368 lines
12 KiB
Haskell
368 lines
12 KiB
Haskell
module Dodge.Item.Weapon.BatteryGuns
|
|
( lasGun
|
|
, lasCircle
|
|
, dualBeam
|
|
, lasWide
|
|
, sparkGun
|
|
, teslaGun
|
|
, teslaParams
|
|
, tractorGun
|
|
, lasRayAt
|
|
, flameBeamCombine
|
|
, teslaBeamCombine
|
|
, splitBeamCombine
|
|
, shootTeslaArc
|
|
, shootLaser
|
|
, circleLaser
|
|
, shootDualLaser
|
|
, aTractorBeam
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Reloading.Action
|
|
import Dodge.Tesla
|
|
import Dodge.Beam
|
|
import Dodge.Item.Weapon.LaserPath
|
|
import Dodge.Item.Location
|
|
import Dodge.Creature.HandPos
|
|
import Dodge.Default.Weapon
|
|
import Dodge.Base
|
|
--import Dodge.Zone
|
|
import Geometry
|
|
import Picture
|
|
import LensHelp
|
|
|
|
import qualified IntMapHelp as IM
|
|
import qualified Data.Map.Strict as M
|
|
--import Control.Monad.State
|
|
|
|
defaultBatteryGun :: Item
|
|
defaultBatteryGun = defaultWeapon
|
|
& itType . iyModules .~ batteryModules
|
|
|
|
batteryModules :: M.Map ModuleSlot ItemModuleType
|
|
batteryModules = M.fromList
|
|
[(ModBattery, EMPTYMODULE)
|
|
,(ModTeleport, EMPTYMODULE)
|
|
]
|
|
|
|
defaultAutoBatteryGun :: Item
|
|
defaultAutoBatteryGun = defaultAutoGun
|
|
& itType . iyModules .~ batteryModules
|
|
|
|
sparkGun :: Item
|
|
sparkGun = teslaGun
|
|
& itType . iyBase .~ HELD SPARKGUN
|
|
& itParams . arcSize .~ 10
|
|
teslaGun :: Item
|
|
teslaGun = defaultBatteryGun
|
|
& itConsumption . laMax .~ 200
|
|
& itConsumption . laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
|
|
& itDimension . dimRad .~ 9
|
|
& itDimension . dimCenter .~ V3 4 0 0
|
|
& itParams .~ teslaParams
|
|
& itUse . rUse .~ HeldTeslaArc --shootTeslaArc
|
|
& itUse . useDelay .~ NoDelay
|
|
& itUse . useMods .~ TeslaMod
|
|
& itUse . useAim . aimWeight .~ 6
|
|
& itUse . useAim . aimStance .~ TwoHandFlat
|
|
& itUse . useAim . aimHandlePos .~ 4
|
|
& itUse . useAim . aimMuzPos .~ 4
|
|
& itType . iyBase .~ HELD TESLAGUN
|
|
--lasPulse :: Item
|
|
--lasPulse = lasGun
|
|
-- & itType . iyBase .~ LASPULSE
|
|
-- & itUse . useMods .~
|
|
-- [ ammoCheckI
|
|
-- , withItem $ \it -> withTempLight 1 (100 * frac it) (xyzV4 (_lasColor $ _itParams it))
|
|
-- , withItem $ \it -> withSoundForVol (frac it) tone440sawtoothquietS 2
|
|
-- , withItemUpdate itup
|
|
-- $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) (frac it * 0.8)
|
|
-- , useAmmoAmount 1
|
|
-- ]
|
|
-- where
|
|
-- itup it = it
|
|
-- & itParams . lasCycle %~ (\i -> (i+1) `mod` 20)
|
|
-- & itParams . lasDamage .~ ceiling ((22 :: Float) * frac it)
|
|
-- & itParams . lasColor .~ frac it * orange
|
|
-- frac it = 0.5 * (1 + sin (pi * fromIntegral (_lasCycle $ _itParams it) * 0.1))
|
|
|
|
lasCircle :: Item
|
|
lasCircle = lasGun
|
|
& itType . iyBase .~ HELD LASCIRCLE
|
|
& itParams . lasColor .~ orange
|
|
& itParams . lasDamage .~ 2
|
|
& itConsumption . laMax .~ 10000
|
|
& itUse . rUse .~ HeldLaser --shootLaser
|
|
& itUse . useDelay .~ NoDelay
|
|
& itUse . rUse .~ HeldCircleLaser --circleLaser
|
|
& itUse . useMods .~ CircleLaserMod
|
|
& itUse . useAim . aimWeight .~ 6
|
|
& itUse . useAim . aimRange .~ 1
|
|
& itUse . useAim . aimStance .~ TwoHandTwist
|
|
|
|
lasWide :: Int -> Item
|
|
lasWide n = lasGun
|
|
& itType . iyBase .~ HELD (LASWIDE n)
|
|
& itParams . lasColor .~ yellow
|
|
& itParams . lasDamage .~ 2
|
|
& itUse . useMods .~ LasWideMod n
|
|
--lasWidePulse :: Item
|
|
--lasWidePulse = lasGun
|
|
-- & itType . iyBase .~ LASGUNWIDEPULSE
|
|
-- & itParams . lasColor .~ orange
|
|
-- & itParams . lasDamage .~ 2
|
|
-- & itUse .~ ( ruseInstant shootLaser
|
|
-- [ ammoCheckI
|
|
-- , withItem $ \it -> withTempLight 1 (100 * frac it) (xyzV4 (_lasColor $ _itParams it))
|
|
-- , withItem $ \it -> withSoundForVol (frac it) tone440sawtoothquietS 2
|
|
-- , withItemUpdate itup
|
|
-- $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) (frac it * 0.8)
|
|
-- , useAmmoAmount 1
|
|
-- , withItemUpdate itup $ \it -> duplicateOffsets (xs it)
|
|
-- ]
|
|
-- & useAim . aimWeight .~ 6
|
|
-- & useAim . aimRange .~ 1
|
|
-- & useAim . aimStance .~ TwoHandTwist
|
|
-- )
|
|
-- where
|
|
-- itup it = it
|
|
-- & itParams . lasCycle %~ (\i -> (i+1) `mod` 40)
|
|
-- & itParams . lasDamage .~ ceiling ((22 :: Float) * frac it)
|
|
-- & itParams . lasColor .~ frac it * orange
|
|
-- frac it = 0.5 * (1 + sin (pi * fromIntegral (_lasCycle $ _itParams it) * 0.05))
|
|
-- xs it = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ]
|
|
-- where
|
|
-- n' = (ceiling $ (150 :: Float) * frac it) :: Int
|
|
--lasSway :: Item
|
|
--lasSway = lasGun
|
|
-- & itType . iyBase .~ LASGUNSWAY
|
|
-- & itParams . lasColor .~ orange
|
|
-- & itParams . lasDamage .~ 11
|
|
-- & itUse .~ ( ruseInstant shootLaser
|
|
-- [ ammoCheckI
|
|
-- , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
|
|
-- , withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
|
-- , withSoundForI tone440sawtoothquietS 2
|
|
-- , useAmmoAmount 1
|
|
-- , withItemUpdate itup $ \it -> duplicateOffsets (x it)
|
|
-- ]
|
|
-- & useAim . aimWeight .~ 6
|
|
-- & useAim . aimRange .~ 1
|
|
-- & useAim . aimStance .~ TwoHandTwist
|
|
-- )
|
|
-- where
|
|
-- itup = itParams . lasCycle %~ (\i -> (i+1) `mod` 40)
|
|
-- x it = [ 15 * sin (pi * fromIntegral x' * 0.05) ]
|
|
-- where
|
|
-- x' = _lasCycle $ _itParams it
|
|
--lasFocus :: Int -> Item
|
|
--lasFocus n = lasGunWide n
|
|
-- & itType . iyBase .~ LASGUNFOCUS n
|
|
-- & itParams . lasColor .~ red
|
|
-- & itUse . useMods .~
|
|
-- [ ammoCheckI
|
|
-- , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
|
|
-- , withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
|
-- , withSoundForI tone440sawtoothquietS 2
|
|
-- , useAmmoAmount 1
|
|
-- , duplicateOffsetsFocus xs
|
|
-- ]
|
|
-- where
|
|
-- n' = 9 * n
|
|
-- xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ]
|
|
|
|
dualBeam :: Item
|
|
dualBeam = lasGun
|
|
& itType . iyBase .~ HELD DUALBEAM
|
|
& itUse . useAim . aimMuzPos .~ 0
|
|
& itParams .~ DualBeam
|
|
{ _phaseV = 1
|
|
, _lasColor = red
|
|
, _lasColor2 = green
|
|
, _lasCycle = 0
|
|
, _lasDamage = 11
|
|
, _lasBeam = BeamCombine LasBeamCombine
|
|
, _subParams = Nothing
|
|
, _dbGap = 20
|
|
}
|
|
& itUse . rUse .~ HeldDualLaser --shootDualLaser
|
|
& itUse . useDelay .~ NoDelay
|
|
& itUse . useMods .~ DualBeamMod
|
|
& itUse . useAim . aimWeight .~ 6
|
|
& itUse . useAim . aimRange .~ 1
|
|
& itUse . useAim . aimStance .~ TwoHandFlat
|
|
& itType . iyModules . at ModDualBeam ?~ EMPTYMODULE
|
|
--lasSwing :: Item
|
|
--lasSwing = lasGun
|
|
-- & itType . iyBase .~ LASGUNSWING
|
|
-- & itParams . lasColor .~ orange
|
|
-- & itUse . useMods .~
|
|
-- [ ammoCheckI
|
|
-- , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
|
|
-- , withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
|
-- , withSoundForI tone440sawtoothquietS 2
|
|
-- , useAmmoAmount 1
|
|
-- , withItemUpdate itup $ \it -> duplicateOffsetsFocus (x it)
|
|
-- ]
|
|
-- where
|
|
-- itup = itParams . lasCycle %~ (\i -> (i+1) `mod` 200)
|
|
-- x it = [-y,y]
|
|
-- where
|
|
-- y = 15 * sin (pi * fromIntegral x' * 0.01)
|
|
-- x' = _lasCycle $ _itParams it
|
|
lasGun :: Item
|
|
lasGun = defaultAutoBatteryGun
|
|
& itConsumption .~ ( defaultLoadable
|
|
& laMax .~ 200
|
|
& laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
|
|
)
|
|
& itParams .~ Refracting
|
|
{ _phaseV = 1
|
|
, _lasColor = yellow
|
|
, _lasColor2 = yellow
|
|
, _lasCycle = 0
|
|
, _lasDamage = 11
|
|
}
|
|
& itTweaks .~ Tweakable
|
|
{ _tweakParams = IM.fromList [(0,lasGunTweak)]
|
|
, _tweakSel = 0
|
|
}
|
|
& itDimension . dimRad .~ 10
|
|
& itDimension . dimCenter .~ V3 15 0 0
|
|
& itUse . rUse .~ HeldLaser --shootLaser
|
|
& itUse . useDelay .~ NoDelay
|
|
& itUse . useMods .~ LasMod
|
|
& itUse . useAim . aimWeight .~ 6
|
|
& itUse . useAim . aimRange .~ 1
|
|
& itUse . useAim . aimStance .~ TwoHandTwist
|
|
& itUse . useAim . aimHandlePos .~ 5
|
|
& itUse . useAim . aimMuzPos .~ 30
|
|
& itType . iyBase .~ HELD LASGUN
|
|
|
|
lasGunTweak :: TweakParam
|
|
lasGunTweak = TweakParam
|
|
{ _tweakType = TweakPhaseV
|
|
, _tweakVal = 1
|
|
, _tweakMax = 3
|
|
}
|
|
tractorGun :: Item
|
|
tractorGun = lasGun
|
|
& itConsumption .~
|
|
( defaultLoadable
|
|
& laMax .~ 10000
|
|
& laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60] )
|
|
& itParams .~ Attracting {_attractionPower = 1}
|
|
& itTweaks .~ Tweakable
|
|
{ _tweakParams = IM.fromList [(0,tractorGunTweak)]
|
|
, _tweakSel = 0
|
|
}
|
|
& itUse . rUse .~ HeldTractor --aTractorBeam
|
|
& itUse . useDelay .~ NoDelay
|
|
& itUse . useMods .~ AmmoCheckMod
|
|
& itUse . useAim . aimWeight .~ 6
|
|
& itUse . useAim . aimRange .~ 1
|
|
& itUse . useAim . aimStance .~ TwoHandTwist
|
|
& itUse . useAim . aimHandlePos .~ 5
|
|
& itUse . useAim . aimMuzPos .~ 30
|
|
& itType . iyBase .~ HELD TRACTORGUN
|
|
|
|
tractorGunTweak :: TweakParam
|
|
tractorGunTweak = TweakParam
|
|
{ _tweakType = TweakTractionPower
|
|
, _tweakVal = 1
|
|
, _tweakMax = 4
|
|
}
|
|
|
|
-- | assumes that the item is held
|
|
shootTeslaArc :: Item -> Creature -> World -> World
|
|
shootTeslaArc it cr w = w'
|
|
& cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itParams .~ ip
|
|
where
|
|
(w',ip) = shootTeslaArc' (_itParams it) pos dir w
|
|
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
|
|
dir = _crDir cr
|
|
|
|
shootLaser :: Item -> Creature -> World -> World
|
|
shootLaser it cr = cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
|
|
where
|
|
pos = _crPos cr
|
|
dir = _crDir cr
|
|
phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr
|
|
dam = _lasDamage $ _itParams it
|
|
|
|
-- this has the feel of a left click item
|
|
circleLaser :: Item -> Creature -> World -> World
|
|
circleLaser it cr w
|
|
| hasLOSIndirect cpos pos w = w
|
|
& cWorld . lasers .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
|
|
| otherwise = w
|
|
where
|
|
cpos = _crPos cr
|
|
mwp = mouseWorldPos w
|
|
pos = _crPos cr +.+ rotateV dir (V2 0 (max 70 $ dist cpos mwp))
|
|
dir = fromIntegral (_lasCycle (_itParams it)) * pi / 1000
|
|
phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr
|
|
dam = _lasDamage $ _itParams it
|
|
|
|
shootDualLaser :: Item -> Creature -> World -> World
|
|
shootDualLaser it cr w = w'
|
|
& cWorld . newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl
|
|
& cWorld . newBeams . electronBeams .:~ basicBeamAt itid w (_lasColor2 $ _itParams it) dam phasev posr dirr
|
|
where
|
|
(w',itid) = getHeldItemLoc cr w
|
|
dir = _crDir cr
|
|
pos = _crPos cr +.+ aimlength *.* unitVectorAtAngle dir
|
|
aimlength = aimingMuzzlePos cr it
|
|
gap = _dbGap . _itParams $ it
|
|
posl = pos +.+ (-gap) *.* vNormal (unitVectorAtAngle dir)
|
|
posr = pos +.+ gap *.* vNormal (unitVectorAtAngle dir)
|
|
mwp = mouseWorldPos w
|
|
mwp' | dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir
|
|
| otherwise = mwp
|
|
dirl = argV $ mwp' -.- posl
|
|
dirr = argV $ mwp' -.- posr
|
|
phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr
|
|
dam = _lasDamage $ _itParams it
|
|
|
|
basicBeamAt :: Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
|
|
basicBeamAt itid w col dam phasev pos dir = Beam
|
|
{ _bmDraw = BasicBeamDraw --drawBeam
|
|
, _bmPos = pos
|
|
, _bmDir = dir
|
|
, _bmDamage = dam
|
|
, _bmRange = 800
|
|
, _bmPhaseV = phasev
|
|
, _bmColor = col
|
|
, _bmPoints = pos:ps
|
|
, _bmFirstPoints = []
|
|
, _bmOrigin = Just itid
|
|
, _bmType = BeamCombine NoBeamCombine
|
|
}
|
|
where
|
|
(_,ps) = reflectLaserAlong phasev pos (pos +.+ 800 *.* unitVectorAtAngle dir) w
|
|
|
|
dualRayAt :: BeamType -> Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
|
|
dualRayAt bt itid w col dam phasev pos dir = basicBeamAt itid w col dam phasev pos dir
|
|
& bmType .~ bt
|
|
|
|
aTractorBeam :: Item -> Creature -> World -> World
|
|
aTractorBeam _ cr w = w & cWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power
|
|
where
|
|
cpos = _crPos cr
|
|
spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
|
|
xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
|
|
dir = _crDir cr
|
|
outpos = fst $ collidePointWallsFilterStream (const True) cpos xpos w
|
|
power = _attractionPower . _itParams $ _crInv cr IM.! crSel cr
|
|
|
|
tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
|
|
tractorBeamAt pos outpos dir power = TractorBeam
|
|
{ _tbPos = pos
|
|
, _tbStartPos = outpos
|
|
, _tbVel = d
|
|
, _tbTime = 10
|
|
}
|
|
where
|
|
d = unitVectorAtAngle dir * power
|
|
|