Create prototype run function

Graphics/Engine.hs

@@ -1,4 +1,7 @@
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Graphics.Engine where
 
@@ -6,8 +9,10 @@ import Control.Arrow
 import Control.Monad.Representable.Reader
 import FRP.Yampa
 import GOL.Engine
+import GOL.Rule
 import GOL.Space
 import Graphics.Config
+import Graphics.Display (drawGrid)
 import Graphics.Gloss
 import Graphics.Gloss.Interface.IO.Game hiding (Event)
 import qualified Graphics.Gloss.Interface.IO.Game as G
@@ -21,20 +26,23 @@ initialSpace = tabulate $ const False
 engine :: Space f => GOL f Bool -> SF TickEvent (GOL f Bool)
 engine = accumHoldBy (\s _ -> tick s)
 
-defaultPeriod = 0.5
-
 repeatTick :: Time -> SF a TickEvent
 repeatTick t = repeatedly t ()
 
 tickSignal :: SF (Event Time) TickEvent
 tickSignal =
   arr (\ev -> ((), fmap repeatTick ev))
-    >>> drSwitch (repeatTick defaultPeriod)
+    >>> drSwitch (repeatTick 0.5)
 
-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
+
+run :: forall f. DisplayableSpace f => f Bool -> SF InputEvent Picture
+run st =
+  (arr . fmap) processEvent
+    >>> accum defaultConfig
+    >>> identity &&& (arr . fmap) tickPeriod
+    >>> hold defaultConfig *** (tickSignal >>> engine @f (gol' standardRule st))
+    >>> arr (\(c, s) -> drawGrid @f c (getSpace s))

Main.hs

@@ -1,5 +1,13 @@
 module Main where
 
+import Control.Monad.Representable.Reader
+import GOL.Space
+import Graphics.Engine (initialSpace, run)
+import Graphics.Gloss
+import Graphics.GlossUtils (playYampa)
+
+space :: ToroidalSpace Bool
+space = tabulate (\(x,y) -> (x + y `mod` 5) * 10 + x - y > 30)
 
 main :: IO ()
-main = putStrLn "Hello"
+main = playYampa (InWindow "a" (2, 2) (2, 2)) black 30 (run space)