Implement defeat

app/Graphics.hs

@@ -7,7 +7,7 @@ import SDL
 import qualified SDL.Font as FONT
 import Foreign.C (CInt)
 import Data.Array (assocs)
-import Control.Monad (void)
+import Control.Monad (void, when)
 
 import Snake
 
@@ -21,14 +21,15 @@ spriteSize = 16
 tileSize :: CInt
 tileSize = 64
 
-renderFrame :: Renderer -> Assets -> Game -> IO ()
+renderFrame :: Renderer -> Assets -> (Game, Bool) -> IO ()
-renderFrame renderer (texture, font) game = do
+renderFrame renderer (texture, font) (game, isEnd) = do
     rendererDrawColor renderer $= V4 0 0 0 255
     clear renderer
     renderBG renderer (gameBoardSize game)
     rendererDrawColor renderer $= V4 255 255 255 255
     renderGame renderer texture game
     renderScore renderer font game
+    when isEnd $ renderDefeat renderer font
     present renderer
 
 renderBG :: Renderer -> (Int, Int) -> IO ()
@@ -66,6 +67,18 @@ renderScore renderer font game = do
 
     destroyTexture texture
 
+renderDefeat :: Renderer -> FONT.Font -> IO ()
+renderDefeat renderer font = do
+    surface <- FONT.blended font (V4 200 50 50 255) $ Text.pack ("You died! Press R to restart.")
+    texture <- createTextureFromSurface renderer surface
+    freeSurface surface
+
+    width <- textureWidth <$> queryTexture texture
+    height <- textureHeight <$> queryTexture texture
+    copy renderer texture Nothing (Just (Rectangle (P (V2 20 60)) (V2 width height)))
+
+    destroyTexture texture
+
 snakeSprite :: SnakeSegmentOrientation -> Sprite
 snakeSprite HEAD_DOWN = SNAKE_HEAD_DOWN
 snakeSprite HEAD_LEFT = SNAKE_HEAD_LEFT

app/Main.hs

@@ -21,7 +21,7 @@ main = do
     renderer <- createRenderer window (-1) defaultRenderer
     
     assets <- loadAssets renderer
-    appLoop renderer assets (initialState boardSize (2, 2))
+    appLoop renderer assets (startState, False)
     freeAssets assets
     destroyRenderer renderer
     destroyWindow window
@@ -35,14 +35,17 @@ targetFrameMs = 1000 `div` targetFps
 boardSize :: (Int, Int)
 boardSize = (12, 8)
 
+startState :: Game
+startState = initialState boardSize (2, 2)
+
 boardWindowSize :: (Int, Int) -> V2 CInt
 boardWindowSize (w, h) = V2 (fromIntegral w * tileSize) (fromIntegral h * tileSize)
 
 snakeWindowSize :: V2 CInt
 snakeWindowSize = boardWindowSize boardSize
 
-appLoop :: Renderer -> Assets -> Game -> IO ()
+appLoop :: Renderer -> Assets -> (Game, Bool) -> IO ()
-appLoop renderer assets game = do
+appLoop renderer assets (game, isEnd) = do
     frameStart <- getTicks
     events <- pollEvents
     let eventIsExitPress event = case eventPayload event of
@@ -57,7 +60,7 @@ appLoop renderer assets game = do
                 keyboardEventKeyMotion keyboardEvent == Pressed &&
                 keysymKeycode (keyboardEventKeysym keyboardEvent) == KeycodeR
             _ -> False
-        restartPresssed = any eventIsRestartPress events
+        restartPressed = any eventIsRestartPress events
     let eventDirectionPress event = case eventPayload event of
           KeyboardEvent keyboardEvent -> 
             if keyboardEventKeyMotion keyboardEvent == Pressed 
@@ -65,14 +68,15 @@ appLoop renderer assets game = do
                 else NothingPressed
           _ -> NothingPressed
         input = foldMap eventDirectionPress events
-    (_, updatedGame) <- if restartPresssed then pure (IntoEmpty, initialState (10, 8) (2, 2)) else runTick game input
+    (movementResult, updatedGame) <- if restartPressed then pure (IntoEmpty, startState) else if isEnd then pure (IntoEmpty, game) else runTick game input
-    renderFrame renderer assets updatedGame
+    let updatedIsEnd = (isEnd || movementResult == IntoSnake) && not restartPressed
+    renderFrame renderer assets (updatedGame, updatedIsEnd)
     
     unless exitPressed $ do 
         frameEnd <- getTicks
         let elapsed = frameEnd - frameStart
         delay (targetFrameMs - elapsed)
-        appLoop renderer assets updatedGame
+        appLoop renderer assets (updatedGame, updatedIsEnd)
 
 getInputByKeycode :: Keycode -> MovementInput
 getInputByKeycode KeycodeW = UpPressed