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

Start refactor storing items in single intmap, done turrets

Browse Source 
More checks required
This commit is contained in:
justin
2025-08-24 11:53:21 +01:00
parent 7336177edf
commit c38d03165f
22 changed files with 644 additions and 271 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/GenWorld.hs
+1
View File
@@ -33,6 +33,7 @@ data PSType
{ _putMachinePoly :: [Point2]
, _putMachineMachine :: Machine
, _putMachineWall :: Wall
, _putMachineMaybeItem :: Maybe Item
}
| PutLS LightSource
| PutButton {_putButton :: Button}
src/Dodge/Data/LWorld.hs
+1
View File
@@ -100,6 +100,7 @@ data LWorld = LWorld
{ _creatures :: IM.IntMap Creature
, _creatureGroups :: IM.IntMap CrGroupParams
, _itemLocations :: IM.IntMap ItemLocation
, _items :: IM.IntMap Item
, _clouds :: [Cloud]
, _dusts :: [Dust]
, _gusts :: IM.IntMap Gust
src/Dodge/Data/Machine.hs
+1 -1
View File
@@ -55,7 +55,7 @@ data MachineType
--hderiving (Eq, Show, Read) --Generic, Flat)
data Turret = Turret
{ _tuWeapon :: Item
{ _tuWeapon :: Int
, _tuTurnSpeed :: Float
, _tuFireTime :: Int
, _tuDir :: Float
src/Dodge/Default/World.hs
+1
View File
@@ -103,6 +103,7 @@ defaultLWorld =
, _dusts = mempty
, _gusts = IM.empty
, _itemLocations = IM.empty
, _items = mempty
, _props = IM.empty
, _debris = mempty
, _projectiles = IM.empty
src/Dodge/Floor.hs
+3 -2
View File
@@ -5,7 +5,7 @@ module Dodge.Floor (
) where
import Dodge.Annotation.Data
import Dodge.Room.Tutorial
--import Dodge.Room.Tutorial
import Data.List (intersperse)
import Dodge.Annotation
import Dodge.Cleat
@@ -24,7 +24,8 @@ initialRoomTree = annoToRoomTree initialAnoTree
--initialRoomTree = annoToRoomTree startWorldTreeTest
tutRoomTree :: State LayoutVars (MetaTree Room String)
tutRoomTree = annoToRoomTree tutAnoTree
--tutRoomTree = annoToRoomTree tutAnoTree
tutRoomTree = annoToRoomTree initialAnoTree
--startWorldTreeTest :: Annotation
--startWorldTreeTest =
src/Dodge/HeldUse.hs
+3 -3
View File
@@ -1208,11 +1208,11 @@ mcShootLaser _ mc =
mcShootAuto :: Item -> Machine -> World -> World
mcShootAuto itm mc w
| Just (AutoTrigger rate) <- baseItemTriggerType <$> mc ^? mcType . mctTurret . tuWeapon
| Just i <- mc ^? mcType . mctTurret . tuWeapon
, Just (AutoTrigger rate) <- baseItemTriggerType <$> w ^? cWorld . lWorld . items . ix i
, w ^. cWorld . lWorld . lClock - rate > lastused =
w
& cWorld . lWorld . machines . ix (_mcID mc) . mcType . mctTurret . tuWeapon
. itTimeLastUsed
& cWorld . lWorld . items . ix i . itTimeLastUsed
.~ w ^. cWorld . lWorld . lClock
& makeBullet defaultBullet itm pos dir
| otherwise = w
src/Dodge/Inventory/Add.hs
+1 -1
View File
@@ -39,7 +39,7 @@ tryPutItemInInv cid flit w = do
( i
, w
& cWorld . lWorld . floorItems %~ IM.delete (flit ^. flIt . itID . unNInt)
& cWorld . lWorld . creatures . ix cid . crInv %~ IM.insert i it
& cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
& updateItLocation i
-- I forget whether using "at" rather than "IM.insert" here caused problems
-- & cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
src/Dodge/Item/Location.hs
+2 -2
View File
@@ -37,7 +37,7 @@ pointerYourRootItem f w = fromMaybe (pure w) $ do
pointerToItem :: Applicative f => Item -> (Item -> f Item) -> World -> f World
pointerToItem x = case x ^. itLocation of
OnFloor -> cWorld . lWorld . floorItems . ix (x ^. itID . unNInt) . flIt
OnTurret tid -> cWorld . lWorld . machines . ix tid . mcType . mctTurret . tuWeapon
OnTurret _ -> cWorld . lWorld . items . ix (x ^. itID . unNInt)
InInv cid invid _ _ _ _ -> cWorld . lWorld . creatures . ix cid . crInv . ix invid
InVoid -> const pure
@@ -46,6 +46,6 @@ pointerToItemID itid f w = fromMaybe (pure w) $ do
itloc <- w ^? cWorld . lWorld . itemLocations . ix (_unNInt itid)
return $ (\x -> x f w) $ case itloc of
OnFloor -> cWorld . lWorld . floorItems . ix (_unNInt itid) . flIt
OnTurret tid -> cWorld . lWorld . machines . ix tid . mcType . mctTurret . tuWeapon
OnTurret _ -> cWorld . lWorld . items . ix (itid ^. unNInt)
InInv cid invid _ _ _ _ -> cWorld . lWorld . creatures . ix cid . crInv . ix invid
InVoid -> const pure
src/Dodge/Item/Location/Initialize.hs
+15 -15
View File
@@ -11,7 +11,7 @@ import Data.Traversable
initItemLocations :: LWorld -> LWorld
--initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
initItemLocations = initCrsItemLocations . initTusItemLocations
initItemLocations = initCrsItemLocations -- . initTusItemLocations
initCrsItemLocations :: LWorld -> LWorld
initCrsItemLocations w = w' & creatures .~ newcreatures
@@ -23,10 +23,10 @@ initCrsItemLocations w = w' & creatures .~ newcreatures
-- where
-- (w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems)
initTusItemLocations :: LWorld -> LWorld
initTusItemLocations w = w' & machines .~ newmachines
where
(w', newmachines) = mapAccumR initTuItemLocation w (w ^. machines)
--initTusItemLocations :: LWorld -> LWorld
--initTusItemLocations w = w' & machines .~ newmachines
-- where
-- (w', newmachines) = mapAccumR initTuItemLocation w (w ^. machines)
initSpecificCrItemLocations :: Int -> LWorld -> LWorld
initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr
@@ -64,13 +64,13 @@ initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
-- locid = IM.newKey (w ^. itemLocations )
-- loc = OnFloor (_flItID flit)
initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
Nothing -> (w, mc)
Just _ ->
let locid = IM.newKey ( w ^. itemLocations)
loc = OnTurret (_mcID mc)
in ( w & itemLocations . at locid ?~ loc
, mc & mcType . _McTurret . tuWeapon . itID .~ NInt locid
& mcType . _McTurret . tuWeapon . itLocation .~ loc
)
--initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
--initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
-- Nothing -> (w, mc)
-- Just _ ->
-- let locid = IM.newKey ( w ^. itemLocations)
-- loc = OnTurret (_mcID mc)
-- in ( w & itemLocations . at locid ?~ loc
-- , mc & mcType . _McTurret . tuWeapon . itID .~ NInt locid
-- & mcType . _McTurret . tuWeapon . itLocation .~ loc
-- )
src/Dodge/Machine/Destroy.hs
+5 -3
View File
@@ -20,9 +20,11 @@ destroyMachine mc =
. destroyMcType (mc ^. mcType) mc
destroyMcType :: MachineType -> Machine -> World -> World
destroyMcType mt mc = case mt of
McTurret tu -> copyItemToFloor (_mcPos mc) (_tuWeapon tu)
_ -> id
destroyMcType mt mc w = case mt of
McTurret tu -> fromMaybe w $ do
itm <- w ^? cWorld . lWorld . items . ix (tu ^. tuWeapon)
return $ copyItemToFloor (_mcPos mc) itm w
_ -> w
mcKillTerm :: Machine -> World -> World
mcKillTerm mc w = fromMaybe w $ do
src/Dodge/Machine/Draw.hs
+6 -8
View File
@@ -1,6 +1,4 @@
module Dodge.Machine.Draw (
drawMachine,
) where
module Dodge.Machine.Draw ( drawMachine) where
import Dodge.Terminal.Color
import Control.Lens
@@ -18,7 +16,7 @@ drawMachine :: LWorld -> Machine -> SPic
drawMachine lw mc = case _mcType mc of
McStatic -> mempty
McTerminal -> terminalSPic lw mc
McTurret tu -> drawBaseMachine 20 mc <> drawTurret tu mc
McTurret tu -> drawBaseMachine 20 mc <> drawTurret lw tu mc
McSensor se -> drawBaseMachine 25 mc <> drawSensor se mc
drawSensor :: Sensor -> Machine -> SPic
@@ -62,10 +60,10 @@ drawBaseMachine h mc =
. square
$ _mcWidth mc
drawTurret :: Turret -> Machine -> SPic
drawTurret tu mc = overPosSP (turretItemOffset itm tu mc) (itemSPic itm)
where
itm = _tuWeapon tu
drawTurret :: LWorld -> Turret -> Machine -> SPic
drawTurret lw tu mc = fold $ do
itm <- lw ^? items . ix (tu ^. tuWeapon)
return $ overPosSP (turretItemOffset itm tu mc) (itemSPic itm)
sensorSPic :: (PaletteColor, DecorationShape) -> Machine -> SPic
sensorSPic (pc, ds) mc =
src/Dodge/Machine/Update.hs
+4 -3
View File
@@ -83,12 +83,13 @@ isElectrical dm = case dm of
_ -> False
mcUseItem :: Machine -> World -> World
mcUseItem mc = fromMaybe id $ do
mcUseItem mc w = fromMaybe w $ do
tu <- mc ^? mcType . _McTurret
let it = tu ^. tuWeapon
let i = tu ^. tuWeapon
it <- w ^? cWorld . lWorld . items . ix i
hit <- it ^? itType
guard (_tuFireTime tu > 0)
return $ mcUseHeld hit it mc
return $ mcUseHeld hit it mc w
mcSensorTriggerUpdate :: Sensor -> Machine -> World -> World
mcSensorTriggerUpdate se mc = fromMaybe id $ do
src/Dodge/Placement/Instance/Sensor.hs
+1
View File
@@ -35,6 +35,7 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
)
)
defaultSensorWall
Nothing
)
damageTypeThreshold :: SensorType -> Int
src/Dodge/Placement/Instance/Terminal.hs
+1
View File
@@ -34,6 +34,7 @@ putTerminalFull f col mc tm =
& mcCloseSound ?~ fridgeHumS
)
defaultSensorWall
Nothing
)
$ \mcpl -> Just $ pt0 (PutWorldUpdate $ const (setids tmpl btpl mcpl)) (\_ -> f tmpl btpl mcpl)
where
src/Dodge/Placement/Instance/Turret.hs
+4 -2
View File
@@ -19,6 +19,7 @@ putTurret itm rotSpeed =
& mcHP .~ 50000
)
defaultMachineWall
(Just itm)
putLasTurret :: Float -> Placement
putLasTurret rotSpeed =
@@ -31,14 +32,15 @@ putLasTurret rotSpeed =
& mcHP .~ 50000
)
defaultMachineWall
(Just laser)
turret :: Item -> MachineType
turret wp = lasTurret & mctTurret . tuWeapon .~ wp
turret _ = lasTurret
lasTurret :: MachineType
lasTurret = McTurret $
Turret
{ _tuWeapon = laser
{ _tuWeapon = 0
, _tuTurnSpeed = 0.1
, _tuFireTime = 0
, _tuDir = 0
src/Dodge/Placement/PlaceSpot.hs
+27 -3
View File
@@ -121,7 +121,7 @@ placeSpotID' ps pt w = case pt of
-- w
PutCrit cr -> plNewUpID (cWorld . lWorld . creatures) crID (mvCr p rot cr) w
PutForeground fs -> plNewUpID (cWorld . lWorld . foregroundShapes) fsID (mvFS p rot fs) w
PutMachine pps mc wl -> plMachine (map doShift pps) mc wl p rot w
PutMachine pps mc wl mitm -> plMachine (map doShift pps) mc wl mitm p rot w
PutLS ls -> plNewUpID (cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
PutPPlate pp -> plNewUpID (cWorld . lWorld . pressPlates) ppID (mvPP p rot pp) w
RandPS rgn -> evaluateRandPS rgn ps w
@@ -193,8 +193,32 @@ mvCr p rot cr = cr{_crPos = p, _crOldPos = p, _crDir = rot}
mvFS :: Point2 -> Float -> ForegroundShape -> ForegroundShape
mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +.+) . rotateV a))
plMachine :: [Point2] -> Machine -> Wall -> Point2 -> Float -> World -> (Int, World)
plMachine wallpoly mc wl p rot gw =
plMachine :: [Point2] -> Machine -> Wall -> Maybe Item -> Point2 -> Float -> World -> (Int, World)
plMachine wallpoly mc wl mitm = case mitm of
Nothing -> plMachine' wallpoly mc wl
Just itm -> plTurret wallpoly mc wl itm
plTurret :: [Point2] -> Machine -> Wall -> Item -> Point2 -> Float -> World -> (Int, World)
plTurret wallpoly mc wl itm p rot gw =
( mcid
, gw & cWorld . lWorld . machines %~ addMc
& cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
& cWorld . lWorld . items . at itid ?~ itm'
& cWorld . lWorld . itemLocations . at itid ?~ OnTurret mcid
)
where
itm' = itm & itID .~ NInt itid
& itLocation .~ OnTurret mcid
itid = IM.newKey $ gw ^. cWorld . lWorld . itemLocations
col = _mcColor mc
mcid = IM.newKey $ gw ^. cWorld . lWorld . machines
wlid = IM.newKey $ gw ^. cWorld . lWorld . walls
wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
addMc = IM.insert mcid (mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids}
& mcType . mctTurret . tuWeapon .~ itid)
plMachine' :: [Point2] -> Machine -> Wall -> Point2 -> Float -> World -> (Int, World)
plMachine' wallpoly mc wl p rot gw =
( mcid
, gw & cWorld . lWorld . machines %~ addMc
& cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
src/Dodge/Room/Tutorial.hs
+1 -1
View File
@@ -1,4 +1,4 @@
module Dodge.Room.Tutorial (tutAnoTree) where
module Dodge.Room.Tutorial (tutAnoTree,tutRezBox) where
import Dodge.Room.Corridor
import Dodge.Room.Airlock