From 079294e2df3a8cb3f72931dd920cda7037bdfdba Mon Sep 17 00:00:00 2001
From: Kiana Sheibani <kiana.a.sheibani@gmail.com>
Date: Wed, 25 Jan 2023 15:49:42 -0500
Subject: [PATCH 01/10] Fix orientation error

---
 src/Game/State.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Game/State.hs b/src/Game/State.hs
index 0dd6f38..8039bd8 100644
--- a/src/Game/State.hs
+++ b/src/Game/State.hs
@@ -3,8 +3,8 @@ module Game.State where
 data Direction = U | D | L | R
 
 movePos :: Direction -> (Int, Int) -> (Int, Int)
-movePos U (x, y) = (x, y - 1)
-movePos D (x, y) = (x, y + 1)
+movePos U (x, y) = (x, y + 1)
+movePos D (x, y) = (x, y - 1)
 movePos L (x, y) = (x - 1, y)
 movePos R (x, y) = (x + 1, y)
 

From c449d1e892422d5bb33e356c9cc0c2bde4598b22 Mon Sep 17 00:00:00 2001
From: Kiana Sheibani <kiana.a.sheibani@gmail.com>
Date: Wed, 25 Jan 2023 15:49:49 -0500
Subject: [PATCH 02/10] Write doc comments

---
 src/Game/Engine.hs | 5 +++--
 src/Game/Utils.hs  | 7 +++++++
 2 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/src/Game/Engine.hs b/src/Game/Engine.hs
index 67d4807..073bc69 100644
--- a/src/Game/Engine.hs
+++ b/src/Game/Engine.hs
@@ -45,10 +45,11 @@ tick =
 
 mainSF :: Monad m => MSF (DrawerT m) () ()
 mainSF = proc () -> do
+  -- A "tick" is each frame that the snake advances
   n <- count -< ()
-  let isTick = n `mod` 20 == 1
+  let isTick = n `mod` 8 == 1
 
-  -- handle inputs (buffer)
+  -- Handle inputs (buffer)
   dirs <- handleEvents -< ()
   dir <- fifoGate -< (dirs, isTick)
 
diff --git a/src/Game/Utils.hs b/src/Game/Utils.hs
index 443e29a..8f172aa 100644
--- a/src/Game/Utils.hs
+++ b/src/Game/Utils.hs
@@ -10,6 +10,11 @@ import Graphics.Gloss.Interface.IO.Game
 
 -- | Display an MSF outputting a picture value as a window using Gloss.
 -- Note that the MSF is not passed a real-time clock.
+--
+-- The MSF is always called at a consistent framerate, regardless of when input
+-- events are registered. It is passed a buffered list of all events that
+-- occured between the last and current frames, with the first event in the
+-- list being the latest.
 playMSF :: Display -> Color -> Int -> MSF IO [Event] Picture -> IO ()
 playMSF display color freq msf = do
   -- `react` doesn't allow inputs or outputs, so we have to use IORefs
@@ -52,6 +57,8 @@ hold =
         Just x' -> (x', x')
     )
 
+-- | Buffers and returns the elements in FIFO order, only allowing elements to
+-- shift out whenever the input boolean is true.
 fifoGate :: Monad m => MSF m ([a], Bool) (Maybe a)
 fifoGate =
   mealy

From 9da1dee6bca082f9d9241fb316371fa59bea40ed Mon Sep 17 00:00:00 2001
From: Kiana Sheibani <kiana.a.sheibani@gmail.com>
Date: Sat, 28 Jan 2023 16:07:19 -0500
Subject: [PATCH 03/10] Separate pure game logic from tick function

---
 src/Game/Engine.hs | 44 +++++++++++++++++++++++++++++---------------
 src/Game/State.hs  |  2 +-
 src/Game/Utils.hs  |  4 ++++
 3 files changed, 34 insertions(+), 16 deletions(-)

diff --git a/src/Game/Engine.hs b/src/Game/Engine.hs
index 073bc69..80455d4 100644
--- a/src/Game/Engine.hs
+++ b/src/Game/Engine.hs
@@ -4,6 +4,7 @@
 
 module Game.Engine where
 
+import Control.Monad.Trans.MSF.Maybe
 import Control.Monad.Trans.MSF.Reader
 import Control.Monad.Trans.MSF.Writer
 import Data.Maybe
@@ -30,27 +31,40 @@ handleEvents = mapMaybe getDir <$> liftTransS (constM ask)
       _ -> Nothing
     getDir _ = Nothing
 
-tick :: Monad m => MSF (DrawerT m) (Maybe Direction) GameState
-tick =
-  next initialState $
-    mealy
-      ( \input state ->
-          let moveDir = setDir state.moveDir input
-              snakePos = movePos moveDir <$> state.snakePos
-              berryPos = state.berryPos
-              newstate = GameState {..}
-           in (newstate, newstate)
-      )
-      initialState
 
-mainSF :: Monad m => MSF (DrawerT m) () ()
+tickState :: Maybe Direction -> GameState -> Maybe GameState
+tickState dir state =
+  let moveDir = setDir state.moveDir dir
+      newBlock = movePos moveDir $ head state.snakePos
+      hitBerry = newBlock == state.berryPos
+      snakePos =
+        newBlock
+          : if hitBerry
+            then state.snakePos
+            else init state.snakePos
+      isHit = head snakePos `notElem` tail snakePos
+      berryPos =
+        if hitBerry
+          then
+            ( (fst state.berryPos * 80 `div` 3) `mod` 15,
+              (snd state.berryPos * 75 `div` 6) `mod` 15
+            )
+          else state.berryPos
+   in guard isHit $> GameState {..}
+
+tick :: Monad m => MSF (MaybeT (DrawerT m)) (Maybe Direction) GameState
+tick = feedback initialState $ proc (dir, state) -> do
+  newstate <- maybeExit -< tickState dir state
+  returnA -< (newstate, newstate)
+
+mainSF :: Monad m => MSF (MaybeT (DrawerT m)) () ()
 mainSF = proc () -> do
   -- A "tick" is each frame that the snake advances
   n <- count -< ()
   let isTick = n `mod` 8 == 1
 
   -- Handle inputs (buffer)
-  dirs <- handleEvents -< ()
+  dirs <- liftTransS handleEvents -< ()
   dir <- fifoGate -< (dirs, isTick)
 
   state' <-
@@ -61,4 +75,4 @@ mainSF = proc () -> do
   state <- hold undefined -< state'
 
   -- Display the current state
-  displayState -< state
+  liftTransS displayState -< state
diff --git a/src/Game/State.hs b/src/Game/State.hs
index 8039bd8..126205d 100644
--- a/src/Game/State.hs
+++ b/src/Game/State.hs
@@ -26,4 +26,4 @@ data GameState = GameState
   }
 
 initialState :: GameState
-initialState = GameState [(4, 4)] R (3, 3)
+initialState = GameState [(4, 5), (4, 4), (5, 4)] R (3, 3)
diff --git a/src/Game/Utils.hs b/src/Game/Utils.hs
index 8f172aa..c6aa297 100644
--- a/src/Game/Utils.hs
+++ b/src/Game/Utils.hs
@@ -1,5 +1,6 @@
 module Game.Utils where
 
+import Control.Monad.Trans.MSF.Maybe
 import Control.Monad.Trans.MSF.Reader
 import Control.Monad.Trans.MSF.Writer
 import Data.IORef
@@ -71,3 +72,6 @@ fifoGate =
   where
     safeSnoc [] = (Nothing, [])
     safeSnoc (x : xs) = (Just x, xs)
+
+loopMaybe :: Monad m => MSF (MaybeT m) a b -> MSF m a b
+loopMaybe msf = msf `catchMaybe` loopMaybe msf

From 0f54f532f0412acaefca3f66d2f4b48232944334 Mon Sep 17 00:00:00 2001
From: Kiana Sheibani <kiana.a.sheibani@gmail.com>
Date: Sat, 28 Jan 2023 16:07:41 -0500
Subject: [PATCH 04/10] Separate key-getting function from event handler

---
 src/Game/Engine.hs | 36 +++++++++++++++++++++++-------------
 1 file changed, 23 insertions(+), 13 deletions(-)

diff --git a/src/Game/Engine.hs b/src/Game/Engine.hs
index 80455d4..28c57b8 100644
--- a/src/Game/Engine.hs
+++ b/src/Game/Engine.hs
@@ -4,9 +4,11 @@
 
 module Game.Engine where
 
+import Control.Monad (guard)
 import Control.Monad.Trans.MSF.Maybe
 import Control.Monad.Trans.MSF.Reader
 import Control.Monad.Trans.MSF.Writer
+import Data.Functor (($>))
 import Data.Maybe
 import Data.MonadicStreamFunction
 import Game.Display
@@ -15,22 +17,30 @@ import Game.Utils
 import Graphics.Gloss
 import Graphics.Gloss.Interface.IO.Game
 
-handleEvents :: Monad m => MSF (DrawerT m) () [Direction]
-handleEvents = mapMaybe getDir <$> liftTransS (constM ask)
+-- * Input handling
+
+getKeys :: Monad m => MSF (DrawerT m) () [Key]
+getKeys = mapMaybe getKey <$> liftTransS (constM ask)
   where
-    getDir :: Event -> Maybe Direction
-    getDir (EventKey k Down _ _) = case k of
-      Char 'w' -> Just U
-      Char 's' -> Just D
-      Char 'a' -> Just L
-      Char 'd' -> Just R
-      SpecialKey KeyUp -> Just U
-      SpecialKey KeyDown -> Just D
-      SpecialKey KeyLeft -> Just L
-      SpecialKey KeyRight -> Just R
-      _ -> Nothing
+    getKey :: Event -> Maybe Key
+    getKey (EventKey k Down _ _) = Just k
+    getKey _ = Nothing
+
+handleEvents :: Monad m => MSF (DrawerT m) () [Direction]
+handleEvents = mapMaybe getDir <$> getKeys
+  where
+    getDir :: Key -> Maybe Direction
+    getDir (Char 'w') = Just U
+    getDir (Char 's') = Just D
+    getDir (Char 'a') = Just L
+    getDir (Char 'd') = Just R
+    getDir (SpecialKey KeyUp) = Just U
+    getDir (SpecialKey KeyDown) = Just D
+    getDir (SpecialKey KeyLeft) = Just L
+    getDir (SpecialKey KeyRight) = Just R
     getDir _ = Nothing
 
+-- * Core game engine
 
 tickState :: Maybe Direction -> GameState -> Maybe GameState
 tickState dir state =

From 59d344b6786733182879ba732193b8d6d2fcfd56 Mon Sep 17 00:00:00 2001
From: Kiana Sheibani <kiana.a.sheibani@gmail.com>
Date: Sat, 28 Jan 2023 21:50:09 -0500
Subject: [PATCH 05/10] Add pausing

---
 src/Game/Engine.hs | 23 ++++++++++++++---------
 src/Game/Utils.hs  | 10 ++++++++++
 2 files changed, 24 insertions(+), 9 deletions(-)

diff --git a/src/Game/Engine.hs b/src/Game/Engine.hs
index 28c57b8..7ab92eb 100644
--- a/src/Game/Engine.hs
+++ b/src/Game/Engine.hs
@@ -8,6 +8,7 @@ import Control.Monad (guard)
 import Control.Monad.Trans.MSF.Maybe
 import Control.Monad.Trans.MSF.Reader
 import Control.Monad.Trans.MSF.Writer
+import Data.Bits (xor)
 import Data.Functor (($>))
 import Data.Maybe
 import Data.MonadicStreamFunction
@@ -67,8 +68,8 @@ tick = feedback initialState $ proc (dir, state) -> do
   newstate <- maybeExit -< tickState dir state
   returnA -< (newstate, newstate)
 
-mainSF :: Monad m => MSF (MaybeT (DrawerT m)) () ()
-mainSF = proc () -> do
+gameSF :: Monad m => MSF (MaybeT (DrawerT m)) () GameState
+gameSF = proc () -> do
   -- A "tick" is each frame that the snake advances
   n <- count -< ()
   let isTick = n `mod` 8 == 1
@@ -77,12 +78,16 @@ mainSF = proc () -> do
   dirs <- liftTransS handleEvents -< ()
   dir <- fifoGate -< (dirs, isTick)
 
-  state' <-
-    if isTick
-      then fmap Just tick -< dir
-      else returnA -< Nothing
-  -- undefined is safe here because the first frame is guaranteed to be a tick
-  state <- hold undefined -< state'
+  -- only run `tick` whenever there's a tick
+  pauseMSF undefined tick -< (dir, isTick)
+
+mainSF :: Monad m => MSF (DrawerT m) () ()
+mainSF = proc () -> do
+  keys <- getKeys -< ()
+  let esc = SpecialKey KeyEsc `elem` keys
+
+  paused <- accumulateWith xor True -< esc
+  state <- pauseMSF undefined (loopMaybe gameSF) -< ((), paused)
 
   -- Display the current state
-  liftTransS displayState -< state
+  displayState -< state
diff --git a/src/Game/Utils.hs b/src/Game/Utils.hs
index c6aa297..3ff02f3 100644
--- a/src/Game/Utils.hs
+++ b/src/Game/Utils.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE Arrows #-}
+
 module Game.Utils where
 
 import Control.Monad.Trans.MSF.Maybe
@@ -75,3 +77,11 @@ fifoGate =
 
 loopMaybe :: Monad m => MSF (MaybeT m) a b -> MSF m a b
 loopMaybe msf = msf `catchMaybe` loopMaybe msf
+
+pauseMSF :: Monad m => b -> MSF m a b -> MSF m (a, Bool) b
+pauseMSF def msf = proc (x, b) -> do
+  y <-
+    if b
+      then fmap Just msf -< x
+      else returnA -< Nothing
+  hold def -< y

From 7c61ddb24f0d2ab89b194d81a6d4c43c9ed87421 Mon Sep 17 00:00:00 2001
From: Kiana Sheibani <kiana.a.sheibani@gmail.com>
Date: Sun, 21 Apr 2024 03:39:13 -0400
Subject: [PATCH 06/10] Update dependencies

---
 flake.lock | 30 ++++++++++++++++++++++++------
 1 file changed, 24 insertions(+), 6 deletions(-)

diff --git a/flake.lock b/flake.lock
index 9333a82..48081d6 100644
--- a/flake.lock
+++ b/flake.lock
@@ -1,12 +1,15 @@
 {
   "nodes": {
     "flake-utils": {
+      "inputs": {
+        "systems": "systems"
+      },
       "locked": {
-        "lastModified": 1667395993,
-        "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=",
+        "lastModified": 1710146030,
+        "narHash": "sha256-SZ5L6eA7HJ/nmkzGG7/ISclqe6oZdOZTNoesiInkXPQ=",
         "owner": "numtide",
         "repo": "flake-utils",
-        "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f",
+        "rev": "b1d9ab70662946ef0850d488da1c9019f3a9752a",
         "type": "github"
       },
       "original": {
@@ -17,11 +20,11 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1674004508,
-        "narHash": "sha256-sB5hYccS1Uoemc8pRA8z17HZ9hrGHrWqn8g0nQm7/lg=",
+        "lastModified": 1713674382,
+        "narHash": "sha256-1M/5T+D2obq8g5C3JZ2NnC4QGdbxcit5QkLd8ui3OYk=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "c8b20e1c4168642f9fc92fb8d7fa465eb7a18c5c",
+        "rev": "44fa1ee8c2b0a581804e101c8627339c3fa2fd96",
         "type": "github"
       },
       "original": {
@@ -35,6 +38,21 @@
         "flake-utils": "flake-utils",
         "nixpkgs": "nixpkgs"
       }
+    },
+    "systems": {
+      "locked": {
+        "lastModified": 1681028828,
+        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
+        "owner": "nix-systems",
+        "repo": "default",
+        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nix-systems",
+        "repo": "default",
+        "type": "github"
+      }
     }
   },
   "root": "root",

From a6a70e5dca66994bee79c6bce517f31a618f7b7e Mon Sep 17 00:00:00 2001
From: Kiana Sheibani <kiana.a.sheibani@gmail.com>
Date: Sun, 21 Apr 2024 03:39:41 -0400
Subject: [PATCH 07/10] Add true randomness

Previously, randomness was faked via bad pseudo-randomness code, so
let's refactor some of this to add true randomness support.
---
 snake.cabal        |  2 ++
 src/Game/Engine.hs | 23 ++++++++++-------------
 src/Game/State.hs  | 40 ++++++++++++++++++++++++++++++----------
 src/Game/Utils.hs  |  6 ++++++
 4 files changed, 48 insertions(+), 23 deletions(-)

diff --git a/snake.cabal b/snake.cabal
index a9edfcc..d005796 100644
--- a/snake.cabal
+++ b/snake.cabal
@@ -12,5 +12,7 @@ executable snake
   default-language:   GHC2021
   default-extensions: Arrows
   build-depends: base,
+                 mtl,
+                 random,
                  dunai,
                  gloss
diff --git a/src/Game/Engine.hs b/src/Game/Engine.hs
index 7ab92eb..ae41042 100644
--- a/src/Game/Engine.hs
+++ b/src/Game/Engine.hs
@@ -1,10 +1,10 @@
 {-# LANGUAGE Arrows #-}
 {-# LANGUAGE OverloadedRecordDot #-}
-{-# LANGUAGE RecordWildCards #-}
 
 module Game.Engine where
 
 import Control.Monad (guard)
+import Control.Monad.Trans
 import Control.Monad.Trans.MSF.Maybe
 import Control.Monad.Trans.MSF.Reader
 import Control.Monad.Trans.MSF.Writer
@@ -43,7 +43,7 @@ handleEvents = mapMaybe getDir <$> getKeys
 
 -- * Core game engine
 
-tickState :: Maybe Direction -> GameState -> Maybe GameState
+tickState :: Maybe Direction -> GameState -> MaybeT IO GameState
 tickState dir state =
   let moveDir = setDir state.moveDir dir
       newBlock = movePos moveDir $ head state.snakePos
@@ -56,19 +56,16 @@ tickState dir state =
       isHit = head snakePos `notElem` tail snakePos
       berryPos =
         if hitBerry
-          then
-            ( (fst state.berryPos * 80 `div` 3) `mod` 15,
-              (snd state.berryPos * 75 `div` 6) `mod` 15
-            )
-          else state.berryPos
-   in guard isHit $> GameState {..}
+          then randomPos
+          else pure state.berryPos
+   in MaybeT $ (guard isHit $>) <$> (GameState snakePos moveDir <$> berryPos)
 
-tick :: Monad m => MSF (MaybeT (DrawerT m)) (Maybe Direction) GameState
-tick = feedback initialState $ proc (dir, state) -> do
-  newstate <- maybeExit -< tickState dir state
+tick :: MonadIO m => MSF (MaybeT (DrawerT m)) (Maybe Direction) GameState
+tick = feedbackM (liftIO randomState) $ proc (dir, state) -> do
+  newstate <- arrM (mapMaybeT (lift . lift . liftIO) . uncurry tickState) -< (dir, state)
   returnA -< (newstate, newstate)
 
-gameSF :: Monad m => MSF (MaybeT (DrawerT m)) () GameState
+gameSF :: MonadIO m => MSF (MaybeT (DrawerT m)) () GameState
 gameSF = proc () -> do
   -- A "tick" is each frame that the snake advances
   n <- count -< ()
@@ -81,7 +78,7 @@ gameSF = proc () -> do
   -- only run `tick` whenever there's a tick
   pauseMSF undefined tick -< (dir, isTick)
 
-mainSF :: Monad m => MSF (DrawerT m) () ()
+mainSF :: MonadIO m => MSF (DrawerT m) () ()
 mainSF = proc () -> do
   keys <- getKeys -< ()
   let esc = SpecialKey KeyEsc `elem` keys
diff --git a/src/Game/State.hs b/src/Game/State.hs
index 126205d..f74c297 100644
--- a/src/Game/State.hs
+++ b/src/Game/State.hs
@@ -1,6 +1,11 @@
+{-# LANGUAGE LambdaCase #-}
+
 module Game.State where
 
-data Direction = U | D | L | R
+import System.Random
+import Control.Monad
+
+data Direction = U | D | L | R deriving (Eq)
 
 movePos :: Direction -> (Int, Int) -> (Int, Int)
 movePos U (x, y) = (x, y + 1)
@@ -8,16 +13,15 @@ movePos D (x, y) = (x, y - 1)
 movePos L (x, y) = (x - 1, y)
 movePos R (x, y) = (x + 1, y)
 
-opposite :: Direction -> Direction -> Bool
-opposite U D = True
-opposite D U = True
-opposite L R = True
-opposite R L = True
-opposite _ _ = False
+opposite :: Direction -> Direction
+opposite U = D
+opposite D = U
+opposite L = R
+opposite R = L
 
 setDir :: Direction -> Maybe Direction -> Direction
 setDir d Nothing = d
-setDir d (Just d') = if opposite d d' then d else d'
+setDir d (Just d') = if opposite d == d' then d else d'
 
 data GameState = GameState
   { snakePos :: [(Int, Int)],
@@ -25,5 +29,21 @@ data GameState = GameState
     berryPos :: (Int, Int)
   }
 
-initialState :: GameState
-initialState = GameState [(4, 5), (4, 4), (5, 4)] R (3, 3)
+initialLength :: Int
+initialLength = 3
+
+randomPos :: IO (Int, Int)
+randomPos = (,) <$> randomRIO (-10, 10) <*> randomRIO (-10, 10)
+
+randomState :: IO GameState
+randomState = do
+  let randomDirection =
+        (\case
+          1 -> U
+          2 -> D
+          3 -> L
+          4 -> R) <$> randomRIO @Int (1,4)
+  dirs <- replicateM (initialLength - 1) randomDirection
+  hd <- randomPos
+  let snake = scanr movePos hd dirs
+  GameState snake <$> randomDirection <*> randomPos
diff --git a/src/Game/Utils.hs b/src/Game/Utils.hs
index 3ff02f3..2e12fe2 100644
--- a/src/Game/Utils.hs
+++ b/src/Game/Utils.hs
@@ -52,6 +52,12 @@ draw = arrM tell
 
 -- * MSF convenience functions
 
+feedbackM :: Monad m => m c -> MSF m (a, c) (b, c) -> MSF m a b
+feedbackM init msf = feedback Nothing $ proc (x, state) -> do
+  state' <- arrM (maybe init pure) -< state
+  (y, newstate) <- msf -< (x, state')
+  returnA -< (y, Just newstate)
+
 hold :: Monad m => a -> MSF m (Maybe a) a
 hold =
   mealy

From 35e68719cbcc85617496cb1847b160cd4dea7836 Mon Sep 17 00:00:00 2001
From: Kiana Sheibani <kiana.a.sheibani@gmail.com>
Date: Mon, 22 Apr 2024 22:41:39 -0400
Subject: [PATCH 08/10] Add display to pause screen

---
 src/Game/Display.hs | 7 ++++++-
 src/Game/Engine.hs  | 7 +++++--
 2 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/src/Game/Display.hs b/src/Game/Display.hs
index 99d3be7..03cf3d4 100644
--- a/src/Game/Display.hs
+++ b/src/Game/Display.hs
@@ -20,5 +20,10 @@ getSquare (toEnum -> x, toEnum -> y) =
 
 displayState :: Monad m => MSF (DrawerT m) GameState ()
 displayState = proc state -> do
-  draw -< mconcat $ color green . getSquare <$> state.snakePos
+  draw -< pictures $ color green . getSquare <$> state.snakePos
   draw -< color red $ getSquare state.berryPos
+
+displayPause :: Monad m => MSF (DrawerT m) () ()
+displayPause = proc () -> do
+  draw -< color (withAlpha 0.5 black) $ rectangleSolid 5000 5000
+  draw -< color white $ scale 0.5 0.5 $ text "Paused"
diff --git a/src/Game/Engine.hs b/src/Game/Engine.hs
index ae41042..df27b96 100644
--- a/src/Game/Engine.hs
+++ b/src/Game/Engine.hs
@@ -83,8 +83,11 @@ mainSF = proc () -> do
   keys <- getKeys -< ()
   let esc = SpecialKey KeyEsc `elem` keys
 
-  paused <- accumulateWith xor True -< esc
-  state <- pauseMSF undefined (loopMaybe gameSF) -< ((), paused)
+  unpaused <- accumulateWith xor True -< esc
+  state <- pauseMSF undefined (loopMaybe gameSF) -< ((), unpaused)
 
   -- Display the current state
   displayState -< state
+  if unpaused
+    then returnA -< ()
+    else displayPause -< ()

From 65d257d4ad60c7d4ca7aa29c32e53a18adef41c1 Mon Sep 17 00:00:00 2001
From: Kiana Sheibani <kiana.a.sheibani@gmail.com>
Date: Tue, 23 Apr 2024 00:10:41 -0400
Subject: [PATCH 09/10] Overhaul event handling

---
 src/Game/Display.hs | 20 +++++++++----------
 src/Game/Engine.hs  | 48 +++++++++++++++------------------------------
 src/Game/State.hs   | 36 ++++++++++++++++++++++++++++++++++
 src/Main.hs         |  5 ++++-
 4 files changed, 66 insertions(+), 43 deletions(-)

diff --git a/src/Game/Display.hs b/src/Game/Display.hs
index 03cf3d4..e5ebdcf 100644
--- a/src/Game/Display.hs
+++ b/src/Game/Display.hs
@@ -14,16 +14,16 @@ import Game.Utils
 import Graphics.Gloss
 import Graphics.Gloss.Interface.IO.Game
 
-getSquare :: (Int, Int) -> Picture
-getSquare (toEnum -> x, toEnum -> y) =
-  translate (x * 25) (y * 25) $ rectangleSolid 25 25
+getSquare :: (Int, Int) -> (Int, Int) -> Picture
+getSquare (toEnum -> winWidth, toEnum -> winHeight) (toEnum -> x, toEnum -> y) =
+  translate (x * winWidth / 30) (y * winHeight / 20) $ rectangleSolid (winWidth / 30) (winHeight / 20)
 
-displayState :: Monad m => MSF (DrawerT m) GameState ()
-displayState = proc state -> do
-  draw -< pictures $ color green . getSquare <$> state.snakePos
-  draw -< color red $ getSquare state.berryPos
+displayState :: Monad m => MSF (DrawerT m) (GameState, (Int, Int)) ()
+displayState = proc (state, windowSize) -> do
+  draw -< pictures $ color green . getSquare windowSize <$> state.snakePos
+  draw -< color red $ getSquare windowSize state.berryPos
 
-displayPause :: Monad m => MSF (DrawerT m) () ()
-displayPause = proc () -> do
-  draw -< color (withAlpha 0.5 black) $ rectangleSolid 5000 5000
+displayPause :: Monad m => MSF (DrawerT m) (Int, Int) ()
+displayPause = proc (width, height) -> do
+  draw -< color (withAlpha 0.5 black) $ rectangleSolid (toEnum width) (toEnum height)
   draw -< color white $ scale 0.5 0.5 $ text "Paused"
diff --git a/src/Game/Engine.hs b/src/Game/Engine.hs
index df27b96..69f614d 100644
--- a/src/Game/Engine.hs
+++ b/src/Game/Engine.hs
@@ -17,29 +17,12 @@ import Game.State
 import Game.Utils
 import Graphics.Gloss
 import Graphics.Gloss.Interface.IO.Game
+import Control.Applicative (asum)
 
 -- * Input handling
 
-getKeys :: Monad m => MSF (DrawerT m) () [Key]
-getKeys = mapMaybe getKey <$> liftTransS (constM ask)
-  where
-    getKey :: Event -> Maybe Key
-    getKey (EventKey k Down _ _) = Just k
-    getKey _ = Nothing
-
-handleEvents :: Monad m => MSF (DrawerT m) () [Direction]
-handleEvents = mapMaybe getDir <$> getKeys
-  where
-    getDir :: Key -> Maybe Direction
-    getDir (Char 'w') = Just U
-    getDir (Char 's') = Just D
-    getDir (Char 'a') = Just L
-    getDir (Char 'd') = Just R
-    getDir (SpecialKey KeyUp) = Just U
-    getDir (SpecialKey KeyDown) = Just D
-    getDir (SpecialKey KeyLeft) = Just L
-    getDir (SpecialKey KeyRight) = Just R
-    getDir _ = Nothing
+handleEvents :: Monad m => MSF (DrawerT m) () GameEvents
+handleEvents = parseEvents <$> liftTransS (constM ask)
 
 -- * Core game engine
 
@@ -65,29 +48,30 @@ tick = feedbackM (liftIO randomState) $ proc (dir, state) -> do
   newstate <- arrM (mapMaybeT (lift . lift . liftIO) . uncurry tickState) -< (dir, state)
   returnA -< (newstate, newstate)
 
-gameSF :: MonadIO m => MSF (MaybeT (DrawerT m)) () GameState
-gameSF = proc () -> do
+gameSF :: MonadIO m => MSF (MaybeT (DrawerT m)) GameEvents GameState
+gameSF = proc events -> do
   -- A "tick" is each frame that the snake advances
   n <- count -< ()
   let isTick = n `mod` 8 == 1
 
   -- Handle inputs (buffer)
-  dirs <- liftTransS handleEvents -< ()
-  dir <- fifoGate -< (dirs, isTick)
+  dir <- fifoGate -< (events.directions, isTick)
 
   -- only run `tick` whenever there's a tick
   pauseMSF undefined tick -< (dir, isTick)
 
-mainSF :: MonadIO m => MSF (DrawerT m) () ()
-mainSF = proc () -> do
-  keys <- getKeys -< ()
-  let esc = SpecialKey KeyEsc `elem` keys
+mainSF :: MonadIO m => (Int, Int) -> MSF (DrawerT m) () ()
+mainSF initSize = proc () -> do
+  events <- handleEvents -< ()
 
-  unpaused <- accumulateWith xor True -< esc
-  state <- pauseMSF undefined (loopMaybe gameSF) -< ((), unpaused)
+  -- Handle window resize
+  windowSize <- hold initSize -< events.windowResize
+
+  unpaused <- accumulateWith xor True -< events.pause
+  state <- pauseMSF undefined (loopMaybe gameSF) -< (events, unpaused)
 
   -- Display the current state
-  displayState -< state
+  displayState -< (state, windowSize)
   if unpaused
     then returnA -< ()
-    else displayPause -< ()
+    else displayPause -< windowSize
diff --git a/src/Game/State.hs b/src/Game/State.hs
index f74c297..6778c44 100644
--- a/src/Game/State.hs
+++ b/src/Game/State.hs
@@ -4,6 +4,9 @@ module Game.State where
 
 import System.Random
 import Control.Monad
+import Graphics.Gloss.Interface.IO.Game
+import Data.Maybe (mapMaybe)
+import Control.Applicative (asum)
 
 data Direction = U | D | L | R deriving (Eq)
 
@@ -23,6 +26,7 @@ setDir :: Direction -> Maybe Direction -> Direction
 setDir d Nothing = d
 setDir d (Just d') = if opposite d == d' then d else d'
 
+
 data GameState = GameState
   { snakePos :: [(Int, Int)],
     moveDir :: Direction,
@@ -47,3 +51,35 @@ randomState = do
   hd <- randomPos
   let snake = scanr movePos hd dirs
   GameState snake <$> randomDirection <*> randomPos
+
+
+data GameEvents = GameEvents
+  { directions :: [Direction],
+    pause :: Bool,
+    windowResize :: Maybe (Int, Int)
+  }
+
+parseEvents :: [Event] -> GameEvents
+parseEvents evs = GameEvents
+  (mapMaybe getDir evs) (any getPause evs) (asum $ fmap getResize evs)
+  where
+    getDir :: Event -> Maybe Direction
+    getDir (EventKey k Down _ _) = case k of
+      Char 'w' -> Just U
+      Char 's' -> Just D
+      Char 'a' -> Just L
+      Char 'd' -> Just R
+      SpecialKey KeyUp -> Just U
+      SpecialKey KeyDown -> Just D
+      SpecialKey KeyLeft -> Just L
+      SpecialKey KeyRight -> Just R
+      _ -> Nothing
+    getDir _ = Nothing
+
+    getPause :: Event -> Bool
+    getPause (EventKey (SpecialKey KeyEsc) Down _ _) = True
+    getPause _ = False
+
+    getResize :: Event -> Maybe (Int, Int)
+    getResize (EventResize resize) = Just resize
+    getResize _ = Nothing
diff --git a/src/Main.hs b/src/Main.hs
index 33775f4..fd3f5a9 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -4,6 +4,9 @@ import Data.MonadicStreamFunction
 import Game.Engine
 import Game.Utils
 import Graphics.Gloss
+import Graphics.Gloss.Interface.Environment (getScreenSize)
 
 main :: IO ()
-main = playMSF FullScreen black 60 (runDrawerS mainSF)
+main = do
+  size <- getScreenSize
+  playMSF FullScreen black 60 (runDrawerS $ mainSF size)

From b885d70549f245b19887b6a31359fe6f32773532 Mon Sep 17 00:00:00 2001
From: Kiana Sheibani <kiana.a.sheibani@gmail.com>
Date: Wed, 1 May 2024 00:31:58 -0400
Subject: [PATCH 10/10] Switch to flake-parts based flake

---
 flake.lock  | 78 +++++++++++++++++++++++++++++++++--------------------
 flake.nix   | 63 +++++++++++++------------------------------
 snake.cabal |  4 +++
 3 files changed, 72 insertions(+), 73 deletions(-)

diff --git a/flake.lock b/flake.lock
index 48081d6..7f0b48f 100644
--- a/flake.lock
+++ b/flake.lock
@@ -1,58 +1,78 @@
 {
   "nodes": {
-    "flake-utils": {
+    "flake-parts": {
       "inputs": {
-        "systems": "systems"
+        "nixpkgs-lib": "nixpkgs-lib"
       },
       "locked": {
-        "lastModified": 1710146030,
-        "narHash": "sha256-SZ5L6eA7HJ/nmkzGG7/ISclqe6oZdOZTNoesiInkXPQ=",
-        "owner": "numtide",
-        "repo": "flake-utils",
-        "rev": "b1d9ab70662946ef0850d488da1c9019f3a9752a",
+        "lastModified": 1712014858,
+        "narHash": "sha256-sB4SWl2lX95bExY2gMFG5HIzvva5AVMJd4Igm+GpZNw=",
+        "owner": "hercules-ci",
+        "repo": "flake-parts",
+        "rev": "9126214d0a59633752a136528f5f3b9aa8565b7d",
         "type": "github"
       },
       "original": {
-        "owner": "numtide",
-        "repo": "flake-utils",
+        "owner": "hercules-ci",
+        "repo": "flake-parts",
+        "type": "github"
+      }
+    },
+    "haskell-flake": {
+      "locked": {
+        "lastModified": 1714268160,
+        "narHash": "sha256-LNbwGgBT5EqfWN7pqYbj71VLLGQJqWkde3ToOhkM5vM=",
+        "owner": "srid",
+        "repo": "haskell-flake",
+        "rev": "5b0857e0b7feec60bf00e075f7859746d52b8564",
+        "type": "github"
+      },
+      "original": {
+        "owner": "srid",
+        "repo": "haskell-flake",
         "type": "github"
       }
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1713674382,
-        "narHash": "sha256-1M/5T+D2obq8g5C3JZ2NnC4QGdbxcit5QkLd8ui3OYk=",
-        "owner": "NixOS",
+        "lastModified": 1714314149,
+        "narHash": "sha256-yNAevSKF4krRWacmLUsLK7D7PlfuY3zF0lYnGYNi9vQ=",
+        "owner": "nixos",
         "repo": "nixpkgs",
-        "rev": "44fa1ee8c2b0a581804e101c8627339c3fa2fd96",
+        "rev": "cf8cc1201be8bc71b7cbbbdaf349b22f4f99c7ae",
         "type": "github"
       },
       "original": {
+        "owner": "nixos",
+        "ref": "nixpkgs-unstable",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "nixpkgs-lib": {
+      "locked": {
+        "dir": "lib",
+        "lastModified": 1711703276,
+        "narHash": "sha256-iMUFArF0WCatKK6RzfUJknjem0H9m4KgorO/p3Dopkk=",
         "owner": "NixOS",
         "repo": "nixpkgs",
+        "rev": "d8fe5e6c92d0d190646fb9f1056741a229980089",
+        "type": "github"
+      },
+      "original": {
+        "dir": "lib",
+        "owner": "NixOS",
+        "ref": "nixos-unstable",
+        "repo": "nixpkgs",
         "type": "github"
       }
     },
     "root": {
       "inputs": {
-        "flake-utils": "flake-utils",
+        "flake-parts": "flake-parts",
+        "haskell-flake": "haskell-flake",
         "nixpkgs": "nixpkgs"
       }
-    },
-    "systems": {
-      "locked": {
-        "lastModified": 1681028828,
-        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
-        "owner": "nix-systems",
-        "repo": "default",
-        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
-        "type": "github"
-      },
-      "original": {
-        "owner": "nix-systems",
-        "repo": "default",
-        "type": "github"
-      }
     }
   },
   "root": "root",
diff --git a/flake.nix b/flake.nix
index c2568c0..50b4996 100644
--- a/flake.nix
+++ b/flake.nix
@@ -1,52 +1,27 @@
 {
-  description = "A snake game in Haskell using Dunai";
-
   inputs = {
-    nixpkgs.url = "github:NixOS/nixpkgs";
-    flake-utils.url = "github:numtide/flake-utils";
+    nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable";
+    flake-parts.url = "github:hercules-ci/flake-parts";
+    haskell-flake.url = "github:srid/haskell-flake";
   };
+  outputs = inputs@{ self, nixpkgs, flake-parts, ... }:
+    flake-parts.lib.mkFlake { inherit inputs; } {
+      imports = [ inputs.haskell-flake.flakeModule ];
 
-  outputs = { self, nixpkgs, flake-utils, ... }:
-    flake-utils.lib.eachDefaultSystem (system:
-      let
-        pkgs = nixpkgs.legacyPackages.${system};
-        
-        # package/executable name
-        packageName = "snake";
-        execName = packageName;
-        
-        # version of ghc used
-        hp = pkgs.haskell.packages.ghc92;
-        
-        project = returnShellEnv:
-          hp.developPackage {
-            inherit returnShellEnv;
-            name = packageName;
-            root = ./.;
-            withHoogle = false;
-            modifier = drv:
-              pkgs.haskell.lib.addBuildTools drv (with hp; [
-                # Specify your build/dev dependencies here.
-                hlint
-                haskell-language-server
-                ormolu
+      systems = nixpkgs.lib.systems.flakeExposed;
+      perSystem = { config, system, self', pkgs, ... }: {
 
-                pkgs.mesa
-                pkgs.mesa_glu
-                pkgs.freeglut
-              ]);
-          };
-      in
-      {
-        # Used by `nix build` & `nix run` (prod exe)
-        packages.default = project false;
-
-        apps.default = {
-          type = "app";
-          program = "${self.packages.${system}.default}/bin/${execName}";
+        _module.args.pkgs = import nixpkgs {
+          inherit system;
+          config.allowBroken = true;
         };
 
-        # Used by `nix develop` (dev shell)
-        devShell = project true;
-      });
+        haskellProjects.default = {
+          basePackages = pkgs.haskell.packages.ghc94;
+        };
+
+        packages.default = self'.packages.snake;
+        apps.default = self'.apps.snake;
+      };
+    };
 }
diff --git a/snake.cabal b/snake.cabal
index d005796..ec96f03 100644
--- a/snake.cabal
+++ b/snake.cabal
@@ -9,6 +9,10 @@ build-type:    Simple
 executable snake
   hs-source-dirs: src
   main-is:        Main.hs
+  other-modules:  Game.Display,
+                  Game.Engine,
+                  Game.State,
+                  Game.Utils
   default-language:   GHC2021
   default-extensions: Arrows
   build-depends: base,