{-# LANGUAGE Rank2Types, TypeOperators #-}
{-# OPTIONS -Wall #-}
----------------------------------------------------------------------
-- |
-- Module      :  FRP.Reactive.GLUT.Adapter
-- Copyright   :  (c) Conal Elliott 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- 
-- Connect Reactive + GLUT
----------------------------------------------------------------------

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 (Event,Behavior,stepper)
import FRP.Reactive.LegacyAdapters

import FRP.Reactive.GLUT.UI
import FRP.Reactive.GLUT.SimpleGL

-- while debugging
-- import Control.Concurrent (forkIO)
-- import FRP.Reactive.Internal.Reactive (eFutures,isNeverE)


-- | Adapter to connect @FRP.Reactive@ with @GLUT@.  Uses given window
-- title and a simple canned initialization.  Or do your own
-- initialization and then invoke 'adapt'.
adaptSimple :: String -> Sink (UI -> Behavior Action)
adaptSimple title snk = simpleInit title >> adapt snk

-- | Adapter to connect @FRP.Reactive@ with @GLUT@.  Assumes that GL/GLUT
-- have been initialized as desired.
adapt :: Sink (UI -> Behavior Action)
adapt f =
  do clock <- makeClock
     let mkE :: forall a. Show a => (a :+-> Event a)
         mkE = makeEvent clock
     (mousePosSink , mousePosE ) <- mkE
     (leftDownSink , leftDown  ) <- mkE
     (rightDownSink, rightDown ) <- mkE
     (keyActionSink, keyActions) <- mkE
     (tickSink     , tick      ) <- mkE

     -- Debugging:
     -- isNeverE leftDown ==   C-c C-c
     -- putStrLn ("isNeverE leftDown == " ++ show (isNeverE leftDown))
     -- forkIO $ do putStrLn ("mouse motion: " ++ show mousePosE)
     -- forkIO $ do putStrLn ("lbp: " ++ show (eFutures leftDown))

     -- TODO: let the initial mouse position be its actual position
     let windowPoint'  p = do -- putStrLn $ "window point " ++ show p
                              windowPoint p
         mousePosSink' p = do -- putStrLn $ "mouse " ++ show p
                              mousePosSink p
                              -- yield
         mousePos = (0.0,0.0) `stepper` mousePosE
         mouseCB  = Just (windowPoint' >=> mousePosSink')
     -- Callbacks
     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 ())
     -- putStrLn "mainLoop"
     G.mainLoop

-- TODO: figure out how to exit cleanly. Right now mainLoop never returns
--   killThread programTid
--   exitWith ExitSuccess
-- Better yet, don't kill the process.  Instead leave the GL state such
-- that ghci can continue with more graphical yumminess.


-- Schedule an action for regular execution.  This version uses idle
-- callback.  Could instead use a chain of timer call-backs, which could
-- then limit the update rate.  (On my Windows machine, I'm getting exactly
-- 64fps most of the time for extremely simple graphics.  I guess there's
-- something wired into G.idleCallback. -Conal)

-- Schedule using idle callback.
scheduleIdle :: Sink Action
scheduleIdle act = G.idleCallback G.$= Just act

-- Schedule using the timer callback.  No matter how small an interval I
-- choose, I still get max 64 frames/sec.
scheduleTimer :: Sink Action
scheduleTimer act = G.addTimerCallback ms (act >> scheduleTimer act)
 where
   ms = 10

-- Schedule an action for repeated execution
schedule :: Sink Action
schedule | useIdle   = scheduleIdle
         | otherwise = scheduleTimer

-- Whether to use the 'scheduleIdle' or 'scheduleTimer'.
useIdle :: Bool
useIdle = False

-- Both schedulers seem to work great.