First implementation of pulse lasers

2025-07-23 23:22:26 +01:00
parent 8b17ec56ad
commit ff3699e6cb
9 changed files with 181 additions and 129 deletions
@@ -6,6 +6,7 @@ module Dodge.BaseTriggerType (
    module Dodge.Data.TriggerType,
 ) where

+import Dodge.PulseLaser
 import Dodge.Data.ComposedItem
 import Dodge.Data.DoubleTree
 import Control.Lens
@@ -13,7 +14,9 @@ import Dodge.Data.Item
 import Dodge.Data.TriggerType

 itemTriggerType :: LocationDT OItem -> TriggerType
-itemTriggerType loc = baseItemTriggerType $ loc ^. locDT . dtValue . _1
+itemTriggerType loc 
+    | isPulseLaser loc = HammerTrigger 9
+    | otherwise = baseItemTriggerType $ loc ^. locDT . dtValue . _1

 baseItemTriggerType :: Item -> TriggerType
 baseItemTriggerType itm = case itm ^. itType of
@@ -329,8 +329,9 @@ stackedInventory =
    , remoteScreen
    , megaShellMag
    , laser
-    , makeTypeCraft TRANSFORMER
+    , megaBattery
    , makeTypeCraft CAPACITOR
+    , makeTypeCraft TRANSFORMER
    , teslaGun
    , megaBattery
    , flameThrower
@@ -38,6 +38,7 @@ data ItemSF -- Structural Function
    | ToggleSF
    | MapperSF
    | LaserWeaponSF
+    | CapacitorSF
    deriving (Eq, Ord, Show, Read)

 type CItem = (Item, ItemSF)
@@ -31,6 +31,7 @@ data FlareType
 data MuzzleEffect
    = MuzzleShootBullet
    | MuzzleLaser
+    | MuzzlePulseLaser
    | MuzzleTesla
    | MuzzleTractor
    | MuzzleRLauncher
@@ -4,14 +4,10 @@
 module Dodge.Data.TriggerType where
 import Control.Lens

--import Data.Aeson
--import Data.Aeson.TH
-
 data TriggerType
    = AutoTrigger Int
    | HammerTrigger Int
    | NoTrigger
--    | AlwaysSingleTrigger Int
    | BurstTrigger {_burstFrames :: [Int], _burstRate :: Int}
    | VolleyGunTrigger {_volleyNumBarrels::Int, _volleyRate :: Int}
    | WarmUpCoolDown
@@ -19,9 +15,7 @@ data TriggerType
        , _coolStart :: Int
        , _coolEnd :: Int
        }
-    | WarmUpNoDelay
-        { _warmMax :: Int
-        }
+    | WarmUpNoDelay { _warmMax :: Int }
    deriving (Eq, Show, Read)
 makeLenses ''TriggerType

@@ -8,6 +8,7 @@ module Dodge.HeldUse (
    heldEffectMuzzles,
 ) where

+import Dodge.PulseLaser
 import Color
 import Control.Applicative
 import Control.Monad
@@ -134,12 +135,23 @@ heldEffectMuzzles loc cr w =
        $ loadedmuzzles
  where
    t = loc ^. locDT
-    (_, loadedmuzzles) = mapAccumR loadMuzzle t . itemMuzzles $ t ^. dtValue . _1
+    (_, loadedmuzzles) = mapAccumR loadMuzzle t . locMuzzles $ loc
    setusetime =
        cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itid . itTimeLastUsed
            .~ w ^. cWorld . lWorld . lClock
    itid = t ^?! dtValue . _1 . itLocation . ilInvID

+locMuzzles :: LocationDT OItem -> [Muzzle]
+locMuzzles loc
+    | isPulseLaser loc = 
+        dbwMuzzles
+            & ix 0 . mzPos .~ V2 6 0
+            & ix 0 . mzInaccuracy .~ 0
+            & ix 0 . mzFlareType .~ TeslaGunFlare
+            & ix 0 . mzEffect .~ MuzzlePulseLaser
+            & ix 0 . mzAmmoPerShot .~ UseExactly 100
+    | otherwise = itemMuzzles $ loc ^. locDT . dtValue . _1
+
 itemMuzzles :: Item -> [Muzzle]
 itemMuzzles itm = case itm ^. itType of
    HELD ALTERIFLE ->
@@ -686,10 +698,10 @@ flareCircleAt col alphax tranv =
            )

 -- previous phaseV parameters: 0.2, 1, 5
-getLaserPhaseV :: DTree Item -> Float
+getLaserPhaseV :: LocationDT OItem -> Float
 getLaserPhaseV = const 1

-getLaserDamage :: DTree Item -> LaserType
+getLaserDamage :: LocationDT OItem -> LaserType
 getLaserDamage = const (DamageLaser 11)

 getLaserColor :: LocationDT OItem -> Color
@@ -719,6 +731,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
        MuzzleTesla -> shootTeslaArc loc cr mz w
        MuzzleTractor -> shootTractorBeam cr w
        MuzzleRLauncher -> createProjectileR loc magtree mz cr w
@@ -816,14 +829,12 @@ creatureShootLaser loc cr mz w =
        & randGen .~ g
        & shootLaser
            (CrWeaponSound (_crID cr) 0)
-            (getLaserDamage istree)
-            (getLaserPhaseV istree)
+            (getLaserDamage loc)
+            (getLaserPhaseV loc)
            pos
            dir
            (getLaserColor loc)
  where
-    itmtree = loc ^. locDT
-    istree = fmap (\(i, _, _) -> i) itmtree
    (V3 x y _, q) =
        locOrient loc cr
            `Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz))
@@ -856,6 +867,39 @@ shootLaser so lt pv p dir col w =
                }
        & soundContinue so p tone440sawtoothquietS (Just 2)

+creatureShootPulseLaser :: LocationDT OItem -> Creature -> Muzzle -> World -> World
+creatureShootPulseLaser loc cr mz w =
+    w
+        & randGen .~ g
+        & shootPulseLaser
+            (CrWeaponSound (_crID cr) 0)
+            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
+
+shootPulseLaser :: SoundOrigin -> Point2 -> Float -> World -> World
+shootPulseLaser so p dir w =
+    w
+        & cWorld . lWorld . pulseLasers
+            .:~ PulseLaser
+                { _pzPhaseV = 1
+                , _pzPos = p
+                , _pzDir = dir
+                , _pzDamage = 101
+                , _pzTimer = 5
+                }
+        & soundContinue so p tone440sawtoothquietS (Just 2)
+
 removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
 removeAmmoFromMag x mid cr = fromMaybe id $ do
    magid <- mid
@@ -47,6 +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 TORCH, _) -> getAmmoLinks itm
    (ATTACH UNDERBARRELSLOT, _) -> [UnderBarrelPlatformSF]
    (_, HeldPlatformSF) -> getAmmoLinks itm <> extraWeaponLinksBelow itm
@@ -128,6 +129,7 @@ itemToFunction itm = case itm ^. itType of
    ATTACH SHELLPAYLOAD{} -> AmmoPayloadSF LauncherAmmo
    DROPPER{} -> GadgetPlatformSF
    CLICKER{} -> GadgetPlatformSF
+    CRAFT CAPACITOR -> CapacitorSF
    _ -> NoSF

 treeToPotentialFunction :: DTree CItem -> S.Set ItemSF
@@ -36,6 +36,7 @@ itemInvColor ci = case ci ^. _2 of
    UnderBarrelPlatformSF -> white
    UnderBarrelSlotSF -> white
    LaserWeaponSF -> white
+    CapacitorSF -> yellow

 --ammoTypeColor :: AmmoType -> Color
 --ammoTypeColor = \case