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

Render BG

Browse source
This commit is contained in:
Oleg Sobolev 2026-03-30 00:16:04 +03:00
parent ffb2a087e1
commit fe45880384
1 changed files with 15 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

16
app/Graphics.hs
View file

@ -13,6 +13,7 @@ import Snake
import Assets import Assets
import qualified Data.Text as Text import qualified Data.Text as Text
import Data.Word (Word8)
spriteSize :: CInt spriteSize :: CInt
spriteSize = 16 spriteSize = 16
@ -22,13 +23,26 @@ tileSize = 64
renderFrame :: Renderer -> Assets -> Game -> IO () renderFrame :: Renderer -> Assets -> Game -> IO ()
renderFrame renderer (texture, font) game = do renderFrame renderer (texture, font) game = do
rendererDrawColor renderer $= V4 32 32 32 255 rendererDrawColor renderer $= V4 0 0 0 255
clear renderer clear renderer
renderBG renderer (gameBoardSize game)
rendererDrawColor renderer $= V4 255 255 255 255 rendererDrawColor renderer $= V4 255 255 255 255
renderGame renderer texture game renderGame renderer texture game
renderScore renderer font game renderScore renderer font game
present renderer present renderer
renderBG :: Renderer -> (Int, Int) -> IO ()
renderBG renderer (w, h) = do
void $ traverse (renderBGTile renderer) [(x, y) | x <- [0..w-1], y <- [0..h-1]]
tileColors :: (V4 Word8, V4 Word8)
tileColors = (V4 32 32 32 255, V4 64 64 64 255)
renderBGTile :: Renderer -> (Int, Int) -> IO ()
renderBGTile renderer (x, y) = do
rendererDrawColor renderer $= ((if even (x + y) then fst else snd) tileColors)
fillRect renderer (Just $ Rectangle (P $ V2 (fromIntegral x * tileSize) (fromIntegral y * tileSize)) (V2 tileSize tileSize))
renderGame :: Renderer -> Texture -> Game -> IO () renderGame :: Renderer -> Texture -> Game -> IO ()
renderGame renderer texture state = do renderGame renderer texture state = do
void $ traverse (renderTile renderer texture) (assocs $ gameBoard state) void $ traverse (renderTile renderer texture) (assocs $ gameBoard state)