{-# OPTIONS -Wno-incomplete-uni-patterns #-} --{-# LANGUAGE TupleSections #-} {-# LANGUAGE LambdaCase #-} module Dodge.HeldUse ( gadgetEffect, 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.World import Dodge.Gas import Dodge.Inventory.Lock import Dodge.Inventory.Path import Dodge.Item.HeldOffset import Dodge.Item.Weapon.Bullet import Dodge.Item.Weapon.Shatter import Dodge.Projectile.Create import Dodge.RadarSweep import Dodge.SoundLogic import Dodge.Tesla import Geometry import LensHelp import ListHelp import NewInt import Picture.Base import qualified Quaternion as Q import RandomHelp import qualified SDL import Sound.Data gadgetEffect :: PressType -> LocationDT OItem -> Creature -> World -> World gadgetEffect pt loc | UseHeld{} <- loc ^. locDT . dtValue . _1 . itUse = heldEffect pt loc | DROPPER x <- loc ^. locDT . dtValue . _1 . itType , Just i <- loc ^? locDT . dtValue . _1 . itUse . uInt , pt == InitialPress = dropInventoryPath i x loc | CLICKER x <- loc ^. locDT . dtValue . _1 . itType , Just i <- loc ^? locDT . dtValue . _1 . itUse . uInt = useInventoryPath pt i x loc | otherwise = const id heldEffect :: PressType -> LocationDT OItem -> Creature -> World -> World heldEffect = hammerCheck heldEffectMuzzles hammerCheck :: (LocationDT OItem -> Creature -> World -> World) -> PressType -> LocationDT OItem -> Creature -> World -> World hammerCheck f pt loc cr w = case itemTriggerType loc of WarmUpNoDelay wm | _wTime (_itParams it) < wm -> w & setwarming & soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ it ^. itType) (Just 2) & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itParams . wTime +~ 1 WarmUpNoDelay{} -> f loc cr w & setwarming WarmUpCoolDown ws _ _ -- UNSAFE: | _wTime (_itParams it) < ws -> w & setwarming & soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ it ^. itType) (Just 2) & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itParams . wTime +~ 1 WarmUpCoolDown _ cs _ | _wTime (_itParams it) < cs -> f loc cr w & setwarming & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itParams . wTime +~ 1 WarmUpCoolDown{} -> w & setwarming BurstTrigger is t | w ^. cWorld . lWorld . lClock - t > timelastused , pt == InitialPress -> w & f loc cr & cWorld . lWorld . delayedEvents .++~ map g is VolleyGunTrigger i t | w ^. cWorld . lWorld . lClock - t > timelastused , pt == InitialPress -> let (is, gen) = getVolleyBurst i (w ^. randGen) in w & f loc cr & cWorld . lWorld . delayedEvents .++~ map g is & randGen .~ gen HammerTrigger t | w ^. cWorld . lWorld . lClock - t > timelastused -- , isNothing $ lookup MakeAutoLink (tree ^. ldtRight) , pt == InitialPress -> f loc cr w AutoTrigger t | w ^. cWorld . lWorld . lClock - t > timelastused -> f loc cr w NoTrigger -> f loc cr w _ -> w where it = loc ^. locDT . dtValue . _1 cid = _crID cr -- the following is unsafe, but if ilInvID isn't correctly set we probably -- will have problems elsewhere also invid = it ^?! itLocation . ilInvID setwarming = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itParams . isWarming %~ const True timelastused = it ^. itTimeLastUsed g x = (x, WdWdBurstFireRepetition (_crID cr) invid) 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') heldEffectMuzzles :: LocationDT OItem -> Creature -> World -> World heldEffectMuzzles loc cr w = setusetime . doHeldUseEffect t cr . uncurry (applyCME loc cr) . foldl' (useLoadedAmmo loc cr) (False, w) $ loadedmuzzles where t = loc ^. locDT (_, loadedmuzzles) = mapAccumR loadMuzzle t . itemMuzzles $ t ^. dtValue . _1 setusetime = cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itid . itTimeLastUsed .~ w ^. cWorld . lWorld . lClock itid = t ^?! dtValue . _1 . 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 | -- 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) 0] MACHINEPISTOL -> [Muzzle (V2 10 0) 0 0.3 0 MiniGunFlare MuzzleShootBullet (UseExactly 1) 0] AUTOPISTOL -> [Muzzle (V2 10 0) 0 0 0 BasicFlare MuzzleShootBullet (UseExactly 1) 0] SMG -> [Muzzle (V2 20 0) 0 0.05 0 BasicFlare MuzzleShootBullet (UseExactly 1) 0] RIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0 BURSTRIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0 & ix 0 . mzInaccuracy .~ 0.05 MINIGUNX i -> replicate i (Muzzle (V2 30 0) 0 0.05 0 NoFlare MuzzleShootBullet (UseExactly 1) 10) & ix 0 . mzFlareType .~ MiniGunFlare BANGROD -> dbwMuzzles & ix 0 . mzPos .~ V2 30 0 & ix 0 . mzFlareType .~ HeavySmokeFlare ELEPHANTGUN -> dbwMuzzles & ix 0 . mzPos .~ V2 30 0 & ix 0 . mzFlareType .~ HeavySmokeFlare & ix 0 . mzInaccuracy .~ 0.05 AMR -> dbwMuzzles & ix 0 . mzPos .~ V2 30 0 & ix 0 . mzFlareType .~ HeavySmokeFlare & ix 0 . mzInaccuracy .~ 0.05 AUTOAMR -> dbwMuzzles & ix 0 . mzPos .~ V2 30 0 & ix 0 . mzFlareType .~ HeavySmokeFlare & ix 0 . mzInaccuracy .~ 0.05 SNIPERRIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 30 0 & ix 0 . mzFlareType .~ HeavySmokeFlare & ix 0 . mzInaccuracy .~ 0 BANGCONE -> [Muzzle (V2 15 0) 0 0.5 0 BasicFlare MuzzleShootBullet (UseUpTo 15) 12] BLUNDERBUSS -> [Muzzle (V2 30 0) 0 0.5 0 BasicFlare MuzzleShootBullet (UseUpTo 15) 12] GRAPECANNON i -> [Muzzle (V2 30 0) 0 0.5 0 BasicFlare MuzzleShootBullet (UseUpTo 15) (12 + 4 * fromIntegral i)] TORCH -> dbwMuzzles & ix 0 . mzPos .~ V2 10 0 VOLLEYGUN{} -> error "should get volleygun muzzles earlier" FLAMETHROWER -> flameMuzzles FLAMESPITTER -> flameMuzzles & ix 0 . mzEffect . nzPressure .~ UniRandFloat 3 4 RLAUNCHER -> dbwMuzzles & ix 0 . mzInaccuracy .~ 0 & ix 0 . mzEffect .~ MuzzleRLauncher & ix 0 . mzPos .~ V2 20 0 GLAUNCHER -> dbwMuzzles & ix 0 . mzInaccuracy .~ 0 & ix 0 . mzEffect .~ MuzzleGLauncher & ix 0 . mzPos .~ V2 20 0 RLAUNCHERX i -> getZipList ( ZipList [Muzzle (V2 20 0) a 0 | a <- take i [0, 2 * pi / fromIntegral i ..]] <*> ZipList [0 ..] <*> pure NoFlare <*> pure MuzzleRLauncher <*> pure (UseExactly 1) <*> pure 0 ) LASER -> dbwMuzzles & ix 0 . mzPos .~ V2 6 0 & ix 0 . mzInaccuracy .~ 0 & ix 0 . mzFlareType .~ LasGunFlare & ix 0 . mzEffect .~ MuzzleLaser TESLAGUN -> dbwMuzzles & ix 0 . mzPos .~ V2 10 0 & ix 0 . mzInaccuracy .~ 0 & ix 0 . mzFlareType .~ TeslaGunFlare & ix 0 . mzEffect .~ MuzzleTesla TRACTORGUN -> dbwMuzzles & ix 0 . mzPos .~ V2 30 0 & ix 0 . mzInaccuracy .~ 0 & ix 0 . mzFlareType .~ NoFlare & ix 0 . mzEffect .~ MuzzleTractor SHATTERGUN -> dbwMuzzles & ix 0 . mzPos .~ V2 30 0 & ix 0 . mzInaccuracy .~ 0 & ix 0 . mzEffect .~ MuzzleShatter BLINKER -> dbwMuzzles & ix 0 . mzEffect .~ MuzzleBlink & ix 0 . mzAmmoPerShot .~ UseExactly 10000000 BLINKERUNSAFE -> dbwMuzzles & ix 0 . mzEffect .~ MuzzleUnsafeBlink & ix 0 . mzAmmoPerShot .~ UseExactly 10000000 REWINDER -> dbwMuzzles & ix 0 . mzEffect .~ MuzzleRewind & ix 0 . mzAmmoPerShot .~ UseExactly 100000 TIMESTOPPER -> dbwMuzzles & ix 0 . mzEffect .~ MuzzleStopper & ix 0 . mzAmmoPerShot .~ UseExactly 100000 TIMESCROLLER -> dbwMuzzles & ix 0 . mzEffect .~ MuzzleScroller & ix 0 . mzAmmoPerShot .~ UseExactly 100000 _ -> [ Muzzle { _mzPos = V2 20 0 , _mzRot = 0 , _mzInaccuracy = 0.05 , _mzAmmoSlot = 0 , _mzFlareType = NoFlare , _mzEffect = MuzzleShootBullet , _mzAmmoPerShot = UseExactly 1 , _mzRandomOffset = 0 } ] baseStickSpread :: Float baseStickSpread = 0.2 dbwMuzzles :: [Muzzle] dbwMuzzles = [Muzzle (V2 15 0) 0 0.01 0 BasicFlare MuzzleShootBullet (UseExactly 1) 0] flameMuzzles :: [Muzzle] flameMuzzles = [ Muzzle (V2 18 0) 0 0 0 NoFlare MuzzleNozzle { _nzPressure = ConstFloat 4 , _nzMaxWalkAngle = 0.2 , _nzWalkSpeed = 0.01 } (UseExactly 1) 0 ] vgunMuzzles :: Int -> [Muzzle] vgunMuzzles i = getZipList ( ZipList [Muzzle (V2 15 x) 0 0.01 | x <- spreadAroundCenter i 6] <*> ZipList [0 .. i -1] <*> pure BasicFlare <*> pure MuzzleShootBullet <*> pure (UseExactly 1) <*> pure 0 ) doHeldUseEffect :: DTree OItem -> Creature -> World -> World doHeldUseEffect t cr w = case t ^. dtValue . _1 . itType of HELD (VOLLEYGUN j) -> case itm ^? itParams . unfiredBarrels of Just [_] -> fromMaybe w $ do let (is, g) = runState (shuffle [0 .. j -1]) $ w ^. randGen i <- itm ^? itLocation . ilInvID return $ w & randGen .~ g & 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 ^? dtValue . _1 . 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 ^. dtValue . _1 --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 :: LocationDT OItem -> Creature -> Bool -> World -> World applyCME loc cr cme | cme = applyInvLock itm cr . applySoundCME itm cr . applySidePush spush cr . applyTorqueCME itm cr . applyRecoil loc cr | otherwise = case itm ^. itType of HELD MACHINEPISTOL -> cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itid . itParams .~ WarmTime (coolstart - 1) True Nothing -- the above is quite hacky for now _ -> failsound where itm = loc ^. locDT . dtValue . _1 coolstart = fromMaybe 0 $ baseItemTriggerType itm ^? coolStart itid = itm ^?! itLocation . ilInvID -- unsafe spush = maybe 0 itemSidePush $ itm ^? itType . ibtHeld failsound w = case w ^? input . mouseButtons . ix SDL.ButtonLeft of Just 0 -> soundStart (CrWeaponFailSound (_crID cr)) (_crPos cr) click1S Nothing w _ -> soundContinue (CrWeaponFailSound (_crID cr)) (_crPos cr) click1S Nothing w itemSidePush :: HeldItemType -> Float itemSidePush = \case BANGSTICK{} -> 0 REWINDER -> 0 TIMESTOPPER -> 0 TIMESCROLLER -> 0 PISTOL -> 50 MACHINEPISTOL -> 50 AUTOPISTOL -> 50 SMG -> 30 BANGCONE -> 0 BLUNDERBUSS -> 0 GRAPECANNON{} -> 0 MINIGUNX i -> 10 + fromIntegral i VOLLEYGUN{} -> 0 RIFLE -> 0 ALTERIFLE -> 0 AUTORIFLE -> 0 BURSTRIFLE -> 0 BANGROD -> 0 ELEPHANTGUN -> 0 AMR -> 0 AUTOAMR -> 0 SNIPERRIFLE -> 0 FLAMESPITTER -> 0 FLAMETHROWER -> 25 FLAMETORRENT -> 0 FLAMEWALL -> 0 BLOWTORCH -> 0 SPARKGUN -> 0 TESLAGUN -> 0 LASER -> 0 TRACTORGUN -> 0 RLAUNCHER -> 0 RLAUNCHERX{} -> 0 GLAUNCHER -> 0 POISONSPRAYER -> 0 SHATTERGUN -> 0 TORCH -> 0 FLATSHIELD -> 0 KEYCARD{} -> 0 BLINKER -> 0 BLINKERUNSAFE -> 0 applyInvLock :: Item -> Creature -> World -> World applyInvLock itm cr = case itemInvLock itm of i | i > 0 && cid == 0 -> (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv)) . lockInv _ -> id where cid = _crID cr itemInvLock :: Item -> Int itemInvLock itm = case itm ^. itType of HELD hit -> heldItemInvLock hit _ -> 0 heldItemInvLock :: HeldItemType -> Int heldItemInvLock = \case FLAMESPITTER -> 10 VOLLEYGUN i -> i + 1 BURSTRIFLE -> 70 _ -> 0 applySoundCME :: Item -> Creature -> World -> World applySoundCME itm cr = fromMaybe id $ do (soundid, x) <- bgunSound itm return $ if x > 0 then soundContinue (CrWeaponSound cid 0) (_crPos cr) soundid (Just x) else soundMultiFrom [CrWeaponSound cid j | j <- [0 .. 5]] (_crPos cr) soundid Nothing where cid = _crID cr applyRecoil :: LocationDT OItem -> Creature -> World -> World applyRecoil loc cr = cWorld . lWorld . creatures . ix (_crID cr) . crPos +~ rotateV (_crDir cr + Q.qToAng q) (V2 ((- recoilAmount itm) / crMass (_crType cr)) 0) where itm = loc ^. locDT . dtValue . _1 (_, q) = locOrient loc cr recoilAmount :: Item -> Float recoilAmount itm | HELD hit <- itm ^. itType = case hit of BANGSTICK _ -> 25 REWINDER -> 0 TIMESTOPPER -> 0 TIMESCROLLER -> 0 PISTOL -> 10 MACHINEPISTOL -> 5 AUTOPISTOL -> 10 SMG -> 10 BANGCONE -> 150 BLUNDERBUSS -> 150 GRAPECANNON i -> 150 + fromIntegral i * 50 MINIGUNX i -> 10 * fromIntegral i VOLLEYGUN _ -> 30 RIFLE -> 50 ALTERIFLE -> 50 AUTORIFLE -> 50 BURSTRIFLE -> 50 BANGROD -> 50 ELEPHANTGUN -> 50 AMR -> 50 AUTOAMR -> 50 SNIPERRIFLE -> 50 FLAMESPITTER -> 0 FLAMETHROWER -> 0 FLAMETORRENT -> 0 FLAMEWALL -> 0 BLOWTORCH -> 0 SPARKGUN -> 0 TESLAGUN -> 0 LASER -> 0 TRACTORGUN -> 0 RLAUNCHER -> 0 RLAUNCHERX _ -> 0 GLAUNCHER -> 0 POISONSPRAYER -> 0 SHATTERGUN -> 0 TORCH -> 0 FLATSHIELD -> 0 KEYCARD _ -> 0 BLINKER -> 0 BLINKERUNSAFE -> 0 | otherwise = 0 -- if the int is 0, play sound on new channel -- if >0, continue playing sound for given time bgunSound :: Item -> Maybe (SoundID, Int) bgunSound itm | HELD hit <- itm ^. itType = case hit of BANGSTICK _ -> Just (tap3S, 0) REWINDER -> Nothing TIMESTOPPER -> Nothing TIMESCROLLER -> Nothing PISTOL -> Just (tap3S, 0) MACHINEPISTOL -> Just (whirTapS, 2) AUTOPISTOL -> Just (tap1S, 0) SMG -> Just (tap1S, 0) BANGCONE -> Just (bangEchoS, 0) BLUNDERBUSS -> Just (bangEchoS, 0) GRAPECANNON _ -> Just (bangEchoS, 0) MINIGUNX _ -> Just (mini1S, 2) VOLLEYGUN _ -> Just (tap3S, 0) RIFLE -> Just (tap3S, 0) ALTERIFLE -> Just (tap3S, 0) AUTORIFLE -> Just (tap3S, 0) BURSTRIFLE -> Just (tap3S, 0) BANGROD -> Just (bangEchoS, 0) ELEPHANTGUN -> Just (bangEchoS, 0) AMR -> Just (bangEchoS, 0) AUTOAMR -> Just (bangEchoS, 0) SNIPERRIFLE -> Just (bangEchoS, 0) FLAMESPITTER -> Nothing FLAMETHROWER -> Nothing FLAMETORRENT -> Nothing FLAMEWALL -> Nothing BLOWTORCH -> Nothing SPARKGUN -> Nothing TESLAGUN -> Nothing LASER -> Nothing TRACTORGUN -> Nothing RLAUNCHER -> Just (tap4S, 0) RLAUNCHERX _ -> Just (tap4S, 0) GLAUNCHER -> Just (tap4S, 0) POISONSPRAYER -> Just (foamSprayLoopS, 5) SHATTERGUN -> Nothing TORCH -> Nothing FLATSHIELD -> Nothing KEYCARD _ -> Nothing BLINKER -> Nothing BLINKERUNSAFE -> Nothing | otherwise = Nothing applySidePush :: Float -> Creature -> World -> World applySidePush 0 _ w = w applySidePush maxSide cr w = w & cWorld . lWorld . creatures . ix cid . crPos +~ push & randGen .~ g where cid = _crID cr push = rotateV (_crDir cr) (V2 0 (pushAmount / crMass (_crType cr))) (pushAmount, g) = randomR (- maxSide, maxSide) $ _randGen w applyTorqueCME :: Item -> Creature -> World -> World applyTorqueCME itm cr w = w & cWorld . lWorld . creatures . ix cid . crDir +~ rot & randGen .~ g & if cid == 0 then wCam . camRot -~ rot else id where cid = _crID cr (rot, g) = randomR (- torque, torque) $ _randGen w torque = torqueAmount itm torqueAmount :: Item -> Float torqueAmount itm = case itm ^. itType of HELD hit -> heldTorqueAmount hit _ -> 0 heldTorqueAmount :: HeldItemType -> Float heldTorqueAmount = \case BANGSTICK i -> 0.18 + 0.02 * fromIntegral i REWINDER -> 0 TIMESTOPPER -> 0 TIMESCROLLER -> 0 PISTOL -> 0.2 MACHINEPISTOL -> 0.2 AUTOPISTOL -> 0.2 SMG -> 0.05 BANGCONE -> 0.1 BLUNDERBUSS -> 0.1 GRAPECANNON i -> 0.1 + 0.2 * fromIntegral i MINIGUNX i -> 0.04 + 0.02 * fromIntegral i VOLLEYGUN{} -> 0.1 RIFLE -> 0.1 ALTERIFLE -> 0.1 AUTORIFLE -> 0.1 BURSTRIFLE -> 0.1 BANGROD -> 0.3 ELEPHANTGUN -> 0.3 AMR -> 0.3 AUTOAMR -> 0.3 SNIPERRIFLE -> 0.3 FLAMESPITTER -> 0 FLAMETHROWER -> 0 FLAMETORRENT -> 0 FLAMEWALL -> 0 BLOWTORCH -> 0 SPARKGUN -> 0 TESLAGUN -> 0.01 LASER -> 0 TRACTORGUN -> 0 RLAUNCHER -> 0 RLAUNCHERX{} -> 0 GLAUNCHER -> 0 POISONSPRAYER -> 0 SHATTERGUN -> 0 TORCH -> 0 FLATSHIELD -> 0 KEYCARD{} -> 0 BLINKER -> 0 BLINKERUNSAFE -> 0 loadMuzzle :: DTree OItem -> Muzzle -> (DTree OItem, Maybe (Muzzle, Int, DTree OItem)) loadMuzzle t@(DT _ l _) mz = fromMaybe (t, Nothing) $ do let as = _mzAmmoSlot mz amamount = _mzAmmoPerShot mz (i, mag) <- findWithIx (isAmmoIntLink as . (^. dtValue . _2)) l availableammo <- mag ^. dtValue . _1 . itConsumables let usedammo = case amamount of UseUpTo x -> min x availableammo UseExactly x | x <= availableammo -> x | otherwise -> 0 guard $ usedammo > 0 return ( t & dtLeft . ix i . dtValue . _1 . itConsumables . _Just -~ usedammo , Just (mz, usedammo, mag) ) makeMuzzleFlare :: Muzzle -> LocationDT OItem -> Creature -> World -> World makeMuzzleFlare mz loc cr = case mz ^. mzFlareType of NoFlare -> id BasicFlare -> basicMuzFlare pos dir NoLightFlare -> muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir MiniGunFlare -> oddcheck (cWorld . lWorld . lights .:~ LSParam (pos `v2z` 20) 100 (V3 1 1 0.5)) . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir HeavySmokeFlare -> basicMuzFlare pos dir LasGunFlare -> flareCircleAt (getLaserColor loc) 0.8 (pos `v2z` 20) . ( cWorld . lWorld . lights .:~ LSParam (pos `v2z` 10) 100 (xyzV4 $ getLaserColor loc) ) TeslaGunFlare -> cWorld . lWorld . lights .:~ LSParam (pos `v2z` 10) 100 (V3 0 0 1) where (V3 x y _, q) = locOrient loc cr `Q.comp` (_mzPos mz `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz)) pos = _crPos cr + rotateV (_crDir cr) (V2 x y) dir = _crDir cr + Q.qToAng q oddcheck f w | odd (w ^. cWorld . lWorld . lClock) = f w | otherwise = w --{-# OPTIONS -Wno-incomplete-uni-patterns #-} muzFlareAt :: Color -> Point3 -> Float -> World -> World muzFlareAt col tranv dir w = w & randGen .~ g & cWorld . lWorld . flares <>~ thepic where thepic = setLayer BloomLayer . translate3 tranv . color col . rotate dir . polygon $ [ V2 0 0 , V2 a (- b) , V2 c d ] thestate = replicateM 4 $ state $ randomR (2, 20) (a : b : c : d : _, g) = runState thestate $ _randGen w flareCircleAt :: Color -> Float -> Point3 -> World -> World flareCircleAt col alphax tranv = cWorld . lWorld . flares <>~ setLayer BloomNoZWrite ( translate3 tranv $ circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 50 ) -- previous phaseV parameters: 0.2, 1, 5 getLaserPhaseV :: DTree Item -> Float getLaserPhaseV = const 1 getLaserDamage :: DTree Item -> LaserType getLaserDamage = const (DamageLaser 11) getLaserColor :: LocationDT OItem -> Color getLaserColor = const yellow basicMuzFlare :: Point2 -> Float -> World -> World basicMuzFlare pos dir = (cWorld . lWorld . lights .:~ LSParam (pos `v2z` 20) 100 (V3 1 1 0.5)) . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir isAmmoIntLink :: Int -> ItemStructuralFunction -> Bool isAmmoIntLink i (AmmoMagSF j _) = i == j isAmmoIntLink _ _ = False useLoadedAmmo :: LocationDT OItem -> Creature -> (Bool, World) -> Maybe (Muzzle, Int, DTree OItem) -> (Bool, World) useLoadedAmmo _ _ (cme, w) Nothing = (cme, w) useLoadedAmmo loc cr (_, w) (Just (mz, x, magtree)) = (,) True $ removeAmmoFromMag x mid cr . makeMuzzleFlare mz loc cr $ case _mzEffect mz of MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w MuzzleLaser -> creatureShootLaser loc cr mz w MuzzleTesla -> shootTeslaArc loc cr mz w MuzzleTractor -> shootTractorBeam cr w MuzzleRLauncher -> createProjectileR loc magtree mz cr w MuzzleGLauncher -> createProjectile (itmtree ^. dtValue . _3) (Grenade (getGrenadeHitEffect itmtree)) magtree (getPJStabiliser itmtree) mz cr w MuzzleNozzle{} -> useGasParams mid mz loc cr $ walkNozzle mz itm cr w MuzzleShatter -> shootShatter itm cr w MuzzleDetector -> itemDetectorEffect itm (getAttachedSFLink MapperSF itmtree) (getAttachedSFLink ARHUDSF itmtree) cr w MuzzleBlink -> unsafeBlinkAction cr w MuzzleUnsafeBlink -> blinkActionMousePos cr w MuzzleRewind -> useRewindGun (itm ^. itID) w MuzzleStopper -> useStopWatch itm cr w MuzzleScroller -> useTimeScrollGun itm cr w where itmtree = loc ^. locDT mid = magtree ^? dtValue . _1 . itLocation . ilInvID itm = itmtree ^. dtValue . _1 getAttachedSFLink :: ItemStructuralFunction -> 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 = 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 :: LocationDT OItem -> Creature -> Muzzle -> World -> World creatureShootLaser loc cr mz w = w & randGen .~ g & shootLaser (CrWeaponSound (_crID cr) 0) (getLaserDamage istree) (getLaserPhaseV istree) pos dir (getLaserColor loc) where itmtree = loc ^. locDT istree = fmap (\(i, _, _) -> i) itmtree (V3 x y _, q) = locOrient loc cr `Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz)) pos = _crPos cr + rotateV (_crDir cr) (V2 x y) dir = _crDir cr + Q.qToAng q + a (a, g) = randomR (- inacc, inacc) $ _randGen w inacc = _mzInaccuracy mz offset = case mz ^. mzRandomOffset of 0 -> 0 i -> fst . randomR (- i, i) $ _randGen w shootLaser :: SoundOrigin -> LaserType -> Float -> Point2 -> Float -> Color -> World -> World shootLaser so lt pv p dir col w = w & cWorld . lWorld . lasers .:~ Laser { _lpType = lt , _lpPhaseV = pv , _lpPos = p , _lpDir = dir , _lpColor = col } & soundContinue so p tone440sawtoothquietS (Just 2) removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World removeAmmoFromMag x mid cr = fromMaybe id $ do magid <- mid return $ cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix magid . itConsumables . _Just -~ x getBulletType :: DTree OItem -> Maybe Bullet getBulletType magtree = (magtree ^? dtValue . _1 . to magAmmoParams . _Just . ampBullet) <&> buPayload .~ bpayload <&> buEffect .~ beffect where bpayload = fromMaybe (BulPlain 100) $ do attree <- find ispayload (magtree ^. dtLeft) attree ^? dtValue . _1 . itUse . ubMod . bmPayload ispayload :: DTree OItem -> Bool ispayload y = case y ^. dtValue . _2 of AmmoPayloadSF {} -> True _ -> False beffect = fromMaybe DestroyBullet $ do attree <- find isammoeffect (magtree ^. dtLeft) attree ^? dtValue . _1 . itUse . ubMod . bmEffect isammoeffect :: DTree OItem -> Bool isammoeffect y = case y ^. dtValue . _2 of AmmoEffectSF {} -> True _ -> False magAmmoParams :: Item -> Maybe AmmoParams magAmmoParams itm = case itm ^. itType of EQUIP FUELPACK -> Just $ GasParams ChemFuel AMMOMAG CHEMFUELPOUCH -> Just $ GasParams ChemFuel EQUIP BULLETBELTPACK -> Just $ BulletParams defaultBullet EQUIP BULLETBELTBRACER -> Just $ BulletParams defaultBullet AMMOMAG TINMAG -> Just $ BulletParams defaultBullet AMMOMAG DRUMMAG -> Just $ BulletParams defaultBullet AMMOMAG BELTMAG -> Just $ BulletParams defaultBullet AMMOMAG SHELLMAG -> Just $ ProjectileParams ExplosionPayload _ -> Nothing --getBulletTrajectory :: -- Muzzle -> -- Item -> -- BulletTrajectoryType -> -- Point2 -> -- Creature -> -- World -> -- BulletTrajectory --getBulletTrajectory mz itm bt tp cr w = case bt of -- BasicBulletTrajectoryType -> BasicBulletTrajectory -- FlechetteTrajectoryType -> FlechetteTrajectory tp -- BezierTrajectoryType -> BezierTrajectory bulpos tp (mouseWorldPos (w ^. input) (w ^. wCam)) -- MagnetTrajectoryType -> MagnetTrajectory tp -- where -- (moff, _) = heldItemOrient2D itm cr (_mzPos mz + V2 0 offset) (_mzRot mz) -- bulpos = _crPos cr + rotateV (_crDir cr) moff -- offset = case itm ^? itUse . heldParams . randomOffset of -- Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w -- _ -> 0 shootBullets :: LocationDT OItem -> Creature -> (Muzzle, Int, DTree OItem) -> World -> World shootBullets loc cr (mz, x, magtree) w = fromMaybe w $ do thebullet <- getBulletType magtree return $ foldl' (&) w (replicate x (shootBullet thebullet loc cr mz)) shootBullet :: Bullet -> LocationDT OItem -> Creature -> Muzzle -> World -> World shootBullet bu loc cr mz w = makeBullet bu itm bulpos dir . (randGen .~ g) $ w where (V3 x y _, q) = locOrient loc cr `Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz)) itm = loc ^. locDT . dtValue . _1 bulpos = _crPos cr + rotateV (_crDir cr) (V2 x y) (a, g) = randomR (- inacc, inacc) $ _randGen w dir = _crDir cr + Q.qToAng q + a inacc = _mzInaccuracy mz offset = case mz ^. mzRandomOffset of 0 -> 0 i -> fst . randomR (- i, i) $ _randGen w makeBullet :: Bullet -> Item -> Point2 -> Float -> World -> World makeBullet thebullet itm bulpos dir w = w & randGen .~ g'' & cWorld . lWorld . bullets .:~ ( thebullet & buPos .~ bulpos & buOldPos .~ bulpos & buVel %~ (rotateV dir . (muzvel *.*)) & buDrag *~ drag ) where g = _randGen w (drag, g') = case heldItemRifling (_ibtHeld $ _itType itm) of --unsafe ConstFloat x -> (x, g) UniRandFloat x y -> randomR (x, y) g (muzvel, g'') = case heldItemMuzVel $ _ibtHeld $ _itType itm of ConstFloat x -> (x, g') UniRandFloat x y -> randomR (x, y) g' heldItemMuzVel :: HeldItemType -> GenFloat heldItemMuzVel = \case BANGSTICK{} -> ConstFloat 0.8 REWINDER -> ConstFloat 0.8 TIMESTOPPER -> ConstFloat 0.8 TIMESCROLLER -> ConstFloat 0.8 PISTOL -> ConstFloat 0.8 MACHINEPISTOL -> ConstFloat 0.8 AUTOPISTOL -> ConstFloat 0.8 SMG -> ConstFloat 0.8 BANGCONE -> UniRandFloat 0.5 0.8 BLUNDERBUSS -> UniRandFloat 0.5 0.8 GRAPECANNON{} -> UniRandFloat 0.5 0.8 MINIGUNX{} -> ConstFloat 0.8 VOLLEYGUN{} -> ConstFloat 0.8 RIFLE -> ConstFloat 0.8 ALTERIFLE -> ConstFloat 0.8 AUTORIFLE -> ConstFloat 0.8 BURSTRIFLE -> ConstFloat 0.8 BANGROD -> ConstFloat 0.8 ELEPHANTGUN -> ConstFloat 0.8 AMR -> ConstFloat 0.8 AUTOAMR -> ConstFloat 0.8 SNIPERRIFLE -> ConstFloat 0.8 FLAMESPITTER -> ConstFloat 0.8 FLAMETHROWER -> ConstFloat 0.8 FLAMETORRENT -> ConstFloat 0.8 FLAMEWALL -> ConstFloat 0.8 BLOWTORCH -> ConstFloat 0.8 SPARKGUN -> ConstFloat 0.8 TESLAGUN -> ConstFloat 0.8 LASER -> ConstFloat 0.8 TRACTORGUN -> ConstFloat 0.8 RLAUNCHER -> ConstFloat 0 RLAUNCHERX{} -> ConstFloat 0 GLAUNCHER -> ConstFloat 0 POISONSPRAYER -> ConstFloat 0.8 SHATTERGUN -> ConstFloat 0.8 TORCH -> ConstFloat 0.8 FLATSHIELD -> ConstFloat 0 KEYCARD{} -> ConstFloat 0.8 BLINKER -> ConstFloat 0.8 BLINKERUNSAFE -> ConstFloat 0.8 heldItemRifling :: HeldItemType -> GenFloat heldItemRifling = \case BANGSTICK{} -> ConstFloat 0.8 REWINDER -> ConstFloat 0.8 TIMESTOPPER -> ConstFloat 0.8 TIMESCROLLER -> ConstFloat 0.8 PISTOL -> ConstFloat 0.8 MACHINEPISTOL -> ConstFloat 0.8 AUTOPISTOL -> ConstFloat 0.8 SMG -> ConstFloat 0.8 BANGCONE -> UniRandFloat 0.3 0.8 BLUNDERBUSS -> UniRandFloat 0.3 0.8 GRAPECANNON{} -> UniRandFloat 0.3 0.8 MINIGUNX{} -> UniRandFloat 0.8 0.9 VOLLEYGUN{} -> ConstFloat 0.9 RIFLE -> ConstFloat 0.9 ALTERIFLE -> ConstFloat 0.9 AUTORIFLE -> ConstFloat 0.9 BURSTRIFLE -> ConstFloat 0.9 BANGROD -> ConstFloat 1 ELEPHANTGUN -> ConstFloat 1 AMR -> ConstFloat 1 AUTOAMR -> ConstFloat 1 SNIPERRIFLE -> ConstFloat 1 FLAMESPITTER -> ConstFloat 0.8 FLAMETHROWER -> ConstFloat 0.8 FLAMETORRENT -> ConstFloat 0.8 FLAMEWALL -> ConstFloat 0.8 BLOWTORCH -> ConstFloat 0.8 SPARKGUN -> ConstFloat 0.8 TESLAGUN -> ConstFloat 0.8 LASER -> ConstFloat 0.8 TRACTORGUN -> ConstFloat 0.8 RLAUNCHER -> ConstFloat 0 RLAUNCHERX{} -> ConstFloat 0 GLAUNCHER -> ConstFloat 0 POISONSPRAYER -> ConstFloat 0.8 SHATTERGUN -> ConstFloat 0.8 TORCH -> ConstFloat 0.8 FLATSHIELD -> ConstFloat 0.8 KEYCARD{} -> ConstFloat 0.8 BLINKER -> ConstFloat 0.8 BLINKERUNSAFE -> ConstFloat 0.8 mcUseHeld :: HeldItemType -> Item -> Machine -> World -> World mcUseHeld hit = case hit of LASER -> mcShootLaser _ -> mcShootAuto useGasParams :: Maybe Int -> Muzzle -> LocationDT OItem -> Creature -> World -> World useGasParams mmagid mz loc cr w = w & createGas gastype pressure pos dir cr & randGen .~ g' where itm = loc ^. locDT . dtValue . _1 (pressure, g) = doGenFloat (_nzPressure $ _mzEffect mz) (_randGen w) gastype = fromMaybe (error "cannot find gas ammo") $ do magid <- mmagid hit <- itm ^? itType . ibtHeld fueltype <- cr ^? crInv . ix magid >>= magAmmoParams >>= (^? ampCreateGas) gasType hit fueltype (V3 x y _, q) = locOrient loc cr `Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz)) -- (moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz) pos = _crPos cr + rotateV (_crDir cr) (V2 x y) (a, g') = randomR (- inacc, inacc) g inacc = _mzInaccuracy mz offset = case mz ^. mzRandomOffset of 0 -> 0 i -> fst . randomR (- i, i) $ _randGen w -- dir = _crDir cr + mrot + a + _nzAngle (_itParams itm) dir = _crDir cr + Q.qToAng q + a + _nzAngle (_itParams itm) gasType :: HeldItemType -> GasFuel -> Maybe GasCreate gasType hit _ = case hit of BANGSTICK{} -> Nothing REWINDER -> Nothing TIMESTOPPER -> Nothing TIMESCROLLER -> Nothing PISTOL -> Nothing MACHINEPISTOL -> Nothing AUTOPISTOL -> Nothing SMG -> Nothing BANGCONE -> Nothing BLUNDERBUSS -> Nothing GRAPECANNON{} -> Nothing MINIGUNX{} -> Nothing VOLLEYGUN{} -> Nothing RIFLE -> Nothing ALTERIFLE -> Nothing AUTORIFLE -> Nothing BURSTRIFLE -> Nothing BANGROD -> Nothing ELEPHANTGUN -> Nothing AMR -> Nothing AUTOAMR -> Nothing SNIPERRIFLE -> Nothing FLAMESPITTER -> Nothing FLAMETHROWER -> Just CreateFlame FLAMETORRENT -> Just CreateFlame FLAMEWALL -> Just CreateFlame BLOWTORCH -> Nothing SPARKGUN -> Nothing TESLAGUN -> Nothing LASER -> Nothing TRACTORGUN -> Nothing RLAUNCHER -> Nothing RLAUNCHERX{} -> Nothing GLAUNCHER -> Nothing POISONSPRAYER -> Just CreatePoisonGas SHATTERGUN -> Nothing TORCH -> Nothing FLATSHIELD -> Nothing KEYCARD{} -> Nothing BLINKER -> Nothing BLINKERUNSAFE -> Nothing doGenFloat :: RandomGen g => GenFloat -> g -> (Float, g) doGenFloat (ConstFloat x) g = (x, g) doGenFloat (UniRandFloat x y) g = randomR (x, y) g mcShootLaser :: Item -> Machine -> World -> World mcShootLaser _ mc = shootLaser (MachineSound (_mcID mc)) (DamageLaser 11) 1 pos dir yellow where pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir dir = mc ^?! mcType . _McTurret . tuDir mcShootAuto :: Item -> Machine -> World -> World mcShootAuto itm mc w | Just (AutoTrigger rate) <- baseItemTriggerType <$> mc ^? mcType . mctTurret . tuWeapon -- . 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 :: LocationDT OItem -> Creature -> Muzzle -> World -> World shootTeslaArc loc cr mz w = w' & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itParams .~ ip & soundContinue (CrWeaponSound (_crID cr) 0) pos elecCrackleS (Just 2) where -- use items item location instead -- itRef = cr ^?! crManipulation . manObject . imRootSelectedItem -- unsafe!! TODO change itm = loc ^. locDT . dtValue . _1 invid = itm ^?! itLocation . ilInvID (w', ip) = makeTeslaArc (itm ^. itParams) pos dir w (V3 x y _, q) = locOrient loc cr `Q.comp` ((_mzPos mz + V2 0 offset) `v2z` 0, Q.axisAngle (V3 0 0 1) (_mzRot mz)) pos = _crPos cr + rotateV (_crDir cr) (V2 x y) dir = _crDir cr + Q.qToAng q offset = case mz ^. mzRandomOffset of 0 -> 0 i -> fst . randomR (- i, i) $ _randGen w determineProjectileTracking :: DTree OItem -> DTree OItem -> RocketHoming determineProjectileTracking magtree itmtree = fromMaybe NoHoming $ finddronecontrols <|> findexternaltracking where finddronecontrols = do screen <- find isremscreen (magtree ^. dtLeft) _ <- find isjoystick (screen ^. dtLeft) return $ HomeUsingRemoteScreen (screen ^. dtValue . _1 . itID) findexternaltracking = do _ <- find isammotargeting (magtree ^. dtLeft) targetingtree <- find isweapontargeting (itmtree ^. dtRight) return $ HomeUsingTargeting (targetingtree ^. dtValue . _1 . itID) isremscreen :: DTree OItem -> Bool isremscreen x = case x ^. dtValue . _2 of RemoteScreenSF {} -> True _ -> False isjoystick :: DTree OItem -> Bool isjoystick x = case x ^. dtValue . _2 of JoystickSF {} -> True _ -> False isammotargeting :: DTree OItem -> Bool isammotargeting x = case x ^. dtValue . _2 of AmmoTargetingSF {} -> True _ -> False isweapontargeting :: DTree OItem -> Bool isweapontargeting x = case x ^. dtValue . _2 of WeaponTargetingSF {} -> True _ -> False createProjectileR :: LocationDT OItem -> DTree OItem -> Muzzle -> Creature -> World -> World createProjectileR loc magtree = createProjectile (loc ^. locDT . dtValue . _3) ( Rocket (determineProjectileTracking magtree itmtree) smoke ) magtree (getPJStabiliser itmtree) where itmtree = loc ^. locDT smoke | isJust $ find issmokereducer (magtree ^. dtLeft) = Just ReducedRocketSmoke | otherwise = Nothing issmokereducer :: DTree OItem -> Bool issmokereducer y = case y ^. dtValue . _2 of SmokeReducerSF {} -> True _ -> False getPJStabiliser :: DTree OItem -> Maybe PJStabiliser getPJStabiliser ldt = case find isprojstab (ldt ^. dtRight) of Just ldt' -> case ldt' ^? dtValue . _1 . itType . ibtAttach of Just GIMBAL -> Just StabOrthReduce Just GYROSCOPE -> Just StabSpinIncrease _ -> Nothing _ -> Nothing where isprojstab :: DTree OItem -> Bool isprojstab y = case y ^.dtValue . _2 of ProjectileStabiliserSF {} -> True _ -> False getGrenadeHitEffect :: DTree OItem -> GrenadeHitEffect getGrenadeHitEffect t = case find isghiteff (t ^. dtRight) of Just ldt' -> case ldt' ^? dtValue . _1 . itType of Just STICKYMOD -> GStick _ -> GBounce 2 _ -> GBounce 2 where isghiteff :: DTree OItem -> Bool isghiteff y = case y ^. dtValue . _2 of GrenadeHitEffectSF {} -> True _ -> False createProjectile :: (Point3, Q.Quaternion Float) -> ProjectileType -> DTree OItem -> Maybe PJStabiliser -> Muzzle -> Creature -> World -> World createProjectile x pjtype magtree stab muz cr = fromMaybe failsound $ do magid <- magtree ^? dtValue . _1 . itLocation . ilInvID ammoitem <- cr ^? crInv . ix magid let rdetonate = (^. dtValue . _1 . itID) <$> find isrdet (magtree ^. dtLeft) rscreen = (^. dtValue . _1 . itID) <$> find isrscreen (magtree ^. dtLeft) aparams <- ((magtree ^? dtLeft) >>= find isampay >>= (^? dtValue . _1 . itType . ibtAttach . shellPayload)) -- <|> ammoitem ^? itConsumables . magParams . ampPayload <|> magAmmoParams ammoitem ^? _Just . ampPayload return $ createShell x rdetonate rscreen stab pjtype aparams muz cr . startthesound where isrdet :: DTree OItem -> Bool isrdet y = case y ^. dtValue . _2 of RemoteDetonatorSF {} -> True _ -> False isrscreen :: DTree OItem -> Bool isrscreen y = case y ^. dtValue . _2 of RemoteScreenSF {} -> True _ -> False isampay :: DTree OItem -> Bool isampay y = case y ^. dtValue . _2 of AmmoPayloadSF {} -> True _ -> False -- the sound should be moved to the projectile firing startthesound = soundMultiFrom [CrWeaponSound (_crID cr) j | j <- [0 .. 3]] (_crPos cr) tap4S Nothing failsound w' = case w' ^? input . mouseButtons . ix SDL.ButtonLeft of Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w' _ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w' ---- need to add these to muzzle flare? --makeMuzzleSmoke :: Muzzle -> Item -> Creature -> World -> World --makeMuzzleSmoke mz itm cr w = case mz ^. mzFlareType of -- DefaultFlareType -> w -- PistolFlare -> foldl' (flip $ smokeCloudAt (greyN 0.5) 5 400 5 . (+.+.+ pos) . (* 8)) w ps -- MiniGunFlare -> smokeCloudAt (greyN 0.5) 5 400 5 pos w -- HeavySmokeFlare -> foldl' (flip $ smokeCloudAt black 20 400 5 . (+.+.+ pos) . (* 8)) w ps' -- LasGunFlare -> w -- TeslaGunFlare -> w -- where -- ps = replicateM 2 randOnUnitSphere & evalState $ _randGen w -- ps' = replicateM 4 randOnUnitSphere & evalState $ _randGen w -- pos = addZ 10 $ _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm) ---- , withSmoke 1 black 20 200 5 useStopWatch :: Item -> Creature -> World -> World useStopWatch itm _ = timeFlow .~ PausedTimeFlow { _timeFlowCharge = 100 , _scrollItemID = _itID itm } useTimeScrollGun :: Item -> Creature -> World -> World useTimeScrollGun itm _ = timeFlow .~ ItemScrollTimeFlow { _scrollSmoothing = 0 , --, _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge _reverseAmount = 100 , _futureWorlds = [] , _scrollItemID = _itID itm } useRewindGun :: NewInt ItmInt -> World -> World useRewindGun i = timeFlow .~ RewindLeftClick { -- { _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge _reverseAmount = 100 , _scrollItemID = i } dropInventoryPath :: Int -> InventoryPathing -> LocationDT OItem -> Creature -> World -> World dropInventoryPath i ip loc cr = fromMaybe id $ do invid <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID j <- getInventoryPath i ip invid cr return $ dropItem cr j --dropInventoryPath i ip loc cr w = case ip of -- ABSOLUTE -> fromMaybe w $ do -- guard $ i `IM.member` (cr ^. crInv) -- return $ dropItem cr i w -- RELCURS -> fromMaybe w $ do -- j <- cr ^? crManipulation . manObject . imSelectedItem -- guard $ (i + j) `IM.member` (cr ^. crInv) -- return $ dropItem cr (i + j) w -- RELITEM -> fromMaybe w $ do -- j <- loc ^? locLDT . ldtValue . _1 . itLocation . ilInvID -- guard $ (i + j) `IM.member` (cr ^. crInv) -- return $ dropItem cr (i + j) w warmupSound :: ItemType -> SoundID warmupSound = \case HELD MINIGUNX{} -> crankSlowS HELD MACHINEPISTOL{} -> whirupS _ -> crankSlowS useInventoryPath :: PressType -> Int -> InventoryPathing -> LocationDT OItem -> Creature -> World -> World useInventoryPath pt i ip loc cr w = case ip of ABSOLUTE -> fromMaybe w $ do guard $ i `IM.member` (cr ^. crInv) return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem i pt) RELCURS -> fromMaybe w $ do j <- cr ^? crManipulation . manObject . imSelectedItem guard $ (i + j) `IM.member` (cr ^. crInv) return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt) RELITEM -> fromMaybe w $ do j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID guard $ (i + j) `IM.member` (cr ^. crInv) return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt) --useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of -- [w'] -> w & cwTime . maybeWorld .~ Just' w' -- (w' : ws) -> w -- & cwTime . maybeWorld -- .~ Just' w' -- & cwTime . rewindWorlds .~ ws -- _ -> w