81 lines
3.2 KiB
Haskell
81 lines
3.2 KiB
Haskell
|
module Graphics (
|
||
|
|
renderFrame
|
||
|
|
) where
|
||
|
|
|
||
|
|
import SDL
|
||
|
|
import SnakeLib
|
||
|
|
import Foreign.C (CInt)
|
||
|
|
import Data.Array (indices)
|
||
|
|
import Control.Monad (void)
|
||
|
|
|
||
|
|
renderFrame :: Renderer -> Texture -> IO ()
|
||
|
|
renderFrame renderer texture = do
|
||
|
|
rendererDrawColor renderer $= V4 32 32 32 255
|
||
|
|
clear renderer
|
||
|
|
rendererDrawColor renderer $= V4 255 255 255 255
|
||
|
|
renderState renderer texture $ initialState (20, 20) (2, 2)
|
||
|
|
present renderer
|
||
|
|
|
||
|
|
renderState :: Renderer -> Texture -> GameState -> IO ()
|
||
|
|
renderState renderer texture state = do
|
||
|
|
void $ traverse (renderTile renderer texture state) (indices $ gameBoard state)
|
||
|
|
|
||
|
|
renderTile :: Renderer -> Texture -> GameState -> Pos -> IO ()
|
||
|
|
renderTile renderer texture state pos = case tileAt (gameBoard state) pos of
|
||
|
|
Empty -> return ()
|
||
|
|
Apple -> renderSpriteAt renderer texture APPLE pos
|
||
|
|
Snake ->
|
||
|
|
let size = gameBoardSize state
|
||
|
|
in renderSpriteAt renderer texture (snakeSprite (neighborTiles size (gameBoard state) pos) (pos == snakeHead state))pos
|
||
|
|
|
||
|
|
snakeSprite :: (Tile, Tile, Tile, Tile) -> Bool -> Sprite
|
||
|
|
snakeSprite (Snake, _, _, _) True = SNAKE_HEAD_DOWN
|
||
|
|
snakeSprite (_, Snake, _, _) True = SNAKE_HEAD_LEFT
|
||
|
|
snakeSprite (_, _, Snake, _) True = SNAKE_HEAD_UP
|
||
|
|
snakeSprite (_, _, _, Snake) True = SNAKE_HEAD_RIGHT
|
||
|
|
snakeSprite (Snake, _, Snake, _) _ = SNAKE_VERTICAL
|
||
|
|
snakeSprite (_, Snake, _, Snake) _ = SNAKE_HORIZONTAL
|
||
|
|
snakeSprite (Snake, Snake, _, _) _ = SNAKE_TURN_UP_RIGHT
|
||
|
|
snakeSprite (_, Snake, Snake, _) _ = SNAKE_TURN_DOWN_RIGHT
|
||
|
|
snakeSprite (_, _, Snake, Snake) _ = SNAKE_TURN_DOWN_LEFT
|
||
|
|
snakeSprite (Snake, _, _, Snake) _ = SNAKE_TURN_UP_LEFT
|
||
|
|
snakeSprite (Snake, _, _, _) _ = SNAKE_TAIL_UP
|
||
|
|
snakeSprite (_, Snake, _, _) _ = SNAKE_TAIL_RIGHT
|
||
|
|
snakeSprite (_, _, Snake, _) _ = SNAKE_TAIL_DOWN
|
||
|
|
snakeSprite (_, _, _, Snake) _ = SNAKE_TAIL_LEFT
|
||
|
|
snakeSprite _ _ = APPLE
|
||
|
|
|
||
|
|
renderSpriteAt :: Renderer -> Texture -> Sprite -> (Int, Int) -> IO ()
|
||
|
|
renderSpriteAt renderer texture sprite (x, y) = do
|
||
|
|
let srcRect = getSpriteSheetLocation $ getSpriteIndex sprite
|
||
|
|
let dstRect = Rectangle (P (V2 (64 * (fromIntegral x)) (64 * (fromIntegral y)))) (V2 64 64)
|
||
|
|
copy renderer texture (Just srcRect) (Just dstRect)
|
||
|
|
|
||
|
|
getSpriteSheetLocation :: (Int, Int) -> Rectangle CInt
|
||
|
|
getSpriteSheetLocation (y, x) = Rectangle (P (V2 (16 * (fromIntegral x)) (16 * (fromIntegral y)))) (V2 16 16)
|
||
|
|
|
||
|
|
getSpriteIndex :: Sprite -> (Int, Int)
|
||
|
|
getSpriteIndex SNAKE_HEAD_DOWN = (0, 0)
|
||
|
|
getSpriteIndex SNAKE_HEAD_LEFT = (0, 1)
|
||
|
|
getSpriteIndex SNAKE_HEAD_UP = (0, 2)
|
||
|
|
getSpriteIndex SNAKE_HEAD_RIGHT = (0, 3)
|
||
|
|
getSpriteIndex SNAKE_TURN_UP_RIGHT = (1, 0)
|
||
|
|
getSpriteIndex SNAKE_TURN_DOWN_RIGHT = (1, 1)
|
||
|
|
getSpriteIndex SNAKE_TURN_DOWN_LEFT = (1, 2)
|
||
|
|
getSpriteIndex SNAKE_TURN_UP_LEFT = (1, 3)
|
||
|
|
getSpriteIndex SNAKE_VERTICAL = (2, 0)
|
||
|
|
getSpriteIndex SNAKE_HORIZONTAL = (2, 1)
|
||
|
|
getSpriteIndex SNAKE_TAIL_UP = (3, 0)
|
||
|
|
getSpriteIndex SNAKE_TAIL_RIGHT = (3, 1)
|
||
|
|
getSpriteIndex SNAKE_TAIL_DOWN = (3, 2)
|
||
|
|
getSpriteIndex SNAKE_TAIL_LEFT = (3, 3)
|
||
|
|
getSpriteIndex APPLE = (2, 2)
|
||
|
|
|
||
|
|
data Sprite =
|
||
|
|
SNAKE_HEAD_DOWN | SNAKE_HEAD_LEFT | SNAKE_HEAD_UP | SNAKE_HEAD_RIGHT |
|
||
|
|
SNAKE_TURN_UP_RIGHT | SNAKE_TURN_DOWN_RIGHT | SNAKE_TURN_DOWN_LEFT | SNAKE_TURN_UP_LEFT |
|
||
|
|
SNAKE_VERTICAL | SNAKE_HORIZONTAL |
|
||
|
|
SNAKE_TAIL_UP | SNAKE_TAIL_RIGHT | SNAKE_TAIL_DOWN | SNAKE_TAIL_LEFT |
|
||
|
|
APPLE
|
||
|
|
|