Tweak tesla gun

2022-04-06 19:59:38 +01:00
parent bd255d2e54
commit dd64f3c5db
6 changed files with 143 additions and 72 deletions
@@ -7,12 +7,7 @@ import Dodge.Particle.HitEffect.ExpireAndDamage
 import Dodge.Particle.Damage
 import Dodge.Item.Equipment
 import Dodge.Item.Craftable
-import Dodge.Item.Weapon.BulletGuns
-import Dodge.Item.Weapon.BatteryGuns
-import Dodge.Item.Weapon.Launcher
-import Dodge.Item.Weapon.SprayGuns
-import Dodge.Item.Weapon.TriggerType
-import Dodge.Item.Weapon.ExtraEffect
+import Dodge.Item.Weapon
 import Dodge.Base
 import LensHelp

@@ -77,6 +72,8 @@ itemCombinations =
    , p [o TRANSFORMER,p 2 CAN] sparkGun
    , p [o SPARKGUN,p 2 PIPE] teslaGun

+    , p [o TELEPORTMODULE,p 2 MICROCHIP] blinkGun
+
    , po [MAGNET,TIN] magShield

    , p [p 4 CAN] plateCraft
@@ -138,8 +135,7 @@ moduleCombinations =
        )
    ,   ( ModBulletTrajectory
        ,   bulletWeapons
-        ,   [amod [TELEPORTMODULE,MICROCHIP] "+DIRECTEDTELE" makeDirectedTele
-            ,amod [MAGNET,MICROCHIP,HARDWARE] "+MAGNETTRAJECTORY" 
+        ,   [amod [MAGNET,MICROCHIP,HARDWARE] "+MAGNETTRAJECTORY" 
                ( (itConsumption . aoType . amBulTraj .~ MagnetTrajectory) 
                . (itConsumption . aoType . amBulVel  .~ V2 10 0)
                )
@@ -149,6 +145,18 @@ moduleCombinations =
                (itConsumption . aoType . amBulTraj .~ BezierTrajectory)
            ]
        )
+    ,   ( ModDualBeam
+        ,   [lasGunDual]
+        ,   [amod [INCENDIARYMODULE] "+INCENDIARY" (itParams . lasBeam .~ BeamCombine flameBeamCombine)
+            ,amod [STATICMODULE]     "+STATIC" (itParams . lasBeam .~ BeamCombine teslaBeamCombine)
+            ,amod [TRANSFORMER]      "+SPLIT"  (itParams . lasBeam .~ BeamCombine splitBeamCombine)
+            ]
+        )
+    ,   ( ModTeleport
+        ,   teleportableWeapons
+        ,   [amod [TELEPORTMODULE,MICROCHIP] "+DIRECTEDTELE" makeDirectedTele
+            ]
+        )
    ,   ( ModLauncherHoming
        ,   homingLaunchers
        ,   [ amod [MICROCHIP,TRANSMITTER] "+TARGET HOMING" 
@@ -192,6 +200,9 @@ batteryGuns =
    ] ++
    [ lasGunFocus i | i <- [1..10]]

+teleportableWeapons :: [Item]
+teleportableWeapons  = bulletWeapons ++ batteryGuns ++ homingLaunchers
+
 bulletWeapons :: [Item]
 bulletWeapons = [bangStick i | i <- [1..9] ]
    ++ [bangCaneX i | i <- [1..6] ]
@@ -174,10 +174,11 @@ inventoryA = IM.fromList $ zip [0..]
 testInventory :: IM.IntMap Item
 testInventory = IM.fromList $ zip [0..] 
    [ makeTypeCraftNum 9 PIPE
-    , incendiaryModule
+    , makeModule INCENDIARYMODULE
+    , makeModule STATICMODULE
    , bounceModule
    , medkit 50 & itConsumption . itAmount .~ 3
--    , teleportModule
+    , teleportModule
    , makeTypeCraftNum 1 LIGHTER
 --    , makeTypeCraftNum 15 TUBE
    , makeTypeCraftNum 9 TRANSFORMER
@@ -194,7 +195,7 @@ testInventory = IM.fromList $ zip [0..]
 --    , makeTypeCraftNum 3 TIN
    , makeTypeCraftNum 3 PLANK
 --    , makeTypeCraftNum 1 MOTOR
--    , makeTypeCraftNum 5 MICROCHIP
+    , makeTypeCraftNum 5 MICROCHIP
 --    , makeTypeCraftNum 5 AIUNIT
    ]
 stackedInventory :: IM.IntMap Item
@@ -442,6 +442,8 @@ data ModuleSlot
    | ModBulletTrajectory
    | ModLauncherHoming
    | ModBattery
+    | ModTeleport
+    | ModDualBeam
  deriving (Eq,Ord)

 data ItemModule
@@ -655,7 +657,6 @@ data GunBarrels
        , _brlInaccuracy :: Float
        }
    | SingleBarrel  {_brlInaccuracy :: Float}
-    
 data ItemParams
    = NoParams
    | ShellLauncher
@@ -670,8 +671,16 @@ data ItemParams
        , _lasCycle :: Int
        , _lasDamage :: Int
        }
+    | DualBeam
+        { _phaseV :: Float
+        , _lasColor :: Color
+        , _lasColor2 :: Color
+        , _lasCycle :: Int
+        , _lasDamage :: Int
+        , _lasBeam :: BeamType
+        }
    | Attracting    {_attractionPower :: Point2}
-    | BulletShooter -- this should possibly be moved into ammo type
+    | BulletShooter
        { _muzVel   :: Float
        , _rifling  :: Float
        , _bore     :: Float
@@ -687,14 +696,19 @@ data ItemParams
        , _walkSpeed :: Float
        }
    | Arcing 
-        { _currentArc :: Maybe [(Point2,Float,Maybe (Either Creature Wall))] 
+        { _currentArc :: Maybe [ArcStep] 
        , _arcSize :: Float
        , _arcNumber :: Int
        , _newArcStep :: ItemParams -> World 
-            -> (Point2,Float,Maybe (Either Creature Wall))
-            -> State StdGen (Maybe (Point2,Float,Maybe (Either Creature Wall)))
+            -> ArcStep
+            -> State StdGen (Maybe ArcStep)
        , _previousArcEffect :: PreviousArcEffect
        }
+data ArcStep = ArcStep
+    { _asPos :: Point2
+    , _asDir :: Float
+    , _asObject :: Maybe (Either Creature Wall)
+    }
 data PreviousArcEffect = NoPreviousArcEffect | PerturbTillBreakPreviousArc
 data Modification
    = ModIDTimerPoint3Bool
@@ -1169,3 +1183,4 @@ makeLenses ''Sensor
 makeLenses ''Beam
 makeLenses ''BeamType
 makeLenses ''WorldBeams
+makeLenses ''ArcStep
@@ -103,6 +103,7 @@ defaultGun = Item
        [(ModBullet, DefaultModule)
        ,(ModTarget, DefaultModule)
        ,(ModBulletTrajectory, DefaultModule)
+        ,(ModTeleport, DefaultModule)
        ]
    , _itScope = NoScope
    , _itTargeting = NoTargeting
@@ -11,6 +11,9 @@ module Dodge.Item.Weapon.BatteryGuns
    , teslaGun
    , tractorGun
    , lasRayAt
+    , flameBeamCombine
+    , teslaBeamCombine
+    , splitBeamCombine
    ) where
 import Dodge.Data
 import Dodge.Item.Weapon.LaserPath
@@ -47,11 +50,17 @@ import Control.Monad.State

 defaultBatteryGun :: Item
 defaultBatteryGun = defaultGun
-    & itModules .~ M.fromList [(ModBattery, DefaultModule)]
+    & itModules .~ batteryModules
+
+batteryModules :: M.Map ModuleSlot ItemModule
+batteryModules = M.fromList 
+    [(ModBattery, DefaultModule)
+    ,(ModTeleport, DefaultModule)
+    ]

 defaultAutoBatteryGun :: Item
 defaultAutoBatteryGun = defaultAutoGun
-    & itModules .~ M.fromList [(ModBattery, DefaultModule)]
+    & itModules .~ batteryModules

 sparkGun :: Item
 sparkGun = teslaGun
@@ -212,8 +221,14 @@ lasGunDual :: Item
 lasGunDual = lasGun
    & itName .~ "DUALAS"
    & itType .~ LASGUNDUAL
-    & itParams . lasColor .~ orange
-    & itParams . lasColor2 .~ blue
+    & itParams .~ DualBeam
+        { _phaseV = 1
+        , _lasColor = yellow
+        , _lasColor2 = yellow
+        , _lasCycle = 0
+        , _lasDamage = 11
+        , _lasBeam = BeamCombine lasBeamCombine
+        }
    & itUse .~ (ruseInstant shootDualLaser NoHammer
        [ ammoCheckI
 --        , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
@@ -226,7 +241,7 @@ lasGunDual = lasGun
        & useAim . aimRange .~ 1
        & useAim . aimStance .~ TwoHandTwist
        )
-
+    & itModules . at ModDualBeam ?~ DefaultModule
 lasGunSwing :: Item
 lasGunSwing = lasGun
    & itName .~ "SWINGLAS"
@@ -313,7 +328,6 @@ lasGunTweak = TweakParam
    showPhaseV 2 = "Z"
    showPhaseV i = "THIS SHOULD NOT BE POSSIBLE" ++ show i

-
 tractorGun :: Item
 tractorGun = lasGun 
    { _itName = "TRACTORGUN"
@@ -372,7 +386,6 @@ tractorGunPic it =
  where
    amFrac = fractionLoadedAmmo it
    col = brightX 2 1.5 $ mixColors amFrac (1-amFrac) green red
-
 -- | assumes that the item is held
 shootTeslaArc :: Item -> Creature -> World -> World
 shootTeslaArc it cr w = w & randGen .~ g
@@ -388,21 +401,22 @@ createArc :: ItemParams
    -> World
    -> Point2
    -> Float
-    -> State StdGen [(Point2,Float,Maybe (Either Creature Wall))]
+    -> State StdGen [ArcStep]
 createArc arcparams@Arcing{_currentArc = Nothing} w p dir = createNewArc arcparams w p dir
 createArc arcparams w p dir = updateArc arcparams w p dir

 createNewArc :: ItemParams -> World -> Point2 -> Float
-    -> State StdGen [(Point2,Float,Maybe (Either Creature Wall))]
+    -> State StdGen [ArcStep]
 createNewArc arcparams w p dir = take (_arcNumber arcparams)
-    <$> unfoldrMID (_newArcStep arcparams arcparams w) (p,dir,Nothing)
+    <$> unfoldrMID (_newArcStep arcparams arcparams w) (ArcStep p dir Nothing)

-defaultArcStep :: RandomGen g => ItemParams -> World -> (Point2,Float,Maybe (Either Creature Wall))
-    -> State g (Maybe (Point2,Float,Maybe (Either Creature Wall)))
-defaultArcStep _     _ (_,_,Just _) = return Nothing
-defaultArcStep itparams w (p,dir,_) = do
+defaultArcStep :: RandomGen g => ItemParams -> World -> ArcStep
+    -> State g (Maybe ArcStep)
+defaultArcStep _     _ (ArcStep _ _ (Just _)) = return Nothing
+defaultArcStep itparams w (ArcStep p dir _) = do
    let csize = _arcSize itparams
-    rot <- takeOne [pi/4,negate pi/4]
+    --rot <- takeOne [pi/4,negate pi/4]
+    rot <- takeOne [0]
    let center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p
    newp <- (center +.+) <$> randInCirc csize
    let mcr = listToMaybe 
@@ -415,17 +429,41 @@ defaultArcStep itparams w (p,dir,_) = do
            . sortOn (dist p . fst)
            . mapMaybe (\ q -> collidePointWallsWall p (center +.+ q) wlsnearpoint)
            $ polyCirc 6 csize
-        f (q,wl) = (q,dir,Just $ Right wl)
-        g cr   = (_crPos cr +.+ csize *.* unitVectorAtAngle dir, dir,Just $ Left cr)
-    return . listToMaybe . sortOn (dist p . (^. _1)) 
-        $ (newp,dir,Nothing) : catMaybes [fmap f mwl,fmap g mcr]
+        f (q,wl) = ArcStep q dir (Just $ Right wl)
+        g cr   = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (Just $ Left cr)
+    return . listToMaybe . sortOn (dist p . (^. asPos))
+        $ ArcStep newp dir Nothing : catMaybes [fmap f mwl,fmap g mcr]

 updateArc :: ItemParams
    -> World
    -> Point2
    -> Float
-    -> State StdGen [(Point2,Float,Maybe (Either Creature Wall))]
-updateArc = createNewArc
+    -> State StdGen [ArcStep]
+updateArc ip w p dir = take (_arcNumber ip) <$> zipArcs ip w (ArcStep p dir Nothing) carc
+  where
+    carc = tail $ fromJust $ _currentArc ip
+
+zipArcs :: ItemParams
+    -> World
+    -> ArcStep
+    -> [ArcStep]
+    -> State StdGen [ArcStep]
+zipArcs ip w x (y:ys) = (x :) <$> do  
+    defaultnext <- _newArcStep ip ip w x
+    case defaultnext of
+        Nothing -> return []
+        Just z@(ArcStep _ _ (Just _)) -> return [z]
+        Just z -> do
+            p <- randInCirc 5
+            let csize = _arcSize ip
+                center = _asPos x +.+ csize *.* unitVectorAtAngle (_asDir x)
+                newp = _asPos y +.+ p
+                --newdir = argV $ newp -.- _asPos x
+                newdir = _asDir x
+            if dist newp center < csize
+                then zipArcs ip w (y & asPos .~ newp & asDir .~ newdir) ys
+                else zipArcs ip w z ys
+zipArcs ip w y _ = createNewArc ip w (_asPos y) (_asDir y)

 shootLaser :: Item -> Creature -> World -> World
 shootLaser it cr = instantParticles .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
@@ -437,8 +475,8 @@ shootLaser it cr = instantParticles .:~ lasRayAt (_lasColor $ _itParams it) dam

 shootDualLaser :: Item -> Creature -> World -> World
 shootDualLaser it cr w = w
-    & newBeams . positronBeams .:~ dualRayAt w (_lasColor $ _itParams it) dam phasev posl dirl
-    & newBeams . electronBeams .:~ dualRayAtNoFlame w (_lasColor2 $ _itParams it) dam phasev posr dirr
+    & newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) w (_lasColor $ _itParams it) dam phasev posl dirl
+    & newBeams . electronBeams .:~ basicBeamAt w (_lasColor2 $ _itParams it) dam phasev posr dirr
  where 
    dir = _crDir cr
    pos = _crPos cr +.+ aimlength *.* unitVectorAtAngle dir
@@ -461,44 +499,49 @@ drawBeam bm = setLayer 1 $ pictures
  where
    col = _bmColor bm
    ps = _bmFirstPoints bm
-    
-dualRayAt :: World -> Color -> Int -> Float -> Point2 -> Float -> Beam
-dualRayAt w col dam phasev pos dir = Beam
+
+basicBeamAt :: World -> Color -> Int -> Float -> Point2 -> Float -> Beam
+basicBeamAt w col dam phasev pos dir = Beam
    { _bmDraw = drawBeam
    , _bmPos = pos
    , _bmDir = dir
    , _bmDamage = dam
--    , _ptUpdate = mvLaser phasev pos dir
    , _bmRange = 800
--    , _ptDamage = dam
    , _bmPhaseV = phasev
    , _bmColor = col
    , _bmPoints = pos:ps
    , _bmFirstPoints = []
-    , _bmType = BeamCombine 
-        $ \(p,(a,b,_),(x,y,_)) -> makeFlame p (2 *.* normalizeV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
+    , _bmType = BeamCombine $ const id
    }
  where
    (_,ps) = reflectLaserAlong phasev [] pos (pos +.+ 800 *.* unitVectorAtAngle dir) w
--    ps = [pos,pos +.+ 800 *.* unitVectorAtAngle dir]
-dualRayAtNoFlame :: World -> Color -> Int -> Float -> Point2 -> Float -> Beam
-dualRayAtNoFlame w col dam phasev pos dir = Beam
-    { _bmDraw = drawBeam
-    , _bmPos = pos
-    , _bmDir = dir
-    , _bmDamage = dam
--    , _ptUpdate = mvLaser phasev pos dir
-    , _bmRange = 800
--    , _ptDamage = dam
-    , _bmPhaseV = phasev
-    , _bmColor = col
-    , _bmPoints = pos:ps
-    , _bmFirstPoints = []
-    , _bmType = BeamCombine 
-        $ const id
-    }
+
+dualRayAt :: BeamType -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
+dualRayAt bt w col dam phasev pos dir = basicBeamAt w col dam phasev pos dir
+    & bmType .~ bt
+
+flameBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
+    -> World -> World
+flameBeamCombine (p,(a,b,_),(x,y,_))
+    = makeFlame p (2 *.* normalizeV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
+
+lasBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
+    -> World -> World
+lasBeamCombine (p,(a,b,_),(x,y,_)) 
+    = instantParticles .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
+
+splitBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
+    -> World -> World
+splitBeamCombine (p,(a,b,_),(x,y,_)) 
+    = (instantParticles .:~ lasRayAt yellow 11 1 p (dir+0.5*pi))
+    . (instantParticles .:~ lasRayAt yellow 11 1 p (dir-0.5*pi))
  where
-    (_,ps) = reflectLaserAlong phasev [] pos (pos +.+ 800 *.* unitVectorAtAngle dir) w
+    dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))
+
+teslaBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
+    -> World -> World
+teslaBeamCombine (p,(a,b,_),(x,y,_)) 
+    = instantParticles .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))

 lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> Particle
 lasRayAt col dam phasev pos dir = LaserParticle
@@ -21,9 +21,9 @@ import Control.Monad.State
 --import Data.List
 --import Data.Maybe

-aTeslaArcAt :: Color -> [(Point2,Float,Maybe (Either Creature Wall))] -> Particle
+aTeslaArcAt :: Color -> [ArcStep] -> Particle
 aTeslaArcAt col thearc = LinearParticle
-    { _ptPoints = map (^. _1) thearc
+    { _ptPoints = map (^. asPos) thearc
    , _ptDraw = drawTeslaArc
    , _ptUpdate = moveTeslaArc thearc
    , _ptTimer = 2
@@ -37,7 +37,7 @@ drawTeslaArc pt = setLayer 1 $ pictures
    ]
  where
    ps = _ptPoints pt
-moveTeslaArc :: [(Point2,Float,Maybe (Either Creature Wall))]
+moveTeslaArc :: [ArcStep]
    -> World
    -> Particle
    -> (World,Maybe Particle)
@@ -52,11 +52,11 @@ moveTeslaArc thearc w pt
    makeaspark = randColDirTimeSpark rcol rdir rtime lp
    makesparks = makeaspark . makeaspark . makeaspark
    (lp,ld) = case last thearc of
-        (lp',ld',Nothing) -> (lp',ld')
-        (lp',ld',Just (Left cr)) -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld',ld'+pi)
-        (lp',ld',Just (Right _)) -> (lp' -.- 2 *.* unitVectorAtAngle ld',ld'+pi)
-    damthings (_,_,Nothing) = id
-    damthings (p,dir,Just crwl) = damageCrWall (thedamage p dir) crwl
+        ArcStep lp' ld' Nothing -> (lp',ld')
+        ArcStep lp' ld' (Just (Left cr)) -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld',ld'+pi)
+        ArcStep lp' ld' (Just (Right _)) -> (lp' -.- 2 *.* unitVectorAtAngle ld',ld'+pi)
+    damthings (ArcStep _ _ Nothing) = id
+    damthings (ArcStep p dir (Just crwl)) = damageCrWall (thedamage p dir) crwl
    thedamage p dir = Damage Electrical 50 (p -.- q) p (p +.+ q) NoDamageEffect
      where
        q = 5 *.* unitVectorAtAngle dir