Commit before trying to add machine footprint

src/Dodge/Data/Machine.hs

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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