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)