I have been working hard trying to learn Haskell, or at least understand it enough to make simple programs. This is my first program. I have been working on it for about a month now. I had already gone through 4 different Haskell courses. None of which explain even basic usage. My goal was SDL2 a game, one I have already made in Ruby and Gosu.

It seems to work, but i still don't really understand Haskell very well and I'm sure there are some huge mistakes i am making. There is one for sure issue i'm having with music. At first i used an ogg file for music and it would play for about 10 seconds and stop. So I re-encoded it to mp5 and it seemed to fix the issue. But it still sometimes randomly stops without error and the music can't be restarted. The game keeps playing. I have never had this issue with SDL2 and C before so i am not sure what i causing it. I have also tried to push the music to a different thread but it doesn't seem to matter. I also have paranoia that it's not running at full speed all the time. I think i see it but it can also be completely in my head. Because i don't know if I'm running all these recursions correctly.

I didn't follow any sort of tutorial since i couldn't find one at all. So everything in the game i don't know if i'm doing it correctly or not. Since not 1 of the courses even mentioned having a program loop or states or anything at all dealing with anything real world. There is 0 SDL info except the the one official page. But this has only started to make a little bit of sense to me after a month. So if anyone would like to share some knowledge and let me know what i have totally stuffed up i would really love it.

I used stack. I believe you need full SDL2 C libraries installed. The game controls are left right to move. Escape to close and Space to reset.


{-# LANGUAGE OverloadedStrings #-}

-- Load required modules.
import qualified SDL
import qualified SDL.Image
import qualified SDL.Mixer
import qualified SDL.Font
import Foreign.C.Types
import Control.Monad.State
import System.Random
import Data.Time.Clock.POSIX
import Control.Concurrent
import qualified Data.Text

-- Define a new GameState record.
data GameState = GameState { gameRenderer :: SDL.Renderer
                           , gameBackground :: SDL.Texture
                           , gamePlayer :: SDL.Texture
                           , gamePlayerRect :: SDL.Rectangle CInt
                           , gamePlayerLeft :: Bool
                           , gameWhiteFlake :: SDL.Texture
                           , gameYellowFlake :: SDL.Texture
                           , gameFlakes :: [(SDL.Texture, Bool, SDL.Rectangle CInt)]
                           , gameMusic :: SDL.Mixer.Music
                           , gameCollect :: SDL.Mixer.Chunk
                           , gameHit :: SDL.Mixer.Chunk
                           , gameScore :: Int
                           , gameScoreTex :: SDL.Texture
                           , gameScoreRect :: SDL.Rectangle CInt
                           , gameOver :: Bool }

-- Generate random number seeded from the time.
getRandomNumber :: CInt -> IO CInt
getRandomNumber num = do
  posixTime <- getPOSIXTime
  let seed = floor $ posixTime * 1000000000
  let gen = mkStdGen seed
  let (randomNum, _) = random gen :: (Int, StdGen)
  return (fromIntegral $ randomNum `mod` fromIntegral num)

-- Load an image in as surface. Get dimensions, free surface, return tex and dim.
loadTexWithDim :: SDL.Renderer -> FilePath -> IO (SDL.Texture, SDL.V2 CInt)
loadTexWithDim renderer imageFile = do
  surf <- SDL.Image.load imageFile
  dim <- SDL.surfaceDimensions surf
  tex <- SDL.createTextureFromSurface renderer surf
  SDL.freeSurface surf
  return (tex, dim)

-- Load all images and sounds assets and return GameState record.
loadAssets :: SDL.Renderer -> IO GameState
loadAssets renderer = do
  background <- SDL.Image.loadTexture renderer "images/background.png"
  (player, playerDim) <- loadTexWithDim renderer "images/player.png"
  (white, flakeDim) <- loadTexWithDim renderer "images/white.png"
  yellow <- SDL.Image.loadTexture renderer "images/yellow.png"
  collect <- SDL.Mixer.load "sounds/collect.wav" :: IO SDL.Mixer.Chunk
  hit <- SDL.Mixer.load "sounds/hit.wav" :: IO SDL.Mixer.Chunk
  music <- SDL.Mixer.load "music/winter_loop.mp3" :: IO SDL.Mixer.Music
  let playerRect = SDL.Rectangle (SDL.P (SDL.V2 350 374)) playerDim
  whiteFlakes <- sequence (replicate 10 (generateFlake white True flakeDim))
  yellowFlakes <- sequence (replicate 5 (generateFlake yellow False flakeDim))
  (scoreTex, scoreRect) <- generateMsg renderer 10 10 ("Score: 0") 24
  return GameState { gameRenderer = renderer
                   , gameBackground = background
                   , gamePlayer = player
                   , gamePlayerRect = playerRect
                   , gamePlayerLeft = False
                   , gameWhiteFlake = white
                   , gameYellowFlake = yellow
                   , gameFlakes = whiteFlakes ++ yellowFlakes
                   , gameMusic = music
                   , gameCollect = collect
                   , gameHit = hit
                   , gameScore = 0
                   , gameScoreTex = scoreTex
                   , gameScoreRect = scoreRect
                   , gameOver = False }

-- Generate a flake 2 screens above window.
generateFlake :: SDL.Texture -> Bool -> SDL.V2 CInt -> IO (SDL.Texture, Bool, SDL.Rectangle CInt)
generateFlake tex color dim = do
  let (SDL.V2 width height) = dim
  x <- getRandomNumber (800 - width)
  y <- getRandomNumber 1200
  let y' = (-y) - height
  let rect = SDL.Rectangle (SDL.P (SDL.V2 x y')) dim
  return (tex, color, rect)

-- Generate a texture and rect from a string.
generateMsg :: SDL.Renderer -> CInt -> CInt -> String -> Int -> IO (SDL.Texture, SDL.Rectangle CInt)
generateMsg renderer x y msg size = do
  font <- SDL.Font.load "fonts/freesansbold.ttf" size
  let text = Data.Text.pack msg
  surf <- SDL.Font.blended font (SDL.V4 255 255 255 255) text
  dim <- SDL.surfaceDimensions surf
  let rect = SDL.Rectangle (SDL.P (SDL.V2 x y)) dim
  tex <- SDL.createTextureFromSurface renderer surf
  SDL.Font.free font
  SDL.freeSurface surf
  return (tex, rect)

-- Check the direction keys if they are in the down state and return the updated player position
checkKeysDown :: SDL.Rectangle CInt -> (SDL.Scancode -> Bool) -> Bool -> (SDL.Rectangle CInt, Bool)
checkKeysDown playerRect keyboardState leftBool = do
  -- Get bool for each key thats down.
  let leftPressed = keyboardState SDL.ScancodeLeft
  let rightPressed = keyboardState SDL.ScancodeRight

  -- Deconstruct the Rect to its parts.
  let (SDL.Rectangle (SDL.P (SDL.V2 oldX oldY)) playerDim) = playerRect
  let (SDL.V2 width _) = playerDim

  let leftBool' = if leftPressed && not rightPressed then True
                    else if rightPressed && not leftPressed then False
                    else leftBool
  -- Update the x and y position.
  let x = if leftPressed && not rightPressed then oldX - 5
           else if rightPressed && not leftPressed then oldX + 5
           else oldX

  -- Check bounds and update x and y.
  let x' = if x < -40 then -40
           else if x > 800 - width + 36 then 800 - width + 36
           else x
  -- Return the updated rectangle.
  ((SDL.Rectangle (SDL.P (SDL.V2 x' oldY)) playerDim), leftBool')

-- Check all the events and return whether escape or space are pressed.
checkKeysPressed :: [SDL.Event] -> (Bool, Bool)
checkKeysPressed events = foldr checkKey (False, False) events
  where checkKey event (escape, space) =
          case SDL.eventPayload event of
            SDL.KeyboardEvent keyboardEvent ->
              if SDL.keyboardEventKeyMotion keyboardEvent == SDL.Pressed then
                case SDL.keysymKeycode (SDL.keyboardEventKeysym keyboardEvent) of
                  SDL.KeycodeEscape -> (True, space)
                  SDL.KeycodeSpace -> (escape, True)
                  _ -> (escape, space)
              else (escape, space)
            _ -> (escape, space)

-- Free all asset memory and shutdown SDL.
cleanup :: GameState -> SDL.Window -> IO ()
cleanup gameState window = do
  let renderer = gameRenderer gameState
      background = gameBackground gameState
      player = gamePlayer gameState
      white = gameWhiteFlake gameState
      yellow = gameYellowFlake gameState
      collect = gameCollect gameState
      scoreTex = gameScoreTex gameState
      hit = gameHit gameState
      music = gameMusic gameState
  SDL.Mixer.free music
  SDL.Mixer.free collect
  SDL.Mixer.free hit
  SDL.destroyTexture scoreTex
  SDL.destroyTexture white
  SDL.destroyTexture yellow
  SDL.destroyTexture player
  SDL.destroyTexture background
  SDL.destroyRenderer renderer
  SDL.destroyWindow window

main :: IO ()
main = do
  -- Initialize SDL and SDL.TTF for use.

  -- Initialize SDL Mixer.
  SDL.Mixer.openAudio SDL.Mixer.defaultAudio 4096

  -- Create the window and renderer.
  window <- SDL.createWindow "Don't Eat The Yellow Snow!" SDL.defaultWindow
  renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer

  -- Load all images and sounds assets and return GameState record.
  gameState <- loadAssets renderer

  -- Start playing background music on repeat.
  _ <- forkIO $ SDL.Mixer.playMusic SDL.Mixer.Forever $ gameMusic gameState

  -- Start the main game loop using the gameState.
  evalStateT gameLoop gameState

  -- Free all asset memory and shutdown SDL.
  cleanup gameState window

-- Update all Flakes keeping track of white flakes collected and if a yellow flake was hit.
updateFlakes :: [(SDL.Texture, Bool, SDL.Rectangle CInt)] -> SDL.V2 CInt -> Int -> Bool-> IO ([(SDL.Texture, Bool, SDL.Rectangle CInt)], Int, Bool)
updateFlakes [] _ collected over = return ([], collected, over)
updateFlakes (x:xs) playerPos collected over = do
  (flake, newCollected, newOver) <- updateFlake x playerPos
  (flakes, finalCollected, finalOver) <- updateFlakes xs playerPos (newCollected + collected) (newOver || over)
  return (flake : flakes, finalCollected, finalOver)

-- Update a falling flake. If it his the ground reset above the screen, else check if collided with player.
updateFlake :: (SDL.Texture, Bool, SDL.Rectangle CInt) -> SDL.V2 CInt -> IO ((SDL.Texture, Bool, SDL.Rectangle CInt), Int, Bool)
updateFlake (tex, color, (SDL.Rectangle (SDL.P (SDL.V2 x y)) (SDL.V2 w h))) (SDL.V2 playerX _ )= do
  (x', y', s, o) <- if y + 5 > 520 then do
                  numX <- getRandomNumber (800 - w)
                  numY <- getRandomNumber 600
                  let numY' = (-numY) - h
                  return (numX, numY', 0, False)
                else if y + 5 > 360 && x > (playerX + 10) && x < (playerX + 100) then
                  if color then do
                    numX <- getRandomNumber (800 - w)
                    numY <- getRandomNumber 600
                    let numY' = (-numY) - h
                    return (numX, numY', 1, False)
                  else return (x, y + 5, 0, True)
                else return (x, y + 5, 0, False)
  return ((tex, color, (SDL.Rectangle (SDL.P (SDL.V2 x' y')) (SDL.V2 w h))), s, o)

-- Resets all flakes somewhere 2 screens above the window. For game reset.
resetFlakes :: [(SDL.Texture, Bool, SDL.Rectangle CInt)] -> IO [(SDL.Texture, Bool, SDL.Rectangle CInt)]
resetFlakes = mapM (\(tex, color, (SDL.Rectangle (SDL.P _) (SDL.V2 w h))) -> do
  numX <- getRandomNumber (800 - w)
  numY <- getRandomNumber 1200
  let numY' = (-numY) - h
  return (tex, color, (SDL.Rectangle (SDL.P (SDL.V2 numX numY')) (SDL.V2 w h))))

-- Main game loop using gameState.
gameLoop :: StateT GameState IO ()
gameLoop = do
  -- Get the current gameState. Get current gameState variables.
  gameState <- get
  let renderer = gameRenderer gameState
      background = gameBackground gameState
      player = gamePlayer gameState
      playerRect = gamePlayerRect gameState
      playerLeft = gamePlayerLeft gameState
      oldFlakes = gameFlakes gameState
      music = gameMusic gameState
      collect = gameCollect gameState
      hit = gameHit gameState
      oldScore = gameScore gameState
      oldScoreTex = gameScoreTex gameState
      oldScoreRect = gameScoreRect gameState
      oldOver = gameOver gameState
  -- Get current events and check for key pressed events.
  events <- SDL.pollEvents
  let (escapePressed, spacePressed) = ( checkKeysPressed events )

  -- Rest game.
  (flakes, score, scoreTex, scoreRect, over) <- if spacePressed && oldOver then do
    newFlakes <- liftIO $ resetFlakes oldFlakes
    (scoreTex, scoreRect) <- liftIO $ generateMsg renderer 10 10 "Score: 0" 24
    SDL.destroyTexture oldScoreTex
    _ <- liftIO $ forkIO $ SDL.Mixer.playMusic SDL.Mixer.Forever music
    return (newFlakes, 0, scoreTex, scoreRect, False)
    else return (oldFlakes, oldScore, oldScoreTex, oldScoreRect, oldOver)

  -- Get current state of keyboard and update position and direction facing.
  keyboardState <- SDL.getKeyboardState
  let (playerRect', playerLeft') = if over
                                    then (playerRect, playerLeft)
                                    else checkKeysDown playerRect keyboardState playerLeft

-- Only update flakes if game is not over.
  (newFlakes, collected, newOver) <- if over
                                then return (flakes, 0, over)
                                else do
                                  let (SDL.Rectangle (SDL.P playerPos) _ ) = playerRect'
                                  (newFlakes, collected, newOver) <- liftIO $ updateFlakes flakes playerPos 0 over
                                  when newOver $ do
                                    SDL.Mixer.play hit
                                  return (newFlakes, collected, newOver) 

  -- Update the score and score texture.
  (newScore, newScoreTex, newScoreRect) <-
    if collected > 0 then do
      let newScore = collected + score
      SDL.Mixer.play collect
      (newScoreTex, newScoreRect) <- liftIO $ generateMsg renderer 10 10 ("Score: " ++ show newScore) 24
      SDL.destroyTexture scoreTex
      return (newScore, newScoreTex, newScoreRect)
    else return (score, scoreTex, scoreRect)

  -- Clear the renderer
  SDL.clear $ gameRenderer gameState

  -- Draw the assets to the renderer.
  SDL.copy renderer background Nothing Nothing
  SDL.copyEx renderer player Nothing (Just playerRect') 0 Nothing (SDL.V2 playerLeft' False)

  -- Draw all flakes to the renderer.
  liftIO $ mapM_ (\(tex, _, rect) -> SDL.copy renderer tex Nothing (Just rect)) newFlakes

  -- Draw the score.
  SDL.copy renderer newScoreTex Nothing (Just newScoreRect)

  -- Present the renderer/flip back and front buffers.
  SDL.present renderer

  -- Appoximate 60FPS with a 16ms delay.
  SDL.delay 16

  -- Update the gameState
  put gameState { gamePlayerRect = playerRect'
                , gamePlayerLeft = playerLeft'
                , gameFlakes = newFlakes
                , gameScore = newScore
                , gameScoreTex = newScoreTex
                , gameScoreRect = newScoreRect
                , gameOver = newOver }

  -- Loop unless escaped pressed.
  unless escapePressed (gameLoop)
  • 2
    \$\begingroup\$ Welcome to Code Review! The bulk of the second paragraph mentions an issue with music not working. That part seems a bit off-topic. I'd suggest posting a question about that on Stack Overflow and removing that portion from the description here, or else deleting the post until it all works as intended. \$\endgroup\$ Commented Feb 3, 2023 at 7:42
  • \$\begingroup\$ It seems on topic to me. Since I'm asking if i have written the Haskell code correctly. The whole code runs and works as intended. However there is sometimes that issue with the sound but there is no error or anything. This would be a question for code review. And its said that code review should be posted here and not stack overflow. However if you could let me know if my code written well with no issues. And then that issue would go to stack overflow. For now i am assusing its something with the way i wrote it. So my original question is am i writing Haskell code correctly? \$\endgroup\$
    – Jeremiah C
    Commented Feb 3, 2023 at 10:19
  • \$\begingroup\$ I have added a Lua Love2D and also a Ruby Gosu version of this game as well. \$\endgroup\$
    – Jeremiah C
    Commented Feb 4, 2023 at 21:56
  • 1
    \$\begingroup\$ "works as intended" and "there is sometimes that issue with the sound" seem contradictory to me. \$\endgroup\$
    – ggorlen
    Commented Feb 6, 2023 at 0:55
  • \$\begingroup\$ Thank you Sam and Gorlen for you very helpful code reviews. Some may use these sites for other reasons. But thank you. Also thanks for the review of my communication or possibly failure. Yes if i didn't state it my program does what i want it to do. No I do not believe it to be perfect or without bugs. Its been discussed here any many sites that there is absolutely no such thing as a bugless program. Also it may be helpful to look up what a code review is. Something about peer review to help someones programming technician and finding bugs that may or may not be obvious to the programmer. \$\endgroup\$
    – Jeremiah C
    Commented Feb 6, 2023 at 3:24


Browse other questions tagged or ask your own question.