packages feed

Rasenschach-0.1.2: RenderGame.hs

module RenderGame

where

import Control.Monad

import Graphics.UI.SDL as SDL
import Graphics.UI.SDL.TTF as SDLt
import Graphics.UI.SDL.Mixer as Mix

import RenderUtil
import States
import Message
import BasicTypes

renderGame :: (Num a1, Ord a1, RealFrac a, Show a1) => 
                t -> Surface -> a -> (a1, a1) -> 
                  (GameState, GameMsgParam) -> t1 -> Font -> Font -> Chunk -> 
                  IO Bool
renderGame _ surface t (scoreHome, scoreAway) (gState, gStateParam)
           _ font bigfont whistle =
  do
    let color = colorFromPixel $ rgbColor 255 255 1
    let tt = truncate t
    let (min', sec) = (tt `div` 60, tt `mod` 60) :: (Int, Int)
    fontSurface <- SDLt.renderTextSolid font ("Score " ++ show scoreHome ++ "-" ++ show scoreAway) color
    timeSurface <- SDLt.renderTextSolid font ("Time" ++ show min' ++ "min " ++ show sec ++ "sec") color
    when (gState == GSKickOff && shouldWhistle gStateParam) $ do
--    when (shouldWhistle gStateParam) $ do
        playChannel (1) whistle 0 >> return ()

    SDL.blitSurface fontSurface Nothing surface (Just $ Rect 850 50 950 50)
    SDL.blitSurface timeSurface Nothing surface (Just $ Rect 850 80 950 80)
    
    when (gState == GSKickOff && scoreHome + scoreAway > 0) $ do
        goalSurface <- SDLt.renderTextSolid bigfont ("GOAL!!") color
        SDL.blitSurface goalSurface Nothing surface (Just $ Rect 380 400 100 100)
        return ()

    let (GPTeamPosition _ _ _ _ _ _ oop) = gStateParam

    when (oop == OOPSideOut) $ do
        goalSurface <- SDLt.renderTextSolid bigfont ("Throw in") color
        SDL.blitSurface goalSurface Nothing surface (Just $ Rect 380 300 100 100)
        return ()

    when (oop == OOPOffsite) $ do
        goalSurface <- SDLt.renderTextSolid bigfont ("Offsite") color
        SDL.blitSurface goalSurface Nothing surface (Just $ Rect 380 300 100 100)
        return ()

    when (oop == OOPBaseOut) $ do
        goalSurface <- SDLt.renderTextSolid bigfont ("Corner") color
        SDL.blitSurface goalSurface Nothing surface (Just $ Rect 380 300 100 100)
        return ()

    return True

shouldWhistle :: GameMsgParam -> Bool
shouldWhistle (GPTeamPosition _ _ _ _ _ w _) = w

renderGameDebug :: Show a => Surface -> a -> Font -> IO Bool
renderGameDebug surface state font =
  do
    let color = colorFromPixel $ rgbColor 255 255 1
    fontSurface <- SDLt.renderTextSolid font ("Game: " ++ show state) color
    SDL.blitSurface fontSurface Nothing surface (Just $ Rect 850 120 1000 140)