toki/conways-game-of-life
1
0
Fork 0
Code Issues Pull requests Activity

Use arrow notation for signal funcitons

Browse source
This commit is contained in:
Kiana Sheibani 2021-12-28 22:55:46 -05:00
parent 3cdb121ed3
commit d31cdc6057
2 changed files with 9 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Graphics/Config.hs
View file

@ -12,4 +12,4 @@ data Config = Config
} }
defaultConfig :: Config defaultConfig :: Config
defaultConfig = Config standardRule 1.0 white (500, 500) defaultConfig = Config standardRule 0.2 white (500, 500)

16
Graphics/Engine.hs
View file

@ -1,7 +1,7 @@
{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Graphics.Engine where module Graphics.Engine where
@ -32,7 +32,7 @@ repeatTick t = repeatedly t ()
tickSignal :: SF (Event Time) TickEvent tickSignal :: SF (Event Time) TickEvent
tickSignal = tickSignal =
arr (\ev -> ((), fmap repeatTick ev)) arr (\ev -> ((), fmap repeatTick ev))
>>> drSwitch (repeatTick 0.5) >>> drSwitch (repeatTick 0.2)
processEvent :: G.Event -> Config -> Config processEvent :: G.Event -> Config -> Config
processEvent (EventKey (Char '-') Down _ _) c = c {tickPeriod = tickPeriod c * 0.8} processEvent (EventKey (Char '-') Down _ _) c = c {tickPeriod = tickPeriod c * 0.8}
@ -40,9 +40,9 @@ processEvent (EventResize s) c = c {windowSize = s}
processEvent _ c = c processEvent _ c = c
run :: forall f. DisplayableSpace f => f Bool -> SF InputEvent Picture run :: forall f. DisplayableSpace f => f Bool -> SF InputEvent Picture
run st = run st = proc ev -> do
(arr . fmap) processEvent c <- accum defaultConfig -< fmap processEvent ev
>>> accum defaultConfig c' <- hold defaultConfig -< c
>>> identity &&& (arr . fmap) tickPeriod t <- tickSignal -< fmap tickPeriod c
>>> hold defaultConfig *** (tickSignal >>> engine @f (gol' standardRule st)) s <- engine (gol' standardRule st) -< t
>>> arr (\(c, s) -> drawGrid @f c (getSpace s)) identity -< drawGrid c' (getSpace s)