Move towards adding in pulse laser "rifle" (like UT shock rifle)

src/Dodge/BaseTriggerType.hs

@@ -6,7 +6,7 @@ module Dodge.BaseTriggerType (
     module Dodge.Data.TriggerType,
 ) where
 
-import Dodge.PulseLaser
+import Dodge.IsPulseLaser
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
 import Control.Lens

src/Dodge/Creature/Impulse/UseItem.hs

@@ -23,20 +23,12 @@ useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
 
 useItemLoc :: Creature -> LocationDT OItem -> PressType -> World -> Maybe World
 useItemLoc cr loc pt w
-    | HeldPlatformSF <- sf
+    | aimuse
-      , fromMaybe False $ loc ^? locDT . dtValue . _1 . itLocation . ilIsAttached
-      , Aiming{} <- cr ^. crStance . posture =
-        return $ gadgetEffect pt loc cr w
-    | LaserWeaponSF <- sf
       , fromMaybe False $ loc ^? locDT . dtValue . _1 . itLocation . ilIsAttached
       , Aiming{} <- cr ^. crStance . posture =
         return $ gadgetEffect pt loc cr w
     | GadgetPlatformSF <- sf =
         return $ gadgetEffect pt loc cr w
-    | UnderBarrelPlatformSF <- sf
-      , fromMaybe False $ loc ^? locDT . dtValue . _1 . itLocation . ilIsAttached
-      , Aiming{} <- cr ^. crStance . posture =
-        return $ gadgetEffect pt loc cr w
     | RemoteDetonatorSF <- sf
       , pt == InitialPress =
         return $ activateDetonator ldt w
@@ -55,6 +47,12 @@ useItemLoc cr loc pt w
         return $ toggleEquipmentAt invid' cr w
     | otherwise = (\loc' -> useItemLoc cr loc' pt w) =<< locUp' loc
   where
+    aimuse 
+        | LaserWeaponSF <- sf = True
+        | HeldPlatformSF <- sf = True
+        | PulseBallSF <- sf = True
+        | UnderBarrelPlatformSF <- sf = True
+        | otherwise = False
     sf = loc ^. locDT . dtValue . _2
     ldt = loc ^. locDT
     itm = ldt ^. dtValue . _1

src/Dodge/Data/ComposedItem.hs

@@ -39,6 +39,7 @@ data ItemSF -- Structural Function
     | MapperSF
     | LaserWeaponSF
     | CapacitorSF
+    | PulseBallSF
     deriving (Eq, Ord, Show, Read)
 
 type CItem = (Item, ItemSF)

src/Dodge/Data/LWorld.hs

@@ -117,6 +117,7 @@ data LWorld = LWorld
     , _shockwaves :: [Shockwave]
     , _lasers :: [Laser]
     , _pulseLasers :: [PulseLaser]
+    , _pulseBalls :: IM.IntMap PulseBall
     , _linearShockwaves :: IM.IntMap LinearShockwave
     , _tractorBeams :: [TractorBeam]
     , _walls :: IM.IntMap Wall

src/Dodge/Data/PulseLaser.hs

@@ -21,8 +21,11 @@ data PulseBall = PulseBall
     { _pbVel :: Point2
     , _pbPos :: Point2
     , _pbTimer :: Int
+    , _pbID :: Int
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''PulseLaser
+makeLenses ''PulseBall
 deriveJSON defaultOptions ''PulseLaser
+deriveJSON defaultOptions ''PulseBall

src/Dodge/Data/SoundOrigin.hs

@@ -38,6 +38,7 @@ data SoundOrigin
     | Tap Int
     | EBSound Int
     | DamageHitSound Int
+    | PBSound Int
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 

src/Dodge/Default/World.hs

@@ -119,6 +119,7 @@ defaultLWorld =
         , _shockwaves = []
         , _lasers = []
         , _pulseLasers = mempty
+        , _pulseBalls = mempty
         , _tractorBeams = mempty
         , _linearShockwaves = mempty
         , _walls = IM.empty

src/Dodge/HeldUse.hs

@@ -8,11 +8,11 @@ module Dodge.HeldUse (
     heldEffectMuzzles,
 ) where
 
-import Dodge.PulseLaser
+import qualified IntMapHelp as IM
+import Dodge.IsPulseLaser
 import Color
 import Control.Applicative
 import Control.Monad
-import qualified Data.IntMap.Strict as IM
 import Data.Maybe
 import Dodge.Base
 import Dodge.BaseTriggerType
@@ -53,8 +53,12 @@ gadgetEffect pt loc
     | CLICKER x <- loc ^. locDT . dtValue . _1 . itType
       , Just i <- loc ^? locDT . dtValue . _1 . itUse . uInt =
         useInventoryPath pt i x loc
+    | PulseBallSF <- loc ^. locDT . dtValue . _2 = \cr 
+        -> creatureShootPulseBall loc cr cmuz
     | otherwise = const id
 
+cmuz = Muzzle (V2 15 0) 0 0.01 0 BasicFlare MuzzleShootBullet (UseExactly 1) 0
+
 heldEffect :: PressType -> LocationDT OItem -> Creature -> World -> World
 heldEffect = hammerCheck heldEffectMuzzles
 
@@ -731,7 +735,7 @@ useLoadedAmmo loc cr (_, w) (Just (mz, x, magtree)) = (,) True $
     removeAmmoFromMag x mid cr . makeMuzzleFlare mz loc cr $ case _mzEffect mz of
         MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w
         MuzzleLaser -> creatureShootLaser loc cr mz w
-        MuzzlePulseLaser -> creatureShootPulseLaser loc cr mz w
+        MuzzlePulseLaser -> creatureShootPulseBall loc cr mz w
         MuzzleTesla -> shootTeslaArc loc cr mz w
         MuzzleTractor -> shootTractorBeam cr w
         MuzzleRLauncher -> createProjectileR loc magtree mz cr w
@@ -900,6 +904,34 @@ shootPulseLaser so p dir w =
                 }
         & soundContinue so p tone440sawtoothquietS (Just 2)
 
+creatureShootPulseBall :: LocationDT OItem -> Creature -> Muzzle -> World -> World
+creatureShootPulseBall loc cr mz w = w & randGen .~ g & shootPulseBall pos dir
+  where
+    (V3 x y _, q) =
+        locOrient loc cr
+            `Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz))
+    pos = _crPos cr + rotateV (_crDir cr) (V2 x y)
+    dir = _crDir cr + Q.qToAng q + a
+    (a, g) = randomR (- inacc, inacc) $ _randGen w
+    inacc = _mzInaccuracy mz
+    offset = case mz ^. mzRandomOffset of
+        0 -> 0
+        i -> fst . randomR (- i, i) $ _randGen w
+
+shootPulseBall :: Point2 -> Float -> World -> World
+shootPulseBall p dir w =
+    w
+        & cWorld . lWorld . pulseBalls . at i ?~
+            PulseBall
+                { _pbPos = p
+                , _pbVel = 5 * unitVectorAtAngle dir
+                , _pbTimer = 50
+                , _pbID = i
+                }
+        & soundStart (PBSound i) p energyReleaseS Nothing
+  where
+    i = IM.newKey $ w ^. cWorld . lWorld . pulseBalls
+
 removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
 removeAmmoFromMag x mid cr = fromMaybe id $ do
     magid <- mid

src/Dodge/IsPulseLaser.hs

@@ -0,0 +1,19 @@
+module Dodge.IsPulseLaser (
+    isPulseLaser,
+    isPulseCapacitor,
+) where
+
+import Control.Lens
+import Dodge.Data.ComposedItem
+import Dodge.Data.DoubleTree
+import Dodge.Data.Item
+
+isPulseLaser :: LocationDT OItem -> Bool
+isPulseLaser loc =
+    loc ^. locDT . dtValue . _1 . itType == HELD LASER
+        && (loc ^? locDT . dtLeft . ix 0 . dtValue . _1 . itType == Just (CRAFT CAPACITOR))
+
+isPulseCapacitor :: LocationDT OItem -> Bool
+isPulseCapacitor loc =
+    loc ^. locDT . dtValue . _1 . itType == HELD LASER
+        && (loc ^? locDT . dtLeft . ix 0 . dtValue . _1 . itType == Just (CRAFT CAPACITOR))

src/Dodge/Item/Grammar.hs

@@ -47,7 +47,7 @@ itemAboveAttachables (itm,sf) = case (itm ^. itType, sf) of
 
 itemBelowAttachables :: CItem -> [ItemSF]
 itemBelowAttachables (itm,sf) = case (itm ^. itType, sf) of
-    (HELD LASER, _) -> getAmmoLinks itm <> [CapacitorSF]
+    (HELD LASER, _) -> getAmmoLinks itm <> [PulseBallSF]
     (HELD TORCH, _) -> getAmmoLinks itm
     (ATTACH UNDERBARRELSLOT, _) -> [UnderBarrelPlatformSF]
     (_, HeldPlatformSF) -> getAmmoLinks itm <> extraWeaponLinksBelow itm
@@ -142,6 +142,7 @@ treeToPotentialFunction ldt = case ldt ^. dtValue . _1 . itType of
     HELD LASER -> S.fromList [WeaponTargetingSF,LaserWeaponSF]
     -- following limits items to ten ammo slots
     _ | AmmoMagSF _ x <- ldt ^. dtValue . _2 -> S.fromList [AmmoMagSF i x | i <- [0..9]]
+    CRAFT CAPACITOR -> S.fromList [CapacitorSF,PulseBallSF]
     _ -> S.singleton (ldt ^. dtValue . _2)
 
 baseCI :: Item -> CItem

src/Dodge/Item/InventoryColor.hs

@@ -37,6 +37,7 @@ itemInvColor ci = case ci ^. _2 of
     UnderBarrelSlotSF -> white
     LaserWeaponSF -> white
     CapacitorSF -> yellow
+    PulseBallSF -> white
 
 --ammoTypeColor :: AmmoType -> Color
 --ammoTypeColor = \case

src/Dodge/Projectile/Update.hs

@@ -82,10 +82,7 @@ applyGravityPU pj w
     newz = pj ^. pjZ + pj ^. pjZVel
 
 -- consider pushing any hit creature back
-shellCollisionCheck ::
+shellCollisionCheck :: Projectile -> World -> World
-    Projectile ->
-    World ->
-    World
 shellCollisionCheck pj w
     | RetiredProjectile <- pj ^. pjType
       , time <= 0 =

src/Dodge/Render/ShapePicture.hs

@@ -23,6 +23,7 @@ worldSPic cfig u =
     (mempty :!: extraPics cfig u)
         <> foldup propSPic (filtOn _prPos _props)
         <> foldup drawProjectile (filtOn _pjPos _projectiles)
+        <> foldup drawPulseBall (filtOn _pbPos _pulseBalls)
         <> foldup (shiftDraw _blPos _blDir (drawBlock . _blDraw)) (filtOn _blPos _blocks)
         <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes)
         <> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses)
@@ -36,6 +37,14 @@ worldSPic cfig u =
     filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w)))
     pointIsClose = cullPoint cfig w
 
+drawPulseBall :: PulseBall -> SPic
+drawPulseBall pb =
+    translateSPz 20 
+    . uncurryV translateSPxy (pb ^. pbPos)
+    . noShape 
+    . setLayer BloomLayer
+    $ circleSolidCol green white 10
+
 drawCreature :: Creature -> SPic
 drawCreature cr = uncurryV translateSPxy (_crPos cr) . rotateSP (_crDir cr) $
     case cr ^. crType of

src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs

@@ -1,4 +1,4 @@
--- generated at 2025-06-26 07:04:16.343678574 UTC
+-- generated at 2025-07-24 21:27:39.778553009 UTC
 module Dodge.SoundLogic.ExternallyGeneratedSounds where
 import Sound.Data
 soundToVol :: SoundID -> Float
@@ -77,72 +77,73 @@ soundToVol v = case _getSoundID v of
     71 -> 40
     72 -> 2000
     73 -> 100
-    74 -> 500
+    74 -> 250
-    75 -> 40
+    75 -> 500
-    76 -> 100
+    76 -> 40
-    77 -> 300
+    77 -> 100
     78 -> 300
-    79 -> 100
+    79 -> 300
-    80 -> 2000
+    80 -> 100
-    81 -> 1000
+    81 -> 2000
     82 -> 1000
     83 -> 1000
-    84 -> 100
+    84 -> 1000
     85 -> 100
-    86 -> 1000
+    86 -> 100
     87 -> 1000
-    88 -> 40
+    88 -> 1000
-    89 -> 50
+    89 -> 40
-    90 -> 1000
+    90 -> 50
-    91 -> 500
+    91 -> 1000
     92 -> 500
-    93 -> 100
+    93 -> 500
     94 -> 100
-    95 -> 1000
+    95 -> 100
-    96 -> 20
+    96 -> 1000
-    97 -> 500
+    97 -> 20
-    98 -> 300
+    98 -> 500
-    99 -> 200
+    99 -> 300
-    100 -> 500
+    100 -> 200
-    101 -> 1000
+    101 -> 500
-    102 -> 200
+    102 -> 1000
-    103 -> 1000
+    103 -> 200
-    104 -> 2000
+    104 -> 1000
-    105 -> 500
+    105 -> 2000
-    106 -> 200
+    106 -> 500
-    107 -> 100
+    107 -> 200
-    108 -> 1000
+    108 -> 100
-    109 -> 300
+    109 -> 1000
-    110 -> 2000
+    110 -> 300
     111 -> 2000
-    112 -> 100
+    112 -> 2000
-    113 -> 500
+    113 -> 100
-    114 -> 2000
+    114 -> 500
-    115 -> 500
+    115 -> 2000
-    116 -> 100
+    116 -> 500
-    117 -> 300
+    117 -> 100
-    118 -> 1000
+    118 -> 300
-    119 -> 200
+    119 -> 1000
-    120 -> 100
+    120 -> 200
-    121 -> 200
+    121 -> 100
-    122 -> 1000
+    122 -> 200
-    123 -> 2000
+    123 -> 1000
-    124 -> 200
+    124 -> 2000
-    125 -> 1000
+    125 -> 200
-    126 -> 100
+    126 -> 1000
-    127 -> 200
+    127 -> 100
-    128 -> 500
+    128 -> 200
-    129 -> 100
+    129 -> 500
-    130 -> 2000
+    130 -> 100
-    131 -> 200
+    131 -> 2000
-    132 -> 300
+    132 -> 200
-    133 -> 1000
+    133 -> 300
-    134 -> 2000
+    134 -> 1000
     135 -> 2000
-    136 -> 250
+    136 -> 2000
-    137 -> 200
+    137 -> 250
-    138 -> 100
+    138 -> 200
-    139 -> 200
+    139 -> 100
+    140 -> 200
     _ -> 50
 soundToOnomato :: SoundID -> String
 soundToOnomato v = case _getSoundID v of
@@ -220,72 +221,73 @@ soundToOnomato v = case _getSoundID v of
     71 -> "TIPTOP"
     72 -> "CRUH"
     73 -> "CHNKCHNKCHUNK"
-    74 -> "CLKCLK"
+    74 -> "DMP"
-    75 -> "TIPTAP"
+    75 -> "CLKCLK"
-    76 -> "SKWLCH"
+    76 -> "TIPTAP"
-    77 -> "TNKTNKTNK"
+    77 -> "SKWLCH"
-    78 -> "CHPCHPCHP"
+    78 -> "TNKTNKTNK"
-    79 -> "SLP"
+    79 -> "CHPCHPCHP"
-    80 -> "SCREE"
+    80 -> "SLP"
-    81 -> "DHDHL"
+    81 -> "SCREE"
-    82 -> "BRAP"
+    82 -> "DHDHL"
-    83 -> "CRSK"
+    83 -> "BRAP"
-    84 -> "SPLRT"
+    84 -> "CRSK"
-    85 -> "SKWLL"
+    85 -> "SPLRT"
-    86 -> "CRNKL"
+    86 -> "SKWLL"
-    87 -> "TRNKL"
+    87 -> "CRNKL"
-    88 -> "TAPP"
+    88 -> "TRNKL"
-    89 -> "SHUHP"
+    89 -> "TAPP"
-    90 -> "CRUMBL"
+    90 -> "SHUHP"
-    91 -> "DEDEDUM"
+    91 -> "CRUMBL"
-    92 -> "TAK"
+    92 -> "DEDEDUM"
-    93 -> "SPLRT"
+    93 -> "TAK"
-    94 -> "SQLEE"
+    94 -> "SPLRT"
-    95 -> "CRISH"
+    95 -> "SQLEE"
-    96 -> "SWSH"
+    96 -> "CRISH"
-    97 -> "BIPBIPBIP"
+    97 -> "SWSH"
-    98 -> "BEP"
+    98 -> "BIPBIPBIP"
-    99 -> "CRSKRL"
+    99 -> "BEP"
-    100 -> "KRTNKL"
+    100 -> "CRSKRL"
-    101 -> "CRSNK"
+    101 -> "KRTNKL"
-    102 -> "SHTCK"
+    102 -> "CRSNK"
-    103 -> "TTRKL"
+    103 -> "SHTCK"
-    104 -> "UGGAUGGA"
+    104 -> "TTRKL"
-    105 -> "DUDURAH"
+    105 -> "UGGAUGGA"
-    106 -> "TING"
+    106 -> "DUDURAH"
-    107 -> "KKSQWL"
+    107 -> "TING"
-    108 -> "CRMPL"
+    108 -> "KKSQWL"
-    109 -> "BWEP"
+    109 -> "CRMPL"
-    110 -> "CHUGUGUG"
+    110 -> "BWEP"
-    111 -> "BANG"
+    111 -> "CHUGUGUG"
-    112 -> "SLPP"
+    112 -> "BANG"
-    113 -> "DEDA"
+    113 -> "SLPP"
-    114 -> "WHSSH"
+    114 -> "DEDA"
-    115 -> "CLANG"
+    115 -> "WHSSH"
-    116 -> "HNH"
+    116 -> "CLANG"
-    117 -> "BWAH"
+    117 -> "HNH"
-    118 -> "CRUNK"
+    118 -> "BWAH"
-    119 -> "SQWLTCH"
+    119 -> "CRUNK"
-    120 -> "DRR"
+    120 -> "SQWLTCH"
-    121 -> "WHH"
+    121 -> "DRR"
-    122 -> "TRNKL"
+    122 -> "WHH"
-    123 -> "BRAP"
+    123 -> "TRNKL"
-    124 -> "WHR"
+    124 -> "BRAP"
-    125 -> "BLPCHCH"
+    125 -> "WHR"
-    126 -> "SKLE"
+    126 -> "BLPCHCH"
-    127 -> "ZMM"
+    127 -> "SKLE"
-    128 -> "WRRR"
+    128 -> "ZMM"
-    129 -> "FWUMP"
+    129 -> "WRRR"
-    130 -> "BRAHCHCH"
+    130 -> "FWUMP"
-    131 -> "TING"
+    131 -> "BRAHCHCH"
-    132 -> "WHRR"
+    132 -> "TING"
-    133 -> "BWMP"
+    133 -> "WHRR"
-    134 -> "BRPBRPBRP"
+    134 -> "BWMP"
-    135 -> "WE-OH"
+    135 -> "BRPBRPBRP"
-    136 -> "WHRHH"
+    136 -> "WE-OH"
-    137 -> "THCK"
+    137 -> "WHRHH"
-    138 -> "FHP"
+    138 -> "THCK"
-    139 -> "QWLPH"
+    139 -> "FHP"
+    140 -> "QWLPH"
     _ -> error "unitialised sound"
 soundPathList :: [String]
 soundPathList =
@@ -363,6 +365,7 @@ soundPathList =
     , "twoStepSlow.TIPTOP.40.wav"
     , "seagullCry.CRUH.2000.wav"
     , "crankSlow.CHNKCHNKCHUNK.100.wav"
+    , "energyRelease.DMP.250.wav"
     , "prime.CLKCLK.500.wav"
     , "twoStep.TIPTAP.40.wav"
     , "bloodShort8.SKWLCH.100.wav"
@@ -578,135 +581,137 @@ seagullCryS :: SoundID
 seagullCryS = SoundID 72
 crankSlowS :: SoundID
 crankSlowS = SoundID 73
+energyReleaseS :: SoundID
+energyReleaseS = SoundID 74
 primeS :: SoundID
-primeS = SoundID 74
+primeS = SoundID 75
 twoStepS :: SoundID
-twoStepS = SoundID 75
+twoStepS = SoundID 76
 bloodShort8S :: SoundID
-bloodShort8S = SoundID 76
+bloodShort8S = SoundID 77
 reloadS :: SoundID
-reloadS = SoundID 77
+reloadS = SoundID 78
 reload1S :: SoundID
-reload1S = SoundID 78
+reload1S = SoundID 79
 slapS :: SoundID
-slapS = SoundID 79
+slapS = SoundID 80
 tone440sawtoothS :: SoundID
-tone440sawtoothS = SoundID 80
+tone440sawtoothS = SoundID 81
 metal3S :: SoundID
-metal3S = SoundID 81
+metal3S = SoundID 82
 tap3S :: SoundID
-tap3S = SoundID 82
+tap3S = SoundID 83
 glassShat4S :: SoundID
-glassShat4S = SoundID 83
+glassShat4S = SoundID 84
 bloodShort1S :: SoundID
-bloodShort1S = SoundID 84
+bloodShort1S = SoundID 85
 bloodShort4S :: SoundID
-bloodShort4S = SoundID 85
+bloodShort4S = SoundID 86
 glassShat2S :: SoundID
-glassShat2S = SoundID 86
+glassShat2S = SoundID 87
 metal1S :: SoundID
-metal1S = SoundID 87
+metal1S = SoundID 88
 foot3S :: SoundID
-foot3S = SoundID 88
+foot3S = SoundID 89
 pickUpS :: SoundID
-pickUpS = SoundID 89
+pickUpS = SoundID 90
 stone5S :: SoundID
-stone5S = SoundID 90
+stone5S = SoundID 91
 dededumS :: SoundID
-dededumS = SoundID 91
+dededumS = SoundID 92
 tap1S :: SoundID
-tap1S = SoundID 92
+tap1S = SoundID 93
 blood1S :: SoundID
-blood1S = SoundID 93
+blood1S = SoundID 94
 bloodShort7S :: SoundID
-bloodShort7S = SoundID 94
+bloodShort7S = SoundID 95
 metal4S :: SoundID
-metal4S = SoundID 95
+metal4S = SoundID 96
 knifeS :: SoundID
-knifeS = SoundID 96
+knifeS = SoundID 97
 computerBeepingS :: SoundID
-computerBeepingS = SoundID 97
+computerBeepingS = SoundID 98
 tone440S :: SoundID
-tone440S = SoundID 98
+tone440S = SoundID 99
 gut6S :: SoundID
-gut6S = SoundID 99
+gut6S = SoundID 100
 smallGlass2S :: SoundID
-smallGlass2S = SoundID 100
+smallGlass2S = SoundID 101
 glassShat1S :: SoundID
-glassShat1S = SoundID 101
+glassShat1S = SoundID 102
 disconnectItemS :: SoundID
-disconnectItemS = SoundID 102
+disconnectItemS = SoundID 103
 metal5S :: SoundID
-metal5S = SoundID 103
+metal5S = SoundID 104
 seagullBarkTransformedS :: SoundID
-seagullBarkTransformedS = SoundID 104
+seagullBarkTransformedS = SoundID 105
 ejectS :: SoundID
-ejectS = SoundID 105
+ejectS = SoundID 106
 ting3S :: SoundID
-ting3S = SoundID 106
+ting3S = SoundID 107
 blood3S :: SoundID
-blood3S = SoundID 107
+blood3S = SoundID 108
 stone2S :: SoundID
-stone2S = SoundID 108
+stone2S = SoundID 109
 tone440raiseS :: SoundID
-tone440raiseS = SoundID 109
+tone440raiseS = SoundID 110
 seagullChatter1S :: SoundID
-seagullChatter1S = SoundID 110
+seagullChatter1S = SoundID 111
 bangS :: SoundID
-bangS = SoundID 111
+bangS = SoundID 112
 slap1S :: SoundID
-slap1S = SoundID 112
+slap1S = SoundID 113
 dedaS :: SoundID
-dedaS = SoundID 113
+dedaS = SoundID 114
 missileLaunchS :: SoundID
-missileLaunchS = SoundID 114
+missileLaunchS = SoundID 115
 clang2S :: SoundID
-clang2S = SoundID 115
+clang2S = SoundID 116
 gruntS :: SoundID
-gruntS = SoundID 116
+gruntS = SoundID 117
 sineRaisePitchOneSecS :: SoundID
-sineRaisePitchOneSecS = SoundID 117
+sineRaisePitchOneSecS = SoundID 118
 metal2S :: SoundID
-metal2S = SoundID 118
+metal2S = SoundID 119
 gut5S :: SoundID
-gut5S = SoundID 119
+gut5S = SoundID 120
 slideDoorS :: SoundID
-slideDoorS = SoundID 120
+slideDoorS = SoundID 121
 whirdown2S :: SoundID
-whirdown2S = SoundID 121
+whirdown2S = SoundID 122
 metal6S :: SoundID
-metal6S = SoundID 122
+metal6S = SoundID 123
 autoGunS :: SoundID
-autoGunS = SoundID 123
+autoGunS = SoundID 124
 whirdownSmall1S :: SoundID
-whirdownSmall1S = SoundID 124
+whirdownSmall1S = SoundID 125
 oldMachineBootS :: SoundID
-oldMachineBootS = SoundID 125
+oldMachineBootS = SoundID 126
 blood6S :: SoundID
-blood6S = SoundID 126
+blood6S = SoundID 127
 buzzS :: SoundID
-buzzS = SoundID 127
+buzzS = SoundID 128
 fireLoudS :: SoundID
-fireLoudS = SoundID 128
+fireLoudS = SoundID 129
 tap4S :: SoundID
-tap4S = SoundID 129
+tap4S = SoundID 130
 shotgunS :: SoundID
-shotgunS = SoundID 130
+shotgunS = SoundID 131
 ting5S :: SoundID
-ting5S = SoundID 131
+ting5S = SoundID 132
 whirS :: SoundID
-whirS = SoundID 132
+whirS = SoundID 133
 sawtoothFailS :: SoundID
-sawtoothFailS = SoundID 133
+sawtoothFailS = SoundID 134
 miniS :: SoundID
-miniS = SoundID 134
+miniS = SoundID 135
 seagullWhistleS :: SoundID
-seagullWhistleS = SoundID 135
+seagullWhistleS = SoundID 136
 whirdownS :: SoundID
-whirdownS = SoundID 136
+whirdownS = SoundID 137
 connectItemS :: SoundID
-connectItemS = SoundID 137
+connectItemS = SoundID 138
 whiteNoiseFadeInS :: SoundID
-whiteNoiseFadeInS = SoundID 138
+whiteNoiseFadeInS = SoundID 139
 gut1S :: SoundID
-gut1S = SoundID 139
+gut1S = SoundID 140

src/Dodge/Update.hs

@@ -7,14 +7,6 @@ Description : Simulation update
 -}
 module Dodge.Update (updateUniverse) where
 
-import Dodge.Item.Weapon.LaserPath
-import Dodge.Cloud
-import Dodge.Creature.Radius
-import Dodge.Creature.Mass
-import Dodge.Damage
-import RandomHelp
-import Dodge.Data.CrWlID
-import Dodge.ListDisplayParams
 import Color
 import Control.Applicative
 import Control.Monad
@@ -24,8 +16,13 @@ import Data.Maybe
 import Data.Monoid
 import Dodge.Base
 import Dodge.Bullet
+import Dodge.Cloud
 import Dodge.CrGroupUpdate
+import Dodge.Creature.Mass
+import Dodge.Creature.Radius
 import Dodge.Creature.Update
+import Dodge.Damage
+import Dodge.Data.CrWlID
 import Dodge.Data.Universe
 import Dodge.Debug
 import Dodge.DisplayInventory
@@ -34,8 +31,10 @@ import Dodge.DrWdWd
 import Dodge.EnergyBall
 import Dodge.Flame
 import Dodge.Inventory
+import Dodge.Item.Weapon.LaserPath
 import Dodge.Laser.Update
 import Dodge.LinearShockwave.Update
+import Dodge.ListDisplayParams
 import Dodge.Machine.Update
 import Dodge.Menu
 import Dodge.ModificationEffect
@@ -62,12 +61,14 @@ import Dodge.Update.Scroll
 import Dodge.Update.WallDamage
 import Dodge.WallCreatureCollisions
 import Dodge.WorldEffect
+import Dodge.WorldEvent.ThingsHit
 import Dodge.Zoning.Cloud
 import Dodge.Zoning.Creature
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
 import NewInt
+import RandomHelp
 import SDL
 import Sound.Data
 import StrictHelp
@@ -87,7 +88,7 @@ updateUniverseFirst :: Universe -> Universe
 updateUniverseFirst u =
     u
         & uvWorld . input . clickWorldPos %~ M.union (setClickWorldPos u)
-        & uvWorld . input . smoothScrollAmount 
+        & uvWorld . input . smoothScrollAmount
             %~ calcSmoothScroll (u ^. uvWorld . input . scrollAmount)
         & over (uvWorld . input) updateScrollTestValue
         & updateDebugMessageOffset
@@ -159,15 +160,18 @@ updateUniverseLast u =
 updateUniverseMid :: Universe -> Universe
 updateUniverseMid u = case _uvScreenLayers u of
     (OptionScreen{_scOptionFlag = LoadingScreen} : _) -> u
---    (sl@OptionScreen{_scOptionFlag = GameOverOptions} : _) -> u & updateUseInputOnScreen sl
+    --    (sl@OptionScreen{_scOptionFlag = GameOverOptions} : _) -> u & updateUseInputOnScreen sl
     (sl : _) -> u & uvWorld . unpauseClock .~ 0 & updateUseInputOnScreen sl
     [] ->
-        (uvWorld . unpauseClock +~ 1) .
+        (uvWorld . unpauseClock +~ 1)
-        timeFlowUpdate . updateUseInputInGame .
+            . timeFlowUpdate
-            over
+            . updateUseInputInGame
+            . over
                 uvWorld
                 (updateMouseInGame (u ^. uvConfig))
-        $ over uvWorld (updateCamera (u ^. uvConfig))
+            $ over
+                uvWorld
+                (updateCamera (u ^. uvConfig))
                 u
 
 timeFlowUpdate :: Universe -> Universe
@@ -263,18 +267,23 @@ functionalUpdate u =
         . over uvWorld (updateIMl' (_doors . _lWorld . _cWorld) updateDoor)
         . over uvWorld doWorldEvents
         . over uvWorld updateDelayedEvents
-        . over uvWorld (updateIMl (_modifications . _lWorld . _cWorld) 
+        . over
-            (doModificationEffect . _mdUpdate))
+            uvWorld
+            ( updateIMl
+                (_modifications . _lWorld . _cWorld)
+                (doModificationEffect . _mdUpdate)
+            )
         . over uvWorld updateSparks
         . over uvWorld updateRadarSweeps
         . over uvWorld updateFlames
         . over uvWorld updateShockwaves
         . over uvWorld updateBullets
-        . over uvWorld updateEnergyBalls  -- energybs can be created by bullets, 
+        . over uvWorld updateEnergyBalls -- energybs can be created by bullets,
-                                          -- so should probably be updated before bullets
+        -- so should probably be updated before bullets
         . over uvWorld updateRadarBlips
         --        . over uvWorld updateBeams
         . over uvWorld updateLasers
+        . over uvWorld (updateIMl' (_pulseBalls . _lWorld . _cWorld) updatePulseBall)
         . over uvWorld updatePulseLasers
         . over uvWorld updateTeslaArcs
         . over uvWorld updateTractorBeams
@@ -292,7 +301,7 @@ functionalUpdate u =
         . over (uvWorld . cWorld . lWorld . creatures) (fmap setOldPos)
         . over uvWorld updateCreatureGroups
         . over uvWorld updateWallDamages
---        . over uvWorld updateSeenWalls
+        --        . over uvWorld updateSeenWalls
         . over uvWorld checkTermDist
         . over uvWorld updateRBList
         . over uvWorld updateCloseObjects
@@ -308,8 +317,9 @@ functionalUpdate u =
         $ over uvWorld updatePastWorlds u
 
 updateAimPos :: Universe -> Universe
-updateAimPos u = u & uvWorld . cWorld . lWorld . lAimPos
+updateAimPos u =
-    .~ mouseWorldPos (u ^. uvWorld . input) (u ^. uvWorld . wCam)
+    u & uvWorld . cWorld . lWorld . lAimPos
+        .~ mouseWorldPos (u ^. uvWorld . input) (u ^. uvWorld . wCam)
 
 updateDoor :: Door -> World -> World
 updateDoor dr = doDrWdWd (_drMech dr) dr
@@ -344,12 +354,12 @@ updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
     isrotatedrag = do
         t1 <- w ^. input . mouseButtons . at ButtonLeft
         t2 <- w ^. input . mouseButtons . at ButtonRight
-        guard $ t1 > t2 
+        guard $ t1 > t2
         return MouseGameRotate
     aimcontext
---        | Just t1 <- w ^. input . mouseButtons . at ButtonLeft
+        --        | Just t1 <- w ^. input . mouseButtons . at ButtonLeft
---        , Just t2 <- w ^. input . mouseButtons . at ButtonRight
+        --        , Just t2 <- w ^. input . mouseButtons . at ButtonRight
---        , t1 > t2 = MouseGameRotate
+        --        , t1 > t2 = MouseGameRotate
         | ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
         | otherwise = MouseInGame
     mpos = w ^. input . mousePos
@@ -427,9 +437,9 @@ advanceScrollAmount =
         . (uvWorld . input . smoothScrollAmount %~ advanceSmoothScroll)
 
 updatePastWorlds :: World -> World
-updatePastWorlds w = w 
+updatePastWorlds w =
-    & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
+    w
-
+        & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
 
 doWorldEvents :: World -> World
 doWorldEvents w =
@@ -441,14 +451,39 @@ doWorldEvents w =
 updateLasers :: World -> World
 updateLasers w = w' & cWorld . lWorld . flares <>~ concat ls
   where
-    (w', ls) = mapAccumR updateLaser 
+    (w', ls) =
-        (w & cWorld . lWorld . lasers .~ [])
+        mapAccumR
-        (w ^. cWorld . lWorld . lasers)
+            updateLaser
+            (w & cWorld . lWorld . lasers .~ [])
+            (w ^. cWorld . lWorld . lasers)
 
 updatePulseLasers :: World -> World
 updatePulseLasers w = f w & cWorld . lWorld . pulseLasers .~ pzs
   where
-   (Endo f, pzs) = foldMap updatePulseLaser (w ^. cWorld . lWorld . pulseLasers)
+    (Endo f, pzs) = foldMap updatePulseLaser (w ^. cWorld . lWorld . pulseLasers)
+
+updatePulseBall :: PulseBall -> World -> World
+updatePulseBall pb w
+    | Just (_, ecrwl) <- thit =
+        w & cWorld . lWorld . pulseBalls . at (pb ^. pbID) .~ Nothing
+    | pb ^. pbTimer <= 0 =
+        w & cWorld . lWorld . pulseBalls . at (pb ^. pbID) .~ Nothing
+    | otherwise =
+        w
+            & cWorld . lWorld . pulseBalls . ix (pb ^. pbID) . pbTimer -~ 1
+            & cWorld . lWorld . pulseBalls . ix (pb ^. pbID) . pbPos .~ ep
+            & pbFlicker pb
+  where
+    sp = pb ^. pbPos
+    ep = sp + pb ^. pbVel
+    thit = thingHit sp ep w
+
+pbFlicker :: PulseBall -> World -> World
+pbFlicker pt =
+        cWorld . lWorld . lights
+            .:~ LSParam (addZ 5 $ _pbPos pt) d (0.5 * xyzV4 chartreuse)
+  where
+    d = 4 * fromIntegral (10 + abs ((_pbTimer pt `mod` 20) - 10))
 
 zoneClouds :: World -> World
 zoneClouds w = w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
@@ -594,21 +629,23 @@ updateTeslaArc w pt
 
 updatePulseLaser :: PulseLaser -> (Endo World, [PulseLaser])
 updatePulseLaser pz = case pz ^. pzTimer of
-    i | i <= 0 -> (Endo id,[])
+    i | i <= 0 -> (Endo id, [])
-    5 -> (Endo f,[pz & pzTimer -~ 1])
+    5 -> (Endo f, [pz & pzTimer -~ 1])
-    _ -> (Endo g,[pz & pzTimer -~ 1])
+    _ -> (Endo g, [pz & pzTimer -~ 1])
-  where 
+  where
-    f w = damThingHitWith
+    f w =
-                (\p2 -> Lasering (pz ^. pzDamage) p2 (xp - sp))
+        damThingHitWith
-                thHit w
+            (\p2 -> Lasering (pz ^. pzDamage) p2 (xp - sp))
-        & cWorld . lWorld . flares <>~ drawLaser cyan (sp: ps)
+            thHit
+            w
+            & cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
       where
         (thHit, ps) = reflectLaserAlong phasev sp xp w
     phasev = _pzPhaseV pz
     sp = _pzPos pz
     dir = _pzDir pz
     xp = sp +.+ 800 *.* unitVectorAtAngle dir
-    g w = w & cWorld . lWorld . flares <>~ drawLaser cyan (sp: ps)
+    g w = w & cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
       where
         (_, ps) = reflectLaserAlong phasev sp xp w
 
@@ -620,7 +657,6 @@ randWallReflect a wl = randPeaked a1 outa a2
     a1 = nearestAngleRep outa $ argV (x - y)
     a2 = if a1 < outa then a1 + pi else a1 - pi
 
-
 updateTractorBeams :: World -> World
 updateTractorBeams = updateObjCatMaybes tractorBeams updateTractorBeam
 
@@ -818,7 +854,8 @@ clClSpringVel a v b
     pa = _clPos a
     pb = _clPos b
     radDist = 10
-    --radDist = (_clRad a + _clRad b) / 2
+
+--radDist = (_clRad a + _clRad b) / 2
 
 dustSpringVel :: Dust -> Point3 -> Dust -> Point3
 dustSpringVel a v b