Create master run function

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

View file

@ -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)

View file

@ -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

View file

@ -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