justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Separate out concrete part of world

Browse Source
This commit is contained in:
justin
2022-07-25 12:10:50 +01:00
parent 3354d108be
commit b2efbd2b3e
134 changed files with 933 additions and 930 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Inventory.hs
+66 -61
View File
@@ -53,23 +53,24 @@ rmInvItem :: Int -- ^ Creature id
-> Int -- ^ Inventory position
-> World
-> World
rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itConsumption . icAmount of
Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ subtract 1
_ -> w & creatures . ix cid . crInv %~ f
& creatures . ix cid . crInvSel %~ stopCrInvSelAction
& creatures . ix cid . crInvSel . iselPos %~ g
& creatures . ix cid . crLeftInvSel %~ g'
rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid . itConsumption . icAmount of
Just x | x > 1 -> w & cWorld . creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ subtract 1
_ -> w
& cWorld . creatures . ix cid . crInv %~ f
& cWorld . creatures . ix cid . crInvSel %~ stopCrInvSelAction
& cWorld . creatures . ix cid . crInvSel . iselPos %~ g
& cWorld . creatures . ix cid . crLeftInvSel %~ g'
& removeAnySlotEquipment
& dounequipfunction
& doanyitemeffect
& creatures . ix cid . crInvEquipped %~ IM.delete invid
& creatures . ix cid . crInvEquipped %~ IM.mapKeys g
& cWorld . creatures . ix cid . crInvEquipped %~ IM.delete invid
& cWorld . creatures . ix cid . crInvEquipped %~ IM.mapKeys g
-- TODO check whether this can be mapKeysMonotonic
where
stopCrInvSelAction (InvSel i a)
| i == invid = InvSel i NoInvSelAction
| otherwise = InvSel i a
cr = _creatures w IM.! cid
cr = _creatures (_cWorld w) IM.! cid
itm = _crInv cr IM.! invid
dounequipfunction = fromMaybe id $ do
rmf <- itm ^? itUse . eqEq . eqOnRemove
@@ -77,10 +78,10 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons
doanyitemeffect = fromMaybe id $ do
rmf <- itm ^? itEffect . ieDrop
return $ doDropEffect rmf itm cr
removeAnySlotEquipment = case w ^? creatures . ix cid . crInvEquipped . ix invid of
Just epos -> creatures . ix cid . crEquipment . at epos .~ Nothing
removeAnySlotEquipment = case w ^? cWorld . creatures . ix cid . crInvEquipped . ix invid of
Just epos -> cWorld . creatures . ix cid . crEquipment . at epos .~ Nothing
Nothing -> id
maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures w IM.! cid
maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures (_cWorld w) IM.! cid
f inv = let (xs,ys) = IM.split invid inv
in xs `IM.union` IM.mapKeys (subtract 1) ys
g x | x > invid || Just x == maxk = max 0 $ x - 1
@@ -92,7 +93,7 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons
| otherwise = Just x
rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = rmInvItem cid (crSel (_creatures w IM.! cid)) w
rmSelectedInvItem cid w = rmInvItem cid (crSel (_creatures (_cWorld w) IM.! cid)) w
augmentedInvSizes :: World -> IM.IntMap Int
augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize
@@ -100,7 +101,7 @@ augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize
bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.IntMap a
bimapAugmentInv f g w = IM.union
(f <$> yourInv w)
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects w)
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects (_cWorld w))
invSelSize :: Int -> World -> Int
invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
@@ -154,18 +155,18 @@ updateTerminal :: World -> World
updateTerminal = checkTermDist
checkTermDist :: World -> World
checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
Just tmid -> fromMaybe (w & hud . hudElement .~ DisplayInventory NoSubInventory) $ do
btid <- w ^? terminals . ix tmid . tmButtonID
btpos <- w ^? buttons . ix btid . btPos
checkTermDist w = case w ^? cWorld . hud . hudElement . subInventory . termID of
Just tmid -> fromMaybe (w & cWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do
btid <- w ^? cWorld . terminals . ix tmid . tmButtonID
btpos <- w ^? cWorld . buttons . ix btid . btPos
if dist btpos (_crPos $ you w) < 40 then Just w else Nothing
Nothing -> w
-- this looks ugly...
updateCloseObjects :: World -> World
updateCloseObjects w = w
& closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
& creatures . ix (_yourID w) . crInvSel . iselPos %~ updateinvsel
& cWorld . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ updateinvsel
where
updateinvsel curinvsel
| length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1
@@ -175,26 +176,26 @@ updateCloseObjects w = w
activeButtons = map Right
. filter ( (/=) BtNoLabel . _btState)
. IM.elems
$ _buttons w
currentClose = filt $ map Left (IM.elems $ _floorItems w) ++ activeButtons
oldClose = filt $ mapMaybe updatebyid $ _closeObjects w
$ _buttons (_cWorld w)
currentClose = filt $ map Left (IM.elems $ _floorItems (_cWorld w)) ++ activeButtons
oldClose = filt $ mapMaybe updatebyid $ _closeObjects (_cWorld w)
oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
updatebyid (Left flid) = fmap Left $ w ^? floorItems . ix (_flItID flid)
updatebyid (Right btid) = fmap Right $ w ^? buttons . ix (_btID btid)
updatebyid (Left flid) = fmap Left $ w ^? cWorld . floorItems . ix (_flItID flid)
updatebyid (Right btid) = fmap Right $ w ^? cWorld . buttons . ix (_btID btid)
updateRBList :: World -> World
updateRBList w
| w ^? rbOptions . opCurInvPos == Just curinvid
| w ^? cWorld . rbOptions . opCurInvPos == Just curinvid
= w & setEquipAllocation & setEquipActivation
| otherwise = case cr ^? crInv . ix curinvid . itUse . eqEq . eqSite of
Just esite -> w
& rbOptions .~ EquipOptions (equipSiteToPositions esite)
& cWorld . rbOptions .~ EquipOptions (equipSiteToPositions esite)
(chooseEquipmentPosition cr (equipSiteToPositions esite))
curinvid
DoNotMoveEquipment
NoChangeActivateEquipment
& setEquipAllocation & setEquipActivation
Nothing -> w & rbOptions .~ NoRightButtonOptions
Nothing -> w & cWorld . rbOptions .~ NoRightButtonOptions
-- | otherwise = w & rbOptions .~ NoRightButtonOptions
where
curinvid = crSel cr
@@ -211,53 +212,53 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
setEquipAllocation :: World -> World
setEquipAllocation w = case _rbOptions w of
setEquipAllocation w = case _rbOptions (_cWorld w) of
EquipOptions {_opEquip = es,_opSel=i} ->
case you w ^? crInvEquipped . ix (crSel (you w)) of
Just epos | es !! i == epos
-> w & rbOptions . opAllocateEquipment .~ RemoveEquipment
-> w & cWorld . rbOptions . opAllocateEquipment .~ RemoveEquipment
{_allocOldPos = epos}
Just epos | isJust (you w ^? crEquipment . ix (es !! i))
-> w & rbOptions . opAllocateEquipment .~ SwapEquipment
-> w & cWorld . rbOptions . opAllocateEquipment .~ SwapEquipment
{_allocOldPos = epos
,_allocNewPos = es !! i
,_allocSwapID = _crEquipment (you w) M.! (es !! i)
}
Just epos -> w & rbOptions . opAllocateEquipment .~ MoveEquipment
Just epos -> w & cWorld . rbOptions . opAllocateEquipment .~ MoveEquipment
{_allocOldPos = epos
,_allocNewPos = es !! i
}
Nothing | isJust (you w ^? crEquipment . ix (es !! i))
-> w & rbOptions . opAllocateEquipment .~ ReplaceEquipment
-> w & cWorld . rbOptions . opAllocateEquipment .~ ReplaceEquipment
{_allocNewPos = es !! i
,_allocRemoveID = _crEquipment (you w) M.! (es !! i)
}
Nothing -> w & rbOptions . opAllocateEquipment .~ PutOnEquipment
Nothing -> w & cWorld . rbOptions . opAllocateEquipment .~ PutOnEquipment
{_allocNewPos = es !! i}
_ -> w
-- where
-- curpos = invSelPos w
setEquipActivation :: World -> World
setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
setEquipActivation w = case w ^? cWorld . rbOptions . opAllocateEquipment of
Just DoNotMoveEquipment -> w
Just RemoveEquipment { }
-> case _crLeftInvSel (you w) of
Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ DeactivateEquipment
Just i | i == invsel -> w & cWorld . rbOptions . opActivateEquipment .~ DeactivateEquipment
{_deactivateEquipment = i}
_ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
_ -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Just rbos
-> case _crLeftInvSel (you w) of
Just i | i == invsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Just i | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment
Just i | i == invsel -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Just i | invselcanactivate -> w & cWorld . rbOptions . opActivateEquipment .~ ActivateDeactivateEquipment
{_activateEquipment = invsel,_deactivateEquipment = i}
Just i | Just i == rbos ^? allocRemoveID
-> w & rbOptions . opActivateEquipment .~ DeactivateEquipment i
Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing | invselcanactivate -> w & rbOptions . opActivateEquipment .~ ActivateEquipment
-> w & cWorld . rbOptions . opActivateEquipment .~ DeactivateEquipment i
Just _ -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing | invselcanactivate -> w & cWorld . rbOptions . opActivateEquipment .~ ActivateEquipment
{_activateEquipment = invsel}
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
Nothing -> w & cWorld . rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
where
invsel = crSel (you w)
invselcanactivate = isJust (you w ^? crInv . ix invsel . itUse . lUse)
@@ -274,29 +275,32 @@ equipSiteToPositions es = case es of
closeObjScrollDir :: Float -> World -> World
closeObjScrollDir x
| x > 0 = over closeObjects rotU
| x < 0 = over closeObjects rotD
| x > 0 = over (cWorld . closeObjects) rotU
| x < 0 = over (cWorld . closeObjects) rotD
| otherwise = id
changeInvSel :: Int -> World -> World
changeInvSel i w
| n == 0 = w
| yourInvSel w < n = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ (`mod` n) . subtract i
& creatures . ix (_yourID w) . crInvSel . iselAction .~ NoInvSelAction
| otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ ((+n) . (`mod` numCO) . subtract (i+n))
& creatures . ix (_yourID w) . crInvSel . iselAction .~ NoInvSelAction
| yourInvSel w < n = w
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
| otherwise = w
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ ((+n) . (`mod` numCO) . subtract (i+n))
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
-- arguably this should jump the invpos into the inventory proper
where
n = length $ _crInv $ _creatures w IM.! _yourID w
numCO = length $ _closeObjects w
n = length $ _crInv $ _creatures (_cWorld w) IM.! _yourID (_cWorld w)
numCO = length $ _closeObjects (_cWorld w)
changeSwapInvSel :: Int -> World -> World
changeSwapInvSel k w
| n == 0 = w
| yourInvSel w < n = w
& creatures . ix (_yourID w) %~ updatecreature
| otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos .~ ico'
& closeObjects %~ swapIndices (i - n) (ico' - n)
& cWorld . creatures . ix (_yourID (_cWorld w)) %~ updatecreature
| otherwise = w
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos .~ ico'
& cWorld . closeObjects %~ swapIndices (i - n) (ico' - n)
where
updatecreature = ( crInv %~ IM.safeSwapKeys (i `mod` n) swapi )
. (crLeftInvSel . _Just %~ updateLeftInvSel)
@@ -315,18 +319,19 @@ changeSwapInvSel k w
i = crSel cr
ico' = ( (i - (k+n)) `mod` numCO ) + n
n = length $ _crInv cr
numCO = length $ _closeObjects w
numCO = length $ _closeObjects (_cWorld w)
changeAugInvSel :: Int -> World -> World
changeAugInvSel i w
| n == 0 = w
| otherwise = w & creatures . ix (_yourID w) . crInvSel . iselPos %~ (`mod` n) . subtract i
& creatures . ix (_yourID w) . crInvSel . iselAction .~ NoInvSelAction
| otherwise = w
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
where
n = length (yourInv w) + length (_closeObjects w)
n = length (yourInv w) + length (_closeObjects (_cWorld w))
bestCloseObjectIndex :: World -> Maybe Int
bestCloseObjectIndex w = findIndex f $ _closeObjects w
bestCloseObjectIndex w = findIndex f $ _closeObjects (_cWorld w)
where
f (Right _) = True
f (Left flit) = itSlotsTaken (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr
@@ -342,4 +347,4 @@ selectedCloseObject w
inv = _crInv cr
selectNthCloseObject :: World -> Int -> Maybe (Int,Either FloorItem Button)
selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects w !? n)
selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects (_cWorld w) !? n)