428 lines
13 KiB
Haskell
428 lines
13 KiB
Haskell
module Dodge.Item.Weapon.Launcher
|
|
( launcher
|
|
, remoteLauncher
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Default
|
|
import Dodge.Default.Weapon
|
|
import Dodge.Item.Weapon.InventoryDisplay
|
|
import Dodge.Default.Shell
|
|
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.Base
|
|
import Dodge.Zone
|
|
import Dodge.SoundLogic
|
|
import Dodge.WorldEvent.SpawnParticle
|
|
import Dodge.WorldEvent.Cloud
|
|
import Dodge.RandomHelp
|
|
import Dodge.Picture.Layer
|
|
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
|
|
import Control.Monad.State
|
|
import System.Random
|
|
|
|
launcher :: Item
|
|
launcher = defaultGun
|
|
{ _itName = "ROCKO"
|
|
, _itIdentity = Launcher
|
|
, _itConsumption = defaultAmmo
|
|
{ _aoType = defaultShellAmmo
|
|
{ _amPayload = makeExplosionAt
|
|
, _amString = "EXPLOSIVE SHELL"
|
|
, _amPjDraw = shellPic
|
|
}
|
|
, _ammoMax = 30
|
|
, _ammoLoaded = 30
|
|
, _reloadTime = 80
|
|
}
|
|
, _itUse = ruseRate 20 aRocketWithItemParams upHammer
|
|
[ ammoCheckI
|
|
, useTimeCheck
|
|
, withSoundStart tap4S
|
|
, useAmmo 1
|
|
]
|
|
& useAim . aimSpeed .~ 0.2
|
|
& useAim . aimRange .~ 0.5
|
|
& useAim . aimStance .~ TwoHandTwist
|
|
, _itFloorPict = launcherPic
|
|
, _itEffect = NoItEffect
|
|
, _itParams = ShellLauncher
|
|
{ _shellSpinDrag = 1
|
|
, _shellSpinAmount = 2
|
|
, _shellThrustDelay = 1
|
|
}
|
|
, _itTweaks = Tweakable
|
|
{ _tweakSel = 0
|
|
, _tweakParams = basicAmPjMoves
|
|
}
|
|
, _itInvSize = 3
|
|
, _itInvDisplay = \it -> basicWeaponDisplay it ++
|
|
["!" ++ replicate 8 ch ++ "!"
|
|
,"!" ++ replicate 8 ch ++ "!"]
|
|
}
|
|
where
|
|
ch = ' '
|
|
|
|
defaultShellAmmo :: AmmoType
|
|
defaultShellAmmo = ProjectileAmmo
|
|
{ _amPayload = const id
|
|
, _amString = "Shell"
|
|
, _amPjDraw = const mempty
|
|
}
|
|
|
|
launcherPic :: Item -> SPic
|
|
launcherPic _ =
|
|
( colorSH cyan $ prismPoly
|
|
(map (+.+.+ V3 10 0 4.5) $ polyCircx 4 5)
|
|
(map (+.+.+ V3 (-10) 0 4.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
|
|
|
|
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)
|
|
& makeFlameletTimed (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
|
|
& smokeGen
|
|
where
|
|
accel = _pjAcc pj
|
|
i = _pjID pj
|
|
oldPos = _pjPos 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
|
|
smokeGen = shellTrailCloud $ addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos))
|
|
|
|
--aPJtweakParams :: Prop -> Item -> Creature -> World -> World
|
|
--aPJtweakParams pr it cr w =
|
|
|
|
aRocketWithItemParams :: Item -> Creature -> World -> World
|
|
aRocketWithItemParams it cr w = over props (IM.insert i theShell) w
|
|
where
|
|
am = _itConsumption it
|
|
i = IM.newKey $ _props w
|
|
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
|
|
dir = _crDir cr
|
|
params = _itParams it
|
|
spindrag = _shellSpinDrag params
|
|
spinamount = _shellSpinAmount params
|
|
thrustdelay = _shellThrustDelay params
|
|
theShell = defaultShell
|
|
{ _pjPos = pos
|
|
, _pjStartPos = pos
|
|
, _pjVel = rotateV dir (V2 1 0)
|
|
, _pjAcc = rotateV dir (V2 3 0)
|
|
, _prDraw = _amPjDraw $ _aoType am
|
|
, _pjID = i
|
|
--, _pjUpdate = \pj -> ammoMvs pj . decTimMvVel pj . moveShell pj
|
|
, _pjUpdate = \pj -> pjEffAtTime 35 (trySpinByCID (_crID cr) spinamount) pj
|
|
. pjThrust thrustdelay pj
|
|
. reduceSpinBy (1-fromIntegral spindrag*2 / 200) pj
|
|
. decTimMvVel pj
|
|
. moveShell pj
|
|
, _pjPayload = _amPayload $ _aoType am
|
|
, _pjTimer = 50
|
|
}
|
|
|
|
moveShell
|
|
:: Prop -- ^ Projectile id
|
|
-> World
|
|
-> World
|
|
moveShell pj w
|
|
| time > 40 = if circOnSomeWall oldPos 4 w
|
|
then doExplode
|
|
else w
|
|
| isJust thingHit = doExplode
|
|
| time > -300 = w
|
|
| otherwise = doExplode
|
|
where
|
|
time = _pjTimer pj
|
|
doExplode = w
|
|
& projectileExplosion oldPos
|
|
& stopSoundFrom (ShellSound i)
|
|
& props %~ IM.delete i
|
|
i = _pjID pj
|
|
oldPos = _pjPos pj
|
|
vel = _pjVel pj
|
|
projectileExplosion = _pjPayload pj
|
|
newPos = oldPos +.+ vel
|
|
hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w
|
|
hitWl = fst <$> collideCircWalls oldPos newPos 2 (wallsNearPoint newPos w)
|
|
thingHit = hitCr <|> hitWl
|
|
|
|
reduceSpinBy :: Float -> Prop -> World -> World
|
|
reduceSpinBy x pj = props . ix (_pjID pj) . pjSpin *~ x
|
|
|
|
shellPic :: Prop -> SPic
|
|
shellPic pj = noPic $ translateSHz 18 . uncurryV translateSHf pos $ rotateSH (argV accel) basePic
|
|
where
|
|
basePic = colorSH black $ upperPrismPoly 4 $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
|
|
accel = _pjAcc pj
|
|
pos = _pjPos pj
|
|
--shellPic pj = (,) mempty $ setDepth 20 . uncurryV translate pos $ rotate (argV accel) basePic
|
|
-- where
|
|
-- basePic = color blackSH $ polygon $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
|
|
-- accel = _pjAcc pj
|
|
-- pos = _pjPos 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 = defaultGun
|
|
{ _itName = "ROCKO-REM"
|
|
, _itIdentity = RemoteLauncher
|
|
, _itConsumption = defaultAmmo
|
|
{ _aoType = defaultShellAmmo
|
|
{ _amPayload = makeExplosionAt
|
|
, _amString = ""
|
|
, _amPjDraw = shellPic
|
|
}
|
|
, _ammoMax = 30
|
|
, _ammoLoaded = 30
|
|
, _reloadTime = 80
|
|
}
|
|
, _itUse = ruseRate 10 (const fireRemoteLauncher) upHammer
|
|
[ ammoCheckI
|
|
, hammerCheckI
|
|
]
|
|
& useAim . aimSpeed .~ 0.2
|
|
& useAim . aimRange .~ 0.5
|
|
& useAim . aimStance .~ TwoHandTwist
|
|
, _itFloorPict = launcherPic
|
|
, _itAttachment = ItScope (V2 0 0) 0 1 True
|
|
-- , _itParams = ShellLauncher
|
|
-- { _tweakSel = 0
|
|
-- , _tweakParams = basicAmPjMoves -- TODO change to allow tweaking rocket speed
|
|
-- }
|
|
}
|
|
|
|
fireRemoteLauncher :: Creature -> World -> World
|
|
fireRemoteLauncher cr w = setLocation
|
|
$ resetFire
|
|
$ resetName
|
|
$ soundStart (CrWeaponSound cid 0) pos tap4S Nothing
|
|
$ over props addRemRocket w
|
|
where
|
|
i = IM.newKey $ _props w
|
|
cid = _crID cr
|
|
dir = _crDir cr
|
|
pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0)
|
|
addRemRocket = IM.insert i $ Shell
|
|
{ _pjPos = pos
|
|
, _pjZ = 20
|
|
, _pjStartPos = pos
|
|
, _pjVel = rotateV dir (V2 1 0)
|
|
, _prDraw = remoteShellDraw
|
|
, _pjID = i
|
|
, _pjUpdate = \pj -> decTimMvVel pj . setRemoteScope itid pj . moveRemoteShell cid itid pj
|
|
, _pjAcc = V2 0 0
|
|
, _pjDir = dir
|
|
, _pjSpin = 0
|
|
, _pjPayload = makeExplosionAt
|
|
, _pjTimer = 50
|
|
}
|
|
j = _crInvSel cr
|
|
newitid = IM.newKey $ _itemPositions w
|
|
maybeitid = cr ^? crInv . ix j . itID . _Just
|
|
resetFire = set (creatures . ix cid . crInv . ix j . itUse . rUse)
|
|
$ \_ _ -> explodeRemoteRocket itid i
|
|
resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEROCKET"
|
|
setLocation :: World -> World
|
|
setLocation w' = case maybeitid of
|
|
Nothing -> w' & creatures . ix cid . crInv . ix j . itID ?~ newitid
|
|
& itemPositions %~ IM.insert newitid (InInv cid j)
|
|
_ -> w'
|
|
itid = fromMaybe newitid maybeitid
|
|
|
|
moveRemoteShell :: Int -> Int -> Prop -> World -> World
|
|
moveRemoteShell cid itid pj w
|
|
| time > 40 = if circOnSomeWall oldPos 4 w
|
|
then doExplosion w
|
|
else w
|
|
| time >= 20 = case thingHit of
|
|
Just _ -> doExplosion w
|
|
Nothing -> w & props . ix i . pjDir .~ newdir
|
|
| time > -99 = case thingHit of
|
|
Just _ -> doExplosion $ stopSoundFrom (ShellSound i) w
|
|
Nothing -> w & set randGen g
|
|
& props . ix i %~
|
|
( ( pjVel %~ ( (accel +.+) . (frict *.*) ) )
|
|
. ( pjDir .~ newdir )
|
|
)
|
|
& soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
|
|
& smokeGen
|
|
& makeFlameletTimed oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
|
|
| time > -200 = case thingHit of
|
|
Just _ -> doExplosion $ stopSoundFrom (ShellSound i) w
|
|
Nothing -> w
|
|
| otherwise = doExplosion $ stopSoundFrom (ShellSound i) w
|
|
where
|
|
time = _pjTimer pj
|
|
i = _pjID pj
|
|
oldPos = _pjPos pj
|
|
vel = _pjVel pj
|
|
newPos = oldPos +.+ vel
|
|
newdir
|
|
| SDL.ButtonRight `S.member` _mouseButtons w
|
|
&& w ^? creatures . ix cid . crInvSel == w ^? itemPositions . ix itid . itInvId
|
|
= _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
|
|
hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w
|
|
hitWl = fst <$> collideCircWalls oldPos newPos 2 (wallsNearPoint newPos w)
|
|
thingHit = hitCr <|> hitWl
|
|
r1 = _randGen w & evalState (randInCirc 10)
|
|
smokeGen = shellTrailCloud $ addZ 20 $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)
|
|
doExplosion = explodeRemoteRocket itid i
|
|
|
|
explodeRemoteRocket
|
|
:: Int -- ^ Item id
|
|
-> Int -- ^ Projectile id
|
|
-> World
|
|
-> World
|
|
explodeRemoteRocket itid pjid w
|
|
= set (props . ix pjid . pjUpdate) (\_ -> retireRemoteRocket itid 30 pjid)
|
|
$ set (props . ix pjid . prDraw) (const mempty)
|
|
$ set (itPoint . itUse . rUse) (\_ _ -> id)
|
|
$ resetName
|
|
$ makeExplosionAt (_pjPos (_props w IM.! pjid)) w
|
|
where
|
|
resetName = set (itPoint . itName) "REMOTELAUNCHER"
|
|
itPoint = pointToItem $ _itemPositions w IM.! itid
|
|
|
|
remoteShellDraw :: Prop -> SPic
|
|
remoteShellDraw pj
|
|
| t > 40 = (,) mempty $ onLayerL [levLayer CrLayer - 2]
|
|
$ uncurryV translate pos $ rotate dir $ remoteShellPic t
|
|
| otherwise = (,) mempty $ uncurryV translate pos $ rotate dir $ remoteShellPic t
|
|
where
|
|
t = _pjTimer pj
|
|
pos = _pjPos pj
|
|
dir = _pjDir pj
|
|
|
|
remoteShellPic
|
|
:: Int -- ^ Timer
|
|
-> Picture
|
|
remoteShellPic t
|
|
| rem (t+200) 20 < 9 = setDepth 20 $ polygon $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
|
|
| otherwise = pictures
|
|
[ setDepth 20 $ polygon $ map toV2 [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)]
|
|
, setLayer 1 . setDepth 20.5 . color col $ circleSolid 3
|
|
]
|
|
where
|
|
col | t > (-99) = green
|
|
| otherwise = red
|
|
retireRemoteRocket :: Int -> Int -> Int -> World -> World
|
|
retireRemoteRocket itid 0 pjid w =
|
|
set (pointToItem (_itemPositions w IM.! itid) . itAttachment . scopePos) (V2 0 0)
|
|
$ set (pointToItem (_itemPositions w IM.! itid) . itUse . rUse) (const fireRemoteLauncher)
|
|
(w & props %~ IM.delete pjid)
|
|
retireRemoteRocket itid t pjid w = setScope w
|
|
& props . ix pjid . pjUpdate .~ (\_ -> retireRemoteRocket itid (t-1) pjid)
|
|
where
|
|
setScope w' = case _itemPositions w' IM.! itid of
|
|
InInv cid invid -> w'
|
|
& creatures . ix cid . crInv . ix invid . itAttachment
|
|
. scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
|
|
_ -> w'
|
|
pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . pjPos
|
|
|
|
setRemoteScope :: Int -> Prop -> World -> World
|
|
setRemoteScope itid pj w' = case w' ^? itemPositions . ix itid of
|
|
Just (InInv cid' invid )
|
|
-> w' & creatures . ix cid' . crInv . ix invid . itAttachment
|
|
. scopePos .~ (_pjPos pj -.- _crPos (_creatures w' IM.! cid'))
|
|
_ -> w'
|