graph-rewriting-gl (empty) → 0.5

raw patch · 9 files changed

+449/−0 lines, 9 filesdep +AC-Vectordep +GLUTdep +OpenGLsetup-changed

Dependencies added: AC-Vector, GLUT, OpenGL, base, base-unicode-symbols, containers, graph-rewriting, graph-rewriting-layout

Files

• GraphRewriting/GL/Canvas.hs +158/−0
• GraphRewriting/GL/Global.hs +50/−0
• GraphRewriting/GL/HyperEdge.hs +18/−0
• GraphRewriting/GL/Menu.hs +68/−0
• GraphRewriting/GL/Render.hs +28/−0
• GraphRewriting/GL/UI.hs +74/−0
• LICENSE +10/−0
• Setup.hs +2/−0
• graph-rewriting-gl.cabal +41/−0

@@ -0,0 +1,158 @@+module GraphRewriting.GL.Canvas (setupCanvas) where++import qualified Graphics.UI.GLUT as GL+import Graphics.Rendering.OpenGL (($=))+import GraphRewriting.Graph+import GraphRewriting.Graph.Read+import GraphRewriting.Graph.Write.Unsafe as Unsafe+import GraphRewriting.Pattern+import GraphRewriting.Rule+import GraphRewriting.GL.Render+import GraphRewriting.GL.Global+import Data.IORef+import GraphRewriting.Layout.Rotation+import GraphRewriting.Layout.Position+import GraphRewriting.Layout.PortSpec+import qualified Data.Set as Set+import Control.Monad (liftM)+import Data.Maybe (catMaybes, listToMaybe)+++setupCanvas ∷ (View [Port] n, Render n, View Position n, PortSpec n, View Rotation n)+            ⇒ (Graph n → Graph n) → (Edge → [n] → [(Vector2, Vector2)]) → IORef (GlobalVars n) → IO GL.Window+setupCanvas project hyperEdgeToLines globalVars = do+	canvas ← GL.createWindow "Graph"+	GL.clearColor $= (GL.Color4 1 1 1 0 ∷ GL.Color4 GL.GLclampf)+	GL.lineWidth $= 2+	aspect ← newIORef 1+	focus  ← newIORef $ GL.Vector3 0 0 0+	zoom   ← newIORef (1 ∷ GL.GLdouble)+	origLayoutStep ← liftM layoutStep $ readIORef globalVars+	registerCallbacks origLayoutStep aspect focus zoom project hyperEdgeToLines globalVars+	GL.cursor $= GL.LeftArrow+	return canvas++registerCallbacks origLayoutStep aspect focus zoom project hyperEdgeToLines globalVars = do+	autozoom+	GL.displayCallback $= display+	GL.reshapeCallback $= Just reshape+	GL.keyboardMouseCallback $= Just inputCallback++	where++	zoomBy factor = modifyIORef zoom (* factor) >> readIORef globalVars >>= redisplay . canvas++	inputCallback (GL.MouseButton GL.WheelUp)   _ _ _ = zoomBy 1.1+	inputCallback (GL.MouseButton GL.WheelDown) _ _ _ = zoomBy 0.9++	inputCallback (GL.MouseButton GL.RightButton) GL.Down mod pos = do+		pause globalVars+		rule ← liftM selectedRule $ readIORef globalVars+		node ← nodeAt pos+		let applyRuleOn n = execGraph (apply $ nextIs n rule)+		modifyGraph (maybe id applyRuleOn node) globalVars+	inputCallback (GL.MouseButton GL.RightButton) GL.Up mod (GL.Position x y) = resume globalVars++	inputCallback (GL.MouseButton GL.LeftButton) GL.Up mod pos = do+		modifyIORef globalVars $ \v → v {layoutStep = origLayoutStep}+		GL.addTimerCallback 50 $ GL.motionCallback $= Nothing+	inputCallback (GL.MouseButton GL.LeftButton) GL.Down mod from = do+		node ← nodeAt from+		case node of+			Nothing → GL.motionCallback $= Just (scrollCallback from)+			Just n  → do+				let fixN = do+					npos ← examineNode position n+					origLayoutStep+					updateNode (Position npos) n+				modifyIORef globalVars $ \v → v {layoutStep = fixN}+				GL.motionCallback $= Just (dragCallback n)+		where+		dragCallback n to = do+			GL.motionCallback $= Nothing+			GL.Vertex3 tx ty _ ← unproject to+			let v = Vector2 (convertGLdouble tx) (convertGLdouble ty)+			modifyGraph (execGraph $ Unsafe.updateNode (Position v) n) globalVars+			GL.addTimerCallback 40 $ GL.motionCallback $= Just (dragCallback n)++		scrollCallback from to = do+			GL.motionCallback $= Nothing+			GL.Vertex3 fx fy _ ← unproject from+			GL.Vertex3 tx ty _ ← unproject to+			modifyIORef focus $ \(GL.Vector3 x y _) → GL.Vector3 (x + tx - fx) (y + ty - fy) 0+			redisplay =<< liftM canvas (readIORef globalVars)+			GL.addTimerCallback 40 $ GL.motionCallback $= Just (scrollCallback to)++	inputCallback (GL.Char 'z') GL.Up _ _ = autozoom+	inputCallback (GL.Char ' ') GL.Up _ _ = do+		isPaused ← liftM paused $ readIORef globalVars+		if isPaused then resume globalVars else pause globalVars+	inputCallback _ _ _ _ = return ()++	autozoom = let margin = 2 in do+		ns ← liftM (nodes . graph) (readIORef globalVars)+		let maxDist = maximum $ map abs $ concat [[v2x p, v2y p] | p ← examine position `map` ns]+		writeIORef focus $ GL.Vector3 0 0 0+		writeIORef zoom $ 1 / (convertDouble maxDist + margin)++	display = do+		GL.clear [GL.ColorBuffer]+		GL.loadIdentity+		a ← readIORef aspect+		if a < 1 then GL.ortho2D (-1) 1 (-1/a) (1/a) else GL.ortho2D (-1*a) (1*a) (-1) 1+		z ← readIORef zoom+		GL.scale z z 1+		GL.translate =<< readIORef focus++		GL.color (GL.Color3 0 0 0 ∷ GL.Color3 GL.GLfloat)+		g ← liftM (project . graph) (readIORef globalVars)+		mapM_ (uncurry renderLine) (concatMap (uncurry hyperEdgeToLines) (edges g))+		hl ← liftM highlighted (readIORef globalVars)+		mapM_ (renderNode hl) (evalGraph readNodeList g `zip` nodes g)++		GL.swapBuffers++	nodeAt ∷ GL.Position → IO (Maybe Node)+	nodeAt glPos = do+		GL.Vertex3 x y _ ← unproject glPos+		let pos = Vector2 (convertGLdouble x) (convertGLdouble y)+		g ← liftM (project . graph) (readIORef globalVars)+		return $ listToMaybe $ catMaybes $ evalGraph (readOnly $ withNodes $ checkPos pos) g+		where checkPos pos n = do+			npos ← examineNode position n+			return $ if (vmag (pos - npos) < 1)+				then Just n+				else Nothing++	reshape s@(GL.Size w h) = do+		writeIORef aspect newAspect+		GL.viewport $= (GL.Position 0 0, s)+		GL.matrixMode $= GL.Projection+		GL.loadIdentity+		GL.perspective 0 newAspect (-1) 1+		GL.matrixMode $= GL.Modelview 0+		where newAspect = fromIntegral w / fromIntegral (max 1 h)++unproject ∷ GL.Position → IO (GL.Vertex3 GL.GLdouble)+unproject (GL.Position x y) = do+	GL.Size winWidth winHeight ← GL.get GL.windowSize+	let pos = GL.Vertex3 (fromIntegral x) (fromIntegral $ fromIntegral winHeight - y) 0+	modelview  ← getMatrix (GL.Modelview 1)+	projection ← getMatrix GL.Projection+	viewport   ← GL.get GL.viewport+	GL.unProject pos modelview projection viewport++getMatrix ∷ GL.MatrixMode → IO (GL.GLmatrix GL.GLdouble)+getMatrix = GL.get . GL.matrix . Just++renderNode ∷ (Render n, View Position n, View Rotation n) ⇒ Set.Set Node → (Node,n) → IO ()+renderNode highlighted (ref,n) = GL.preservingMatrix $ do+	GL.translate (vector $ examine position n)+	GL.rotate (convertDouble $ examine rotation n * 180 / pi) (GL.Vector3 0 0 1 ∷ GL.Vector3 GL.GLdouble)+	if ref `Set.member` highlighted+		then GL.color (GL.Color3 1 0 0 ∷ GL.Color3 GL.GLfloat)+		else GL.color (GL.Color3 0 0 0 ∷ GL.Color3 GL.GLfloat)+	render n++renderLine ∷ Vector2 → Vector2 → IO ()+renderLine p1 p2 = GL.renderPrimitive GL.Lines $ vertex p1 >> vertex p2

@@ -0,0 +1,50 @@+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

@@ -0,0 +1,18 @@+module GraphRewriting.GL.HyperEdge where++import GraphRewriting.Graph+import GraphRewriting.Graph.Read+import GraphRewriting.Layout.Rotation+import GraphRewriting.Layout.Position+import GraphRewriting.Layout.PortSpec+import GraphRewriting.Layout.RotPortSpec+++type HyperEdgeRepr n = Edge → [n] → [(Vector2, Vector2)]++star ∷ (View [Port] n, View Position n, PortSpec n, View Rotation n) ⇒ HyperEdgeRepr n+star e ns = [(port, focalPoint ports) | port ← ports]+	where ports = concatMap (propOfPort absRotPortPos e) ns++complete ∷ (View Position n, PortSpec n, View Rotation n) ⇒ Edge → [n] → [(Vector2, Vector2)]+complete = undefined

@@ -0,0 +1,68 @@+module GraphRewriting.GL.Menu (LabeledTree (..), setupMenu) where++import Prelude.Unicode+import Graphics.UI.GLUT as GLUT+import qualified Graphics.Rendering.OpenGL as GL+import GraphRewriting.GL.Global+import GraphRewriting.Graph+import GraphRewriting.Rule+import Data.IORef+import GraphRewriting.Pattern+import Control.Monad+++data LabeledTree a = Branch String [LabeledTree a] | Leaf String a++flattenLT ∷ String → ([a] → a) → LabeledTree a → (a,[(String, a)])+flattenLT indent combine tree = case tree of+	Leaf l x → (x,[(l,x)])+	Branch b cs → (x, (b,x) : zip (map (indent ⧺) strs) ys) where+		x = combine xs+		(xs,css) = unzip $ map (flattenLT indent combine) cs+		(strs,ys) = unzip $ concat css++menuItemHeight = 20+font = Fixed9By15++setupMenu ∷ LabeledTree (Rule n) → IORef (GlobalVars n) → IO ()+setupMenu rules globalVars = do+	c ← liftM canvas $ readIORef globalVars+	winWidth ← liftM (fromIntegral . maximum) (mapM (stringWidth font) ruleNames)+	let winSize = Size winWidth (fromIntegral $ menuItemHeight * n)+	menu ← createSubWindow c (GL.Position 0 0) winSize+	clearColor $= (Color4 1 1 1 0 ∷ Color4 GLclampf)++	GLUT.cursor $= GLUT.LeftArrow+	selectedIndex ← newIORef (0 ∷ Int)+	selectRule (ruleList !! 0) globalVars+	displayCallback $= (displayMenu =<< readIORef selectedIndex)+	keyboardMouseCallback $= Just (inputCallback $ menuClick menu selectedIndex)+	where++	(ruleNames, ruleList) = unzip $ snd $ flattenLT "   " anyOf rules+	n = length ruleNames++	displayMenu selectedIndex = do+		clear [ColorBuffer]+		color (Color3 0 0 0 ∷ Color3 GLfloat)+		zipWithM_ displayLine ruleNames [0..]+		swapBuffers+		where displayLine name i = do+			if i ≡ selectedIndex+				then GL.color (GL.Color3 1 0 0 ∷ GL.Color3 GL.GLfloat)+				else GL.color (GL.Color3 0 0 0 ∷ GL.Color3 GL.GLfloat)+			windowPos (Vertex2 0 (fromIntegral $ (n - i - 1) * menuItemHeight + 5) ∷ Vertex2 GLint)+			renderString font name++	inputCallback handler (MouseButton button) Up modifiers (Position x y) = do+		let idx = fromIntegral y `div` menuItemHeight+		when (0 <= idx ∧ idx < n) (handler button idx)+	inputCallback _ _ _ _ _ = return ()++	menuClick menu selectedIndex LeftButton idx = do+		writeIORef selectedIndex idx+		selectRule (ruleList !! idx) globalVars+		postRedisplay $ Just menu+	menuClick menu selectedIndex RightButton idx = do+		modifyGraph (execGraph $ apply $ everywhere $ ruleList !! idx) globalVars+	menuClick _ _ _ _  = return ()

@@ -0,0 +1,28 @@+module GraphRewriting.GL.Render where++import Data.Vector+import Graphics.Rendering.OpenGL (GLdouble)+import qualified Graphics.Rendering.OpenGL as GL+import Unsafe.Coerce+++-- | Here the OpenGL code for rendering a node can be given. The node-size is expected to be roughly 2 (radius 1) but this is not a requirement.+class Render a where render ∷ a → IO ()++convertDouble ∷ Double → GLdouble+convertDouble = unsafeCoerce++convertGLdouble ∷ GLdouble → Double+convertGLdouble = unsafeCoerce++vector ∷ Vector2 → GL.Vector3 GLdouble+vector v = GL.Vector3 (convertDouble $ v2x v) (convertDouble $ v2y v) 0++vertex ∷ Vector2 → IO ()+vertex v = GL.vertex $ GL.Vertex2 (convertDouble $ v2x v) (convertDouble $ v2y v)++vector2 ∷ (Double,Double) → GL.Vector3 GLdouble+vector2 (x,y) = GL.Vector3 (convertDouble x) (convertDouble y) 0++vertex2 ∷ (Double,Double) → IO ()+vertex2 (x,y) = GL.vertex $ GL.Vertex2 (convertDouble x) (convertDouble y)

@@ -0,0 +1,74 @@+-- | 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:+--+-- - left-click on a menu entry: rule selection. At all times for each redex (according to the selected rule) one node of the redex (the first node that is matched) is marked red in the graph.+--+-- - right-click on a menu entry: applies the rule once for each redex currently existing in the graph. No contractions take place for redexes deleted or arisen during this process.+--+-- - right-click on a (red) node: applies the selected rule to the redex containing the node.+--+-- - drag a node: by this you can manually help out the graph drawing mechanism to find a better layout.+--+-- - drag outside of a node: scroll around.+--+-- - mouse wheel: zoom+--+-- - @z@: autozoom+--+-- - @space@: pause/resume layouting+--+-- 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, LabeledTree (..)) 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 = GL.getArgsAndInitialize++-- | After initialisation 'run' can be used to start the GUI+run ∷ (View [Port] n, Render n, View Position n, PortSpec n, View Rotation n)+    ⇒ Int                  -- ^ The number of layout steps to apply before displaying the graph+    → (Graph n → Graph n)  -- ^ A projection function that is applied just before displaying the graph+    → Rewrite n a          -- ^ The monadic graph transformation code for a layout step+    → Graph n+    → LabeledTree (Rule n) -- ^ The rule menu given as a tree of named rules+    → IO ()+run initSteps project layoutStep g rules = do+	globalVars ← newIORef $ GlobalVars+		{graph        = execGraph (replicateM_ initSteps layoutStep) g,+		 paused       = False,+		 selectedRule = fail "none",+		 highlighted  = Set.empty,+		 layoutStep   = layoutStep >> return (),+		 canvas       = undefined}+--	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+	GL.initialDisplayMode $= [GL.DoubleBuffered, GL.Multisampling]+	p ← get GL.displayModePossible+	when (not p) $ do+		GL.initialDisplayMode $= [GL.DoubleBuffered]+		p ← get GL.displayModePossible+		when (not p) $ GL.initialDisplayMode $= []+	c ← setupCanvas project star globalVars+	modifyIORef globalVars $ \v → v {canvas = c}+	setupMenu rules globalVars+	layoutLoop globalVars+	GL.mainLoop+	GL.exit

@@ -0,0 +1,10 @@+Copyright (c) 2010, Jan Rochel+All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.+* Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.+* Neither the name of the <ORGANIZATION> nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,41 @@+Name:           graph-rewriting-gl+Version:        0.5+Copyright:      (c) 2010, Jan Rochel+License:        BSD3+License-File:   LICENSE+Author:         Jan Rochel+Maintainer:     jan@rochel.info+Stability:      beta+Build-Type:	Simple+Synopsis:       OpenGL interface for interactive hypergraph rewriting+Description:+	Once a graph rewriting system has been specified using the graph-rewriting library this package can be+	used to create an application that allows to experiment with this system by interactively applying the+	rewrite rules manually on the graph.+Category:       Graphs, Graphics+Extensions:     UnicodeSyntax+Cabal-Version:  >= 1.6+Build-Depends:+	base >= 4 && < 4.3,+	base-unicode-symbols >= 0.2 && < 0.3,+	graph-rewriting >= 0.4.6 && < 0.5,+	graph-rewriting-layout >= 0.4 && < 0.5,+	GLUT >= 2.2 && < 2.3,+	OpenGL >= 2.4 && < 2.5,+	containers >= 0.3 && < 0.4,+	AC-Vector >= 1.2 && < 1.3+Exposed-Modules:+	GraphRewriting.GL.UI+	GraphRewriting.GL.Render+Other-Modules:+	GraphRewriting.GL.Global+	GraphRewriting.GL.Menu+	GraphRewriting.GL.Canvas+	GraphRewriting.GL.HyperEdge+Extensions:+	UnicodeSyntax+	FlexibleInstances+	FlexibleContexts+	MultiParamTypeClasses+	TypeSynonymInstances+GHC-Options:    -fno-warn-duplicate-exports -fwarn-unused-imports