src/Game.hs

   1 module Game (gameSettings, G.getStdGen, G.playGame) where
   2
   3 import Data.Bifunctor (bimap)
   4 import Data.Char (toUpper)
   5 import Data.Maybe (listToMaybe)
   6 import System.Random (Random(..))
   7 import qualified Control.Monad.State as S
   8 import qualified Terminal.Game as G
   9
  10 type RandomState = S.State G.StdGen
  11
  12 data Screen = TitleScreen | HelpScreen | GameScreen
  13
  14 data Direction = U | D | L | R deriving (Bounded, Enum)
  15
  16 instance Random Direction where
  17   random g = randomR (minBound, maxBound) g
  18   randomR (lower, upper) g = case randomR (fromEnum lower, fromEnum upper) g of (r, g') -> (toEnum r, g')
  19
  20 data Player
  21 data Box
  22 data Enemy
  23
  24 data Character t = Character { entityCoords :: !G.Coords
  25                              , entityDirection :: !(Maybe Direction) }
  26
  27 drawPlayer :: Character Player -> (G.Coords, G.Plane)
  28 drawPlayer character = (entityCoords character, G.color G.Blue G.Vivid $ G.cell 'P')
  29
  30 drawBox :: Character Box -> (G.Coords, G.Plane)
  31 drawBox character = (entityCoords character, G.color G.Green G.Dull $ G.cell 'O')
  32
  33 drawEnemy :: Character Enemy -> (G.Coords, G.Plane)
  34 drawEnemy character = (entityCoords character, G.color G.Red G.Vivid $ G.cell 'X')
  35
  36 drawBorder :: (G.Coords, G.Plane)
  37 drawBorder = do
  38   let outerBorder = G.box '%' (fst bottomRightBoundary) (snd bottomRightBoundary)
  39   let innerBlank = bimap (+ 1) (+ 1) topLeftBoundary G.% G.box ' ' (fst bottomRightBoundary - 2) (snd bottomRightBoundary - 2)
  40   (topLeftBoundary, outerBorder G.& innerBlank)
  41
  42 drawScore :: State -> (G.Coords, G.Plane)
  43 drawScore state = ((snd bottomRightBoundary, fst topLeftBoundary), G.stringPlane $ "Score: " <> show (stateScore state))
  44
  45 drawTitle :: (G.Coords, G.Plane)
  46 drawTitle = (bimap (flip (-) 3) (flip (-) 6) centreCoords, G.stringPlane "==AVOIDANCE==\n\n\nMove: WASD\nHelp: H\nPlay: P\nQuit: Q")
  47
  48 drawHelp :: (G.Coords, G.Plane)
  49 drawHelp = (topLeftBoundary, G.textBox "Use W, A, S, and D to move up, left, down, and right respectively.\nPress Q during an active game to return to the main menu.\nPress Q while on the main menu to terminate the application.\n\nOBJECTIVE:\n\nPush the box around the screen, making sure that it is not pushed off the edge.\nBox thieves will appear sporadically to steal the box.\nYour objective is to keep the box on-screen for as long as possible.\n\n  P: Player\n  O: Box\n  X: Box Thief\n\nPress any key to return to the main menu." (fst bottomRightBoundary) (snd bottomRightBoundary))
  50
  51 drawBlank :: G.Plane
  52 drawBlank = G.blankPlane (fst bottomRightBoundary) (snd bottomRightBoundary)
  53
  54 data State = State { statePlayer :: !(Character Player)
  55                    , stateBox :: !(Character Box)
  56                    , stateEnemy :: ![Character Enemy]
  57                    , stateDifficulty :: !Int
  58                    , stateIsQuitting :: !Bool
  59                    , stateRandomGen :: !G.StdGen
  60                    , stateScreen :: !Screen
  61                    , stateScore :: !Int
  62                    }
  63
  64 gameSettings :: G.StdGen -> G.Game State
  65 gameSettings stdgen = G.Game { G.gScreenWidth = fst bottomRightBoundary
  66                              , G.gScreenHeight = snd bottomRightBoundary
  67                              , G.gFPS = 15
  68                              , G.gInitState = initState stdgen
  69                              , G.gLogicFunction = handleEvent
  70                              , G.gDrawFunction = render
  71                              , G.gQuitFunction = shouldQuit
  72                              }
  73
  74 initState :: G.StdGen -> State
  75 initState stdgen = State { statePlayer = initPlayer
  76                          , stateBox = initBox
  77                          , stateEnemy = initEnemies
  78                          , stateDifficulty = 1
  79                          , stateIsQuitting = False
  80                          , stateRandomGen = stdgen
  81                          , stateScreen = TitleScreen
  82                          , stateScore = 0
  83                          }
  84
  85 centreCoords :: G.Coords
  86 centreCoords = (centreCoord (snd topLeftBoundary) (snd bottomRightBoundary), centreCoord (fst topLeftBoundary) (fst bottomRightBoundary))
  87   where
  88     centreCoord lower upper = (+) lower $ flip div 2 $ upper - lower
  89
  90 initPlayer :: Character Player
  91 initPlayer = Character { entityCoords = centreCoords, entityDirection = Nothing }
  92
  93 initBox :: Character Box
  94 initBox = Character { entityCoords = limitCoords $ bimap (+ 1) (+ 1) centreCoords, entityDirection = Nothing }
  95
  96 initEnemies :: [Character Enemy]
  97 initEnemies = mempty
  98
  99 handleEvent :: State -> G.Event -> State
 100 handleEvent state (G.KeyPress key) = handleKeyPress state $ toUpper key
 101 handleEvent state G.Tick = handleTick state
 102
 103 handleTick :: State -> State
 104 handleTick state@(State { stateScreen = GameScreen }) = do
 105   let stateAfterEnemies = handleEnemies state
 106   let oldPlayer = statePlayer state
 107   let player = moveCharacter (entityDirection oldPlayer) oldPlayer
 108   let box = handleCollision player $ handleCollisions (stateEnemy stateAfterEnemies) (stateBox stateAfterEnemies)
 109   let newScore = stateScore stateAfterEnemies + 1
 110   if isOutOfBounds box then stateAfterEnemies { stateScreen = TitleScreen }
 111                        else stateAfterEnemies { statePlayer = resetDirection player, stateBox = box, stateScore = newScore, stateDifficulty = div newScore 200 + 1 }
 112 handleTick state = state
 113
 114 handleEnemies :: State -> State
 115 handleEnemies state = do
 116   let oldEnemies = stateEnemy state
 117   let randomGen1 = stateRandomGen state
 118   let maxEnemies = stateDifficulty state
 119   let (newEnemies, randomGen2) = flip S.runState (stateRandomGen state) $ randomRange (0, maxEnemies - length oldEnemies) >>= flip createEnemies oldEnemies
 120   let updatedEnemies = moveEnemies newEnemies
 121   state { stateEnemy = updatedEnemies, stateRandomGen = randomGen2 }
 122
 123 moveEnemies :: [Character Enemy] -> [Character Enemy]
 124 moveEnemies = filter (not . isOutOfBounds) . fmap (\character -> moveCharacter (entityDirection character) character)
 125
 126 createEnemies :: Int -> [Character Enemy] -> RandomState [Character Enemy]
 127 createEnemies 0 enemies = return enemies
 128 createEnemies enemiesToCreate enemies = createEnemy >>= createEnemies (enemiesToCreate - 1) . flip (:) enemies
 129
 130 createEnemy :: RandomState (Character Enemy)
 131 createEnemy = do
 132   randomDirection <- randomResult
 133   position <- enemyStartPosition randomDirection
 134   return $ Character { entityCoords = position, entityDirection = Just randomDirection }
 135
 136 randomAction :: (Random a) => (G.StdGen -> (a, G.StdGen)) -> RandomState a
 137 randomAction action = do
 138   randomGen <- S.get
 139   let (result, randomGenNew) = action randomGen
 140   S.put randomGenNew
 141   return result
 142
 143 randomResult :: (Random a) => RandomState a
 144 randomResult = randomAction random
 145
 146 randomRange :: (Random a) => (a, a) -> RandomState a
 147 randomRange bounds = randomAction $ G.getRandom bounds
 148
 149 enemyStartPosition :: Direction -> RandomState G.Coords
 150 enemyStartPosition U = randomRange (fst topLeftBoundary, fst bottomRightBoundary) >>= \column -> return (snd bottomRightBoundary, column)
 151 enemyStartPosition D = randomRange (fst topLeftBoundary, fst bottomRightBoundary) >>= \column -> return (snd topLeftBoundary, column)
 152 enemyStartPosition L = randomRange (snd topLeftBoundary, snd bottomRightBoundary) >>= \row -> return (row, fst bottomRightBoundary)
 153 enemyStartPosition R = randomRange (snd topLeftBoundary, snd bottomRightBoundary) >>= \row -> return (row, fst topLeftBoundary)
 154
 155 handleKeyPress :: State -> Char -> State
 156 handleKeyPress state@(State { stateScreen = TitleScreen }) 'Q' = state { stateIsQuitting = True }
 157 handleKeyPress state@(State { stateScreen = TitleScreen }) 'P' = state { statePlayer = initPlayer, stateBox = initBox, stateEnemy = initEnemies, stateDifficulty = 1, stateScreen = GameScreen, stateScore = 0 }
 158 handleKeyPress state@(State { stateScreen = TitleScreen }) 'H' = state { stateScreen = HelpScreen }
 159 handleKeyPress state@(State { stateScreen = HelpScreen }) _ = state { stateScreen = TitleScreen }
 160 handleKeyPress state@(State { stateScreen = GameScreen }) 'Q' = state { stateScreen = TitleScreen }
 161 handleKeyPress state@(State { stateScreen = GameScreen }) 'W' = state { statePlayer = updateDirection U (statePlayer state) }
 162 handleKeyPress state@(State { stateScreen = GameScreen }) 'S' = state { statePlayer = updateDirection D (statePlayer state) }
 163 handleKeyPress state@(State { stateScreen = GameScreen }) 'A' = state { statePlayer = updateDirection L (statePlayer state) }
 164 handleKeyPress state@(State { stateScreen = GameScreen }) 'D' = state { statePlayer = updateDirection R (statePlayer state) }
 165 handleKeyPress state _ = state
 166
 167 render :: State -> G.Plane
 168 render state@(State { stateScreen = TitleScreen }) = G.mergePlanes drawBlank $ drawTitle : drawScore state : []
 169 render state@(State { stateScreen = HelpScreen }) = G.mergePlanes drawBlank $ drawHelp : drawScore state : []
 170 render state@(State { stateScreen = GameScreen }) = do
 171   let playerPlane = drawPlayer $ statePlayer state
 172   let boxPlane = drawBox $ stateBox state
 173   let enemyPlanes = drawEnemy <$> stateEnemy state
 174   G.mergePlanes drawBlank $ drawBorder : drawScore state : playerPlane : boxPlane : enemyPlanes
 175
 176 shouldQuit :: State -> Bool
 177 shouldQuit = stateIsQuitting
 178
 179 boundaries :: (G.Coords, G.Coords)
 180 boundaries = ((1, 1), (80, 24))
 181
 182 topLeftBoundary :: G.Coords
 183 topLeftBoundary = fst boundaries
 184
 185 bottomRightBoundary :: G.Coords
 186 bottomRightBoundary = snd boundaries
 187
 188 resetDirection :: Character Player -> Character Player
 189 resetDirection character = character { entityDirection = Nothing }
 190
 191 updateDirection :: Direction -> Character Player -> Character Player
 192 updateDirection direction character = character { entityDirection = Just direction }
 193
 194 moveCharacter :: Maybe Direction -> Character t -> Character t
 195 moveCharacter (Just U) character = updatePosition (-1, 0) character
 196 moveCharacter (Just D) character = updatePosition (1, 0) character
 197 moveCharacter (Just L) character = updatePosition (0, -1) character
 198 moveCharacter (Just R) character = updatePosition (0, 1) character
 199 moveCharacter _ character = character
 200
 201 limitCoords :: G.Coords -> G.Coords
 202 limitCoords (a, b) = (limitCoord snd a, limitCoord fst b)
 203   where
 204     limitCoord projection a
 205       | a < projection topLeftBoundary = projection topLeftBoundary
 206       | a > projection bottomRightBoundary = projection bottomRightBoundary
 207       | otherwise = a
 208
 209 updatePosition :: G.Coords -> Character t -> Character t
 210 updatePosition (velocityRow, velocityColumn) character = do
 211   let (oldRow, oldColumn) = entityCoords character
 212   let newCoords = (oldRow + velocityRow, oldColumn + velocityColumn)
 213   let boundedCoords = limitCoords newCoords
 214   character { entityCoords = boundedCoords }
 215
 216 willCollide :: Maybe Direction -> G.Coords -> G.Coords -> Bool
 217 willCollide Nothing _ _ = False
 218 willCollide _ first second = first == second
 219
 220 handleCollisions :: [Character Enemy] -> Character Box -> Character Box
 221 handleCollisions enemies box = do
 222   let matchingEnemy = listToMaybe $ filter (\enemy -> willCollide (entityDirection enemy) (entityCoords enemy) (entityCoords box)) enemies
 223   case matchingEnemy of
 224     Nothing -> box
 225     Just enemy -> moveCharacter (entityDirection enemy) box
 226
 227 handleCollision :: Character t -> Character Box -> Character Box
 228 handleCollision (Character { entityCoords = coords, entityDirection = direction }) box
 229   | willCollide direction coords (entityCoords box) = moveCharacter direction box
 230   | otherwise = box
 231
 232 isOutOfBounds :: Character t -> Bool
 233 isOutOfBounds (Character { entityCoords = (row, column) }) = row == fst topLeftBoundary || column == snd topLeftBoundary || row == snd bottomRightBoundary || column == fst bottomRightBoundary