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 ()