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