snake-hs/app/Main.hs

module Main where

import SDL
import qualified SDL.Font as FONT
import qualified Data.Text as Text
import Control.Monad (unless)
import SDL.Raw (getTicks)
import Data.Word (Word32)
import Foreign.C (CInt)

import Snake

import Assets
import Graphics

main :: IO ()
main = do
    initializeAll
    FONT.initialize
    window <- createWindow (Text.pack "Haskell Snake") defaultWindow {windowInitialSize = snakeWindowSize}
    renderer <- createRenderer window (-1) defaultRenderer
    
    assets <- loadAssets renderer
    appLoop renderer assets (startState, False)
    freeAssets assets
    destroyRenderer renderer
    destroyWindow window

targetFps :: Word32
targetFps = 5

targetFrameMs :: Word32
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, Bool) -> IO ()
appLoop renderer assets (game, isEnd) = do
    frameStart <- getTicks
    events <- pollEvents
    let eventIsExitPress event = case eventPayload event of
            KeyboardEvent keyboardEvent ->
                keyboardEventKeyMotion keyboardEvent == Pressed &&
                keysymKeycode (keyboardEventKeysym keyboardEvent) == KeycodeQ
            WindowClosedEvent _ -> True
            _ -> False
        exitPressed = any eventIsExitPress events
    let eventIsRestartPress event = case eventPayload event of
            KeyboardEvent keyboardEvent ->
                keyboardEventKeyMotion keyboardEvent == Pressed &&
                keysymKeycode (keyboardEventKeysym keyboardEvent) == KeycodeR
            _ -> False
        restartPressed = any eventIsRestartPress events
    let eventDirectionPress event = case eventPayload event of
          KeyboardEvent keyboardEvent -> 
            if keyboardEventKeyMotion keyboardEvent == Pressed 
                then getInputByKeycode $ keysymKeycode (keyboardEventKeysym keyboardEvent) 
                else NothingPressed
          _ -> NothingPressed
        input = foldMap eventDirectionPress events
    (movementResult, updatedGame) <- if restartPressed then pure (IntoEmpty, startState) else if isEnd then pure (IntoEmpty, game) else runTick game input
    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, updatedIsEnd)

getInputByKeycode :: Keycode -> MovementInput
getInputByKeycode KeycodeW = UpPressed
getInputByKeycode KeycodeUp = UpPressed
getInputByKeycode KeycodeD = RightPressed
getInputByKeycode KeycodeRight = RightPressed
getInputByKeycode KeycodeS = DownPressed
getInputByKeycode KeycodeDown = DownPressed
getInputByKeycode KeycodeA = LeftPressed
getInputByKeycode KeycodeLeft = LeftPressed
getInputByKeycode _ = NothingPressed