module GraphRewriting.GL.Menu (LabelledTree (..), setupMenu) where
import Prelude.Unicode
import Graphics.UI.GLUT as GLUT
import qualified Graphics.Rendering.OpenGL as GL
import GraphRewriting.GL.Global
import GraphRewriting.Rule
import Data.IORef
import GraphRewriting.Pattern
import Control.Monad
menuItemHeight = 20
font = Fixed9By15
setupMenu ∷ LabelledTree (Rule n) → IORef (GlobalVars n) → IO ()
setupMenu rules globalVars = do
c ← liftM canvas $ readIORef globalVars
winWidth ← liftM fromIntegral (stringWidth font $ showRuleTree ruleTree)
let winSize = Size (winWidth + 60) (fromIntegral $ menuItemHeight * n) -- a little wider to display counters
menu ← createSubWindow c (GL.Position 0 0) winSize
modifyIORef globalVars $ \x -> x {menu=menu} -- set the menu subwindow
clearColor $= (Color4 1 1 1 0 ∷ Color4 GLclampf)
GLUT.cursor $= GLUT.LeftArrow
selectRule (ruleList !! 0) globalVars
displayCallback $= displayMenu globalVars
keyboardMouseCallback $= Just (inputCallback $ menuClick menu globalVars)
where
ruleTree = fmap (\r → (0,r)) rules
(ruleNames, ruleList) = unzip $ snd $ flattenLT " " anyOf rules
n = length ruleNames
displayMenu globalVars = do
gv <- readIORef globalVars
clear [ColorBuffer]
color (Color3 0 0 0 ∷ Color3 GLfloat)
zipWithM_ displayLine (lines $ showRuleTree ruleTree) [0..]
swapBuffers
where displayLine line i = do -- display one line of the menu
gv <- readIORef globalVars
if i ≡ selectedIndex gv
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 line
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 globalVars LeftButton idx = do
modifyIORef globalVars $ \x -> x {selectedIndex = idx}
gv <- readIORef globalVars
selectRule (ruleList !! idx) globalVars
postRedisplay $ Just menu
menuClick menu globalVars RightButton idx = do
gv <- readIORef globalVars
_ ← applyLeafRules idx globalVars
-- TODO: update the resulting subtree
highlight globalVars
-- applyRule (everywhere $ ruleList !! idx) globalVars
postRedisplay $ Just menu
menuClick _ _ _ _ = return ()