{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

{- | A pure @gloss@ backend for Rhine.

To run pure Rhine apps with @gloss@,
write a clocked signal function ('ClSF') in the 'GlossClock' and use 'flowGloss'.
-}
module FRP.Rhine.Gloss.Pure (
  GlossM,
  paint,
  clear,
  paintAll,
  GlossClock (..),
  GlossClSF,
  currentEvent,
  flowGloss,
  flowGlossClSF,
) where

-- base
import qualified Control.Category as Category
import Data.Functor.Identity

-- transformers
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Writer.Strict

-- monad-schedule
import Control.Monad.Schedule.Class
import Control.Monad.Schedule.Yield

-- automaton
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 (..))

-- rhine
import FRP.Rhine

-- rhine-gloss
import FRP.Rhine.Gloss.Common

-- * @gloss@ effects

-- | A pure monad in which all effects caused by the @gloss@ backend take place.
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)

-- Would have liked to make this a derived instance, but for some reason deriving gets thrown off by the newtype
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

-- | Add a picture to the canvas.
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

-- FIXME This doesn't what you think it does

-- | Clear the canvas.
clear :: GlossM ()
clear :: GlossM ()
clear = Picture -> GlossM ()
paint Picture
Blank

-- | Clear the canvas and then paint.
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

-- * Clocks

{- | The overall clock of a pure @rhine@ 'ClSF' that can be run by @gloss@.
   It ticks both on events (@tag = Just Event@) and simulation steps (@tag = Nothing@).
-}
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

-- * Signal functions

{- |
The type of a 'ClSF' you can implement to get a @gloss@ app,
if you chose to handle events and simulation steps in the same subsystem.

You can, but don't need to paint via 'GlossM':
You can also simply output the picture and it will be painted on top.
-}
type GlossClSF = ClSF GlossM GlossClock () Picture

{- | Observe whether there was an event this tick,
   and which one.
-}
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

-- * Reactimation

-- | Specialisation of 'flowGloss' to a 'GlossClSF'
flowGlossClSF ::
  GlossSettings ->
  -- | The @gloss@-compatible 'ClSF'.
  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 ())

-- | The main function that will start the @gloss@ backend and run the 'Rhine'
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)