Separate out concrete part of world

This commit is contained in:
2022-07-25 12:10:50 +01:00
parent 3354d108be
commit b2efbd2b3e
134 changed files with 933 additions and 930 deletions
+19 -14
View File
@@ -20,11 +20,11 @@ import Data.Maybe
useItem :: Creature -> World -> World
useItem cr' w = fromMaybe (f w) $ do
cr <- w ^? creatures . ix (_crID cr')
cr <- w ^? cWorld . creatures . ix (_crID cr')
it <- cr ^? crInv . ix (crSel cr)
return $ itemEffect cr it w
where
f = creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
f = cWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
itemEffect :: Creature -> Item -> World -> World
itemEffect cr it w = case it ^? itUse of
@@ -40,13 +40,13 @@ itemEffect cr it w = case it ^? itUse of
hammerTest f = case _crHammerPosition cr of
HammerUp -> f w
_ -> w & setuhamdown
setuhamdown = creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions w) (crSel cr) cr
. activateEquipmentAt (_rbOptions w) cr)
setuhamdown = cWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions (_cWorld w)) (crSel cr) cr
. activateEquipmentAt (_rbOptions (_cWorld w)) cr)
tryReload :: Creature -> Item -> World -> (World -> World) -> World -> World
tryReload cr it w f
| _crID cr == _yourID w && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False
| _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons (_cWorld w) M.!? SDL.ButtonLeft == Just False
= crToggleReloading cr
| otherwise
= (runIdentity . pointToItem (_itPos it) (return . (itUse . useHammer .~ HammerDown)))
@@ -58,7 +58,7 @@ itNeedsLoading it = _laLoaded ic == 0 || not (_laPrimed ic)
ic = _itConsumption it
activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World
activateEquipmentAt rbo cr = creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
activateEquipmentAt rbo cr = cWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
(Just i,_) -> crLeftInvSel ?~ i
(_,Just _) -> crLeftInvSel .~ Nothing
_ -> id
@@ -67,31 +67,36 @@ toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World
toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
Just DoNotMoveEquipment -> w
Just PutOnEquipment {_allocNewPos = newp}
-> w & crpoint . crEquipment . at newp ?~ invid
-> w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInvEquipped . at invid ?~ newp
& onequip itm cr
Just MoveEquipment {_allocNewPos=newp,_allocOldPos = oldp }
-> w & crpoint . crEquipment . at newp ?~ invid
-> w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInvEquipped . at invid ?~ newp
Just SwapEquipment {_allocNewPos=newp, _allocOldPos = oldp, _allocSwapID = sid }
-> w & crpoint . crEquipment . at newp ?~ invid
-> 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 }
-> w & crpoint . crEquipment . at newp ?~ invid
-> 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 }
-> w & crpoint . crEquipment . at oldp .~ 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)
crpoint = cWorld . creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
itm = itmat (crSel cr)
onequip itm' = useE ((_eqOnEquip . _eqEq . _itUse) itm') itm'
@@ -110,7 +115,7 @@ useLeftItem cid w
. useL f itm cr
$ w
where
cr = _creatures w IM.! cid
cr = _creatures (_cWorld w) IM.! cid
itmShouldBeUsed = isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse)
|| ( isJust (cr ^? crInv . ix (crSel cr) . itUse . eqEq . eqUse)
&& _crLeftInvSel cr /= Just (crSel cr)