diff --git a/src/Dodge/Data/Machine.hs b/src/Dodge/Data/Machine.hs index fed02faa6..e552cfcdb 100644 --- a/src/Dodge/Data/Machine.hs +++ b/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" diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 7352b0781..7c6837e89 100644 --- a/src/Dodge/Default.hs +++ b/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 } diff --git a/src/Dodge/Machine/Destroy.hs b/src/Dodge/Machine/Destroy.hs index adcfcf37f..335cd81f8 100644 --- a/src/Dodge/Machine/Destroy.hs +++ b/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 diff --git a/src/Dodge/Machine/Draw.hs b/src/Dodge/Machine/Draw.hs index fdbfc8dbe..874368818 100644 --- a/src/Dodge/Machine/Draw.hs +++ b/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 diff --git a/src/Dodge/Machine/Update.hs b/src/Dodge/Machine/Update.hs index 70acc54e8..643e4df8f 100644 --- a/src/Dodge/Machine/Update.hs +++ b/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) diff --git a/src/Dodge/Placement/Instance/Sensor.hs b/src/Dodge/Placement/Instance/Sensor.hs index dffadcf9c..c989780b3 100644 --- a/src/Dodge/Placement/Instance/Sensor.hs +++ b/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) diff --git a/src/Dodge/Placement/PlaceSpot.hs b/src/Dodge/Placement/PlaceSpot.hs index 6a8da64af..c908d096a 100644 --- a/src/Dodge/Placement/PlaceSpot.hs +++ b/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 ) diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index 3c9cbd0fc..465bdf721 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/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 diff --git a/src/Dodge/Room/Warning.hs b/src/Dodge/Room/Warning.hs index a02322547..313c6d65e 100644 --- a/src/Dodge/Room/Warning.hs +++ b/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 diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index 754290a72..75dcc9111 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/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