module RenderUtil where import Control.Monad import qualified Graphics.UI.SDL as SDL hiding (init) import qualified Graphics.UI.SDL.TTF as SDL import Graphics.Rendering.OpenGL as GL import Data.Map as M import Utilities import States import StaticInterface import Static import RenderInterface import Pic -- * Some text colours textColour, userInputColour, messageColour :: SDL.Color textColour = SDL.Color {SDL.colorRed = 255, SDL.colorGreen = 255, SDL.colorBlue = 255} userInputColour = SDL.Color {SDL.colorRed = 200, SDL.colorGreen = 200, SDL.colorBlue = 255} messageColour = SDL.Color {SDL.colorRed = 0, SDL.colorGreen = 0, SDL.colorBlue = 0} clearScreen :: IO () clearScreen = GL.clear [GL.ColorBuffer] showScreen :: IO () showScreen = do GL.flush SDL.glSwapBuffers --------------------------------------------------------------------------- -- * Render an SDLPic --------------------------------------------------------------------------- renderImg :: SDLPic -> Pos -> IO () renderImg = renderImgAttr defaultRenderAttr renderImgAnchor :: Anchor -> SDLPic -> Pos -> IO () renderImgAnchor anchor = renderImgAttr (defaultRenderAttr { ra_anchor = anchor }) fadeOutImg :: SDLPic -> Pos -> Int -> Int -> IO () fadeOutImg pic pos t et = renderImgAttr (defaultRenderAttr { ra_fade = FadeOut fading_duration (et - t) }) pic pos renderImgAttr :: RenderAttr -> SDLPic -> Pos -> IO () renderImgAttr attr pic = renderSpriteAttr attr (sdlPicToSprite pic) () data RenderAttr = RenderAttr { ra_anchor :: Anchor , ra_fade :: Fade , ra_scale :: Double } -- etc -- | The anchor specifies the position of the point that's -- passed. The result is the upper left and lower right -- corner in OpenGL terms. data Anchor = TopLeft | Centre | TopRight | TopCentre data Fade = NoFade | FadeIn Int Int | FadeOut Int Int defaultRenderAttr = RenderAttr Centre NoFade 1.0 type ScaledDim = (Double, Double) anchorTransform :: Anchor -> Pos -> ScaledDim -> (Pos, Pos) anchorTransform TopCentre (x,y) (w,h) = let w2 = w / 2 in ((x - w2, y), (x + w2, y + h)) anchorTransform Centre (x,y) (w,h) = let w2 = w / 2 h2 = h / 2 in ((x - w2, y - h2), (x + w2, y + h2)) anchorTransform TopLeft (x,y) (w,h) = ((x,y), (x + w,y + h)) anchorTransform TopRight (x,y) (w,h) = ((x - w,y), (x, y + h)) renderSprite :: Ord a => SDLSprite a -> a -> Pos -> IO () renderSprite = renderSpriteAttr defaultRenderAttr renderSpriteAttr :: Ord a => RenderAttr -> SDLSprite a -> a -> Pos -> IO () renderSpriteAttr (RenderAttr anchor fade scale) pic o pos = do let img = sdl_image (sdl_sprite pic) let (w,h) = sdl_dim (sdl_sprite pic) let (tw,th) = sdl_tiledim pic let dim = (scale * fromIntegral tw, scale * fromIntegral th) let op = sdl_offsets pic M.! o -- here, we adapt the alpha channel ... let alpha :: Float alpha = case fade of NoFade -> 1 FadeIn dur dt -> 1 - (fromIntegral dt / fromIntegral dur) FadeOut dur dt -> fromIntegral dt / fromIntegral dur GL.color (GL.Color4 1 1 1 (alpha :: Float)) GL.texture GL.Texture2D $= GL.Enabled GL.textureBinding GL.Texture2D $= Just img GL.textureFunction $= GL.Modulate GL.renderPrimitive GL.Quads $ do let x0, x1, y0, y1, sx, sy, tx, ty :: Double ((x0,y0),(x1,y1)) = anchorTransform anchor pos dim sx = nextPowerOfTwoFraction op w sy = nextPowerOfTwoFraction 0 h tx = nextPowerOfTwoFraction (op + tw) w ty = nextPowerOfTwoFraction h h GL.texCoord (GL.TexCoord2 (sx :: Double) sy) GL.vertex (GL.Vertex2 x0 y0) GL.texCoord (GL.TexCoord2 (tx :: Double) sy) GL.vertex (GL.Vertex2 x1 y0) GL.texCoord (GL.TexCoord2 (tx :: Double) ty) GL.vertex (GL.Vertex2 x1 y1) GL.texCoord (GL.TexCoord2 (sx :: Double) ty) GL.vertex (GL.Vertex2 x0 y1) return () -- TODO: parametrise fading_duration :: Int fading_duration = 30 fadeOutSprite :: Ord a => SDLSprite a -> a -> Pos -> Int -> Int -> IO () fadeOutSprite pic o pos t et = renderSpriteAttr (defaultRenderAttr { ra_fade = FadeOut fading_duration (et - t) }) pic o pos renderAnimation :: SDLAnimation -> Int -> Pos -> IO () renderAnimation (SDLAnimation sprite descr) t pos = renderSprite sprite (descr t) pos renderAnimationAttr :: RenderAttr -> SDLAnimation -> Int -> Pos -> IO () renderAnimationAttr ra (SDLAnimation sprite descr) t pos = renderSpriteAttr ra sprite (descr t) pos --------------------------------------------------------------------------- -- * Render text --------------------------------------------------------------------------- renderTextFontAttr :: String -> SDL.Color -> Pos -> SDL.Font -> RenderAttr -> IO () renderTextFontAttr txt c pos fnt attr = do rtxt <- SDL.renderTextBlended fnt txt c pic <- convertSurface (SDL.surfaceGetWidth rtxt, SDL.surfaceGetHeight rtxt) rtxt renderImgAttr attr pic pos GL.deleteObjectNames [ sdl_image pic ] renderTextFontAnchor :: String -> SDL.Color -> Pos -> SDL.Font -> Anchor -> IO () renderTextFontAnchor txt c pos fnt anchor = renderTextFontAttr txt c pos fnt (defaultRenderAttr { ra_anchor = anchor }) renderTextCFnt :: String -> SDL.Color -> Pos -> SDL.Font -> IO () renderTextCFnt txt c pos fnt = renderTextFontAnchor txt c pos fnt TopCentre renderText :: String -> SDL.Color -> Pos -> Static -> IO () renderText txt c pos st = let fnt = font (fonts st) in renderTextFontAnchor txt c pos fnt TopLeft renderTextC :: String -> SDL.Color -> Pos -> Static -> IO () renderTextC txt c pos st = let fnt = font (fonts st) in renderTextFontAnchor txt c pos fnt Centre renderBigText :: String -> SDL.Color -> Pos -> Static -> IO () renderBigText txt c pos st = let bigfnt = bigfont (fonts st) in renderTextFontAnchor txt c pos bigfnt TopLeft renderTexts :: [String] -> SDL.Color -> Pos -> Static -> IO () renderTexts txts c (x,y) st = let fnt = font (fonts st) in renderGLines (x,y) fnt txts renderBigTextR :: String -> SDL.Color -> Pos -> Static -> IO () renderBigTextR txt c pos st = let bigfnt = bigfont (fonts st) in renderTextFontAnchor txt c pos bigfnt TopRight renderBigTextC :: String -> SDL.Color -> Pos -> Static -> IO () renderBigTextC txt c pos st = let bigfnt = bigfont (fonts st) in renderTextFontAnchor txt c pos bigfnt Centre fadeOutBigTextC :: String -> SDL.Color -> Pos -> Static -> Int -> Int -> IO () fadeOutBigTextC txt c pos st t et = let bigfnt = bigfont (fonts st) in renderTextFontAttr txt c pos bigfnt (defaultRenderAttr { ra_anchor = Centre, ra_fade = FadeOut fading_duration (et - t) }) --------------------------------------------------------------------------- -- * Render lines in SDL --------------------------------------------------------------------------- renderGLinesAnchor :: Anchor -> Pos -> SDL.Font -> [String] -> IO () renderGLinesAnchor anchor pos fnt [] = return () renderGLinesAnchor anchor pos@(x,y) fnt (s:ss) = do renderTextFontAnchor s textColour pos fnt anchor baselineskip <- SDL.fontLineSkip fnt let npos = (x, y + fromIntegral baselineskip) renderGLinesAnchor anchor npos fnt ss renderGLines, renderGLinesR :: Pos -> SDL.Font -> [String] -> IO () renderGLines = renderGLinesAnchor TopLeft renderGLinesR = renderGLinesAnchor TopRight