Rasenschach-0.1.2: RenderUtil.hs

module RenderUtil where

import Graphics.UI.SDL as SDL
import Graphics.UI.SDL.Image as SDLi
import Graphics.UI.SDL.Types as SDLt
import Graphics.UI.SDL.TTF as TTF
import Graphics.UI.SDL.Mixer as Mix
 
import GHC.Int
import GHC.Word
import Data.Bits

import Data.Array

import Global
import Paths_Rasenschach

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral 

rgbColor :: Word8 -> Word8 -> Word8 -> Pixel
rgbColor r g b = Pixel (shiftL (fi r) (24::Int) .|. shiftL (fi g) (16::Int) .|. shiftL (fi b) (8::Int) .|. fi (255::Int))

colorFromPixel :: Pixel -> Color
colorFromPixel (Pixel p) = Color (fi $ shiftR p 24) (fi $ shiftR p 16) (fi $ shiftR p 8)

-- Geometrie
 
winHeight :: Double
winHeight = 1050 :: Double
winWidth :: Double
winWidth = 1096 :: Double

ratio :: Fractional a => t -> a
ratio _ = 8.625 -- winHeight / (pPitchLength param + pUpperBorderY param + pLowerBorderY param)

pixelToMeter :: Param -> Int16 -> Double
pixelToMeter param p = fromIntegral p / ratio param

meterToPixel :: Param -> Double -> Int16
meterToPixel param = truncate . (* ratio param)

pitchToPoint :: Param -> (Double, Double) -> (Int16, Int16)
pitchToPoint param (x,y) = (meterToPixel param $ (pLeftBorderX param) + x,
                            meterToPixel param $ (pUpperBorderY param) + y)

pointToPitch :: Param -> (Int16, Int16) -> (Double, Double)
pointToPitch param (x,y) = (pixelToMeter param x - pLeftBorderX param, pixelToMeter param y - pUpperBorderY param)

ballRessources :: Surface -> IO (Array Int (Surface, Int))
ballRessources screen = do

    t <- mapRGB (surfaceGetPixelFormat screen) 0 255 0

    fn20 <- getDataFileName "20redball.png"
    png20 <- SDLi.load fn20
    b20 <- convertSurface png20 (surfaceGetPixelFormat screen) []
    setColorKey b20 [SrcColorKey, RLEAccel] t

    fn23 <- getDataFileName "23redball.png"
    png23 <- SDLi.load fn23
    b23 <- convertSurface png23 (surfaceGetPixelFormat screen) []
    setColorKey b23 [SrcColorKey, RLEAccel] t

    fn26 <- getDataFileName "26redball.png"
    png26 <- SDLi.load fn26
    b26 <- convertSurface png26 (surfaceGetPixelFormat screen) []
    setColorKey b26 [SrcColorKey, RLEAccel] t

    fn30 <- getDataFileName "30redball.png"
    png30 <- SDLi.load fn30
    b30 <- convertSurface png30 (surfaceGetPixelFormat screen) []
    setColorKey b30 [SrcColorKey, RLEAccel] t

    fn35 <- getDataFileName "35redball.png"
    png35 <- SDLi.load fn35
    b35 <- convertSurface png35 (surfaceGetPixelFormat screen) []
    setColorKey b35 [SrcColorKey, RLEAccel] t

    fn40 <- getDataFileName "40redball.png"
    png40 <- SDLi.load fn40
    b40 <- convertSurface png40 (surfaceGetPixelFormat screen) []
    setColorKey b40 [SrcColorKey, RLEAccel] t
 
    return $ array (0,5) [(0,(b20, SDLt.surfaceGetWidth b20)),
                          (1,(b23, SDLt.surfaceGetWidth b23)),
                          (2,(b26, SDLt.surfaceGetWidth b26)), 
                          (3,(b30, SDLt.surfaceGetWidth b30)),
                          (4,(b35, SDLt.surfaceGetWidth b35)),
                          (5,(b40, SDLt.surfaceGetWidth b40))]

fontsRessources :: IO (Array Integer Font)
fontsRessources = do
--  fn <- getDataFileName "C64_User_Mono_v1.0-STYLE.ttf"
  fn <- getDataFileName "20THCENT.TTF"

  f1 <- TTF.openFont fn 14 --8
  f2 <- TTF.openFont fn 16 -- 9
  f3 <- TTF.openFont fn 18 --10

  f4 <- TTF.openFont fn 30 -- for messages
  f5 <- TTF.openFont fn 20 -- for marking designated player
  return $ array (1,5) [(1,f1),(2,f2),(3,f3),(4,f4),(5,f5)]

chalkFontsRessources :: IO Font
chalkFontsRessources = do
  fn <- getDataFileName "SqueakyChalkSound.ttf"
  TTF.openFont fn 14
--  setFontStyle f [StyleBold]

bigChalkFonts :: IO Font
bigChalkFonts = do
  fn <- getDataFileName "SqueakyChalkSound.ttf"
  TTF.openFont fn 20

pitchRessources :: Surface -> IO Surface
pitchRessources screen = do
    fn <- getDataFileName "chalkboard.png"
    pitch <- SDLi.load fn
    convertSurface pitch (surfaceGetPixelFormat screen) []

soundRessources :: IO (Chunk, Chunk, Chunk)
soundRessources = do
    fnt <- getDataFileName "tockH.wav"
    t <- loadWAV fnt

    fnk <- getDataFileName "ballM.wav"
    k <- loadWAV fnk

    fnw <- getDataFileName "whistle.wav"
    w <- loadWAV fnw
    return (t, k, w)