309 lines
9.4 KiB
Haskell
309 lines
9.4 KiB
Haskell
module Dodge.Item.Weapon.BatteryGuns
|
|
( lasGun
|
|
, teslaGun
|
|
, tractorGun
|
|
, makeLaserAt
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Particle.TeslaArc
|
|
import Dodge.SoundLogic.LoadSound
|
|
import Dodge.WorldEvent
|
|
import Dodge.WorldEvent.Damage
|
|
import Dodge.Default
|
|
import Dodge.Item.Draw
|
|
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 Dodge.Picture
|
|
|
|
import Data.Function
|
|
import qualified Data.Sequence as Seq
|
|
import Data.List
|
|
import Control.Lens
|
|
import System.Random
|
|
import Data.Maybe
|
|
import Data.Tuple
|
|
import qualified Data.IntMap.Strict as IM
|
|
teslaGun :: Item
|
|
teslaGun = defaultGun
|
|
{ _itName = "TESLA"
|
|
, _itIdentity = TeslaGun
|
|
, _wpMaxAmmo = 200
|
|
, _wpLoadedAmmo = 200
|
|
, _wpReloadTime = 80
|
|
, _wpReloadState = 0
|
|
, _itUseRate = 0
|
|
, _itAimStance = TwoHandFlat
|
|
, _itUseTime = 0
|
|
, _itUse = const aTeslaArc
|
|
, _itUseModifiers =
|
|
[ ammoCheckI
|
|
, useTimeCheckI
|
|
, withTempLight 1 100 (V3 0 0 1)
|
|
, withSoundForI elecCrackleS 1
|
|
, useAmmo 1
|
|
]
|
|
, _wpSpread = 0.001
|
|
, _wpRange = 20
|
|
, _itFloorPict = teslaGunPic
|
|
, _itAimingSpeed = 0.4
|
|
, _itZoom = defaultItZoom
|
|
, _itAimingRange = 0
|
|
, _itEquipPict = pictureWeaponOnAim teslaGunPic
|
|
}
|
|
teslaGunPic :: Item -> SPic
|
|
teslaGunPic _ =
|
|
( colorSH blue $
|
|
upperPrismPoly 5 (rectNESW xb y xa (-y))
|
|
++ upperPrismPoly 5 (rectNESW (-xa) y (-xb) (-y))
|
|
, mempty
|
|
)
|
|
where
|
|
xa = 1
|
|
xb = 9
|
|
y = 4
|
|
lasGun :: Item
|
|
lasGun = defaultAutoGun
|
|
{ _itName = "LASGUN ////"
|
|
, _itIdentity = LasGun
|
|
, _wpMaxAmmo = 200
|
|
, _wpLoadedAmmo = 200
|
|
, _wpReloadTime = 80
|
|
, _wpReloadState = 0
|
|
, _itUseRate = 0
|
|
, _itUseTime = 0
|
|
, _itUse = const aLaser
|
|
, _itUseModifiers =
|
|
[ ammoCheckI
|
|
, useTimeCheckI
|
|
, withTempLight 1 100 (V3 1 1 0)
|
|
, withSoundForI tone440sawtoothS 1
|
|
, useAmmo 1
|
|
]
|
|
, _wpSpread = 0.001
|
|
, _wpRange = 20
|
|
, _itFloorPict = lasGunPic
|
|
, _itAimingSpeed = 0.4
|
|
, _itAimingRange = 1
|
|
, _itEquipPict = pictureWeaponOnAim lasGunPic
|
|
, _itAttachment = ItCharMode $ Seq.fromList "/VZ"
|
|
, _itScroll = scrollCharMode
|
|
, _itInvDisplay = basicWeaponDisplay
|
|
}
|
|
lasGunPic :: Item -> SPic
|
|
lasGunPic it =
|
|
( colorSH blue $
|
|
upperPrismPoly 4 (rectNESW 3 15 1 (-15))
|
|
<> upperPrismPoly 4 (rectNESW (-1) 15 (-3) (-15))
|
|
-- <> (upperPrismPoly 4 $ rectNESW (5) l (-5) (l-2))
|
|
<> upperPrismPoly 1 (rectNESW 3 15 (-3) (-15))
|
|
, setLayer 1 . color col . setDepth 1.1 . polygon $ rectNESW 1 15 (-1) (-15)
|
|
)
|
|
where
|
|
amFrac = fractionLoadedAmmo it
|
|
col = brightX 2 1.5 $ mixColors amFrac (1-amFrac) green red
|
|
|
|
tractorGun :: Item
|
|
tractorGun = defaultAutoGun
|
|
{ _itName = "TRACTORGUN"
|
|
, _itIdentity = TractorGun
|
|
, _wpMaxAmmo = 10000
|
|
, _wpLoadedAmmo = 10000
|
|
, _wpReloadTime = 40
|
|
, _wpReloadState = 0
|
|
, _itUseRate = 0
|
|
, _itUseTime = 0
|
|
, _itUse = aTractorBeam
|
|
, _itUseModifiers =
|
|
[ ammoUseCheckI
|
|
]
|
|
, _wpSpread = 0.00001
|
|
, _wpRange = 20
|
|
, _itFloorPict = tractorGunSPic
|
|
, _itAimingSpeed = 0.4
|
|
, _itAimingRange = 0.5
|
|
, _itEquipPict = pictureWeaponOnAim tractorGunSPic
|
|
}
|
|
-- TODO own picture for tractor gun
|
|
tractorGunSPic :: Item -> SPic
|
|
tractorGunSPic = lasGunPic
|
|
|
|
aTeslaArc :: Creature -> World -> World
|
|
aTeslaArc cr w = set randGen g w
|
|
& particles %~ (makeTeslaArcAt col pos dir :)
|
|
where
|
|
pos = _crPos cr +.+ (_crRad cr +1) *.* unitVectorAtAngle dir
|
|
dir = _crDir cr
|
|
(colid,g) = randomR (0::Int,3) $ _randGen w
|
|
col = chooseColor colid
|
|
chooseColor 0 = white
|
|
chooseColor 1 = azure
|
|
chooseColor 2 = blue
|
|
chooseColor _ = cyan
|
|
|
|
aLaser :: Creature -> World -> World
|
|
aLaser cr = particles %~ (makeLaserAt phaseV pos dir : )
|
|
where
|
|
pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir)
|
|
dir = _crDir cr
|
|
phaseV = charToPhaseV
|
|
$ fromMaybe '/' $ Seq.lookup 0 =<< cr ^? crInv . ix j . itAttachment . itCharMode
|
|
j = _crInvSel cr
|
|
|
|
charToPhaseV :: Fractional p => Char -> p
|
|
charToPhaseV 'V' = 0.2
|
|
charToPhaseV '/' = 1
|
|
charToPhaseV 'Z' = 5
|
|
charToPhaseV _ = error "Trying to set an undefined phaseV"
|
|
|
|
makeLaserAt :: Float -> Point2 -> Float -> Particle
|
|
makeLaserAt phaseV pos dir = Particle
|
|
{ _ptDraw = const blank
|
|
, _ptUpdate = moveLaser phaseV pos dir
|
|
}
|
|
moveLaser
|
|
:: Float -- ^ Phase velocity, controls deflection through windows
|
|
-> Point2
|
|
-> Float
|
|
-> World
|
|
-> Particle
|
|
-> (World, Maybe Particle)
|
|
moveLaser phaseV pos dir w pt
|
|
= ( hitEffect w
|
|
, Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 }
|
|
)
|
|
where
|
|
xp = pos +.+ 800 *.* unitVectorAtAngle dir
|
|
f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either Creature Wall),[Point2])
|
|
f seenWs x y = case find (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of
|
|
--f seenWs x y = case find (h' seenWs) $ thingsHitExceptCr Nothing x y w of
|
|
Just (p,Right wl)
|
|
| _wlOpacity wl == SeeThrough -> addPoint p $ f (wl:seenWs) p (h x y wl p)
|
|
| otherwise -> (Just (p,Right wl), [p])
|
|
Just (p,obj) -> (Just (p,obj), [p])
|
|
Nothing -> (Nothing, [y])
|
|
addPoint p (x,ps') = (x,p:ps')
|
|
h x y wl p
|
|
| isEntering = p +.+ rotateV angleRef normalDist
|
|
| otherwise = p +.+ rotateV angleRef' normalDist'
|
|
where
|
|
wlNormal = vNormal $ uncurry (-.-) $ swap (_wlLine wl)
|
|
normalDist = magV (p -.- y) *.* normalizeV wlNormal
|
|
angleInc = piRange $ argV wlNormal - argV (x -.- y)
|
|
angleRef
|
|
| reflectExternal = angleInc
|
|
| otherwise = asin $ sin angleInc / phaseV
|
|
piRange a'
|
|
| a' > pi = a' - 2 * pi
|
|
| a' > negate pi = a'
|
|
| otherwise = a' + 2 * pi
|
|
isEntering = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl))
|
|
wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl)
|
|
normalDist' = magV (p -.- y) *.* normalizeV wlNormal'
|
|
angleInc' = piRange $ argV wlNormal' - argV (x -.- y)
|
|
angleRef'
|
|
| reflectInternal = angleInc'
|
|
| otherwise = asin $ phaseV * sin angleInc'
|
|
reflectInternal = 1 < abs (phaseV * sin angleInc')
|
|
reflectExternal = 1 < abs (sin angleInc / phaseV)
|
|
|
|
h' ws (_,Right wl) = not $ any (\w' -> _wlID w' == _wlID wl) ws
|
|
h' _ _ = True
|
|
(thHit, ps) = f [] pos xp
|
|
hitEffect = damThingHitWith (Lasering 19) pos xp thHit
|
|
pic = setLayer 1 $ pictures
|
|
[ setDepth 19 . color (brightX 0 0.5 yellow) $ lineOfThickness 20 (pos:ps)
|
|
, setDepth 19.5 . color (brightX 10 1 yellow) $ lineOfThickness 3 (pos:ps)
|
|
]
|
|
|
|
aTractorBeam :: Item -> Creature -> World -> World
|
|
aTractorBeam _ cr w = over props (IM.insert i (tractorBeamAt i spos outpos dir)) w
|
|
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
|
|
|
|
tractorBeamAt :: Int -> Point2 -> Point2 -> Float -> Prop
|
|
tractorBeamAt i pos outpos dir = ProjectileTimed
|
|
{ _pjPos = pos
|
|
, _pjStartPos = outpos
|
|
, _pjVel = d
|
|
, _prDraw = tractorSPic
|
|
, _pjID = i
|
|
, _pjUpdate = updateTractor
|
|
, _pjTime = 10
|
|
}
|
|
where
|
|
d = unitVectorAtAngle dir
|
|
|
|
{- |
|
|
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 $ safeNormalizeV q
|
|
p3 = p1 +.+ p4
|
|
|
|
tractorSPic :: Prop -> SPic
|
|
tractorSPic pj = (,) mempty $ setLayer 1 $ 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 = safeNormalizeV $ spos -.- xpos
|
|
n = vNormal d
|
|
col = mixColors 0.5 0.5 white blue
|