module Graphics.Gloss.Interface.FRP.Yampa
(InputEvent, playYampa)
where
import Control.Monad (when)
import Data.IORef (newIORef, readIORef,
writeIORef)
import FRP.Yampa (DTime, Event (..), SF, react,
reactInit)
import Graphics.Gloss (Color, Display, Picture,
blank)
import Graphics.Gloss.Interface.IO.Game (playIO)
import qualified Graphics.Gloss.Interface.IO.Game as G
type InputEvent = G.Event
playYampa :: Display
-> Color
-> Int
-> SF (Event InputEvent) Picture
-> IO ()
playYampa :: Display -> Color -> Int -> SF (Event InputEvent) Picture -> IO ()
playYampa Display
display Color
color Int
frequency SF (Event InputEvent) Picture
mainSF = do
IORef Picture
picRef <- forall a. a -> IO (IORef a)
newIORef Picture
blank
ReactHandle (Event InputEvent) Picture
handle <- forall a b.
IO a
-> (ReactHandle a b -> Bool -> b -> IO Bool)
-> SF a b
-> IO (ReactHandle a b)
reactInit
(forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Event a
NoEvent)
(\ReactHandle (Event InputEvent) Picture
_ Bool
updated Picture
pic -> do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
updated (IORef Picture
picRef forall a. IORef a -> a -> IO ()
`writeIORef` Picture
pic)
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
)
SF (Event InputEvent) Picture
mainSF
let
toPic :: DTime -> IO Picture
toPic :: DTime -> IO Picture
toPic = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Picture
picRef
handleInput :: G.Event -> DTime -> IO DTime
handleInput :: InputEvent -> DTime -> IO DTime
handleInput InputEvent
event DTime
timeAcc = do
Bool
_quit <- forall a b. ReactHandle a b -> (DTime, Maybe a) -> IO Bool
react ReactHandle (Event InputEvent) Picture
handle (DTime
delta, forall a. a -> Maybe a
Just (forall a. a -> Event a
Event InputEvent
event))
forall (m :: * -> *) a. Monad m => a -> m a
return (DTime
timeAcc forall a. Num a => a -> a -> a
+ DTime
delta)
where
delta :: DTime
delta = DTime
0.01 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frequency
stepWorld :: Float -> DTime -> IO DTime
stepWorld :: Float -> DTime -> IO DTime
stepWorld Float
delta DTime
timeAcc
| DTime
delta' forall a. Ord a => a -> a -> Bool
> DTime
0 = forall a b. ReactHandle a b -> (DTime, Maybe a) -> IO Bool
react ReactHandle (Event InputEvent) Picture
handle (DTime
delta', forall a. a -> Maybe a
Just forall a. Event a
NoEvent) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return DTime
0.0
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return (-DTime
delta')
where
delta' :: DTime
delta' = forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
delta forall a. Num a => a -> a -> a
- DTime
timeAcc
forall world.
Display
-> Color
-> Int
-> world
-> (world -> IO Picture)
-> (InputEvent -> world -> IO world)
-> (Float -> world -> IO world)
-> IO ()
playIO Display
display Color
color Int
frequency DTime
0 DTime -> IO Picture
toPic InputEvent -> DTime -> IO DTime
handleInput Float -> DTime -> IO DTime
stepWorld