module Graphics.Gloss.Interface.FRP.ReactiveBanana (playBanana, InputEvent) where
import Graphics.Gloss
import Graphics.Gloss.Interface.IO.Game (playIO)
import qualified Graphics.Gloss.Interface.IO.Game as G
import Reactive.Banana
import Reactive.Banana.Frameworks
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
type InputEvent = G.Event
playBanana ∷ Display
→ Color
→ Int
→ (∀ t. Frameworks t
⇒ Event t Float
→ Event t InputEvent
→ Moment t (Behavior t Picture))
→ IO ()
playBanana display colour frequency mPicture = do
pictureref ← newIORef blank
(tickHandler, tick) ← newAddHandler
(eventHandler, event) ← newAddHandler
compile (makeNetwork tickHandler eventHandler $ writeIORef pictureref) >>= actuate
playIO display colour frequency ()
(\ _ → readIORef pictureref)
(\ ev _ → () <$ event ev)
(\ time _ → () <$ tick time)
where
makeNetwork tickHandler eventHandler change = do
eTick ← fromAddHandler tickHandler
eEvent ← fromAddHandler eventHandler
bRawPicture ← mPicture eTick eEvent
let bPicture = bRawPicture
<* stepper undefined eTick
<* stepper undefined eEvent
changes bPicture >>= reactimate' . fmap (fmap change)
initial bPicture >>= liftIO . change