From ed1deaef5f567350ef14390231deb699a45270c4 Mon Sep 17 00:00:00 2001 From: kiana-S Date: Tue, 28 Dec 2021 18:16:51 -0500 Subject: [PATCH] Create prototype run function --- Graphics/Engine.hs | 30 +++++++++++++++++++----------- Main.hs | 10 +++++++++- 2 files changed, 28 insertions(+), 12 deletions(-) diff --git a/Graphics/Engine.hs b/Graphics/Engine.hs index 6122b5b..1f00766 100644 --- a/Graphics/Engine.hs +++ b/Graphics/Engine.hs @@ -1,4 +1,7 @@ -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Graphics.Engine where @@ -6,8 +9,10 @@ import Control.Arrow import Control.Monad.Representable.Reader import FRP.Yampa import GOL.Engine +import GOL.Rule import GOL.Space import Graphics.Config +import Graphics.Display (drawGrid) import Graphics.Gloss import Graphics.Gloss.Interface.IO.Game hiding (Event) 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 = accumHoldBy (\s _ -> tick s) -defaultPeriod = 0.5 - repeatTick :: Time -> SF a TickEvent repeatTick t = repeatedly t () tickSignal :: SF (Event Time) TickEvent tickSignal = 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 (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 +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 + +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)) \ No newline at end of file diff --git a/Main.hs b/Main.hs index 33c67b6..27e9f9c 100644 --- a/Main.hs +++ b/Main.hs @@ -1,5 +1,13 @@ 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 = putStrLn "Hello" +main = playYampa (InWindow "a" (2, 2) (2, 2)) black 30 (run space) \ No newline at end of file