fallingblocks-0.1.1: GraphicsInfo.hs

module GraphicsInfo where

import Graphics.UI.SDL as SDL
import Graphics.UI.SDL.TTF as TTF

import Helpers

makeGraphics :: IO GraphicsInfo
makeGraphics = do
  redblock <- loadBMP "redblock.bmp"
  blueblock <- loadBMP "blueblock.bmp"
  yellowblock <- loadBMP "yellowblock.bmp"
  greenblock <- loadBMP "greenblock.bmp"
  purpleblock <- loadBMP "purpleblock.bmp"
  cyanblock <- loadBMP "cyanblock.bmp"
  orangeblock <- loadBMP "orangeblock.bmp"

  greyblock <- loadBMP "greyblock.bmp"
  font <- openFont "Joystix.ttf" 16
  titlefont <- openFont "Joystix.ttf" 20
  screen <- getVideoSurface

  return $ GraphicsInfo screen 
             (BS redblock 
                 blueblock
                 yellowblock
                 greenblock
                 purpleblock
                 cyanblock
                 orangeblock
             ) 
             greyblock font titlefont

cleanupGraphics :: GraphicsInfo -> IO ()
cleanupGraphics gi = do
  freeSurface $ screen gi
  let bs = blocks gi
           
  freeSurface $ redBlock bs
  freeSurface $ blueBlock bs
  freeSurface $ yellowBlock bs
  freeSurface $ greenBlock bs
  freeSurface $ purpleBlock bs
  freeSurface $ cyanBlock bs
  freeSurface $ orangeBlock bs

  closeFont $ font gi
  closeFont $ titlefont gi

data BlockSurfaces = BS {
      redBlock :: Surface,
      blueBlock :: Surface,
      yellowBlock :: Surface,
      greenBlock :: Surface,
      purpleBlock :: Surface,
      cyanBlock :: Surface,
      orangeBlock :: Surface
    }


data GraphicsInfo = GraphicsInfo {
      screen :: Surface,
      blocks  :: BlockSurfaces,
      bkgdblock :: Surface,
      font   :: Font,
      titlefont :: Font
    }

getBlockSurface :: GraphicsInfo -> Helpers.Color -> Surface
getBlockSurface gi c = g $ blocks gi
    where g | c == Red = redBlock
            | c == Blue = blueBlock
            | c == Yellow = yellowBlock
            | c == Green = greenBlock
            | c == Purple = purpleBlock
            | c == Cyan = cyanBlock
            | c == Orange = orangeBlock