diff --git a/Graphics/Config.hs b/Graphics/Config.hs index 3add0d8..d83f2db 100644 --- a/Graphics/Config.hs +++ b/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) - } \ No newline at end of file + } + +defaultConfig :: Config +defaultConfig = Config standardRule 1.0 white (500, 500) \ No newline at end of file diff --git a/Graphics/Engine.hs b/Graphics/Engine.hs index f5382c0..6122b5b 100644 --- a/Graphics/Engine.hs +++ b/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 \ No newline at end of file diff --git a/Graphics/GlossUtils.hs b/Graphics/GlossUtils.hs index e706467..3ee8166 100644 --- a/Graphics/GlossUtils.hs +++ b/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