Start adding pulseLasers

src/Dodge/Creature.hs

@@ -330,6 +330,7 @@ stackedInventory =
     , megaShellMag
     , laser
     , makeTypeCraft TRANSFORMER
+    , makeTypeCraft CAPACITOR
     , teslaGun
     , megaBattery
     , flameThrower

src/Dodge/Data/Item/Combine.hs

@@ -62,6 +62,7 @@ data CraftType
     | PUMP
     | MOTOR
     | TRANSFORMER
+    | CAPACITOR
     | PRISM
     | LIGHTER
     | MAGNET

src/Dodge/Data/LWorld.hs

@@ -43,8 +43,10 @@ module Dodge.Data.LWorld (
     module Dodge.Data.TractorBeam,
     module Dodge.Data.Wall,
     module Dodge.Data.WorldEffect,
+    module Dodge.Data.PulseLaser,
 ) where
 
+import Dodge.Data.PulseLaser
 import Dodge.Data.Equipment.Misc
 import Control.Lens
 import Data.Aeson
@@ -114,6 +116,7 @@ data LWorld = LWorld
     , _arcNode :: M.Map ArcNodeType Int
     , _shockwaves :: [Shockwave]
     , _lasers :: [Laser]
+    , _pulseLasers :: [PulseLaser]
     , _linearShockwaves :: IM.IntMap LinearShockwave
     , _tractorBeams :: [TractorBeam]
     , _walls :: IM.IntMap Wall

src/Dodge/Data/PulseLaser.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Data.PulseLaser where
+
+import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Geometry.Data
+
+data PulseLaser = PulseLaser
+    { _pzPhaseV :: Float
+    , _pzPos :: Point2
+    , _pzDir :: Float
+    , _pzDamage :: Int
+    , _pzTimer :: Int
+    }
+    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+data PulseBall = PulseBall
+    { _pbVel :: Point2
+    , _pbPos :: Point2
+    , _pbTimer :: Int
+    }
+    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+makeLenses ''PulseLaser
+deriveJSON defaultOptions ''PulseLaser

src/Dodge/Default/World.hs

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

src/Dodge/Item/Draw/SPic.hs

@@ -70,6 +70,7 @@ craftItemSPic = \case
             . upperCylinder Small Typical 1
             $ polyCirc 3 4
     TIN -> colorSH green . upperPrismPolyST 3 $ rectXH 2 2
+    CAPACITOR -> colorSH cyan . upperPrismPolyST 3 $ rectXH 2 2
     STEELDRUM ->
         colorSH green
             . translateSH (V3 4 0 0)

src/Dodge/Item/Grammar.hs

@@ -75,59 +75,6 @@ itemBelowAttachables (itm,sf) = case (itm ^. itType, sf) of
     (ATTACH BULLETSYNTH, _) -> [AmmoMagSF 0 ElectricalAmmo]
     _ -> []
 
---itemToBreakLists :: Item -> ItemSF -> ([ItemSF], [ItemSF])
---itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
---    (HELD TORCH, _) -> (getAmmoLinks itm, [])
---    (ATTACH UNDERBARRELSLOT, _) -> ([UnderBarrelPlatformSF], [])
---    (_, HeldPlatformSF) ->
---        ( getAmmoLinks itm
---            <> extraWeaponLinksBelow itm
---        , [WeaponTargetingSF, WeaponScopeSF]
---            <> getAutoSpringLinks itm
---            <> extraWeaponLinks itm
---        )
---    (_, UnderBarrelPlatformSF) ->
---        ( getAmmoLinks itm,[])
---    (DETECTOR {}, _) -> 
---        ( getAmmoLinks itm
---        , [ARHUDSF,TriggerSF,MapperSF]
---        )
---    (CRAFT TRANSFORMER, _) ->  ([],[LaserWeaponSF])
---    (MAPPER, _) -> 
---        ( []
---        , [ARHUDSF]
---        )
---    (_, GadgetPlatformSF) ->
---        ( getAmmoLinks itm
---        , [TriggerSF, WeaponTargetingSF, WeaponScopeSF]
---        )
---    (_, AmmoMagSF{}) -> fromMaybe ([], []) $ do
---        atype <- magAmmoType itm
---        let screenanddet = case atype of
---                LauncherAmmo ->
---                    [ RemoteScreenSF
---                    , RemoteDetonatorSF
---                    ]
---                _ -> []
---        return
---            ( [ AmmoModifierSF atype
---              , AmmoTargetingSF atype
---              , AmmoPayloadSF atype
---              , AmmoEffectSF atype
---              , SmokeReducerSF
---              ]
---                <> screenanddet
---            , []
---            )
---    (_, RemoteScreenSF) ->
---        ( [JoystickSF]
---        , []
---        )
---    (_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [ARHUDSF], [])
---    (ATTACH BULLETSYNTH, _) ->
---        ([AmmoMagSF 0 ElectricalAmmo], [])
---    _ -> ([], [])
-
 getAutoSpringLinks :: Item -> [ItemSF]
 getAutoSpringLinks itm = case baseItemTriggerType itm of
     HammerTrigger _ -> [MakeAutoSF]

src/Dodge/Item/Held/BatteryGuns.hs

@@ -19,15 +19,8 @@ sparkGun =
 teslaGun :: Item
 teslaGun =
     defaultHeldItem
---        & itUse . heldParams .~ BeamShooterParams-- (Just (elecCrackleS, 2))
         & itParams .~ teslaParams
---        & itUse . heldDelay .~ NoDelay
---        & itUse . heldMuzzles . ix 0 . mzPos .~ V2 10 0
---        & itUse . heldMuzzles . ix 0 . mzInaccuracy .~ 0
---        & itUse . heldMuzzles . ix 0 . mzFlareType .~ TeslaGunFlare
---        & itUse . heldMuzzles . ix 0 . mzEffect .~ MuzzleTesla
         & itType .~ HELD TESLAGUN
---        & itAmmoSlots .~ singleAmmo ElectricalAmmo
 
 teslaParams :: ItemParams
 teslaParams =

src/Dodge/Item/Info.hs

@@ -182,6 +182,7 @@ craftInfo fit = case fit of
     PUMP -> "A device that can create pressure."
     MOTOR -> "A device that can create rotational force."
     TRANSFORMER -> "A device that can step up or down voltage and current."
+    CAPACITOR -> "A device that stores electrical energy."
     PRISM -> "An object that refracts light."
     THERMOMETER -> "An object that measures temperature."
     LIGHTER -> "A device that can create a small flame."

src/Dodge/Laser/Update.hs

@@ -1,4 +1,4 @@
-module Dodge.Laser.Update ( updateLaser) where
+module Dodge.Laser.Update (updateLaser, drawLaser) where
 
 import Dodge.Damage
 import Control.Lens

src/Dodge/Update.hs

@@ -7,6 +7,7 @@ Description : Simulation update
 -}
 module Dodge.Update (updateUniverse) where
 
+import Dodge.Item.Weapon.LaserPath
 import Dodge.Cloud
 import Dodge.Creature.Radius
 import Dodge.Creature.Mass
@@ -274,6 +275,7 @@ functionalUpdate u =
         . over uvWorld updateRadarBlips
         --        . over uvWorld updateBeams
         . over uvWorld updateLasers
+        . over uvWorld updatePulseLasers
         . over uvWorld updateTeslaArcs
         . over uvWorld updateTractorBeams
         . over uvWorld (updateIMl' (_linearShockwaves . _lWorld . _cWorld) updateLinearShockwave)
@@ -443,6 +445,11 @@ updateLasers w = w' & cWorld . lWorld . flares <>~ concat ls
         (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)
+
 zoneClouds :: World -> World
 zoneClouds w = w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
 
@@ -585,6 +592,26 @@ updateTeslaArc w pt
         | ArcStep lp' ld' _ <- last thearc = (lp', rp ld')
     damthings (ArcStep _ _ crwl) = damageCrWlID [Electrical 50] crwl
 
+updatePulseLaser :: PulseLaser -> (Endo World, [PulseLaser])
+updatePulseLaser pz = case pz ^. pzTimer of
+    i | i <= 0 -> (Endo id,[])
+    5 -> (Endo f,[pz & pzTimer -~ 1])
+    _ -> (Endo g,[pz & pzTimer -~ 1])
+  where 
+    f w = damThingHitWith
+                (\p2 -> Lasering (pz ^. pzDamage) p2 (xp - sp))
+                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)
+      where
+        (_, ps) = reflectLaserAlong phasev sp xp w
+
 randWallReflect :: RandomGen g => Float -> Wall -> State g Float
 randWallReflect a wl = randPeaked a1 outa a2
   where