Files
loop/src/Dodge/HeldUse.hs
T

1490 lines
49 KiB
Haskell

{-# OPTIONS -Wno-incomplete-uni-patterns #-}
--{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
module Dodge.HeldUse (
gadgetEffect,
mcUseHeld,
heldEffectMuzzles,
) where
import qualified IntMapHelp as IM
import Dodge.IsPulseLaser
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.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 LensHelp
import ListHelp
import NewInt
import Picture.Base
import qualified Quaternion as Q
import RandomHelp
import qualified SDL
import Sound.Data
gadgetEffect :: PressType -> 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
-- hammerCheck (\a b c -> creatureShootPulseBall a b cmuz c) pt loc
| DROPPER x <- loc ^. locDT . dtValue . _1 . itType
, Just i <- loc ^? locDT . dtValue . _1 . itUse . uInt
, pt == InitialPress =
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 :: PressType -> LocationDT OItem -> Creature -> World -> World
heldEffect = hammerCheck heldEffectMuzzles
hammerCheck ::
(LocationDT OItem -> Creature -> World -> World) ->
PressType ->
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)
(_crPos cr)
(warmupSound $ it ^. itType)
(Just 2)
& itmset . itParams . wTime +~ 1
WarmUpNoDelay{} -> f loc cr w & setwarming
WarmUpCoolDown ws _ _
-- UNSAFE:
| _wTime (_itParams it) < ws ->
w & setwarming
& soundContinue
(CrWeaponSound cid 0)
(_crPos cr)
(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
| w ^. cWorld . lWorld . lClock - t > timelastused
, pt == InitialPress ->
w & f loc cr & cWorld . lWorld . delayedEvents .++~ map g is
VolleyGunTrigger i t
| w ^. cWorld . lWorld . lClock - t > timelastused
, pt == InitialPress ->
let (is, gen) = getVolleyBurst i (w ^. randGen)
in w & f loc cr
& cWorld . lWorld . delayedEvents .++~ map g is
& randGen .~ gen
HammerTrigger t
| w ^. cWorld . lWorld . lClock - t > timelastused
, isNothing $ find ((== MakeAutoSF) . (^. dtValue . _2)) (loc ^. locDT . dtRight)
, pt == InitialPress ->
f loc cr w
AutoTrigger t
| w ^. cWorld . lWorld . lClock - t > timelastused -> f loc cr w
NoTrigger -> f loc cr w
_ -> w
where
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 . creatures . ix cid . crInv . ix invid
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 . creatures . ix (_crID cr) . crInv . ix itid . itTimeLastUsed
.~ w ^. cWorld . lWorld . lClock
itid = t ^?! dtValue . _1 . itLocation . ilInvID
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 . mzAmmoPerShot .~ UseExactly 200
& ix 0 . mzAmmoSlot .~ CapacitorBelow
| PulseBallSF <- loc ^. locDT . dtValue . _2 = dbwMuzzles
& ix 0 . mzEffect .~ MuzzlePulseBall
& ix 0 . mzAmmoPerShot .~ UseExactly 200
& ix 0 . mzAmmoSlot .~ CapacitorSelf
& ix 0 . mzInaccuracy .~ 0
& ix 0 . mzFlareType .~ TeslaGunFlare
| otherwise = itemMuzzles $ loc ^. locDT . dtValue . _1
itemMuzzles :: Item -> [Muzzle]
itemMuzzles itm = case itm ^. itType of
HELD ALTERIFLE ->
dbwMuzzles & ix 0 . mzPos .~ V2 25 0
& ix 0 . mzAmmoSlot .~ MagBelow (_alteRifleSwitch (_itParams itm))
HELD (VOLLEYGUN i) -> fromMaybe [] $ do
j <- itm ^? itParams . unfiredBarrels . ix 0
x <- vgunMuzzles i ^? ix j
return [x]
HELD hit -> heldItemMuzzles hit
DETECTOR{} ->
dbwMuzzles & ix 0 . mzEffect .~ MuzzleDetector
& ix 0 . mzAmmoPerShot .~ UseExactly 100
_ -> []
heldItemMuzzles :: HeldItemType -> [Muzzle]
heldItemMuzzles = \case
BANGSTICK i ->
[ Muzzle
(V2 10 0)
a
0.01
(MagBelow 0)
NoFlare
MuzzleShootBullet
(UseExactly 1)
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 (MagBelow 0) BasicFlare MuzzleShootBullet (UseExactly 1) 0]
MACHINEPISTOL -> [Muzzle (V2 10 0) 0 0.3 (MagBelow 0) MiniGunFlare MuzzleShootBullet (UseExactly 1) 0]
AUTOPISTOL -> [Muzzle (V2 10 0) 0 0 (MagBelow 0) BasicFlare MuzzleShootBullet (UseExactly 1) 0]
SMG -> [Muzzle (V2 20 0) 0 0.05 (MagBelow 0) BasicFlare MuzzleShootBullet (UseExactly 1) 0]
RIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0
BURSTRIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0 & ix 0 . mzInaccuracy .~ 0.05
MINIGUNX i ->
replicate
i
(Muzzle (V2 30 0) 0 0.05 (MagBelow 0) NoFlare MuzzleShootBullet (UseExactly 1) 10)
& 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 (MagBelow 0) BasicFlare MuzzleShootBullet (UseUpTo 15) 12]
BLUNDERBUSS -> [Muzzle (V2 30 0) 0 0.5 (MagBelow 0) BasicFlare MuzzleShootBullet (UseUpTo 15) 12]
GRAPECANNON i -> [Muzzle (V2 30 0) 0 0.5 (MagBelow 0) BasicFlare MuzzleShootBullet (UseUpTo 15) (12 + 4 * fromIntegral i)]
TORCH -> dbwMuzzles & ix 0 . mzPos .~ V2 10 0
VOLLEYGUN{} -> error "should get volleygun muzzles earlier"
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 MagBelow [0 ..])
<*> pure NoFlare
<*> pure MuzzleRLauncher
<*> pure (UseExactly 1)
<*> pure 0
)
LASER ->
dbwMuzzles
& ix 0 . mzPos .~ V2 6 0
& ix 0 . mzInaccuracy .~ 0
& ix 0 . mzFlareType .~ LasGunFlare
& ix 0 . mzEffect .~ MuzzleLaser
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 . mzAmmoPerShot .~ UseExactly 10000000
BLINKERUNSAFE ->
dbwMuzzles
& ix 0 . mzEffect .~ MuzzleUnsafeBlink
& ix 0 . mzAmmoPerShot .~ UseExactly 10000000
REWINDER ->
dbwMuzzles
& ix 0 . mzEffect .~ MuzzleRewind
& ix 0 . mzAmmoPerShot .~ UseExactly 100000
TIMESTOPPER ->
dbwMuzzles
& ix 0 . mzEffect .~ MuzzleStopper
& ix 0 . mzAmmoPerShot .~ UseExactly 100000
TIMESCROLLER ->
dbwMuzzles
& ix 0 . mzEffect .~ MuzzleScroller
& ix 0 . mzAmmoPerShot .~ UseExactly 100000
_ ->
[ Muzzle
{ _mzPos = V2 20 0
, _mzRot = 0
, _mzInaccuracy = 0.05
, _mzAmmoSlot = MagBelow 0
, _mzFlareType = NoFlare
, _mzEffect = MuzzleShootBullet
, _mzAmmoPerShot = UseExactly 1
, _mzRandomOffset = 0
}
]
baseStickSpread :: Float
baseStickSpread = 0.2
dbwMuzzles :: [Muzzle]
dbwMuzzles = [Muzzle (V2 15 0) 0 0.01 (MagBelow 0) BasicFlare MuzzleShootBullet (UseExactly 1) 0]
flameMuzzles :: [Muzzle]
flameMuzzles =
[ Muzzle
(V2 18 0)
0
0
(MagBelow 0)
NoFlare
MuzzleNozzle
{ _nzPressure = ConstFloat 4
, _nzMaxWalkAngle = 0.2
, _nzWalkSpeed = 0.01
}
(UseExactly 1)
0
]
vgunMuzzles :: Int -> [Muzzle]
vgunMuzzles i =
getZipList
( ZipList [Muzzle (V2 15 x) 0 0.01 | x <- spreadAroundCenter i 6]
<*> ZipList (fmap MagBelow [0 .. i -1])
<*> pure BasicFlare
<*> pure MuzzleShootBullet
<*> pure (UseExactly 1)
<*> pure 0
)
doHeldUseEffect :: DTree OItem -> Creature -> World -> World
doHeldUseEffect t cr 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
i <- itm ^? itLocation . ilInvID
return $
w
& randGen .~ g
& crinvset . ix i . itParams . unfiredBarrels %~ const is
Just (_ : _ : _) -> fromMaybe w $ do
i <- itm ^? itLocation . ilInvID
return $ w & crinvset . ix i . itParams . unfiredBarrels %~ tail
_ -> w
HELD ALTERIFLE -> fromMaybe w $ do
i <- t ^? dtValue . _1 . itLocation . ilInvID
return $
w & crinvset . ix i . itParams . alteRifleSwitch %~ ((`mod` 2) . (+ 1))
_ -> w
where
crinvset = cWorld . lWorld . creatures . ix (_crID cr) . crInv
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 = case itm ^. itType of
HELD MACHINEPISTOL ->
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itid . itParams
.~ WarmTime (coolstart - 1) True Nothing
-- the above is quite hacky for now
_ -> failsound
where
itm = loc ^. locDT . dtValue . _1
coolstart = fromMaybe 0 $ baseItemTriggerType itm ^? coolStart
itid = itm ^?! itLocation . ilInvID -- unsafe
spush = maybe 0 itemSidePush $ itm ^? itType . ibtHeld
failsound w = case w ^? input . mouseButtons . ix SDL.ButtonLeft of
Just 0 -> soundStart (CrWeaponFailSound (_crID cr)) (_crPos cr) click1S Nothing w
_ -> soundContinue (CrWeaponFailSound (_crID cr)) (_crPos cr) 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
LASER -> 0
TRACTORGUN -> 0
RLAUNCHER -> 0
RLAUNCHERX{} -> 0
GLAUNCHER -> 0
POISONSPRAYER -> 0
SHATTERGUN -> 0
TORCH -> 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) (_crPos cr) soundid (Just x)
else soundMultiFrom [CrWeaponSound cid j | j <- [0 .. 5]] (_crPos cr) soundid Nothing
where
cid = _crID cr
applyRecoil :: LocationDT OItem -> Creature -> World -> World
applyRecoil loc cr =
cWorld . lWorld . creatures . ix (_crID cr) . crPos
+~ 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
LASER -> 0
TRACTORGUN -> 0
RLAUNCHER -> 0
RLAUNCHERX _ -> 0
GLAUNCHER -> 0
POISONSPRAYER -> 0
SHATTERGUN -> 0
TORCH -> 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
LASER -> Nothing
TRACTORGUN -> Nothing
RLAUNCHER -> Just (tap4S, 0)
RLAUNCHERX _ -> Just (tap4S, 0)
GLAUNCHER -> Just (tap4S, 0)
POISONSPRAYER -> Just (foamSprayLoopS, 5)
SHATTERGUN -> Nothing
TORCH -> 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 +~ 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
LASER -> 0
TRACTORGUN -> 0
RLAUNCHER -> 0
RLAUNCHERX{} -> 0
GLAUNCHER -> 0
POISONSPRAYER -> 0
SHATTERGUN -> 0
TORCH -> 0
FLATSHIELD -> 0
KEYCARD{} -> 0
BLINKER -> 0
BLINKERUNSAFE -> 0
loadMuzzle :: LocationDT OItem -> Creature -> (Bool,World) -> Muzzle -> (Bool,World)
loadMuzzle loc cr (b,w) mz = fromMaybe (b,w) $ do
let as = _mzAmmoSlot mz
amamount = _mzAmmoPerShot mz
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 . itLocation . ilInvID
availableammo <- w ^? cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix mid . itConsumables . _Just
let usedammo = case amamount of
UseUpTo x -> min x availableammo
UseExactly x
| x <= availableammo -> x
| otherwise -> 0
guard $ usedammo > 0
return $ useLoadedAmmo loc cr (b,w) (Just (mz,usedammo,mag))
makeMuzzleFlare :: Muzzle -> LocationDT OItem -> Creature -> World -> World
makeMuzzleFlare mz loc cr = case mz ^. mzFlareType of
NoFlare -> id
BasicFlare -> basicMuzFlare pos dir
NoLightFlare -> muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
MiniGunFlare ->
oddcheck (cWorld . lWorld . lights .:~ LSParam (pos `v2z` 20) 100 (V3 1 1 0.5))
. muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
HeavySmokeFlare -> basicMuzFlare pos dir
LasGunFlare ->
flareCircleAt (getLaserColor loc) 0.8 (pos `v2z` 20)
. ( cWorld . lWorld . lights
.:~ LSParam (pos `v2z` 10) 100 (xyzV4 $ getLaserColor loc)
)
TeslaGunFlare -> cWorld . lWorld . lights .:~ LSParam (pos `v2z` 10) 100 (V3 0 0 1)
where
(V3 x y _, q) =
locOrient loc cr
`Q.comp` (_mzPos mz `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz))
pos = _crPos cr + rotateV (_crDir cr) (V2 x y)
dir = _crDir cr + 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 tranv dir w =
w & randGen .~ g
& cWorld . lWorld . flares <>~ thepic
where
thepic =
setLayer BloomLayer . translate3 tranv . 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
BloomNoZWrite
( 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
-- (AmmoMagSF j _) = i == j
--isAmmoIntLink _ _ = False
useLoadedAmmo ::
LocationDT OItem ->
Creature ->
(Bool, World) ->
Maybe (Muzzle, Int, DTree OItem) ->
(Bool, World)
useLoadedAmmo _ _ (cme, w) Nothing = (cme, w)
useLoadedAmmo loc cr (_, w) (Just (mz, x, magtree)) = (,) True $
removeAmmoFromMag x mid cr . makeMuzzleFlare mz loc cr $ case _mzEffect mz of
MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w
MuzzleLaser -> creatureShootLaser loc cr mz w
MuzzlePulseLaser -> creatureShootPulseLaser loc cr mz w
MuzzlePulseBall -> creatureShootPulseBall loc cr mz w
MuzzleTesla -> shootTeslaArc loc cr mz w
MuzzleTractor -> shootTractorBeam cr w
MuzzleRLauncher -> createProjectileR loc magtree mz cr w
MuzzleGLauncher ->
createProjectile
(itmtree ^. dtValue . _3)
(Grenade (getGrenadeHitEffect itmtree))
magtree
(getPJStabiliser itmtree)
mz
cr
w
MuzzleNozzle{} -> useGasParams mid mz loc cr $ walkNozzle mz itm cr w
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
itmtree = loc ^. locDT
mid = magtree ^? dtValue . _1 . itLocation . ilInvID
itm = itmtree ^. dtValue . _1
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 -> Creature -> World -> World
walkNozzle mz itm cr w = fromMaybe w $ do
invid <- itm ^? itLocation . ilInvID
return $
w
& cWorld . lWorld . creatures . ix (_crID cr) . crInv
. ix invid
. 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 = _crPos cr
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 :: LocationDT OItem -> Creature -> Muzzle -> World -> World
creatureShootLaser loc cr mz w =
w
& randGen .~ g
& shootLaser
(CrWeaponSound (_crID cr) 0)
(getLaserDamage loc)
(getLaserPhaseV loc)
pos
dir
(getLaserColor loc)
where
(V3 x y _, q) =
locOrient loc cr
`Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz))
pos = _crPos cr + rotateV (_crDir cr) (V2 x y)
dir = _crDir cr + Q.qToAng q + a
(a, g) = randomR (- inacc, inacc) $ _randGen w
inacc = _mzInaccuracy mz
offset = case mz ^. mzRandomOffset of
0 -> 0
i -> fst . randomR (- i, i) $ _randGen w
shootLaser ::
SoundOrigin ->
LaserType ->
Float ->
Point2 ->
Float ->
Color ->
World ->
World
shootLaser so lt pv p dir col w =
w
& cWorld . lWorld . lasers
.:~ Laser
{ _lpType = lt
, _lpPhaseV = pv
, _lpPos = p
, _lpDir = dir
, _lpColor = col
}
& soundContinue so p tone440sawtoothquietS (Just 2)
creatureShootPulseLaser :: LocationDT OItem -> Creature -> Muzzle -> World -> World
creatureShootPulseLaser loc cr mz w =
w
& randGen .~ g
& shootPulseLaser
(CrWeaponSound (_crID cr) 0)
pos
dir
where
(V3 x y _, q) =
locOrient loc cr
`Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz))
pos = _crPos cr + rotateV (_crDir cr) (V2 x y)
dir = _crDir cr + Q.qToAng q + a
(a, g) = randomR (- inacc, inacc) $ _randGen w
inacc = _mzInaccuracy mz
offset = case mz ^. mzRandomOffset of
0 -> 0
i -> fst . randomR (- i, i) $ _randGen w
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
creatureShootPulseBall :: LocationDT OItem -> Creature -> Muzzle -> World -> World
creatureShootPulseBall loc cr mz w = w & randGen .~ g & shootPulseBall pos dir
where
(V3 x y _, q) =
locOrient loc cr
`Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz))
pos = _crPos cr + rotateV (_crDir cr) (V2 x y)
dir = _crDir cr + Q.qToAng q + a
(a, g) = randomR (- inacc, inacc) $ _randGen w
inacc = _mzInaccuracy mz
offset = case mz ^. mzRandomOffset of
0 -> 0
i -> fst . randomR (- i, i) $ _randGen w
shootPulseBall :: Point2 -> Float -> World -> World
shootPulseBall p dir w =
w
& cWorld . lWorld . pulseBalls . at i ?~
PulseBall
{ _pbPos = p
, _pbVel = 3.5 * unitVectorAtAngle dir
, _pbTimer = 100
, _pbID = i
}
& soundStart (PBSound i) p energyReleaseS Nothing
where
i = IM.newKey $ w ^. cWorld . lWorld . pulseBalls
removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
removeAmmoFromMag x mid cr = fromMaybe id $ do
magid <- mid
return $
cWorld . lWorld . creatures
. ix (_crID cr)
. crInv
. 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 bulpos dir . (randGen .~ g) $ w
where
(V3 x y _, q) =
locOrient loc cr
`Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz))
itm = loc ^. locDT . dtValue . _1
bulpos = _crPos cr + rotateV (_crDir cr) (V2 x y)
(a, g) = randomR (- inacc, inacc) $ _randGen w
dir = _crDir cr + Q.qToAng q + a
inacc = _mzInaccuracy mz
offset = case mz ^. mzRandomOffset of
0 -> 0
i -> fst . randomR (- i, i) $ _randGen w
makeBullet :: Bullet -> Item -> Point2 -> Float -> World -> World
makeBullet thebullet itm bulpos dir w =
w & randGen .~ g''
& cWorld . lWorld . bullets
.:~ ( thebullet
& buPos .~ bulpos
& buOldPos .~ bulpos
& buVel %~ (rotateV dir . (muzvel *.*))
& buDrag *~ drag
)
where
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
LASER -> ConstFloat 0.8
TRACTORGUN -> ConstFloat 0.8
RLAUNCHER -> ConstFloat 0
RLAUNCHERX{} -> ConstFloat 0
GLAUNCHER -> ConstFloat 0
POISONSPRAYER -> ConstFloat 0.8
SHATTERGUN -> ConstFloat 0.8
TORCH -> 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
LASER -> ConstFloat 0.8
TRACTORGUN -> ConstFloat 0.8
RLAUNCHER -> ConstFloat 0
RLAUNCHERX{} -> ConstFloat 0
GLAUNCHER -> ConstFloat 0
POISONSPRAYER -> ConstFloat 0.8
SHATTERGUN -> ConstFloat 0.8
TORCH -> ConstFloat 0.8
FLATSHIELD -> ConstFloat 0.8
KEYCARD{} -> ConstFloat 0.8
BLINKER -> ConstFloat 0.8
BLINKERUNSAFE -> ConstFloat 0.8
mcUseHeld :: HeldItemType -> Item -> Machine -> World -> World
mcUseHeld hit = case hit of
LASER -> mcShootLaser
_ -> mcShootAuto
useGasParams :: Maybe Int -> Muzzle -> LocationDT OItem -> Creature -> World -> World
useGasParams mmagid mz loc cr w =
w
& createGas gastype pressure pos 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
magid <- mmagid
hit <- itm ^? itType . ibtHeld
fueltype <- cr ^? crInv . ix magid >>= magAmmoParams >>= (^? ampCreateGas)
gasType hit fueltype
(V3 x y _, q) =
locOrient loc cr
`Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz))
pos = _crPos cr + rotateV (_crDir cr) (V2 x y)
(a, g') = randomR (- inacc, inacc) g
inacc = _mzInaccuracy mz
offset = case mz ^. mzRandomOffset of
0 -> 0
i -> fst . randomR (- i, i) $ _randGen w
dir = _crDir cr + Q.qToAng q + a + _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
LASER -> Nothing
TRACTORGUN -> Nothing
RLAUNCHER -> Nothing
RLAUNCHERX{} -> Nothing
GLAUNCHER -> Nothing
POISONSPRAYER -> Just CreatePoisonGas
SHATTERGUN -> Nothing
TORCH -> 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 (MachineSound (_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 (AutoTrigger rate) <- baseItemTriggerType <$> mc ^? mcType . mctTurret . tuWeapon
, w ^. cWorld . lWorld . lClock - rate > lastused =
w
& cWorld . lWorld . machines . ix (_mcID mc) . mcType . mctTurret . tuWeapon
. 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 :: LocationDT OItem -> Creature -> Muzzle -> World -> World
shootTeslaArc loc cr mz w =
w' & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itParams .~ ip
& soundContinue (CrWeaponSound (_crID cr) 0) pos elecCrackleS (Just 2)
where
itm = loc ^. locDT . dtValue . _1
invid = itm ^?! itLocation . ilInvID
(w', ip) = makeTeslaArc (itm ^. itParams) pos dir w
(V3 x y _, q) =
locOrient loc cr
`Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz))
pos = _crPos cr + rotateV (_crDir cr) (V2 x y)
dir = _crDir cr + Q.qToAng q
offset = case mz ^. mzRandomOffset of
0 -> 0
i -> fst . randomR (- i, i) $ _randGen w
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 ::
LocationDT OItem ->
DTree OItem ->
Muzzle ->
Creature ->
World ->
World
createProjectileR loc magtree =
createProjectile
(loc ^. locDT . dtValue . _3)
( 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 ->
Muzzle ->
Creature ->
World ->
World
createProjectile x pjtype magtree stab muz cr = fromMaybe failsound $ do
magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
ammoitem <- cr ^? crInv . ix magid
let rdetonate =
(^. dtValue . _1 . itID)
<$> find isrdet (magtree ^. dtLeft)
rscreen =
(^. dtValue . _1 . itID)
<$> find isrscreen (magtree ^. dtLeft)
aparams <-
((magtree ^? dtLeft) >>= find isampay >>= (^? dtValue . _1 . itType . ibtAttach . shellPayload))
-- <|> ammoitem ^? itConsumables . magParams . ampPayload
<|> magAmmoParams ammoitem ^? _Just . ampPayload
return $
createShell x rdetonate rscreen stab pjtype aparams muz cr
. startthesound
where
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
-- the sound should be moved to the projectile firing
startthesound =
soundMultiFrom
[CrWeaponSound (_crID cr) j | j <- [0 .. 3]]
(_crPos cr)
tap4S
Nothing
failsound w' = case w' ^? input . mouseButtons . ix SDL.ButtonLeft of
Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
_ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
---- 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
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 ::
PressType ->
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)
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem i pt)
RELCURS -> fromMaybe w $ do
j <- cr ^? crManipulation . manObject . imSelectedItem
guard $ (i + j) `IM.member` (cr ^. crInv)
return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
RELITEM -> fromMaybe w $ do
j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID
guard $ (i + j) `IM.member` (cr ^. crInv)
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