4Blocks-0.2: Interface/OnePlayerModeWindow.hs

module Interface.OnePlayerModeWindow ( onePlayerMode )

where

import Core.Game
import Core.Commands
import Rendering.Engine
import Interface.CommandKeys
import Interface.WindowUpdate

import Random
import Control.Monad.State
import Control.Concurrent
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.Events
import qualified Data.Set as Set; import Data.Set (Set)
import Data.IORef;

------------------------------------------------------------------------------------------------------ 
-- Setup one player mode
onePlayerMode :: DrawingArea -> Window -> IO ()
onePlayerMode canvas window
  = do -- ioref for set of keys pressed
       keysIORef <- newIORef (Set.empty)
       
       -- get global random seed
       seed <- newStdGen
       
       -- mutable variable for game state
       gameMVar <- newMVar $ standardRandomGame seed
       
       -- gravity delay loop
       updateWindowWithGravityDelay canvas gameMVar
       
       drawin <- widgetGetDrawWindow canvas
       
       onExpose canvas (\x -> do game <- readMVar gameMVar
                                 renderWithDrawable drawin $ renderOnePlayerScreen game
                                 return (eventSent x))
           
       -- Shift Left Brick
       setupCommandKeyShiftBrick "Left" window canvas shift_brick_left gameMVar
       setupCommandKeyShiftBrick "A" window canvas shift_brick_left gameMVar
       setupCommandKeyShiftBrick "a" window canvas shift_brick_left gameMVar
       
       -- Shift Right Brick
       setupCommandKeyShiftBrick "Right" window canvas shift_brick_right gameMVar
       setupCommandKeyShiftBrick "D" window canvas shift_brick_right gameMVar
       setupCommandKeyShiftBrick "d" window canvas shift_brick_right gameMVar
       
       -- Soft Drop Brick
       setupCommandKeyShiftBrick "Down" window canvas soft_drop_brick gameMVar
       setupCommandKeyShiftBrick "S" window canvas soft_drop_brick gameMVar
       setupCommandKeyShiftBrick "s" window canvas soft_drop_brick gameMVar
       
       -- Hard Drop Brick
       setupCommandKeyShiftBrick "Up" window canvas drop_lock_clear_next_brick gameMVar
       setupCommandKeyShiftBrick "W" window canvas drop_lock_clear_next_brick gameMVar
       setupCommandKeyShiftBrick "w" window canvas drop_lock_clear_next_brick gameMVar       
       
       -- Rotate Left Brick
       setupCommandKeyRotateBrick "q" window canvas rotate_brick_left gameMVar keysIORef 
       setupCommandKeyRotateBrick "Q" window canvas rotate_brick_left gameMVar keysIORef
       setupCommandKeyRotateBrick "comma" window canvas rotate_brick_left gameMVar keysIORef
                    
       -- Rotate Right Brick
       setupCommandKeyRotateBrick "e" window canvas rotate_brick_right gameMVar keysIORef
       setupCommandKeyRotateBrick "E" window canvas rotate_brick_right gameMVar keysIORef
       setupCommandKeyRotateBrick "period" window canvas rotate_brick_right gameMVar keysIORef
       
       -- Pause/Resume Game
       setupCommandKeyPauseResumeGame "p" window canvas pause_resume gameMVar keysIORef
       setupCommandKeyPauseResumeGame "P" window canvas pause_resume gameMVar keysIORef
       
       return ()