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

Add in "linear" lWorld to separate time reversable worlds

Browse Source
This commit is contained in:
justin
2022-10-28 12:24:51 +01:00
parent 5f6bd43599
commit 7e790b7153
130 changed files with 827 additions and 980 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Inventory.hs
+44 -42
View File
@@ -49,26 +49,26 @@ rmInvItem ::
Int ->
World ->
World
rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount of
Just x | x > 1 -> w & cWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount %~ subtract 1
rmInvItem cid invid w = case w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount of
Just x | x > 1 -> w & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount %~ 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'
& cWorld . lWorld . creatures . ix cid . crInv %~ f
& cWorld . lWorld . creatures . ix cid . crInvSel %~ stopCrInvSelAction
& cWorld . lWorld . creatures . ix cid . crInvSel . iselPos %~ g
& cWorld . lWorld . creatures . ix cid . crLeftInvSel %~ g'
& removeAnySlotEquipment
& dounequipfunction
& doanyitemeffect
& cWorld . creatures . ix cid . crInvEquipped %~ IM.delete invid
& cWorld . creatures . ix cid . crInvEquipped %~ IM.mapKeys g
& cWorld . lWorld . creatures . ix cid . crInvEquipped %~ IM.delete invid
& cWorld . lWorld . creatures . ix cid . crInvEquipped %~ IM.mapKeys g
where
-- TODO check whether this can be mapKeysMonotonic
stopCrInvSelAction (InvSel i a)
| i == invid = InvSel i NoInvSelAction
| otherwise = InvSel i a
cr = _creatures (_cWorld w) IM.! cid
cr = w ^?! cWorld . lWorld . creatures . ix cid
itm = _crInv cr IM.! invid
dounequipfunction = fromMaybe id $ do
rmf <- itm ^? itUse . equipEffect . eeOnRemove
@@ -76,10 +76,10 @@ rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid
doanyitemeffect = fromMaybe id $ do
rmf <- itm ^? itEffect . ieOnDrop
return $ doInvEffect rmf itm cr
removeAnySlotEquipment = case w ^? cWorld . creatures . ix cid . crInvEquipped . ix invid of
Just epos -> cWorld . creatures . ix cid . crEquipment . at epos .~ Nothing
removeAnySlotEquipment = case w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid of
Just epos -> cWorld . lWorld . creatures . ix cid . crEquipment . at epos .~ Nothing
Nothing -> id
maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures (_cWorld w) IM.! cid
maxk = fmap fst $ IM.lookupMax $ w ^?! cWorld . lWorld . creatures . ix cid . crInv
f inv =
let (xs, ys) = IM.split invid inv
in xs `IM.union` IM.mapKeys (subtract 1) ys
@@ -93,7 +93,7 @@ rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid
| otherwise = Just x
rmSelectedInvItem :: Int -> World -> World
rmSelectedInvItem cid w = rmInvItem cid (crSel (_creatures (_cWorld w) IM.! cid)) w
rmSelectedInvItem cid w = rmInvItem cid (crSel (w ^?! cWorld . lWorld . creatures . ix cid)) w
augmentedInvSizes :: World -> IM.IntMap Int
augmentedInvSizes = bimapAugmentInv itSlotsTaken closeObjectSize
@@ -102,7 +102,7 @@ bimapAugmentInv :: (Item -> a) -> (Either FloorItem Button -> a) -> World -> IM.
bimapAugmentInv f g w =
IM.union
(f <$> yourInv w)
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ _closeObjects (_cWorld w))
(IM.fromAscList $ zip [length (yourInv w) ..] $ map g $ w ^. cWorld . lWorld . closeObjects)
invSelSize :: Int -> World -> Int
invSelSize i w = fromMaybe 1 $ augmentedInvSizes w IM.!? i
@@ -157,10 +157,10 @@ updateTerminal :: World -> World
updateTerminal = checkTermDist
checkTermDist :: World -> World
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
checkTermDist w = case w ^? cWorld . lWorld . hud . hudElement . subInventory . termID of
Just tmid -> fromMaybe (w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do
btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
if dist btpos (_crPos $ you w) < 40 then Just w else Nothing
Nothing -> w
@@ -168,8 +168,8 @@ checkTermDist w = case w ^? cWorld . hud . hudElement . subInventory . termID of
updateCloseObjects :: World -> World
updateCloseObjects w =
w
& cWorld . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ updateinvsel
& cWorld . lWorld . closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
& cWorld . lWorld . creatures . ix (_yourID (_lWorld (_cWorld w))) . crInvSel . iselPos %~ updateinvsel
where
updateinvsel curinvsel
| length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1
@@ -180,12 +180,12 @@ updateCloseObjects w =
map Right
. filter ((/=) BtNoLabel . _btState)
. IM.elems
$ _buttons (_cWorld w)
currentClose = filt $ map Left (IM.elems $ _floorItems (_cWorld w)) ++ activeButtons
oldClose = filt $ mapMaybe updatebyid $ _closeObjects (_cWorld w)
$ w ^. cWorld . lWorld . buttons
currentClose = filt $ map Left (IM.elems $ w ^. cWorld . lWorld . floorItems) ++ activeButtons
oldClose = filt $ mapMaybe updatebyid $ w ^. cWorld . lWorld . closeObjects
oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
updatebyid (Left flid) = fmap Left $ w ^? cWorld . floorItems . ix (_flItID flid)
updatebyid (Right btid) = fmap Right $ w ^? cWorld . buttons . ix (_btID btid)
updatebyid (Left flid) = fmap Left $ w ^? cWorld . lWorld . floorItems . ix (_flItID flid)
updatebyid (Right btid) = fmap Right $ w ^? cWorld . lWorld . buttons . ix (_btID btid)
updateRBList :: World -> World
updateRBList w
@@ -310,8 +310,8 @@ equipSiteToPositions es = case es of
closeObjScrollDir :: Float -> World -> World
closeObjScrollDir x
| x > 0 = over (cWorld . closeObjects) rotU
| x < 0 = over (cWorld . closeObjects) rotD
| x > 0 = over (cWorld . lWorld . closeObjects) rotU
| x < 0 = over (cWorld . lWorld . closeObjects) rotD
| otherwise = id
changeInvSel :: Int -> World -> World
@@ -319,29 +319,30 @@ changeInvSel i w
| n == 0 = w
| 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
& cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID) . crInvSel . iselPos %~ (`mod` n) . subtract i
& cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID) . 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
& cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID) . crInvSel . iselPos %~ ((+ n) . (`mod` numCO) . subtract (i + n))
& cWorld . lWorld . creatures . ix (w ^. cWorld . lWorld . yourID) . crInvSel . iselAction .~ NoInvSelAction
where
-- arguably this should jump the invpos into the inventory proper
n = length $ _crInv $ _creatures (_cWorld w) IM.! _yourID (_cWorld w)
numCO = length $ _closeObjects (_cWorld w)
n = length $ _crInv $ _creatures (_lWorld (_cWorld w)) IM.! _yourID (_lWorld (_cWorld w))
numCO = length $ w ^. cWorld . lWorld . closeObjects
changeSwapInvSel :: Int -> World -> World
changeSwapInvSel k w
| n == 0 = w
| yourInvSel w < n =
w
& cWorld . creatures . ix (_yourID (_cWorld w)) %~ updatecreature
& cWorld . lWorld . creatures . ix yid %~ updatecreature
| otherwise =
w
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos .~ ico'
& cWorld . closeObjects %~ swapIndices (i - n) (ico' - n)
& cWorld . lWorld . creatures . ix yid . crInvSel . iselPos .~ ico'
& cWorld . lWorld . closeObjects %~ swapIndices (i - n) (ico' - n)
where
yid = w ^. cWorld . lWorld . yourID
updatecreature =
(crInv %~ IM.safeSwapKeys (i `mod` n) swapi)
. (crLeftInvSel . _Just %~ updateLeftInvSel)
@@ -361,20 +362,21 @@ changeSwapInvSel k w
i = crSel cr
ico' = ((i - (k + n)) `mod` numCO) + n
n = length $ _crInv cr
numCO = length $ _closeObjects (_cWorld w)
numCO = length $ w ^. cWorld . lWorld . closeObjects
changeAugInvSel :: Int -> World -> World
changeAugInvSel i w
| n == 0 = w
| otherwise =
w
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselPos %~ (`mod` n) . subtract i
& cWorld . creatures . ix (_yourID (_cWorld w)) . crInvSel . iselAction .~ NoInvSelAction
& cWorld . lWorld . creatures . ix yid . crInvSel . iselPos %~ (`mod` n) . subtract i
& cWorld . lWorld . creatures . ix yid . crInvSel . iselAction .~ NoInvSelAction
where
n = length (yourInv w) + length (_closeObjects (_cWorld w))
yid = w ^. cWorld . lWorld . yourID
n = length (yourInv w) + length (w ^. cWorld . lWorld . closeObjects)
bestCloseObjectIndex :: World -> Maybe Int
bestCloseObjectIndex w = findIndex f $ _closeObjects (_cWorld w)
bestCloseObjectIndex w = findIndex f $ w ^. cWorld . lWorld . closeObjects
where
f (Right _) = True
f (Left flit) = itSlotsTaken (_flIt flit) <= _crInvCapacity ycr - crInvSize ycr
@@ -390,4 +392,4 @@ selectedCloseObject w
inv = _crInv cr
selectNthCloseObject :: World -> Int -> Maybe (Int, Either FloorItem Button)
selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects (_cWorld w) !? n)
selectNthCloseObject w n = (length (yourInv w) + n,) <$> (_closeObjects (_lWorld (_cWorld w)) !? n)