Graphics.hs

module Game.HSnake.Graphics where

import Game.HSnake.Basic
import Game.HSnake.Board
import Game.HSnake.Game
import Game.HSnake.Player
import Game.HSnake.Snake


import Control.Lens
import Control.Monad.IO.Class (MonadIO(..))
import Data.Text (pack)
import qualified Data.Vector.Storable as DVS
import Data.Word
import Linear
import Linear.Affine
import Foreign.C.Types (CInt(..))
import qualified SDL
import qualified SDL.Font as SDLF


type SDLRect = SDL.Rectangle CInt


setColor :: SDL.Renderer -> Colour -> IO ()
setColor r White  = SDL.rendererDrawColor r SDL.$= SDL.V4 maxBound maxBound maxBound maxBound
setColor r Red    = SDL.rendererDrawColor r SDL.$= SDL.V4 maxBound 0 0 maxBound
setColor r Green  = SDL.rendererDrawColor r SDL.$= SDL.V4 0 maxBound 0 maxBound
setColor r Blue   = SDL.rendererDrawColor r SDL.$= SDL.V4 0 0 maxBound maxBound
setColor r Yellow = SDL.rendererDrawColor r SDL.$= SDL.V4 maxBound maxBound 0 maxBound
setColor r Black = SDL.rendererDrawColor r SDL.$= SDL.V4 0 0 0 maxBound

sdlColor :: Colour -> SDLF.Color
sdlColor Black = SDL.V4 0 0 0 maxBound
sdlColor White = SDL.V4 maxBound maxBound maxBound maxBound

screenWidth :: Int
screenWidth   = 640
screenHeight :: Int
screenHeight  = 480
screenBpp :: Int
screenBpp     = 32

gameScreenWidth :: Int
gameScreenWidth   = 540
gameScreenHeight :: Int
gameScreenHeight  = 400

messageScreenWidth :: Int
messageScreenWidth = screenWidth - gameScreenWidth
messageScreenHeight :: Int
messageScreenHeight = screenHeight - gameScreenHeight

rectWidth :: Int
rectWidth  = gameScreenWidth `div` numRectsX
rectHeight :: Int
rectHeight = gameScreenHeight `div` numRectsY


rectFromPoint :: Game.HSnake.Basic.Point -> SDLRect
rectFromPoint (Game.HSnake.Basic.Point x y) = SDL.Rectangle startPoint size
                where
                    startX = (x - 1)*rectWidth + 1
                    startY = (y - 1)*rectHeight + 1
                    width  = rectWidth - 1
                    height = rectHeight - 1
                    startPoint = P $ V2 (fromIntegral startX) (fromIntegral startY)
                    size = V2 (fromIntegral width) (fromIntegral height)


rects = [rectFromPoint (Game.HSnake.Basic.Point ptx pty) | ptx <- [1..numRectsX], pty <- [1..numRectsY]]
rectsVec = DVS.generate (numRectsX * numRectsY)
  (\i -> rects !! i )


paintRects :: SDL.Renderer -> Colour -> IO ()
paintRects r color = do
  setColor r color
  SDL.fillRects r rectsVec

paintBoard :: SDL.Renderer -> IO ()
paintBoard r = do
  paintRects r White

paintApple :: SDL.Renderer -> Game.HSnake.Basic.Point -> IO ()
paintApple r ap = do
  setColor r Red
  SDL.fillRect r $ Just rect
  where
    rect = rectFromPoint ap

-- | TODO: paint different snakes with different colors
paintPlayer :: SDL.Renderer -> Player -> IO ()
paintPlayer r p = paintSnake r (p^.snake) (p^.colour)


paintSnake :: SDL.Renderer -> Snake -> Colour -> IO ()
paintSnake r s c =
  mapM_ (\p -> paintSnakePiece r (rectFromPoint p) c) (s^.position)

paintSnakePiece :: SDL.Renderer -> SDLRect -> Colour -> IO ()
paintSnakePiece r rect c = do
  setColor r c
  SDL.fillRect r $ Just rect

showGameMessages :: SDL.Window -> GameState -> IO ()
showGameMessages w gameState = do
  font <- SDLF.load "liberation.ttf" 25

  surface <- SDLF.solid font color levelMessage

  screen <- SDL.getWindowSurface w

  renderSurfaceToWindow w screen surface startPoint

  SDL.freeSurface screen
  SDL.freeSurface surface
  SDLF.free font

  where
    levelMessage = pack $ "Level " ++ (show $ gameState^.level)
    color = sdlColor White
    startPoint = P $ V2 (fromIntegral gameScreenWidth) 0

renderSurfaceToWindow :: (MonadIO m) => SDL.Window -> SDL.Surface -> SDL.Surface -> (SDL.Point V2 CInt) -> m ()
renderSurfaceToWindow w s i startPoint = do
  SDL.surfaceBlit i Nothing s (Just startPoint)
  return ()

clearScreen :: SDL.Renderer -> IO ()
clearScreen r = do
  setColor r Black
  SDL.clear r

clearSurface :: SDL.Surface -> IO ()
clearSurface s = do
  SDL.surfaceFillRect s Nothing (sdlColor Black)