Create master run function

Graphics/Config.hs

@@ -1,12 +1,15 @@
 module Graphics.Config where
 
 import FRP.Yampa (Time)
-import GOL.Rule (Rule)
-import Graphics.Gloss (Color)
+import GOL.Rule
+import Graphics.Gloss (Color, white)
 
 data Config = Config
-  { cellColor :: Color,
-    rule :: Rule,
-    tickRate :: Time,
+  { rule :: Rule,
+    tickPeriod :: Time,
+    cellColor :: Color,
     windowSize :: (Int, Int)
-  }
+  }
+
+defaultConfig :: Config
+defaultConfig = Config standardRule 1.0 white (500, 500)

Graphics/Engine.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+
 module Graphics.Engine where
 
 import Control.Arrow
@@ -8,24 +9,32 @@ import GOL.Engine
 import GOL.Space
 import Graphics.Config
 import Graphics.Gloss
-import Graphics.GlossUtils (InputEvent)
 import Graphics.Gloss.Interface.IO.Game hiding (Event)
 import qualified Graphics.Gloss.Interface.IO.Game as G
+import Graphics.GlossUtils (InputEvent)
 
-data Tick = Tick
+type TickEvent = Event ()
 
 initialSpace :: Space f => f Bool
 initialSpace = tabulate $ const False
 
-engine :: Space f => GOL f Bool -> SF (Event Tick) (GOL f Bool)
+engine :: Space f => GOL f Bool -> SF TickEvent (GOL f Bool)
 engine = accumHoldBy (\s _ -> tick s)
 
 defaultPeriod = 0.5
 
-repeatTick :: Time -> SF a (Event Tick)
-repeatTick t = repeatedly t Tick
+repeatTick :: Time -> SF a TickEvent
+repeatTick t = repeatedly t ()
 
-tickSignal :: SF (Event Time) (Event Tick)
+tickSignal :: SF (Event Time) TickEvent
 tickSignal =
   arr (\ev -> ((), fmap repeatTick ev))
     >>> drSwitch (repeatTick defaultPeriod)
+
+run :: SF InputEvent Picture
+run = arr (fmap processEvent) >>> accum defaultConfig >>> ()
+  where
+    processEvent :: G.Event -> Config -> Config
+    processEvent (EventKey (Char '-') Down _ _) c = c {tickPeriod = tickPeriod c * 0.8}
+    processEvent (EventResize s) c = c {windowSize = s}
+    processEvent _ c = c

Graphics/GlossUtils.hs

@@ -25,7 +25,7 @@ import qualified Graphics.Gloss
 import Graphics.Gloss.Interface.IO.Game (playIO)
 import qualified Graphics.Gloss.Interface.IO.Game as G
 
-type InputEvent = G.Event
+type InputEvent = Event G.Event
 
 playYampa ::
   -- | The display method
@@ -34,7 +34,7 @@ playYampa ::
   Color ->
   -- | The refresh rate, in Hertz
   Int ->
-  SF (Event InputEvent) Picture ->
+  SF InputEvent Picture ->
   IO ()
 playYampa display color frequency mainSF = do
   picRef <- newIORef blank