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

Make equipment indices point to item indices

Browse Source
This commit is contained in:
justin
2025-08-26 23:57:02 +01:00
parent 49efe62910
commit 06d50ac752
18 changed files with 108 additions and 522 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature.hs
+21 -20
View File
@@ -110,9 +110,9 @@ startInvList = []
startInventory :: IM.IntMap Item
startInventory = IM.fromList $ zip [0 ..] startInvList
inventoryX :: Char -> [Item]
inventoryX :: String -> [Item]
inventoryX c = case c of
'A' ->
"A" ->
[introScan t | t <- [minBound..maxBound]] <>
[ flameThrower
, fuelPack
@@ -122,7 +122,7 @@ inventoryX c = case c of
, unigate
, bingate
]
'B' ->
"B" ->
[ wristArmour
, wristArmour
, volleyGun 5
@@ -146,15 +146,16 @@ inventoryX c = case c of
, makeTypeCraftNum 2 PIPE
, makeTypeCraftNum 1 CREATURESENSOR
]
'C' -> map makeTypeCraft [minBound..maxBound]
'D' ->
"BB" -> [ wristArmour , wristArmour]
"C" -> map makeTypeCraft [minBound..maxBound]
"D" ->
[ blinker
, unsafeBlinker
, pulseChecker
, detector WALLDETECTOR
, battery
]
'E' -> [alteRifle
"E" -> [alteRifle
, tinMag
, tinMag
] <>
@@ -165,7 +166,7 @@ inventoryX c = case c of
, makeTypeCraftNum 1 STEELDRUM
, makeTypeCraftNum 1 MOTOR
]
'F' -> fold
"F" -> fold
[ makeTypeCraftNum 3 PIPE
, makeTypeCraftNum 3 TUBE
, makeTypeCraftNum 3 HARDWARE
@@ -182,7 +183,7 @@ inventoryX c = case c of
, makeTypeCraftNum 3 LIGHTER
-- , makeTypeCraftNum 5 (ENERGYBALLCRAFT IncBall)
]
'G' ->
"G" ->
[ autoPistol
, tinMag
, pistol
@@ -196,19 +197,19 @@ inventoryX c = case c of
-- , makeTypeCraftNum 5 (BULBODYCRAFT BounceBullet)
-- , makeTypeCraftNum 5 (BULBODYCRAFT PenetrateBullet)
]
'H' -> [shatterGun]
'I' ->
"H" -> [shatterGun]
"I" ->
[ makeTypeCraft HARDDRIVE
, makeTypeCraft RAM
] <> fold
[ makeTypeCraftNum 2 MICROCHIP
]
'J' ->
"J" ->
[ laser
, battery
--, dualBeam
] <> makeTypeCraftNum 10 TRANSFORMER
'K' ->
"K" ->
[ autoRifle
, tinMag
] <> fold
@@ -221,14 +222,14 @@ inventoryX c = case c of
, makeTypeCraftNum 1 SOUNDSENSOR
, makeTypeCraftNum 1 HEATSENSOR
]
'L' -> [burstRifle
"L" -> [burstRifle
,tinMag
, bulletSynthesizer
, battery
]
'M' -> stackedInventory
'N' -> [zoomScope,laser,battery, sniperRifle, tinMag]
'O' -> [ rLauncherX 2
"M" -> stackedInventory
"N" -> [zoomScope,laser,battery, sniperRifle, tinMag]
"O" -> [ rLauncherX 2
, shellMag
, shellMag
, rLauncherX 3
@@ -238,9 +239,9 @@ inventoryX c = case c of
, rifle
, shellMag
]
'P' -> [burstRifle , tinMag, bulletSynthesizer, battery]
'T' -> testInventory
'U' ->
"P" -> [burstRifle , tinMag, bulletSynthesizer, battery]
"T" -> testInventory
"U" ->
[targetingScope tt | tt <- [minBound .. maxBound]]
<>
[ gyroscope
@@ -266,7 +267,7 @@ inventoryX c = case c of
, stickyMod
]
<> [shellModule p | p <- [minBound .. maxBound]]
'V' ->
"V" ->
[targetingScope tt | tt <- [minBound .. maxBound]]
<>
[ battery
src/Dodge/Creature/Action.hs
+2 -1
View File
@@ -175,8 +175,9 @@ dropItem :: Creature -> Int -> World -> World
dropItem cr invid w' =
doanyitemdropeffect
. maybeshiftseldown
. rmInvItem (_crID cr) (NInt invid)
. copyItemToFloor (_crPos cr) itm -- . mayberemoveequip
. rmInvItem (_crID cr) (NInt invid) -- it is important
-- to do this before copying the item to the floor!
. soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
$ w'
where
src/Dodge/Creature/Impulse/UseItem.hs
+10 -9
View File
@@ -44,8 +44,8 @@ useItemLoc cr loc pt w
return $ w & pointerToItem itm . itUse . useToggle .~ not b
| isJust $ itm ^? itType . ibtEquip
, pt == 0
, Just invid' <- itm ^? itLocation . ilInvID =
return $ toggleEquipmentAt invid' cr w
, Just invid <- itm ^? itLocation . ilInvID =
return $ toggleEquipmentAt invid cr w
| otherwise = (\loc' -> useItemLoc cr loc' pt w) =<< locUp' loc
where
aimuse
@@ -68,26 +68,26 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
DoNotMoveEquipment -> w
PutOnEquipment{_allocNewPos = newp} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at newp ?~ NInt itid
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
& onequip itm cr
MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at newp ?~ NInt itid
& crpoint . crEquipment . at oldp .~ Nothing
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at newp ?~ NInt itid
& crpoint . crEquipment . at oldp ?~ sid
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
& toitems . ix (invidtoitid sid) . itLocation . ilEquipSite ?~ oldp
& toitems . ix (_unNInt sid) . itLocation . ilEquipSite ?~ oldp
ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
w
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crEquipment . at newp ?~ NInt itid
& toitems . ix itid . itLocation . ilEquipSite ?~ newp
& toitems . ix (invidtoitid rid) . itLocation . ilEquipSite .~ Nothing
& onremove (itmat rid) cr
& toitems . ix (_unNInt rid) . itLocation . ilEquipSite .~ Nothing
& onremove (itmat' rid) cr
& onequip itm cr
RemoveEquipment{_allocOldPos = oldp} ->
w
@@ -101,6 +101,7 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
itid = invidtoitid invid
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
itmat i = w ^?! cWorld . lWorld . items . ix (invidtoitid i)
itmat' i = w ^?! cWorld . lWorld . items . ix (_unNInt i)
itm = itmat invid
onequip itm' = effectOnEquip itm'
onremove itm' = effectOnRemove itm'
src/Dodge/Creature/Test.hs
+1 -2
View File
@@ -116,8 +116,7 @@ twists m cr = crInAimStance TwoHandUnder m cr || crInAimStance TwoHandOver m cr
-- Not sure if it is a good idea
crIsArmouredFrom :: IM.IntMap Item -> Point2 -> Creature -> Bool
crIsArmouredFrom m p cr = fromMaybe False $ do
invid <- cr ^? crEquipment . ix OnChest
itid <- cr ^? crInv . ix invid
NInt itid <- cr ^? crEquipment . ix OnChest
ittype <- m ^? ix itid . itType
return $
EQUIP FRONTARMOUR == ittype
src/Dodge/Data/Creature.hs
+1 -1
View File
@@ -48,7 +48,7 @@ data Creature = Creature
, _crHP :: Int
, _crInv :: NewIntMap InvInt Int
, _crManipulation :: Manipulation
, _crEquipment :: M.Map EquipSite (NewInt InvInt)
, _crEquipment :: M.Map EquipSite (NewInt ItmInt)
, _crDamage :: [Damage]
, _crPain :: Int
, _crStance :: Stance
src/Dodge/Data/RightButtonOptions.hs
+2 -2
View File
@@ -29,11 +29,11 @@ data EquipmentAllocation
| SwapEquipment
{ _allocNewPos :: EquipSite
, _allocOldPos :: EquipSite
, _allocSwapID :: NewInt InvInt
, _allocSwapID :: NewInt ItmInt
}
| ReplaceEquipment
{ _allocNewPos :: EquipSite
, _allocRemoveID :: NewInt InvInt
, _allocRemoveID :: NewInt ItmInt
}
| RemoveEquipment
{ _allocOldPos :: EquipSite
src/Dodge/Debug/Terminal.hs
+1 -1
View File
@@ -28,7 +28,7 @@ applyTerminalString ss = case ss of
applyTerminalCommand :: String -> Universe -> Universe
applyTerminalCommand s = case s of
"NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
['L', x] -> uvWorld %~ \w -> foldl' (flip createItemYou) w (inventoryX x)
'-': xs -> uvWorld %~ \w -> foldl' (flip createItemYou) w (inventoryX xs)
-- (uvWorld . cWorld . lWorld %~ initSpecificCrItemLocations 0)
-- . (uvWorld . cWorld . lWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0 ..] $ inventoryX x))
-- . (uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ 50)
src/Dodge/Floor.hs
+2 -3
View File
@@ -4,8 +4,8 @@ module Dodge.Floor (
tutRoomTree,
) where
import Dodge.Room.Tutorial
import Dodge.Annotation.Data
--import Dodge.Room.Tutorial
import Data.List (intersperse)
import Dodge.Annotation
import Dodge.Cleat
@@ -24,8 +24,7 @@ initialRoomTree = annoToRoomTree initialAnoTree
--initialRoomTree = annoToRoomTree startWorldTreeTest
tutRoomTree :: State LayoutVars (MetaTree Room String)
--tutRoomTree = annoToRoomTree tutAnoTree
tutRoomTree = annoToRoomTree initialAnoTree
tutRoomTree = annoToRoomTree tutAnoTree
--startWorldTreeTest :: Annotation
--startWorldTreeTest =
src/Dodge/Inventory.hs
+4 -3
View File
@@ -76,7 +76,7 @@ rmInvItem cid invid w =
& dounequipfunction --the ordering of these is
& pointcid . crInv %~ f -- important
& removeAnySlotEquipment
& pointcid . crEquipment . each %~ g
& cWorld . lWorld . items . ix itid . itLocation . ilEquipSite .~ Nothing
& updateselection
& updateselectionextra
& pointcid %~ updateRootItemID (w ^. cWorld . lWorld . items)
@@ -96,11 +96,12 @@ rmInvItem cid invid w =
itm = w ^?! cWorld . lWorld . items . ix itid
dounequipfunction = effectOnRemove itm cr
removeAnySlotEquipment = fromMaybe id $ do
epos <- w ^? cWorld . lWorld . items . ix itid
. itLocation
epos <- itm ^?
itLocation
. ilEquipSite
. _Just
return $ pointcid . crEquipment . at epos .~ Nothing
-- return $ pointcid . crEquipment .~ mempty
maxk = fmap fst $ IM.lookupMax $ _unNIntMap $ cr ^. crInv
f inv =
let (xs, ys) = IM.split (_unNInt invid) $ _unNIntMap inv
src/Dodge/Inventory/RBList.hs
+4 -3
View File
@@ -49,9 +49,9 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
getEquipmentAllocation :: NewInt InvInt -> World -> EquipmentAllocation
getEquipmentAllocation invid w = fromMaybe DoNotMoveEquipment $ do
esite <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType-- . itUse . uequipEffect . eeType
i <-
w ^? rbOptions . opSel
itid <- you w ^? crInv . ix invid
esite <- w ^? cWorld . lWorld . items . ix itid >>= equipType
i <- w ^? rbOptions . opSel
<|> Just (chooseEquipPosition (w ^. cWorld . lWorld . items) (you w) (eqSiteToPositions esite))
es <- eqSiteToPositions esite ^? ix i
return $ case you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
@@ -76,6 +76,7 @@ getEquipmentAllocation invid w = fromMaybe DoNotMoveEquipment $ do
, _allocRemoveID = _crEquipment (you w) M.! es
}
Nothing -> PutOnEquipment{_allocNewPos = es}
where
eqSiteToPositions :: EquipType -> [EquipSite]
eqSiteToPositions es = case es of
src/Dodge/Render/HUD.hs
+2 -3
View File
@@ -298,9 +298,8 @@ drawRBOptions cfig w = fold $ do
maybebottomborder a b curpos
| a == b - 1 = listCursorChooseBorderScale 0 1 (bc South) curpos 0 white 7 1
| otherwise = mempty
otheritem j = fromMaybe "" $ do
itid <- you w ^? crInv . ix j
itype <- w ^? cWorld . lWorld . items . ix itid . itType
otheritem (NInt j) = fromMaybe "" $ do
itype <- w ^? cWorld . lWorld . items . ix j . itType
return $ itemBaseName itype
equipAllocString :: EquipmentAllocation -> String
src/Dodge/Room/Tutorial.hs
+9 -9
View File
@@ -1,9 +1,9 @@
module Dodge.Room.Tutorial (tutAnoTree,tutRezBox) where
module Dodge.Room.Tutorial where
import Dodge.Room.Corridor
import Dodge.Room.Airlock
import Dodge.Room.RoadBlock
import Dodge.Room.Room
--import Dodge.Room.Room
import Dodge.Item.Held.Cane
import Dodge.Item.Ammo
import Dodge.Annotation.Data
@@ -44,13 +44,13 @@ tutAnoTree :: Annotation
tutAnoTree =
OnwardList $
[ AnTree $ return $ tToBTree "teststart" $ return $ cleatOnward corridor
, AnTree $ tutDrop
-- , AnTree $ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, AnTree corDoor
, AnTree $ tutRooms
, AnTree $ tutDrop
-- , AnTree $ pickupTut
-- , AnTree $ weaponTut
-- , AnTree $ tutDrop
---- , AnTree $ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
-- , AnTree corDoor
-- , AnTree $ tutRooms
-- , AnTree $ tutDrop
---- , AnTree $ pickupTut
---- , AnTree $ weaponTut
]
tutDrop :: State LayoutVars (MetaTree Room String)
src/Dodge/TestString.hs
+5 -1
View File
@@ -31,7 +31,11 @@ import NewInt
import Data.Foldable
testStringInit :: Universe -> [String]
testStringInit _ = mempty
testStringInit u = map show
( u ^.. uvWorld . cWorld . lWorld . items . each . itLocation . ilEquipSite)
<> ["---"] <> map show
( u ^.. uvWorld . cWorld . lWorld . items . each . itID)
<> ["---"] <> map show (M.toList $ fold $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crEquipment)
-- map f (IM.toList $ u ^. uvWorld . cWorld . lWorld . items)
-- <> ["---"]
-- <> map show (IM.toList . fold $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv . unNIntMap)