Rasenschach-0.1.2: RenderBall.hs

module RenderBall -- (renderBall)

where

import Data.Array
import Control.Monad
import Data.Bits

import FRP.Yampa.Geometry

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

import RenderUtil
import Global

sizedBall :: Double -> Array Int (Surface, Int) -> (Surface, Int)
sizedBall z balls =
    if      z < 0.3 then balls!0
    else if z < 0.5 then balls!1
    else if z < 1.0 then balls!2
    else if z < 2.0 then balls!3
    else if z < 3.0 then balls!4
    else                 balls!5

renderBall :: Param -> Surface -> Array Int (Surface, Int) -> Chunk -> Point3 Double -> Bool -> IO Bool
renderBall param surface balls tock p bounced = do
    when bounced $ playChannel (-1) tock 0 >> return ()
    let Point3 px py pz  = p
    let (x, y) = pitchToPoint param (px, py)
    let (x', y') = (fromIntegral x, fromIntegral y) :: (Int, Int)
    let (ball, points) = sizedBall pz balls
    let adjust = fromIntegral $ points `shiftR` 2
    SDL.blitSurface ball Nothing surface (Just $ Rect (x'-adjust) (y'-adjust) (x'+adjust) (y'+adjust))

renderBallDebug :: Show a => Surface -> a -> Font -> t -> IO Bool
renderBallDebug surface state font _ =
  do
    let color = colorFromPixel $ rgbColor 255 255 1
    fontSurface <- SDLt.renderTextSolid font ("Ball: " ++ show state) color
--                                              ++ " , z=" ++ show z) color
--    f2 <- SDL.convertSurface fontSurface (SDL.surfaceGetPixelFormat surface) []

    SDL.blitSurface fontSurface Nothing surface (Just $ Rect 850 140 1000 150)