Skip to content
Permalink
Browse files

Implement drill logic

  • Loading branch information...
jhb563 committed May 8, 2019
1 parent cab57d9 commit 1e768dbcbe8fa9d6a05f5c507e049efcad391a9c
Showing with 52 additions and 20 deletions.
  1. +6 −2 src/JSONInstances.hs
  2. +43 −17 src/Runner.hs
  3. +3 −1 src/Types.hs
@@ -21,6 +21,7 @@ instance FromJSON World where
(boundaryString :: Text) <- o .: "boundaries"
result <- o .: "result"
enemies <- o .: "enemies"
drillLocs <- o .: "drillPowerupLocations"
stunCells <- o .: "stunCells"
time <- o .: "time"
params <- o .: "gameParameters"
@@ -32,7 +33,7 @@ instance FromJSON World where
Just i -> mkStdGen i
_ -> mkStdGen 1
return $ World player startLoc endLoc boundaries
result gen enemies stunCells time params
result gen enemies drillLocs stunCells time params

instance ToJSON World where
toJSON w = object
@@ -42,6 +43,7 @@ instance ToJSON World where
, "boundaries" .= dumpMaze (worldBoundaries w)
, "result" .= worldResult w
, "enemies" .= worldEnemies w
, "drillPowerupLocations" .= worldDrillPowerUpLocations w
, "stunCells" .= stunCells w
, "time" .= worldTime w
, "gameParameters" .= worldParameters w
@@ -97,18 +99,20 @@ instance FromJSON GameParameters where
numRows <- o .: "numRows"
numCols <- o .: "numColumns"
numEnemies <- o .: "numEnemies"
numDrills <- o .: "numDrillPowerups"
tickRate <- o .: "tickRate"
playerParams <- o .: "playerParameters"
enemyParams <- o .: "enemyParameters"
randomGen <- o .:? "randomSeed"
return $ GameParameters numRows numCols numEnemies tickRate
return $ GameParameters numRows numCols numEnemies numDrills tickRate
playerParams enemyParams randomGen

instance ToJSON GameParameters where
toJSON gp = object
[ "numRows" .= numRows gp
, "numColumns" .= numColumns gp
, "numEnemies" .= numEnemies gp
, "numDrillPowerups" .= numDrillPowerups gp
, "tickRate" .= tickRate gp
, "playerParameters" .= playerGameParameters gp
, "enemyParameters" .= enemyGameParameters gp
@@ -3,6 +3,7 @@ module Runner where
import qualified Data.Array as Array
import Control.Monad.State (State, get, put, runState, replicateM)
import Data.Ix (range)
import Data.List (delete)
import qualified Data.Map as Map
import Data.Maybe (mapMaybe, fromJust, catMaybes)
import System.Random (getStdGen, StdGen, randomR)
@@ -44,12 +45,15 @@ main = do
gen <- getStdGen
let gameParams = defaultGameParameters
(maze, gen') = generateRandomMaze gen (numRows gameParams, numColumns gameParams)
(randomLocations, gen'') = runState
(enemyLocations, gen'') = runState
(replicateM (numEnemies gameParams) (generateRandomLocation (numRows gameParams, numColumns gameParams)))
gen'
enemies = (mkNewEnemy (enemyGameParameters gameParams)) <$> randomLocations
(drillPowerupLocations, gen''') = runState
(replicateM (numDrillPowerups gameParams) (generateRandomLocation (numRows gameParams, numColumns gameParams)))
gen''
enemies = (mkNewEnemy (enemyGameParameters gameParams)) <$> enemyLocations
endCell = (numColumns gameParams - 1, numRows gameParams - 1)
initialWorld = World (newPlayer (playerGameParameters gameParams)) (0,0) endCell maze GameInProgress gen'' enemies [] 0 gameParams
initialWorld = World (newPlayer (playerGameParameters gameParams)) (0,0) endCell maze GameInProgress gen''' enemies drillPowerupLocations [] 0 gameParams
return initialWorld
Just loadFile -> loadWorldFromFile loadFile
play
@@ -143,37 +147,39 @@ inputHandler event w
| worldResult w == GameWon = case event of
(EventKey (SpecialKey KeyEnter) Down _ _) ->
let (newMaze, gen') = generateRandomMaze (worldRandomGenerator w) (worldRows, worldCols)
(newLocations, gen'') = runState
(newEnemyLocations, gen'') = runState
(replicateM (length (worldEnemies w)) (generateRandomLocation (worldRows, worldCols)))
gen'
in World (newPlayer playerParams) (0,0) (worldCols - 1, worldRows - 1) newMaze GameInProgress gen''
(mkNewEnemy enemyParams <$> newLocations) [] 0 (worldParameters w)
(newDrillPowerupLocations, gen''') = runState
(replicateM (numDrillPowerups (worldParameters w)) (generateRandomLocation (worldRows, worldCols)))
gen''
in World (newPlayer playerParams) (0,0) (worldCols - 1, worldRows - 1) newMaze GameInProgress gen'''
(mkNewEnemy enemyParams <$> newEnemyLocations) newDrillPowerupLocations [] 0 (worldParameters w)
_ -> w
| worldResult w == GameLost = case event of
(EventKey (SpecialKey KeyEnter) Down _ _) ->
let (newLocations, gen') = runState
let (newEnemyLocations, gen') = runState
(replicateM (length (worldEnemies w)) (generateRandomLocation (worldRows, worldCols)))
(worldRandomGenerator w)
in World (newPlayer playerParams) (0,0) (worldCols - 1, worldRows - 1) (worldBoundaries w) GameInProgress gen'
(mkNewEnemy enemyParams <$> newLocations) [] 0 (worldParameters w)
(newDrillPowerupLocations, gen'') = runState
(replicateM (numDrillPowerups (worldParameters w)) (generateRandomLocation (worldRows, worldCols)))
gen'
in World (newPlayer playerParams) (0,0) (worldCols - 1, worldRows - 1) (worldBoundaries w) GameInProgress gen''
(mkNewEnemy enemyParams <$> newEnemyLocations) newDrillPowerupLocations [] 0 (worldParameters w)
_ -> w
| otherwise = case event of
(EventKey (SpecialKey KeyUp) Down (Modifiers _ _ Down) _) ->
drillLocation upBoundary breakUpWall breakDownWall w
(EventKey (SpecialKey KeyUp) Down _ _) -> w
{ worldPlayer = currentPlayer { playerLocation = nextLocation upBoundary } }
(EventKey (SpecialKey KeyUp) Down _ _) -> updatePlayerMove upBoundary
(EventKey (SpecialKey KeyDown) Down (Modifiers _ _ Down) _) ->
drillLocation downBoundary breakDownWall breakUpWall w
(EventKey (SpecialKey KeyDown) Down _ _) -> w
{ worldPlayer = currentPlayer { playerLocation = nextLocation downBoundary } }
(EventKey (SpecialKey KeyDown) Down _ _) -> updatePlayerMove downBoundary
(EventKey (SpecialKey KeyRight) Down (Modifiers _ _ Down) _) ->
drillLocation rightBoundary breakRightWall breakLeftWall w
(EventKey (SpecialKey KeyRight) Down _ _) -> w
{ worldPlayer = currentPlayer { playerLocation = nextLocation rightBoundary } }
(EventKey (SpecialKey KeyRight) Down _ _) -> updatePlayerMove rightBoundary
(EventKey (SpecialKey KeyLeft) Down (Modifiers _ _ Down) _) ->
drillLocation leftBoundary breakLeftWall breakRightWall w
(EventKey (SpecialKey KeyLeft) Down _ _) -> w
{ worldPlayer = currentPlayer { playerLocation = nextLocation leftBoundary } }
(EventKey (SpecialKey KeyLeft) Down _ _) -> updatePlayerMove leftBoundary
(EventKey (SpecialKey KeySpace) Down _ _) -> if playerCurrentStunDelay currentPlayer /= 0 then w
else w
{ worldPlayer = activatePlayerStun currentPlayer playerParams
@@ -193,6 +199,18 @@ inputHandler event w
currentLocation = playerLocation currentPlayer
cellBounds = worldBounds Array.! currentLocation

updatePlayerMove :: (CellBoundaries -> BoundaryType) -> World
updatePlayerMove boundaryFunc = case boundaryFunc cellBounds of
(AdjacentCell cell) ->
let movedPlayer = movePlayer cell currentPlayer
drillLocs = worldDrillPowerUpLocations w
(finalPlayer, finalDrillList) = if cell `elem` drillLocs
then (pickupDrill movedPlayer, delete cell drillLocs)
else (movedPlayer, drillLocs)
in w
{ worldPlayer = finalPlayer, worldDrillPowerUpLocations = finalDrillList }
_ -> w

nextLocation :: (CellBoundaries -> BoundaryType) -> Location
nextLocation boundaryFunc = case boundaryFunc cellBounds of
(AdjacentCell cell) -> cell
@@ -313,6 +331,14 @@ activatePlayerDrill :: Player -> Player
activatePlayerDrill pl = pl
{ playerDrillsRemaining = decrementIfPositive (playerDrillsRemaining pl)}

pickupDrill :: Player -> Player
pickupDrill pl = pl
{ playerDrillsRemaining = (playerDrillsRemaining pl) + 1}

movePlayer :: Location -> Player -> Player
movePlayer newLoc pl = pl
{ playerLocation = newLoc }

stunEnemy :: Enemy -> EnemyGameParameters -> Enemy
stunEnemy (Enemy loc lag nextStun _) params = Enemy loc newLag newNextStun nextStun
where
@@ -54,6 +54,7 @@ data World = World
, worldResult :: GameResult
, worldRandomGenerator :: StdGen
, worldEnemies :: [Enemy]
, worldDrillPowerUpLocations :: [Location]
, stunCells :: [Location]
, worldTime :: Word
, worldParameters :: GameParameters
@@ -63,6 +64,7 @@ data GameParameters = GameParameters
{ numRows :: Int
, numColumns :: Int
, numEnemies :: Int
, numDrillPowerups :: Int
, tickRate :: Int
, playerGameParameters :: PlayerGameParameters
, enemyGameParameters :: EnemyGameParameters
@@ -88,7 +90,7 @@ data EnemyGameParameters = EnemyGameParameters

defaultGameParameters :: GameParameters
defaultGameParameters = GameParameters
25 25 4 20 playerParams enemyParams Nothing
25 25 4 4 20 playerParams enemyParams Nothing
where
playerParams = PlayerGameParameters
200 10 (maxBound :: Word) 2 2

0 comments on commit 1e768db

Please sign in to comment.
You can’t perform that action at this time.