Tweak tesla gun

src/Dodge/Combine/Combinations.hs

@@ -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
-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.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] ]

src/Dodge/Creature.hs

@@ -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

src/Dodge/Data.hs

@@ -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))
+            -> ArcStep
-            -> State StdGen (Maybe (Point2,Float,Maybe (Either Creature Wall)))
+            -> 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

src/Dodge/Default/Weapon.hs

@@ -103,6 +103,7 @@ defaultGun = Item
         [(ModBullet, DefaultModule)
         ,(ModTarget, DefaultModule)
         ,(ModBulletTrajectory, DefaultModule)
+        ,(ModTeleport, DefaultModule)
         ]
     , _itScope = NoScope
     , _itTargeting = NoTargeting

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -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 .~ DualBeam
-    & itParams . lasColor2 .~ blue
+        { _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))
+defaultArcStep :: RandomGen g => ItemParams -> World -> ArcStep
-    -> State g (Maybe (Point2,Float,Maybe (Either Creature Wall)))
+    -> State g (Maybe ArcStep)
-defaultArcStep _     _ (_,_,Just _) = return Nothing
+defaultArcStep _     _ (ArcStep _ _ (Just _)) = return Nothing
-defaultArcStep itparams w (p,dir,_) = do
+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)
+        f (q,wl) = ArcStep q dir (Just $ Right wl)
-        g cr   = (_crPos cr +.+ csize *.* unitVectorAtAngle dir, dir,Just $ Left cr)
+        g cr   = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (Just $ Left cr)
-    return . listToMaybe . sortOn (dist p . (^. _1)) 
+    return . listToMaybe . sortOn (dist p . (^. asPos))
-        $ (newp,dir,Nothing) : catMaybes [fmap f mwl,fmap g mcr]
+        $ ArcStep newp dir Nothing : catMaybes [fmap f mwl,fmap g mcr]
 
 updateArc :: ItemParams
     -> World
     -> Point2
     -> Float
-    -> State StdGen [(Point2,Float,Maybe (Either Creature Wall))]
+    -> State StdGen [ArcStep]
-updateArc = createNewArc
+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 . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) w (_lasColor $ _itParams it) dam phasev posl dirl
-    & newBeams . electronBeams .:~ dualRayAtNoFlame w (_lasColor2 $ _itParams it) dam phasev posr dirr
+    & 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
+basicBeamAt :: World -> Color -> Int -> Float -> Point2 -> Float -> Beam
-dualRayAt w col dam phasev pos dir = 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 
+    , _bmType = BeamCombine $ const id
-        $ \(p,(a,b,_),(x,y,_)) -> makeFlame p (2 *.* normalizeV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
     }
   where
     (_,ps) = reflectLaserAlong phasev [] pos (pos +.+ 800 *.* unitVectorAtAngle dir) w
---    ps = [pos,pos +.+ 800 *.* unitVectorAtAngle dir]
+
-dualRayAtNoFlame :: World -> Color -> Int -> Float -> Point2 -> Float -> Beam
+dualRayAt :: BeamType -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
-dualRayAtNoFlame w col dam phasev pos dir = Beam
+dualRayAt bt w col dam phasev pos dir = basicBeamAt w col dam phasev pos dir
-    { _bmDraw = drawBeam
+    & bmType .~ bt
-    , _bmPos = pos
+
-    , _bmDir = dir
+flameBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-    , _bmDamage = dam
+    -> World -> World
---    , _ptUpdate = mvLaser phasev pos dir
+flameBeamCombine (p,(a,b,_),(x,y,_))
-    , _bmRange = 800
+    = makeFlame p (2 *.* normalizeV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
---    , _ptDamage = dam
+
-    , _bmPhaseV = phasev
+lasBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-    , _bmColor = col
+    -> World -> World
-    , _bmPoints = pos:ps
+lasBeamCombine (p,(a,b,_),(x,y,_)) 
-    , _bmFirstPoints = []
+    = instantParticles .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
-    , _bmType = BeamCombine 
+
-        $ const id
+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

src/Dodge/Particle/TeslaArc.hs

@@ -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')
+        ArcStep lp' ld' Nothing -> (lp',ld')
-        (lp',ld',Just (Left cr)) -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld',ld'+pi)
+        ArcStep lp' ld' (Just (Left cr)) -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld',ld'+pi)
-        (lp',ld',Just (Right _)) -> (lp' -.- 2 *.* unitVectorAtAngle ld',ld'+pi)
+        ArcStep lp' ld' (Just (Right _)) -> (lp' -.- 2 *.* unitVectorAtAngle ld',ld'+pi)
-    damthings (_,_,Nothing) = id
+    damthings (ArcStep _ _ Nothing) = id
-    damthings (p,dir,Just crwl) = damageCrWall (thedamage p dir) crwl
+    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