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)