{-# OPTIONS -Wno-incomplete-uni-patterns #-} --{-# LANGUAGE TupleSections #-} {-# LANGUAGE LambdaCase #-} module Dodge.HeldUse ( heldEffect, gadgetEffect, heldEffectNoHammerCheck, mcUseHeld, ) where import Color import Control.Applicative import Control.Monad import qualified Data.IntMap.Strict as IM import Data.Maybe import Dodge.Base.Collide import Dodge.BaseTriggerType import Dodge.Creature.Action import Dodge.Data.ComposedItem import Dodge.Data.DoubleTree import Dodge.Data.MuzzleEffect import Dodge.Data.World import Dodge.Gas import Dodge.Inventory.Lock import Dodge.Inventory.Path import Dodge.Item.HeldOffset import Dodge.Item.Weapon.Bullet import Dodge.Item.Weapon.Shatter import Dodge.Projectile.Create import Dodge.RadarSweep import Dodge.SoundLogic import Dodge.Tesla import Geometry import LensHelp import ListHelp import NewInt import Picture.Base import RandomHelp import qualified SDL import Sound.Data gadgetEffect :: PressType -> LocationLDT ItemLink ComposedItem -> Creature -> World -> World gadgetEffect pt loc | UseHeld{} <- loc ^. locLDT . ldtValue . _1 . itUse = heldEffect pt (bimap _iatType (^. _1) (loc ^. locLDT)) | DROPPER x <- loc ^. locLDT . ldtValue . _1 . itType , Just i <- loc ^? locLDT . ldtValue . _1 . itUse . uInt , pt == InitialPress = dropInventoryPath i x loc | CLICKER x <- loc ^. locLDT . ldtValue . _1 . itType , Just i <- loc ^? locLDT . ldtValue . _1 . itUse . uInt = useInventoryPath pt i x loc | otherwise = const id heldEffect :: PressType -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World heldEffect = hammerCheck heldEffectNoHammerCheck heldEffectNoHammerCheck :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World heldEffectNoHammerCheck = useTimeCheck heldEffectMuzzles type ChainEffect = (LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World) -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World hammerCheck :: (LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World) -> PressType -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World hammerCheck f pt it cr | BurstTrigger is <- baseTriggerType (it ^. ldtValue) , pt == InitialPress = f it cr . (cWorld . lWorld . delayedEvents .++~ map g is) | BurstTrigger{} <- baseTriggerType (it ^. ldtValue) , pt /= InitialPress = id | t <- baseTriggerType (it ^. ldtValue) , t == HammerTrigger || t == AlwaysSingleTrigger , isNothing $ lookup MakeAutoLink (it ^. ldtRight) , pt /= InitialPress = id | otherwise = f it cr where g x = (x, WdWdFromItCrixWdWd (upitm x) (_crID cr) ItCrWdItemHeldEffectNoHammer) upitm x = it -- & ldtValue . itUse . heldParams . weaponRepeat .~ [] & ldtValue . itUse . heldFrame .~ x --g x = (x, WdWdBurstFireRepeats (_crID cr) (it ^?! ldtValue . itLocation . ilInvID)) -- | Applies a world effect after an item use cooldown check. useTimeCheck :: ChainEffect useTimeCheck f item cr w = case item ^? ldtValue . itUse . heldDelay of Just (FixedRate rate lastused) | w ^. cWorld . lWorld . lClock - rate > lastused -> f item cr $ setUseRate w Just FixedRate{} -> w Just (WarmUpNoDelay wt wm ws) | wt < wm -> w & soundContinue (CrWeaponSound cid 0) (_crPos cr) ws (Just 2) & cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . warmTime +~ 2 Just (WarmUpNoDelay _ wm _) -> f item cr w & cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . warmTime .~ (wm + 1) Just NoDelay -> f item cr w Nothing -> w where cid = _crID cr setUseRate = cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . rateTimeLastUsed .~ w ^. cWorld . lWorld . lClock -- the following is unsafe, but if ilInvID isn't correctly set we probably -- will have problems elsewhere also itRef = item ^?! ldtValue . itLocation . ilInvID heldEffectMuzzles :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World heldEffectMuzzles t cr w = doHeldUseEffect t cr $ uncurry (applyCME (_ldtValue t) cr) cmew where -- & doWeaponRepetitions upitm cr muzzles = t ^. ldtValue . itUse . heldMuzzles --(upitm, loadedmuzzles) = mapAccumR loadMuzzle t muzzles (_, loadedmuzzles) = mapAccumR loadMuzzle t muzzles cmew = foldl' (useLoadedAmmo t cr) (CME 0 0 False, w) $ zip [0 ..] loadedmuzzles doHeldUseEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World doHeldUseEffect t cr w = case t ^? ldtValue . itUse . heldUseEffect of Just (RandomiseMuzzleFrames x) -> fromMaybe w $ do i <- t ^? ldtValue . itLocation . ilInvID let g = w ^. randGen (is, g') = runState (shuffle [0 .. x -1]) g return $ w & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i . itUse . heldMuzzles %~ zipWith (\j mz -> mz & mzFrame .~ j) is & randGen .~ g' Just SwitchAlteRifle -> fromMaybe w $ do i <- t ^? ldtValue . itLocation . ilInvID return $ w & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i . itUse . heldMuzzles . ix 0 . mzAmmoSlot %~ ((`mod` 2) . (+ 1)) Just NoHeldUseEffect -> w Nothing -> w ---- need to be careful about inventory lock or item ids here --doWeaponRepetitions :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World --doWeaponRepetitions itm cr = case itm ^? ldtValue . itUse . heldParams . weaponRepeat of -- Just xs -> cWorld . lWorld . delayedEvents .++~ map f xs -- _ -> id -- where -- f x = (x, WdWdFromItCrixWdWd (upitm x) (_crID cr) ItCrWdItemHeldEffect) -- upitm x = -- itm & ldtValue . itUse . heldParams . weaponRepeat .~ [] -- & ldtValue . itUse . heldFrame .~ x applyCME :: Item -> Creature -> CumulativeMuzzleEffect -> World -> World applyCME itm cr cme | _cmeSound cme = applyInvLock itm cr . applySoundCME itm cr . applySidePush spush cr . applyTorqueCME itm cr . applyRecoil itm cr | otherwise = failsound where spush = maybe 0 itemSidePush $ itm ^? itType . ibtHeld failsound w = case w ^? input . mouseButtons . ix SDL.ButtonLeft of Just 0 -> soundStart (CrWeaponFailSound (_crID cr)) (_crPos cr) click1S Nothing w _ -> soundContinue (CrWeaponFailSound (_crID cr)) (_crPos cr) click1S Nothing w itemSidePush :: HeldItemType -> Float itemSidePush = \case BANGSTICK{} -> 0 REWINDER -> 0 TIMESTOPPER -> 0 TIMESCROLLER -> 0 PISTOL -> 50 MACHINEPISTOL -> 50 AUTOPISTOL -> 50 SMG -> 30 BANGCONE -> 0 BLUNDERBUSS -> 0 GRAPECANNON{} -> 0 MINIGUNX i -> 10 + fromIntegral i VOLLEYGUN{} -> 0 RIFLE -> 0 ALTERIFLE -> 0 AUTORIFLE -> 0 BURSTRIFLE -> 0 BANGROD -> 0 ELEPHANTGUN -> 0 AMR -> 0 AUTOAMR -> 0 SNIPERRIFLE -> 0 FLAMESPITTER -> 0 FLAMETHROWER -> 25 FLAMETORRENT -> 0 FLAMEWALL -> 0 BLOWTORCH -> 0 SPARKGUN -> 0 TESLAGUN -> 0 LASER -> 0 TRACTORGUN -> 0 RLAUNCHER -> 0 RLAUNCHERX{} -> 0 GLAUNCHER -> 0 POISONSPRAYER -> 0 SHATTERGUN -> 0 TORCH -> 0 FLATSHIELD -> 0 KEYCARD{} -> 0 BLINKER -> 0 BLINKERUNSAFE -> 0 applyInvLock :: Item -> Creature -> World -> World applyInvLock itm cr | i <- itemInvLock itm , i > 0 = (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv cid)) . lockInv cid | otherwise = id where cid = _crID cr itemInvLock :: Item -> Int itemInvLock itm = case itm ^. itType of HELD hit -> heldItemInvLock hit _ -> 0 heldItemInvLock :: HeldItemType -> Int heldItemInvLock = \case FLAMESPITTER -> 10 VOLLEYGUN i -> i + 1 BURSTRIFLE -> 7 _ -> 0 applySoundCME :: Item -> Creature -> World -> World applySoundCME itm cr = fromMaybe id $ do (soundid, x) <- bgunSound itm return $ if x > 0 then soundContinue (CrWeaponSound cid 0) (_crPos cr) soundid (Just x) else soundMultiFrom [CrWeaponSound cid j | j <- [0 .. 5]] (_crPos cr) soundid Nothing where cid = _crID cr applyRecoil :: Item -> Creature -> World -> World applyRecoil itm cr = cWorld . lWorld . creatures . ix (_crID cr) . crPos +~ rotateV (_crDir cr) (V2 ((- recoilAmount itm) / _crMass cr) 0) recoilAmount :: Item -> Float recoilAmount itm | HELD hit <- itm ^. itType = case hit of BANGSTICK _ -> 25 REWINDER -> 0 TIMESTOPPER -> 0 TIMESCROLLER -> 0 PISTOL -> 10 MACHINEPISTOL -> 15 AUTOPISTOL -> 10 SMG -> 10 BANGCONE -> 150 BLUNDERBUSS -> 150 GRAPECANNON i -> 150 + fromIntegral i * 50 MINIGUNX i -> 10 * fromIntegral i VOLLEYGUN _ -> 30 RIFLE -> 50 ALTERIFLE -> 50 AUTORIFLE -> 50 BURSTRIFLE -> 50 BANGROD -> 50 ELEPHANTGUN -> 50 AMR -> 50 AUTOAMR -> 50 SNIPERRIFLE -> 50 FLAMESPITTER -> 0 FLAMETHROWER -> 0 FLAMETORRENT -> 0 FLAMEWALL -> 0 BLOWTORCH -> 0 SPARKGUN -> 0 TESLAGUN -> 0 LASER -> 0 TRACTORGUN -> 0 RLAUNCHER -> 0 RLAUNCHERX _ -> 0 GLAUNCHER -> 0 POISONSPRAYER -> 0 SHATTERGUN -> 0 TORCH -> 0 FLATSHIELD -> 0 KEYCARD _ -> 0 BLINKER -> 0 BLINKERUNSAFE -> 0 | otherwise = 0 -- if the int is 0, play sound on new channel -- if >0, continue playing sound for given time bgunSound :: Item -> Maybe (SoundID, Int) bgunSound itm | HELD hit <- itm ^. itType = case hit of BANGSTICK _ -> Just (tap3S, 0) REWINDER -> Nothing TIMESTOPPER -> Nothing TIMESCROLLER -> Nothing PISTOL -> Just (tap3S, 0) MACHINEPISTOL -> Just (tap1S, 0) AUTOPISTOL -> Just (tap1S, 0) SMG -> Just (tap1S, 0) BANGCONE -> Just (bangEchoS, 0) BLUNDERBUSS -> Just (bangEchoS, 0) GRAPECANNON _ -> Just (bangEchoS, 0) MINIGUNX _ -> Just (mini1S, 2) VOLLEYGUN _ -> Just (tap3S, 0) RIFLE -> Just (tap3S, 0) ALTERIFLE -> Just (tap3S, 0) AUTORIFLE -> Just (tap3S, 0) BURSTRIFLE -> Just (tap3S, 0) BANGROD -> Just (bangEchoS, 0) ELEPHANTGUN -> Just (bangEchoS, 0) AMR -> Just (bangEchoS, 0) AUTOAMR -> Just (bangEchoS, 0) SNIPERRIFLE -> Just (bangEchoS, 0) FLAMESPITTER -> Nothing FLAMETHROWER -> Nothing FLAMETORRENT -> Nothing FLAMEWALL -> Nothing BLOWTORCH -> Nothing SPARKGUN -> Nothing TESLAGUN -> Nothing LASER -> Nothing TRACTORGUN -> Nothing RLAUNCHER -> Just (tap4S, 0) RLAUNCHERX _ -> Just (tap4S, 0) GLAUNCHER -> Just (tap4S, 0) POISONSPRAYER -> Just (foamSprayLoopS, 5) SHATTERGUN -> Nothing TORCH -> Nothing FLATSHIELD -> Nothing KEYCARD _ -> Nothing BLINKER -> Nothing BLINKERUNSAFE -> Nothing | otherwise = Nothing applySidePush :: Float -> Creature -> World -> World applySidePush 0 _ w = w applySidePush maxSide cr w = w & cWorld . lWorld . creatures . ix cid . crPos +~ push & randGen .~ g where cid = _crID cr push = rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr)) (pushAmount, g) = randomR (- maxSide, maxSide) $ _randGen w applyTorqueCME :: Item -> Creature -> World -> World applyTorqueCME itm cr w = w & cWorld . lWorld . creatures . ix cid . crDir +~ rot & randGen .~ g & if cid == 0 then wCam . camRot -~ rot else id where cid = _crID cr (rot, g) = randomR (- torque, torque) $ _randGen w torque = torqueAmount itm torqueAmount :: Item -> Float torqueAmount itm = case itm ^. itType of HELD hit -> heldTorqueAmount hit _ -> 0 heldTorqueAmount :: HeldItemType -> Float heldTorqueAmount = \case BANGSTICK i -> 0.18 + 0.02 * fromIntegral i REWINDER -> 0 TIMESTOPPER -> 0 TIMESCROLLER -> 0 PISTOL -> 0.2 MACHINEPISTOL -> 0.2 AUTOPISTOL -> 0.2 SMG -> 0.05 BANGCONE -> 0.1 BLUNDERBUSS -> 0.1 GRAPECANNON i -> 0.1 + 0.2 * fromIntegral i MINIGUNX i -> 0.04 + 0.02 * fromIntegral i VOLLEYGUN{} -> 0.1 RIFLE -> 0.1 ALTERIFLE -> 0.1 AUTORIFLE -> 0.1 BURSTRIFLE -> 0.1 BANGROD -> 0.3 ELEPHANTGUN -> 0.3 AMR -> 0.3 AUTOAMR -> 0.3 SNIPERRIFLE -> 0.3 FLAMESPITTER -> 0 FLAMETHROWER -> 0 FLAMETORRENT -> 0 FLAMEWALL -> 0 BLOWTORCH -> 0 SPARKGUN -> 0 TESLAGUN -> 0 LASER -> 0 TRACTORGUN -> 0 RLAUNCHER -> 0 RLAUNCHERX{} -> 0 GLAUNCHER -> 0 POISONSPRAYER -> 0 SHATTERGUN -> 0 TORCH -> 0 FLATSHIELD -> 0 KEYCARD{} -> 0 BLINKER -> 0 BLINKERUNSAFE -> 0 -- (Muzzle,Int,Int) = (muzzle, amountloaded, id of mag taken from) loadMuzzle :: LabelDoubleTree ComposeLinkType Item -> Muzzle -> (LabelDoubleTree ComposeLinkType Item, Maybe (Muzzle, Int, LabelDoubleTree ComposeLinkType Item)) loadMuzzle t@(LDT _ l _) mz = fromMaybe (t, Nothing) $ do guard $ mz ^? mzFrame == t ^? ldtValue . itUse . heldFrame let as = _mzAmmoSlot mz amamount = _mzAmmoPerShot mz (i, (_, mag)) <- findWithIx (isAmmoIntLink as . fst) l availableammo <- mag ^? ldtValue . itConsumables . magLoadStatus . iaLoaded let usedammo = case amamount of UseUpTo x -> min x availableammo UseExactly x | x <= availableammo -> x | otherwise -> 0 guard $ usedammo > 0 return ( t & ldtLeft . ix i . _2 . ldtValue . itConsumables . magLoadStatus . iaLoaded -~ usedammo , Just (mz, usedammo, mag) ) makeMuzzleFlare :: Muzzle -> LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World makeMuzzleFlare mz itmtree cr = case mz ^. mzFlareType of NoFlare -> id BasicFlare -> basicMuzFlare pos dir NoLightFlare -> muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir MiniGunFlare -> (cWorld . lWorld . lights .:~ LSParam (pos `v2z` 20) 100 (V3 1 1 0.5)) . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir HeavySmokeFlare -> basicMuzFlare pos dir LasGunFlare -> flareCircleAt (getLaserColor itmtree) 0.8 (pos `v2z` 20) -- . ( cWorld . lWorld . tempLightSources -- .:~ tlsTimeRadColPos 1 100 (xyzV4 $ getLaserColor itmtree) (pos `v2z` 10) . ( cWorld . lWorld . lights .:~ LSParam (pos `v2z` 10) 100 (xyzV4 $ getLaserColor itmtree) ) TeslaGunFlare -> cWorld . lWorld . lights .:~ LSParam (pos `v2z` 10) 100 (V3 0 0 1) where -- .:~ tlsTimeRadColPos 1 100 (V3 0 0 1) (pos `v2z` 10) itm = itmtree ^. ldtValue (moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz) pos = _crPos cr + rotateV (_crDir cr) moff dir = _crDir cr + mrot --{-# OPTIONS -Wno-incomplete-uni-patterns #-} muzFlareAt :: Color -> Point3 -> Float -> World -> World muzFlareAt col tranv dir w = w & randGen .~ g & cWorld . lWorld . flares <>~ thepic where thepic = setLayer BloomNoZWrite . translate3 tranv . color col . rotate dir . polygon $ [ V2 0 0 , V2 a (- b) , V2 c d ] thestate = replicateM 4 $ state $ randomR (2, 20) (a : b : c : d : _, g) = runState thestate $ _randGen w -- randomRs (2, 20) (_randGen w) flareCircleAt :: Color -> Float -> Point3 -> World -> World flareCircleAt col alphax tranv = cWorld . lWorld . flares <>~ setLayer BloomNoZWrite ( translate3 tranv $ circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 50 ) -- previous phaseV parameters: 0.2, 1, 5 getLaserPhaseV :: LabelDoubleTree ComposeLinkType Item -> Float getLaserPhaseV = const 1 getLaserDamage :: LabelDoubleTree ComposeLinkType Item -> LaserType getLaserDamage = const (DamageLaser 11) getLaserColor :: LabelDoubleTree ComposeLinkType Item -> Color getLaserColor = const yellow basicMuzFlare :: Point2 -> Float -> World -> World basicMuzFlare pos dir = (cWorld . lWorld . lights .:~ LSParam (pos `v2z` 20) 100 (V3 1 1 0.5)) . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir . muzFlareAt (V4 10 10 1 3) (pos `v2z` 20) dir isAmmoIntLink :: Int -> ComposeLinkType -> Bool isAmmoIntLink i (AmmoInLink j _) = i == j isAmmoIntLink _ _ = False useLoadedAmmo :: LabelDoubleTree ComposeLinkType Item -> Creature -> (CumulativeMuzzleEffect, World) -> (Int, Maybe (Muzzle, Int, LabelDoubleTree ComposeLinkType Item)) -> (CumulativeMuzzleEffect, World) useLoadedAmmo _ _ (cme, w) (_, Nothing) = (cme, w) useLoadedAmmo itmtree cr (cme, w) (mzid, Just (mz, x, magtree)) = (,) (cme & cmeSound .~ True) $ removeAmmoFromMag x mid cr . makeMuzzleFlare mz itmtree cr $ case _mzEffect mz of MuzzleShootBullet -> shootBullet itmtree cr (mz, x, magtree) w MuzzleLaser -> creatureShootLaser itmtree cr mz w MuzzleTesla -> shootTeslaArc itm cr mz w MuzzleTractor -> shootTractorBeam cr w MuzzleRLauncher -> createProjectileR itmtree magtree mz cr w MuzzleGLauncher -> createProjectile (Grenade (getGrenadeHitEffect itmtree)) magtree (getPJStabiliser itmtree) mz cr w MuzzleNozzle{} -> useGasParams mid mz itm cr $ walkNozzle mzid mz itm cr w MuzzleShatter -> shootShatter itm cr w MuzzleDetector -> itemDetectorEffect itm (getAttachedSFLink MapperSF itmtree) (getAttachedSFLink ARHUDSF itmtree) cr w MuzzleBlink -> unsafeBlinkAction cr w MuzzleUnsafeBlink -> blinkActionMousePos cr w MuzzleRewind -> useRewindGun (itm ^. itID) w MuzzleStopper -> useStopWatch itm cr w MuzzleScroller -> useTimeScrollGun itm cr w where mid = magtree ^? ldtValue . itLocation . ilInvID itm = itmtree ^. ldtValue getAttachedSFLink :: ItemStructuralFunction -> LabelDoubleTree ComposeLinkType Item -> Maybe (NewInt ItmInt) getAttachedSFLink sf = (^? ldtRight . folding (lookup (SFLink sf)) . ldtValue . itID) itemDetectorEffect :: Item -> Maybe (NewInt ItmInt) -> Maybe (NewInt ItmInt) -> Creature -> World -> World itemDetectorEffect itm mitid armitid cr w = fromMaybe w $ do DETECTOR dt <- itm ^? itType return $ aRadarPulse (itm ^. itID) mitid armitid (f dt) cr w where f ITEMDETECTOR = ObItem f CREATUREDETECTOR = ObCreature f WALLDETECTOR = ObWall walkNozzle :: Int -> Muzzle -> Item -> Creature -> World -> World walkNozzle mzid mz itm cr w = fromMaybe w $ do invid <- itm ^? itLocation . ilInvID return $ w & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . heldMuzzles . ix mzid . mzEffect . nzCurrentWalkAngle .~ wa & randGen .~ g where nz = _mzEffect mz (walkamount, g) = randomR (- aspeed, aspeed) (_randGen w) aspeed = _nzWalkSpeed nz maxa = _nzMaxWalkAngle nz wa = min maxa $ max (negate maxa) (_nzCurrentWalkAngle nz + walkamount) shootTractorBeam :: Creature -> World -> World shootTractorBeam cr w = w & cWorld . lWorld . tractorBeams .:~ tractorBeamAt spos outpos dir power & soundContinue (CrWeaponSound (_crID cr) 0) cpos tone440sawtoothquietS (Just 2) where cpos = _crPos cr spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir xpos = cpos +.+ 400 *.* unitVectorAtAngle dir dir = _crDir cr outpos = fst $ collidePointWallsFilter (const True) cpos xpos w power = 1 tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> TractorBeam tractorBeamAt pos outpos dir power = TractorBeam { _tbPos = pos , _tbStartPos = outpos , _tbVel = d , _tbTime = 10 } where d = unitVectorAtAngle dir * power creatureShootLaser :: LabelDoubleTree ComposeLinkType Item -> Creature -> Muzzle -> World -> World creatureShootLaser itmtree cr mz w = w & randGen .~ g & shootLaser (CrWeaponSound (_crID cr) 0) (getLaserDamage itmtree) (getLaserPhaseV itmtree) pos dir (getLaserColor itmtree) where itm = itmtree ^. ldtValue (moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz) pos = _crPos cr + rotateV (_crDir cr) moff dir = _crDir cr + mrot + a (a, g) = randomR (- inacc, inacc) $ _randGen w inacc = _mzInaccuracy mz shootLaser :: SoundOrigin -> LaserType -> Float -> Point2 -> Float -> Color -> World -> World shootLaser so lt pv p dir col w = w & cWorld . lWorld . lasers .:~ Laser { _lpType = lt , _lpPhaseV = pv , _lpPos = p , _lpDir = dir , _lpColor = col } & soundContinue so p tone440sawtoothquietS (Just 2) removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World removeAmmoFromMag x mid cr = fromMaybe id $ do magid <- mid return $ cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix magid . itConsumables . magLoadStatus . iaLoaded -~ x getBulletType :: LabelDoubleTree ComposeLinkType Item -> Maybe Bullet getBulletType magtree = magtree ^? ldtValue . itConsumables . magParams . ampBullet -- <&> buTrajectory .~ btraj <&> buPayload .~ bpayload <&> buEffect .~ beffect where -- btraj = fromMaybe BasicBulletTrajectory $ do -- targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these? -- tp <- targetingtree ^? ldtValue . itTargeting . itTgPos . _Just -- attree <- lookup AmmoTargetingLink (magtree ^. ldtLeft) -- bt <- attree ^? ldtValue . itUse . ubMod . bmTrajectory -- return $ getBulletTrajectory mz (itmtree ^. ldtValue) bt tp cr w bpayload = fromMaybe BulSpark $ do attree <- lookup AmmoPayloadLink (magtree ^. ldtLeft) attree ^? ldtValue . itUse . ubMod . bmPayload beffect = fromMaybe DestroyBullet $ do attree <- lookup AmmoEffectLink (magtree ^. ldtLeft) attree ^? ldtValue . itUse . ubMod . bmEffect --getBulletTrajectory :: -- Muzzle -> -- Item -> -- BulletTrajectoryType -> -- Point2 -> -- Creature -> -- World -> -- BulletTrajectory --getBulletTrajectory mz itm bt tp cr w = case bt of -- BasicBulletTrajectoryType -> BasicBulletTrajectory -- FlechetteTrajectoryType -> FlechetteTrajectory tp -- BezierTrajectoryType -> BezierTrajectory bulpos tp (mouseWorldPos (w ^. input) (w ^. wCam)) -- MagnetTrajectoryType -> MagnetTrajectory tp -- where -- (moff, _) = heldItemOrient2D itm cr (_mzPos mz + V2 0 offset) (_mzRot mz) -- bulpos = _crPos cr + rotateV (_crDir cr) moff -- offset = case itm ^? itUse . heldParams . randomOffset of -- Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w -- _ -> 0 shootBullet :: LabelDoubleTree ComposeLinkType Item -> Creature -> (Muzzle, Int, LabelDoubleTree ComposeLinkType Item) -> World -> World shootBullet itmtree cr (mz, x, magtree) w = fromMaybe w $ do thebullet <- getBulletType magtree return $ foldl' (&) w (replicate x (makeBullet' thebullet (itmtree ^. ldtValue) cr mz)) makeBullet' :: Bullet -> Item -> Creature -> Muzzle -> World -> World makeBullet' bu itm cr mz w = makeBullet bu itm bulpos dir . (randGen .~ g) $ w where bulpos = _crPos cr + rotateV (_crDir cr) moff (moff, mrot) = heldItemOrient2D itm cr (_mzPos mz + V2 0 offset) (_mzRot mz) (a, g) = randomR (- inacc, inacc) $ _randGen w dir = _crDir cr + mrot + a inacc = _mzInaccuracy mz offset = case itemRandomOffset <$> itm ^? itType . ibtHeld of Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w _ -> 0 -- & makeMuzzleSmoke mz itm cr itemRandomOffset :: HeldItemType -> Float itemRandomOffset = \case BANGSTICK{} -> 0 REWINDER -> 0 TIMESTOPPER -> 0 TIMESCROLLER -> 0 PISTOL -> 0 MACHINEPISTOL -> 0 AUTOPISTOL -> 0 SMG -> 0 BANGCONE -> 12 BLUNDERBUSS -> 12 GRAPECANNON i -> 12 + 4 * fromIntegral i MINIGUNX{} -> 10 VOLLEYGUN{} -> 0 RIFLE -> 0 ALTERIFLE -> 0 AUTORIFLE -> 0 BURSTRIFLE -> 0 BANGROD -> 0 ELEPHANTGUN -> 0 AMR -> 0 AUTOAMR -> 0 SNIPERRIFLE -> 0 FLAMESPITTER -> 0 FLAMETHROWER -> 0 FLAMETORRENT -> 0 FLAMEWALL -> 0 BLOWTORCH -> 0 SPARKGUN -> 0 TESLAGUN -> 0 LASER -> 0 TRACTORGUN -> 0 RLAUNCHER -> 0 RLAUNCHERX{} -> 0 GLAUNCHER -> 0 POISONSPRAYER -> 0 SHATTERGUN -> 0 TORCH -> 0 FLATSHIELD -> 0 KEYCARD{} -> 0 BLINKER -> 0 BLINKERUNSAFE -> 0 makeBullet :: Bullet -> Item -> Point2 -> Float -> World -> World makeBullet thebullet itm bulpos dir w = w & randGen .~ g'' & cWorld . lWorld . bullets .:~ ( thebullet & buPos .~ bulpos & buOldPos .~ bulpos & buVel %~ (rotateV dir . (muzvel *.*)) & buDrag *~ drag ) where g = _randGen w (drag, g') = case heldItemRifling (_ibtHeld $ _itType itm) of --unsafe ConstFloat x -> (x, g) UniRandFloat x y -> randomR (x, y) g (muzvel, g'') = case heldItemMuzVel $ _ibtHeld $ _itType itm of ConstFloat x -> (x, g') UniRandFloat x y -> randomR (x, y) g' heldItemMuzVel :: HeldItemType -> GenFloat heldItemMuzVel = \case BANGSTICK{} -> ConstFloat 0.8 REWINDER -> ConstFloat 0.8 TIMESTOPPER -> ConstFloat 0.8 TIMESCROLLER -> ConstFloat 0.8 PISTOL -> ConstFloat 0.8 MACHINEPISTOL -> ConstFloat 0.8 AUTOPISTOL -> ConstFloat 0.8 SMG -> ConstFloat 0.8 BANGCONE -> UniRandFloat 0.5 0.8 BLUNDERBUSS -> UniRandFloat 0.5 0.8 GRAPECANNON{} -> UniRandFloat 0.5 0.8 MINIGUNX{} -> ConstFloat 0.8 VOLLEYGUN{} -> ConstFloat 0.8 RIFLE -> ConstFloat 0.8 ALTERIFLE -> ConstFloat 0.8 AUTORIFLE -> ConstFloat 0.8 BURSTRIFLE -> ConstFloat 0.8 BANGROD -> ConstFloat 0.8 ELEPHANTGUN -> ConstFloat 0.8 AMR -> ConstFloat 0.8 AUTOAMR -> ConstFloat 0.8 SNIPERRIFLE -> ConstFloat 0.8 FLAMESPITTER -> ConstFloat 0.8 FLAMETHROWER -> ConstFloat 0.8 FLAMETORRENT -> ConstFloat 0.8 FLAMEWALL -> ConstFloat 0.8 BLOWTORCH -> ConstFloat 0.8 SPARKGUN -> ConstFloat 0.8 TESLAGUN -> ConstFloat 0.8 LASER -> ConstFloat 0.8 TRACTORGUN -> ConstFloat 0.8 RLAUNCHER -> ConstFloat 0 RLAUNCHERX{} -> ConstFloat 0 GLAUNCHER -> ConstFloat 0 POISONSPRAYER -> ConstFloat 0.8 SHATTERGUN -> ConstFloat 0.8 TORCH -> ConstFloat 0.8 FLATSHIELD -> ConstFloat 0 KEYCARD{} -> ConstFloat 0.8 BLINKER -> ConstFloat 0.8 BLINKERUNSAFE -> ConstFloat 0.8 heldItemRifling :: HeldItemType -> GenFloat heldItemRifling = \case BANGSTICK{} -> ConstFloat 0.8 REWINDER -> ConstFloat 0.8 TIMESTOPPER -> ConstFloat 0.8 TIMESCROLLER -> ConstFloat 0.8 PISTOL -> ConstFloat 0.8 MACHINEPISTOL -> ConstFloat 0.8 AUTOPISTOL -> ConstFloat 0.8 SMG -> ConstFloat 0.8 BANGCONE -> UniRandFloat 0.3 0.8 BLUNDERBUSS -> UniRandFloat 0.3 0.8 GRAPECANNON{} -> UniRandFloat 0.3 0.8 MINIGUNX{} -> UniRandFloat 0.8 0.9 VOLLEYGUN{} -> ConstFloat 0.9 RIFLE -> ConstFloat 0.9 ALTERIFLE -> ConstFloat 0.9 AUTORIFLE -> ConstFloat 0.9 BURSTRIFLE -> ConstFloat 0.9 BANGROD -> ConstFloat 1 ELEPHANTGUN -> ConstFloat 1 AMR -> ConstFloat 1 AUTOAMR -> ConstFloat 1 SNIPERRIFLE -> ConstFloat 1 FLAMESPITTER -> ConstFloat 0.8 FLAMETHROWER -> ConstFloat 0.8 FLAMETORRENT -> ConstFloat 0.8 FLAMEWALL -> ConstFloat 0.8 BLOWTORCH -> ConstFloat 0.8 SPARKGUN -> ConstFloat 0.8 TESLAGUN -> ConstFloat 0.8 LASER -> ConstFloat 0.8 TRACTORGUN -> ConstFloat 0.8 RLAUNCHER -> ConstFloat 0 RLAUNCHERX{} -> ConstFloat 0 GLAUNCHER -> ConstFloat 0 POISONSPRAYER -> ConstFloat 0.8 SHATTERGUN -> ConstFloat 0.8 TORCH -> ConstFloat 0.8 FLATSHIELD -> ConstFloat 0.8 KEYCARD{} -> ConstFloat 0.8 BLINKER -> ConstFloat 0.8 BLINKERUNSAFE -> ConstFloat 0.8 mcUseHeld :: HeldItemType -> Item -> Machine -> World -> World mcUseHeld hit = case hit of LASER -> mcShootLaser _ -> mcShootAuto useGasParams :: Maybe Int -> Muzzle -> Item -> Creature -> World -> World useGasParams mmagid mz itm cr w = w & createGas gastype pressure pos dir cr & randGen .~ g' where (pressure, g) = doGenFloat (_nzPressure $ _mzEffect mz) (_randGen w) gastype = fromMaybe (error "cannot find gas ammo") $ do magid <- mmagid hit <- itm ^? itType . ibtHeld fueltype <- cr ^? crInv . ix magid . itConsumables . magParams . ampCreateGas gasType hit fueltype --pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm) (moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz) pos = _crPos cr + rotateV (_crDir cr) moff (a, g') = randomR (- inacc, inacc) g inacc = _mzInaccuracy mz dir = _crDir cr + mrot + a + _nzCurrentWalkAngle (_mzEffect mz) gasType :: HeldItemType -> GasFuel -> Maybe GasCreate gasType hit _ = case hit of BANGSTICK{} -> Nothing REWINDER -> Nothing TIMESTOPPER -> Nothing TIMESCROLLER -> Nothing PISTOL -> Nothing MACHINEPISTOL -> Nothing AUTOPISTOL -> Nothing SMG -> Nothing BANGCONE -> Nothing BLUNDERBUSS -> Nothing GRAPECANNON{} -> Nothing MINIGUNX{} -> Nothing VOLLEYGUN{} -> Nothing RIFLE -> Nothing ALTERIFLE -> Nothing AUTORIFLE -> Nothing BURSTRIFLE -> Nothing BANGROD -> Nothing ELEPHANTGUN -> Nothing AMR -> Nothing AUTOAMR -> Nothing SNIPERRIFLE -> Nothing FLAMESPITTER -> Nothing FLAMETHROWER -> Just CreateFlame FLAMETORRENT -> Just CreateFlame FLAMEWALL -> Just CreateFlame BLOWTORCH -> Nothing SPARKGUN -> Nothing TESLAGUN -> Nothing LASER -> Nothing TRACTORGUN -> Nothing RLAUNCHER -> Nothing RLAUNCHERX{} -> Nothing GLAUNCHER -> Nothing POISONSPRAYER -> Just CreatePoisonGas SHATTERGUN -> Nothing TORCH -> Nothing FLATSHIELD -> Nothing KEYCARD{} -> Nothing BLINKER -> Nothing BLINKERUNSAFE -> Nothing doGenFloat :: RandomGen g => GenFloat -> g -> (Float, g) doGenFloat (ConstFloat x) g = (x, g) doGenFloat (UniRandFloat x y) g = randomR (x, y) g mcShootLaser :: Item -> Machine -> World -> World mcShootLaser _ mc = shootLaser (MachineSound (_mcID mc)) (DamageLaser 11) 1 pos dir yellow where pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir dir = mc ^?! mcType . _McTurret . tuDir mcShootAuto :: Item -> Machine -> World -> World mcShootAuto itm mc w | Just (FixedRate rate lastused) <- mc ^? mcType . mctTurret . tuWeapon . itUse . heldDelay , w ^. cWorld . lWorld . lClock - rate > lastused = w & cWorld . lWorld . machines . ix (_mcID mc) . mcType . mctTurret . tuWeapon . itUse . heldDelay . rateTimeLastUsed .~ w ^. cWorld . lWorld . lClock & makeBullet defaultBullet itm pos dir | otherwise = w where pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir dir = mc ^?! mcType . _McTurret . tuDir -- | assumes that the item is held shootTeslaArc :: Item -> Creature -> Muzzle -> World -> World shootTeslaArc itm cr mz w = w' & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip & soundContinue (CrWeaponSound (_crID cr) 0) pos elecCrackleS (Just 2) where -- use items item location instead itRef = cr ^?! crManipulation . manObject . imRootSelectedItem -- unsafe!! TODO change (w', ip) = makeTeslaArc (_itParams itm) pos dir w (moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz) pos = _crPos cr + rotateV (_crDir cr) moff dir = _crDir cr + mrot determineProjectileTracking :: LabelDoubleTree ComposeLinkType Item -> LabelDoubleTree ComposeLinkType Item -> RocketHoming determineProjectileTracking magtree itmtree = fromMaybe NoHoming $ finddronecontrols <|> findexternaltracking where finddronecontrols = do screen <- lookup RemoteScreenLink (magtree ^. ldtLeft) _ <- lookup JoystickLink (screen ^. ldtLeft) return $ HomeUsingRemoteScreen (screen ^. ldtValue . itID) findexternaltracking = do _ <- lookup AmmoTargetingLink (magtree ^. ldtLeft) targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) return $ HomeUsingTargeting (targetingtree ^. ldtValue . itID) createProjectileR :: LabelDoubleTree ComposeLinkType Item -> LabelDoubleTree ComposeLinkType Item -> Muzzle -> Creature -> World -> World createProjectileR itmtree magtree = createProjectile ( Rocket (determineProjectileTracking magtree itmtree) smoke ) magtree (getPJStabiliser itmtree) where smoke | isJust $ lookup SmokeReducerLink (magtree ^. ldtLeft) = Just ReducedRocketSmoke | otherwise = Nothing getPJStabiliser :: LabelDoubleTree ComposeLinkType Item -> Maybe PJStabiliser getPJStabiliser ldt = case lookup ProjectileStabiliserLink (ldt ^. ldtRight) of Just ldt' -> case ldt' ^? ldtValue . itType . ibtAttach of Just GIMBAL -> Just StabOrthReduce Just GYROSCOPE -> Just StabSpinIncrease _ -> Nothing _ -> Nothing getGrenadeHitEffect :: LabelDoubleTree ComposeLinkType Item -> GrenadeHitEffect getGrenadeHitEffect t = case lookup GrenadeHitEffectLink (t ^. ldtRight) of Just ldt' -> case ldt' ^? ldtValue . itType of Just STICKYMOD -> GStick _ -> GBounce 2 _ -> GBounce 2 createProjectile :: ProjectileType -> LabelDoubleTree ComposeLinkType Item -> Maybe PJStabiliser -> Muzzle -> Creature -> World -> World createProjectile pjtype magtree stab muz cr = fromMaybe failsound $ do magid <- magtree ^? ldtValue . itLocation . ilInvID ammoitem <- cr ^? crInv . ix magid let rdetonate = (^. ldtValue . itID) <$> lookup RemoteDetonatorLink (magtree ^. ldtLeft) rscreen = (^. ldtValue . itID) <$> lookup RemoteScreenLink (magtree ^. ldtLeft) aparams <- ((magtree ^? ldtLeft) >>= lookup AmmoPayloadLink >>= (^? ldtValue . itType . ibtAttach . shellPayload)) <|> ammoitem ^? itConsumables . magParams . ampPayload return $ createShell rdetonate rscreen stab pjtype aparams muz cr . startthesound where -- the sound should be moved to the projectile firing startthesound = soundMultiFrom [CrWeaponSound (_crID cr) j | j <- [0 .. 3]] (_crPos cr) tap4S Nothing failsound w' = case w' ^? input . mouseButtons . ix SDL.ButtonLeft of Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w' _ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w' ---- need to add these to muzzle flare? --makeMuzzleSmoke :: Muzzle -> Item -> Creature -> World -> World --makeMuzzleSmoke mz itm cr w = case mz ^. mzFlareType of -- DefaultFlareType -> w -- PistolFlare -> foldl' (flip $ smokeCloudAt (greyN 0.5) 5 400 5 . (+.+.+ pos) . (* 8)) w ps -- MiniGunFlare -> smokeCloudAt (greyN 0.5) 5 400 5 pos w -- HeavySmokeFlare -> foldl' (flip $ smokeCloudAt black 20 400 5 . (+.+.+ pos) . (* 8)) w ps' -- LasGunFlare -> w -- TeslaGunFlare -> w -- where -- ps = replicateM 2 randOnUnitSphere & evalState $ _randGen w -- ps' = replicateM 4 randOnUnitSphere & evalState $ _randGen w -- pos = addZ 10 $ _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm) ---- , withSmoke 1 black 20 200 5 useStopWatch :: Item -> Creature -> World -> World useStopWatch itm _ = timeFlow .~ PausedTimeFlow { _timeFlowCharge = 100 , _scrollItemID = _itID itm } useTimeScrollGun :: Item -> Creature -> World -> World useTimeScrollGun itm _ = timeFlow .~ ItemScrollTimeFlow { _scrollSmoothing = 0 , --, _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge _reverseAmount = 100 , _futureWorlds = [] , _scrollItemID = _itID itm } useRewindGun :: NewInt ItmInt -> World -> World useRewindGun i = timeFlow .~ RewindLeftClick { -- { _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge _reverseAmount = 100 , _scrollItemID = i } dropInventoryPath :: Int -> InventoryPathing -> LocationLDT ItemLink ComposedItem -> Creature -> World -> World dropInventoryPath i ip loc cr = fromMaybe id $ do invid <- loc ^? locLDT . ldtValue . _1 . itLocation . ilInvID j <- getInventoryPath i ip invid cr return $ dropItem cr j --dropInventoryPath i ip loc cr w = case ip of -- ABSOLUTE -> fromMaybe w $ do -- guard $ i `IM.member` (cr ^. crInv) -- return $ dropItem cr i w -- RELCURS -> fromMaybe w $ do -- j <- cr ^? crManipulation . manObject . imSelectedItem -- guard $ (i + j) `IM.member` (cr ^. crInv) -- return $ dropItem cr (i + j) w -- RELITEM -> fromMaybe w $ do -- j <- loc ^? locLDT . ldtValue . _1 . itLocation . ilInvID -- guard $ (i + j) `IM.member` (cr ^. crInv) -- return $ dropItem cr (i + j) w useInventoryPath :: PressType -> Int -> InventoryPathing -> LocationLDT ItemLink ComposedItem -> Creature -> World -> World useInventoryPath pt i ip loc cr w = case ip of ABSOLUTE -> fromMaybe w $ do guard $ i `IM.member` (cr ^. crInv) return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem i pt) RELCURS -> fromMaybe w $ do j <- cr ^? crManipulation . manObject . imSelectedItem guard $ (i + j) `IM.member` (cr ^. crInv) return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt) RELITEM -> fromMaybe w $ do j <- loc ^? locLDT . ldtValue . _1 . itLocation . ilInvID guard $ (i + j) `IM.member` (cr ^. crInv) return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt) --useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of -- [w'] -> w & cwTime . maybeWorld .~ Just' w' -- (w' : ws) -> w -- & cwTime . maybeWorld -- .~ Just' w' -- & cwTime . rewindWorlds .~ ws -- _ -> w