module Reflex.Gloss
( playReflex
, InputEvent
, GlossApp )
where
import Control.Monad.Fix (MonadFix)
import Control.Monad.Identity
import Control.Monad.IO.Class (liftIO)
import Data.Dependent.Sum (DSum ((:=>)))
import Data.IORef (readIORef)
import Graphics.Gloss (Color, Display, Picture)
import Graphics.Gloss.Interface.IO.Game (playIO)
import qualified Graphics.Gloss.Interface.IO.Game as G
import Reflex
import Reflex.Host.Class (newEventWithTriggerRef, runHostFrame, fireEvents)
type InputEvent = G.Event
type GlossApp t m = (Reflex t, MonadHold t m, MonadFix m)
=> Event t Float
-> Event t InputEvent
-> m (Behavior t Picture)
playReflex
:: Display
-> Color
-> Int
-> (forall t m. GlossApp t m)
-> IO ()
playReflex display color frequency network =
runSpiderHost $ do
(tickEvent, tickTriggerRef) <- newEventWithTriggerRef
(inputEvent, inputTriggerRef) <- newEventWithTriggerRef
picture <- runHostFrame $ network tickEvent inputEvent
liftIO $ playIO display
color
frequency
()
(\_ -> runSpiderHost $ runHostFrame (sample picture))
(\ge _ -> runSpiderHost $ handleTrigger ge inputTriggerRef)
(\fl _ -> runSpiderHost $ handleTrigger fl tickTriggerRef)
where
handleTrigger e trigger = do
mETrigger <- liftIO $ readIORef trigger
case mETrigger of
Nothing -> return ()
Just eTrigger -> fireEvents [eTrigger :=> Identity e]