Rasenschach-0.1: RenderUtil.hs

module RenderUtil where

import FRP.Yampa.Geometry

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 Physics
import Global
import Paths_Rasenschach

fi a = fromIntegral a

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

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

-- Geometrie

winHeight = 1050 :: Double
winWidth = 1195 :: Double

ratio param = 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 (x,y) = (meterToPixel param $ (pLeftBorderX param) + x,
                            meterToPixel param $ (pUpperBorderY param) + y)

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

    fn13 <- getDataFileName "13ball.png"
    png13 <- SDLi.load fn13
    b13 <- convertSurface png13 (surfaceGetPixelFormat screen) []
    setColorKey b13 [SrcColorKey, RLEAccel] t

    fn15 <- getDataFileName "15ball.png"
    png15 <- SDLi.load fn15
    b15 <- convertSurface png15 (surfaceGetPixelFormat screen) []
    setColorKey b15 [SrcColorKey, RLEAccel] t

    fn17 <- getDataFileName "17ball.png"
    png17 <- SDLi.load fn17
    b17 <- convertSurface png17 (surfaceGetPixelFormat screen) []
    setColorKey b17 [SrcColorKey, RLEAccel] t

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

    fn25 <- getDataFileName "25ball.png"
    png25 <- SDLi.load fn25
    b25 <- convertSurface png25 (surfaceGetPixelFormat screen) []
    setColorKey b25 [SrcColorKey, RLEAccel] t

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

    return $ array (0,5) [(0,(b13, SDLt.surfaceGetWidth b13)),
                          (1,(b15, SDLt.surfaceGetWidth b15)),
                          (2,(b17, SDLt.surfaceGetWidth b17)),
                          (3,(b20, SDLt.surfaceGetWidth b20)),
                          (4,(b25, SDLt.surfaceGetWidth b25)),
                          (5,(b30, SDLt.surfaceGetWidth b30))]

fontsRessources = do
--  fn <- getDataFileName "C64_User_Mono_v1.0-STYLE.ttf"
  fn <- getDataFileName "20THCENT.TTF"

  f1 <- TTF.openFont fn 8
  f2 <- TTF.openFont fn 9
  f3 <- TTF.openFont fn 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 = do
  fn <- getDataFileName "SqueakyChalkSound.ttf"
  TTF.openFont fn 14
--  setFontStyle f [StyleBold]

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

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

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)