diff --git a/Graphics/Command.hs b/Graphics/Command.hs new file mode 100644 index 0000000..ff61936 --- /dev/null +++ b/Graphics/Command.hs @@ -0,0 +1,17 @@ +module Graphics.Command where + +import FRP.Yampa (Time, Event) + +data Command + = Resize (Int, Int) + | ChangeSpeed (Time -> Time) + +getResize :: Command -> Maybe (Int, Int) +getResize (Resize size) = Just size +getResize _ = Nothing + +getChangeSpeed :: Command -> Maybe (Time -> Time) +getChangeSpeed (ChangeSpeed f) = Just f +getChangeSpeed _ = Nothing + +type CommandEvent = Event Command \ No newline at end of file diff --git a/Graphics/Config.hs b/Graphics/Config.hs deleted file mode 100644 index 4ec0d6e..0000000 --- a/Graphics/Config.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Graphics.Config where - -import FRP.Yampa (Time) -import GOL.Rule -import Graphics.Gloss (Color, white) - -data Config = Config - { rule :: Rule, - tickPeriod :: Time, - cellColor :: Color, - windowSize :: (Int, Int) - } - -defaultConfig :: Config -defaultConfig = Config standardRule 0.2 white (500, 500) \ No newline at end of file diff --git a/Graphics/Display.hs b/Graphics/Display.hs index 960f26a..4ee75a4 100644 --- a/Graphics/Display.hs +++ b/Graphics/Display.hs @@ -6,7 +6,6 @@ module Graphics.Display where import Control.Monad.Representable.Reader import Data.Maybe (mapMaybe) import GOL.Space -import Graphics.Config import Graphics.Gloss -- * Drawing the display grid @@ -28,9 +27,8 @@ drawCells xs size = let poss = (,) <$> [0 .. sizex @f -1] <*> [0 .. sizey @f -1] in mapMaybe (\pos -> drawCell xs pos size) poss -drawGrid :: forall f. DisplayableSpace f => Config -> f Bool -> Picture -drawGrid config xs = - let (w, h) = windowSize config - size = fromIntegral $ if w > h then h `div` sizey @f else w `div` sizex @f +drawGrid :: forall f. DisplayableSpace f => (Int, Int) -> Color -> f Bool -> Picture +drawGrid (w, h) c xs = + let size = fromIntegral $ if w > h then h `div` sizey @f else w `div` sizex @f in translate (fromIntegral $ -w `div` 2) (fromIntegral $ -h `div` 2) $ - color (cellColor config) $ pictures $ drawCells xs size \ No newline at end of file + color c $ pictures $ drawCells xs size \ No newline at end of file diff --git a/Graphics/Engine.hs b/Graphics/Engine.hs index 1c79f64..64e5345 100644 --- a/Graphics/Engine.hs +++ b/Graphics/Engine.hs @@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE Arrows #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -11,7 +12,7 @@ import FRP.Yampa import GOL.Engine import GOL.Rule import GOL.Space -import Graphics.Config +import Graphics.Command import Graphics.Display (drawGrid) import Graphics.Gloss import Graphics.Gloss.Interface.IO.Game hiding (Event) @@ -34,15 +35,23 @@ tickSignal = arr (\ev -> ((), fmap repeatTick ev)) >>> drSwitch (repeatTick 0.2) -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 +processEvent :: InputEvent -> CommandEvent +processEvent = event noEvent $ \case + EventKey (Char '-') Down _ _ -> Event $ ChangeSpeed (* 1.25) + EventKey (Char '+') Down _ _ -> Event $ ChangeSpeed (* 0.8) + EventKey {} -> noEvent + EventMotion {} -> noEvent + EventResize size -> Event $ Resize size run :: forall f. DisplayableSpace f => f Bool -> SF InputEvent Picture -run st = proc ev -> do - c <- accum defaultConfig -< fmap processEvent ev - c' <- hold defaultConfig -< c - t <- tickSignal -< fmap tickPeriod c - s <- engine (gol' standardRule st) -< t - identity -< drawGrid c' (getSpace s) \ No newline at end of file +run st = + let initSpace = gol' standardRule st + in proc inp -> do + let cmdev = processEvent inp + + time <- accum 0.2 -< mapFilterE getChangeSpeed cmdev + windowSize <- hold (100, 100) -< mapFilterE getResize cmdev + + space <- engine initSpace <<< tickSignal -< time + + returnA -< drawGrid windowSize white (getSpace space) \ No newline at end of file diff --git a/conways-game-of-life.cabal b/conways-game-of-life.cabal index 2c24031..d15a9fb 100644 --- a/conways-game-of-life.cabal +++ b/conways-game-of-life.cabal @@ -12,7 +12,7 @@ executable gol GOL.Space, GOL.Engine, Graphics.GlossUtils, - Graphics.Config, + Graphics.Command, Graphics.Engine, Graphics.Display build-depends: base,