{-# LANGUAGE RecordWildCards #-}

{- | A pure @gloss@ backend for Rhine,
with separated event and simulation loop.

To run pure Rhine apps with @gloss@,
write a signal network ('SN') in the 'GlossCombinedClock' and use 'flowGlossCombined'.
As an easy starter, you can use the helper function 'buildGlossRhine'.
-}
module FRP.Rhine.Gloss.Pure.Combined where

-- rhine
import FRP.Rhine

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

{- | The overall clock of a pure @rhine@ 'SN' that can be run by @gloss@.
   It is combined of two subsystems, the event part and the simulation part.
   @a@ is the type of subevents that are selected.
-}
type GlossCombinedClock a =
  SequentialClock
    (GlossEventClock a)
    GlossSimulationClock

-- ** Events

-- | The clock that ticks whenever a specific @gloss@ event occurs.
type GlossEventClock a = SelectClock GlossClock a

{- | Select the relevant events by converting them to @Just a@,
   and the irrelevant ones to 'Nothing'.
-}
glossEventSelectClock ::
  (Event -> Maybe a) ->
  GlossEventClock a
glossEventSelectClock :: forall a. (Event -> Maybe a) -> GlossEventClock a
glossEventSelectClock Event -> Maybe a
selector =
  SelectClock
    { mainClock :: GlossClock
mainClock = GlossClock
GlossClock
    , select :: Tag GlossClock -> Maybe a
select = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Event -> Maybe a
selector)
    }

-- | Tick on every event.
glossEventClock :: GlossEventClock Event
glossEventClock :: GlossEventClock Event
glossEventClock = forall a. (Event -> Maybe a) -> GlossEventClock a
glossEventSelectClock forall a. a -> Maybe a
Just

-- ** Simulation

-- | The clock that ticks for every @gloss@ simulation step.
type GlossSimulationClock = SelectClock GlossClock ()

glossSimulationClock :: GlossSimulationClock
glossSimulationClock :: GlossSimulationClock
glossSimulationClock = SelectClock {GlossClock
forall {a}. Maybe a -> Maybe ()
select :: forall {a}. Maybe a -> Maybe ()
mainClock :: GlossClock
select :: Tag GlossClock -> Maybe ()
mainClock :: GlossClock
..}
  where
    mainClock :: GlossClock
mainClock = GlossClock
GlossClock
    select :: Maybe a -> Maybe ()
select (Just a
_event) = forall a. Maybe a
Nothing
    select Maybe a
Nothing = forall a. a -> Maybe a
Just ()

-- * Signal networks

{- |
The type of a valid 'Rhine' that can be run by @gloss@,
if you chose to separate events and simulation into two subsystems.
@a@ is the type of subevents that are selected.

All painting has to be done in 'GlossM', e.g. via the 'paint' method.

Typically, such a 'Rhine' is built something like this:

@
-- | Select only key press events
myEventClock :: GlossEventClock Key
myEventClock = glossEventSelectClock selector
  where
    selector (EventKey key _ _ _) = Just key
    selector _ = Nothing

myEventSubsystem :: ClSF GlossM GlossEventClock () MyType
myEventSubsystem = ...

mySim :: ClSF GlossM GlossSimulationClock [MyType] ()
mySim = ...

myGlossRhine :: GlossRhine a
myGlossRhine
  = myEventSubsystem @@ myEventClock >-- collect --> mySim @@ glossSimulationClock
@
-}
type GlossRhine a = Rhine GlossM (GlossCombinedClock a) () ()

{- | For most applications, it is sufficient to implement
a single signal function
that is called with a list of all relevant events
that occurred in the last tick.
-}
buildGlossRhine ::
  -- | The event selector
  (Event -> Maybe a) ->
  -- | The 'ClSF' representing the game loop.
  ClSF GlossM GlossSimulationClock [a] () ->
  GlossRhine a
buildGlossRhine :: forall a.
(Event -> Maybe a)
-> ClSF GlossM GlossSimulationClock [a] () -> GlossRhine a
buildGlossRhine Event -> Maybe a
selector ClSF GlossM GlossSimulationClock [a] ()
clsfSim =
  forall (m :: * -> *) cl b a.
Monad m =>
(TimeInfo cl -> b) -> ClSF m cl a b
timeInfoOf forall cl. TimeInfo cl -> Tag cl
tag forall cl (m :: * -> *) a b.
(cl ~ In cl, cl ~ Out cl) =>
ClSF m cl a b -> cl -> Rhine m cl a b
@@ forall a. (Event -> Maybe a) -> GlossEventClock a
glossEventSelectClock Event -> Maybe a
selector
    forall (m :: * -> *) cl1 a b inCl2 c.
Rhine m cl1 a b
-> ResamplingBuffer m (Out cl1) inCl2 b c
-> RhineAndResamplingBuffer m cl1 inCl2 a c
>-- forall (m :: * -> *) cl1 cl2 a.
Monad m =>
ResamplingBuffer m cl1 cl2 a [a]
collect
    forall (m :: * -> *) cl1 cl2 inCl2 a b c.
(Clock m cl1, Clock m cl2, Time cl1 ~ Time cl2,
 Time (Out cl1) ~ Time cl1, Time (In cl2) ~ Time cl2,
 Clock m (Out cl1), Clock m (Out cl2), Clock m (In cl1),
 Clock m (In cl2), In cl2 ~ inCl2, GetClockProxy cl1,
 GetClockProxy cl2) =>
RhineAndResamplingBuffer m cl1 inCl2 a b
-> Rhine m cl2 b c -> Rhine m (SequentialClock cl1 cl2) a c
--> ClSF GlossM GlossSimulationClock [a] ()
clsfSim forall cl (m :: * -> *) a b.
(cl ~ In cl, cl ~ Out cl) =>
ClSF m cl a b -> cl -> Rhine m cl a b
@@ GlossSimulationClock
glossSimulationClock