Move towards implementing wrist shields

This commit is contained in:
2022-05-25 10:27:05 +01:00
parent 546c279fae
commit dccbca5cfc
8 changed files with 131 additions and 44 deletions
+31 -24
View File
@@ -32,42 +32,49 @@ itemEffect cr it w = case it ^? itUse of
hammerTest f = case _crHammerPosition cr of
HammerUp -> f w
_ -> w & setuhamdown
lhammer f' = w & case _crHammerPosition cr of
HammerUp -> creatures . ix (_crID cr) %~ f'
_ -> id
setuhamdown = creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
doequipmentchange = setuhamdown $ lhammer (toggleEquipmentAt (_rbOptions w) (_crInvSel cr)
. activateEquipmentAt (_rbOptions w))
doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions w) (_crInvSel cr) cr
. activateEquipmentAt (_rbOptions w) cr)
activateEquipmentAt :: RightButtonOptions -> Creature -> Creature
activateEquipmentAt rbo = case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World
activateEquipmentAt rbo cr = creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
(Just i,_) -> crLeftInvSel ?~ i
(_,Just _) -> crLeftInvSel .~ Nothing
_ -> id
toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> Creature
toggleEquipmentAt rbops invid cr = case rbops ^? opAllocateEquipment of
Just DoNotMoveEquipment -> cr
toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World
toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
Just DoNotMoveEquipment -> w
Just PutOnEquipment {_allocNewPos = newp}
-> cr & crEquipment . at newp ?~ invid
& crInvEquipped . at invid ?~ newp
-> w & crpoint . crEquipment . at newp ?~ invid
& crpoint . crInvEquipped . at invid ?~ newp
& onequip itm cr
Just MoveEquipment {_allocNewPos=newp,_allocOldPos = oldp }
-> cr & crEquipment . at newp ?~ invid
& crEquipment . at oldp .~ Nothing
& crInvEquipped . at invid ?~ newp
-> w & crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInvEquipped . at invid ?~ newp
Just SwapEquipment {_allocNewPos=newp, _allocOldPos = oldp, _allocSwapID = sid }
-> cr & crEquipment . at newp ?~ invid
& crEquipment . at oldp ?~ sid
& crInvEquipped . at invid ?~ newp
& crInvEquipped . at sid ?~ oldp
-> w & crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp ?~ sid
& crpoint . crInvEquipped . at invid ?~ newp
& crpoint . crInvEquipped . at sid ?~ oldp
Just ReplaceEquipment {_allocNewPos = newp, _allocRemoveID = rid }
-> cr & crEquipment . at newp ?~ invid
& crInvEquipped . at invid ?~ newp
& crInvEquipped . at rid .~ Nothing
-> w & crpoint . crEquipment . at newp ?~ invid
& crpoint . crInvEquipped . at invid ?~ newp
& crpoint . crInvEquipped . at rid .~ Nothing
& onremove (itmat rid) cr
& onequip itm cr
Just RemoveEquipment {_allocOldPos = oldp }
-> cr & crEquipment . at oldp .~ Nothing
& crInvEquipped . at invid .~ Nothing
-> w & crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInvEquipped . at invid .~ Nothing
& onremove itm cr
Nothing -> error "tried to toggle equipment whilst not prepared"
where
crpoint = creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
itm = itmat (_crInvSel cr)
onequip itm' = (_eqOnEquip . _itUse) itm' itm'
onremove itm' = (_eqOnRemove . _itUse) itm' itm'
useLeftItem :: Int -> World -> World
useLeftItem cid w