#4 Setup interaction

This commit is contained in:
Tibo De Peuter 2022-12-23 09:42:34 +01:00
parent ef784c2dbc
commit 9addf1ed07
13 changed files with 223 additions and 33 deletions

View file

@ -57,7 +57,8 @@ These are the keybinds *in* the game. All other keybinds in the menus should be
| Move left | `Arrow Left` | `a` |
| Move down | `Arrow Down` | `s` |
| Move right | `Arrow Right` | `d` |
| Show inventory | `i` | |
| Interaction | `Space` | `f` |
| Show inventory | `i` | `Tab` |
| Restart level | `r` | |
| Quit game | `Esc` | |

View file

@ -19,22 +19,30 @@ data Game = Game {
-- Main menu
data State = Menu
-- Select the level you want to play
| LevelSelection { levelList :: [FilePath],
selector :: ListSelector }
| LevelSelection { levelList :: [FilePath],
selector :: ListSelector }
-- Playing a level
| Playing { levels :: [Level],
count :: Int,
level :: Level,
player :: Player,
restart :: State }
| Playing { levels :: [Level],
count :: Int,
level :: Level,
player :: Player,
restart :: State }
-- Selecting an action
| ActionSelection { actionList :: [Action],
selector :: ListSelector,
-- The player of this state will be used to interact
continue :: State }
-- Paused while playing a level
| Paused { continue :: State }
| Paused { continue :: State }
-- Won a level
| Win
-- Lost a level
| Lose { restart :: State }
| Lose { restart :: State }
| Error Message
deriving (Eq, Show)
type Message = String
------------------------------- Level --------------------------------
data Level = Level {

View file

@ -5,8 +5,9 @@ where
import GHC.IO (unsafePerformIO)
import System.Directory (getDirectoryContents)
import RPGEngine.Input.Core (ListSelector(..))
import RPGEngine.Data (Level (..), Physical (..), Direction (..), Entity (..), Game (..), Item (..), Player (..), State (..), X, Y, Layout)
import RPGEngine.Data (Action(..), Level (..), Physical (..), Direction (..), Entity (..), Game (..), Item (..), Player (..), State (..), X, Y, Layout, Condition (InventoryFull, InventoryContains, Not, AlwaysFalse))
import RPGEngine.Config (levelFolder)
import Data.Foldable (find)
------------------------------ Exported ------------------------------
@ -25,6 +26,17 @@ findAt pos lvl@Level{ index = index } = try
try | not (null matches) = head matches
| otherwise = Void
hasAt :: (X, Y) -> Level -> Maybe (Either Item Entity)
hasAt pos level = match firstItem firstEntity
where match :: Maybe Item -> Maybe Entity -> Maybe (Either Item Entity)
match (Just a) _ = Just $ Left a
match _ (Just a) = Just $ Right a
match _ _ = Nothing
firstEntity = find ((== pos) . getECoord) $ entities level
getECoord e = (entityX e, entityY e)
firstItem = find ((== pos) . getICoord) $ items level
getICoord i = (itemX i, itemY i)
directionOffsets :: Direction -> (X, Y)
directionOffsets North = ( 0, 1)
directionOffsets East = ( 1, 0)
@ -33,4 +45,29 @@ directionOffsets West = (-1, 0)
directionOffsets Stay = ( 0, 0)
getLevelList :: [FilePath]
getLevelList = drop 2 $ unsafePerformIO $ getDirectoryContents levelFolder
getLevelList = drop 2 $ unsafePerformIO $ getDirectoryContents levelFolder
-- Get the actions of either an entity or an item
getActions :: Either Item Entity -> [([Condition], Action)]
getActions (Left item) = itemActions item
getActions (Right entity) = entityActions entity
getActionText :: Action -> String
getActionText Leave = "Leave"
getActionText (RetrieveItem _) = "Pick up"
getActionText (UseItem _) = "Use item"
getActionText _ = "ERROR"
-- TODO Check conditions
-- Filter based on the conditions, keep only the actions of which the
-- conditions are met.
filterActions :: [([Condition], Action)] -> [Action]
filterActions [] = []
filterActions ((conditions, action):others) = action:filterActions others
-- Check if a condition is met or not.
meetsCondition :: Condition -> Bool
meetsCondition InventoryFull = False -- TODO
meetsCondition (InventoryContains id) = True -- TODO
meetsCondition (Not condition) = not $ meetsCondition condition
meetsCondition AlwaysFalse = False

View file

@ -13,6 +13,7 @@ import RPGEngine.Input.Playing ( handleInputPlaying )
import RPGEngine.Input.Paused ( handleInputPaused )
import RPGEngine.Input.Win ( handleInputWin )
import RPGEngine.Input.Lose ( handleInputLose )
import RPGEngine.Input.ActionSelection (handleInputActionSelection)
------------------------------ Exported ------------------------------
@ -23,4 +24,6 @@ handleAllInput ev g@Game{ state = LevelSelection{} } = handleInputLevelSelection
handleAllInput ev g@Game{ state = Playing{} } = handleInputPlaying ev g
handleAllInput ev g@Game{ state = Paused{} } = handleInputPaused ev g
handleAllInput ev g@Game{ state = Win } = handleInputWin ev g
handleAllInput ev g@Game{ state = Lose{} } = handleInputLose ev g
handleAllInput ev g@Game{ state = Lose{} } = handleInputLose ev g
handleAllInput ev g@Game{ state = ActionSelection{}} = handleInputActionSelection ev g
handleAllInput ev g@Game{ state = Error _ } = handleAnyKey (\game -> game{ state = Menu}) ev g

View file

@ -0,0 +1,76 @@
module RPGEngine.Input.ActionSelection
( handleInputActionSelection
) where
import RPGEngine.Input.Core (InputHandler, handleKey, composeInputHandlers, ListSelector (selection))
import RPGEngine.Data (Game (..), State (..), Direction (..), Action (..), ItemId, EntityId)
import Graphics.Gloss.Interface.IO.Game (Key(SpecialKey), SpecialKey (KeyUp, KeyDown))
import Graphics.Gloss.Interface.IO.Interact
( SpecialKey(..), KeyState(..) )
------------------------------ Exported ------------------------------
handleInputActionSelection :: InputHandler Game
handleInputActionSelection = composeInputHandlers [
handleKey (SpecialKey KeySpace) Down selectAction,
handleKey (SpecialKey KeyUp) Down $ moveSelector North,
handleKey (SpecialKey KeyDown) Down $ moveSelector South
]
----------------------------------------------------------------------
selectAction :: Game -> Game
selectAction game@Game{ state = ActionSelection list selection continue } = newGame
where newGame = game{ state = execute selectedAction continue }
selectedAction = Leave
selectAction g = g
-- TODO Lift this code from LevelSelection
-- Move the selector either up or down
moveSelector :: Direction -> Game -> Game
moveSelector dir game@Game{ state = state@(ActionSelection list selector _) } = newGame
where newGame = game{ state = newState }
newState = state{ selector = newSelector }
newSelector | constraint = selector{ selection = newSelection }
| otherwise = selector
constraint = 0 <= newSelection && newSelection < length list
newSelection = selection selector + diff
diff | dir == North = -1
| dir == South = 1
| otherwise = 0
moveSelector _ g = g{ state = Error "Something went wrong while moving the selector up or down"}
------------------------------ Actions -------------------------------
execute :: Action -> State -> State
execute (RetrieveItem id ) s = pickUpItem id s
execute (UseItem id ) s = useItem id s
execute (DecreaseHp eid iid) s = decreaseHp eid iid s
execute (IncreasePlayerHp iid) s = increasePlayerHp iid s
execute _ s = s
-- Pick up the item with itemId and put it in the players inventory
pickUpItem :: ItemId -> State -> State
pickUpItem _ s = s -- TODO
-- Use an item on the player
useItem :: ItemId -> State -> State -- TODO
useItem _ s = s -- TODO
-- Attack an entity using an item
decreaseHp :: EntityId -> ItemId -> State -> State
decreaseHp _ _ s = s
-- TODO DecreaseHp of monster
-- TODO Check if monster is dead
-- TODO Entity attack player
-- TODO Decrease durability of item
-- TODO Break item if durability below zero
-- Heal a bit
increasePlayerHp :: ItemId -> State -> State
increasePlayerHp _ s = s
-- TODO Increase playerHp
-- TODO Decrease durability of item
-- TODO Remove item if durability below zero

View file

@ -24,14 +24,15 @@ handleInputLevelSelection = composeInputHandlers [
-- Select a level and load it in
selectLevel :: Game -> Game
selectLevel game@Game{ state = LevelSelection{ levelList = list, selector = selector }} = newGame
selectLevel game@Game{ state = LevelSelection list selector } = newGame
where newGame = parse $ levelFolder ++ (list !! index)
index = selection selector
selectLevel g = g
selectLevel g = g{ state = Error "Something went wrong while selecting a level"}
-- TODO Lift this code from ActionSelection
-- Move the selector either up or down
moveSelector :: Direction -> Game -> Game
moveSelector dir game@Game{ state = state@LevelSelection{ levelList = list, selector = selector } } = newGame
moveSelector dir game@Game{ state = state@(LevelSelection list selector) } = newGame
where newGame = game{ state = newState }
newState = state{ selector = newSelector }
newSelector | constraint = selector{ selection = newSelection }
@ -41,4 +42,4 @@ moveSelector dir game@Game{ state = state@LevelSelection{ levelList = list, sele
diff | dir == North = -1
| dir == South = 1
| otherwise = 0
moveSelector _ g = g
moveSelector _ g = g{ state = Error "Something went wrong while moving the selector up or down"}

View file

@ -5,15 +5,16 @@ module RPGEngine.Input.Playing
, putCoords
) where
import RPGEngine.Input.Core (InputHandler, handle, handleKey, composeInputHandlers)
import RPGEngine.Input.Core (InputHandler, handle, handleKey, composeInputHandlers, ListSelector (..))
import RPGEngine.Data (Game (..), Layout(..), Level(..), Physical(..), Player(..), State(..), X, Y, Direction (..))
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)
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 ------------------------------
@ -28,15 +29,21 @@ handleInputPlaying = composeInputHandlers [
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,
handleKey (Char 'w') Down $ movePlayer North,
handleKey (Char 'd') Down $ movePlayer East,
handleKey (Char 's') Down $ movePlayer South,
handleKey (Char 'a') Down $ movePlayer West,
handleKey (Char 'r') Down restartGame,
-- 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 (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
]
----------------------------------------------------------------------
@ -63,6 +70,7 @@ 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
@ -83,16 +91,39 @@ movePlayer dir g@Game{ state = s@Playing{ player = p@Player{ position = (x, y) }
newCoord | isLegalMove dir g = (x + xD, y + yD)
| otherwise = (x, y)
(xD, yD) = directionOffsets dir
movePlayer _ g = g
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
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

View file

@ -15,9 +15,11 @@ import RPGEngine.Render.Paused ( renderPaused )
import RPGEngine.Render.Win ( renderWin )
import RPGEngine.Render.Lose ( renderLose )
import Graphics.Gloss (Display)
import Graphics.Gloss ( Display, text, color )
import Graphics.Gloss.Data.Picture (Picture, blank)
import Graphics.Gloss.Data.Display (Display(..))
import RPGEngine.Render.ActionSelection (renderActionSelection)
import RPGEngine.Config (textColor)
----------------------------------------------------------------------
@ -32,4 +34,6 @@ render Game{ state = s@LevelSelection{} } = renderLevelSelection s
render Game{ state = s@Playing{} } = renderPlaying s
render Game{ state = s@Paused{} } = renderPaused s
render Game{ state = s@Win } = renderWin s
render Game{ state = s@Lose{} } = renderLose s
render Game{ state = s@Lose{} } = renderLose s
render Game{ state = s@ActionSelection{}} = renderActionSelection s
render Game{ state = Error message } = color textColor $ text message

View file

@ -0,0 +1,26 @@
module RPGEngine.Render.ActionSelection
( renderActionSelection
) where
import RPGEngine.Data (State (..), Action (..))
import Graphics.Gloss
( Picture, text, pictures, translate, scale, color )
import Graphics.Gloss.Data.Picture (blank)
import RPGEngine.Data.Level (getActionText)
import RPGEngine.Config (uizoom, selectionColor, textColor)
import RPGEngine.Input.Core (ListSelector(selection))
import RPGEngine.Render.Playing (renderPlaying)
import RPGEngine.Render.Core (overlay)
------------------------------ Exported ------------------------------
renderActionSelection :: State -> Picture
renderActionSelection (ActionSelection list selector continue) = everything
where numberedTexts = zip [0::Int ..] $ map getActionText list
sel = selection selector
everything = pictures $ [renderPlaying continue, overlay] ++ map render numberedTexts
render (i, t) | i == sel = color selectionColor $ make (i, t)
| otherwise = color textColor $ make (i, t)
make (i, t) = scale uizoom uizoom $ translate 0 (offset i) $ text t
offset i = negate (250 * uizoom * fromIntegral i)
renderActionSelection _ = blank

View file

@ -21,7 +21,7 @@ renderLevelSelection state = result
----------------------------------------------------------------------
renderLevelList :: Renderer State
renderLevelList LevelSelection{ levelList = list, selector = selector } = everything
renderLevelList (LevelSelection list selector) = everything
where everything = pictures $ map render entries
sel = selection selector
entries = zip [0::Int .. ] list

View file

@ -42,7 +42,8 @@ focusPlayer _ = id
renderLevel :: Renderer Level
renderLevel Level{ layout = l, items = i, entities = e } = level
where level = pictures [void, layout, items, entities]
void = createVoid
-- void = createVoid
void = blank
layout = renderLayout l
items = renderItems i
entities = renderEntities e

View file

@ -23,6 +23,7 @@ library
RPGEngine.Input
RPGEngine.Input.Core
RPGEngine.Input.ActionSelection
RPGEngine.Input.Menu
RPGEngine.Input.LevelSelection
RPGEngine.Input.Playing
@ -37,6 +38,7 @@ library
RPGEngine.Render
RPGEngine.Render.Core
RPGEngine.Render.ActionSelection
RPGEngine.Render.Menu
RPGEngine.Render.LevelSelection
RPGEngine.Render.Playing

Binary file not shown.