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

Continue removing LDTs

Browse Source
This commit is contained in:
justin
2025-07-12 14:01:44 +01:00
parent 8ff607675b
commit f47f99eac4
15 changed files with 359 additions and 257 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse/UseItem.hs
+16 -16
View File
@@ -18,25 +18,25 @@ import qualified IntMapHelp as IM
useItem :: Int -> PressType -> World -> Maybe World
useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
itmloc <- allInvLocs (_crInv cr) ^? ix invid . _2
useItemLoc cr itmloc pt w
itmloc <- invIndents (_crInv cr) ^? ix invid . _2
useItemLoc cr (itmloc) pt w
useItemLoc :: Creature -> LocationLDT ItemLink OItem -> PressType -> World -> Maybe World
useItemLoc :: Creature -> LocationDT OItem -> PressType -> World -> Maybe World
useItemLoc cr loc pt w
| HeldPlatformSF <- sf
, fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
, fromMaybe False $ loc ^? locDT . dtValue . _1 . itLocation . ilIsAttached
, Aiming{} <- cr ^. crStance . posture =
return $ gadgetEffect pt (locLDTToLocDT loc) cr w
return $ gadgetEffect pt loc cr w
| LaserWeaponSF <- sf
, fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
, fromMaybe False $ loc ^? locDT . dtValue . _1 . itLocation . ilIsAttached
, Aiming{} <- cr ^. crStance . posture =
return $ gadgetEffect pt (locLDTToLocDT loc) cr w
return $ gadgetEffect pt (loc) cr w
| GadgetPlatformSF <- sf =
return $ gadgetEffect pt (locLDTToLocDT loc) cr w
return $ gadgetEffect pt (loc) cr w
| UnderBarrelPlatformSF <- sf
, fromMaybe False $ loc ^? locLDT . ldtValue . _1 . itLocation . ilIsAttached
, fromMaybe False $ loc ^? locDT . dtValue . _1 . itLocation . ilIsAttached
, Aiming{} <- cr ^. crStance . posture =
return $ gadgetEffect pt (locLDTToLocDT loc) cr w
return $ gadgetEffect pt (loc) cr w
| RemoteDetonatorSF <- sf
, pt == InitialPress =
return $ activateDetonator ldt w
@@ -53,12 +53,12 @@ useItemLoc cr loc pt w
, pt == InitialPress
, Just invid' <- itm ^? itLocation . ilInvID =
return $ toggleEquipmentAt invid' cr w
| otherwise = (\loc' -> useItemLoc cr loc' pt w) =<< locUp loc
| otherwise = (\loc' -> useItemLoc cr loc' pt w) =<< locUp' loc
-- ie try location above
where
sf = loc ^. locLDT . ldtValue . _2
ldt = loc ^. locLDT
itm = ldt ^. ldtValue . _1
sf = loc ^. locDT . dtValue . _2
ldt = loc ^. locDT
itm = ldt ^. dtValue . _1
--chooseUseLocation :: LocationLDT ItemLink OItem -> LocationLDT ItemLink OItem
--chooseUseLocation loc
@@ -78,9 +78,9 @@ useItemLoc cr loc pt w
-- MapperSF -> True
-- _ -> False
activateDetonator :: LDTree ItemLink OItem -> World -> World
activateDetonator :: DTree OItem -> World -> World
activateDetonator det = fromMaybe id $ do
pjid <- det ^? ldtValue . _1 . itUse . uaParams . apProjectiles . ix 0
pjid <- det ^? dtValue . _1 . itUse . uaParams . apProjectiles . ix 0
return $ cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0
toggleEquipmentAt :: Int -> Creature -> World -> World
src/Dodge/Creature/State.hs
+28 -28
View File
@@ -147,18 +147,18 @@ invRootItemEffs :: Creature -> World -> World
invRootItemEffs cr =
appEndo $
foldMap
(reduceLocLDT (Endo . invItemLocUpdate cr) . LocLDT TopLDT)
(invLDT' (_crInv cr))
(reduceLocDT (Endo . invItemLocUpdate cr) . LocDT TopDT)
(invDT' (_crInv cr))
invItemLocUpdate :: Creature -> LocationLDT ItemLink OItem -> World -> World
invItemLocUpdate :: Creature -> LocationDT OItem -> World -> World
invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
ATTACH BULLETSYNTH -> trySynthBullet loc w
EQUIP WRIST_ECG | haspulse -> tryUseParent (locLDTToLocDT loc) w
EQUIP WRIST_ECG | haspulse -> tryUseParent (loc) w
COPIER _ -> copierItemUpdate itm cr w
HELD FLATSHIELD -> rootNotrootEff createShieldWall removeShieldWall itm cr w
HELD MINIGUNX{} -> coolMinigun itm w
HELD MACHINEPISTOL{} -> coolMachinePistol cr itm w
HELD LASER | loc ^. locLDT . ldtValue . _2 == WeaponTargetingSF
HELD LASER | loc ^. locDT . dtValue . _2 == WeaponTargetingSF
, itm ^? itLocation . ilIsAttached == Just True -> shineTargetLaser cr loc w
HELD TORCH
| itm ^? itLocation . ilIsAttached == Just True -> shineTorch cr loc w
@@ -171,7 +171,7 @@ invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
haspulse =
w ^? cWorld . lWorld . creatures . ix 0 . crType . avatarPulse . pulseProgress
== Just 0
itm = loc ^. locLDT . ldtValue . _1
itm = loc ^. locDT . dtValue . _1
coolMinigun :: Item -> World -> World
coolMinigun itm
@@ -219,9 +219,9 @@ copierItemUpdate itm cr w = fromMaybe w $ do
v <- getItemValue itm' w cr
return $ w & pointerToItem itm . itUse . uValue .~ v
doAnyEquipmentEffect :: LocationLDT ItemLink OItem -> Creature -> World -> World
doAnyEquipmentEffect :: LocationDT OItem -> Creature -> World -> World
doAnyEquipmentEffect loc cr = maybe id (equipBackgroundEffect loc cr)
$ loc ^? locLDT . ldtValue . _1 . itLocation . ilEquipSite . _Just
$ loc ^? locDT . dtValue . _1 . itLocation . ilEquipSite . _Just
tryUseParent :: LocationDT OItem -> World -> World
tryUseParent loc w = fromMaybe w $ do
@@ -229,13 +229,13 @@ tryUseParent loc w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix 0
return $ gadgetEffect InitialPress t cr w
trySynthBullet :: LocationLDT ItemLink OItem -> World -> World
trySynthBullet :: LocationDT OItem -> World -> World
trySynthBullet loc w = fromMaybe w $ do
i <- itm ^? itLocation . ilInvID
x <- itm ^? itUse . uaParams . apInt
if x < 100
then do
bat <- loc ^? locLDT . ldtLeft . ix 0 . _2 . ldtValue . _1
bat <- loc ^? locDT . dtLeft . ix 0 . dtValue . _1
j <- bat ^? itLocation . ilInvID
y <- bat ^. itConsumables
guard $ y > 0
@@ -257,7 +257,7 @@ trySynthBullet loc w = fromMaybe w $ do
. _Just
-~ 1
else do
mag <- loc ^? locLdtContext . cldtParent . _1
mag <- loc ^? locDtContext . cdtParent . _1
j <- mag ^? itLocation . ilInvID
y <- mag ^. itConsumables
ymax <- maxAmmo mag
@@ -280,24 +280,24 @@ trySynthBullet loc w = fromMaybe w $ do
. _Just
+~ 1
where
itm = loc ^. locLDT . ldtValue . _1
itm = loc ^. locDT . dtValue . _1
drawARHUD :: LocationLDT ItemLink OItem -> World -> World
drawARHUD (LocLDT con _) w = fromMaybe w $ do
itm <- con ^? cldtParent . _1
drawARHUD :: LocationDT OItem -> World -> World
drawARHUD (LocDT con _) w = fromMaybe w $ do
itm <- con ^? cdtParent . _1
return $
w & cWorld . lWorld . flares
<>~ fold
(drawTargetingAR itm w <|> drawMapperAR itm w)
shineTargetLaser :: Creature -> LocationLDT ItemLink OItem -> World -> World
shineTargetLaser :: Creature -> LocationDT OItem -> World -> World
shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ do
guard (crIsAiming cr)
-- (_, mag) <- find (isammolink . fst) (itmtree ^. ldtLeft)
(_, mag) <- find (isammolink . (^. _2 . ldtValue . _2)) (itmtree ^. ldtLeft)
i <- mag ^. ldtValue . _1 . itConsumables
( mag) <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft)
i <- mag ^. dtValue . _1 . itConsumables
guard $ i >= x
maginvid <- mag ^? ldtValue . _1 . itLocation . ilInvID
maginvid <- mag ^? dtValue . _1 . itLocation . ilInvID
return $
w
& worldEventFlags . at InventoryChange ?~ ()
@@ -316,33 +316,33 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
, _lpType = TargetingLaser (_itID itm)
}
where
o = locOrient (locLDTToLocDT loc) cr
itmtree = loc ^. locLDT
o = locOrient (loc) cr
itmtree = loc ^. locDT
(p, q) = o `Q.comp` (V3 5 0 0, Q.qID)
x = 1
isammolink AmmoMagSF{} = True
isammolink _ = False
pos = _crPos cr + xyV3 (rotate3 cdir p)
cdir = _crDir cr
itm = itmtree ^. ldtValue . _1
itm = itmtree ^. dtValue . _1
pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
cid = _crID cr
invid = _ilInvID $ _itLocation itm
col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
shineTorch :: Creature -> LocationLDT ItemLink OItem -> World -> World
shineTorch :: Creature -> LocationDT OItem -> World -> World
shineTorch cr loc = fromMaybe id $ do
(_, mag) <- find (isammolink . (^. _2 . ldtValue . _2)) (itmtree ^. ldtLeft)
i <- mag ^. ldtValue . _1 . itConsumables
( mag) <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft)
i <- mag ^. dtValue . _1 . itConsumables
guard $ crIsAiming cr
guard $ i >= x
invid <- mag ^? ldtValue . _1 . itLocation . ilInvID
invid <- mag ^? dtValue . _1 . itLocation . ilInvID
return $
(cWorld . lWorld . lights .:~ LSParam pos 250 0.7)
. (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumables . _Just -~ x)
where
itmtree = loc ^. locLDT
(p, q) = locOrient (locLDTToLocDT loc) cr
itmtree = loc ^. locDT
(p, q) = locOrient (loc) cr
x = 10
isammolink AmmoMagSF{} = True
isammolink _ = False
src/Dodge/Creature/Test.hs
+2 -3
View File
@@ -24,7 +24,6 @@ module Dodge.Creature.Test (
crSafeDistFromTarg,
) where
import Dodge.DoubleTree
import Dodge.Item.Grammar
import Dodge.Creature.Radius
import Dodge.Data.Equipment.Misc
@@ -97,8 +96,8 @@ crInAimStance as cr = crIsAiming cr && mitstance == Just as
mitstance = do
i <- cr ^? crManipulation . manObject . imRootSelectedItem
--itm <- invRootTrees' (cr ^. crInv) ^? ix i
itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invRootTrees (cr ^. crInv) ^? ix i
return $ aimStance $ ldtToDT itm
itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (cr ^. crInv) ^? ix i
return $ aimStance $ itm
--cr ^? crInv . ix i . itUse . heldAim . aimStance
oneH :: Creature -> Bool
src/Dodge/DisplayInventory.hs
+1 -1
View File
@@ -162,7 +162,7 @@ updateDisplaySections w cfig =
invitems =
IM.map
(uncurry (invSelectionItem w))
(allInvLocs' $ _crInv cr)
(invIndents $ _crInv cr)
filterSectionsPair ::
Bool -> -- check for whether filter is in focus, changes string at the end
src/Dodge/DoubleTree.hs
+68
View File
@@ -309,6 +309,12 @@ locLeftmost loc = maybe loc locLeftmost $ alaf First foldMap Just $ locGoLeft lo
locRightmost :: LocationLDT b a -> LocationLDT b a
locRightmost loc = maybe loc locRightmost $ alaf Last foldMap Just $ locGoRight loc
locDTLeftmost :: LocationDT a -> LocationDT a
locDTLeftmost loc = maybe loc locDTLeftmost $ alaf First foldMap Just $ locDTGoLeft loc
locDTRightmost :: LocationDT a -> LocationDT a
locDTRightmost loc = maybe loc locDTRightmost $ alaf Last foldMap Just $ locDTGoRight loc
-- should probably do tests for these
locGoLeft :: LocationLDT b a -> [LocationLDT b a]
locGoLeft (LocLDT c (LDT v l r)) =
@@ -319,6 +325,16 @@ locGoRight :: LocationLDT b a -> [LocationLDT b a]
locGoRight (LocLDT c (LDT v l r)) =
[LocLDT (RightwardLDT c l closel v link closer) t | (closel, (link, t), closer) <- locGoHelp id r]
-- should probably do tests for these
locDTGoLeft :: LocationDT a -> [LocationDT a]
locDTGoLeft (LocDT c (DT v l r)) =
[LocDT (LeftwardDT c closel v closer r) t | (closel, t, closer) <- locDTGoHelp id l]
-- should probably do tests for these
locDTGoRight :: LocationDT a -> [LocationDT a]
locDTGoRight (LocDT c (DT v l r)) =
[LocDT (RightwardDT c l closel v closer) t | (closel, ( t), closer) <- locDTGoHelp id r]
-- this seems like it might be very inefficient for large lists
-- difference lists?
locGoHelp :: (a -> b) -> [a] -> [([a], b, [a])]
@@ -327,6 +343,14 @@ locGoHelp f = go []
go cleft (y : ys) = (cleft, f y, ys) : go (cleft <> [y]) ys
go _ [] = []
-- this seems like it might be very inefficient for large lists
-- difference lists?
locDTGoHelp :: (a -> b) -> [a] -> [([a], b, [a])]
locDTGoHelp f = go []
where
go cleft (y : ys) = (cleft, f y, ys) : go (cleft <> [y]) ys
go _ [] = []
-- Propgates a value (of type c) down the branches of the ContextLDT.
-- The value is updated according a "left" or "right" function (lf or rf),
-- that acts on the parent value, the link, and the child value.
@@ -370,3 +394,47 @@ reduceLocLDT :: Monoid m => (LocationLDT b a -> m) -> LocationLDT b a -> m
reduceLocLDT f x =
foldMap (reduceLocLDT f) (locGoLeft x) <> f x
<> foldMap (reduceLocLDT f) (locGoRight x)
reduceLocDT :: Monoid m => (LocationDT a -> m) -> LocationDT a -> m
reduceLocDT f x =
foldMap (reduceLocDT f) (locDTGoLeft x) <> f x
<> foldMap (reduceLocDT f) (locDTGoRight x)
-- Propgates a value (of type c) down the branches of the ContextLDT.
-- The value is updated according a "left" or "right" function (lf or rf),
-- that acts on the parent value and the child value.
-- For each context node, the updated value is used to update a final value (of type d).
cdtPropagateFold ::
(c -> a -> a -> c) ->
(c -> a -> a -> c) ->
(c -> LocationDT a -> d -> d) ->
c ->
LocationDT a ->
d ->
d
cdtPropagateFold lf rf up x loc =
alaf
Endo
foldMap
( \(LocDT con' t') ->
cdtPropagateFold
lf
rf
up
(lf x (_cdtParent con') (_dtValue t'))
(LocDT con' t')
)
(locDTGoLeft loc)
. alaf
Endo
foldMap
( \(LocDT con' t') ->
cdtPropagateFold
lf
rf
up
(rf x (_cdtParent con') (_dtValue t'))
(LocDT con' t')
)
(locDTGoRight loc)
. up x loc
src/Dodge/Euse.hs
+2 -2
View File
@@ -12,7 +12,7 @@ import Dodge.Wall.Move
import Geometry
import LensHelp
equipBackgroundEffect :: LocationLDT ItemLink OItem -> Creature -> EquipSite
equipBackgroundEffect :: LocationDT OItem -> Creature -> EquipSite
-> World -> World
equipBackgroundEffect loc cr = case eo of
EQUIP (MAGSHIELD mt) -> const $ useMagShield mt itm cr
@@ -20,7 +20,7 @@ equipBackgroundEffect loc cr = case eo of
EQUIP HEADLAMP -> const $ createHeadLamp itm cr
_ -> const id
where
itm = loc ^. locLDT . ldtValue . _1
itm = loc ^. locDT . dtValue . _1
eo = itm ^. itType
-- this should probably drain energy
src/Dodge/HeldUse.hs
-1
View File
@@ -107,7 +107,6 @@ hammerCheck f pt loc cr w = case itemTriggerType loc of
NoTrigger -> f loc cr w
_ -> w
where
tree = loc ^. locDT
it = loc ^. locDT . dtValue . _1
cid = _crID cr
-- the following is unsafe, but if ilInvID isn't correctly set we probably
src/Dodge/Inventory/Location.hs
+1 -1
View File
@@ -54,7 +54,7 @@ crSetRoots cid w = fromMaybe w $ do
dropMissing
preserveMissing
(zipWithMatched f)
(invRootTrees inv)
(invIMDT inv)
where
f _ _ = itLocation . ilIsRoot .~ True
src/Dodge/Inventory/SelectionList.hs
+3 -2
View File
@@ -29,7 +29,7 @@ import NewInt
import Padding
import Picture.Base
invSelectionItem :: World -> Int -> LocationLDT ItemLink CItem -> SelectionItem ()
invSelectionItem :: World -> Int -> LocationDT OItem -> SelectionItem ()
invSelectionItem w indent loc =
SelectionItem
{ _siPictures = itemDisplay w cr ci
@@ -41,7 +41,8 @@ invSelectionItem w indent loc =
, _siPayload = ()
}
where
ci = loc ^. locLDT . ldtValue
ci = (a,b)
(a,b,_) = loc ^. locDT . dtValue
cr = w ^?! cWorld . lWorld . creatures . ix 0
-- note the convoluted display of the hotkey/equipment, this was done to avoid a
src/Dodge/Inventory/Swap.hs
+6 -6
View File
@@ -65,15 +65,15 @@ checkConnection :: SoundOrigin -> SoundID -> Int -> Int -> World -> World
checkConnection so s i j w = fromMaybe w $ do
inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
let locs = allInvLocs inv
let locs = invIndents inv -- why indents?
iit <- locs ^? ix i . _2
jit <- locs ^? ix j . _2
guard $ isConnected iit || isConnected jit
return $ soundStart so cpos s Nothing w
isConnected :: LocationLDT b a -> Bool
isConnected x = case x ^. locLdtContext of
TopLDT ->
not (null $ x ^. locLDT . ldtRight)
|| not (null $ x ^. locLDT . ldtLeft)
isConnected :: LocationDT a -> Bool
isConnected x = case x ^. locDtContext of
TopDT ->
not (null $ x ^. locDT . dtRight)
|| not (null $ x ^. locDT . dtLeft)
_ -> True
src/Dodge/Item/Grammar.hs
+78 -48
View File
@@ -2,14 +2,14 @@
module Dodge.Item.Grammar (
invDT,
invLDT,
invLDT',
invDT',
invAdj,
invRootMap,
invRootTrees,
invRootTrees',
-- invRootTrees,
invIMDT,
baseCI,
allInvLocs,
allInvLocs',
invIndents,
-- allInvLocs,
) where
import Dodge.Item.Orientation
@@ -256,8 +256,11 @@ invDT = fmap ldtToDT .
joinItemsInList tryAttachItems . IM.elems
. fmap (singleLDT . baseCI)
invLDT' :: IM.IntMap Item -> [LDTree ItemLink OItem]
invLDT' = fmap propagateOrientation . invLDT
--invLDT' :: IM.IntMap Item -> [LDTree ItemLink OItem]
--invLDT' = fmap propagateOrientation . invLDT
invDT' :: IM.IntMap Item -> [DTree OItem]
invDT' = fmap propagateOrientation' . invDT
-- this assumes the creature inventory is well formed, specifically the
-- location ids
@@ -283,57 +286,84 @@ invAdj = IM.unions . map g . invLDT
(error ("invAdj item " ++ show (_itID itm) ++ " location: " ++ show (itm ^? itLocation)))
$ itm ^? itLocation . ilInvID
-- returns an intmap with trees for (only!) root items, indexed by inventory position
invRootTrees :: IM.IntMap Item -> IM.IntMap (LDTree ItemLink OItem)
invRootTrees = fmap propagateOrientation . IM.fromDistinctAscList . reverse . map getid . invLDT
where
getid :: LDTree ItemLink CItem -> (Int, LDTree ItemLink CItem)
getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)
---- returns an intmap with trees for (only!) root items, indexed by inventory position
--invRootTrees :: IM.IntMap Item -> IM.IntMap (LDTree ItemLink OItem)
--invRootTrees = fmap propagateOrientation . IM.fromDistinctAscList . reverse . map getid . invLDT
-- where
-- getid :: LDTree ItemLink CItem -> (Int, LDTree ItemLink CItem)
-- getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)
invRootTrees' :: IM.IntMap Item -> IM.IntMap (LDTree ItemLink CItem)
invRootTrees' = IM.fromDistinctAscList . reverse . map getid . invLDT
invIMDT :: IM.IntMap Item -> IM.IntMap (DTree OItem)
invIMDT = fmap propagateOrientation' . IM.fromDistinctAscList . reverse . map getid . invDT
where
getid :: LDTree ItemLink CItem -> (Int, LDTree ItemLink CItem)
getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)
getid :: DTree CItem -> (Int, DTree CItem)
getid t = (t ^?! dtValue . _1 . itLocation . ilInvID, t)
-- returns an intmap with indents and locations for all items
allInvLocs :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink OItem)
allInvLocs inv = foldMap (f . LocLDT TopLDT) (IM.elems (invRootTrees inv)) mempty
--invRootTrees' :: IM.IntMap Item -> IM.IntMap (LDTree ItemLink CItem)
--invRootTrees' = IM.fromDistinctAscList . reverse . map getid . invLDT
-- where
-- getid :: LDTree ItemLink CItem -> (Int, LDTree ItemLink CItem)
-- getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)
invIndents :: IM.IntMap Item -> IM.IntMap (Int, LocationDT OItem)
invIndents inv = foldMap (f . LocDT TopDT) (IM.elems (invIMDT inv)) mempty
where
f t = cldtPropagateFold h h g 0 t id
h x _ _ _ = x + 1
f t = cdtPropagateFold h h g 0 t id
h x _ _ = x + 1
g ::
Int ->
LocationLDT ItemLink OItem ->
( IM.IntMap (Int, LocationLDT ItemLink OItem) ->
IM.IntMap (Int, LocationLDT ItemLink OItem)
LocationDT OItem ->
( IM.IntMap (Int, LocationDT OItem) ->
IM.IntMap (Int, LocationDT OItem)
) ->
IM.IntMap (Int, LocationLDT ItemLink OItem) ->
IM.IntMap (Int, LocationLDT ItemLink OItem)
IM.IntMap (Int, LocationDT OItem) ->
IM.IntMap (Int, LocationDT OItem)
g x ldt =
(.)
( IM.insert
(ldt ^?! locLDT . ldtValue . _1 . itLocation . ilInvID)
(ldt ^?! locDT . dtValue . _1 . itLocation . ilInvID)
(x, ldt)
)
-- returns an intmap with indents and locations for all items
allInvLocs' :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink CItem)
allInvLocs' inv = foldMap (f . LocLDT TopLDT) (IM.elems (invRootTrees' inv)) mempty
where
f t = cldtPropagateFold h h g 0 t id
h x _ _ _ = x + 1
g ::
Int ->
LocationLDT ItemLink CItem ->
( IM.IntMap (Int, LocationLDT ItemLink CItem) ->
IM.IntMap (Int, LocationLDT ItemLink CItem)
) ->
IM.IntMap (Int, LocationLDT ItemLink CItem) ->
IM.IntMap (Int, LocationLDT ItemLink CItem)
g x ldt =
(.)
( IM.insert
(ldt ^?! locLDT . ldtValue . _1 . itLocation . ilInvID)
(x, ldt)
)
---- returns an intmap with indents and locations for all items
--allInvLocs :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink OItem)
--allInvLocs inv = foldMap (f . LocLDT TopLDT) (IM.elems (invRootTrees inv)) mempty
-- where
-- f t = cldtPropagateFold h h g 0 t id
-- h x _ _ _ = x + 1
-- g ::
-- Int ->
-- LocationLDT ItemLink OItem ->
-- ( IM.IntMap (Int, LocationLDT ItemLink OItem) ->
-- IM.IntMap (Int, LocationLDT ItemLink OItem)
-- ) ->
-- IM.IntMap (Int, LocationLDT ItemLink OItem) ->
-- IM.IntMap (Int, LocationLDT ItemLink OItem)
-- g x ldt =
-- (.)
-- ( IM.insert
-- (ldt ^?! locLDT . ldtValue . _1 . itLocation . ilInvID)
-- (x, ldt)
-- )
---- returns an intmap with indents and locations for all items
--allInvLocs' :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink CItem)
--allInvLocs' inv = foldMap (f . LocLDT TopLDT) (IM.elems (invRootTrees' inv)) mempty
-- where
-- f t = cldtPropagateFold h h g 0 t id
-- h x _ _ _ = x + 1
-- g ::
-- Int ->
-- LocationLDT ItemLink CItem ->
-- ( IM.IntMap (Int, LocationLDT ItemLink CItem) ->
-- IM.IntMap (Int, LocationLDT ItemLink CItem)
-- ) ->
-- IM.IntMap (Int, LocationLDT ItemLink CItem) ->
-- IM.IntMap (Int, LocationLDT ItemLink CItem)
-- g x ldt =
-- (.)
-- ( IM.insert
-- (ldt ^?! locLDT . ldtValue . _1 . itLocation . ilInvID)
-- (x, ldt)
-- )
src/Dodge/Item/Orientation.hs
+1
View File
@@ -1,6 +1,7 @@
module Dodge.Item.Orientation (
orientAttachment,
propagateOrientation,
propagateOrientation',
) where
import Dodge.Data.ComposedItem
src/Dodge/Render/HUD.hs
+4 -4
View File
@@ -94,11 +94,11 @@ drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
getRootItemBounds :: Int -> IM.IntMap Item -> Maybe (Int, Int)
getRootItemBounds i inv = do
let ia = allInvLocs inv
let ia = invIndents inv -- why indents? why OItem?
itm <- ia ^? ix i . _2
let root = locToTop itm
x <- locRightmost root ^? locLDT . ldtValue . _1 . itLocation . ilInvID
y <- locLeftmost root ^? locLDT . ldtValue . _1 . itLocation . ilInvID
let root = locToTop' itm
x <- locDTRightmost root ^? locDT . dtValue . _1 . itLocation . ilInvID
y <- locDTLeftmost root ^? locDT . dtValue . _1 . itLocation . ilInvID
return (x, y)
drawMouseOver :: Configuration -> World -> Picture
src/Dodge/WorldEffect.hs
+3 -3
View File
@@ -5,7 +5,7 @@ module Dodge.WorldEffect (
lineOutputTerminal,
) where
import Dodge.DoubleTree
--import Dodge.DoubleTree
import Dodge.Item.Grammar
import Dodge.Creature.Impulse.UseItem
import Dodge.BlBl
@@ -46,8 +46,8 @@ doWdWd we = case we of
WdWdBurstFireRepetition cid invid -> \w -> fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix cid
--itree <- allInvLocs (cr ^. crInv) ^? ix invid . _2 . locLDT
loc <- allInvLocs (cr ^. crInv) ^? ix invid . _2
return $ heldEffectMuzzles (locLDTToLocDT loc) cr w
loc <- invIndents (cr ^. crInv) ^? ix invid . _2
return $ heldEffectMuzzles (loc) cr w
accessTerminal :: Maybe Int -> World -> World
accessTerminal mtmid w = fromMaybe w $ do