module FRP.Reactive.GLUT.Adapter
( adaptSimple, adapt, simpleInit
, Action, Sink
, module FRP.Reactive.GLUT.UI
) where
import Control.Applicative ((<$>))
import Control.Monad ((>=>))
import qualified Graphics.UI.GLUT as G
import FRP.Reactive (Behavior,stepper)
import FRP.Reactive.LegacyAdapters
import FRP.Reactive.GLUT.UI
import FRP.Reactive.GLUT.SimpleGL
adaptSimple :: String -> Sink (UI -> Behavior Action)
adaptSimple title snk = simpleInit title >> adapt snk
adapt :: Sink (UI -> Behavior Action)
adapt f =
do clock <- makeClock
let mkE = makeEvent clock
(mousePosSink , mousePosE ) <- mkE
(leftDownSink , leftDown ) <- mkE
(rightDownSink, rightDown ) <- mkE
(keyActionSink, keyActions) <- mkE
(tickSink , tick ) <- mkE
let windowPoint' p = do
windowPoint p
mousePosSink' p = do
mousePosSink p
mousePos = (0.0,0.0) `stepper` mousePosE
mouseCB = Just (windowPoint' >=> mousePosSink')
G.passiveMotionCallback G.$= mouseCB
G.motionCallback G.$= mouseCB
G.displayCallback G.$= return ()
G.keyboardMouseCallback G.$= Just (\k ks _ _ ->
case (k,ks) of
(G.MouseButton G.LeftButton ,G.Down) -> leftDownSink ()
(G.MouseButton G.RightButton,G.Down) -> rightDownSink ()
(G.Char c ,G.Down) -> keyActionSink (Down, Char c)
(G.SpecialKey s,G.Down) -> keyActionSink (Down, SpecialKey s)
(G.Char c ,G.Up) -> keyActionSink (Up , Char c)
(G.SpecialKey s,G.Up) -> keyActionSink (Up , SpecialKey s)
_ -> return ()
)
updater <- mkUpdater
(cGetTime clock)
(glwrap <$> f (UI mousePos leftDown rightDown keyActions tick))
schedule (updater >> tickSink ())
G.mainLoop
scheduleIdle :: Sink Action
scheduleIdle act = G.idleCallback G.$= Just act
scheduleTimer :: Sink Action
scheduleTimer act = G.addTimerCallback ms (act >> scheduleTimer act)
where
ms = 10
schedule :: Sink Action
schedule | useIdle = scheduleIdle
| otherwise = scheduleTimer
useIdle :: Bool
useIdle = False