{-# LANGUAGE RecordWildCards #-}
module FRP.Rhine.Gloss.Pure.Combined where
import FRP.Rhine
import FRP.Rhine.Gloss.Common
import FRP.Rhine.Gloss.Pure
type GlossCombinedClock a =
SequentialClock
(GlossEventClock a)
GlossSimulationClock
type GlossEventClock a = SelectClock GlossClock a
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 = (Maybe Event -> (Event -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Event -> Maybe a
selector)
}
glossEventClock :: GlossEventClock Event
glossEventClock :: GlossEventClock Event
glossEventClock = (Event -> Maybe Event) -> GlossEventClock Event
forall a. (Event -> Maybe a) -> GlossEventClock a
glossEventSelectClock Event -> Maybe Event
forall a. a -> Maybe a
Just
type GlossSimulationClock = SelectClock GlossClock ()
glossSimulationClock :: GlossSimulationClock
glossSimulationClock :: GlossSimulationClock
glossSimulationClock = SelectClock {GlossClock
Maybe Event -> Maybe ()
Tag GlossClock -> Maybe ()
forall {a}. Maybe a -> Maybe ()
mainClock :: GlossClock
select :: Tag GlossClock -> Maybe ()
mainClock :: GlossClock
select :: forall {a}. Maybe a -> Maybe ()
..}
where
mainClock :: GlossClock
mainClock = GlossClock
GlossClock
select :: Maybe a -> Maybe ()
select (Just a
_event) = Maybe ()
forall a. Maybe a
Nothing
select Maybe a
Nothing = () -> Maybe ()
forall a. a -> Maybe a
Just ()
type GlossRhine a = Rhine GlossM (GlossCombinedClock a) () ()
buildGlossRhine ::
(Event -> Maybe a) ->
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 =
(TimeInfo (GlossEventClock a) -> a)
-> ClSF GlossM (GlossEventClock a) () a
forall (m :: * -> *) cl b a.
Monad m =>
(TimeInfo cl -> b) -> ClSF m cl a b
timeInfoOf TimeInfo (GlossEventClock a) -> a
TimeInfo (GlossEventClock a) -> Tag (GlossEventClock a)
forall cl. TimeInfo cl -> Tag cl
tag ClSF GlossM (GlossEventClock a) () a
-> GlossEventClock a -> Rhine GlossM (GlossEventClock a) () a
forall cl (m :: * -> *) a b.
(cl ~ In cl, cl ~ Out cl) =>
ClSF m cl a b -> cl -> Rhine m cl a b
@@ (Event -> Maybe a) -> GlossEventClock a
forall a. (Event -> Maybe a) -> GlossEventClock a
glossEventSelectClock Event -> Maybe a
selector
Rhine GlossM (GlossEventClock a) () a
-> ResamplingBuffer
GlossM (Out (GlossEventClock a)) GlossSimulationClock a [a]
-> RhineAndResamplingBuffer
GlossM (GlossEventClock a) GlossSimulationClock () [a]
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
>-- ResamplingBuffer
GlossM (Out (GlossEventClock a)) GlossSimulationClock a [a]
ResamplingBuffer
GlossM (GlossEventClock a) GlossSimulationClock a [a]
forall (m :: * -> *) cl1 cl2 a.
Monad m =>
ResamplingBuffer m cl1 cl2 a [a]
collect
RhineAndResamplingBuffer
GlossM (GlossEventClock a) GlossSimulationClock () [a]
-> Rhine GlossM GlossSimulationClock [a] ()
-> Rhine
GlossM
(SequentialClock (GlossEventClock a) GlossSimulationClock)
()
()
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 ClSF GlossM GlossSimulationClock [a] ()
-> GlossSimulationClock -> Rhine GlossM GlossSimulationClock [a] ()
forall cl (m :: * -> *) a b.
(cl ~ In cl, cl ~ Out cl) =>
ClSF m cl a b -> cl -> Rhine m cl a b
@@ GlossSimulationClock
glossSimulationClock