1210 lines
39 KiB
Haskell
1210 lines
39 KiB
Haskell
{-# OPTIONS -Wno-incomplete-uni-patterns #-}
|
|
--{-# LANGUAGE TupleSections #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Dodge.HeldUse (
|
|
heldEffect,
|
|
gadgetEffect,
|
|
heldEffectNoHammerCheck,
|
|
mcUseHeld,
|
|
) where
|
|
|
|
import Color
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Data.Maybe
|
|
import Dodge.Base.Collide
|
|
import Dodge.BaseTriggerType
|
|
import Dodge.Creature.Action
|
|
import Dodge.Data.ComposedItem
|
|
import Dodge.Data.DoubleTree
|
|
import Dodge.Data.MuzzleEffect
|
|
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 RandomHelp
|
|
import qualified SDL
|
|
import Sound.Data
|
|
|
|
gadgetEffect ::
|
|
PressType ->
|
|
LocationLDT ItemLink ComposedItem ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
gadgetEffect pt loc
|
|
| UseHeld{} <- loc ^. locLDT . ldtValue . _1 . itUse =
|
|
heldEffect
|
|
pt
|
|
(bimap _iatType (^. _1) (loc ^. locLDT))
|
|
| DROPPER x <- loc ^. locLDT . ldtValue . _1 . itType
|
|
, Just i <- loc ^? locLDT . ldtValue . _1 . itUse . uInt
|
|
, pt == InitialPress =
|
|
dropInventoryPath i x loc
|
|
| CLICKER x <- loc ^. locLDT . ldtValue . _1 . itType
|
|
, Just i <- loc ^? locLDT . ldtValue . _1 . itUse . uInt =
|
|
useInventoryPath pt i x loc
|
|
| otherwise = const id
|
|
|
|
heldEffect ::
|
|
PressType ->
|
|
LabelDoubleTree ComposeLinkType Item ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
heldEffect = hammerCheck heldEffectNoHammerCheck
|
|
|
|
heldEffectNoHammerCheck ::
|
|
LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
|
heldEffectNoHammerCheck = useTimeCheck heldEffectMuzzles
|
|
|
|
type ChainEffect =
|
|
(LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World) ->
|
|
LabelDoubleTree ComposeLinkType Item ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
|
|
hammerCheck ::
|
|
(LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World) ->
|
|
PressType ->
|
|
LabelDoubleTree ComposeLinkType Item ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
hammerCheck f pt it cr
|
|
| BurstTrigger is <- baseTriggerType (it ^. ldtValue)
|
|
, pt == InitialPress =
|
|
f it cr
|
|
. (cWorld . lWorld . delayedEvents .++~ map g is)
|
|
| BurstTrigger{} <- baseTriggerType (it ^. ldtValue)
|
|
, pt /= InitialPress =
|
|
id
|
|
| t <- baseTriggerType (it ^. ldtValue)
|
|
, t == HammerTrigger || t == AlwaysSingleTrigger
|
|
, isNothing $ lookup MakeAutoLink (it ^. ldtRight)
|
|
, pt /= InitialPress =
|
|
id
|
|
| otherwise = f it cr
|
|
where
|
|
g x = (x, WdWdFromItCrixWdWd (upitm x) (_crID cr) ItCrWdItemHeldEffectNoHammer)
|
|
upitm x =
|
|
it -- & ldtValue . itUse . heldParams . weaponRepeat .~ []
|
|
& ldtValue . itUse . heldFrame .~ x
|
|
|
|
--g x = (x, WdWdBurstFireRepeats (_crID cr) (it ^?! ldtValue . itLocation . ilInvID))
|
|
|
|
-- | Applies a world effect after an item use cooldown check.
|
|
useTimeCheck :: ChainEffect
|
|
useTimeCheck f item cr w = case item ^? ldtValue . itUse . heldDelay of
|
|
Just (FixedRate rate lastused)
|
|
| w ^. cWorld . lWorld . lClock - rate > lastused -> f item cr $ setUseRate w
|
|
Just FixedRate{} -> w
|
|
Just (WarmUpNoDelay wt wm ws)
|
|
| wt < wm ->
|
|
w
|
|
& soundContinue (CrWeaponSound cid 0) (_crPos cr) ws (Just 2)
|
|
& cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . warmTime +~ 2
|
|
Just (WarmUpNoDelay _ wm _) ->
|
|
f item cr w
|
|
& cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . warmTime .~ (wm + 1)
|
|
Just NoDelay -> f item cr w
|
|
Nothing -> w
|
|
where
|
|
cid = _crID cr
|
|
setUseRate =
|
|
cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . rateTimeLastUsed
|
|
.~ w ^. cWorld . lWorld . lClock
|
|
-- the following is unsafe, but if ilInvID isn't correctly set we probably
|
|
-- will have problems elsewhere also
|
|
itRef = item ^?! ldtValue . itLocation . ilInvID
|
|
|
|
heldEffectMuzzles :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
|
heldEffectMuzzles t cr w =
|
|
doHeldUseEffect t cr $
|
|
uncurry (applyCME (_ldtValue t) cr) cmew
|
|
where
|
|
-- & doWeaponRepetitions upitm cr
|
|
|
|
muzzles = t ^. ldtValue . itUse . heldMuzzles
|
|
--(upitm, loadedmuzzles) = mapAccumR loadMuzzle t muzzles
|
|
(_, loadedmuzzles) = mapAccumR loadMuzzle t muzzles
|
|
cmew = foldl' (useLoadedAmmo t cr) (CME 0 0 False, w) $ zip [0 ..] loadedmuzzles
|
|
|
|
doHeldUseEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
|
doHeldUseEffect t cr w = case t ^? ldtValue . itUse . heldUseEffect of
|
|
Just (RandomiseMuzzleFrames x) -> fromMaybe w $ do
|
|
i <- t ^? ldtValue . itLocation . ilInvID
|
|
let g = w ^. randGen
|
|
(is, g') = runState (shuffle [0 .. x -1]) g
|
|
return $
|
|
w & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i . itUse . heldMuzzles %~ zipWith (\j mz -> mz & mzFrame .~ j) is
|
|
& randGen .~ g'
|
|
Just SwitchAlteRifle -> fromMaybe w $ do
|
|
i <- t ^? ldtValue . itLocation . ilInvID
|
|
return $
|
|
w
|
|
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i
|
|
. itUse
|
|
. heldMuzzles
|
|
. ix 0
|
|
. mzAmmoSlot
|
|
%~ ((`mod` 2) . (+ 1))
|
|
Just NoHeldUseEffect -> w
|
|
Nothing -> w
|
|
|
|
---- need to be careful about inventory lock or item ids here
|
|
--doWeaponRepetitions :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
|
--doWeaponRepetitions itm cr = case itm ^? ldtValue . itUse . heldParams . weaponRepeat of
|
|
-- Just xs -> cWorld . lWorld . delayedEvents .++~ map f xs
|
|
-- _ -> id
|
|
-- where
|
|
-- f x = (x, WdWdFromItCrixWdWd (upitm x) (_crID cr) ItCrWdItemHeldEffect)
|
|
-- upitm x =
|
|
-- itm & ldtValue . itUse . heldParams . weaponRepeat .~ []
|
|
-- & ldtValue . itUse . heldFrame .~ x
|
|
|
|
applyCME :: Item -> Creature -> CumulativeMuzzleEffect -> World -> World
|
|
applyCME itm cr cme
|
|
| _cmeSound cme =
|
|
applyInvLock itm cr
|
|
. applySoundCME itm cr
|
|
. applySidePush spush cr
|
|
. applyTorqueCME itm cr
|
|
. applyRecoil itm cr
|
|
| otherwise = failsound
|
|
where
|
|
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
|
|
| i <- itemInvLock itm
|
|
, i > 0 =
|
|
(cWorld . lWorld . delayedEvents .:~ (i, UnlockInv cid))
|
|
. lockInv cid
|
|
| otherwise = 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 -> 7
|
|
_ -> 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 :: Item -> Creature -> World -> World
|
|
applyRecoil itm cr =
|
|
cWorld . lWorld . creatures . ix (_crID cr) . crPos
|
|
+~ rotateV (_crDir cr) (V2 ((- recoilAmount itm) / _crMass cr) 0)
|
|
|
|
recoilAmount :: Item -> Float
|
|
recoilAmount itm
|
|
| HELD hit <- itm ^. itType = case hit of
|
|
BANGSTICK _ -> 25
|
|
REWINDER -> 0
|
|
TIMESTOPPER -> 0
|
|
TIMESCROLLER -> 0
|
|
PISTOL -> 10
|
|
MACHINEPISTOL -> 15
|
|
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 (tap1S, 0)
|
|
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 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
|
|
LASER -> 0
|
|
TRACTORGUN -> 0
|
|
RLAUNCHER -> 0
|
|
RLAUNCHERX{} -> 0
|
|
GLAUNCHER -> 0
|
|
POISONSPRAYER -> 0
|
|
SHATTERGUN -> 0
|
|
TORCH -> 0
|
|
FLATSHIELD -> 0
|
|
KEYCARD{} -> 0
|
|
BLINKER -> 0
|
|
BLINKERUNSAFE -> 0
|
|
|
|
-- (Muzzle,Int,Int) = (muzzle, amountloaded, id of mag taken from)
|
|
loadMuzzle ::
|
|
LabelDoubleTree ComposeLinkType Item ->
|
|
Muzzle ->
|
|
(LabelDoubleTree ComposeLinkType Item, Maybe (Muzzle, Int, LabelDoubleTree ComposeLinkType Item))
|
|
loadMuzzle t@(LDT _ l _) mz = fromMaybe (t, Nothing) $ do
|
|
guard $ mz ^? mzFrame == t ^? ldtValue . itUse . heldFrame
|
|
let as = _mzAmmoSlot mz
|
|
amamount = _mzAmmoPerShot mz
|
|
(i, (_, mag)) <- findWithIx (isAmmoIntLink as . fst) l
|
|
availableammo <- mag ^? ldtValue . itConsumables . magLoadStatus . iaLoaded
|
|
let usedammo = case amamount of
|
|
UseUpTo x -> min x availableammo
|
|
UseExactly x
|
|
| x <= availableammo -> x
|
|
| otherwise -> 0
|
|
guard $ usedammo > 0
|
|
return
|
|
( t & ldtLeft . ix i . _2 . ldtValue . itConsumables . magLoadStatus . iaLoaded
|
|
-~ usedammo
|
|
, Just (mz, usedammo, mag)
|
|
)
|
|
|
|
makeMuzzleFlare :: Muzzle -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
|
makeMuzzleFlare mz itmtree cr = case mz ^. mzFlareType of
|
|
NoFlare -> id
|
|
BasicFlare -> basicMuzFlare pos dir
|
|
NoLightFlare -> muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir
|
|
MiniGunFlare ->
|
|
(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 itmtree) 0.8 (pos `v2z` 20)
|
|
-- . ( cWorld . lWorld . tempLightSources
|
|
-- .:~ tlsTimeRadColPos 1 100 (xyzV4 $ getLaserColor itmtree) (pos `v2z` 10)
|
|
. ( cWorld . lWorld . lights
|
|
.:~ LSParam (pos `v2z` 10) 100 (xyzV4 $ getLaserColor itmtree)
|
|
)
|
|
TeslaGunFlare ->
|
|
cWorld . lWorld . lights
|
|
.:~ LSParam (pos `v2z` 10) 100 (V3 0 0 1)
|
|
where
|
|
-- .:~ tlsTimeRadColPos 1 100 (V3 0 0 1) (pos `v2z` 10)
|
|
|
|
itm = itmtree ^. ldtValue
|
|
(moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
|
|
pos = _crPos cr + rotateV (_crDir cr) moff
|
|
dir = _crDir cr + mrot
|
|
|
|
--{-# 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 BloomNoZWrite . 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 -- randomRs (2, 20) (_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 :: LabelDoubleTree ComposeLinkType Item -> Float
|
|
getLaserPhaseV = const 1
|
|
|
|
getLaserDamage :: LabelDoubleTree ComposeLinkType Item -> LaserType
|
|
getLaserDamage = const (DamageLaser 11)
|
|
|
|
getLaserColor :: LabelDoubleTree ComposeLinkType Item -> 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 -> ComposeLinkType -> Bool
|
|
isAmmoIntLink i (AmmoInLink j _) = i == j
|
|
isAmmoIntLink _ _ = False
|
|
|
|
useLoadedAmmo ::
|
|
LabelDoubleTree ComposeLinkType Item ->
|
|
Creature ->
|
|
(CumulativeMuzzleEffect, World) ->
|
|
(Int, Maybe (Muzzle, Int, LabelDoubleTree ComposeLinkType Item)) ->
|
|
(CumulativeMuzzleEffect, World)
|
|
useLoadedAmmo _ _ (cme, w) (_, Nothing) = (cme, w)
|
|
useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cmeSound .~ True) $
|
|
removeAmmoFromMag x mid cr . makeMuzzleFlare mz itmtree cr $ case _mzEffect mz of
|
|
MuzzleShootBullet -> shootBullet itmtree cr (mz, x, magtree) w
|
|
MuzzleLaser -> creatureShootLaser itmtree cr mz w
|
|
MuzzleTesla -> shootTeslaArc itm cr mz w
|
|
MuzzleTractor -> shootTractorBeam cr w
|
|
MuzzleRLauncher -> createProjectileR itmtree magtree mz cr w
|
|
MuzzleGLauncher ->
|
|
createProjectile
|
|
(Grenade (getGrenadeHitEffect itmtree))
|
|
magtree
|
|
(getPJStabiliser itmtree)
|
|
mz
|
|
cr
|
|
w
|
|
MuzzleNozzle{} -> useGasParams mid mz itm cr $ walkNozzle mzid 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
|
|
mid = magtree ^? ldtValue . itLocation . ilInvID
|
|
itm = itmtree ^. ldtValue
|
|
|
|
getAttachedSFLink ::
|
|
ItemStructuralFunction ->
|
|
LabelDoubleTree ComposeLinkType Item ->
|
|
Maybe (NewInt ItmInt)
|
|
getAttachedSFLink sf = (^? ldtRight . folding (lookup (SFLink sf)) . ldtValue . itID)
|
|
|
|
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 = ObItem
|
|
f CREATUREDETECTOR = ObCreature
|
|
f WALLDETECTOR = ObWall
|
|
|
|
walkNozzle :: Int -> Muzzle -> Item -> Creature -> World -> World
|
|
walkNozzle mzid mz itm cr w = fromMaybe w $ do
|
|
invid <- itm ^? itLocation . ilInvID
|
|
return $
|
|
w
|
|
& cWorld . lWorld . creatures . ix (_crID cr) . crInv
|
|
. ix invid
|
|
. itUse
|
|
. heldMuzzles
|
|
. ix mzid
|
|
. mzEffect
|
|
. nzCurrentWalkAngle
|
|
.~ wa
|
|
& randGen .~ g
|
|
where
|
|
nz = _mzEffect mz
|
|
(walkamount, g) = randomR (- aspeed, aspeed) (_randGen w)
|
|
aspeed = _nzWalkSpeed nz
|
|
maxa = _nzMaxWalkAngle nz
|
|
wa = min maxa $ max (negate maxa) (_nzCurrentWalkAngle nz + 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 + 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 = d
|
|
, _tbTime = 10
|
|
}
|
|
where
|
|
d = unitVectorAtAngle dir * power
|
|
|
|
creatureShootLaser ::
|
|
LabelDoubleTree ComposeLinkType Item ->
|
|
Creature ->
|
|
Muzzle ->
|
|
World ->
|
|
World
|
|
creatureShootLaser itmtree cr mz w =
|
|
w
|
|
& randGen .~ g
|
|
& shootLaser
|
|
(CrWeaponSound (_crID cr) 0)
|
|
(getLaserDamage itmtree)
|
|
(getLaserPhaseV itmtree)
|
|
pos
|
|
dir
|
|
(getLaserColor itmtree)
|
|
where
|
|
itm = itmtree ^. ldtValue
|
|
(moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
|
|
pos = _crPos cr + rotateV (_crDir cr) moff
|
|
dir = _crDir cr + mrot + a
|
|
(a, g) = randomR (- inacc, inacc) $ _randGen w
|
|
inacc = _mzInaccuracy mz
|
|
|
|
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)
|
|
|
|
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
|
|
. magLoadStatus
|
|
. iaLoaded
|
|
-~ x
|
|
|
|
getBulletType :: LabelDoubleTree ComposeLinkType Item -> Maybe Bullet
|
|
getBulletType magtree =
|
|
magtree ^? ldtValue . itConsumables . magParams . ampBullet
|
|
-- <&> buTrajectory .~ btraj
|
|
<&> buPayload .~ bpayload
|
|
<&> buEffect .~ beffect
|
|
where
|
|
-- btraj = fromMaybe BasicBulletTrajectory $ do
|
|
-- targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these?
|
|
-- tp <- targetingtree ^? ldtValue . itTargeting . itTgPos . _Just
|
|
-- attree <- lookup AmmoTargetingLink (magtree ^. ldtLeft)
|
|
-- bt <- attree ^? ldtValue . itUse . ubMod . bmTrajectory
|
|
-- return $ getBulletTrajectory mz (itmtree ^. ldtValue) bt tp cr w
|
|
bpayload = fromMaybe BulSpark $ do
|
|
attree <- lookup AmmoPayloadLink (magtree ^. ldtLeft)
|
|
attree ^? ldtValue . itUse . ubMod . bmPayload
|
|
beffect = fromMaybe DestroyBullet $ do
|
|
attree <- lookup AmmoEffectLink (magtree ^. ldtLeft)
|
|
attree ^? ldtValue . itUse . ubMod . bmEffect
|
|
|
|
--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
|
|
|
|
shootBullet ::
|
|
LabelDoubleTree ComposeLinkType Item ->
|
|
Creature ->
|
|
(Muzzle, Int, LabelDoubleTree ComposeLinkType Item) ->
|
|
World ->
|
|
World
|
|
shootBullet itmtree cr (mz, x, magtree) w = fromMaybe w $ do
|
|
thebullet <- getBulletType magtree
|
|
return $ foldl' (&) w (replicate x (makeBullet' thebullet (itmtree ^. ldtValue) cr mz))
|
|
|
|
makeBullet' :: Bullet -> Item -> Creature -> Muzzle -> World -> World
|
|
makeBullet' bu itm cr mz w = makeBullet bu itm bulpos dir . (randGen .~ g) $ w
|
|
where
|
|
bulpos = _crPos cr + rotateV (_crDir cr) moff
|
|
(moff, mrot) = heldItemOrient2D itm cr (_mzPos mz + V2 0 offset) (_mzRot mz)
|
|
(a, g) = randomR (- inacc, inacc) $ _randGen w
|
|
dir = _crDir cr + mrot + a
|
|
inacc = _mzInaccuracy mz
|
|
offset = case itemRandomOffset <$> itm ^? itType . ibtHeld of
|
|
Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w
|
|
_ -> 0
|
|
|
|
-- & makeMuzzleSmoke mz itm cr
|
|
|
|
itemRandomOffset :: HeldItemType -> Float
|
|
itemRandomOffset = \case
|
|
BANGSTICK{} -> 0
|
|
REWINDER -> 0
|
|
TIMESTOPPER -> 0
|
|
TIMESCROLLER -> 0
|
|
PISTOL -> 0
|
|
MACHINEPISTOL -> 0
|
|
AUTOPISTOL -> 0
|
|
SMG -> 0
|
|
BANGCONE -> 12
|
|
BLUNDERBUSS -> 12
|
|
GRAPECANNON i -> 12 + 4 * fromIntegral i
|
|
MINIGUNX{} -> 10
|
|
VOLLEYGUN{} -> 0
|
|
RIFLE -> 0
|
|
ALTERIFLE -> 0
|
|
AUTORIFLE -> 0
|
|
BURSTRIFLE -> 0
|
|
BANGROD -> 0
|
|
ELEPHANTGUN -> 0
|
|
AMR -> 0
|
|
AUTOAMR -> 0
|
|
SNIPERRIFLE -> 0
|
|
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
|
|
|
|
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 -> Item -> Creature -> World -> World
|
|
useGasParams mmagid mz itm cr w =
|
|
w
|
|
& createGas gastype pressure pos dir cr
|
|
& randGen .~ g'
|
|
where
|
|
(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 . itConsumables . magParams . ampCreateGas
|
|
gasType hit fueltype
|
|
--pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
|
|
(moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
|
|
pos = _crPos cr + rotateV (_crDir cr) moff
|
|
(a, g') = randomR (- inacc, inacc) g
|
|
inacc = _mzInaccuracy mz
|
|
dir = _crDir cr + mrot + a + _nzCurrentWalkAngle (_mzEffect mz)
|
|
|
|
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 (FixedRate rate lastused) <- mc ^? mcType . mctTurret . tuWeapon . itUse . heldDelay
|
|
, w ^. cWorld . lWorld . lClock - rate > lastused =
|
|
w
|
|
& cWorld . lWorld . machines . ix (_mcID mc) . mcType . mctTurret . tuWeapon
|
|
. itUse
|
|
. heldDelay
|
|
. rateTimeLastUsed
|
|
.~ w ^. cWorld . lWorld . lClock
|
|
& makeBullet defaultBullet itm pos dir
|
|
| otherwise = w
|
|
where
|
|
pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
|
|
dir = mc ^?! mcType . _McTurret . tuDir
|
|
|
|
-- | assumes that the item is held
|
|
shootTeslaArc :: Item -> Creature -> Muzzle -> World -> World
|
|
shootTeslaArc itm cr mz w =
|
|
w' & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip
|
|
& soundContinue (CrWeaponSound (_crID cr) 0) pos elecCrackleS (Just 2)
|
|
where
|
|
-- use items item location instead
|
|
itRef = cr ^?! crManipulation . manObject . imRootSelectedItem -- unsafe!! TODO change
|
|
(w', ip) = makeTeslaArc (_itParams itm) pos dir w
|
|
(moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
|
|
pos = _crPos cr + rotateV (_crDir cr) moff
|
|
dir = _crDir cr + mrot
|
|
|
|
determineProjectileTracking ::
|
|
LabelDoubleTree ComposeLinkType Item ->
|
|
LabelDoubleTree ComposeLinkType Item ->
|
|
RocketHoming
|
|
determineProjectileTracking magtree itmtree =
|
|
fromMaybe NoHoming $
|
|
finddronecontrols <|> findexternaltracking
|
|
where
|
|
finddronecontrols = do
|
|
screen <- lookup RemoteScreenLink (magtree ^. ldtLeft)
|
|
_ <- lookup JoystickLink (screen ^. ldtLeft)
|
|
return $ HomeUsingRemoteScreen (screen ^. ldtValue . itID)
|
|
findexternaltracking = do
|
|
_ <- lookup AmmoTargetingLink (magtree ^. ldtLeft)
|
|
targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight)
|
|
return $ HomeUsingTargeting (targetingtree ^. ldtValue . itID)
|
|
|
|
createProjectileR ::
|
|
LabelDoubleTree ComposeLinkType Item ->
|
|
LabelDoubleTree ComposeLinkType Item ->
|
|
Muzzle ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
createProjectileR itmtree magtree =
|
|
createProjectile
|
|
( Rocket
|
|
(determineProjectileTracking magtree itmtree)
|
|
smoke
|
|
)
|
|
magtree
|
|
(getPJStabiliser itmtree)
|
|
where
|
|
smoke
|
|
| isJust $ lookup SmokeReducerLink (magtree ^. ldtLeft) = Just ReducedRocketSmoke
|
|
| otherwise = Nothing
|
|
|
|
getPJStabiliser :: LabelDoubleTree ComposeLinkType Item -> Maybe PJStabiliser
|
|
getPJStabiliser ldt = case lookup ProjectileStabiliserLink (ldt ^. ldtRight) of
|
|
Just ldt' -> case ldt' ^? ldtValue . itType . ibtAttach of
|
|
Just GIMBAL -> Just StabOrthReduce
|
|
Just GYROSCOPE -> Just StabSpinIncrease
|
|
_ -> Nothing
|
|
_ -> Nothing
|
|
|
|
getGrenadeHitEffect :: LabelDoubleTree ComposeLinkType Item -> GrenadeHitEffect
|
|
getGrenadeHitEffect t = case lookup GrenadeHitEffectLink (t ^. ldtRight) of
|
|
Just ldt' -> case ldt' ^? ldtValue . itType of
|
|
Just STICKYMOD -> GStick
|
|
_ -> GBounce 2
|
|
_ -> GBounce 2
|
|
|
|
createProjectile ::
|
|
ProjectileType ->
|
|
LabelDoubleTree ComposeLinkType Item ->
|
|
Maybe PJStabiliser ->
|
|
Muzzle ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
createProjectile pjtype magtree stab muz cr = fromMaybe failsound $ do
|
|
magid <- magtree ^? ldtValue . itLocation . ilInvID
|
|
ammoitem <- cr ^? crInv . ix magid
|
|
let rdetonate =
|
|
(^. ldtValue . itID)
|
|
<$> lookup RemoteDetonatorLink (magtree ^. ldtLeft)
|
|
rscreen =
|
|
(^. ldtValue . itID)
|
|
<$> lookup RemoteScreenLink (magtree ^. ldtLeft)
|
|
aparams <-
|
|
((magtree ^? ldtLeft) >>= lookup AmmoPayloadLink >>= (^? ldtValue . itType . ibtAttach . shellPayload))
|
|
<|> ammoitem ^? itConsumables . magParams . ampPayload
|
|
return $
|
|
createShell rdetonate rscreen stab pjtype aparams muz cr
|
|
. startthesound
|
|
where
|
|
-- 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 ->
|
|
LocationLDT ItemLink ComposedItem ->
|
|
Creature ->
|
|
World ->
|
|
World
|
|
dropInventoryPath i ip loc cr = fromMaybe id $ do
|
|
invid <- loc ^? locLDT . ldtValue . _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
|
|
|
|
useInventoryPath ::
|
|
PressType ->
|
|
Int ->
|
|
InventoryPathing ->
|
|
LocationLDT ItemLink ComposedItem ->
|
|
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 ^? locLDT . ldtValue . _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
|