391 lines
12 KiB
Haskell
391 lines
12 KiB
Haskell
module Dodge.Item.Weapon.Launcher
|
|
( launcher
|
|
, launcherX
|
|
, remoteLauncher
|
|
, fireTrackingShell
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Default
|
|
import Dodge.Default.Weapon
|
|
import Dodge.Item.Location
|
|
import Dodge.SoundLogic.LoadSound
|
|
import Dodge.WorldEvent.Explosion
|
|
import Dodge.Item.Weapon.Shell
|
|
import Dodge.Item.Weapon.Remote
|
|
import Dodge.Item.Weapon.TriggerType
|
|
import Dodge.Movement.Turn
|
|
import Dodge.Base
|
|
import Dodge.Zone
|
|
import Dodge.SoundLogic
|
|
import Dodge.WorldEvent.SpawnParticle
|
|
import Dodge.WorldEvent.Cloud
|
|
import RandomHelp
|
|
import Geometry
|
|
import Picture
|
|
import qualified IntMapHelp as IM
|
|
--import Padding
|
|
import ShapePicture
|
|
import Shape
|
|
|
|
import qualified Data.Set as S
|
|
import qualified SDL
|
|
import Data.Maybe
|
|
import Control.Lens
|
|
import Control.Applicative
|
|
|
|
launcher :: Item
|
|
launcher = defaultWeapon
|
|
{ _itConsumption = defaultLoadable
|
|
& laAmmoType .~ ProjectileAmmo
|
|
{ _amPayload = makeExplosionAt
|
|
, _amString = "EXPLOSIVE SHELL"
|
|
, _amPjDraw = drawShell
|
|
, _amPjCreation = fireShell
|
|
}
|
|
& laMax .~ 1
|
|
& laLoaded .~ 1
|
|
& laLoadType . ejectTime .~ 40
|
|
& laLoadType . insertTime .~ 40
|
|
, _itUse = ruseRate 20 usePjCreation upHammer
|
|
[ hammerCheckI
|
|
, ammoCheckI
|
|
, useTimeCheck
|
|
, withSoundStart tap4S
|
|
, useAmmoAmount 1
|
|
]
|
|
& useAim . aimWeight .~ 8
|
|
& useAim . aimRange .~ 0.5
|
|
& useAim . aimStance .~ TwoHandTwist
|
|
, _itParams = ShellLauncher
|
|
{ _shellSpinDrag = 1
|
|
, _shellSpinAmount = 2
|
|
, _shellThrustDelay = 1
|
|
}
|
|
, _itTweaks = Tweakable
|
|
{ _tweakSel = 0
|
|
, _tweakParams = basicAmPjMoves
|
|
}
|
|
, _itInvSize = 3
|
|
, _itDimension = ItemDimension
|
|
{ _dimRad = 9
|
|
, _dimCenter = V3 10 0 0
|
|
, _dimPortage = HeldItem
|
|
{_handlePos = 5
|
|
,_muzPos = 20
|
|
}
|
|
, _dimSPic = launcherPic
|
|
}
|
|
}
|
|
& itType . iyBase .~ LAUNCHER
|
|
& itType . iyModules . at ModLauncherHoming ?~ EMPTYMODULE
|
|
|
|
launcherX :: Int -> Item
|
|
launcherX i = launcher
|
|
& itType . iyBase .~ LAUNCHERX i
|
|
& itConsumption . laMax .~ i
|
|
& itConsumption . laLoaded .~ i
|
|
& itUse . rUse .~ usePjCreationX i
|
|
& itUse . useMods .~
|
|
[ hammerCheckI
|
|
, ammoCheckI
|
|
, useTimeCheck
|
|
, withSoundStart tap4S
|
|
, useAmmoAmount i
|
|
]
|
|
|
|
usePjCreation :: Item -> Creature -> World -> World
|
|
usePjCreation it = _amPjCreation (_laAmmoType (_itConsumption it)) it
|
|
|
|
usePjCreationX :: Int -> Item -> Creature -> World -> World
|
|
usePjCreationX i it cr = foldr f
|
|
(_amPjCreation (_laAmmoType (_itConsumption it)) it cr)
|
|
[1..i-1]
|
|
where
|
|
f n = (. _amPjCreation (_laAmmoType (_itConsumption it)) it (cr & crDir +~ (2*pi*fromIntegral n / fromIntegral i)))
|
|
|
|
launcherPic :: Item -> SPic
|
|
launcherPic _ =
|
|
( colorSH cyan $ prismPoly
|
|
(map (+.+.+ V3 20 0 5) $ polyCircx 4 5)
|
|
(map (+.+.+ V3 0 0 5) $ polyCircx 4 5)
|
|
, mempty
|
|
)
|
|
|
|
basicAmPjMoves :: IM.IntMap TweakParam
|
|
basicAmPjMoves = IM.fromList . zip [0..] $
|
|
[spinDrag
|
|
,spinStart
|
|
,thrustParam
|
|
]
|
|
spinDrag :: TweakParam
|
|
spinDrag = TweakParam
|
|
{ _doTweak = \i -> itParams . shellSpinDrag .~ i
|
|
, _curTweak = 1
|
|
, _showTweak = show
|
|
, _maxTweak = 5
|
|
, _nameTweak = "SPIN SLOWDOWN"
|
|
}
|
|
spinStart :: TweakParam
|
|
spinStart = TweakParam
|
|
{ _doTweak = \i -> itParams . shellSpinAmount .~ i
|
|
, _curTweak = 2
|
|
, _showTweak = show
|
|
, _maxTweak = 5
|
|
, _nameTweak = "SPIN AMOUNT"
|
|
}
|
|
thrustParam :: TweakParam
|
|
thrustParam = TweakParam
|
|
{ _doTweak = \i -> itParams . shellThrustDelay .~ i
|
|
, _curTweak = 1
|
|
, _showTweak = show
|
|
, _maxTweak = 5
|
|
, _nameTweak = "THRUST DELAY"
|
|
}
|
|
|
|
pjThrust :: Int -> Prop -> World -> World
|
|
pjThrust i = pjEffTimeRange (st,et) doThrust
|
|
where
|
|
et | i == 0 = 36
|
|
| otherwise = 40 - (i * 20)
|
|
st = et - 100
|
|
|
|
pjTrack :: Int -> Int -> Prop -> World -> World
|
|
pjTrack itid i pj w = pjEffTimeRange (st,et) rotateToTarget pj w
|
|
where
|
|
et | i == 0 = 36
|
|
| otherwise = 40 - (i * 20)
|
|
st = et - 100
|
|
rotateToTarget _ = fromMaybe id $ do
|
|
tpos <- w ^? itPoint . itTargeting . tgPos . _Just
|
|
return $ props . ix (_pjID pj) . pjSpin .~ turnToAmount 0.15 (_prPos pj) tpos (argV $ _pjAcc pj)
|
|
itPoint = pointToItem $ _itemPositions w IM.! itid
|
|
|
|
doThrust :: Prop -> World -> World
|
|
doThrust pj w = w
|
|
& randGen .~ g
|
|
& props . ix i . pjVel %~ (\v -> accel +.+ frict *.* v)
|
|
& soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
|
|
& makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
|
|
& shellTrailCloud (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
|
|
where
|
|
accel = _pjAcc pj
|
|
i = _pjID pj
|
|
oldPos = _prPos pj
|
|
vel = _pjVel pj
|
|
newPos = oldPos +.+ vel
|
|
(frict,g) = randomR (0.6,0.9) $ _randGen w
|
|
(sparkD,_) = randomR (-0.2,0.2) $ _randGen w
|
|
r1 = randInCirc 10 & evalState $ _randGen w
|
|
|
|
fireShell :: Item -> Creature -> World -> World
|
|
fireShell it cr = makeShell it cr $ \pj -> pjEffAtTime 35 (trySpinByCID (_crID cr) spinamount) pj
|
|
. pjThrust thrustdelay pj
|
|
. reduceSpinBy (1-fromIntegral spindrag*2 / 200) pj
|
|
. decTimMvVel pj
|
|
. moveShell pj
|
|
where
|
|
params = _itParams it
|
|
spindrag = _shellSpinDrag params
|
|
spinamount = _shellSpinAmount params
|
|
thrustdelay = _shellThrustDelay params
|
|
|
|
moveShell :: Prop -- ^ Projectile id
|
|
-> World
|
|
-> World
|
|
moveShell pj w
|
|
| time > 40 = if circOnSomeWall oldPos 4 w
|
|
then doExplode
|
|
else w
|
|
| anythingHitCirc 2 oldPos newPos w = doExplode
|
|
| time > -300 = w
|
|
| otherwise = doExplode
|
|
where
|
|
time = _pjTimer pj
|
|
doExplode = w
|
|
& _pjPayload pj oldPos
|
|
& stopSoundFrom (ShellSound i)
|
|
& props %~ IM.delete i
|
|
i = _pjID pj
|
|
oldPos = _prPos pj
|
|
vel = _pjVel pj
|
|
newPos = oldPos +.+ vel
|
|
|
|
reduceSpinBy :: Float -> Prop -> World -> World
|
|
reduceSpinBy x pj = props . ix (_pjID pj) . pjSpin *~ x
|
|
|
|
drawShell :: Prop -> SPic
|
|
drawShell pj = noPic
|
|
. translateSHz 18
|
|
. uncurryV translateSHf (_prPos pj)
|
|
$ rotateSH (argV $ _pjAcc pj) shellShape
|
|
|
|
shellShape :: Shape
|
|
shellShape = colorSH black $ upperPrismPoly 4 $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
|
|
|
|
remoteShellShape :: Color -> SPic
|
|
remoteShellShape col = (shellShape
|
|
, setLayer BloomNoZWrite . setDepth 4.5 . color col $ circleSolid 3
|
|
)
|
|
|
|
drawRemoteShell :: Prop -> SPic
|
|
drawRemoteShell pj
|
|
| rem (t+200) 20 < 9
|
|
= doposition $ noPic shellShape
|
|
| otherwise = doposition $ remoteShellShape col
|
|
where
|
|
col | t > (-99) = green
|
|
| otherwise = red
|
|
t = _pjTimer pj
|
|
doposition = translateSPz 18 . uncurryV translateSPf (_prPos pj) . rotateSP (_pjDir pj)
|
|
|
|
pjEffTimeRange
|
|
:: (Int,Int)
|
|
-> (Prop -> World -> World)
|
|
-> Prop
|
|
-> World
|
|
-> World
|
|
pjEffTimeRange (st,et) f pj
|
|
| t <= et && t >= st = f pj
|
|
| otherwise = id
|
|
where
|
|
t = _pjTimer pj
|
|
|
|
pjEffAtTime
|
|
:: Int
|
|
-> (Prop -> World -> World)
|
|
-> Prop
|
|
-> World
|
|
-> World
|
|
pjEffAtTime t f pj
|
|
| _pjTimer pj == t = f pj
|
|
| otherwise = id
|
|
|
|
trySpinByCID
|
|
:: Int -- ^ creature id
|
|
-> Int -- ^ Spin amount
|
|
-> Prop
|
|
-> World
|
|
-> World
|
|
trySpinByCID cid i pj w = w & props . ix pjid . pjSpin .~ newSpin
|
|
where
|
|
pjid = _pjID pj
|
|
dir = argV $ _pjVel pj
|
|
newSpin = case w ^? creatures . ix cid of
|
|
Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
|
|
_ -> 0
|
|
spinFactor = 5 * (6 - fromIntegral i)
|
|
|
|
remoteLauncher :: Item
|
|
remoteLauncher = launcher
|
|
& itType . iyBase .~ REMOTELAUNCHER
|
|
& itUse . rUse .~ fireRemoteShell
|
|
& itScope .~ RemoteScope (V2 0 0) 1 True
|
|
& itConsumption . laAmmoType . amPjDraw .~ drawRemoteShell
|
|
-- TODO consider allowing tweaking rocket speed
|
|
|
|
fireRemoteShell :: Item -> Creature -> World -> World
|
|
fireRemoteShell it cr w = set (creatures . ix cid . crInv . ix j . itUse . rUse)
|
|
(\_ _ -> explodeRemoteRocket itid i)
|
|
-- $ set (creatures . ix cid . crInv . ix j . itName) remoteLauncherName
|
|
$ addRemRocket w'
|
|
where
|
|
(w',itid) = getHeldItemLoc cr w
|
|
i = IM.newKey $ _props w
|
|
cid = _crID cr
|
|
addRemRocket = makeShell it cr $ \pj ->
|
|
decTimMvVel pj . setRemoteScope itid pj . moveRemoteShell cid itid pj
|
|
j = _crInvSel cr
|
|
|
|
moveRemoteShell :: Int -> Int -> Prop -> World -> World
|
|
moveRemoteShell cid itid pj w
|
|
| time > 40 = if circOnSomeWall oldPos 4 w
|
|
then doExplosion
|
|
else w
|
|
| anythingHitCirc 2 oldPos newPos w = doExplosion
|
|
| time >= 20 = w & props . ix i . pjDir .~ newdir
|
|
| time > -99 = w & set randGen g
|
|
& props . ix i %~
|
|
( ( pjVel %~ ( (accel +.+) . (frict *.*) ) )
|
|
. ( pjDir .~ newdir )
|
|
)
|
|
& soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
|
|
& smokeGen
|
|
& makeFlamelet oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
|
|
| time > -200 = w
|
|
| otherwise = doExplosion
|
|
where
|
|
time = _pjTimer pj
|
|
i = _pjID pj
|
|
oldPos = _prPos pj
|
|
vel = _pjVel pj
|
|
newPos = oldPos +.+ vel
|
|
newdir
|
|
| SDL.ButtonRight `S.member` _mouseButtons w
|
|
&& w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . ipInvId
|
|
= _cameraRot w + argV (_mousePos w)
|
|
| otherwise = _pjDir pj
|
|
accel = rotateV newdir (V2 2 0)
|
|
(frict,g) = randomR (0.6,0.9) $ _randGen w
|
|
(sparkD,_) = randomR (-0.5,0.5) $ _randGen w
|
|
r1 = _randGen w & evalState (randInCirc 10)
|
|
smokeGen = shellTrailCloud $ addZ 20 $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)
|
|
doExplosion = explodeRemoteRocket itid i $ stopSoundFrom (ShellSound i) w
|
|
|
|
anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
|
|
anythingHitCirc rad sp ep w = isJust $ hitCr <|> hitWl
|
|
where
|
|
hitCr = fst <$> collideCircCrsPoint sp ep rad (_creatures w)
|
|
hitWl = fst <$> collideCircWalls sp ep rad (wallsNearPoint ep w)
|
|
-- this should probably be wallsOnLine or something
|
|
|
|
explodeRemoteRocket
|
|
:: Int -- ^ Item id
|
|
-> Int -- ^ Projectile id
|
|
-> World
|
|
-> World
|
|
explodeRemoteRocket itid pjid w = w
|
|
& props . ix pjid . pjUpdate .~ (\_ -> retireRemoteProj fireRemoteShell itid 30 pjid)
|
|
& props . ix pjid . prDraw .~ const mempty
|
|
& itPoint . itUse . rUse .~ (\_ _ -> id)
|
|
-- & itPoint . itName .~ "REMOTELAUNCHER"
|
|
& _pjPayload thepj (_prPos thepj)
|
|
where
|
|
itPoint = pointToItem $ _itemPositions w IM.! itid
|
|
thepj = _props w IM.! pjid
|
|
|
|
fireTrackingShell :: Item -> Creature -> World -> World
|
|
fireTrackingShell it cr w = addTrackRocket w'
|
|
where
|
|
(w',itid) = getHeldItemLoc cr w
|
|
addTrackRocket = makeShell it cr $ \pj -> pjEffAtTime 35 (trySpinByCID (_crID cr) spinamount) pj
|
|
. pjThrust thrustdelay pj
|
|
. reduceSpinBy (1-fromIntegral spindrag*2 / 200) pj
|
|
. decTimMvVel pj
|
|
. pjTrack itid thrustdelay pj
|
|
. moveShell pj
|
|
spinamount = _shellSpinAmount params
|
|
thrustdelay = _shellThrustDelay params
|
|
spindrag = _shellSpinDrag params
|
|
params = _itParams it
|
|
|
|
makeShell :: Item -> Creature -> (Prop -> World -> World) -> World -> World
|
|
makeShell it cr theupdate w = w & props %~ IM.insert i Shell
|
|
{ _prPos = pos
|
|
, _pjZ = 20
|
|
, _pjStartPos = pos
|
|
, _pjVel = rotateV dir (V2 1 0)
|
|
, _prDraw = _amPjDraw $ _laAmmoType am
|
|
, _pjID = i
|
|
, _pjUpdate = theupdate
|
|
, _pjAcc = rotateV dir (V2 3 0)
|
|
, _pjDir = dir
|
|
, _pjSpin = 0
|
|
, _pjPayload = _amPayload $ _laAmmoType am
|
|
, _pjTimer = 50
|
|
}
|
|
where
|
|
i = IM.newKey $ _props w
|
|
dir = _crDir cr
|
|
pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0)
|
|
am = _itConsumption it
|