406 lines
12 KiB
Haskell
406 lines
12 KiB
Haskell
module Dodge.Item.Weapon.Launcher
|
|
( launcher
|
|
, remoteLauncher
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Data.SoundOrigin
|
|
import Dodge.Default.Weapon
|
|
import Dodge.Default.Shell
|
|
import Dodge.SoundLogic.LoadSound
|
|
import Dodge.WorldEvent.Explosion
|
|
import Dodge.Item.Data
|
|
import Dodge.Item.Attachment.Data
|
|
import Dodge.Item.Draw
|
|
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 Geometry.Vector3D
|
|
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
|
|
, _wpMaxAmmo = 30
|
|
, _wpLoadedAmmo = 30
|
|
, _wpReloadTime = 80
|
|
, _wpReloadState = 0
|
|
, _itUseRate = 20
|
|
, _itUseTime = 0
|
|
, _itUse = aRocketWithItemParams
|
|
, _itUseModifiers =
|
|
[ ammoCheckI
|
|
, useTimeCheckI
|
|
, withSoundStart tap4S
|
|
, useAmmo 1
|
|
]
|
|
, _wpSpread = 0.02
|
|
, _wpRange = 20
|
|
, _itFloorPict = launcherPic
|
|
, _itAimingSpeed = 0.2
|
|
, _itAimingRange = 0.5
|
|
, _itEquipPict = pictureWeaponOnAim launcherPic
|
|
, _itHammer = NoHammer
|
|
, _itEffect = NoItEffect
|
|
, _wpAmmo = defaultShellAmmo
|
|
{ _amPayload = makeExplosionAt
|
|
, _amString = ""
|
|
, _amPjParams = basicAmPjMoves
|
|
, _amPjDraw = shellPic
|
|
}
|
|
, _itAimStance = TwoHandTwist
|
|
}
|
|
|
|
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 :: [PjParam]
|
|
basicAmPjMoves =
|
|
[spinDrag
|
|
,spinStart
|
|
,thrustParam
|
|
]
|
|
spinDrag :: PjParam
|
|
spinDrag = PjParam
|
|
{ _pjMoveParam = \i _ _ -> reduceSpinBy (1 - fromIntegral i*2 / 200)
|
|
, _pjIntParam = 1
|
|
, _pjDisplayParam = pjPadText "SPIN SLOWDOWN" . show
|
|
, _pjMaxParam = 5
|
|
}
|
|
pjPadText :: String -> String -> String
|
|
pjPadText s = (rightPad 12 ' ' s ++ ) . (' ':)
|
|
spinStart :: PjParam
|
|
spinStart = PjParam
|
|
{ _pjMoveParam = \i _ cr -> pjEffAtTime 35 $ trySpinByCID (_crID cr) i
|
|
, _pjIntParam = 2
|
|
, _pjDisplayParam = pjPadText "SPIN AMOUNT" . show
|
|
, _pjMaxParam = 5
|
|
}
|
|
thrustParam :: PjParam
|
|
thrustParam = PjParam
|
|
{ _pjMoveParam = \i _ _ -> pjThrust i
|
|
, _pjIntParam = 1
|
|
, _pjDisplayParam = pjPadText "THRUST DELAY" . show
|
|
, _pjMaxParam = 5
|
|
}
|
|
|
|
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))
|
|
|
|
--flameLauncher :: Item
|
|
--flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt
|
|
--poisonLauncher :: Item
|
|
--poisonLauncher = launcher & wpAmmo . amPayload .~ makePoisonExplosionAt
|
|
--teslaLauncher :: Item
|
|
--teslaLauncher = launcher & wpAmmo . amPayload .~ makeTeslaExplosionAt
|
|
|
|
aRocketWithItemParams
|
|
:: Item -- ^ Firing item
|
|
-> Creature
|
|
-> World
|
|
-> World
|
|
aRocketWithItemParams it cr w = over props (IM.insert i theShell) w
|
|
where
|
|
am = _wpAmmo it
|
|
i = IM.newKey $ _props w
|
|
pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir)
|
|
dir = _crDir cr
|
|
ammoMvs pj w' = foldr (\pjP -> _pjMoveParam pjP (_pjIntParam pjP) it cr pj) w' (_amPjParams am)
|
|
theShell = defaultShell
|
|
{ _pjPos = pos
|
|
, _pjStartPos = pos
|
|
, _pjVel = rotateV dir (V2 1 0)
|
|
, _pjAcc = rotateV dir (V2 3 0)
|
|
, _prDraw = _amPjDraw am
|
|
, _pjID = i
|
|
, _pjUpdate = \pj -> ammoMvs pj . decTimMvVel pj . moveShell pj
|
|
, _pjPayload = _amPayload 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 = (,) mempty $ setDepth 20 . uncurryV translate pos $ rotate (argV accel) basePic
|
|
where
|
|
basePic = color black $ 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
|
|
, _wpMaxAmmo = 1
|
|
, _wpLoadedAmmo = 1
|
|
, _wpReloadTime = 80
|
|
, _wpReloadState = 0
|
|
, _itUseRate = 10
|
|
, _itUseTime = 0
|
|
, _itUse = const fireRemoteLauncher
|
|
, _itUseModifiers =
|
|
[ ammoCheckI
|
|
, hammerCheckI
|
|
]
|
|
, _wpSpread = 0.02
|
|
, _wpRange = 20
|
|
, _itFloorPict = launcherPic
|
|
, _itAimingSpeed = 0.2
|
|
, _itAimingRange = 0.5
|
|
, _itEquipPict = pictureWeaponOnAim launcherPic
|
|
, _itAttachment = ItScope (V2 0 0) 0 1 True
|
|
, _itAimStance = TwoHandTwist
|
|
}
|
|
|
|
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)
|
|
$ \_ _ -> 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) (\_ _ -> 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) (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'
|