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

Commit before trying to add machine footprint

Browse Source
This commit is contained in:
justin
2026-03-31 13:57:48 +01:00
parent 6bcf03b30d
commit dea4c0dffe
10 changed files with 44 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Machine.hs
+4 -3
View File
@@ -26,11 +26,14 @@ import Dodge.Data.Machine.Sensor
import Dodge.Data.Material
import Dodge.Data.ObjectType
import Geometry.Data
import qualified Data.IntMap.Strict as IM
data Machine = Machine
{ _mcID :: Int
, _mcWallIDs :: IS.IntSet
, _mcMaterial :: Material
, _mcSkin :: Material
, _mcFootPrint :: IM.IntMap (Point2,Point2)
, _mcPos :: Point2
, _mcDir :: Float
, _mcHP :: Int
@@ -40,8 +43,7 @@ data Machine = Machine
}
data MachineType
= McStatic
| McTerminal
= McTerminal
| McDamSensor DamageSensor
| McProxSensor ProximitySensor
| McTurret {_mctTurret :: Turret, _mctTurretStun :: Int}
@@ -52,7 +54,6 @@ data MachineType
instance ShortShow MachineType where
shortShow = \case
McStatic -> "McStatic"
McTerminal -> "McTerm"
McDamSensor {} -> "McDamSen"
McProxSensor {} -> "McProxSen"
src/Dodge/Default.hs
+3 -1
View File
@@ -36,8 +36,10 @@ defaultMachine =
, _mcDir = 0
, _mcHP = 1000
, _mcMaterial = Electronics
, _mcSkin = Metal
, _mcFootPrint = mempty
, _mcDamage = []
, _mcType = McStatic
, _mcType = McTerminal
, _mcMounts = mempty
}
src/Dodge/Machine/Destroy.hs
+16 -1
View File
@@ -14,11 +14,26 @@ destroyMachine :: Machine -> World -> World
destroyMachine mc =
(cWorld . lWorld . machines %~ IM.delete (_mcID mc))
. deleteWallIDs (_mcWallIDs mc)
. makeExplosionAt (_mcPos mc `v2z` 20) 0
. makeMachineDebris mc
. makeSmallExplosionAt (_mcPos mc `v2z` 20) 0
. mcKillTerm mc
. mcKillBut mc
. destroyMcType (mc ^. mcType) mc
--explodeMachine :: Machine -> MachineType -> World -> World
--explodeMachine mc = \case
makeMachineDebris :: Machine -> World -> World
makeMachineDebris mc = id -- foldl' (flip $ makeDebris mt) w ps
-- where
-- dsize = debrisSize mt
-- ps = gridInPolygon dsize $ shrinkPolyOnEdges dsize $ reverse (_mcFootprint bl)
-- mt = fromMaybe Stone $ do
-- wlids <- w ^? cWorld . lWorld . blocks . ix (_blID bl) . blWallIDs
-- (wlid, _) <- IS.minView wlids
-- wl <- w ^? cWorld . lWorld . walls . ix wlid
-- return $ _wlMaterial wl
destroyMcType :: MachineType -> Machine -> World -> World
destroyMcType mt mc w = case mt of
McTurret tu _ -> fromMaybe w $ do
src/Dodge/Machine/Draw.hs
-2
View File
@@ -16,7 +16,6 @@ import ShapePicture
drawMachine :: CWorld -> Machine -> SPic
drawMachine cw mc = case _mcType mc of
McStatic -> mempty
McTerminal -> terminalSPic lw mc
McTurret tu _ -> drawBaseMachine 20 mc <> drawTurret lw tu mc
McDamSensor se -> drawBaseMachine 25 mc <> drawDamSensor gp se
@@ -82,7 +81,6 @@ drawBaseMachine h mc =
mcColor :: Machine -> Color
mcColor mc = case mc ^. mcType of
McStatic -> blue
McTerminal -> dark magenta
McDamSensor{} -> yellow
McProxSensor{} -> aquamarine
src/Dodge/Machine/Update.hs
-2
View File
@@ -31,7 +31,6 @@ updateMachine mc = mcPlaySound mc . mcTypeUpdate mc (_mcType mc)
mcTypeUpdate :: Machine -> MachineType -> World -> World
mcTypeUpdate mc = \case
McStatic -> id
McTerminal -> terminalScreenGlow mc
McTurret tu _ -> updateTurret (_tuTurnSpeed tu) mc
McDamSensor se -> mcDamSensorTriggerUpdate se mc . mcDamSensorUpdate se mc
@@ -152,7 +151,6 @@ mcPlaySound mc w = fromMaybe w $ do
mcBackgroundSound :: Machine -> Maybe (SoundID,Float)
mcBackgroundSound mc = case mc ^. mcType of
McStatic -> Nothing
McTerminal -> Just (fridgeHumS,1)
McTurret{} -> Just (fridgeHumS,1)
McDamSensor{} -> Just (fridgeHumS,1)
src/Dodge/Placement/Instance/Sensor.hs
+1 -1
View File
@@ -17,7 +17,7 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
PutMachine
(reverse $ square wdth)
( defaultMachine
& mcMaterial .~ mattype
& mcSkin .~ mattype
& mcMounts . at OTTrigger .~ mtrid
& mcMounts . at OTLightSource ?~ lsid
& mcType .~ McDamSensor (DamSensor 0 dt)
src/Dodge/Placement/PlaceSpot.hs
+1 -1
View File
@@ -204,7 +204,7 @@ plMachine wallpoly mc mitm p rot gw =
. at mcid
?~ themc
& gwWorld
%~ placeMachineWalls (_mcMaterial mc) wallpoly mcid wlid
%~ placeMachineWalls (_mcSkin mc) wallpoly mcid wlid
& tolw
%~ maybe id placeturretitm mitm
)
src/Dodge/Room/LasTurret.hs
-4
View File
@@ -113,7 +113,6 @@ analyserByNthLink :: Int -> ProximityRequirement -> Int -> Placement
analyserByNthLink n proxreq i =
analyser
(SensorWithRequirement proxreq)
-- (byNthLink n)
( atNthLnkOutShiftBy
n
( \(p, a) ->
@@ -121,11 +120,8 @@ analyserByNthLink n proxreq i =
)
)
(byNthLink n)
-- (atNthLnkOutShiftBy n sensorshift)
& plExternalID
?~ i
where
sensorshift (p, a) = ((p +.+ rotateV a (V2 (-30) (-10)), a), S.singleton UsedPosLow)
analyserByDoor :: ProximityRequirement -> Int -> Room -> Room
analyserByDoor pr i = rmPmnts .:~ analyserByNthLink 0 pr i
src/Dodge/Room/Warning.hs
+2 -29
View File
@@ -52,7 +52,7 @@ addDoorAtNthLinkToggleInterrupt j x i =
outplace =
extTrigLitPos
(atNthLnkOutShiftBy j (\(p, a) -> ((p + rotateV a (V2 18.5 (-2.5)), a), S.singleton UsedPosLow)))
( Just . set plSpot (rprShift (moveToSideNthOutLink (S.singleton UsedPosLow) j))
( Just . set plSpot (byNthLink j)
. putInterrupt
)
& plExternalID
@@ -71,7 +71,7 @@ addDoorAtNthLinkToggleTerminal j xs i =
outplace =
extTrigLitPos
(atNthLnkOutShiftBy j (\(p, a) -> ((p +.+ rotateV a (V2 18.5 (-2.5)), a), S.singleton UsedPosLow)))
( Just . set plSpot (rprShift (moveToSideNthOutLink (S.singleton UsedPosLow) j))
( Just . set plSpot (byNthLink j)
. putMessageTerminal
. termMessages
)
@@ -119,30 +119,3 @@ moveToSideNthOutLink xs i rp rm = do
-- complicated, it should really use created walls...
((rtpos, rpdir), xs)
else ((ltpos, rpdir), xs)
--moveToSideFirstOutLink :: RoomPos -> Room -> Maybe (Point2, Float)
--moveToSideFirstOutLink rp rm = do
-- 0 <- rp ^? rpLinkStatus . rplsChildNum
-- let rppos = _rpPos rp
-- rpdir = _rpDir rp
-- inpos = rppos +.+ rotateV rpdir (V2 0 (-12.5))
-- rtpos = inpos +.+ rotateV rpdir (V2 30 0)
-- ltpos = inpos +.+ rotateV rpdir (V2 (-30) 0)
-- return $ if any (isJust . intersectSegPolyFirst inpos ltpos) (_rmPolys rm)
-- then -- the above test may not work properly if the room polys are
-- -- complicated, it should really use created walls...
-- (rtpos, rpdir)
-- else (ltpos, rpdir)
--moveToSideFirstOutLink rp rm = case rp ^? rpLinkStatus . rplsChildNum of
-- Just 0 ->
-- let rppos = _rpPos rp
-- rpdir = _rpDir rp
-- inpos = rppos +.+ rotateV rpdir (V2 0 (-12.5))
-- rtpos = inpos +.+ rotateV rpdir (V2 30 0)
-- ltpos = inpos +.+ rotateV rpdir (V2 (-30) 0)
-- in if any (isJust . intersectSegPolyFirst inpos ltpos) (_rmPolys rm)
-- then -- the above test may not work properly if the room polys are
-- -- complicated, it should really use created walls...
-- Just (rtpos, rpdir)
-- else Just (ltpos, rpdir)
-- _ -> Nothing
src/Dodge/WorldEvent/Explosion.hs
+17
View File
@@ -3,6 +3,7 @@ Explosions: creation of shockwave and particles at a given point.
-}
module Dodge.WorldEvent.Explosion (
makeExplosionAt,
makeSmallExplosionAt,
makeFlameExplosionAt,
makePoisonExplosionAt,
makeTeslaExplosionAt,
@@ -80,3 +81,19 @@ makeExplosionAt p vel w =
mF v damp = makeFlamelet p (v + damp *^ vel)
newFs = zipWith4 mF fVs fdamps sizes times
addFlames w' = foldl' (&) w' newFs
makeSmallExplosionAt :: Point3 -> Point3 -> World -> World
makeSmallExplosionAt p vel w =
w
& soundStart (Explosion (w ^. cWorld . lWorld . lClock)) (p ^. _xy) bangS Nothing
& addFlames
& cWorld . lWorld . worldEvents .:~ MakeTempLight (LSParam p 150 (V3 1 0.5 0)) 20
& makeShockwaveAt [] p 40 100 1 white
where
fVs = fmap (`v2z` 0) $ replicateM 5 (randInCirc 2) & evalState $ _randGen w
fdamps = replicateM 100 (state $ randomR (0, 1)) & evalState $ _randGen w
sizes = randomRs (2, 9) $ _randGen w
times = randomRs (15, 20) $ _randGen w
mF v damp = makeFlamelet p (v + damp *^ vel)
newFs = zipWith4 mF fVs fdamps sizes times
addFlames w' = foldl' (&) w' newFs