{-# OPTIONS -Wno-incomplete-uni-patterns #-}
--{-# LANGUAGE TupleSections #-}

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.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.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

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 pt = hammerCheck pt 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 ::
    PressType ->
    (LabelDoubleTree ComposeLinkType Item -> t1 -> t2 -> t2) ->
    LabelDoubleTree ComposeLinkType Item ->
    t1 ->
    t2 ->
    t2
hammerCheck pt f it cr
    | Just HammerTrigger <- it ^? ldtValue . itUse . heldTriggerType
      , isNothing $ lookup MakeAutoLink (it ^. ldtRight)
      , pt /= InitialPress = id
    | otherwise = f it cr

-- | 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
            & doWeaponRepetitions upitm cr
  where
    muzzles = t ^. ldtValue . itUse . heldAim . aimMuzzles
    (upitm, 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 . heldAim . aimMuzzles %~ 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
                    . heldAim
                    . aimMuzzles
                    . 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 . heldTriggerType .~ AutoTrigger
            & 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 = fromMaybe 0 $ itm ^? itUse . heldParams . sidePush
    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

applyInvLock :: Item -> Creature -> World -> World
applyInvLock itm cr = case itm ^? itUse . heldParams . weaponInvLock of
    Just i
        | i > 0 ->
            (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv cid))
                . lockInv cid
    _ -> id
  where
    cid = _crID cr

applySoundCME :: Item -> Creature -> World -> World
applySoundCME itm cr = fromMaybe id $ do
    (soundid, x) <- itm ^? itUse . heldParams . bulGunSound . _Just
    if x > 0
        then return $ soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) soundid (Just x)
        else return $ soundMultiFrom [CrWeaponSound cid j | j <- [0 .. 5]] (_crPos cr) soundid Nothing
  where
    cid = _crID cr

applyRecoil :: Item -> Creature -> World -> World
applyRecoil itm cr = over (cWorld . lWorld . creatures . ix cid) pushback
  where
    cid = _crID cr
    recoilAmount = fromMaybe 0 $ itm ^? itUse . heldParams . recoil
    pushback = over crPos (+.+ rotateV (_crDir cr) (V2 ((- recoilAmount) / _crMass cr) 0))

applySidePush :: Float -> Creature -> World -> World
applySidePush 0 _ w = w
applySidePush maxSide cr w =
    w
        & cWorld . lWorld . creatures . ix cid %~ push
        & randGen .~ g
  where
    cid = _crID cr
    push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr)))
    (pushAmount, g) = randomR (- maxSide, maxSide) $ _randGen w

applyTorqueCME :: Item -> Creature -> World -> World
applyTorqueCME itm cr w
    | cid == 0 =
        w
            & wCam . camRot -~ rot
            & cWorld . lWorld . creatures . ix cid . crDir +~ rot
            & randGen .~ g
    | otherwise =
        w
            & cWorld . lWorld . creatures . ix cid . crDir +~ rot
            & randGen .~ g
  where
    cid = _crID cr
    (rot, g) = randomR (- torque, torque) $ _randGen w
    torque = fromMaybe 0 $ itm ^? itUse . heldParams . torqueAfter

-- (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 -> shootLaser 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
                . heldAim
                . aimMuzzles
                . 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
  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

shootLaser :: LabelDoubleTree ComposeLinkType Item -> Creature -> Muzzle -> World -> World
shootLaser itmtree cr mz w =
    w
        & randGen .~ g
        & cWorld . lWorld . lasers
            .:~ Laser
                { _lpType = getLaserDamage itmtree
                , _lpPhaseV = getLaserPhaseV itmtree
                , _lpPos = pos
                , _lpDir = dir
                , _lpColor = 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

lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> Laser
lasRayAt col dam phasev pos dir =
    Laser
        { _lpType = DamageLaser dam
        , _lpPhaseV = phasev
        , _lpPos = pos
        , _lpDir = dir
        , _lpColor = col
        }

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 ->
    LabelDoubleTree ComposeLinkType Item ->
    --    Muzzle ->
    --    Creature ->
    --    World ->
    Maybe Bullet
--getBulletType itmtree magtree mz cr w =
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 itmtree magtree mz cr w
    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 itm ^? itUse . heldParams . randomOffset of
        Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w
        _ -> 0

--            & makeMuzzleSmoke mz itm cr

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 _rifling (_heldParams $ _itUse itm) of
        ConstFloat x -> (x, g)
        UniRandFloat x y -> randomR (x, y) g
    (muzvel, g'') = case _muzVel $ _heldParams $ _itUse itm of
        ConstFloat x -> (x, g')
        UniRandFloat x y -> randomR (x, y) g'

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 =
    createGas
        gastype
        pressure
        pos
        dir
        cr
        w
        & randGen
        .~ g'
  where
    (pressure, g) = doGenFloat (_nzPressure $ _mzEffect mz) (_randGen w)
    gastype = fromMaybe (error "cannot find gas ammo") $ do
        magid <- mmagid
        fueltype <- cr ^? crInv . ix magid . itConsumables . magParams . ampCreateGas
        gc <- itm ^? itUse . heldParams . gasCreation
        return $ gasCreate fueltype gc
    --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)

gasCreate :: GasFuel -> GasCreate -> GasCreate
gasCreate = const id

doGenFloat :: RandomGen g => GenFloat -> g -> (Float, g)
doGenFloat (ConstFloat x) g = (x, g)
doGenFloat (UniRandFloat x y) g = randomR (x, y) g

--caneStickSoundChoice :: Item -> SoundID
--caneStickSoundChoice _ = tap3S
--  --    | (it ^?! itUse . heldConsumption . laSource . _InternalSource . iaLoaded) < 2 = tap3S
--  --    | otherwise = shotgunS

--bangStickSoundChoice :: Item -> SoundID
--bangStickSoundChoice = caneStickSoundChoice

-- do
--    wth <- state $ randomR (1, 5)
--    return (itUse . heldConsumption . laAmmoType . amBullet . buWidth .~ wth)

--coneRandItemParams :: State StdGen (Item -> Item)
--coneRandItemParams = do
--    muzv <- state $ randomR (0.5, 1)
--    rifl <- state $ randomR (0.3, 0.9)
--    return $ \it ->
--        it & itUse . heldParams . muzVel .~ muzv
--             & itUse . heldParams . rifling .~ rifl

mcShootLaser :: Item -> Machine -> World -> World
mcShootLaser _ mc = cWorld . lWorld . lasers .:~ lasRayAt yellow dam phasev pos dir
  where
    pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
    dir = mc ^?! mcType . _McTurret . tuDir
    phasev = 1
    dam = 11

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
  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 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