{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-}
-- | This module provides an easy-to-use interface to create an interactive, graphical front-end for you graph rewriting system. The controls of the GUI are as follows:
--
-- - Left-click on a menu entry to /select/ a rewriting rule. At all times all redexes with respect to the selected rule are marked red in the graph. Note that the menu is hierarchical, which means that selecting a rule that has subordinate entries has the effect of all these entries being selected.
-- 
-- - Right-click on a menu entry to apply the corresponding rule at every applicable position in the graph simultaneously (in no particular order). Redexes that are destroyed (or created) by prior contractions in this process are not reduced, thus if single applications of the rule terminate, so does its simultaneous application. Right-clicking does /not/ select the rule.
-- 
-- - Right-click on a node of the graph to apply the selected rewriting rule at that position. You know before whether it is a applicable, since all redexes in the graph with respect to the selected rule are marked red. Right-clicking on a non-redex node has no effect. The layouting stops while the right mouse-button is pressed.
-- 
-- - Drag the background of the canvas to scroll around.
-- 
-- - Drag individual nodes of the graph around to manually change the layouting of the graph.
-- 
-- - Use your mouse-wheel to zoom in/out. Make sure to keep the mouse curser in the canvas area and not the menu while zooming.
-- 
-- - Press space to pause/resume layouting. Currently layouting is automatically resumed when the graph is rewritten by right-clicking on an individual node and not when right-clicking on a menu entry. This also requires the mouse cursor to be positioned in the canvas area.
--
-- Please have a look the graph-rewriting-ski package for an example application that makes use of this library.
module GraphRewriting.GL.UI (module GraphRewriting.GL.UI, LabelledTree (..), showLabelledTree) where

import qualified Graphics.UI.GLUT as GL
import Graphics.UI.GLUT (($=), get)
import GraphRewriting.Graph
import GraphRewriting.Graph.Read
import GraphRewriting.Rule
import Data.IORef
import GraphRewriting.GL.Render
import GraphRewriting.GL.Global
import GraphRewriting.GL.HyperEdge
import GraphRewriting.GL.Canvas
import GraphRewriting.GL.Menu
import GraphRewriting.Layout.RotPortSpec
import Data.Set as Set
import Control.Monad

-- | Initialises GLUT. Returns program name and command line arguments.
initialise ∷ IO (String, [String])
initialise :: IO (String, [String])
initialise = IO (String, [String])
forall (m :: * -> *). MonadIO m => m (String, [String])
GL.getArgsAndInitialize

run ∷ (View Position n, Render n', View Position n', View Rotation n', PortSpec n', View [Port] n')
    ⇒ Int                  -- ^ The number of initial layout steps to apply before displaying the graph
    → (Graph n → Graph n') -- ^ A projection function that is applied just before displaying the graph
    → (Node → Rewrite n a) -- ^ The monadic graph transformation code for a layout step
    → Graph n
    → LabelledTree (Rule n) -- ^ The rule menu given as a tree of named rules
    → IO ()
run :: forall n n' a.
(View Position n, Render n', View Position n', View Rotation n',
 PortSpec n', View [Port] n') =>
Int
-> (Graph n -> Graph n')
-> (Node -> Rewrite n a)
-> Graph n
-> LabelledTree (Rule n)
-> IO ()
run Int
initSteps Graph n -> Graph n'
project Node -> Rewrite n a
layoutStep Graph n
g LabelledTree (Rule n)
rules = do
	IORef (GlobalVars n)
globalVars ← GlobalVars n -> IO (IORef (GlobalVars n))
forall a. a -> IO (IORef a)
newIORef (GlobalVars n -> IO (IORef (GlobalVars n)))
-> GlobalVars n -> IO (IORef (GlobalVars n))
forall a b. (a -> b) -> a -> b
$ GlobalVars
		{graph :: Graph n
graph        = Rewrite n () -> Graph n -> Graph n
forall n a. Rewrite n a -> Graph n -> Graph n
execGraph (Int -> Rewrite n [a] -> Rewrite n ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
initSteps (Rewrite n [a] -> Rewrite n ()) -> Rewrite n [a] -> Rewrite n ()
forall a b. (a -> b) -> a -> b
$ (Node -> Rewrite n a) -> [Node] -> Rewrite n [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Node -> Rewrite n a
layoutStep ([Node] -> Rewrite n [a]) -> Rewrite n [Node] -> Rewrite n [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Rewrite n [Node]
forall n (m :: * -> *). MonadReader (Graph n) m => m [Node]
readNodeList) Graph n
g,
		 paused :: Bool
paused       = Bool
False,
		 selectedRule :: Int
selectedRule = Int
0,
		 highlighted :: Set Node
highlighted  = Set Node
forall a. Set a
Set.empty,
		 layoutStep :: Node -> Rewrite n ()
layoutStep   = \Node
n → Node -> Rewrite n a
layoutStep Node
n Rewrite n a -> Rewrite n () -> Rewrite n ()
forall a b. Rewrite n a -> Rewrite n b -> Rewrite n b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Rewrite n ()
forall a. a -> Rewrite n a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
		 canvas :: Window
canvas       = Window
forall a. HasCallStack => a
undefined,
		 menu :: Window
menu         = Window
forall a. HasCallStack => a
undefined,
		 getRules :: RuleTree n
getRules     = (Rule n -> (Int, Rule n)) -> LabelledTree (Rule n) -> RuleTree n
forall a b. (a -> b) -> LabelledTree a -> LabelledTree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Rule n
r → (Int
0,Rule n
r)) LabelledTree (Rule n)
rules}


	-- command line benchmarking
--			gvs <- readIORef globalVars
--			finalTree <- reduceAll globalVars (graph gvs) rules
--			putStrLn ("Nr of reductions to normal form:\n" ++ showIndent 0 finalTree) -- (getTopCounter finalTree))
--			putStrLn $ showFlatTabs finalTree
	StateVar [DisplayMode]
GL.initialDisplayMode StateVar [DisplayMode] -> [DisplayMode] -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar [DisplayMode] -> [DisplayMode] -> m ()
$= [DisplayMode
GL.DoubleBuffered, DisplayMode
GL.Multisampling]
--	print =<< get GL.sampleBuffers
--	print =<< get GL.samples
--	print =<< get GL.subpixelBits
--
--	GL.initialDisplayCapabilities $= [GL.With GL.DisplayDouble, GL.With GL.DisplaySamples]
--	GL.multisample $= GL.Enabled
	Bool
p ← GettableStateVar Bool -> GettableStateVar Bool
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
forall (m :: * -> *). MonadIO m => GettableStateVar Bool -> m Bool
get GettableStateVar Bool
GL.displayModePossible
	Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
p) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
		StateVar [DisplayMode]
GL.initialDisplayMode StateVar [DisplayMode] -> [DisplayMode] -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar [DisplayMode] -> [DisplayMode] -> m ()
$= [DisplayMode
GL.DoubleBuffered]
		Bool
p ← GettableStateVar Bool -> GettableStateVar Bool
forall t a (m :: * -> *). (HasGetter t a, MonadIO m) => t -> m a
forall (m :: * -> *). MonadIO m => GettableStateVar Bool -> m Bool
get GettableStateVar Bool
GL.displayModePossible
		Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
p) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ StateVar [DisplayMode]
GL.initialDisplayMode StateVar [DisplayMode] -> [DisplayMode] -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
forall (m :: * -> *).
MonadIO m =>
StateVar [DisplayMode] -> [DisplayMode] -> m ()
$= []
	Window
c ← (Graph n -> Graph n')
-> (Port -> [n'] -> [(Vector2, Vector2)])
-> IORef (GlobalVars n)
-> IO Window
forall n n'.
(View Position n, Render n', View Rotation n', View Position n') =>
(Graph n -> Graph n')
-> (Port -> [n'] -> [(Vector2, Vector2)])
-> IORef (GlobalVars n)
-> IO Window
setupCanvas Graph n -> Graph n'
project Port -> [n'] -> [(Vector2, Vector2)]
forall n.
(View [Port] n, View Position n, PortSpec n, View Rotation n) =>
HyperEdgeRepr n
star IORef (GlobalVars n)
globalVars    -- creates the window, registers callbacks
	IORef (GlobalVars n) -> (GlobalVars n -> GlobalVars n) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (GlobalVars n)
globalVars ((GlobalVars n -> GlobalVars n) -> IO ())
-> (GlobalVars n -> GlobalVars n) -> IO ()
forall a b. (a -> b) -> a -> b
$ \GlobalVars n
v → GlobalVars n
v {canvas = c}
	IORef (GlobalVars n) -> IO ()
forall n. IORef (GlobalVars n) -> IO ()
setupMenu IORef (GlobalVars n)
globalVars
	IORef (GlobalVars n) -> IO ()
forall {n}. View Position n => IORef (GlobalVars n) -> IO ()
layoutLoop IORef (GlobalVars n)
globalVars
	IO ()
forall (m :: * -> *). MonadIO m => m ()
GL.mainLoop
	IO ()
forall (m :: * -> *). MonadIO m => m ()
GL.exit
	() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()