content: -- |
  -- Copyright  : (c) Ivan Perez & Henrik Nilsson, 2014.
  -- License    : See LICENSE file.
  -- Maintainer : Ivan Perez <ivan.perez@keera.co.uk>
  --
  -- 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 })
  