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

Create prototype run function

Browse source
This commit is contained in:
Kiana Sheibani 2021-12-28 18:16:51 -05:00
parent 42ec44a6f8
commit ed1deaef5f
2 changed files with 28 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
Graphics/Engine.hs
View file

@ -1,4 +1,7 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Graphics.Engine where module Graphics.Engine where
@ -6,8 +9,10 @@ import Control.Arrow
import Control.Monad.Representable.Reader import Control.Monad.Representable.Reader
import FRP.Yampa import FRP.Yampa
import GOL.Engine import GOL.Engine
import GOL.Rule
import GOL.Space import GOL.Space
import Graphics.Config import Graphics.Config
import Graphics.Display (drawGrid)
import Graphics.Gloss import Graphics.Gloss
import Graphics.Gloss.Interface.IO.Game hiding (Event) import Graphics.Gloss.Interface.IO.Game hiding (Event)
import qualified Graphics.Gloss.Interface.IO.Game as G 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 :: Space f => GOL f Bool -> SF TickEvent (GOL f Bool)
engine = accumHoldBy (\s _ -> tick s) engine = accumHoldBy (\s _ -> tick s)
defaultPeriod = 0.5
repeatTick :: Time -> SF a TickEvent repeatTick :: Time -> SF a TickEvent
repeatTick t = repeatedly t () 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 defaultPeriod) >>> drSwitch (repeatTick 0.5)
run :: SF InputEvent Picture
run = arr (fmap processEvent) >>> accum defaultConfig >>> ()
where
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}
processEvent (EventResize s) c = c {windowSize = s} processEvent (EventResize s) c = c {windowSize = s}
processEvent _ c = c 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))

10
Main.hs
View file

@ -1,5 +1,13 @@
module Main where 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 :: IO ()
main = putStrLn "Hello" main = playYampa (InWindow "a" (2, 2) (2, 2)) black 30 (run space)