1405 lines
45 KiB
Haskell
1405 lines
45 KiB
Haskell
{-# OPTIONS -Wno-incomplete-uni-patterns #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE TupleSections #-}
|
|
|
|
module Dodge.HeldUse (
|
|
gadgetEffect,
|
|
mcUseHeld,
|
|
heldEffectMuzzles,
|
|
muzzlePos,
|
|
itemMuzzles,
|
|
) where
|
|
|
|
import Color
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import Data.Maybe
|
|
import Dodge.Base
|
|
import Dodge.BaseTriggerType
|
|
import Dodge.Creature.Action
|
|
import Dodge.Creature.Mass
|
|
import Dodge.Creature.Radius
|
|
import Dodge.Data.ComposedItem
|
|
import Dodge.Data.DoubleTree
|
|
import Dodge.Data.Muzzle
|
|
import Dodge.Data.World
|
|
import Dodge.Gas
|
|
import Dodge.Inventory.Lock
|
|
import Dodge.Inventory.Path
|
|
import Dodge.IsPulseLaser
|
|
import Dodge.Item.HeldOffset
|
|
import Dodge.Item.Weapon.Bullet
|
|
import Dodge.Item.Weapon.Shatter
|
|
import Dodge.Projectile.Create
|
|
import Dodge.RadarSweep
|
|
import Dodge.SoundLogic
|
|
import Dodge.Tesla
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
import Linear (_xy, _xyz)
|
|
import ListHelp
|
|
import NewInt
|
|
import Picture.Base
|
|
import qualified Quaternion as Q
|
|
import RandomHelp
|
|
import qualified SDL
|
|
import Sound.Data
|
|
|
|
gadgetEffect :: Int -> LocationDT OItem -> Creature -> World -> World
|
|
gadgetEffect pt loc
|
|
| UseHeld{} <- loc ^. locDT . dtValue . _1 . itUse = heldEffect pt loc
|
|
| PulseBallSF <- loc ^. locDT . dtValue . _2 = heldEffect pt loc
|
|
| DROPPER x <- loc ^. locDT . dtValue . _1 . itType
|
|
, Just i <- loc ^? locDT . dtValue . _1 . itUse . uInt
|
|
, pt == 0 =
|
|
dropInventoryPath i x loc
|
|
| CLICKER x <- loc ^. locDT . dtValue . _1 . itType
|
|
, Just i <- loc ^? locDT . dtValue . _1 . itUse . uInt =
|
|
useInventoryPath pt i x loc
|
|
| otherwise = const id
|
|
|
|
heldEffect :: Int -> LocationDT OItem -> Creature -> World -> World
|
|
heldEffect = hammerCheck heldEffectMuzzles
|
|
|
|
hammerCheck ::
|
|
(LocationDT OItem -> Creature -> World -> World) ->
|
|
Int ->
|
|
LocationDT OItem ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
hammerCheck f pt loc cr w = case itemTriggerType loc of
|
|
WarmUpNoDelay wm
|
|
| _wTime (_itParams it) < wm ->
|
|
w & setwarming
|
|
& soundContinue
|
|
(CrWeaponSound cid 0)
|
|
(cr ^. crPos . _xy)
|
|
(warmupSound $ it ^. itType)
|
|
(Just 2)
|
|
& itmset . itParams . wTime +~ 1
|
|
WarmUpNoDelay{} -> f loc cr w & setwarming
|
|
WarmUpCoolDown ws _ _
|
|
| _wTime (_itParams it) < ws ->
|
|
w & setwarming
|
|
& soundContinue
|
|
(CrWeaponSound cid 0)
|
|
(cr ^. crPos . _xy)
|
|
(warmupSound $ it ^. itType)
|
|
(Just 2)
|
|
& itmset . itParams . wTime +~ 1
|
|
WarmUpCoolDown _ cs _
|
|
| _wTime (_itParams it) < cs ->
|
|
f loc cr w & setwarming
|
|
& itmset . itParams . wTime +~ 1
|
|
WarmUpCoolDown{} -> w & setwarming
|
|
BurstTrigger is t
|
|
| timetest t
|
|
, pt == 0 ->
|
|
w & f loc cr & cWorld . lWorld . delayedEvents .++~ map g is
|
|
VolleyGunTrigger i t
|
|
| timetest t
|
|
, pt == 0 ->
|
|
let (is, gen) = getVolleyBurst i (w ^. randGen)
|
|
in w & f loc cr
|
|
& cWorld . lWorld . delayedEvents .++~ map g is
|
|
& randGen .~ gen
|
|
HammerTrigger t | timetest t, pt == 0 -> f loc cr w
|
|
SemiAutoTrigger t
|
|
| timetest t
|
|
, pt < w ^. cWorld . lWorld . lClock - timelastused ->
|
|
f loc cr w
|
|
AutoTrigger t | timetest t -> f loc cr w
|
|
NoTrigger -> f loc cr w
|
|
_ -> w
|
|
where
|
|
timetest t = w ^. cWorld . lWorld . lClock - t > timelastused
|
|
it = loc ^. locDT . dtValue . _1
|
|
cid = _crID cr
|
|
-- the following is unsafe, but if ilInvID isn't correctly set we probably
|
|
-- will have problems elsewhere also
|
|
invid = it ^?! itLocation . ilInvID
|
|
itmset = cWorld . lWorld . items . ix (it ^. itID . unNInt)
|
|
setwarming = itmset . itParams . isWarming %~ const True
|
|
timelastused = it ^. itTimeLastUsed
|
|
g x = (x, WdWdBurstFireRepetition (_crID cr) invid)
|
|
|
|
getVolleyBurst :: Int -> StdGen -> ([Int], StdGen)
|
|
getVolleyBurst i g =
|
|
let (is, g') = runState (replicateM (i -1) (state $ randomR (0, 6))) g
|
|
in (scanl1 (+) is, g')
|
|
|
|
heldEffectMuzzles :: LocationDT OItem -> Creature -> World -> World
|
|
heldEffectMuzzles loc cr w =
|
|
setusetime
|
|
. doHeldUseEffect t cr
|
|
. uncurry (applyCME loc cr)
|
|
$ bw
|
|
where
|
|
t = loc ^. locDT
|
|
bw = foldl' (loadMuzzle loc cr) (False, w) (locMuzzles loc)
|
|
setusetime =
|
|
cWorld . lWorld . items . ix itid . itTimeLastUsed
|
|
.~ w ^. cWorld . lWorld . lClock
|
|
itid = t ^?! dtValue . _1 . itID . unNInt
|
|
|
|
locMuzzles :: LocationDT OItem -> [Muzzle]
|
|
locMuzzles loc
|
|
| isPulseLaser loc =
|
|
dbwMuzzles
|
|
& ix 0 . mzPos .~ V2 6 0
|
|
& ix 0 . mzInaccuracy .~ 0
|
|
& ix 0 . mzFlareType .~ TeslaGunFlare
|
|
& ix 0 . mzEffect .~ MuzzlePulseLaser
|
|
& ix 0 . mzAmmoSlot .~ CapacitorBelow (UseExactly 200)
|
|
| PulseBallSF <- loc ^. locDT . dtValue . _2 =
|
|
dbwMuzzles
|
|
& ix 0 . mzEffect .~ MuzzlePulseBall
|
|
& ix 0 . mzAmmoSlot .~ CapacitorSelf (UseExactly 200)
|
|
& ix 0 . mzInaccuracy .~ 0
|
|
& ix 0 . mzFlareType .~ TeslaGunFlare
|
|
| otherwise = itemMuzzles $ loc ^. locDT . dtValue . _1
|
|
|
|
itemMuzzles :: Item -> [Muzzle]
|
|
itemMuzzles itm = case itm ^. itType of
|
|
HELD hit -> heldItemMuzzles itm hit
|
|
DETECTOR{} ->
|
|
dbwMuzzles & ix 0 . mzEffect .~ MuzzleDetector
|
|
& ix 0 . mzAmmoSlot . aps .~ UseExactly 100
|
|
LASER ->
|
|
dbwMuzzles
|
|
& ix 0 . mzPos .~ V2 6 0
|
|
& ix 0 . mzInaccuracy .~ 0
|
|
& ix 0 . mzFlareType .~ LasGunFlare
|
|
& ix 0 . mzEffect .~ MuzzleLaser
|
|
_ -> []
|
|
|
|
heldItemMuzzles :: Item -> HeldItemType -> [Muzzle]
|
|
heldItemMuzzles itm = \case
|
|
ALTERIFLE ->
|
|
dbwMuzzles & ix 0 . mzPos .~ V2 25 0
|
|
& ix 0 . mzAmmoSlot .~ MagBelow (_alteRifleSwitch (_itParams itm)) (UseExactly 1)
|
|
(VOLLEYGUN i) -> fromMaybe [] $ do
|
|
j <- itm ^? itParams . unfiredBarrels . ix 0
|
|
x <- vgunMuzzles i ^? ix j
|
|
return [x]
|
|
BANGSTICK i ->
|
|
[ Muzzle
|
|
(V2 10 0)
|
|
a
|
|
0.01
|
|
(MagBelow 0 (UseExactly 1))
|
|
NoFlare
|
|
MuzzleShootBullet
|
|
0
|
|
| -- 0
|
|
a <- spreadAroundCenter i baseStickSpread
|
|
]
|
|
& ix 0 . mzFlareType .~ NoLightFlare
|
|
& ix (i `div` 2) . mzFlareType .~ BasicFlare
|
|
& ix (i -1) . mzFlareType .~ NoLightFlare
|
|
PISTOL -> [Muzzle (V2 10 0) 0 0.05 maguse1 BasicFlare MuzzleShootBullet 0]
|
|
MACHINEPISTOL -> [Muzzle (V2 10 0) 0 0.3 maguse1 MiniGunFlare MuzzleShootBullet 0]
|
|
AUTOPISTOL -> [Muzzle (V2 10 0) 0 0 maguse1 BasicFlare MuzzleShootBullet 0]
|
|
SMG -> [Muzzle (V2 20 0) 0 0.05 maguse1 BasicFlare MuzzleShootBullet 0]
|
|
RIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0
|
|
AUTORIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0
|
|
BURSTRIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0 & ix 0 . mzInaccuracy .~ 0.05
|
|
MINIGUNX i ->
|
|
[ Muzzle
|
|
(V2 (30 + 40 * fromIntegral j / fromIntegral i) 0)
|
|
0
|
|
0.05
|
|
maguse1
|
|
NoFlare
|
|
MuzzleShootBullet
|
|
10
|
|
| j <- [0 .. i -1]
|
|
]
|
|
& ix 0 . mzFlareType .~ MiniGunFlare
|
|
BANGROD ->
|
|
dbwMuzzles
|
|
& ix 0 . mzPos .~ V2 30 0
|
|
& ix 0 . mzFlareType .~ HeavySmokeFlare
|
|
ELEPHANTGUN ->
|
|
dbwMuzzles
|
|
& ix 0 . mzPos .~ V2 30 0
|
|
& ix 0 . mzFlareType .~ HeavySmokeFlare
|
|
& ix 0 . mzInaccuracy .~ 0.05
|
|
AMR ->
|
|
dbwMuzzles
|
|
& ix 0 . mzPos .~ V2 30 0
|
|
& ix 0 . mzFlareType .~ HeavySmokeFlare
|
|
& ix 0 . mzInaccuracy .~ 0.05
|
|
AUTOAMR ->
|
|
dbwMuzzles
|
|
& ix 0 . mzPos .~ V2 30 0
|
|
& ix 0 . mzFlareType .~ HeavySmokeFlare
|
|
& ix 0 . mzInaccuracy .~ 0.05
|
|
SNIPERRIFLE ->
|
|
dbwMuzzles
|
|
& ix 0 . mzPos .~ V2 30 0
|
|
& ix 0 . mzFlareType .~ HeavySmokeFlare
|
|
& ix 0 . mzInaccuracy .~ 0
|
|
BANGCONE -> [Muzzle (V2 15 0) 0 0.5 magupto15 BasicFlare MuzzleShootBullet 12]
|
|
BLUNDERBUSS -> [Muzzle (V2 30 0) 0 0.5 magupto15 BasicFlare MuzzleShootBullet 12]
|
|
GRAPECANNON i -> [Muzzle (V2 30 0) 0 0.5 magupto15 BasicFlare MuzzleShootBullet (12 + 4 * fromIntegral i)]
|
|
LED -> dbwMuzzles & ix 0 . mzPos .~ V2 10 0
|
|
FLAMETHROWER -> flameMuzzles
|
|
FLAMESPITTER -> flameMuzzles & ix 0 . mzEffect . nzPressure .~ UniRandFloat 3 4
|
|
RLAUNCHER ->
|
|
dbwMuzzles
|
|
& ix 0 . mzInaccuracy .~ 0
|
|
& ix 0 . mzEffect .~ MuzzleRLauncher
|
|
& ix 0 . mzPos .~ V2 20 0
|
|
GLAUNCHER ->
|
|
dbwMuzzles
|
|
& ix 0 . mzInaccuracy .~ 0
|
|
& ix 0 . mzEffect .~ MuzzleGLauncher
|
|
& ix 0 . mzPos .~ V2 20 0
|
|
RLAUNCHERX i ->
|
|
getZipList
|
|
( ZipList [Muzzle (V2 20 0) a 0 | a <- take i [0, 2 * pi / fromIntegral i ..]]
|
|
<*> ZipList (fmap (\j -> MagBelow j (UseExactly 1)) [0 ..])
|
|
<*> pure NoFlare
|
|
<*> pure MuzzleRLauncher
|
|
<*> pure 0
|
|
)
|
|
TESLAGUN ->
|
|
dbwMuzzles
|
|
& ix 0 . mzPos .~ V2 10 0
|
|
& ix 0 . mzInaccuracy .~ 0
|
|
& ix 0 . mzFlareType .~ TeslaGunFlare
|
|
& ix 0 . mzEffect .~ MuzzleTesla
|
|
TRACTORGUN ->
|
|
dbwMuzzles
|
|
& ix 0 . mzPos .~ V2 30 0
|
|
& ix 0 . mzInaccuracy .~ 0
|
|
& ix 0 . mzFlareType .~ NoFlare
|
|
& ix 0 . mzEffect .~ MuzzleTractor
|
|
SHATTERGUN ->
|
|
dbwMuzzles
|
|
& ix 0 . mzPos .~ V2 30 0
|
|
& ix 0 . mzInaccuracy .~ 0
|
|
& ix 0 . mzEffect .~ MuzzleShatter
|
|
BLINKER ->
|
|
dbwMuzzles
|
|
& ix 0 . mzEffect .~ MuzzleBlink
|
|
& ix 0 . mzAmmoSlot . aps .~ UseExactly 10000000
|
|
BLINKERUNSAFE ->
|
|
dbwMuzzles
|
|
& ix 0 . mzEffect .~ MuzzleUnsafeBlink
|
|
& ix 0 . mzAmmoSlot . aps .~ UseExactly 10000000
|
|
REWINDER ->
|
|
dbwMuzzles
|
|
& ix 0 . mzEffect .~ MuzzleRewind
|
|
& ix 0 . mzAmmoSlot . aps .~ UseExactly 100000
|
|
TIMESTOPPER ->
|
|
dbwMuzzles
|
|
& ix 0 . mzEffect .~ MuzzleStopper
|
|
& ix 0 . mzAmmoSlot . aps .~ UseExactly 100000
|
|
TIMESCROLLER ->
|
|
dbwMuzzles
|
|
& ix 0 . mzEffect .~ MuzzleScroller
|
|
& ix 0 . mzAmmoSlot . aps .~ UseExactly 100000
|
|
FLATSHIELD -> mempty
|
|
_ ->
|
|
[ Muzzle
|
|
{ _mzPos = V2 20 0
|
|
, _mzRot = 0
|
|
, _mzInaccuracy = 0.05
|
|
, _mzAmmoSlot = maguse1
|
|
, _mzFlareType = NoFlare
|
|
, _mzEffect = MuzzleShootBullet
|
|
, _mzRandomOffset = 0
|
|
}
|
|
]
|
|
where
|
|
maguse1 = MagBelow 0 (UseExactly 1)
|
|
magupto15 = MagBelow 0 (UseUpTo 15)
|
|
|
|
baseStickSpread :: Float
|
|
baseStickSpread = 0.2
|
|
|
|
dbwMuzzles :: [Muzzle]
|
|
dbwMuzzles = [Muzzle (V2 15 0) 0 0.01 (MagBelow 0 (UseExactly 1)) BasicFlare MuzzleShootBullet 0]
|
|
|
|
flameMuzzles :: [Muzzle]
|
|
flameMuzzles =
|
|
[ Muzzle
|
|
(V2 18 0)
|
|
0
|
|
0
|
|
(MagBelow 0 (UseExactly 1))
|
|
NoFlare
|
|
MuzzleNozzle
|
|
{ _nzPressure = ConstFloat 4
|
|
, _nzMaxWalkAngle = 0.2
|
|
, _nzWalkSpeed = 0.01
|
|
}
|
|
0
|
|
]
|
|
|
|
vgunMuzzles :: Int -> [Muzzle]
|
|
vgunMuzzles i =
|
|
getZipList
|
|
( ZipList [Muzzle (V2 15 x) 0 0.01 | x <- spreadAroundCenter i 6]
|
|
<*> ZipList (fmap (\j -> MagBelow j (UseExactly 1)) [0 .. i -1])
|
|
<*> pure BasicFlare
|
|
<*> pure MuzzleShootBullet
|
|
<*> pure 0
|
|
)
|
|
|
|
doHeldUseEffect :: DTree OItem -> Creature -> World -> World
|
|
doHeldUseEffect t _ w = case t ^. dtValue . _1 . itType of
|
|
HELD (VOLLEYGUN j) -> case itm ^? itParams . unfiredBarrels of
|
|
Just [_] -> fromMaybe w $ do
|
|
let (is, g) = runState (shuffle [0 .. j -1]) $ w ^. randGen
|
|
return $
|
|
w
|
|
& randGen .~ g
|
|
& crinvset . itParams . unfiredBarrels %~ const is
|
|
Just (_ : _ : _) -> w & crinvset . itParams . unfiredBarrels %~ tail
|
|
_ -> w
|
|
HELD ALTERIFLE -> w & crinvset . itParams . alteRifleSwitch %~ ((`mod` 2) . (+ 1))
|
|
_ -> w
|
|
where
|
|
crinvset = cWorld . lWorld . items . ix (itm ^. itID . unNInt)
|
|
itm = t ^. dtValue . _1
|
|
|
|
-- should probably unify failure with time use check in some way...
|
|
applyCME :: LocationDT OItem -> Creature -> Bool -> World -> World
|
|
applyCME loc cr cme
|
|
| cme =
|
|
applyInvLock itm cr
|
|
. applySoundCME itm cr
|
|
. applySidePush spush cr
|
|
. applyTorqueCME itm cr
|
|
. applyRecoil loc cr
|
|
| otherwise = failsound
|
|
where
|
|
itm = loc ^. locDT . dtValue . _1
|
|
spush = maybe 0 itemSidePush $ itm ^? itType . ibtHeld
|
|
failsound w = case w ^? input . mouseButtons . ix SDL.ButtonLeft of
|
|
Just 0 -> soundStart (CrWeaponFailSound (_crID cr)) (cr ^. crPos . _xy) click1S Nothing w
|
|
_ -> soundContinue (CrWeaponFailSound (_crID cr)) (cr ^. crPos . _xy) click1S Nothing w
|
|
|
|
itemSidePush :: HeldItemType -> Float
|
|
itemSidePush = \case
|
|
BANGSTICK{} -> 0
|
|
REWINDER -> 0
|
|
TIMESTOPPER -> 0
|
|
TIMESCROLLER -> 0
|
|
PISTOL -> 50
|
|
MACHINEPISTOL -> 50
|
|
AUTOPISTOL -> 50
|
|
SMG -> 30
|
|
BANGCONE -> 0
|
|
BLUNDERBUSS -> 0
|
|
GRAPECANNON{} -> 0
|
|
MINIGUNX i -> 10 + fromIntegral i
|
|
VOLLEYGUN{} -> 0
|
|
RIFLE -> 0
|
|
ALTERIFLE -> 0
|
|
AUTORIFLE -> 0
|
|
BURSTRIFLE -> 0
|
|
BANGROD -> 0
|
|
ELEPHANTGUN -> 0
|
|
AMR -> 0
|
|
AUTOAMR -> 0
|
|
SNIPERRIFLE -> 0
|
|
FLAMESPITTER -> 0
|
|
FLAMETHROWER -> 25
|
|
FLAMETORRENT -> 0
|
|
FLAMEWALL -> 0
|
|
BLOWTORCH -> 0
|
|
SPARKGUN -> 0
|
|
TESLAGUN -> 0
|
|
TRACTORGUN -> 0
|
|
RLAUNCHER -> 0
|
|
RLAUNCHERX{} -> 0
|
|
GLAUNCHER -> 0
|
|
POISONSPRAYER -> 0
|
|
SHATTERGUN -> 0
|
|
LED -> 0
|
|
FLATSHIELD -> 0
|
|
KEYCARD{} -> 0
|
|
BLINKER -> 0
|
|
BLINKERUNSAFE -> 0
|
|
|
|
applyInvLock :: Item -> Creature -> World -> World
|
|
applyInvLock itm cr = case itemInvLock itm of
|
|
i
|
|
| i > 0 && cid == 0 ->
|
|
(cWorld . lWorld . delayedEvents .:~ (i, UnlockInv)) . lockInv
|
|
_ -> id
|
|
where
|
|
cid = _crID cr
|
|
|
|
itemInvLock :: Item -> Int
|
|
itemInvLock itm = case itm ^. itType of
|
|
HELD hit -> heldItemInvLock hit
|
|
_ -> 0
|
|
|
|
heldItemInvLock :: HeldItemType -> Int
|
|
heldItemInvLock = \case
|
|
FLAMESPITTER -> 10
|
|
VOLLEYGUN i -> i + 1
|
|
BURSTRIFLE -> 70
|
|
_ -> 0
|
|
|
|
applySoundCME :: Item -> Creature -> World -> World
|
|
applySoundCME itm cr = fromMaybe id $ do
|
|
(soundid, x) <- bgunSound itm
|
|
return $
|
|
if x > 0
|
|
then soundContinue (CrWeaponSound cid 0) (cr ^. crPos . _xy) soundid (Just x)
|
|
else soundMultiFrom [CrWeaponSound cid j | j <- [0 .. 16]] (cr ^. crPos . _xy) soundid Nothing
|
|
where
|
|
cid = _crID cr
|
|
|
|
applyRecoil :: LocationDT OItem -> Creature -> World -> World
|
|
applyRecoil loc cr =
|
|
cWorld . lWorld . creatures . ix (_crID cr) . crPos . _xy
|
|
+~ rotateV (_crDir cr + Q.qToAng q) (V2 ((- recoilAmount itm) / crMass (_crType cr)) 0)
|
|
where
|
|
itm = loc ^. locDT . dtValue . _1
|
|
(_, q) = locOrient loc cr
|
|
|
|
recoilAmount :: Item -> Float
|
|
recoilAmount itm
|
|
| HELD hit <- itm ^. itType = case hit of
|
|
BANGSTICK _ -> 25
|
|
REWINDER -> 0
|
|
TIMESTOPPER -> 0
|
|
TIMESCROLLER -> 0
|
|
PISTOL -> 10
|
|
MACHINEPISTOL -> 5
|
|
AUTOPISTOL -> 10
|
|
SMG -> 10
|
|
BANGCONE -> 150
|
|
BLUNDERBUSS -> 150
|
|
GRAPECANNON i -> 150 + fromIntegral i * 50
|
|
MINIGUNX i -> 10 * fromIntegral i
|
|
VOLLEYGUN _ -> 30
|
|
RIFLE -> 50
|
|
ALTERIFLE -> 50
|
|
AUTORIFLE -> 50
|
|
BURSTRIFLE -> 50
|
|
BANGROD -> 50
|
|
ELEPHANTGUN -> 50
|
|
AMR -> 50
|
|
AUTOAMR -> 50
|
|
SNIPERRIFLE -> 50
|
|
FLAMESPITTER -> 0
|
|
FLAMETHROWER -> 0
|
|
FLAMETORRENT -> 0
|
|
FLAMEWALL -> 0
|
|
BLOWTORCH -> 0
|
|
SPARKGUN -> 0
|
|
TESLAGUN -> 0
|
|
TRACTORGUN -> 0
|
|
RLAUNCHER -> 0
|
|
RLAUNCHERX _ -> 0
|
|
GLAUNCHER -> 0
|
|
POISONSPRAYER -> 0
|
|
SHATTERGUN -> 0
|
|
LED -> 0
|
|
FLATSHIELD -> 0
|
|
KEYCARD _ -> 0
|
|
BLINKER -> 0
|
|
BLINKERUNSAFE -> 0
|
|
| otherwise = 0
|
|
|
|
-- if the int is 0, play sound on new channel
|
|
-- if >0, continue playing sound for given time
|
|
bgunSound :: Item -> Maybe (SoundID, Int)
|
|
bgunSound itm
|
|
| HELD hit <- itm ^. itType = case hit of
|
|
BANGSTICK _ -> Just (tap3S, 0)
|
|
REWINDER -> Nothing
|
|
TIMESTOPPER -> Nothing
|
|
TIMESCROLLER -> Nothing
|
|
PISTOL -> Just (tap3S, 0)
|
|
MACHINEPISTOL -> Just (whirTapS, 2)
|
|
AUTOPISTOL -> Just (tap1S, 0)
|
|
SMG -> Just (tap1S, 0)
|
|
BANGCONE -> Just (bangEchoS, 0)
|
|
BLUNDERBUSS -> Just (bangEchoS, 0)
|
|
GRAPECANNON _ -> Just (bangEchoS, 0)
|
|
MINIGUNX _ -> Just (mini1S, 2)
|
|
VOLLEYGUN _ -> Just (tap3S, 0)
|
|
RIFLE -> Just (tap3S, 0)
|
|
ALTERIFLE -> Just (tap3S, 0)
|
|
AUTORIFLE -> Just (tap3S, 0)
|
|
BURSTRIFLE -> Just (tap3S, 0)
|
|
BANGROD -> Just (bangEchoS, 0)
|
|
ELEPHANTGUN -> Just (bangEchoS, 0)
|
|
AMR -> Just (bangEchoS, 0)
|
|
AUTOAMR -> Just (bangEchoS, 0)
|
|
SNIPERRIFLE -> Just (bangEchoS, 0)
|
|
FLAMESPITTER -> Nothing
|
|
FLAMETHROWER -> Nothing
|
|
FLAMETORRENT -> Nothing
|
|
FLAMEWALL -> Nothing
|
|
BLOWTORCH -> Nothing
|
|
SPARKGUN -> Nothing
|
|
TESLAGUN -> Nothing
|
|
TRACTORGUN -> Nothing
|
|
RLAUNCHER -> Just (tap4S, 0)
|
|
RLAUNCHERX _ -> Just (tap4S, 0)
|
|
GLAUNCHER -> Just (tap4S, 0)
|
|
POISONSPRAYER -> Just (foamSprayLoopS, 5)
|
|
SHATTERGUN -> Nothing
|
|
LED -> Nothing
|
|
FLATSHIELD -> Nothing
|
|
KEYCARD _ -> Nothing
|
|
BLINKER -> Nothing
|
|
BLINKERUNSAFE -> Nothing
|
|
| otherwise = Nothing
|
|
|
|
applySidePush :: Float -> Creature -> World -> World
|
|
applySidePush 0 _ w = w
|
|
applySidePush maxSide cr w =
|
|
w
|
|
& cWorld . lWorld . creatures . ix cid . crPos . _xy +~ push
|
|
& randGen .~ g
|
|
where
|
|
cid = _crID cr
|
|
push = rotateV (_crDir cr) (V2 0 (pushAmount / crMass (_crType cr)))
|
|
(pushAmount, g) = randomR (- maxSide, maxSide) $ _randGen w
|
|
|
|
applyTorqueCME :: Item -> Creature -> World -> World
|
|
applyTorqueCME itm cr w =
|
|
w
|
|
& cWorld . lWorld . creatures . ix cid . crDir +~ rot
|
|
& randGen .~ g
|
|
& if cid == 0 then wCam . camRot -~ rot else id
|
|
where
|
|
cid = _crID cr
|
|
(rot, g) = randomR (- torque, torque) $ _randGen w
|
|
torque = torqueAmount itm
|
|
|
|
torqueAmount :: Item -> Float
|
|
torqueAmount itm = case itm ^. itType of
|
|
HELD hit -> heldTorqueAmount hit
|
|
_ -> 0
|
|
|
|
heldTorqueAmount :: HeldItemType -> Float
|
|
heldTorqueAmount = \case
|
|
BANGSTICK i -> 0.18 + 0.02 * fromIntegral i
|
|
REWINDER -> 0
|
|
TIMESTOPPER -> 0
|
|
TIMESCROLLER -> 0
|
|
PISTOL -> 0.2
|
|
MACHINEPISTOL -> 0.2
|
|
AUTOPISTOL -> 0.2
|
|
SMG -> 0.05
|
|
BANGCONE -> 0.1
|
|
BLUNDERBUSS -> 0.1
|
|
GRAPECANNON i -> 0.1 + 0.2 * fromIntegral i
|
|
MINIGUNX i -> 0.04 + 0.02 * fromIntegral i
|
|
VOLLEYGUN{} -> 0.1
|
|
RIFLE -> 0.1
|
|
ALTERIFLE -> 0.1
|
|
AUTORIFLE -> 0.1
|
|
BURSTRIFLE -> 0.1
|
|
BANGROD -> 0.3
|
|
ELEPHANTGUN -> 0.3
|
|
AMR -> 0.3
|
|
AUTOAMR -> 0.3
|
|
SNIPERRIFLE -> 0.3
|
|
FLAMESPITTER -> 0
|
|
FLAMETHROWER -> 0
|
|
FLAMETORRENT -> 0
|
|
FLAMEWALL -> 0
|
|
BLOWTORCH -> 0
|
|
SPARKGUN -> 0
|
|
TESLAGUN -> 0.01
|
|
TRACTORGUN -> 0
|
|
RLAUNCHER -> 0
|
|
RLAUNCHERX{} -> 0
|
|
GLAUNCHER -> 0
|
|
POISONSPRAYER -> 0
|
|
SHATTERGUN -> 0
|
|
LED -> 0
|
|
FLATSHIELD -> 0
|
|
KEYCARD{} -> 0
|
|
BLINKER -> 0
|
|
BLINKERUNSAFE -> 0
|
|
|
|
-- fugly
|
|
loadMuzzle :: LocationDT OItem -> Creature -> (Bool, World) -> Muzzle -> (Bool, World)
|
|
loadMuzzle loc cr (b, w) mz = maybe (b, w) (True,) $ case mz ^. mzAmmoSlot of
|
|
NoAmmoRequired -> return (useLoadedAmmo loc cr mz Nothing w)
|
|
as -> do
|
|
mag <- case as of
|
|
MagBelow mi _ ->
|
|
find
|
|
(isAmmoIntLink mi . (^. dtValue . _2))
|
|
(loc ^. locDT . dtLeft)
|
|
CapacitorSelf _ -> loc ^? locDT
|
|
CapacitorBelow _ ->
|
|
find
|
|
((== PulseBallSF) . (^. dtValue . _2))
|
|
(loc ^. locDT . dtLeft)
|
|
mid <- mag ^? dtValue . _1 . itID . unNInt
|
|
availableammo <- w ^? cWorld . lWorld . items . ix mid . itConsumables . _Just
|
|
let usedammo = case as ^?! aps of
|
|
UseUpTo x -> min x availableammo
|
|
UseExactly x
|
|
| x <= availableammo -> x
|
|
| otherwise -> 0
|
|
guard $ usedammo > 0
|
|
return $
|
|
useLoadedAmmo loc cr mz (Just (usedammo, mag)) $
|
|
removeAmmoFromMag usedammo mid w
|
|
|
|
makeMuzzleFlare :: Point3Q -> LocationDT OItem -> FlareType -> World -> World
|
|
makeMuzzleFlare (p, q) loc = \case
|
|
NoFlare -> id
|
|
BasicFlare -> basicMuzFlare (p ^. _xy) dir
|
|
NoLightFlare -> muzFlareAt (V4 10 10 1 3) p dir
|
|
MiniGunFlare ->
|
|
oddcheck (cWorld . lWorld . lights .:~ LSParam p 100 (V3 1 1 0.5))
|
|
. muzFlareAt (V4 10 10 1 3) p dir
|
|
HeavySmokeFlare -> basicMuzFlare (p ^. _xy) dir
|
|
LasGunFlare ->
|
|
flareCircleAt (getLaserColor loc) 0.8 p
|
|
. ( cWorld . lWorld . lights
|
|
.:~ LSParam p 100 (getLaserColor loc ^. _xyz) -- p had z=10
|
|
)
|
|
TeslaGunFlare -> cWorld . lWorld . lights .:~ LSParam p 100 (V3 0 0 1) -- p had z=10
|
|
where
|
|
dir = Q.qToAng q
|
|
oddcheck f w
|
|
| odd (w ^. cWorld . lWorld . lClock) = f w
|
|
| otherwise = w
|
|
|
|
--{-# OPTIONS -Wno-incomplete-uni-patterns #-}
|
|
muzFlareAt :: Color -> Point3 -> Float -> World -> World
|
|
muzFlareAt col x dir w =
|
|
w & randGen .~ g & cWorld . lWorld . flares <>~ thepic
|
|
where
|
|
thepic =
|
|
setLayer BloomLayer . translate3 x . color col . rotate dir . polygon $
|
|
[ V2 0 0
|
|
, V2 a (- b)
|
|
, V2 c d
|
|
]
|
|
thestate = replicateM 4 $ state $ randomR (2, 20)
|
|
(a : b : c : d : _, g) = runState thestate $ _randGen w
|
|
|
|
flareCircleAt :: Color -> Float -> Point3 -> World -> World
|
|
flareCircleAt col alphax tranv =
|
|
cWorld . lWorld . flares
|
|
<>~ setLayer
|
|
BloomLayer -- was NoZWrite
|
|
( translate3 tranv $
|
|
circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 50
|
|
)
|
|
|
|
-- previous phaseV parameters: 0.2, 1, 5
|
|
getLaserPhaseV :: LocationDT OItem -> Float
|
|
getLaserPhaseV = const 1
|
|
|
|
getLaserDamage :: LocationDT OItem -> LaserType
|
|
getLaserDamage = const (DamageLaser 11)
|
|
|
|
getLaserColor :: LocationDT OItem -> Color
|
|
getLaserColor = const yellow
|
|
|
|
basicMuzFlare :: Point2 -> Float -> World -> World
|
|
basicMuzFlare pos dir =
|
|
(cWorld . lWorld . lights .:~ LSParam (pos `v2z` 20) 100 (V3 1 1 0.5))
|
|
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
|
|
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
|
|
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
|
|
|
|
isAmmoIntLink :: Int -> ItemSF -> Bool
|
|
isAmmoIntLink i sf = Just i == sf ^? amsfLink
|
|
|
|
useLoadedAmmo
|
|
:: LocationDT OItem -> Creature -> Muzzle -> Maybe (Int, DTree OItem) -> World -> World
|
|
useLoadedAmmo loc cr mz m w =
|
|
makeMuzzleFlare pq loc (mz ^. mzFlareType) $ case _mzEffect mz of
|
|
MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w
|
|
MuzzleLaser -> creatureShootLaser pq' loc (w & randGen .~ g)
|
|
MuzzlePulseLaser -> creatureShootPulseLaser pq' cr (w & randGen .~ g)
|
|
MuzzlePulseBall -> shootPulseBall pq' (w & randGen .~ g)
|
|
MuzzleTesla -> shootTeslaArc pq' loc (w & randGen .~ g)
|
|
MuzzleTractor -> shootTractorBeam cr w
|
|
MuzzleRLauncher -> createProjectileR pq loc magtree cr w
|
|
MuzzleGLauncher ->
|
|
createProjectile
|
|
pq
|
|
(Grenade (getGrenadeHitEffect itmtree))
|
|
magtree
|
|
(getPJStabiliser itmtree)
|
|
cr
|
|
w
|
|
MuzzleNozzle{} ->
|
|
useGasParams pq' mitid mz loc cr $
|
|
walkNozzle mz itm $
|
|
w & randGen .~ g
|
|
MuzzleShatter -> shootShatter itm cr w
|
|
MuzzleDetector ->
|
|
itemDetectorEffect
|
|
itm
|
|
(getAttachedSFLink MapperSF itmtree)
|
|
(getAttachedSFLink ARHUDSF itmtree)
|
|
cr
|
|
w
|
|
MuzzleBlink -> unsafeBlinkAction cr w
|
|
MuzzleUnsafeBlink -> blinkActionMousePos cr w
|
|
MuzzleRewind -> useRewindGun (itm ^. itID) w
|
|
MuzzleStopper -> useStopWatch itm cr w
|
|
MuzzleScroller -> useTimeScrollGun itm cr w
|
|
where
|
|
pq = muzzlePos loc cr mz
|
|
(pq', g) = muzzleRandPos loc cr mz `runState` (w ^. randGen)
|
|
itmtree = loc ^. locDT
|
|
mitid = magtree ^. dtValue . _1 . itID
|
|
itm = itmtree ^. dtValue . _1
|
|
(x, magtree) = fromJust m
|
|
|
|
muzzlePos :: LocationDT OItem -> Creature -> Muzzle -> Point3Q
|
|
muzzlePos m cr muz = (p1, q1) `Q.comp` pq `Q.comp` (p3, q3)
|
|
where
|
|
pq = locOrient m cr
|
|
p1 = cr ^. crPos
|
|
q1 = Q.qz $ cr ^. crDir
|
|
p3 = addZ 0 $ muz ^. mzPos
|
|
q3 = Q.qz $ muz ^. mzRot
|
|
|
|
muzzleRandPos :: LocationDT OItem -> Creature -> Muzzle -> State StdGen Point3Q
|
|
muzzleRandPos m cr muz = do
|
|
a <- state $ randomR (- inacc, inacc)
|
|
y <- case muz ^. mzRandomOffset of
|
|
0 -> return 0
|
|
i -> state $ randomR (- i, i)
|
|
return $ muzzlePos m cr muz `Q.comp` (V3 0 y 0, Q.qz a)
|
|
where
|
|
inacc = _mzInaccuracy muz
|
|
|
|
getAttachedSFLink :: ItemSF -> DTree OItem -> Maybe (NewInt ItmInt)
|
|
getAttachedSFLink sf = (^? dtRight . folding (find f) . dtValue . _1 . itID)
|
|
where
|
|
f :: DTree OItem -> Bool
|
|
f x = x ^. dtValue . _2 == sf
|
|
|
|
itemDetectorEffect ::
|
|
Item ->
|
|
Maybe (NewInt ItmInt) ->
|
|
Maybe (NewInt ItmInt) ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
itemDetectorEffect itm mitid armitid cr w = fromMaybe w $ do
|
|
DETECTOR dt <- itm ^? itType
|
|
return $ aRadarPulse (itm ^. itID) mitid armitid (f dt) cr w
|
|
where
|
|
f ITEMDETECTOR = OTItem
|
|
f CREATUREDETECTOR = OTCreature
|
|
f WALLDETECTOR = OTWall
|
|
|
|
walkNozzle :: Muzzle -> Item -> World -> World
|
|
walkNozzle mz itm w =
|
|
w
|
|
& cWorld . lWorld . items . ix (itm ^. itID . unNInt) . itParams . nzAngle %~ f
|
|
& randGen .~ g
|
|
where
|
|
nz = _mzEffect mz
|
|
(walkamount, g) = randomR (- aspeed, aspeed) (_randGen w)
|
|
aspeed = _nzWalkSpeed nz
|
|
maxa = _nzMaxWalkAngle nz
|
|
f x = min maxa $ max (negate maxa) (x + walkamount)
|
|
|
|
shootTractorBeam :: Creature -> World -> World
|
|
shootTractorBeam cr w =
|
|
w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power
|
|
& soundContinue (CrWeaponSound (_crID cr) 0) cpos tone440sawtoothquietS (Just 2)
|
|
where
|
|
cpos = cr ^. crPos . _xy
|
|
spos = cpos +.+ (crRad (cr ^. crType) + 10) *.* unitVectorAtAngle dir
|
|
xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
|
|
dir = _crDir cr
|
|
outpos = fst $ collidePointWallsFilter (const True) cpos xpos w
|
|
power = 1
|
|
|
|
tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam
|
|
tractorBeamAt pos outpos dir power =
|
|
TractorBeam
|
|
{ _tbPos = pos
|
|
, _tbStartPos = outpos
|
|
, _tbVel = unitVectorAtAngle dir * power
|
|
, _tbTime = 10
|
|
}
|
|
|
|
creatureShootLaser :: Point3Q -> LocationDT OItem -> World -> World
|
|
creatureShootLaser (p, q) loc =
|
|
shootLaser
|
|
(ItemSound (loc ^. locDT . dtValue . _1 . itID . unNInt) 0)
|
|
(getLaserDamage loc)
|
|
(getLaserPhaseV loc)
|
|
(p ^. _xy)
|
|
(Q.qToAng q)
|
|
(getLaserColor loc)
|
|
|
|
shootLaser ::
|
|
SoundOrigin ->
|
|
LaserType ->
|
|
Float ->
|
|
Point2 ->
|
|
Float ->
|
|
Color ->
|
|
World ->
|
|
World
|
|
shootLaser so lt pv p dir col =
|
|
( cWorld . lWorld . lasers
|
|
.:~ Laser
|
|
{ _lpType = lt
|
|
, _lpPhaseV = pv
|
|
, _lpPos = p
|
|
, _lpDir = dir
|
|
, _lpColor = col
|
|
}
|
|
)
|
|
. soundContinue so p tone440sawtoothquietS (Just 2)
|
|
|
|
creatureShootPulseLaser :: Point3Q -> Creature -> World -> World
|
|
creatureShootPulseLaser (p, q) cr =
|
|
shootPulseLaser
|
|
(CrWeaponSound (_crID cr) 0)
|
|
(p ^. _xy)
|
|
(Q.qToAng q)
|
|
|
|
shootPulseLaser :: SoundOrigin -> Point2 -> Float -> World -> World
|
|
shootPulseLaser so p dir w =
|
|
w
|
|
& cWorld . lWorld . pulseLasers
|
|
.:~ PulseLaser
|
|
{ _pzPhaseV = 1
|
|
, _pzPos = p
|
|
, _pzDir = dir
|
|
, _pzDamage = 101
|
|
, _pzTimer = 5
|
|
}
|
|
& soundStart so p lasPulseS Nothing
|
|
|
|
shootPulseBall :: Point3Q -> World -> World
|
|
shootPulseBall (p, q) w =
|
|
w
|
|
& cWorld . lWorld . pulseBalls . at i
|
|
?~ PulseBall
|
|
{ _pbPos = p ^. _xy
|
|
, _pbVel = 3.5 * unitVectorAtAngle (Q.qToAng q)
|
|
, _pbTimer = 200
|
|
, _pbID = i
|
|
}
|
|
& soundStart (PBSound i) (p ^. _xy) energyReleaseS Nothing
|
|
where
|
|
i = IM.newKey $ w ^. cWorld . lWorld . pulseBalls
|
|
|
|
removeAmmoFromMag :: Int -> Int -> World -> World
|
|
removeAmmoFromMag x magid
|
|
= cWorld . lWorld . items . ix magid . itConsumables . _Just -~ x
|
|
|
|
getBulletType :: DTree OItem -> Maybe Bullet
|
|
getBulletType magtree =
|
|
(magtree ^? dtValue . _1 . to magAmmoParams . _Just . ampBullet)
|
|
<&> buPayload .~ bpayload
|
|
<&> buEffect .~ beffect
|
|
where
|
|
bpayload = fromMaybe (BulPlain 100) $ do
|
|
attree <- find ispayload (magtree ^. dtLeft)
|
|
attree ^? dtValue . _1 . itUse . ubMod . bmPayload
|
|
ispayload :: DTree OItem -> Bool
|
|
ispayload y = case y ^. dtValue . _2 of
|
|
AmmoPayloadSF{} -> True
|
|
_ -> False
|
|
beffect = fromMaybe DestroyBullet $ do
|
|
attree <- find isammoeffect (magtree ^. dtLeft)
|
|
attree ^? dtValue . _1 . itUse . ubMod . bmEffect
|
|
isammoeffect :: DTree OItem -> Bool
|
|
isammoeffect y = case y ^. dtValue . _2 of
|
|
AmmoEffectSF{} -> True
|
|
_ -> False
|
|
|
|
magAmmoParams :: Item -> Maybe AmmoParams
|
|
magAmmoParams itm = case itm ^. itType of
|
|
EQUIP FUELPACK -> Just $ GasParams ChemFuel
|
|
AMMOMAG CHEMFUELPOUCH -> Just $ GasParams ChemFuel
|
|
EQUIP BULLETBELTPACK -> Just $ BulletParams defaultBullet
|
|
EQUIP BULLETBELTBRACER -> Just $ BulletParams defaultBullet
|
|
AMMOMAG TINMAG -> Just $ BulletParams defaultBullet
|
|
AMMOMAG DRUMMAG -> Just $ BulletParams defaultBullet
|
|
AMMOMAG BELTMAG -> Just $ BulletParams defaultBullet
|
|
AMMOMAG SHELLMAG -> Just $ ProjectileParams ExplosionPayload
|
|
_ -> Nothing
|
|
|
|
--getBulletTrajectory ::
|
|
-- Muzzle ->
|
|
-- Item ->
|
|
-- BulletTrajectoryType ->
|
|
-- Point2 ->
|
|
-- Creature ->
|
|
-- World ->
|
|
-- BulletTrajectory
|
|
--getBulletTrajectory mz itm bt tp cr w = case bt of
|
|
-- BasicBulletTrajectoryType -> BasicBulletTrajectory
|
|
-- FlechetteTrajectoryType -> FlechetteTrajectory tp
|
|
-- BezierTrajectoryType -> BezierTrajectory bulpos tp (mouseWorldPos (w ^. input) (w ^. wCam))
|
|
-- MagnetTrajectoryType -> MagnetTrajectory tp
|
|
-- where
|
|
-- (moff, _) = heldItemOrient2D itm cr (_mzPos mz + V2 0 offset) (_mzRot mz)
|
|
-- bulpos = _crPos cr + rotateV (_crDir cr) moff
|
|
-- offset = case itm ^? itUse . heldParams . randomOffset of
|
|
-- Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w
|
|
-- _ -> 0
|
|
|
|
shootBullets
|
|
:: LocationDT OItem -> Creature -> (Muzzle, Int, DTree OItem) -> World -> World
|
|
shootBullets loc cr (mz, x, magtree) w = fromMaybe w $ do
|
|
thebullet <- getBulletType magtree
|
|
return $ foldl' (&) w (replicate x (shootBullet thebullet loc cr mz))
|
|
|
|
shootBullet :: Bullet -> LocationDT OItem -> Creature -> Muzzle -> World -> World
|
|
shootBullet bu loc cr mz w = makeBullet bu itm pq . (randGen .~ g) $ w
|
|
where
|
|
(pq, g) = muzzleRandPos loc cr mz `runState` (w ^. randGen)
|
|
itm = loc ^. locDT . dtValue . _1
|
|
|
|
makeBullet :: Bullet -> Item -> Point3Q -> World -> World
|
|
makeBullet thebullet itm (p, q) w =
|
|
w & randGen .~ g''
|
|
& cWorld . lWorld . bullets
|
|
.:~ ( thebullet
|
|
& buPos .~ bulpos
|
|
& buOldPos .~ bulpos
|
|
& buVel %~ (rotateV dir . (muzvel *.*))
|
|
& buDrag *~ drag
|
|
)
|
|
where
|
|
bulpos = p ^. _xy
|
|
dir = Q.qToAng q
|
|
g = _randGen w
|
|
(drag, g') = case heldItemRifling (_ibtHeld $ _itType itm) of --unsafe
|
|
ConstFloat x -> (x, g)
|
|
UniRandFloat x y -> randomR (x, y) g
|
|
(muzvel, g'') = case heldItemMuzVel $ _ibtHeld $ _itType itm of
|
|
ConstFloat x -> (x, g')
|
|
UniRandFloat x y -> randomR (x, y) g'
|
|
|
|
heldItemMuzVel :: HeldItemType -> GenFloat
|
|
heldItemMuzVel = \case
|
|
BANGSTICK{} -> ConstFloat 0.8
|
|
REWINDER -> ConstFloat 0.8
|
|
TIMESTOPPER -> ConstFloat 0.8
|
|
TIMESCROLLER -> ConstFloat 0.8
|
|
PISTOL -> ConstFloat 0.8
|
|
MACHINEPISTOL -> ConstFloat 0.8
|
|
AUTOPISTOL -> ConstFloat 0.8
|
|
SMG -> ConstFloat 0.8
|
|
BANGCONE -> UniRandFloat 0.5 0.8
|
|
BLUNDERBUSS -> UniRandFloat 0.5 0.8
|
|
GRAPECANNON{} -> UniRandFloat 0.5 0.8
|
|
MINIGUNX{} -> ConstFloat 0.8
|
|
VOLLEYGUN{} -> ConstFloat 0.8
|
|
RIFLE -> ConstFloat 0.8
|
|
ALTERIFLE -> ConstFloat 0.8
|
|
AUTORIFLE -> ConstFloat 0.8
|
|
BURSTRIFLE -> ConstFloat 0.8
|
|
BANGROD -> ConstFloat 0.8
|
|
ELEPHANTGUN -> ConstFloat 0.8
|
|
AMR -> ConstFloat 0.8
|
|
AUTOAMR -> ConstFloat 0.8
|
|
SNIPERRIFLE -> ConstFloat 0.8
|
|
FLAMESPITTER -> ConstFloat 0.8
|
|
FLAMETHROWER -> ConstFloat 0.8
|
|
FLAMETORRENT -> ConstFloat 0.8
|
|
FLAMEWALL -> ConstFloat 0.8
|
|
BLOWTORCH -> ConstFloat 0.8
|
|
SPARKGUN -> ConstFloat 0.8
|
|
TESLAGUN -> ConstFloat 0.8
|
|
TRACTORGUN -> ConstFloat 0.8
|
|
RLAUNCHER -> ConstFloat 0
|
|
RLAUNCHERX{} -> ConstFloat 0
|
|
GLAUNCHER -> ConstFloat 0
|
|
POISONSPRAYER -> ConstFloat 0.8
|
|
SHATTERGUN -> ConstFloat 0.8
|
|
LED -> ConstFloat 0.8
|
|
FLATSHIELD -> ConstFloat 0
|
|
KEYCARD{} -> ConstFloat 0.8
|
|
BLINKER -> ConstFloat 0.8
|
|
BLINKERUNSAFE -> ConstFloat 0.8
|
|
|
|
heldItemRifling :: HeldItemType -> GenFloat
|
|
heldItemRifling = \case
|
|
BANGSTICK{} -> ConstFloat 0.8
|
|
REWINDER -> ConstFloat 0.8
|
|
TIMESTOPPER -> ConstFloat 0.8
|
|
TIMESCROLLER -> ConstFloat 0.8
|
|
PISTOL -> ConstFloat 0.8
|
|
MACHINEPISTOL -> ConstFloat 0.8
|
|
AUTOPISTOL -> ConstFloat 0.8
|
|
SMG -> ConstFloat 0.8
|
|
BANGCONE -> UniRandFloat 0.3 0.8
|
|
BLUNDERBUSS -> UniRandFloat 0.3 0.8
|
|
GRAPECANNON{} -> UniRandFloat 0.3 0.8
|
|
MINIGUNX{} -> UniRandFloat 0.8 0.9
|
|
VOLLEYGUN{} -> ConstFloat 0.9
|
|
RIFLE -> ConstFloat 0.9
|
|
ALTERIFLE -> ConstFloat 0.9
|
|
AUTORIFLE -> ConstFloat 0.9
|
|
BURSTRIFLE -> ConstFloat 0.9
|
|
BANGROD -> ConstFloat 1
|
|
ELEPHANTGUN -> ConstFloat 1
|
|
AMR -> ConstFloat 1
|
|
AUTOAMR -> ConstFloat 1
|
|
SNIPERRIFLE -> ConstFloat 1
|
|
FLAMESPITTER -> ConstFloat 0.8
|
|
FLAMETHROWER -> ConstFloat 0.8
|
|
FLAMETORRENT -> ConstFloat 0.8
|
|
FLAMEWALL -> ConstFloat 0.8
|
|
BLOWTORCH -> ConstFloat 0.8
|
|
SPARKGUN -> ConstFloat 0.8
|
|
TESLAGUN -> ConstFloat 0.8
|
|
TRACTORGUN -> ConstFloat 0.8
|
|
RLAUNCHER -> ConstFloat 0
|
|
RLAUNCHERX{} -> ConstFloat 0
|
|
GLAUNCHER -> ConstFloat 0
|
|
POISONSPRAYER -> ConstFloat 0.8
|
|
SHATTERGUN -> ConstFloat 0.8
|
|
LED -> ConstFloat 0.8
|
|
FLATSHIELD -> ConstFloat 0.8
|
|
KEYCARD{} -> ConstFloat 0.8
|
|
BLINKER -> ConstFloat 0.8
|
|
BLINKERUNSAFE -> ConstFloat 0.8
|
|
|
|
mcUseHeld :: ItemType -> Item -> Machine -> World -> World
|
|
mcUseHeld hit = case hit of
|
|
LASER -> mcShootLaser
|
|
_ -> mcShootAuto
|
|
|
|
useGasParams ::
|
|
Point3Q ->
|
|
NewInt ItmInt ->
|
|
Muzzle ->
|
|
LocationDT OItem ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
useGasParams pq (NInt magitid) mz loc cr w =
|
|
w
|
|
& createGas gastype pressure (pq ^. _1 . _xy) dir cr
|
|
& randGen .~ g
|
|
where
|
|
itm = loc ^. locDT . dtValue . _1
|
|
(pressure, g) = doGenFloat (_nzPressure $ _mzEffect mz) (_randGen w)
|
|
gastype = fromMaybe (error "cannot find gas ammo") $ do
|
|
hit <- itm ^? itType . ibtHeld
|
|
fueltype <-
|
|
w ^? cWorld . lWorld . items . ix magitid
|
|
>>= magAmmoParams
|
|
>>= (^? ampCreateGas)
|
|
gasType hit fueltype
|
|
dir = Q.qToAng (pq ^. _2) + _nzAngle (_itParams itm)
|
|
|
|
gasType :: HeldItemType -> GasFuel -> Maybe GasCreate
|
|
gasType hit _ = case hit of
|
|
BANGSTICK{} -> Nothing
|
|
REWINDER -> Nothing
|
|
TIMESTOPPER -> Nothing
|
|
TIMESCROLLER -> Nothing
|
|
PISTOL -> Nothing
|
|
MACHINEPISTOL -> Nothing
|
|
AUTOPISTOL -> Nothing
|
|
SMG -> Nothing
|
|
BANGCONE -> Nothing
|
|
BLUNDERBUSS -> Nothing
|
|
GRAPECANNON{} -> Nothing
|
|
MINIGUNX{} -> Nothing
|
|
VOLLEYGUN{} -> Nothing
|
|
RIFLE -> Nothing
|
|
ALTERIFLE -> Nothing
|
|
AUTORIFLE -> Nothing
|
|
BURSTRIFLE -> Nothing
|
|
BANGROD -> Nothing
|
|
ELEPHANTGUN -> Nothing
|
|
AMR -> Nothing
|
|
AUTOAMR -> Nothing
|
|
SNIPERRIFLE -> Nothing
|
|
FLAMESPITTER -> Nothing
|
|
FLAMETHROWER -> Just CreateFlame
|
|
FLAMETORRENT -> Just CreateFlame
|
|
FLAMEWALL -> Just CreateFlame
|
|
BLOWTORCH -> Nothing
|
|
SPARKGUN -> Nothing
|
|
TESLAGUN -> Nothing
|
|
TRACTORGUN -> Nothing
|
|
RLAUNCHER -> Nothing
|
|
RLAUNCHERX{} -> Nothing
|
|
GLAUNCHER -> Nothing
|
|
POISONSPRAYER -> Just CreatePoisonGas
|
|
SHATTERGUN -> Nothing
|
|
LED -> Nothing
|
|
FLATSHIELD -> Nothing
|
|
KEYCARD{} -> Nothing
|
|
BLINKER -> Nothing
|
|
BLINKERUNSAFE -> Nothing
|
|
|
|
doGenFloat :: RandomGen g => GenFloat -> g -> (Float, g)
|
|
doGenFloat (ConstFloat x) g = (x, g)
|
|
doGenFloat (UniRandFloat x y) g = randomR (x, y) g
|
|
|
|
mcShootLaser :: Item -> Machine -> World -> World
|
|
mcShootLaser _ mc =
|
|
shootLaser (MachinePrimarySound (_mcID mc)) (DamageLaser 11) 1 pos dir yellow
|
|
where
|
|
pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
|
|
dir = mc ^?! mcType . _McTurret . tuDir
|
|
|
|
mcShootAuto :: Item -> Machine -> World -> World
|
|
mcShootAuto itm mc w
|
|
| Just i <- mc ^? mcType . mctTurret . tuWeapon
|
|
, Just (AutoTrigger rate) <- baseItemTriggerType <$> w ^? cWorld . lWorld . items . ix i
|
|
, w ^. cWorld . lWorld . lClock - rate > lastused =
|
|
w
|
|
& cWorld . lWorld . items . ix i . itTimeLastUsed
|
|
.~ w ^. cWorld . lWorld . lClock
|
|
-- & makeBullet defaultBullet itm pos dir
|
|
| otherwise = w
|
|
where
|
|
lastused = itm ^. itTimeLastUsed
|
|
|
|
-- pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
|
|
-- dir = mc ^?! mcType . _McTurret . tuDir
|
|
|
|
-- | assumes that the item is held
|
|
shootTeslaArc :: Point3Q -> LocationDT OItem -> World -> World
|
|
shootTeslaArc (p, q) loc w =
|
|
w' & cWorld . lWorld . items . ix itid . itParams .~ ip
|
|
& soundContinue (ItemSound itid 0) pos elecCrackleS (Just 2)
|
|
where
|
|
itm = loc ^. locDT . dtValue . _1
|
|
itid = itm ^. itID . unNInt
|
|
(w', ip) = makeTeslaArc (itm ^. itParams) pos (Q.qToAng q) w
|
|
pos = p ^. _xy
|
|
|
|
determineProjectileTracking :: DTree OItem -> DTree OItem -> RocketHoming
|
|
determineProjectileTracking magtree itmtree =
|
|
fromMaybe NoHoming $ finddronecontrols <|> findexternaltracking
|
|
where
|
|
finddronecontrols = do
|
|
screen <- find isremscreen (magtree ^. dtLeft)
|
|
_ <- find isjoystick (screen ^. dtLeft)
|
|
return $ HomeUsingRemoteScreen (screen ^. dtValue . _1 . itID)
|
|
findexternaltracking = do
|
|
_ <- find isammotargeting (magtree ^. dtLeft)
|
|
targetingtree <- find isweapontargeting (itmtree ^. dtRight)
|
|
return $ HomeUsingTargeting (targetingtree ^. dtValue . _1 . itID)
|
|
isremscreen :: DTree OItem -> Bool
|
|
isremscreen x = case x ^. dtValue . _2 of
|
|
RemoteScreenSF{} -> True
|
|
_ -> False
|
|
isjoystick :: DTree OItem -> Bool
|
|
isjoystick x = case x ^. dtValue . _2 of
|
|
JoystickSF{} -> True
|
|
_ -> False
|
|
isammotargeting :: DTree OItem -> Bool
|
|
isammotargeting x = case x ^. dtValue . _2 of
|
|
AmmoTargetingSF{} -> True
|
|
_ -> False
|
|
isweapontargeting :: DTree OItem -> Bool
|
|
isweapontargeting x = case x ^. dtValue . _2 of
|
|
WeaponTargetingSF{} -> True
|
|
_ -> False
|
|
|
|
createProjectileR ::
|
|
Point3Q ->
|
|
LocationDT OItem ->
|
|
DTree OItem ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
createProjectileR pq loc magtree =
|
|
createProjectile
|
|
pq
|
|
( Rocket
|
|
(determineProjectileTracking magtree itmtree)
|
|
smoke
|
|
)
|
|
magtree
|
|
(getPJStabiliser itmtree)
|
|
where
|
|
itmtree = loc ^. locDT
|
|
smoke
|
|
| isJust $ find issmokereducer (magtree ^. dtLeft) = Just ReducedRocketSmoke
|
|
| otherwise = Nothing
|
|
issmokereducer :: DTree OItem -> Bool
|
|
issmokereducer y = case y ^. dtValue . _2 of
|
|
SmokeReducerSF{} -> True
|
|
_ -> False
|
|
|
|
getPJStabiliser :: DTree OItem -> Maybe PJStabiliser
|
|
getPJStabiliser ldt = case find isprojstab (ldt ^. dtRight) of
|
|
Just ldt' -> case ldt' ^? dtValue . _1 . itType . ibtAttach of
|
|
Just GIMBAL -> Just StabOrthReduce
|
|
Just GYROSCOPE -> Just StabSpinIncrease
|
|
_ -> Nothing
|
|
_ -> Nothing
|
|
where
|
|
isprojstab :: DTree OItem -> Bool
|
|
isprojstab y = case y ^. dtValue . _2 of
|
|
ProjectileStabiliserSF{} -> True
|
|
_ -> False
|
|
|
|
getGrenadeHitEffect :: DTree OItem -> GrenadeHitEffect
|
|
getGrenadeHitEffect t = case find isghiteff (t ^. dtRight) of
|
|
Just ldt' -> case ldt' ^? dtValue . _1 . itType of
|
|
Just STICKYMOD -> GStick
|
|
_ -> GBounce 2
|
|
_ -> GBounce 2
|
|
where
|
|
isghiteff :: DTree OItem -> Bool
|
|
isghiteff y = case y ^. dtValue . _2 of
|
|
GrenadeHitEffectSF{} -> True
|
|
_ -> False
|
|
|
|
createProjectile ::
|
|
(Point3, Q.Quaternion Float) ->
|
|
ProjectileType ->
|
|
DTree OItem ->
|
|
Maybe PJStabiliser ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
createProjectile x pjtype mtree stab cr w = fromMaybe w $ do
|
|
magitid <- mtree ^? dtValue . _1 . itID . unNInt
|
|
ammoitem <- w ^? cWorld . lWorld . items . ix magitid
|
|
let rdetonate = getmid isrdet
|
|
rscreen = getmid isrscreen
|
|
aparams <-
|
|
((mtree ^? dtLeft) >>= find isampay >>= (^? dtValue . _1 . itType . ibtAttach . shellPayload))
|
|
<|> magAmmoParams ammoitem ^? _Just . ampPayload
|
|
return $ createShell x rdetonate rscreen stab pjtype aparams cr w
|
|
where
|
|
getmid t = find t (mtree ^. dtLeft) <&> (^. dtValue . _1 . itID)
|
|
isrdet :: DTree OItem -> Bool
|
|
isrdet y = case y ^. dtValue . _2 of
|
|
RemoteDetonatorSF{} -> True
|
|
_ -> False
|
|
isrscreen :: DTree OItem -> Bool
|
|
isrscreen y = case y ^. dtValue . _2 of
|
|
RemoteScreenSF{} -> True
|
|
_ -> False
|
|
isampay :: DTree OItem -> Bool
|
|
isampay y = case y ^. dtValue . _2 of
|
|
AmmoPayloadSF{} -> True
|
|
_ -> False
|
|
|
|
---- need to add these to muzzle flare?
|
|
--makeMuzzleSmoke :: Muzzle -> Item -> Creature -> World -> World
|
|
--makeMuzzleSmoke mz itm cr w = case mz ^. mzFlareType of
|
|
-- DefaultFlareType -> w
|
|
-- PistolFlare -> foldl' (flip $ smokeCloudAt (greyN 0.5) 5 400 5 . (+.+.+ pos) . (* 8)) w ps
|
|
-- MiniGunFlare -> smokeCloudAt (greyN 0.5) 5 400 5 pos w
|
|
-- HeavySmokeFlare -> foldl' (flip $ smokeCloudAt black 20 400 5 . (+.+.+ pos) . (* 8)) w ps'
|
|
-- LasGunFlare -> w
|
|
-- TeslaGunFlare -> w
|
|
-- where
|
|
-- ps = replicateM 2 randOnUnitSphere & evalState $ _randGen w
|
|
-- ps' = replicateM 4 randOnUnitSphere & evalState $ _randGen w
|
|
-- pos = addZ 10 $ _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
|
|
---- , withSmoke 1 black 20 200 5
|
|
|
|
useStopWatch :: Item -> Creature -> World -> World
|
|
useStopWatch itm _ =
|
|
timeFlow
|
|
.~ PausedTimeFlow
|
|
{ _timeFlowCharge = 100
|
|
, _scrollItemID = _itID itm
|
|
}
|
|
|
|
useTimeScrollGun :: Item -> Creature -> World -> World
|
|
useTimeScrollGun itm _ =
|
|
timeFlow
|
|
.~ ItemScrollTimeFlow
|
|
{ _scrollSmoothing = 0
|
|
, --, _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
|
|
_reverseAmount = 100
|
|
, _futureWorlds = []
|
|
, _scrollItemID = _itID itm
|
|
}
|
|
|
|
useRewindGun :: NewInt ItmInt -> World -> World
|
|
useRewindGun i =
|
|
timeFlow
|
|
.~ RewindLeftClick
|
|
{ -- { _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
|
|
_reverseAmount = 100
|
|
, _scrollItemID = i
|
|
}
|
|
|
|
dropInventoryPath ::
|
|
Int ->
|
|
InventoryPathing ->
|
|
LocationDT OItem ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
dropInventoryPath i ip loc cr = fromMaybe id $ do
|
|
invid <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
|
|
j <- getInventoryPath i ip invid cr
|
|
return $ dropItem cr j
|
|
|
|
--dropInventoryPath i ip loc cr w = case ip of
|
|
-- ABSOLUTE -> fromMaybe w $ do
|
|
-- guard $ i `IM.member` (cr ^. crInv)
|
|
-- return $ dropItem cr i w
|
|
-- RELCURS -> fromMaybe w $ do
|
|
-- j <- cr ^? crManipulation . manObject . imSelectedItem
|
|
-- guard $ (i + j) `IM.member` (cr ^. crInv)
|
|
-- return $ dropItem cr (i + j) w
|
|
-- RELITEM -> fromMaybe w $ do
|
|
-- j <- loc ^? locLDT . ldtValue . _1 . itLocation . ilInvID
|
|
-- guard $ (i + j) `IM.member` (cr ^. crInv)
|
|
-- return $ dropItem cr (i + j) w
|
|
|
|
warmupSound :: ItemType -> SoundID
|
|
warmupSound = \case
|
|
HELD MINIGUNX{} -> crankSlowS
|
|
HELD MACHINEPISTOL{} -> whirupS
|
|
_ -> crankSlowS
|
|
|
|
useInventoryPath ::
|
|
Int ->
|
|
Int ->
|
|
InventoryPathing ->
|
|
LocationDT OItem ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
useInventoryPath pt i ip loc cr w = case ip of
|
|
ABSOLUTE -> fromMaybe w $ do
|
|
guard $ i `IM.member` (cr ^. crInv . unNIntMap)
|
|
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem i pt)
|
|
RELCURS -> fromMaybe w $ do
|
|
j <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
|
|
guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap)
|
|
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
|
|
RELITEM -> fromMaybe w $ do
|
|
j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
|
|
guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap)
|
|
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
|
|
|
|
--useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of
|
|
-- [w'] -> w & cwTime . maybeWorld .~ Just' w'
|
|
-- (w' : ws) -> w
|
|
-- & cwTime . maybeWorld
|
|
-- .~ Just' w'
|
|
-- & cwTime . rewindWorlds .~ ws
|
|
-- _ -> w
|