-- | -- Copyright : (c) Ivan Perez & Henrik Nilsson, 2014. -- License : See LICENSE file. -- Maintainer : Ivan Perez -- -- Audio and video renderer. module Display where -- External imports import Control.Applicative ((<$>)) import Control.Monad import Control.Monad.IO.Class import Control.Monad.IfElse import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import Data.IORef import Data.Maybe import Graphics.UI.SDL as SDL import Graphics.UI.SDL.Image as Image import qualified Graphics.UI.SDL.TTF as TTF -- Internal imports import Audio import Constants import GameState import Levels import Objects import Paths_haskanoid import Resources hiding (audio) -- * Initialization initializeDisplay :: IO () initializeDisplay = do -- Initialise SDL SDL.init [InitEverything] initAudio initGraphs :: IO () initGraphs = do -- Create window screen <- SDL.setVideoMode (round width) (round height) 32 [SWSurface] SDL.setCaption "Test" "" -- Important if we want the keyboard to work right (I don't know -- how to make it work otherwise) SDL.enableUnicode True -- Hide mouse SDL.showCursor False -- * Rendering and Sound -- | Loads new resources, renders the game state using SDL, and adjusts music. render :: ResourceMgr -> GameState -> IO() render resourceManager shownState = do resources <- loadNewResources resourceManager shownState audio resources shownState display resources shownState -- ** Audio audio :: Resources -> GameState -> IO() audio resources shownState = do -- Start bg music if necessary playing <- musicPlaying unless playing $ awhen (bgMusic resources) playMusic -- Play object hits mapM_ (audioObject resources) $ gameObjects shownState audioObject :: Resources -> Object -> IO () audioObject resources object = when (objectHit object) $ case objectKind object of (Block _ _) -> playFile (blockHitSnd resources) 3000 _ -> return () -- ** Painting display :: Resources -> GameState -> IO() display resources shownState = do -- Obtain surface screen <- getVideoSurface -- Paint screen green let format = surfaceGetPixelFormat screen -- Paint background awhen (bgImage resources) $ \bg' -> void $ do let bg = imgSurface bg' let rectBg = SDL.Rect 0 0 (round width) (round height) SDL.blitSurface bg Nothing screen $ Just rectBg hud <- createRGBSurface [SWSurface] (round width) (round gameTop) 32 0xFF000000 0x00FF0000 0x0000FF00 0x000000FF paintGeneral hud resources (gameInfo shownState) let rectHud = SDL.Rect 0 0 (round width) (round gameTop) SDL.blitSurface hud Nothing screen $ Just rectHud -- The following line is BIG_ENDIAN specific -- The 32 is important because we are using Word32 for the masks -- FIXME: Should I use HWSurface and possibly other flags (alpha?)? surface <- createRGBSurface [SWSurface] (round gameWidth) (round gameHeight) 32 0xFF000000 0x00FF0000 0x0000FF00 0x000000FF paintGeneralMsg surface resources (gameStatus (gameInfo shownState)) mapM_ (paintObject resources surface) $ gameObjects shownState let rect = SDL.Rect (round gameLeft) (round gameTop) (round gameWidth) (round gameHeight) SDL.blitSurface surface Nothing screen $ Just rect -- Double buffering SDL.flip screen paintGeneral :: Surface -> Resources -> GameInfo -> IO () paintGeneral screen resources over = void $ do -- Paint screen green let format = surfaceGetPixelFormat screen bgColor <- mapRGB format 0x11 0x22 0x33 fillRect screen Nothing bgColor paintGeneralHUD screen resources over paintGeneralMsg :: Surface -> Resources -> GameStatus -> IO () paintGeneralMsg screen resources GamePlaying = return () paintGeneralMsg screen resources GamePaused = paintGeneralMsg' screen resources "Paused" paintGeneralMsg screen resources (GameLoading n) = paintGeneralMsg' screen resources ("Level " ++ show n) paintGeneralMsg screen resources GameOver = paintGeneralMsg' screen resources "GAME OVER!!!" paintGeneralMsg screen resources GameFinished = paintGeneralMsg' screen resources "You won!!! Well done :)" paintGeneralMsg' :: Surface -> Resources -> String -> IO () paintGeneralMsg' screen resources msg = void $ do let font = resFont resources message <- TTF.renderTextSolid (unFont font) msg (SDL.Color 128 128 128) let x = (SDL.surfaceGetWidth screen - w) `div` 2 y = (SDL.surfaceGetHeight screen - h) `div` 2 w = SDL.surfaceGetWidth message h = SDL.surfaceGetHeight message SDL.blitSurface message Nothing screen $ Just (SDL.Rect x y w h) paintGeneralHUD :: Surface -> Resources -> GameInfo -> IO () paintGeneralHUD screen resources over = void $ do let font = unFont $ resFont resources message1 <- TTF.renderTextSolid font ("Level: " ++ show (gameLevel over)) (SDL.Color 128 128 128) let w1 = SDL.surfaceGetWidth message1 h1 = SDL.surfaceGetHeight message1 SDL.blitSurface message1 Nothing screen $ Just (SDL.Rect 10 10 w1 h1) message2 <- TTF.renderTextSolid font ("Points: " ++ show (gamePoints over)) (SDL.Color 128 128 128) let w2 = SDL.surfaceGetWidth message2 h2 = SDL.surfaceGetHeight message2 SDL.blitSurface message2 Nothing screen $ Just (SDL.Rect 10 (10 + h2 + 5) w2 h2) message3 <- TTF.renderTextSolid font ("Lives: " ++ show (gameLives over)) (SDL.Color 128 128 128) let rightMargin = SDL.surfaceGetWidth screen w2 = SDL.surfaceGetWidth message3 h2 = SDL.surfaceGetHeight message3 SDL.blitSurface message3 Nothing screen $ Just (SDL.Rect (rightMargin - 10 - w2) 10 w2 h2) -- | Paints a game object on a surface. paintObject :: Resources -> Surface -> Object -> IO () paintObject resources screen object = case objectKind object of (Paddle (w, h)) -> void $ do let bI = imgSurface $ paddleImg resources t <- mapRGB (surfaceGetPixelFormat bI) 0 255 0 setColorKey bI [SrcColorKey, RLEAccel] t SDL.blitSurface bI Nothing screen $ Just (SDL.Rect x y (round w) (round h)) (Block e (w, h)) -> void $ do let bI = imgSurface $ blockImage e SDL.blitSurface bI Nothing screen $ Just (SDL.Rect x y (round w) (round h)) (Ball r) -> void $ do let x' = x - round r y' = y - round r sz = round (2 * r) -- b <- convertSurface -- (imgSurface $ ballImg resources) -- (format) -- [] let bI = imgSurface $ ballImg resources t <- mapRGB (surfaceGetPixelFormat bI) 0 255 0 setColorKey bI [SrcColorKey, RLEAccel] t SDL.blitSurface bI Nothing screen $ Just (SDL.Rect x' y' sz sz) _ -> return () where format = surfaceGetPixelFormat screen p = objectPos object x = round (fst p) y = round (snd p) blockImage 3 = block1Img resources blockImage 2 = block2Img resources blockImage n = block3Img resources -- * Resource management newtype ResourceMgr = ResourceMgr { unResMgr :: IORef ResourceManager } data ResourceManager = ResourceManager { lastKnownStatus :: GameStatus , resources :: Resources } -- | Includes all the assets needed at the current time in the game. data Resources = Resources { resFont :: Font , blockHitSnd :: Audio , bgImage :: Maybe Image , ballImg :: Image , block1Img :: Image , block2Img :: Image , block3Img :: Image , paddleImg :: Image , bgMusic :: Maybe Music } data Image = Image { imgName :: String, imgSurface :: Surface } data Font = Font { fontName :: String, unFont :: TTF.Font } -- | Ad-hoc resource loading -- -- This function is ad-hoc in two senses: first, because it has the paths to -- the files hard-coded inside. And second, because it loads the specific -- resources that are needed, not a general loadResources :: IO (Maybe ResourceMgr) loadResources = runMaybeT $ do -- Font initialization ttfOk <- lift TTF.init gameFont <- liftIO $ getDataFileName "data/lacuna.ttf" -- Load the fonts we need font <- liftIO $ TTF.tryOpenFont gameFont 32 -- What does the 32 do? let myFont = fmap (Font gameFont) font blockHit <- liftIO $ loadAudio =<< getDataFileName "data/196106_aiwha_ding-cc-by.wav" -- bgM <- liftIO $ loadMusic "Ckotty_-_Game_Loop_11.ogg" -- bgM <- liftIO $ loadMusic "data/level0.mp3" -- let levelBg = "data/level0.png" -- img <- lift $ fmap (Image levelBg) $ load levelBg ballImg <- liftIO $ getDataFileName "data/ball2.png" ball <- lift $ Image ballImg <$> load ballImg b1Img <- liftIO $ getDataFileName "data/block1.png" b1 <- lift $ Image b1Img <$> load b1Img b2Img <- liftIO $ getDataFileName "data/block2.png" b2 <- lift $ Image b2Img <$> load b2Img b3Img <- liftIO $ getDataFileName "data/block3.png" b3 <- lift $ Image b3Img <$> load b3Img paddleImg <- liftIO $ getDataFileName "data/paddleBlu.png" paddle <- lift $ Image paddleImg <$> load paddleImg -- Start playing music -- when (isJust bgM) $ lift (playMusic (fromJust bgM)) -- Return Nothing or embed in Resources res <- case (myFont, blockHit) of (Just f, Just b) -> return $ Resources f b Nothing ball b1 b2 b3 paddle Nothing _ -> do liftIO $ putStrLn "Some resources could not be loaded" mzero liftIO $ ResourceMgr <$> newIORef (ResourceManager GameStarted res) loadNewResources :: ResourceMgr -> GameState -> IO Resources loadNewResources mgr state = do manager <- readIORef (unResMgr mgr) let oldState = lastKnownStatus manager newState = gameStatus (gameInfo state) oldResources = resources manager newResources <- case newState of (GameLoading _) | newState /= oldState -> updateAllResources oldResources newState _ -> return oldResources let manager' = ResourceManager { lastKnownStatus = newState , resources = newResources } writeIORef (unResMgr mgr) manager' return newResources updateAllResources :: Resources -> GameStatus -> IO Resources updateAllResources res (GameLoading n) = do -- Load new music let newMusicFP' = _resourceFP $ levelMusic $ levels !! n newMusicFP <- getDataFileName newMusicFP' let oldMusic = bgMusic res oldMusicFP = maybe "" musicName oldMusic newMusic <- if oldMusicFP == newMusicFP then return oldMusic else do -- Loading can fail, in which case we continue with the -- old music bgM <- loadMusic newMusicFP if isNothing bgM then do putStrLn $ "Could not load resource " ++ newMusicFP return oldMusic else do stopMusic return bgM -- Load new background let newBgFP' = _resourceFP $ levelBg $ levels !! n newBgFP <- getDataFileName newBgFP' let oldBg = bgImage res oldBgFP = maybe "" imgName oldBg newBg <- if oldBgFP == newBgFP then return oldBg else do img' <- load newBgFP return $ Just (Image newBgFP img') return (res { bgImage = newBg, bgMusic = newMusic })