lerasimus/snake-hs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Implement defeat

Browse source
This commit is contained in:
Oleg Sobolev 2026-03-30 01:32:52 +03:00
parent fe45880384
commit fef327c49c
2 changed files with 27 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

19
app/Graphics.hs
View file

@ -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 (texture, font) game = do
renderFrame :: Renderer -> Assets -> (Game, Bool) -> IO ()
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