Rasenschach-0.1.2: Render.hs

module Render where

import Control.Monad (forM_)
import Data.Array as A (Array, Ix,(!)) 
import GHC.Exts

import Graphics.UI.SDL as SDL
import Graphics.UI.SDL.TTF as TTF
import Graphics.UI.SDL.Mixer as Mix
import FRP.Yampa.Geometry

import RenderPlayer
import RenderBall
import RenderGame
import RenderUtil

import Object
import States
import BasicTypes
import Global

init :: IO (Surface, Surface, A.Array Integer Font, Array Int (Surface, Int), Chunk, Chunk, Chunk)
init = do
    SDL.init [SDL.InitVideo]
    TTF.init

    screen <- SDL.setVideoMode (truncate winWidth) (truncate winHeight) 32 []
    openAudio 22050 AudioS16Sys 2 4096
    pitch <- pitchRessources screen
    fonts <- fontsRessources
    balls <- ballRessources screen
    (tockWav, kickWav, whistleWav) <- soundRessources

    return (screen, pitch, fonts, balls, tockWav, kickWav, whistleWav)

exit :: IO ()
exit = do
    closeAudio
    TTF.quit
    SDL.quit

renderObjects :: (Num i, A.Ix i) => Param -> [ObsObjState] 
                 -> (Surface, t, A.Array i Font, A.Array Int (Surface, Int), Chunk, Chunk, Chunk) 
                 -> IO ()
renderObjects param oos (screen, _, fonts, balls, tockWav, kickWav, whistleWav) = do
    cf <- chalkFontsRessources
    cfb <- bigChalkFonts
    forM_ sorted $ \os ->
        case os of
            OOSBall   oosPos'
                      _
                      oosBounced'
                      oosPState
                      -> do renderBall param screen balls tockWav oosPos' oosBounced'
                            renderBallDebug screen oosPState cf (point3Z oosPos')
            OOSPlayer oosPos'
                      _
                      _
                      oosKicked'
                      oosSelected'
                      oosDesignated'
                      _
                      (oosTeam, oosBorder, oosBody)
                      (PlayerInfo oosNumber _ bpOff bpDef _ _ _)
                      oosDir'
                      (bs, _)
                      (ts, _)
                      _
                      -> do renderPlayer param screen oosPos' oosDir' oosSelected' oosNumber
                                               oosBody oosBorder oosBorder oosKicked'
                                               (ts==TSNonAI) oosDesignated' fonts kickWav
                            renderPlayerDebug screen oosSelected' oosNumber bs ts oosBody
                                              cf bpDef bpOff oosTeam
            OOSGame   oosGameTime'
                      oosGameScore'
                      oosGameState'
                      oosAttacker'
                      _
                      -> do renderGame param screen oosGameTime' oosGameScore' oosGameState'
                                       oosAttacker' cfb (fonts ! 4) whistleWav
                            renderGameDebug screen oosGameState' cf

    where sorted = sortWith (point3Z . oosPos) oos

render :: (Num i, Ix i) => 
           Param -> [ObsObjState] 
           -> (Surface, Surface, Array i Font, Array Int (Surface, Int), Chunk, Chunk, Chunk) 
           -> IO ()
render param oos (screen, pitch, fonts, balls, tockWav, kickWav, whistleWav) = do
    SDL.blitSurface pitch Nothing screen Nothing
    renderObjects param oos (screen, pitch, fonts, balls, tockWav, kickWav, whistleWav)
    SDL.flip screen


renderStartMsg :: (Num i, Ix i) => 
                    (Surface, t, Array i Font, t1, t2, t3, t4) -> IO ()
renderStartMsg (screen,_, fonts,_,_,_,_)  =
  do
    let font    = fonts ! 4
    let color = colorFromPixel $ rgbColor 255 255 1

    fontSurface <- TTF.renderTextSolid font ("PRESS <SPACE> TO START") color

    SDL.blitSurface fontSurface Nothing screen (Just $ Rect 250 400 100 100)
    SDL.flip screen

renderEndMsg :: (Num i, Ix i) => (Surface, t, Array i Font, t1, t2, t3, Chunk) -> IO ()
renderEndMsg (screen,_, fonts,_,_,_,whistle)  =
  do
    let font    = fonts ! 4
    let color = colorFromPixel $ rgbColor 255 255 1

    fontSurface <- TTF.renderTextSolid font ("GAME OVER, TRY AGAIN (Y/N)") color
    playChannel (1) whistle 0

    SDL.blitSurface fontSurface Nothing screen (Just $ Rect 200 400 100 100)
    SDL.flip screen