graph-rewriting-gl-0.5: GraphRewriting/GL/Global.hs

module GraphRewriting.GL.Global where

import Graphics.UI.GLUT (addTimerCallback, Window, postRedisplay)
import GraphRewriting.Graph
import GraphRewriting.Graph.Read
import GraphRewriting.Rule
import GraphRewriting.Pattern
import Data.IORef
import GraphRewriting.Layout.RotPortSpec
import Data.Set as Set
import Control.Monad

data GlobalVars n = GlobalVars
	{graph        ∷ Graph n,
	 paused       ∷ Bool,
	 selectedRule ∷ Rule n,
	 highlighted  ∷ Set Node,
	 layoutStep   ∷ Rewrite n (),
	 canvas       ∷ Window}

redisplay ∷ Window → IO ()
redisplay = postRedisplay . Just

modifyGraph f globalVars = do
	modifyIORef globalVars $ \v → v {graph = f $ graph v}
	highlight globalVars

selectRule r globalVars = do
	modifyIORef globalVars $ \v → v {selectedRule = r}
	highlight globalVars

highlight globalVars = do
	gv@GlobalVars {graph = g, selectedRule = rule, highlighted = h, canvas = c} ← readIORef globalVars
	let h' = Set.fromList [head match | (match,rewrite) ← runPattern rule g]
	writeIORef globalVars $ gv {highlighted = h'}
	redisplay c

layoutLoop globalVars = do
	gv@GlobalVars {graph = g, paused = p, layoutStep = l, canvas = c} ← readIORef globalVars
	when (not p) $ do
		examine position (head $ nodes g) `seq` return ()
		writeIORef globalVars $ gv {graph = execGraph l g}
		redisplay c
		addTimerCallback 40 $ layoutLoop globalVars

pause globalVars = modifyIORef globalVars $ \vs → vs {paused = True}

resume globalVars = do
	modifyIORef globalVars $ \vs → vs {paused = False}
	layoutLoop globalVars