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

Make machines have footprint like doors

Browse Source
This commit is contained in:
justin
2026-03-31 20:29:30 +01:00
parent dea4c0dffe
commit 5701261ace
12 changed files with 137 additions and 138 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/GenWorld.hs
+1 -2
View File
@@ -32,8 +32,7 @@ data GenWorld = GenWorld
data PSType
= PutCrit {_unPutCrit :: Creature}
| PutMachine
{ _putMachinePoly :: [Point2]
, _putMachineMachine :: Machine
{ _putMachineMachine :: Machine
, _putMachineMaybeItem :: Maybe Item
}
| PutLS {_putLS :: LightSource}
src/Dodge/Data/Machine.hs
+1 -2
View File
@@ -17,7 +17,6 @@ import Dodge.Data.AmmoType
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import qualified Data.IntSet as IS
import qualified Data.Map.Strict as M
import Dodge.Data.Damage
import Dodge.Data.GenParams
@@ -30,7 +29,7 @@ import qualified Data.IntMap.Strict as IM
data Machine = Machine
{ _mcID :: Int
, _mcWallIDs :: IS.IntSet
-- , _mcWallIDs :: IS.IntSet
, _mcMaterial :: Material
, _mcSkin :: Material
, _mcFootPrint :: IM.IntMap (Point2,Point2)
src/Dodge/Default.hs
-1
View File
@@ -31,7 +31,6 @@ defaultMachine :: Machine
defaultMachine =
Machine
{ _mcID = 0
, _mcWallIDs = mempty
, _mcPos = V2 0 0
, _mcDir = 0
, _mcHP = 1000
src/Dodge/Machine/Destroy.hs
+3 -2
View File
@@ -13,7 +13,7 @@ import LensHelp
destroyMachine :: Machine -> World -> World
destroyMachine mc =
(cWorld . lWorld . machines %~ IM.delete (_mcID mc))
. deleteWallIDs (_mcWallIDs mc)
. deleteWallIDs (IM.keysSet $ _mcFootPrint mc)
. makeMachineDebris mc
. makeSmallExplosionAt (_mcPos mc `v2z` 20) 0
. mcKillTerm mc
@@ -24,7 +24,8 @@ destroyMachine mc =
--explodeMachine mc = \case
makeMachineDebris :: Machine -> World -> World
makeMachineDebris mc = id -- foldl' (flip $ makeDebris mt) w ps
makeMachineDebris _ = id -- foldl' (flip $ makeDebris mt) w ps
--makeMachineDebris mc = id -- foldl' (flip $ makeDebris mt) w ps
-- where
-- dsize = debrisSize mt
-- ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_mcFootprint bl)
src/Dodge/Placement/Instance/Sensor.hs
+2 -1
View File
@@ -9,14 +9,15 @@ import Dodge.Default
import Dodge.LevelGen.PlacementHelper
import Dodge.LightSource
import Geometry
import qualified Data.IntMap.Strict as IM
damageSensor :: SensorType -> Float -> Maybe Int -> PlacementSpot -> Placement
damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
\lsid ->
psPtJpl ps $
PutMachine
(reverse $ square wdth)
( defaultMachine
& mcFootPrint .~ IM.fromDistinctAscList (zip [0..] . loopPairs . reverse $ square wdth)
& mcSkin .~ mattype
& mcMounts . at OTTrigger .~ mtrid
& mcMounts . at OTLightSource ?~ lsid
src/Dodge/Placement/Instance/Terminal.hs
+2 -1
View File
@@ -4,6 +4,7 @@ module Dodge.Placement.Instance.Terminal (
putTerminal,
) where
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Dodge.Data.GenWorld
import Dodge.Default
@@ -29,9 +30,9 @@ putTerminalFull f mc tm =
\btpl -> Just $
pt0
( PutMachine
(reverse $ square 10)
( mc & mcMounts . at OTButton ?~ fromJust (_plMID btpl)
& mcMounts . at OTTerminal .~ _plMID tmpl
& mcFootPrint .~ IM.fromDistinctAscList (zip [0..] . loopPairs . reverse $ square 10)
)
Nothing
)
src/Dodge/Placement/Instance/Turret.hs
+3 -3
View File
@@ -1,5 +1,4 @@
module Dodge.Placement.Instance.Turret
(putLasTurret) where
module Dodge.Placement.Instance.Turret (putLasTurret) where
import Dodge.Item.Held.BatteryGuns
import Dodge.Data.GenWorld
@@ -7,6 +6,7 @@ import Dodge.Default
import Dodge.LevelGen.PlacementHelper
import Geometry
import LensHelp
import qualified Data.IntMap.Strict as IM
--putTurret :: Item -> Float -> Placement
--putTurret itm rotSpeed =
@@ -24,8 +24,8 @@ putLasTurret :: Float -> Placement
putLasTurret rotSpeed =
sps0 $
PutMachine
(reverse $ square 10)
( defaultMachine
& mcFootPrint .~ IM.fromDistinctAscList (zip [0..] . loopPairs . reverse $ square 10)
-- & mcColor .~ blue
& mcType .~ (lasTurret & mctTurret . tuTurnSpeed .~ rotSpeed)
& mcHP .~ 1500
src/Dodge/Placement/PlaceSpot.hs
+24 -25
View File
@@ -10,7 +10,6 @@ module Dodge.Placement.PlaceSpot (placeSpot) where
import Control.Monad.Trans.State.Lazy
import Data.Bifunctor
import Data.Foldable
import qualified Data.IntSet as IS
import Data.Maybe
import qualified Data.Set as S
import Dodge.Base.NewID
@@ -127,7 +126,7 @@ placeSpotID rid ps pt w = case pt of
PutCrit cr -> plNewUpID (gwWorld . cWorld . lWorld . creatures) crID (mvCr p rot cr) w
PutForeground fs ->
(0, w & gwWorld . cWorld . lWorld . foreShapes .:~ mvFS p rot fs)
PutMachine pps mc mitm -> plMachine (map doShift pps) mc mitm p rot w
PutMachine mc mitm -> plMachine mc mitm p rot w
PutLS ls -> plNewUpID (gwWorld . cWorld . lWorld . lightSources) lsID (mvLS p rot ls) w
RandPS _ -> error "RandPS should not be reachable here" -- evaluateRandPS rid rgn ps w
PutDoor dr wl -> plDoor (dr & drZeroPos %~ pashift & drOnePos %~ pashift) wl w
@@ -189,31 +188,42 @@ mvFS :: Point2 -> Float -> ForegroundShape -> ForegroundShape
mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +) . rotateV a))
plMachine ::
[Point2] ->
-- [Point2] ->
Machine ->
Maybe Item ->
Point2 ->
Float ->
GenWorld ->
(Int, GenWorld)
plMachine wallpoly mc mitm p rot gw =
plMachine mc mitm p rot gw =
( mcid
, gw
& tolw
. machines
. at mcid
?~ themc
& gwWorld
%~ placeMachineWalls (_mcSkin mc) wallpoly mcid wlid
& tolw
%~ maybe id placeturretitm mitm
& tolw . machines . at mcid ?~ themc
& tolw %~ maybe id placeturretitm mitm
& gwWorld %~ addwalls
-- & gwWorld %~ placeMachineWalls (_mcSkin mc) wallpoly mcid wlid
)
where
addwalls =
insertStructureWalls
MachinePart
wl
(map fst pps & each %~ shiftPointBy (p,rot))
mcid
wlid
pps = IM.elems $ mc ^. mcFootPrint
wl =
defaultMachineWall
& wlStructure . wsMachine .~ mcid
& wlMaterial .~ (mc ^. mcSkin)
tolw = gwWorld . cWorld . lWorld
mcid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . machines
wlid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . walls
wlids = IS.fromList $ take (length wallpoly) [wlid ..]
themc = mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids}
themc = mc
& mcPos .~ p
& mcDir .~ rot
& mcID .~ mcid
& mcFootPrint .~ IM.fromDistinctAscList (zip [wlid..] pps)
placeturretitm itm =
(items . at itid ?~ itm')
. (machines . ix mcid . mcType . mctTurret . tuWeapon .~ itid)
@@ -221,16 +231,5 @@ plMachine wallpoly mc mitm p rot gw =
itid = IM.newKey $ gw ^. gwWorld . cWorld . lWorld . items
itm' = itm & itID .~ NInt itid & itLocation .~ OnTurret mcid
placeMachineWalls :: Material -> [Point2] -> Int -> Int -> World -> World
placeMachineWalls mat poly mcid = insertStructureWalls MachinePart baseWall poly mcid
where
baseWall =
defaultMachineWall
& wlStructure
. wsMachine
.~ mcid
& wlMaterial
.~ mat
mvLS :: Point2 -> Float -> LightSource -> LightSource
mvLS x rot = lsParam . lsPos . _xy %~ ((+ x) . rotateV rot)
src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+1 -5
View File
@@ -9,11 +9,7 @@ import Dodge.ShiftPoint
import qualified IntMapHelp as IM
import LensHelp
plDoor ::
Door ->
Wall ->
GenWorld ->
(Int, GenWorld)
plDoor :: Door -> Wall -> GenWorld -> (Int, GenWorld)
plDoor dr wl gw =
( drid
, over gwWorld addWalls $ gw & gwWorld . cWorld . lWorld . doors . at drid ?~ newdr
src/Dodge/Room/Room.hs
+4 -1
View File
@@ -15,6 +15,7 @@ module Dodge.Room.Room (
critDeadEnd,
) where
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Linear
import Color
@@ -435,11 +436,13 @@ distributerRoom atype aamount = do
let mcstore = defaultMachine
& mcMaterial .~ Metal
& mcType .~ McStorage atype aamount
& mcFootPrint .~ IM.fromDistinctAscList (zip [0..] . loopPairs . reverse $ polyCirc 4 20)
mcdist mj = defaultMachine
& mcMaterial .~ Metal
& mcType .~ McDistributer mj
store = sps (unusedOffPathAwayFromLink 50)
(PutMachine (reverse $ polyCirc 4 20) mcstore Nothing) & plExternalID ?~ i
--(PutMachine (reverse $ polyCirc 4 20) mcstore Nothing) & plExternalID ?~ i
(PutMachine mcstore Nothing) & plExternalID ?~ i
dst gw = let mj = gw ^? genPmnt . ix i . plMID . _Just
in putTerminal (mcdist mj) (defaultTerminal & tmBootLines .~ tmDistributeLines
& tmRebootOnAccess .~ True
src/Dodge/Wall/Damage.hs
+2 -2
View File
@@ -25,7 +25,7 @@ import Dodge.Zoning.Pathing
import Geometry.Data
import LensHelp
import Linear
import qualified Data.IntSet as IS
--import qualified Data.IntSet as IS
import Dodge.Machine.Destroy
damageWall :: Int -> Damage -> World -> (S.Set Int2, World)
@@ -112,7 +112,7 @@ sensorTypeDamages = \case
destroyMachine' :: Machine -> World -> (S.Set Int2, World)
destroyMachine' mc w = (js, destroyMachine mc w)
where
wlids = IS.toList $ mc ^. mcWallIDs
wlids = IM.keys $ mc ^. mcFootPrint
f wlid = w ^?! cWorld . lWorld . walls . ix wlid . wlLine
js = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize) . f) wlids