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

module Dodge.HeldUse (
    heldEffect,
    gadgetEffect,
    heldEffectNoHammerCheck,
    mcUseHeld,
    heldEffectMuzzles,
) where

import Dodge.Creature.Mass
import Dodge.Data.Muzzle
import Dodge.Data.UseDelay
import Dodge.Item.UseDelay
import Dodge.Base
import Color
import Control.Applicative
import Control.Monad
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Dodge.BaseTriggerType
import Dodge.Creature.Action
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
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, WdWdBurstFireRepetition (_crID cr) (it ^?! ldtValue . itLocation . ilInvID))

-- | Applies a world effect after an item use cooldown check.
useTimeCheck :: ChainEffect
useTimeCheck f item cr w = case useDelay $ item ^. ldtValue of
    FixedRate rate
        | w ^. cWorld . lWorld . lClock - rate > lastused -> f item cr $ setUseRate w
    FixedRate{} -> w
    --Just (WarmUpNoDelay wt wm ws)
    WarmUpNoDelay wm ws
--        | wt < wm ->
        | _wTime (_itParams $ _ldtValue item) < wm ->
            w
                & soundContinue (CrWeaponSound cid 0) (_crPos cr) ws (Just 2)
                -- & cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . warmTime +~ 2
                & cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . wTime +~ 2
    WarmUpNoDelay wm _ ->
        f item cr w
--            & cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . warmTime .~ (wm + 1)
            & cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itParams . wTime .~ (wm + 1)
    NoDelay -> f item cr w
    --Nothing -> w
  where
    lastused = item ^. ldtValue . itTimeLastUsed
    cid = _crID cr
    setUseRate =
        --cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itUse . heldDelay . rateTimeLastUsed
        cWorld . lWorld . creatures . ix cid . crInv . ix itRef . itTimeLastUsed
            .~ 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)
        . foldl' (useLoadedAmmo t cr) (False, w)
        $ loadedmuzzles
  where
    --            & doWeaponRepetitions upitm cr

    --muzzles = t ^. ldtValue . itUse . heldMuzzles
    muzzles = itemMuzzles $ t ^. ldtValue
    --(upitm, loadedmuzzles) = mapAccumR loadMuzzle t muzzles
    (_, loadedmuzzles) = mapAccumR loadMuzzle t muzzles

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 hit -> heldItemMuzzles hit
    DETECTOR {} -> dbwMuzzles & ix 0 . mzEffect .~ MuzzleDetector
        & ix 0 . mzAmmoPerShot .~ UseExactly 100
    _ -> []

heldItemMuzzles :: HeldItemType -> [Muzzle]
heldItemMuzzles = \case
    BANGSTICK i -> [ Muzzle
                (V2 10 0)
                a
                0.01
                0
                NoFlare
                MuzzleShootBullet
                (UseExactly 1)
                0
               | a <- spreadAroundCenter i baseStickSpread
               ]
        & ix 0 . mzFlareType .~ NoLightFlare
        & ix (i `div` 2) . mzFlareType .~ MiniGunFlare
        & ix (i-1) . mzFlareType .~ NoLightFlare
    PISTOL -> [Muzzle (V2 10 0) 0 0.05 0 BasicFlare MuzzleShootBullet (UseExactly 1) 0]
    AUTOPISTOL -> [Muzzle (V2 20 0) 0 0 0 BasicFlare MuzzleShootBullet (UseExactly 1) 0]
    SMG -> [Muzzle (V2 10 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 MiniGunFlare MuzzleShootBullet (UseExactly 1) 0)
    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) 0]
    BLUNDERBUSS -> [Muzzle (V2 30 0) 0 0.5 0 BasicFlare MuzzleShootBullet (UseUpTo 15) 0]
    GRAPECANNON _ -> [Muzzle (V2 30 0) 0 0.5 0 BasicFlare MuzzleShootBullet (UseUpTo 15) 0]
    TORCH -> dbwMuzzles & ix 0 . mzPos .~ V2 10 0
    VOLLEYGUN i -> vgunMuzzles i
    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
            , _mzFrame = 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 MiniGunFlare
            <*> pure MuzzleShootBullet
            <*> pure (UseExactly 1)
            <*> ZipList [0..i-1] 
            )

doHeldUseEffect :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
doHeldUseEffect t cr w = case t ^. ldtValue . itType of
--    HELD (VOLLEYGUN 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'
    HELD ALTERIFLE -> fromMaybe w $ do
        i <- t ^? ldtValue . itLocation . ilInvID
        return $
            w
                & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix i
                    . itParams . alteRifleSwitch
--                    . itUse
--                    . heldMuzzles
--                    . ix 0
--                    . mzAmmoSlot
                %~ ((`mod` 2) . (+ 1))
    _ -> w

--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 -> Bool -> World -> World
applyCME itm cr cme
    | 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 = case itemInvLock itm of
    i
        | i > 0 ->
            (cWorld . lWorld . delayedEvents .:~ (i, UnlockInv cid))
                . lockInv cid
    _ -> 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 (_crType cr)) 0)

recoilAmount :: Item -> Float
recoilAmount itm
    | HELD hit <- itm ^. itType = case hit of
        BANGSTICK _ -> 25
        REWINDER -> 0
        TIMESTOPPER -> 0
        TIMESCROLLER -> 0
        PISTOL -> 10
        MACHINEPISTOL -> 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 (_crType cr)))
    (pushAmount, g) = randomR (- maxSide, maxSide) $ _randGen w

applyTorqueCME :: Item -> Creature -> World -> World
applyTorqueCME itm cr w =
    w
        & cWorld . lWorld . creatures . ix cid . crDir +~ rot
        & randGen .~ g
        & if cid == 0 then wCam . camRot -~ rot else id
  where
    cid = _crID cr
    (rot, g) = randomR (- torque, torque) $ _randGen w
    torque = torqueAmount itm

torqueAmount :: Item -> Float
torqueAmount itm = case itm ^. itType of
    HELD hit -> heldTorqueAmount hit
    _ -> 0

heldTorqueAmount :: HeldItemType -> Float
heldTorqueAmount = \case
    BANGSTICK i -> 0.18 + 0.02 * fromIntegral i
    REWINDER -> 0
    TIMESTOPPER -> 0
    TIMESCROLLER -> 0
    PISTOL -> 0.2
    MACHINEPISTOL -> 0.2
    AUTOPISTOL -> 0.2
    SMG -> 0.05
    BANGCONE -> 0.1
    BLUNDERBUSS -> 0.1
    GRAPECANNON i -> 0.1 + 0.2 * fromIntegral i
    MINIGUNX i -> 0.04 + 0.02 * fromIntegral i
    VOLLEYGUN{} -> 0.1
    RIFLE -> 0.1
    ALTERIFLE -> 0.1
    AUTORIFLE -> 0.1
    BURSTRIFLE -> 0.1
    BANGROD -> 0.3
    ELEPHANTGUN -> 0.3
    AMR -> 0.3
    AUTOAMR -> 0.3
    SNIPERRIFLE -> 0.3
    FLAMESPITTER -> 0
    FLAMETHROWER -> 0
    FLAMETORRENT -> 0
    FLAMEWALL -> 0
    BLOWTORCH -> 0
    SPARKGUN -> 0
    TESLAGUN -> 0.01
    LASER -> 0
    TRACTORGUN -> 0
    RLAUNCHER -> 0
    RLAUNCHERX{} -> 0
    GLAUNCHER -> 0
    POISONSPRAYER -> 0
    SHATTERGUN -> 0
    TORCH -> 0
    FLATSHIELD -> 0
    KEYCARD{} -> 0
    BLINKER -> 0
    BLINKERUNSAFE -> 0

-- (Muzzle,Int,Int) = (muzzle, amountloaded, id of mag taken from)
loadMuzzle ::
    LabelDoubleTree 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
    let usedammo = case amamount of
            UseUpTo x -> min x availableammo
            UseExactly x
                | x <= availableammo -> x
                | otherwise -> 0
    guard $ usedammo > 0
    return
        ( t & ldtLeft . ix i . _2 . ldtValue . itConsumables . _Just -~ usedammo
        , Just (mz, usedammo, mag)
        )

makeMuzzleFlare :: Muzzle -> LabelDoubleTree 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 ->
    (Bool, World) ->
    Maybe (Muzzle, Int, LabelDoubleTree ComposeLinkType Item) ->
    (Bool, World)
useLoadedAmmo _ _ (cme, w) Nothing = (cme, w)
useLoadedAmmo itmtree cr (_, w) (Just (mz, x, magtree)) = (,) True $
    removeAmmoFromMag x mid cr . makeMuzzleFlare mz itmtree cr $ case _mzEffect mz of
        MuzzleShootBullet -> shootBullet itmtree cr (mz, x, magtree) w
        MuzzleLaser -> creatureShootLaser itmtree cr mz w
        MuzzleTesla -> shootTeslaArc itm cr mz w
        MuzzleTractor -> shootTractorBeam cr w
        MuzzleRLauncher -> createProjectileR itmtree magtree mz cr w
        MuzzleGLauncher ->
            createProjectile
                (Grenade (getGrenadeHitEffect itmtree))
                magtree
                (getPJStabiliser itmtree)
                mz
                cr
                w
        MuzzleNozzle{} -> useGasParams mid mz itm cr $ walkNozzle mz itm cr w
        MuzzleShatter -> shootShatter itm cr w
        MuzzleDetector ->
            itemDetectorEffect
                itm
                (getAttachedSFLink MapperSF itmtree)
                (getAttachedSFLink ARHUDSF itmtree)
                cr
                w
        MuzzleBlink -> unsafeBlinkAction cr w
        MuzzleUnsafeBlink -> blinkActionMousePos cr w
        MuzzleRewind -> useRewindGun (itm ^. itID) w
        MuzzleStopper -> useStopWatch itm cr w
        MuzzleScroller -> useTimeScrollGun itm cr w
  where
    mid = magtree ^? ldtValue . itLocation . ilInvID
    itm = itmtree ^. ldtValue

getAttachedSFLink ::
    ItemStructuralFunction ->
    LabelDoubleTree 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 :: 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 + 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
            . _Just
            -~ x

getBulletType :: LabelDoubleTree ComposeLinkType Item -> Maybe Bullet
getBulletType magtree =
    --magtree ^? ldtValue . itConsumables . magParams . ampBullet
    (magtree ^? ldtValue >>= magAmmoParams >>= (^? ampBullet))
        --        <&> buTrajectory .~ btraj
        <&> buPayload .~ bpayload
        <&> buEffect .~ beffect
  where
    --    btraj = fromMaybe BasicBulletTrajectory $ do
    --        targetingtree <- lookup WeaponTargetingLink (itmtree ^. ldtRight) -- left or right for these?
    --        tp <- targetingtree ^? ldtValue . itTargeting . itTgPos . _Just
    --        attree <- lookup AmmoTargetingLink (magtree ^. ldtLeft)
    --        bt <- attree ^? ldtValue . itUse . ubMod . bmTrajectory
    --        return $ getBulletTrajectory mz (itmtree ^. ldtValue) bt tp cr w
    bpayload = fromMaybe 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

magAmmoParams :: Item -> Maybe AmmoParams
magAmmoParams itm = case itm ^. itType of
    EQUIP BATTERYPACK -> Just NoAmmoParams
    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
                        { _ampPayload = ExplosionPayload
                        }
    AMMOMAG BATTERY -> Just NoAmmoParams
    _ -> Nothing

--getBulletTrajectory ::
--    Muzzle ->
--    Item ->
--    BulletTrajectoryType ->
--    Point2 ->
--    Creature ->
--    World ->
--    BulletTrajectory
--getBulletTrajectory mz itm bt tp cr w = case bt of
--    BasicBulletTrajectoryType -> BasicBulletTrajectory
--    FlechetteTrajectoryType -> FlechetteTrajectory tp
--    BezierTrajectoryType -> BezierTrajectory bulpos tp (mouseWorldPos (w ^. input) (w ^. wCam))
--    MagnetTrajectoryType -> MagnetTrajectory tp
--  where
--    (moff, _) = heldItemOrient2D itm cr (_mzPos mz + V2 0 offset) (_mzRot mz)
--    bulpos = _crPos cr + rotateV (_crDir cr) moff
--    offset = case itm ^? itUse . heldParams . randomOffset of
--        Just x | x /= 0 -> fst . randomR (- x, x) $ _randGen w
--        _ -> 0

shootBullet ::
    LabelDoubleTree 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
        fueltype <- cr ^? crInv . ix magid >>= magAmmoParams >>= (^? ampCreateGas)
        gasType hit fueltype
    --pos = _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
    (moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
    pos = _crPos cr + rotateV (_crDir cr) moff
    (a, g') = randomR (- inacc, inacc) g
    inacc = _mzInaccuracy mz
    --dir = _crDir cr + mrot + a + _nzCurrentWalkAngle (_mzEffect mz)
    dir = _crDir cr + mrot + a + _nzAngle (_itParams itm)

gasType :: HeldItemType -> GasFuel -> Maybe GasCreate
gasType hit _ = case hit of
    BANGSTICK{} -> Nothing
    REWINDER -> Nothing
    TIMESTOPPER -> Nothing
    TIMESCROLLER -> Nothing
    PISTOL -> Nothing
    MACHINEPISTOL -> Nothing
    AUTOPISTOL -> Nothing
    SMG -> Nothing
    BANGCONE -> Nothing
    BLUNDERBUSS -> Nothing
    GRAPECANNON{} -> Nothing
    MINIGUNX{} -> Nothing
    VOLLEYGUN{} -> Nothing
    RIFLE -> Nothing
    ALTERIFLE -> Nothing
    AUTORIFLE -> Nothing
    BURSTRIFLE -> Nothing
    BANGROD -> Nothing
    ELEPHANTGUN -> Nothing
    AMR -> Nothing
    AUTOAMR -> Nothing
    SNIPERRIFLE -> Nothing
    FLAMESPITTER -> Nothing
    FLAMETHROWER -> Just CreateFlame
    FLAMETORRENT -> Just CreateFlame
    FLAMEWALL -> Just CreateFlame
    BLOWTORCH -> Nothing
    SPARKGUN -> Nothing
    TESLAGUN -> Nothing
    LASER -> Nothing
    TRACTORGUN -> Nothing
    RLAUNCHER -> Nothing
    RLAUNCHERX{} -> Nothing
    GLAUNCHER -> Nothing
    POISONSPRAYER -> Just CreatePoisonGas
    SHATTERGUN -> Nothing
    TORCH -> Nothing
    FLATSHIELD -> Nothing
    KEYCARD{} -> Nothing
    BLINKER -> Nothing
    BLINKERUNSAFE -> Nothing

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

mcShootLaser :: Item -> Machine -> World -> World
mcShootLaser _ mc =
    shootLaser (MachineSound (_mcID mc)) (DamageLaser 11) 1 pos dir yellow
  where
    pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
    dir = mc ^?! mcType . _McTurret . tuDir

mcShootAuto :: Item -> Machine -> World -> World
mcShootAuto itm mc w
    | Just (FixedRate rate) <- useDelay <$> mc ^? mcType . mctTurret . tuWeapon -- . itUse . heldDelay
      , w ^. cWorld . lWorld . lClock - rate > lastused =
        w
            & cWorld . lWorld . machines . ix (_mcID mc) . mcType . mctTurret . tuWeapon
                . itTimeLastUsed
--                . itUse
--                . heldDelay
--                . rateTimeLastUsed
                .~ w ^. cWorld . lWorld . lClock
            & makeBullet defaultBullet itm pos dir
    | otherwise = w
  where
    lastused = itm ^. itTimeLastUsed
    pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
    dir = mc ^?! mcType . _McTurret . tuDir

-- | assumes that the item is held
shootTeslaArc :: Item -> Creature -> Muzzle -> World -> World
shootTeslaArc itm cr mz w =
    w' & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itRef . itParams .~ ip
        & soundContinue (CrWeaponSound (_crID cr) 0) pos elecCrackleS (Just 2)
  where
    -- use items item location instead
    itRef = cr ^?! crManipulation . manObject . imRootSelectedItem -- unsafe!! TODO change
    (w', ip) = makeTeslaArc (_itParams itm) pos dir w
    (moff, mrot) = heldItemOrient2D itm cr (_mzPos mz) (_mzRot mz)
    pos = _crPos cr + rotateV (_crDir cr) moff
    dir = _crDir cr + mrot

determineProjectileTracking ::
    LabelDoubleTree 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
            <|> magAmmoParams ammoitem ^? _Just . ampPayload
    return $
        createShell rdetonate rscreen stab pjtype aparams muz cr
            . startthesound
  where
    -- the sound should be moved to the projectile firing
    startthesound =
        soundMultiFrom
            [CrWeaponSound (_crID cr) j | j <- [0 .. 3]]
            (_crPos cr)
            tap4S
            Nothing
    failsound w' = case w' ^? input . mouseButtons . ix SDL.ButtonLeft of
        Just 0 -> soundStart (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'
        _ -> soundContinue (CrWeaponSound (_crID cr) 0) (_crPos cr) click1S Nothing w'

---- need to add these to muzzle flare?
--makeMuzzleSmoke :: Muzzle -> Item -> Creature -> World -> World
--makeMuzzleSmoke mz itm cr w = case mz ^. mzFlareType of
--    DefaultFlareType -> w
--    PistolFlare -> foldl' (flip $ smokeCloudAt (greyN 0.5) 5 400 5 . (+.+.+ pos) . (* 8)) w ps
--    MiniGunFlare -> smokeCloudAt (greyN 0.5) 5 400 5 pos w
--    HeavySmokeFlare -> foldl' (flip $ smokeCloudAt black 20 400 5 . (+.+.+ pos) . (* 8)) w ps'
--    LasGunFlare -> w
--    TeslaGunFlare -> w
--  where
--    ps = replicateM 2 randOnUnitSphere & evalState $ _randGen w
--    ps' = replicateM 4 randOnUnitSphere & evalState $ _randGen w
--    pos = addZ 10 $ _crPos cr + rotateV (_crDir cr) (_mzPos mz + aimingWeaponZeroPos cr itm)
----        , withSmoke 1 black 20 200 5

useStopWatch :: Item -> Creature -> World -> World
useStopWatch itm _ =
    timeFlow
        .~ PausedTimeFlow
            { _timeFlowCharge = 100
            , _scrollItemID = _itID itm
            }

useTimeScrollGun :: Item -> Creature -> World -> World
useTimeScrollGun itm _ =
    timeFlow
        .~ ItemScrollTimeFlow
            { _scrollSmoothing = 0
            , --, _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
              _reverseAmount = 100
            , _futureWorlds = []
            , _scrollItemID = _itID itm
            }

useRewindGun :: NewInt ItmInt -> World -> World
useRewindGun i =
    timeFlow
        .~ RewindLeftClick
            { --            { _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge
              _reverseAmount = 100
            , _scrollItemID = i
            }

dropInventoryPath ::
    Int ->
    InventoryPathing ->
    LocationLDT ItemLink 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