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 (initialState boardSize (2, 2))
    freeAssets assets
    destroyRenderer renderer
    destroyWindow window

targetFps :: Word32
targetFps = 5

targetFrameMs :: Word32
targetFrameMs = 1000 `div` targetFps

boardSize :: (Int, Int)
boardSize = (12, 8)

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 = 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
        restartPresssed = 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
    (_, updatedGame) <- if restartPresssed then pure (IntoEmpty, initialState (10, 8) (2, 2)) else runTick game input
    renderFrame renderer assets updatedGame
    
    unless exitPressed $ do 
        frameEnd <- getTicks
        let elapsed = frameEnd - frameStart
        delay (targetFrameMs - elapsed)
        appLoop renderer assets updatedGame

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