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

Create master run function

Browse source
This commit is contained in:
Kiana Sheibani 2021-12-28 16:40:48 -05:00
parent 156a338d48
commit 64fd7d3afc
3 changed files with 26 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
Graphics/Config.hs
View file

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

21
Graphics/Engine.hs
View file

@ -1,4 +1,5 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
module Graphics.Engine where module Graphics.Engine where
import Control.Arrow import Control.Arrow
@ -8,24 +9,32 @@ import GOL.Engine
import GOL.Space import GOL.Space
import Graphics.Config import Graphics.Config
import Graphics.Gloss import Graphics.Gloss
import Graphics.GlossUtils (InputEvent)
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
import Graphics.GlossUtils (InputEvent)
data Tick = Tick type TickEvent = Event ()
initialSpace :: Space f => f Bool initialSpace :: Space f => f Bool
initialSpace = tabulate $ const False 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) engine = accumHoldBy (\s _ -> tick s)
defaultPeriod = 0.5 defaultPeriod = 0.5
repeatTick :: Time -> SF a (Event Tick) repeatTick :: Time -> SF a TickEvent
repeatTick t = repeatedly t Tick repeatTick t = repeatedly t ()
tickSignal :: SF (Event Time) (Event Tick) tickSignal :: SF (Event Time) TickEvent
tickSignal = tickSignal =
arr (\ev -> ((), fmap repeatTick ev)) arr (\ev -> ((), fmap repeatTick ev))
>>> drSwitch (repeatTick defaultPeriod) >>> 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

4
Graphics/GlossUtils.hs
View file

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