678 lines
22 KiB
Haskell
678 lines
22 KiB
Haskell
module Dodge.Item.Weapon.BatteryGuns
|
|
( lasGun
|
|
, lasGunDual
|
|
, lasGunWide
|
|
, lasGunWidePulse
|
|
, lasGunSway
|
|
, lasGunSwing
|
|
, lasGunFocus
|
|
, lasGunPulse
|
|
, sparkGun
|
|
, teslaGun
|
|
, teslaParams
|
|
, tractorGun
|
|
, lasRayAt
|
|
, flameBeamCombine
|
|
, teslaBeamCombine
|
|
, splitBeamCombine
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Item.Weapon.LaserPath
|
|
import Dodge.Item.Location
|
|
import Dodge.Creature.HandPos
|
|
import Dodge.Particle.TeslaArc
|
|
import Dodge.Particle.Flame
|
|
import Dodge.SoundLogic.LoadSound
|
|
import Dodge.WorldEvent.Flash
|
|
import Dodge.WorldEvent.Damage
|
|
--import Dodge.Default
|
|
--import Dodge.Item.Weapon.InventoryDisplay
|
|
import Dodge.Item.Weapon.TriggerType
|
|
import Dodge.Item.Weapon.AmmoParams
|
|
import Dodge.Default.Weapon
|
|
--import Dodge.Item.Attachment
|
|
import Dodge.WorldEvent.HelperParticle
|
|
import Dodge.Base
|
|
import Dodge.Zone
|
|
import Geometry
|
|
import Picture
|
|
import Shape
|
|
import ShapePicture
|
|
import LensHelp
|
|
import Dodge.RandomHelp
|
|
import MonadHelp
|
|
|
|
import Data.Maybe
|
|
import Data.List (sortOn)
|
|
import System.Random
|
|
--import Data.Tuple
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.Map.Strict as M
|
|
import Control.Monad.State
|
|
|
|
defaultBatteryGun :: Item
|
|
defaultBatteryGun = defaultGun
|
|
& itModules .~ batteryModules
|
|
|
|
batteryModules :: M.Map ModuleSlot ItemModule
|
|
batteryModules = M.fromList
|
|
[(ModBattery, DefaultModule)
|
|
,(ModTeleport, DefaultModule)
|
|
]
|
|
|
|
defaultAutoBatteryGun :: Item
|
|
defaultAutoBatteryGun = defaultAutoGun
|
|
& itModules .~ batteryModules
|
|
|
|
sparkGun :: Item
|
|
sparkGun = teslaGun
|
|
& itName .~ "SPARKGUN"
|
|
& itType .~ SPARKGUN
|
|
& itParams . arcSize .~ 10
|
|
teslaGun :: Item
|
|
teslaGun = defaultBatteryGun
|
|
{ _itName = "TESLA"
|
|
, _itType = TESLAGUN
|
|
, _itConsumption = defaultAmmo
|
|
{ _ammoBaseMax = 200
|
|
, _ammoLoaded = 200
|
|
, _reloadTime = 80
|
|
}
|
|
, _itUse = ruseInstant shootTeslaArc NoHammer
|
|
[ ammoCheckI
|
|
, withTempLight 1 100 (V3 0 0 1)
|
|
, withSoundForI elecCrackleS 1
|
|
, useAmmoAmount 1
|
|
]
|
|
& useAim . aimSpeed .~ 0.4
|
|
& useAim . aimStance .~ TwoHandFlat
|
|
, _itDimension = ItemDimension
|
|
{ _dimRad = 9
|
|
, _dimCenter = V3 4 0 0
|
|
, _dimPortage = HeldItem
|
|
{_handlePos = 4
|
|
,_muzPos = 4
|
|
}
|
|
, _dimSPic = teslaGunPic
|
|
}
|
|
, _itParams = teslaParams
|
|
}
|
|
teslaParams :: ItemParams
|
|
teslaParams = Arcing
|
|
{ _currentArc = Nothing
|
|
, _arcSize = 20
|
|
, _arcNumber = 10
|
|
, _newArcStep = defaultArcStep
|
|
, _previousArcEffect = NoPreviousArcEffect
|
|
}
|
|
teslaGunPic :: Item -> SPic
|
|
teslaGunPic _ = noPic $ colorSH blue $
|
|
upperPrismPoly 5 (rectNESW xb 8 xa 0)
|
|
++ upperPrismPoly 5 (rectNESW (-xa) 8 (-xb) 0)
|
|
where
|
|
xa = 1
|
|
xb = 9
|
|
lasGunPulse :: Item
|
|
lasGunPulse = lasGun
|
|
& itName .~ "PULSELAS"
|
|
& itType .~ 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))
|
|
|
|
|
|
lasGunWide :: Int -> Item
|
|
lasGunWide n = lasGun
|
|
& itName .~ "PARALELLAS"++show n
|
|
& itType .~ LASGUNWIDE n
|
|
& itParams . lasColor .~ orange
|
|
& itParams . lasDamage .~ 2
|
|
& itUse .~ ( ruseInstant shootLaser NoHammer
|
|
[ ammoCheckI
|
|
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
|
|
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
|
, withSoundForI tone440sawtoothquietS 2
|
|
, useAmmoAmount 1
|
|
, duplicateOffsets xs
|
|
]
|
|
& useAim . aimSpeed .~ 0.4
|
|
& useAim . aimRange .~ 1
|
|
& useAim . aimStance .~ TwoHandTwist
|
|
)
|
|
where
|
|
n' = 9 * n
|
|
xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2) | x <- [0..n'-1] ]
|
|
lasGunWidePulse :: Item
|
|
lasGunWidePulse = lasGun
|
|
& itName .~ "LASWIDEPULSE"
|
|
& itType .~ LASGUNWIDEPULSE
|
|
& itParams . lasColor .~ orange
|
|
& itParams . lasDamage .~ 2
|
|
& itUse .~ ( ruseInstant shootLaser NoHammer
|
|
[ 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 . aimSpeed .~ 0.4
|
|
& 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
|
|
lasGunSway :: Item
|
|
lasGunSway = lasGun
|
|
& itName .~ "SWAYLAS"
|
|
& itType .~ LASGUNSWAY
|
|
& itParams . lasColor .~ orange
|
|
& itParams . lasDamage .~ 11
|
|
& itUse .~ ( ruseInstant shootLaser NoHammer
|
|
[ 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 . aimSpeed .~ 0.4
|
|
& 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
|
|
lasGunFocus :: Int -> Item
|
|
lasGunFocus n = lasGunWide n
|
|
& itName .~ "FOCALAS"++show n
|
|
& itType .~ 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] ]
|
|
|
|
lasGunDual :: Item
|
|
lasGunDual = lasGun
|
|
& itName .~ "DUALAS"
|
|
& itType .~ LASGUNDUAL
|
|
& itParams .~ DualBeam
|
|
{ _phaseV = 1
|
|
, _lasColor = orange
|
|
, _lasColor2 = blue
|
|
, _lasCycle = 0
|
|
, _lasDamage = 11
|
|
, _lasBeam = BeamCombine lasBeamCombine
|
|
, _subParams = Nothing
|
|
}
|
|
& itUse .~ (ruseInstant shootDualLaser NoHammer
|
|
[ ammoCheckI
|
|
-- , withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
|
|
, withItem $ \it -> withMuzPosShift (V2 0 10) $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
|
, withItem $ \it -> withMuzPosShift (V2 0 (-10)) $ flareCircleAt (_lasColor2 $ _itParams it) 0.8
|
|
, withSoundForI tone440sawtoothquietS 2
|
|
, useAmmoAmount 1
|
|
]
|
|
& useAim . aimSpeed .~ 0.4
|
|
& useAim . aimRange .~ 1
|
|
& useAim . aimStance .~ TwoHandTwist
|
|
)
|
|
& itModules . at ModDualBeam ?~ DefaultModule
|
|
lasGunSwing :: Item
|
|
lasGunSwing = lasGun
|
|
& itName .~ "SWINGLAS"
|
|
& itType .~ 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
|
|
{ _itName = "LASGUN"
|
|
, _itType = LASGUN
|
|
, _itConsumption = defaultAmmo
|
|
{ _ammoBaseMax = 200
|
|
, _ammoLoaded = 200
|
|
, _reloadTime = 80
|
|
}
|
|
, _itUse = ruseInstant shootLaser NoHammer
|
|
[ ammoCheckI
|
|
, withItem $ \it -> withTempLight 1 100 (xyzV4 (_lasColor $ _itParams it))
|
|
, withSoundForI tone440sawtoothquietS 2
|
|
, withItem $ \it -> withMuzPos $ flareCircleAt (_lasColor $ _itParams it) 0.8
|
|
, useAmmoAmount 1
|
|
]
|
|
& useAim . aimSpeed .~ 0.4
|
|
& useAim . aimRange .~ 1
|
|
& useAim . aimStance .~ TwoHandTwist
|
|
, _itParams = Refracting
|
|
{ _phaseV = 1
|
|
, _lasColor = yellow
|
|
, _lasColor2 = yellow
|
|
, _lasCycle = 0
|
|
, _lasDamage = 11
|
|
}
|
|
, _itTweaks = Tweakable
|
|
{ _tweakParams = IM.fromList [(0,lasGunTweak)]
|
|
, _tweakSel = 0
|
|
}
|
|
, _itDimension = ItemDimension
|
|
{ _dimRad = 10
|
|
, _dimCenter = V3 15 0 0
|
|
, _dimPortage = HeldItem 5 30
|
|
, _dimSPic = lasGunPic
|
|
}
|
|
}
|
|
lasGunPic :: Item -> SPic
|
|
lasGunPic it =
|
|
( colorSH blue $
|
|
upperPrismPoly 4 (rectNESW 3 30 1 0)
|
|
<> upperPrismPoly 4 (rectNESW (-1) 30 (-3) 0)
|
|
<> upperPrismPoly 1 (rectNESW 3 30 (-3) 0)
|
|
, setLayer BloomNoZWrite . color col . setDepth 1.1 . polygon $ rectNESW 1 30 (-1) 0
|
|
)
|
|
where
|
|
amFrac = fractionLoadedAmmo it
|
|
col = brightX 2 1.5 $ mixColors amFrac (1-amFrac) green red
|
|
|
|
lasGunTweak :: TweakParam
|
|
lasGunTweak = TweakParam
|
|
{ _doTweak = thetweak
|
|
, _curTweak = 1
|
|
, _maxTweak = 3
|
|
, _showTweak = showPhaseV
|
|
, _nameTweak = "PHASE VELOCITY"
|
|
}
|
|
where
|
|
thetweak 0 = itParams . phaseV .~ 0.2
|
|
thetweak 1 = itParams . phaseV .~ 1
|
|
thetweak 2 = itParams . phaseV .~ 5
|
|
thetweak _ = id
|
|
showPhaseV 0 = "V"
|
|
showPhaseV 1 = "/"
|
|
showPhaseV 2 = "Z"
|
|
showPhaseV i = "THIS SHOULD NOT BE POSSIBLE" ++ show i
|
|
|
|
tractorGun :: Item
|
|
tractorGun = lasGun
|
|
{ _itName = "TRACTORGUN"
|
|
, _itType = TRACTORGUN
|
|
, _itConsumption = defaultAmmo
|
|
{ _ammoBaseMax = 10000
|
|
, _ammoLoaded = 10000
|
|
, _reloadTime = 40
|
|
}
|
|
, _itUse = ruseInstant aTractorBeam NoHammer
|
|
[ ammoCheckI
|
|
]
|
|
& useAim . aimSpeed .~ 0.4
|
|
& useAim . aimRange .~ 1
|
|
& useAim . aimStance .~ TwoHandTwist
|
|
, _itDimension = ItemDimension
|
|
{ _dimRad = 10
|
|
, _dimCenter = V3 15 0 0
|
|
, _dimPortage = HeldItem 5 30
|
|
, _dimSPic = tractorGunPic
|
|
}
|
|
, _itParams = Attracting {_attractionPower = 1}
|
|
, _itTweaks = Tweakable
|
|
{ _tweakParams = IM.fromList [(0,tractorGunTweak)]
|
|
, _tweakSel = 0
|
|
}
|
|
}
|
|
tractorGunTweak :: TweakParam
|
|
tractorGunTweak = TweakParam
|
|
{ _doTweak = thetweak
|
|
, _curTweak = 1
|
|
, _maxTweak = 4
|
|
, _showTweak = showPower
|
|
, _nameTweak = "TRACTION POWER"
|
|
}
|
|
where
|
|
thetweak 0 = itParams . attractionPower .~ 1
|
|
thetweak 1 = itParams . attractionPower .~ -1
|
|
thetweak 2 = itParams . attractionPower .~ -10
|
|
thetweak 3 = itParams . attractionPower .~ 0
|
|
thetweak _ = id
|
|
showPower 0 = "+"
|
|
showPower 1 = "-"
|
|
showPower 2 = "#"
|
|
showPower 3 = "0" -- object should stay in the center of the beam
|
|
showPower i = "THIS SHOULD NOT BE POSSIBLE" ++ show i
|
|
|
|
tractorGunPic :: Item -> SPic
|
|
tractorGunPic it =
|
|
( colorSH red $
|
|
upperPrismPoly 4 (rectNESW 3 30 1 0)
|
|
<> upperPrismPoly 4 (rectNESW (-1) 30 (-3) 0)
|
|
<> upperPrismPoly 1 (rectNESW 3 30 (-3) 0)
|
|
, setLayer BloomNoZWrite . color col . setDepth 1.1 . polygon $ rectNESW 1 30 (-1) 0
|
|
)
|
|
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'
|
|
& creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itParams .~ ip
|
|
where
|
|
(w',ip) = shootTeslaArc' (_itParams it) pos dir w
|
|
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
|
|
dir = _crDir cr
|
|
|
|
shootTeslaArc' :: ItemParams -> Point2 -> Float -> World -> (World,ItemParams)
|
|
shootTeslaArc' ip pos dir w =
|
|
(w & randGen .~ g
|
|
& instantParticles .:~ aTeslaArcAt col newarc
|
|
, ip & currentArc ?~ newarc
|
|
)
|
|
where
|
|
(col,g) = takeOne [white,azure,blue,cyan] & runState $ _randGen w
|
|
newarc = createArc ip w pos dir & evalState $ _randGen w
|
|
|
|
|
|
createArc :: ItemParams
|
|
-> World
|
|
-> Point2
|
|
-> Float
|
|
-> 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 [ArcStep]
|
|
createNewArc arcparams w p dir = take (_arcNumber arcparams)
|
|
<$> unfoldrMID (_newArcStep arcparams arcparams w) (ArcStep p dir Nothing)
|
|
|
|
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 [0]
|
|
let center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p
|
|
newp <- (center +.+) <$> randInCirc csize
|
|
let mcr = listToMaybe
|
|
. sortOn (dist center . _crPos)
|
|
. filter (\cr -> dist center (_crPos cr) < csize)
|
|
. IM.elems
|
|
$ _creatures w
|
|
wlsnearpoint = wallsNearPoint p w
|
|
mwl = listToMaybe
|
|
. sortOn (dist p . fst)
|
|
. mapMaybe (\ q -> collidePointWallsWall p (center +.+ q) wlsnearpoint)
|
|
$ polyCirc 6 csize
|
|
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 [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
|
|
where
|
|
pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
|
|
dir = _crDir cr
|
|
phasev = _phaseV . _itParams $ _crInv cr IM.! _crInvSel cr
|
|
dam = _lasDamage $ _itParams it
|
|
|
|
|
|
shootDualLaser :: Item -> Creature -> World -> World
|
|
shootDualLaser it cr w = w'
|
|
& newBeams . positronBeams .:~ dualRayAt (_lasBeam $ _itParams it) itid w (_lasColor $ _itParams it) dam phasev posl dirl
|
|
& 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
|
|
posl = pos +.+ (-10) * vNormal (unitVectorAtAngle dir)
|
|
posr = pos +.+ 10 * 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.! _crInvSel cr
|
|
dam = _lasDamage $ _itParams it
|
|
|
|
drawBeam :: Beam -> Picture
|
|
drawBeam bm = setLayer BloomNoZWrite $ pictures
|
|
[ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 20 ps
|
|
, setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 ps
|
|
]
|
|
where
|
|
col = _bmColor bm
|
|
ps = _bmFirstPoints bm
|
|
|
|
basicBeamAt :: Int -> World -> Color -> Int -> Float -> Point2 -> Float -> Beam
|
|
basicBeamAt itid w col dam phasev pos dir = Beam
|
|
{ _bmDraw = drawBeam
|
|
, _bmPos = pos
|
|
, _bmDir = dir
|
|
, _bmDamage = dam
|
|
, _bmRange = 800
|
|
, _bmPhaseV = phasev
|
|
, _bmColor = col
|
|
, _bmPoints = pos:ps
|
|
, _bmFirstPoints = []
|
|
, _bmOrigin = Just itid
|
|
, _bmType = BeamCombine $ const id
|
|
}
|
|
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
|
|
|
|
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
|
|
dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))
|
|
|
|
teslaBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
|
|
-> World -> World
|
|
teslaBeamCombine (p,(a,b,bm),(x,y,_)) w
|
|
= w' & pointToItem (_itemPositions w IM.! itid) . itParams . subParams ?~ ip
|
|
where
|
|
itid = fromJust $ _bmOrigin bm
|
|
dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))
|
|
(w',ip) = shootTeslaArc' (fromJust . _subParams $ _itParams it) p dir w
|
|
it = case getItem itid w of
|
|
Nothing -> error "tried to get item use teslaBeamCombine that doesn't exist"
|
|
Just itm -> itm
|
|
|
|
lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> Particle
|
|
lasRayAt col dam phasev pos dir = LaserParticle
|
|
{ _ptDraw = const blank
|
|
, _ptUpdate = mvLaser phasev pos dir
|
|
, _ptRange = 800
|
|
, _ptDamage = dam
|
|
, _ptPhaseV = phasev
|
|
, _ptColor = col
|
|
}
|
|
mvLaser :: Float -- ^ Phase velocity, controls deflection through windows
|
|
-> Point2
|
|
-> Float
|
|
-> World
|
|
-> Particle
|
|
-> (World, Maybe Particle)
|
|
mvLaser phasev pos dir w pt
|
|
= ( damThingHitWith (\p1 p2 p3 -> Damage Lasering dam p1 p2 p3 NoDamageEffect) pos xp thHit w
|
|
, Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 }
|
|
)
|
|
where
|
|
dam = _ptDamage pt
|
|
xp = pos +.+ 800 *.* unitVectorAtAngle dir
|
|
(thHit, ps) = reflectLaserAlong phasev [] pos xp w
|
|
col = _ptColor pt
|
|
pic = setLayer BloomNoZWrite $ pictures
|
|
[ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 20 (pos:ps)
|
|
, setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 (pos:ps)
|
|
]
|
|
aTractorBeam :: Item -> Creature -> World -> World
|
|
aTractorBeam _ cr w = w & props . at i ?~ tractorBeamAt i spos outpos dir power
|
|
where
|
|
i = newProjectileKey w
|
|
cpos = _crPos cr
|
|
spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
|
|
xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
|
|
dir = _crDir cr
|
|
outpos = collidePointWalls cpos xpos
|
|
$ wallsAlongLine cpos xpos w
|
|
power = _attractionPower . _itParams $ _crInv cr IM.! _crInvSel cr
|
|
|
|
tractorBeamAt :: Int -> Point2 -> Point2 -> Float -> Point2 -> Prop
|
|
tractorBeamAt i pos outpos dir power = ProjectileTimed
|
|
{ _pjPos = pos
|
|
, _pjStartPos = outpos
|
|
, _pjVel = d
|
|
, _prDraw = tractorSPic
|
|
, _pjID = i
|
|
, _pjUpdate = updateTractor
|
|
, _pjTime = 10
|
|
}
|
|
where
|
|
d = unitVectorAtAngle dir * power
|
|
{- |
|
|
The interaction of this with objects, walls etc needs more thought. -}
|
|
updateTractor :: Prop -> World -> World
|
|
updateTractor pj w
|
|
| _pjTime pj <= 0 = w & props %~ IM.delete i
|
|
| otherwise = w
|
|
& props . ix i . pjTime -~ 1
|
|
& creatures %~ IM.map (tractCr pullVel pos outpos)
|
|
& floorItems %~ IM.map (tractFlIt pullVel pos outpos)
|
|
where
|
|
i = _pjID pj
|
|
pullVel = _pjVel pj
|
|
pos = _pjPos pj
|
|
outpos = _pjStartPos pj
|
|
|
|
tractFlIt :: Point2 -> Point2 -> Point2 -> FloorItem -> FloorItem
|
|
tractFlIt q p1 outpos it
|
|
| circOnSeg p1 outpos (_flItPos it) 10 = it & flItPos %~ tractorPullPos q p1
|
|
| otherwise = it
|
|
|
|
tractCr :: Point2 -> Point2 -> Point2 -> Creature -> Creature
|
|
tractCr q p1 outpos cr
|
|
| circOnSeg p1 outpos (_crPos cr) 10 = cr & crPos %~ tractorPullPos q p1
|
|
| otherwise = cr
|
|
|
|
tractorPullPos :: Point2 -> Point2 -> Point2 -> Point2
|
|
tractorPullPos q p1 p = p -.- m *.* (0.3/ x' *.* q +.+ g y *.* p4)
|
|
where
|
|
x' = abs y + 1
|
|
y = errorClosestPointOnLineParam 1 p1 p3 p
|
|
m | dist p p1 < 350 = 1
|
|
| otherwise = (400 - dist p p1) / 50
|
|
g x | x > 5 = (10 - x) / 250
|
|
| x > 1 = 0.02
|
|
| x > -1 = x * 0.02
|
|
| x > -5 = -0.02
|
|
| otherwise = (x - 10) / 250
|
|
--p4 = vNormal p5
|
|
p4 = vNormal $ squashNormalizeV q
|
|
p3 = p1 +.+ p4
|
|
|
|
tractorSPic :: Prop -> SPic
|
|
tractorSPic pj = (,) mempty $ setLayer BloomNoZWrite $ setDepth 20 $ color (withAlpha 0.5 col) $ polygon
|
|
[ spos -- not sure if this is anticlockwise...
|
|
, spos +.+ size *.* (d +.+ n)
|
|
, xpos +.+ size *.* n
|
|
, xpos -.- size *.* n
|
|
, spos +.+ size *.* (d -.- n)
|
|
]
|
|
where
|
|
size = fromIntegral (_pjTime pj)
|
|
spos = _pjPos pj
|
|
xpos = _pjStartPos pj
|
|
d = squashNormalizeV $ spos -.- xpos
|
|
n = vNormal d
|
|
col = mixColors 0.5 0.5 white blue
|