126 lines
No EOL
6 KiB
Haskell
126 lines
No EOL
6 KiB
Haskell
module RPGEngine.Input.ActionSelection
|
|
( handleInputActionSelection
|
|
) where
|
|
|
|
import RPGEngine.Input.Core (InputHandler, handleKey, composeInputHandlers, ListSelector (selection))
|
|
|
|
import RPGEngine.Data (Game (..), State (..), Direction (..), Action (..), ItemId, EntityId, Level (..), Player (inventory, playerHp, Player), Item (..), HP, Entity (..))
|
|
import Graphics.Gloss.Interface.IO.Game (Key(SpecialKey), SpecialKey (KeyUp, KeyDown))
|
|
import Graphics.Gloss.Interface.IO.Interact
|
|
( SpecialKey(..), KeyState(..) )
|
|
import RPGEngine.Data.Level (getWithId, itemFromInventory)
|
|
import Data.Foldable (find)
|
|
|
|
------------------------------ 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 selector continue } = newGame
|
|
where newGame = game{ state = execute selectedAction continue }
|
|
selectedAction = list !! index
|
|
index = selection selector
|
|
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 = healedPlayer
|
|
where healedPlayer = s{ player = increasePlayerHp iid (player s)}
|
|
execute _ s = s
|
|
|
|
-- Pick up the item with itemId and put it in the players inventory
|
|
-- Should receive a Playing state
|
|
pickUpItem :: ItemId -> State -> State
|
|
pickUpItem id s@Playing{ level = level, player = player } = newState
|
|
where (Just (Left pickedUpItem)) = getWithId id level
|
|
newState = s{ level = newLevel, player = newPlayer }
|
|
newLevel = level{ items = filteredItems }
|
|
filteredItems = filter (/= pickedUpItem) $ items level
|
|
newPlayer = player{ inventory = newInventory }
|
|
newInventory = pickedUpItem:inventory player
|
|
pickUpItem _ _ = Error "Something went wrong while picking up an item"
|
|
|
|
-- Use an item
|
|
useItem :: ItemId -> State -> State -- TODO
|
|
useItem _ s = s -- TODO
|
|
|
|
-- Attack an entity using an item
|
|
-- Should receive a Playing state
|
|
decreaseHp :: EntityId -> ItemId -> State -> State
|
|
decreaseHp eid iid s@Playing{ level = level, player = player } = newState
|
|
where newState = s{ level = newLevel, player = newPlayer }
|
|
-- Change player
|
|
(Just usingItem) = find ((== iid) . itemId) (inventory player)
|
|
usedItem = decreaseDurability usingItem
|
|
newInventory = filter (/= usingItem) $ inventory player
|
|
newPlayer = player{ inventory = putItemBack usedItem newInventory, playerHp = newHp }
|
|
putItemBack Nothing inv = inv
|
|
putItemBack (Just item) inv = item:inv
|
|
newHp = changeHealth (playerHp player) damageGetAmount -- Damage dealt by entity
|
|
damageDealAmount = itemValue usingItem
|
|
-- Change entity
|
|
(Just (Right attackedEntity)) = getWithId eid level
|
|
newLevel = level{ entities = putEntityBack dealtWithEntity newEntities }
|
|
newEntities = filter ((/= eid) . entityId) $ entities level
|
|
dealtWithEntity = decreaseHealth attackedEntity damageDealAmount
|
|
putEntityBack Nothing list = list
|
|
putEntityBack (Just ent) list = ent:list
|
|
damageGetAmount = inverse (entityValue attackedEntity)
|
|
inverse (Just val) = Just (-val)
|
|
inverse Nothing = Nothing
|
|
decreaseHp _ _ _ = Error "something went wrong while attacking"
|
|
|
|
-- Heal a bit
|
|
-- Should receive a Player
|
|
increasePlayerHp :: ItemId -> Player -> Player
|
|
increasePlayerHp id p@Player{ playerHp = hp, inventory = inventory} = newPlayer
|
|
where newPlayer = p{ playerHp = newHp, inventory = newInventory newItem }
|
|
(Just usedItem) = find ((== id) . itemId) inventory
|
|
newItem = decreaseDurability usedItem
|
|
newInventory (Just item) = item:filteredInventory
|
|
newInventory _ = filteredInventory
|
|
filteredInventory =filter (/= usedItem) inventory
|
|
newHp = changeHealth hp (itemValue usedItem)
|
|
|
|
decreaseDurability :: Item -> Maybe Item
|
|
decreaseDurability item@Item{ useTimes = Nothing } = Just item -- Infinite uses, never breaks
|
|
decreaseDurability item@Item{ useTimes = Just val } | 0 < val - 1 = Just item{ useTimes = Just (val - 1) }
|
|
| otherwise = Nothing -- Broken
|
|
|
|
decreaseHealth :: Entity -> Maybe Int -> Maybe Entity
|
|
decreaseHealth entity@Entity{ entityHp = Nothing } _ = Just entity
|
|
decreaseHealth entity@Entity{ entityHp = Just val } (Just i) | 0 < val - i = Just entity{ entityHp = Just (val - i) }
|
|
| otherwise = Nothing
|
|
decreaseHealth entity _ = Just entity
|
|
|
|
-- Change given health by a given amount
|
|
changeHealth :: HP -> HP -> HP
|
|
changeHealth (Just health) (Just difference) = Just (health + difference)
|
|
changeHealth health _ = health |