fallingblocks-0.1.3: src/GameController.hs

module GameController where

import Graphics.UI.SDL as SDL
import Graphics.UI.SDL.TTF as TTF

import Board
import Game
import Shape
import Helpers
import GameState
import GraphicsInfo

-- Takes a list of events and a game state and returns a modified gamestate
handleGameEvents :: [Event] -> GameState -> GameState
handleGameEvents [] gs = gs
handleGameEvents ((KeyUp (Keysym SDLK_q _ _)):es) gs = gs { keepGoing = False}
handleGameEvents (e:es) gs = handleGameEvents es (gs' themove)
    where gs' Nothing = gs
          gs' (Just m) = gs { game = move (game gs) m }
          themove = 
              case e of 
                (KeyDown (Keysym SDLK_LEFT _ _))  -> Just MoveLeft
                (KeyDown (Keysym SDLK_RIGHT _ _)) -> Just MoveRight
                (KeyDown (Keysym SDLK_UP _ _)) -> Just Rotate
                (KeyDown (Keysym SDLK_DOWN _ _)) -> Just MoveDown
                otherwise  -> Nothing
         

-- Renders the current game state
renderGameState:: GameState -> IO ()
renderGameState gs = do
  let gri = grInfo gs
      g = game gs
      s = screen gri
      fnt = font gri

  -- Clear the screen
  worked <- fillRect s
            Nothing
            (Pixel 0)

  title <- renderTextSolid (titlefont gri) "FALLING BLOCKS!" (Color 255 0 0)
  blitSurface title Nothing s (Just (Rect 10 10 200 0))
  
--  scoreMessage <- renderTextSolid fnt ("Score:" ++ (show (score g))) (Color 255 0 0)
--  blitSurface scoreMessage Nothing s (Just (Rect 220 45 200 0))

  screenText "Score" fnt s 220 45
  screenText (show $ score g) fnt s 220 70

  screenText "Lines" fnt s 220 100
  screenText (show $ numLines g) fnt s 220 125

  screenText "Level" fnt s 220 155
  screenText (show $ curLevel g) fnt s 220 190
  
  screenText "Next" fnt s 220 220
  
  sequence_ [drawBlock x (nrows - y) 20 60 (colorAt g (x, y)) gri s
             | x <- [0..ncols], y <- [0..nrows]]

  drawBlockRect (bkgdblock gri) s

  drawNextBlock (nextBlock g) g gri

  if not . stillRunning $ game gs
   then do 
     gameOver <- renderTextSolid (titlefont gri) "Game Over!" (Color 255 0 0)
     blitSurface gameOver Nothing s (Just (Rect 50 200 200 0))
   else return False

  SDL.flip s

screenText :: String -> Font -> Surface -> Int -> Int -> IO Bool
screenText msg fnt s x y = do  
  screenMessage <- renderTextSolid fnt msg (Color 255 0 0)
  blitSurface screenMessage Nothing s (Just (Rect x y 200 0))


drawNextBlock :: (Maybe Block) -> Game -> GraphicsInfo -> IO ()
drawNextBlock Nothing _ _ = return ()
drawNextBlock (Just b) g gri = sequence_ [drawBlock (-1 * x)
 y 250 260 
                                        (Just . typeColor $ blockType b) gri s 
                                            | (x, y) <- blockPos b]
    where s = screen gri


--Change to take in coordinates
drawBlockRect :: Surface -> Surface -> IO ()
drawBlockRect block screen = do
  sequence_ [db2 x y block screen | x <- [0, ncols + 2],  y <- [0..nrows + 2]]
  sequence_ [db2 x y block screen | x <- [0 .. ncols + 2], y<- [0, nrows + 2]]
 
db2 :: Int -> Int -> Surface -> Surface -> IO Bool
db2 x y block screen
    = blitSurface block
      Nothing 
      screen
      (Just (Rect ((x * 15) + 5) ((y * 15) + 45) 15 15))
  

drawBlock :: Int -> Int -> Int -> Int -> Maybe Helpers.Color -> GraphicsInfo -> Surface -> IO Bool
drawBlock _ _ _ _ Nothing _ _ = return False
drawBlock x y xoff yoff (Just c) gri screen
    = blitSurface
      (getBlockSurface gri c)
      Nothing 
      screen
      (Just (Rect ((x * 15)+ xoff) ((y * 15) + yoff) 15 15))