Files
loop/src/Dodge/HeldUse.hs
T
2025-06-26 12:17:08 +01:00

1462 lines
48 KiB
Haskell

{-# OPTIONS -Wno-incomplete-uni-patterns #-}
--{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
module Dodge.HeldUse (
heldEffect,
gadgetEffect,
heldEffectNoHammerCheck,
mcUseHeld,
heldEffectMuzzles,
) where
import Color
import Control.Applicative
import Control.Monad
import qualified Data.IntMap.Strict as IM
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.UseDelay
import Dodge.Data.World
import Dodge.Gas
import Dodge.Inventory.Lock
import Dodge.Inventory.Path
import Dodge.Item.HeldOffset
import Dodge.Item.UseDelay
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 CItem -> 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 CLinkType Item -> Creature -> World -> World
heldEffect = useTimeCheck . hammerCheck heldEffectMuzzles
heldEffectNoHammerCheck :: LabelDoubleTree CLinkType Item -> Creature -> World -> World
heldEffectNoHammerCheck = useTimeCheck heldEffectMuzzles
type ChainEffect =
(LabelDoubleTree CLinkType Item -> Creature -> World -> World) ->
LabelDoubleTree CLinkType Item ->
Creature ->
World ->
World
hammerCheck ::
(LabelDoubleTree CLinkType Item -> Creature -> World -> World) ->
PressType ->
LabelDoubleTree CLinkType Item ->
Creature ->
World ->
World
hammerCheck f pt it cr w
| BurstTrigger is <- itemTriggerType (it ^. ldtValue)
, pt == InitialPress =
w & f it cr & cWorld . lWorld . delayedEvents .++~ map g is
| BurstTrigger{} <- itemTriggerType (it ^. ldtValue) = w
| VolleyGunTrigger i <- itemTriggerType (it ^. ldtValue)
, pt == InitialPress =
let (is, gen) = getVolleyBurst i (w ^. randGen)
in w & f it cr
& cWorld . lWorld . delayedEvents .++~ map g is
& randGen .~ gen
| VolleyGunTrigger{} <- itemTriggerType (it ^. ldtValue) = w
| t <- itemTriggerType (it ^. ldtValue)
, t == HammerTrigger || t == AlwaysSingleTrigger
, isNothing $ lookup MakeAutoLink (it ^. ldtRight)
, pt /= InitialPress =
w
| otherwise = f it cr w
where
g x = (x, WdWdBurstFireRepetition (_crID cr) (it ^?! ldtValue . itLocation . ilInvID))
getVolleyBurst :: (Random a, RandomGen b, Num a) => Int -> b -> ([a], b)
getVolleyBurst i g =
let (is, g') = runState (replicateM (i -1) (state $ randomR (0, 6))) g
in (scanl1 (+) is, g')
{- | Applies a world effect after an item use cooldown check.
input buffering?
-}
useTimeCheck :: ChainEffect
useTimeCheck f item cr w = case useDelay $ item ^. ldtValue of
FixedRate rate
| w ^. cWorld . lWorld . lClock - rate > lastused -> f item cr w
-- note that the time last used must be updated later in the chain!
FixedRate{} -> w
WarmUpNoDelay wm
| _wTime (_itParams $ _ldtValue item) < wm ->
w & setwarming
& soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ item ^. ldtValue . itType) (Just 2)
& cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . wTime +~ 1
WarmUpNoDelay{} -> f item cr w & setwarming
WarmUpCoolDown ws _ _
| _wTime (_itParams $ _ldtValue item) < ws ->
w & setwarming
& soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ item ^. ldtValue . itType) (Just 2)
& cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . wTime +~ 1
WarmUpCoolDown _ cs _
| _wTime (_itParams $ _ldtValue item) < cs ->
f item cr w & setwarming
& cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . wTime +~ 1
WarmUpCoolDown{} -> w & setwarming
NoDelay -> f item cr w
where
lastused = item ^. ldtValue . itTimeLastUsed
cid = _crID cr
setwarming =
cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . isWarming
%~ const True
-- 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 CLinkType Item -> Creature -> World -> World
heldEffectMuzzles t cr w =
setusetime . doHeldUseEffect t cr
. uncurry (applyCME (_ldtValue t) cr)
. foldl' (useLoadedAmmo t cr) (False, w)
$ loadedmuzzles
where
(_, loadedmuzzles) = mapAccumR loadMuzzle t . itemMuzzles $ t ^. ldtValue
setusetime =
cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itid . itTimeLastUsed
.~ w ^. cWorld . lWorld . lClock
itid = t ^?! ldtValue . itLocation . ilInvID
itemMuzzles :: Item -> [Muzzle]
itemMuzzles itm = case itm ^. itType of
HELD ALTERIFLE ->
dbwMuzzles & ix 0 . mzPos .~ V2 25 0
& ix 0 . mzAmmoSlot .~ _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
0
NoFlare
MuzzleShootBullet
(UseExactly 1)
| -- 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 0 BasicFlare MuzzleShootBullet (UseExactly 1)]
MACHINEPISTOL -> [Muzzle (V2 10 0) 0 0.3 0 MiniGunFlare MuzzleShootBullet (UseExactly 1)]
AUTOPISTOL -> [Muzzle (V2 10 0) 0 0 0 BasicFlare MuzzleShootBullet (UseExactly 1)]
SMG -> [Muzzle (V2 20 0) 0 0.05 0 BasicFlare MuzzleShootBullet (UseExactly 1)]
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 0 NoFlare MuzzleShootBullet (UseExactly 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 0 BasicFlare MuzzleShootBullet (UseUpTo 15)]
BLUNDERBUSS -> [Muzzle (V2 30 0) 0 0.5 0 BasicFlare MuzzleShootBullet (UseUpTo 15)]
GRAPECANNON _ -> [Muzzle (V2 30 0) 0 0.5 0 BasicFlare MuzzleShootBullet (UseUpTo 15)]
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 [0 ..]
<*> pure NoFlare
<*> pure MuzzleRLauncher
<*> pure (UseExactly 1)
)
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 = 0
, _mzFlareType = NoFlare
, _mzEffect = MuzzleShootBullet
, _mzAmmoPerShot = UseExactly 1
-- , _mzFrame = 0
}
]
baseStickSpread :: Float
baseStickSpread = 0.2
dbwMuzzles :: [Muzzle]
dbwMuzzles = [Muzzle (V2 15 0) 0 0.01 0 BasicFlare MuzzleShootBullet (UseExactly 1)]
flameMuzzles :: [Muzzle]
flameMuzzles =
[ Muzzle
(V2 18 0)
0
0
0
NoFlare
MuzzleNozzle
{ _nzPressure = ConstFloat 4
, _nzMaxWalkAngle = 0.2
, _nzWalkSpeed = 0.01
}
(UseExactly 1)
]
vgunMuzzles :: Int -> [Muzzle]
vgunMuzzles i =
getZipList
( ZipList [Muzzle (V2 15 x) 0 0.01 | x <- spreadAroundCenter i 6]
<*> ZipList [0 .. i -1]
<*> pure BasicFlare
<*> pure MuzzleShootBullet
<*> pure (UseExactly 1)
-- <*> ZipList [0 .. i -1]
)
doHeldUseEffect :: LabelDoubleTree CLinkType Item -> Creature -> World -> World
doHeldUseEffect t cr w = case t ^. ldtValue . 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
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i
. itParams
. unfiredBarrels
%~ const is
Just (_ : _ : _) -> fromMaybe w $ do
i <- itm ^? itLocation . ilInvID
return $
w
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i
. itParams
. unfiredBarrels
%~ tail
_ -> w
HELD ALTERIFLE -> fromMaybe w $ do
i <- t ^? ldtValue . itLocation . ilInvID
return $
w
& cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i
. itParams
. alteRifleSwitch
-- . itUse
-- . heldMuzzles
-- . ix 0
-- . mzAmmoSlot
%~ ((`mod` 2) . (+ 1))
_ -> w
where
itm = t ^. ldtValue
--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
-- should probably unify failure with time use check in some way...
applyCME :: Item -> Creature -> Bool -> World -> World
applyCME itm cr cme
| cme =
applyInvLock itm cr
. applySoundCME itm cr
. applySidePush spush cr
. applyTorqueCME itm cr
. applyRecoil itm 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
coolstart = fromMaybe 0 $ useDelay 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 :: Item -> Creature -> World -> World
applyRecoil itm cr =
cWorld . lWorld . creatures . ix (_crID cr) . crPos
+~ rotateV (_crDir cr) (V2 ((- recoilAmount itm) / crMass (_crType 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 -> 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
-- (Muzzle,Int,Int) = (muzzle, amountloaded, id of mag taken from)
loadMuzzle ::
LabelDoubleTree CLinkType Item ->
Muzzle ->
(LabelDoubleTree CLinkType Item, Maybe (Muzzle, Int, LabelDoubleTree CLinkType 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
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 . _Just -~ usedammo
, Just (mz, usedammo, mag)
)
makeMuzzleFlare :: Muzzle -> LabelDoubleTree CLinkType 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 ->
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 itmtree) 0.8 (pos `v2z` 20)
. ( 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
itm = itmtree ^. ldtValue
(moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
pos = _crPos cr + rotateV (_crDir cr) moff
dir = _crDir cr + mrot
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 :: LabelDoubleTree CLinkType Item -> Float
getLaserPhaseV = const 1
getLaserDamage :: LabelDoubleTree CLinkType Item -> LaserType
getLaserDamage = const (DamageLaser 11)
getLaserColor :: LabelDoubleTree CLinkType 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 -> CLinkType -> Bool
isAmmoIntLink i (AmmoInLink j _) = i == j
isAmmoIntLink _ _ = False
useLoadedAmmo ::
LabelDoubleTree CLinkType Item ->
Creature ->
(Bool, World) ->
Maybe (Muzzle, Int, LabelDoubleTree CLinkType Item) ->
(Bool, World)
useLoadedAmmo _ _ (cme, w) Nothing = (cme, w)
useLoadedAmmo itmtree cr (_, w) (Just (mz, x, magtree)) = (,) 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 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 CLinkType 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 :: 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 = d
, _tbTime = 10
}
where
d = unitVectorAtAngle dir * power
creatureShootLaser ::
LabelDoubleTree CLinkType 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
. _Just
-~ x
getBulletType :: LabelDoubleTree CLinkType Item -> Maybe Bullet
getBulletType magtree =
--magtree ^? ldtValue . itConsumables . magParams . ampBullet
(magtree ^? ldtValue >>= magAmmoParams >>= (^? 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 (BulPlain 100) $ 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
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
shootBullet ::
LabelDoubleTree CLinkType Item ->
Creature ->
(Muzzle, Int, LabelDoubleTree CLinkType 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
fueltype <- cr ^? crInv . ix magid >>= magAmmoParams >>= (^? 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)
dir = _crDir cr + mrot + 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 (FixedRate rate) <- useDelay <$> mc ^? mcType . mctTurret . tuWeapon -- . itUse . heldDelay
, w ^. cWorld . lWorld . lClock - rate > lastused =
w
& cWorld . lWorld . machines . ix (_mcID mc) . mcType . mctTurret . tuWeapon
. itTimeLastUsed
-- . itUse
-- . heldDelay
-- . rateTimeLastUsed
.~ 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 :: 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 CLinkType Item ->
LabelDoubleTree CLinkType 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 CLinkType Item ->
LabelDoubleTree CLinkType 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 CLinkType 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 CLinkType 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 CLinkType 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
<|> magAmmoParams ammoitem ^? _Just . 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 CItem ->
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
warmupSound :: ItemType -> SoundID
warmupSound = \case
HELD MINIGUNX{} -> crankSlowS
HELD MACHINEPISTOL{} -> whirupS
_ -> crankSlowS
useInventoryPath ::
PressType ->
Int ->
InventoryPathing ->
LocationLDT ItemLink CItem ->
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