game.hs

import Control.Monad (when)
import qualified Graphics.UI.SDL as SDL
import qualified Graphics.UI.SDL.Image as Image

data Mouse = LeftButton | MiddleButton | RightButton

position :: IO (Int, Int)
position = SDL.getMouseState >>= \(x, y, _) -> return (x, y)

isDown :: Mouse -> IO Bool
isDown m = SDL.getMouseState >>= \(_, _, xs) -> return $ any (check m) xs
  where
    check LeftButton SDL.ButtonLeft = True
    check MiddleButton SDL.ButtonMiddle = True
    check RightButton SDL.ButtonRight = True
    check _ _ = False

type Scene = [Sprite]

data Sprite = Sprite (Int, Int) Int Int FilePath

type Stepper a b = a -> b -> b

type Renderer a = a -> Scene

initialize :: IO ()
initialize = do
  SDL.init [SDL.InitEverything]
  SDL.rawSetCaption (Just "Banana2D") Nothing
  SDL.setVideoMode 640 480 32 []
  return ()

loop :: Stepper a b -> b -> IO a -> Renderer b -> IO ()
loop step state input render = do
  initialize
  b <- check
  when b $ do
    i <- input
    let s = step i state
    draw $ render s
    loop step s input render

check :: IO Bool
check = do
  event <- SDL.pollEvent
  case event of
    SDL.NoEvent -> return True
    SDL.Quit -> return False
    _ -> check

draw :: Scene -> IO ()
draw scene = do
  screen <- SDL.getVideoSurface
  xs <- compile scene
  mapM_ (blit screen) xs
  SDL.flip screen
  where
    blit s (img, r) = SDL.blitSurface img (Just r) s Nothing

compile :: Scene -> IO [(SDL.Surface, SDL.Rect)]
compile [] = return []
compile ((Sprite (x, y) w h fp):xs) = do
  img <- Image.load fp
  return $ (img, (SDL.Rect x y w h)) : compile xs

64:40:
    Couldn't match expected type `[(SDL.Surface, SDL.Rect)]'
                with actual type `IO [(SDL.Surface, SDL.Rect)]'
    In the return type of a call of `compile'
    In the second argument of `(:)', namely `compile xs'
    In the second argument of `($)', namely
      `(img, (SDL.Rect x y w h)) : compile xs'