astrds-0.1: src/Static.hs

module Static where

import Control.Monad
import qualified Data.Map as M
import qualified Data.Traversable as M
import qualified Graphics.UI.SDL as SDL
import qualified Graphics.UI.SDL.TTF as SDL
import qualified Graphics.UI.SDL.Image as SDL
import qualified Graphics.UI.SDL.Mixer as SDL
import Graphics.Rendering.OpenGL as GL
import Data.Maybe

import StaticInterface
import Utilities

import Pic

import Options
import Debug
import Config

initStatic :: Options -> IO Static
initStatic opts
   = do 
      debug_msg opts "loading images ..."
      images <- loadImages 
      debug_msg opts "loading fonts ..."
      fonts  <- loadFonts
      sounds <- if audio opts 
                  then do
                         debug_msg opts "loading sounds ..."
                         loadSounds
                  else return emptySounds
      let st = Static { images   = images
                      , fonts    = fonts
                      , sounds   = sounds
                      , options  = opts
                      }
      return st

-----------------------------------------------------------------------------
-- * Load fonts
-----------------------------------------------------------------------------

loadFonts :: IO Fonts
loadFonts =
  do
    ttf    <- getDataFileName "fonts/AlphaDance.ttf"
    fnt    <- SDL.openFont ttf 20            
    bigfnt <- SDL.openFont ttf 40  
    let fts = Fonts { font = fnt
                    , bigfont = bigfnt 
                    }
    return fts

-----------------------------------------------------------------------------
-- * Load images
-----------------------------------------------------------------------------


loadPic :: Pic -> IO SDLPic
loadPic pic =
  do
    imgBMP <- SDL.loadBMP (picpath pic) 
    convertSurface (picdim pic) imgBMP

convertSurface :: Dim -> SDL.Surface -> IO SDLPic
convertSurface dim img =
  do
    let pixfo = SDL.surfaceGetPixelFormat img
    bppo <- SDL.pixelFormatGetBytesPerPixel pixfo
    -- putStrLn $ show bppo
    let pfn = case bppo of 3 -> GL.RGB; 4 -> GL.RGBA
    imgTmp <- SDL.createRGBSurfaceEndian [SDL.SWSurface]
                (nextPowerOfTwo $ SDL.surfaceGetWidth img)
                (nextPowerOfTwo $ SDL.surfaceGetHeight img)
                (fromIntegral bppo * 8)
                -- 0x000000ff 0x0000ff00 0x00ff0000 -- small endian
                -- 0xff000000 -- alpha
    -- when (bppo == 4) $
    -- This is important in order to keep the alpha information from the
    -- source image in the temporary image:
    SDL.setAlpha img [] 0xff
    SDL.blitSurface img Nothing imgTmp Nothing
    [imgGL] <- GL.genObjectNames 1
    GL.textureBinding GL.Texture2D $= Just imgGL
    let pixfmt = SDL.surfaceGetPixelFormat imgTmp
    bpp <- SDL.pixelFormatGetBytesPerPixel pixfmt
    GL.rowLength GL.Unpack $=
      fromIntegral (SDL.surfaceGetPitch imgTmp `div`
                    fromIntegral bpp)
    pixels <- SDL.surfaceGetPixels imgTmp
    GL.textureFilter GL.Texture2D $=
      ((GL.Linear',Nothing), GL.Linear')
    GL.texImage2D Nothing GL.NoProxy 0 GL.RGBA'
      (GL.TextureSize2D (fromIntegral $ SDL.surfaceGetWidth  imgTmp)
                        (fromIntegral $ SDL.surfaceGetHeight imgTmp))
      0 -- border
      (GL.PixelData pfn GL.UnsignedByte pixels)
    -- GL.flush
    let picSDL = SDLPic { sdl_image = imgGL 
                        , sdl_dim   = dim }
    return picSDL

loadPNGPic :: Pic -> IO SDLPic
loadPNGPic pic = do 
                  imgSDL <- SDL.loadTyped (picpath pic) SDL.PNG
                  convertSurface (picdim pic) imgSDL
                
blackRGB, whiteRGB :: (Int, Int, Int)
blackRGB = (0,0,0) 
whiteRGB = (255,255,255)

-- Load all images necessary for the game.
loadImages :: IO Images
loadImages = 
  do 
    -- load images
    [pl_img, bg_img, rock_img, coll_img, overlay]
           <- mapM (>>= loadPNGPic)
                [playerPic, bgPic, rockPic, collPic, overlayPic]
    -- put it all together
    let imgs = Images { pl_image      = pl_img
                      , bg_image      = bg_img
                      , rock_image    = rock_img
                      , coll_image    = coll_img
                      , overlay       = overlay
                      }
    return imgs

-----------------------------------------------------------------------------
-- * Load sounds
-----------------------------------------------------------------------------

loadSounds :: IO Sounds
loadSounds = do
               bgs <- bgSound >>= loadChunk
               let snds = Sounds { bg_sound    = bgs 
                                 }
               return snds

loadChunk :: Sound -> IO SDLSound
loadChunk s = do 
                chunk <- SDL.loadWAV s
                return SDLSound { sdl_chunk = chunk }