Rasenschach-0.1: RenderPlayer.hs

module RenderPlayer (renderPlayer, renderPlayerDebug)

where

import Data.Bits
import GHC.Int
import Data.Array
import Control.Monad
import Physics
import Data.Time.Clock
import Data.Convertible

import FRP.Yampa.Geometry

import Graphics.UI.SDL as SDL
import Graphics.UI.SDL.Primitives as SDLp
import Graphics.UI.SDL.TTF as SDLt
import Graphics.UI.SDL.Mixer as SDLm

import BasicTypes
import RenderUtil
import Global

orange = rgbColor 0xE7 0x5B 0x12

-- Alles rund um den Fußballer...

r1 z = 3.0 + z   -- Punkte zwischen Kreisrand und äußerem Ring
r2 z = 6.0 + z   -- Punkte zwischen Kreisrand innerem Ring
angle = 0.45 -- Winkel des Zeiger-Dreiecks

pr1 z = truncate $ r1 z

triangle x y height radD alpha r1 r2 angle =
   let l1          = radD - (r1 height)
       l2          = radD - (r2 height)
       a           = (x + truncate (l1 * cos alpha), y + truncate (l1 * sin alpha))
       b           = (x + truncate (l2 * cos (alpha-angle)), y + truncate (l2 * sin (alpha-angle)))
       c           = (x + truncate (l2 * cos (alpha+angle)), y + truncate (l2 * sin (alpha+angle)))
   in (a,b,c)

playersizeMin = 25 :: Int16 -- in Pixeln
playersizeMax = 50
maxJump       = 3.0 -- in Meter

blinker = do
    t <- fmap ((100 *) . convert) getCurrentTime :: IO Double
    let t' = truncate t `mod` 100
    return $ t' < 50

playerSize :: Param -> Double -> Int16
playerSize param z =  -- zwischen 0 und 2 Meter Höhe, dann wechselt der Spieler zwischen 30 und 50 Dicke...
    if   z > maxJump then playersizeMax
    else if z < pGround param  then playersizeMin
    else truncate $ fromIntegral playersizeMin + z * (fromIntegral playersizeMax - fromIntegral playersizeMin) / 10.0

renderPlayer param surface p alpha sel number cCircle cTriangle cBorder kicked nonai designated fonts wav  =
  do
    when kicked $ playChannel (-1) wav 0 >> return ()

    let Point3 px py pz  = p
    let radius      = playerSize param pz `shiftR` 1
    let radius'     = (radius `shiftR` 1)-4   -- hacky: try to align exactly with ball...
    let (x', y')    = pitchToPoint param (px, py)
    let (x, y)      = (x'+radius', y'+radius')
    let xAdjust     = truncate (-0.4*pz) + if number > 9 then 3 else 1 :: Int16 --  Zentrieren der Rückennummer
    let yAdjust     = if pz < 1 then 4 else if pz < 2 then 5 else 5  :: Int16 -- Zentrieren der Rückennummer
    let radD        = fromIntegral radius
    let ((ax, ay),
         (bx, by),
         (cx, cy))  = triangle x y pz radD alpha r1 r2 angle
    let font        = if pz < 1 then fonts ! 1
                        else if pz < 2 then fonts ! 2
                        else fonts ! 3
    let markFont    = fonts ! 5

    blinkOn <- blinker

    let cBorderBlinking   = if nonai && blinkOn then cCircle else cBorder
    let cTriangleBlinking = if nonai && blinkOn then cCircle else cTriangle
    let cCircleBlinking   = if nonai && blinkOn then cBorder else cCircle


    fontSurface <- SDLt.renderTextSolid font (show number) (colorFromPixel cTriangleBlinking)
--    f2 <- SDL.convertSurface fontSurface (SDL.surfaceGetPixelFormat surface) []

    SDLp.filledCircle surface x y radius cBorderBlinking
    SDLp.filledCircle surface x y (radius - (pr1 pz)) cCircleBlinking

    when designated $ do
      markSurface <- SDLt.renderTextSolid markFont "!" (colorFromPixel orange)
      SDL.blitSurface markSurface Nothing surface (Just $ Rect (fromIntegral (x-xAdjust+1))
                                                      (fromIntegral (y-yAdjust-5))
                                                      (fromIntegral (x-xAdjust+10))
                                                      (fromIntegral (y-yAdjust+10)))
      return ()

    SDLp.filledTrigon surface ax ay bx by cx cy  cTriangleBlinking



    SDL.blitSurface fontSurface Nothing surface (Just $ Rect (fromIntegral (x-xAdjust))
                                                    (fromIntegral (y-yAdjust))
                                                    (fromIntegral (x-xAdjust+10))
                                                    (fromIntegral (y-yAdjust+10)))


renderPlayerDebug surface sel number bState tState color font baseDef baseOff oosTeam =
  do
    fontSurface <- SDLt.renderTextSolid font (show number ++ ": " ++
                                              show tState ++ ", " ++
                                              show bState ++ ", " -- ++
--                                              show baseDef ++ ", " ++
--                                              show baseOff
                                              )
                                        (colorFromPixel color)
--    f2 <- SDL.convertSurface fontSurface (SDL.surfaceGetPixelFormat surface) []
    let adjust = if oosTeam == Home then 150 else 500
    SDL.blitSurface fontSurface Nothing surface (Just $ Rect 850 (adjust+20*number) 950 (adjust+50+20*number))