Tweak tesla gun
This commit is contained in:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user