129 lines
No EOL
6 KiB
Haskell
129 lines
No EOL
6 KiB
Haskell
module RPGEngine.Input.Playing
|
|
( handleInputPlaying
|
|
, checkPlaying
|
|
, spawnPlayer
|
|
, putCoords
|
|
) where
|
|
|
|
import RPGEngine.Input.Core (InputHandler, handle, handleKey, composeInputHandlers, ListSelector (..))
|
|
|
|
import RPGEngine.Data (Game (..), Layout(..), Level(..), Physical(..), Player(..), State(..), X, Y, Direction (..), Entity (..), Item (..))
|
|
import RPGEngine.Data.Game (isLegalMove, isPlayerDead, isPlayerAtExit)
|
|
import RPGEngine.Data.Level (directionOffsets, findFirstOf, hasAt, filterActions, getActions)
|
|
|
|
import Data.Maybe (fromJust, isNothing)
|
|
import Graphics.Gloss.Interface.IO.Game (Key(..))
|
|
import Graphics.Gloss.Interface.IO.Interact (SpecialKey(..), KeyState(..), Event(..), KeyState(..))
|
|
import Prelude hiding (interact)
|
|
|
|
------------------------------ Exported ------------------------------
|
|
|
|
handleInputPlaying :: InputHandler Game
|
|
handleInputPlaying = composeInputHandlers [
|
|
-- Pause the game
|
|
handleKey (Char 'p') Down pauseGame,
|
|
|
|
-- Player movement
|
|
handleKey (SpecialKey KeyUp) Down $ movePlayer North,
|
|
handleKey (SpecialKey KeyRight) Down $ movePlayer East,
|
|
handleKey (SpecialKey KeyDown) Down $ movePlayer South,
|
|
handleKey (SpecialKey KeyLeft) Down $ movePlayer West,
|
|
|
|
handleKey (Char 'w') Down $ movePlayer North,
|
|
handleKey (Char 'd') Down $ movePlayer East,
|
|
handleKey (Char 's') Down $ movePlayer South,
|
|
handleKey (Char 'a') Down $ movePlayer West,
|
|
|
|
-- Interaction with entities and items
|
|
handleKey (SpecialKey KeySpace) Down checkForInteraction,
|
|
handleKey (Char 'f') Down checkForInteraction,
|
|
|
|
handleKey (Char 'i') Down $ toggleInventoryShown True,
|
|
handleKey (Char 'i') Up $ toggleInventoryShown False,
|
|
handleKey (SpecialKey KeyTab) Down $ toggleInventoryShown True,
|
|
handleKey (SpecialKey KeyTab) Up $ toggleInventoryShown False,
|
|
|
|
handleKey (Char 'r') Down restartGame
|
|
]
|
|
|
|
----------------------------------------------------------------------
|
|
|
|
-- Set the initial position of the player in a given level.
|
|
spawnPlayer :: Level -> Player -> Player
|
|
spawnPlayer l@Level{ layout = lay } p@Player{ position = prevPos } = p{ position = newPos }
|
|
where try = findFirstOf l Entrance
|
|
newPos | isNothing try = prevPos
|
|
| otherwise = fromJust try
|
|
|
|
checkPlaying :: Game -> Game
|
|
checkPlaying g@Game{ state = s@Playing{ restart = restart }} = newGame
|
|
where newGame | isPlayerDead g = loseGame
|
|
| isPlayerAtExit g = g{ state = goToNextLevel s }
|
|
| otherwise = g
|
|
loseGame = g{ state = Lose{ restart = restart }}
|
|
checkPlaying g = g
|
|
|
|
pauseGame :: Game -> Game
|
|
pauseGame g@Game{ state = playing@Playing{} } = pausedGame
|
|
where pausedGame = g{ state = Paused playing }
|
|
pauseGame g = g
|
|
|
|
restartGame :: Game -> Game
|
|
restartGame g@Game{ state = playing@Playing{ restart = restarted } } = g{ state = restarted }
|
|
restartGame g = g{ state = Error "something went wrong while restarting the level"}
|
|
|
|
-- Go to next level if there is a next level, otherwise, initialize win state.
|
|
goToNextLevel :: State -> State
|
|
goToNextLevel s@Playing{ levels = levels, level = current, count = count, player = player } = nextState
|
|
where nextState | (count + 1) < length levels = nextLevelState
|
|
| otherwise = Win
|
|
nextLevelState = s{ level = nextLevel, count = count + 1, player = movedPlayer, restart = nextLevelState }
|
|
nextLevel = levels !! (count + 1)
|
|
movedPlayer = spawnPlayer nextLevel player
|
|
goToNextLevel s = s
|
|
|
|
-- Move a player in a direction if possible.
|
|
movePlayer :: Direction -> Game -> Game
|
|
movePlayer dir g@Game{ state = s@Playing{ player = p@Player{ position = (x, y) }}} = newGame
|
|
where newGame = g{ state = newState }
|
|
newState = s{ player = newPlayer }
|
|
newPlayer = p{ position = newCoord }
|
|
newCoord | isLegalMove dir g = (x + xD, y + yD)
|
|
| otherwise = (x, y)
|
|
(xD, yD) = directionOffsets dir
|
|
movePlayer _ g = g{ state = Error "something went wrong while moving the player" }
|
|
|
|
checkForInteraction :: Game -> Game
|
|
checkForInteraction g@Game{ state = Playing{ level = level, player = player }} = newGame
|
|
where newGame | canInteract = interact g
|
|
| otherwise = g
|
|
canInteract = not $ null $ hasAt pos level
|
|
pos = position player
|
|
checkForInteraction g = g{ state = Error "something went wrong while checking for entities to interact with" }
|
|
|
|
interact :: Game -> Game
|
|
interact g@Game{ state = s@Playing{ level = level, player = player } } = g{ state = newState }
|
|
where newState = ActionSelection actionList selector continue
|
|
actionList = filterActions $ getActions $ fromJust $ hasAt pos level
|
|
selector = ListSelector 0 False
|
|
pos = position player
|
|
continue = s
|
|
interact g = g{ state = Error "something went wrong while interacting with object"}
|
|
|
|
toggleInventoryShown :: Bool -> Game -> Game
|
|
toggleInventoryShown shown g@Game{ state = s@Playing{ player = p }}= newGame
|
|
where newGame = g{ state = newState }
|
|
newState = s{ player = newPlayer }
|
|
newPlayer = p{ showInventory = shown }
|
|
toggleInventoryShown _ g = g{ state = Error "something went wrong while working inventory" }
|
|
|
|
-- Map all Physicals onto coordinates
|
|
putCoords :: Level -> [(X, Y, Physical)]
|
|
putCoords l@Level{ layout = lay } = concatMap (\(a, bs) -> map (\(b, c) -> (b, a, c)) bs) numberedList
|
|
where numberedStrips = reverse $ zip [0::Int .. ] $ reverse lay
|
|
numberedList = map (\(x, strip) -> (x, zip [0::Int ..] strip)) numberedStrips
|
|
|
|
-- putCoords l = concatMap numberColumns intermediate
|
|
-- where numberColumns (rowIndex, numberedRow) = map (\(colIndex, cell) -> (colIndex, rowIndex, cell)) numberedRow
|
|
-- intermediate = zip [0 .. ] numberedRows
|
|
-- numberedRows = zip [0::X .. ] $ layout l |