{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module FRP.Rhine.Gloss.Pure (
GlossM,
paint,
clear,
paintAll,
GlossClock (..),
GlossClSF,
currentEvent,
flowGloss,
flowGlossClSF,
) where
import qualified Control.Category as Category
import Data.Functor.Identity
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Writer.Strict
import Control.Monad.Schedule.Class
import Control.Monad.Schedule.Yield
import Data.Automaton.Trans.Except (performOnFirstSample)
import qualified Data.Automaton.Trans.Reader as AutomatonReader
import qualified Data.Automaton.Trans.Writer as AutomatonWriter
import Data.Stream.Result (Result (..))
import FRP.Rhine
import FRP.Rhine.Gloss.Common
newtype GlossM a = GlossM {forall a.
GlossM a
-> YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a
unGlossM :: YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a}
deriving ((forall a b. (a -> b) -> GlossM a -> GlossM b)
-> (forall a b. a -> GlossM b -> GlossM a) -> Functor GlossM
forall a b. a -> GlossM b -> GlossM a
forall a b. (a -> b) -> GlossM a -> GlossM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> GlossM a -> GlossM b
fmap :: forall a b. (a -> b) -> GlossM a -> GlossM b
$c<$ :: forall a b. a -> GlossM b -> GlossM a
<$ :: forall a b. a -> GlossM b -> GlossM a
Functor, Functor GlossM
Functor GlossM =>
(forall a. a -> GlossM a)
-> (forall a b. GlossM (a -> b) -> GlossM a -> GlossM b)
-> (forall a b c.
(a -> b -> c) -> GlossM a -> GlossM b -> GlossM c)
-> (forall a b. GlossM a -> GlossM b -> GlossM b)
-> (forall a b. GlossM a -> GlossM b -> GlossM a)
-> Applicative GlossM
forall a. a -> GlossM a
forall a b. GlossM a -> GlossM b -> GlossM a
forall a b. GlossM a -> GlossM b -> GlossM b
forall a b. GlossM (a -> b) -> GlossM a -> GlossM b
forall a b c. (a -> b -> c) -> GlossM a -> GlossM b -> GlossM c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> GlossM a
pure :: forall a. a -> GlossM a
$c<*> :: forall a b. GlossM (a -> b) -> GlossM a -> GlossM b
<*> :: forall a b. GlossM (a -> b) -> GlossM a -> GlossM b
$cliftA2 :: forall a b c. (a -> b -> c) -> GlossM a -> GlossM b -> GlossM c
liftA2 :: forall a b c. (a -> b -> c) -> GlossM a -> GlossM b -> GlossM c
$c*> :: forall a b. GlossM a -> GlossM b -> GlossM b
*> :: forall a b. GlossM a -> GlossM b -> GlossM b
$c<* :: forall a b. GlossM a -> GlossM b -> GlossM a
<* :: forall a b. GlossM a -> GlossM b -> GlossM a
Applicative, Applicative GlossM
Applicative GlossM =>
(forall a b. GlossM a -> (a -> GlossM b) -> GlossM b)
-> (forall a b. GlossM a -> GlossM b -> GlossM b)
-> (forall a. a -> GlossM a)
-> Monad GlossM
forall a. a -> GlossM a
forall a b. GlossM a -> GlossM b -> GlossM b
forall a b. GlossM a -> (a -> GlossM b) -> GlossM b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. GlossM a -> (a -> GlossM b) -> GlossM b
>>= :: forall a b. GlossM a -> (a -> GlossM b) -> GlossM b
$c>> :: forall a b. GlossM a -> GlossM b -> GlossM b
>> :: forall a b. GlossM a -> GlossM b -> GlossM b
$creturn :: forall a. a -> GlossM a
return :: forall a. a -> GlossM a
Monad)
instance MonadSchedule GlossM where
schedule :: forall a. NonEmpty (GlossM a) -> GlossM (NonEmpty a, [GlossM a])
schedule NonEmpty (GlossM a)
actions = ((NonEmpty a,
[YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a])
-> (NonEmpty a, [GlossM a]))
-> GlossM
(NonEmpty a,
[YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a])
-> GlossM (NonEmpty a, [GlossM a])
forall a b. (a -> b) -> GlossM a -> GlossM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a]
-> [GlossM a])
-> (NonEmpty a,
[YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a])
-> (NonEmpty a, [GlossM a])
forall a b. (a -> b) -> (NonEmpty a, a) -> (NonEmpty a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a
-> GlossM a)
-> [YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a]
-> [GlossM a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a
-> GlossM a
forall a.
YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a
-> GlossM a
GlossM)) (GlossM
(NonEmpty a,
[YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a])
-> GlossM (NonEmpty a, [GlossM a]))
-> GlossM
(NonEmpty a,
[YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a])
-> GlossM (NonEmpty a, [GlossM a])
forall a b. (a -> b) -> a -> b
$ YieldT
(ReaderT (Float, Maybe Event) (Writer Picture))
(NonEmpty a,
[YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a])
-> GlossM
(NonEmpty a,
[YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a])
forall a.
YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a
-> GlossM a
GlossM (YieldT
(ReaderT (Float, Maybe Event) (Writer Picture))
(NonEmpty a,
[YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a])
-> GlossM
(NonEmpty a,
[YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a]))
-> YieldT
(ReaderT (Float, Maybe Event) (Writer Picture))
(NonEmpty a,
[YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a])
-> GlossM
(NonEmpty a,
[YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a])
forall a b. (a -> b) -> a -> b
$ NonEmpty (YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a)
-> YieldT
(ReaderT (Float, Maybe Event) (Writer Picture))
(NonEmpty a,
[YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a])
forall a.
NonEmpty
(FreeT (Wait ()) (ReaderT (Float, Maybe Event) (Writer Picture)) a)
-> FreeT
(Wait ())
(ReaderT (Float, Maybe Event) (Writer Picture))
(NonEmpty a,
[FreeT
(Wait ()) (ReaderT (Float, Maybe Event) (Writer Picture)) a])
forall (m :: * -> *) a.
MonadSchedule m =>
NonEmpty (m a) -> m (NonEmpty a, [m a])
schedule (NonEmpty
(YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a)
-> YieldT
(ReaderT (Float, Maybe Event) (Writer Picture))
(NonEmpty a,
[YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a]))
-> NonEmpty
(YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a)
-> YieldT
(ReaderT (Float, Maybe Event) (Writer Picture))
(NonEmpty a,
[YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a])
forall a b. (a -> b) -> a -> b
$ (GlossM a
-> YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a)
-> NonEmpty (GlossM a)
-> NonEmpty
(YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GlossM a
-> YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a
forall a.
GlossM a
-> YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a
unGlossM NonEmpty (GlossM a)
actions
paint :: Picture -> GlossM ()
paint :: Picture -> GlossM ()
paint = YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) ()
-> GlossM ()
forall a.
YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a
-> GlossM a
GlossM (YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) ()
-> GlossM ())
-> (Picture
-> YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) ())
-> Picture
-> GlossM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (Float, Maybe Event) (Writer Picture) ()
-> YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) ()
forall (m :: * -> *) a. Monad m => m a -> FreeT (Wait ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Float, Maybe Event) (Writer Picture) ()
-> YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) ())
-> (Picture -> ReaderT (Float, Maybe Event) (Writer Picture) ())
-> Picture
-> YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Writer Picture ()
-> ReaderT (Float, Maybe Event) (Writer Picture) ()
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Float, Maybe Event) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Writer Picture ()
-> ReaderT (Float, Maybe Event) (Writer Picture) ())
-> (Picture -> Writer Picture ())
-> Picture
-> ReaderT (Float, Maybe Event) (Writer Picture) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Picture -> Writer Picture ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell
clear :: GlossM ()
clear :: GlossM ()
clear = Picture -> GlossM ()
paint Picture
Blank
paintAll :: Picture -> GlossM ()
paintAll :: Picture -> GlossM ()
paintAll Picture
pic = GlossM ()
clear GlossM () -> GlossM () -> GlossM ()
forall a b. GlossM a -> GlossM b -> GlossM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Picture -> GlossM ()
paint Picture
pic
data GlossClock = GlossClock
instance Semigroup GlossClock where
GlossClock
_ <> :: GlossClock -> GlossClock -> GlossClock
<> GlossClock
_ = GlossClock
GlossClock
instance Clock GlossM GlossClock where
type Time GlossClock = Float
type Tag GlossClock = Maybe Event
initClock :: GlossClock
-> RunningClockInit GlossM (Time GlossClock) (Tag GlossClock)
initClock GlossClock
_ = (Automaton GlossM () (Float, Maybe Event), Float)
-> GlossM (Automaton GlossM () (Float, Maybe Event), Float)
forall a. a -> GlossM a
forall (m :: * -> *) a. Monad m => a -> m a
return (GlossM (Float, Maybe Event)
-> Automaton GlossM () (Float, Maybe Event)
forall (m :: * -> *) b a. Functor m => m b -> Automaton m a b
constM (YieldT
(ReaderT (Float, Maybe Event) (Writer Picture))
(Float, Maybe Event)
-> GlossM (Float, Maybe Event)
forall a.
YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a
-> GlossM a
GlossM (YieldT
(ReaderT (Float, Maybe Event) (Writer Picture))
(Float, Maybe Event)
-> GlossM (Float, Maybe Event))
-> YieldT
(ReaderT (Float, Maybe Event) (Writer Picture))
(Float, Maybe Event)
-> GlossM (Float, Maybe Event)
forall a b. (a -> b) -> a -> b
$ YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) ()
forall (m :: * -> *). Monad m => YieldT m ()
yield YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) ()
-> YieldT
(ReaderT (Float, Maybe Event) (Writer Picture))
(Float, Maybe Event)
-> YieldT
(ReaderT (Float, Maybe Event) (Writer Picture))
(Float, Maybe Event)
forall a b.
FreeT (Wait ()) (ReaderT (Float, Maybe Event) (Writer Picture)) a
-> FreeT
(Wait ()) (ReaderT (Float, Maybe Event) (Writer Picture)) b
-> FreeT
(Wait ()) (ReaderT (Float, Maybe Event) (Writer Picture)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT (Float, Maybe Event) (Writer Picture) (Float, Maybe Event)
-> YieldT
(ReaderT (Float, Maybe Event) (Writer Picture))
(Float, Maybe Event)
forall (m :: * -> *) a. Monad m => m a -> FreeT (Wait ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT (Float, Maybe Event) (Writer Picture) (Float, Maybe Event)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask) Automaton GlossM () (Float, Maybe Event)
-> Automaton GlossM (Float, Maybe Event) (Float, Maybe Event)
-> Automaton GlossM () (Float, Maybe Event)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Automaton GlossM Float Float
forall (m :: * -> *) v s.
(Monad m, VectorSpace v s) =>
Automaton m v v
sumS Automaton GlossM Float Float
-> Automaton GlossM (Maybe Event) (Maybe Event)
-> Automaton GlossM (Float, Maybe Event) (Float, Maybe Event)
forall b c b' c'.
Automaton GlossM b c
-> Automaton GlossM b' c' -> Automaton GlossM (b, b') (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Automaton GlossM (Maybe Event) (Maybe Event)
forall a. Automaton GlossM a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Category.id), Float
0)
instance GetClockProxy GlossClock
type GlossClSF = ClSF GlossM GlossClock () Picture
currentEvent :: ClSF GlossM GlossClock () (Maybe Event)
currentEvent :: ClSF GlossM GlossClock () (Maybe Event)
currentEvent = ClSF GlossM GlossClock () (Maybe Event)
ClSF GlossM GlossClock () (Tag GlossClock)
forall (m :: * -> *) cl a. Monad m => ClSF m cl a (Tag cl)
tagS
flowGlossClSF ::
GlossSettings ->
GlossClSF ->
IO ()
flowGlossClSF :: GlossSettings -> GlossClSF -> IO ()
flowGlossClSF GlossSettings
settings GlossClSF
clsf = GlossSettings -> Rhine GlossM GlossClock () () -> IO ()
forall cl.
(Clock GlossM cl, GetClockProxy cl) =>
GlossSettings -> Rhine GlossM cl () () -> IO ()
flowGloss GlossSettings
settings (Rhine GlossM GlossClock () () -> IO ())
-> Rhine GlossM GlossClock () () -> IO ()
forall a b. (a -> b) -> a -> b
$ GlossClSF
clsf GlossClSF
-> Automaton (ReaderT (TimeInfo GlossClock) GlossM) Picture ()
-> Automaton (ReaderT (TimeInfo GlossClock) GlossM) () ()
forall (cat :: * -> * -> *) a b c.
Category cat =>
cat a b -> cat b c -> cat a c
>-> (Picture -> GlossM ())
-> Automaton (ReaderT (TimeInfo GlossClock) GlossM) Picture ()
forall (m :: * -> *) a b cl. Monad m => (a -> m b) -> ClSF m cl a b
arrMCl Picture -> GlossM ()
paintAll Automaton (ReaderT (TimeInfo GlossClock) GlossM) () ()
-> GlossClock -> Rhine GlossM GlossClock () ()
forall cl (m :: * -> *) a b.
(cl ~ In cl, cl ~ Out cl) =>
ClSF m cl a b -> cl -> Rhine m cl a b
@@ GlossClock
GlossClock
type WorldAutomaton = Automaton Identity ((Float, Maybe Event), ()) (Picture, Maybe ())
flowGloss ::
(Clock GlossM cl, GetClockProxy cl) =>
GlossSettings ->
Rhine GlossM cl () () ->
IO ()
flowGloss :: forall cl.
(Clock GlossM cl, GetClockProxy cl) =>
GlossSettings -> Rhine GlossM cl () () -> IO ()
flowGloss GlossSettings {Int
Color
Display
display :: Display
backgroundColor :: Color
stepsPerSecond :: Int
display :: GlossSettings -> Display
backgroundColor :: GlossSettings -> Color
stepsPerSecond :: GlossSettings -> Int
..} Rhine GlossM cl () ()
rhine =
Display
-> Color
-> Int
-> (WorldAutomaton, Picture)
-> ((WorldAutomaton, Picture) -> Picture)
-> (Event
-> (WorldAutomaton, Picture) -> (WorldAutomaton, Picture))
-> (Float
-> (WorldAutomaton, Picture) -> (WorldAutomaton, Picture))
-> IO ()
forall world.
Display
-> Color
-> Int
-> world
-> (world -> Picture)
-> (Event -> world -> world)
-> (Float -> world -> world)
-> IO ()
play Display
display Color
backgroundColor Int
stepsPerSecond (WorldAutomaton
worldAutomaton, Picture
Blank) (WorldAutomaton, Picture) -> Picture
forall {a} {b}. (a, b) -> b
getPic Event -> (WorldAutomaton, Picture) -> (WorldAutomaton, Picture)
handleEvent Float -> (WorldAutomaton, Picture) -> (WorldAutomaton, Picture)
simStep
where
worldAutomaton :: WorldAutomaton
worldAutomaton :: WorldAutomaton
worldAutomaton = Automaton (Writer Picture) ((Float, Maybe Event), ()) (Maybe ())
-> WorldAutomaton
forall (m :: * -> *) w a b.
(Functor m, Monad m) =>
Automaton (WriterT w m) a b -> Automaton m a (w, b)
AutomatonWriter.runWriterS (Automaton (Writer Picture) ((Float, Maybe Event), ()) (Maybe ())
-> WorldAutomaton)
-> Automaton (Writer Picture) ((Float, Maybe Event), ()) (Maybe ())
-> WorldAutomaton
forall a b. (a -> b) -> a -> b
$ Automaton
(ReaderT (Float, Maybe Event) (Writer Picture)) () (Maybe ())
-> Automaton (Writer Picture) ((Float, Maybe Event), ()) (Maybe ())
forall (m :: * -> *) r a b.
Monad m =>
Automaton (ReaderT r m) a b -> Automaton m (r, a) b
AutomatonReader.runReaderS (Automaton
(ReaderT (Float, Maybe Event) (Writer Picture)) () (Maybe ())
-> Automaton
(Writer Picture) ((Float, Maybe Event), ()) (Maybe ()))
-> Automaton
(ReaderT (Float, Maybe Event) (Writer Picture)) () (Maybe ())
-> Automaton (Writer Picture) ((Float, Maybe Event), ()) (Maybe ())
forall a b. (a -> b) -> a -> b
$ (forall x.
GlossM x -> ReaderT (Float, Maybe Event) (Writer Picture) x)
-> Automaton GlossM () (Maybe ())
-> Automaton
(ReaderT (Float, Maybe Event) (Writer Picture)) () (Maybe ())
forall (m :: * -> *) (n :: * -> *) a b.
Monad m =>
(forall x. m x -> n x) -> Automaton m a b -> Automaton n a b
hoistS (YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) x
-> ReaderT (Float, Maybe Event) (Writer Picture) x
forall (m :: * -> *) a. Monad m => YieldT m a -> m a
runYieldT (YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) x
-> ReaderT (Float, Maybe Event) (Writer Picture) x)
-> (GlossM x
-> YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) x)
-> GlossM x
-> ReaderT (Float, Maybe Event) (Writer Picture) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlossM x
-> YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) x
forall a.
GlossM a
-> YieldT (ReaderT (Float, Maybe Event) (Writer Picture)) a
unGlossM) (Automaton GlossM () (Maybe ())
-> Automaton
(ReaderT (Float, Maybe Event) (Writer Picture)) () (Maybe ()))
-> Automaton GlossM () (Maybe ())
-> Automaton
(ReaderT (Float, Maybe Event) (Writer Picture)) () (Maybe ())
forall a b. (a -> b) -> a -> b
$ GlossM (Automaton GlossM () (Maybe ()))
-> Automaton GlossM () (Maybe ())
forall (m :: * -> *) a b.
Monad m =>
m (Automaton m a b) -> Automaton m a b
performOnFirstSample (GlossM (Automaton GlossM () (Maybe ()))
-> Automaton GlossM () (Maybe ()))
-> GlossM (Automaton GlossM () (Maybe ()))
-> Automaton GlossM () (Maybe ())
forall a b. (a -> b) -> a -> b
$ Rhine GlossM cl () () -> GlossM (Automaton GlossM () (Maybe ()))
forall (m :: * -> *) cl a b.
(Monad m, Clock m cl, GetClockProxy cl) =>
Rhine m cl a b -> m (Automaton m a (Maybe b))
eraseClock Rhine GlossM cl () ()
rhine
stepWith :: (Float, Maybe Event) -> (WorldAutomaton, Picture) -> (WorldAutomaton, Picture)
stepWith :: (Float, Maybe Event)
-> (WorldAutomaton, Picture) -> (WorldAutomaton, Picture)
stepWith (Float
diff, Maybe Event
eventMaybe) (WorldAutomaton
automaton, Picture
_) = let Result WorldAutomaton
automaton' (Picture
picture, Maybe ()
_) = Identity (Result WorldAutomaton (Picture, Maybe ()))
-> Result WorldAutomaton (Picture, Maybe ())
forall a. Identity a -> a
runIdentity (Identity (Result WorldAutomaton (Picture, Maybe ()))
-> Result WorldAutomaton (Picture, Maybe ()))
-> Identity (Result WorldAutomaton (Picture, Maybe ()))
-> Result WorldAutomaton (Picture, Maybe ())
forall a b. (a -> b) -> a -> b
$ WorldAutomaton
-> ((Float, Maybe Event), ())
-> Identity (Result WorldAutomaton (Picture, Maybe ()))
forall (m :: * -> *) a b.
Functor m =>
Automaton m a b -> a -> m (Result (Automaton m a b) b)
stepAutomaton WorldAutomaton
automaton ((Float
diff, Maybe Event
eventMaybe), ()) in (WorldAutomaton
automaton', Picture
picture)
getPic :: (a, b) -> b
getPic (a
_, b
pic) = b
pic
handleEvent :: Event -> (WorldAutomaton, Picture) -> (WorldAutomaton, Picture)
handleEvent Event
event = (Float, Maybe Event)
-> (WorldAutomaton, Picture) -> (WorldAutomaton, Picture)
stepWith (Float
0, Event -> Maybe Event
forall a. a -> Maybe a
Just Event
event)
simStep :: Float -> (WorldAutomaton, Picture) -> (WorldAutomaton, Picture)
simStep Float
diff = (Float, Maybe Event)
-> (WorldAutomaton, Picture) -> (WorldAutomaton, Picture)
stepWith (Float
diff, Maybe Event
forall a. Maybe a
Nothing)