{-# LANGUAGE LambdaCase #-}

module Dodge.Item.Draw.SPic (
    itemSPic,
    itemTreeSPic,
) where

import Color
import Data.Maybe
import Data.Strict.Tuple
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Dodge.Data.Item
import Geometry
import LensHelp
import qualified Linear.Quaternion as Q
--import qualified Linear.Quaternion as Q
import Picture
import Shape
import ShapePicture

itemTreeSPic :: LabelDoubleTree ItemLink ComposedItem -> SPic
itemTreeSPic (LDT (itm,_,_) l r) =
    itemSPic itm
        <> foldMap (itemRotTreeSPic itm) (l <> r)

itemRotTreeSPic :: Item -> (ItemLink, LabelDoubleTree ItemLink ComposedItem) 
    -> SPic
itemRotTreeSPic par (il, t) = translateSP p . overPosSP (Q.rotate q) $ itemTreeSPic t
  where
    (p, q) = _iatOrient il par (_iatType il) itm
    itm = t ^. ldtValue . _1

itemSPic :: Item -> SPic
itemSPic it = case it ^. itType of
    CRAFT ct -> noPic $ craftItemSPic ct
    HELD ht -> heldItemSPic ht it
    EQUIP et -> equipItemSPic et it
    ATTACH{} -> defSPic
    AMMOMAG amt -> ammoMagSPic it amt
    TARGETING{} -> defSPic
    BULLETMOD{} -> defSPic
    STICKYMOD -> defSPic

craftItemSPic :: CraftType -> Shape
craftItemSPic = \case
    PIPE -> colorSH green $ xCylinderST 3 10
    TUBE -> colorSH cyan $ xCylinderST 5 20
    HARDWARE -> colorSH orange $ upperPrismPolyST 3 $ square 4
    SPRING -> colorSH green $ xCylinderST 1 5
    HOSE -> colorSH green $ xCylinderST 1 10
    TAPE -> colorSH (greyN 0.5) 
        . translateSH (V3 4 0 0) . upperCylinder Small Typical 1 $ polyCirc 3 5
    CAN -> colorSH green
        . translateSH (V3 4 0 0) . upperCylinder Small Typical 1 $ polyCirc 3 4
    TIN -> colorSH green . upperPrismPolyST 3 $ rectXH 2 2
    STEELDRUM -> colorSH green
        . translateSH (V3 4 0 0) . upperCylinder Small Typical 1 $ polyCirc 4 8
    PLANK -> colorSH orange $ upperPrismPolyST 3 $ rectXH 8 2
    GLASSSHARD -> colorSH azure $ upperPrismPolyST 1 [V2 0 (-1), V2 4 (-0.5), V2 0 1]
    SCRAPMETAL -> colorSH (greyN 0.3) $ upperPrismPolyST 3 $ square 4
    PUMP -> colorSH yellow . translateSH (V3 4 0 0) $ 
        upperCylinder Small Typical 1 (polyCirc 4 4)
        <> upperPrismPolyST 1 (rectNSWE (-2) (-4) 4 0)
        <> upperPrismPolyST 1 (rectNSWE 4 2 0 (-4))
    MOTOR -> colorSH orange $ xCylinderST 5 3 <> xCylinderST 3 5
    TRANSFORMER -> colorSH blue $ upperPrismPolyST 3 $ square 4
    PRISM -> colorSH azure $ upperPrismPolyST 1 [V2 0 (-3), V2 4 0, V2 0 3]
    LIGHTER -> colorSH yellow . upperPrismPolyST 3 $ rectXH 2 2
    MAGNET -> colorSH red (upperPrismPolyST 1 (rectNSWE 2 (-2) 2 0))
        <> colorSH (greyN 0.5) (upperPrismPolyST 1 (rectNSWE 2 (-2) 4 2))
        <> colorSH blue (upperPrismPolyST 1 (rectNSWE 2 (-2) 6 4))
    ANTIMATTER -> colorSH violet $ upperPrismPolyST 3 $ square 4
    PLATE -> colorSH green $ upperPrismPolyST 8 $ rectXH 2 5
    TRANSMITTER -> colorSH green $ 
        xCylinderST 1 5 <> translateSH (V3 5 0 0) (upperPrismPolyHalfST 3 $ polyCirc 4 3)
    MICROCHIP -> colorSH yellow $ upperPrismPolyST 1 $ square 4
    HARDDRIVE -> colorSH green $ upperPrismPolyST 1 $ square 4
    RAM -> colorSH orange $ upperPrismPolyST 1 $ square 4
    AIUNIT -> colorSH blue $ upperPrismPolyST 1 $ square 4
    CAMERA -> colorSH yellow $ xCylinderST 5 3 <> xCylinderST 3 5
    MINIDISPLAY -> colorSH green $ upperPrismPolyST 1 (square 4)
        <> upperPrismPolyST 2 (rectNSWE 4 (-4) 3 4)
    LED -> colorSH yellow $ upperPrismPolyST 1 (square 2)
    NAILBOX -> colorSH green $ upperPrismPolyST 3 (rectXH 4 3)
    IRONBAR -> colorSH (greyN 0.5) $ upperPrismPolyST 3 $ rectXH 8 2
    LIGHTSENSOR -> colorSH green (upperPrismPolyST 1 $ square 3)
        <> colorSH yellow (upperPrismPolyHalfST 3 $ polyCirc 4 3)
    SOUNDSENSOR -> colorSH yellow (upperPrismPolyST 1 $ rectXH 4 1)
        <> translateSH (V3 4 1 0) (colorSH yellow (upperPrismPolyHalfST 2 $ polyCirc 4 2))
        <> translateSH (V3 4 (-1) 0) (colorSH yellow (upperPrismPolyHalfST 2 $ polyCirc 4 2))
    MICROPHONE -> colorSH yellow (upperPrismPolyST 1 $ rectXH 3 1)
        <> translateSH (V3 3 0 0) (colorSH yellow (upperPrismPolyHalfST 2 $ polyCirc 4 2))
    HEATSENSOR -> colorSH red (upperPrismPolyST 1 $ rectXH 4 1)
        <> translateSH (V3 4 1 0) (colorSH yellow (upperPrismPolyHalfST 2 $ polyCirc 4 2))
        <> translateSH (V3 4 (-1) 0) (colorSH yellow (upperPrismPolyHalfST 2 $ polyCirc 4 2))
    THERMOMETER -> colorSH green (upperPrismPolyST 1 $ rectXH 3 1)
        <> translateSH (V3 3 0 0) (colorSH yellow (upperPrismPolyHalfST 2 $ polyCirc 4 2))
    CREATURESENSOR -> colorSH azure (upperPrismPolyST 1 $ rectXH 4 1)
        <> translateSH (V3 4 1 0) (colorSH yellow (upperPrismPolyHalfST 2 $ polyCirc 4 2))
        <> translateSH (V3 4 (-1) 0) (colorSH yellow (upperPrismPolyHalfST 2 $ polyCirc 4 2))
    WIRE -> colorSH blue $ xCylinderST 1 5
    FUELCELL -> colorSH blue
        . translateSH (V3 4 0 0) . upperCylinder Small Typical 1 $ polyCirc 3 4
    PORTABLEFUSION -> colorSH azure
        . translateSH (V3 4 0 0) . upperCylinder Small Typical 1 $ polyCirc 3 4
--    FRAGMODULE
--    FLASHMODULE
--    GASINJECTOR
--    FLAKCRAFT
--    FRAGCRAFT

ammoMagSPic :: Item -> AmmoMagType -> SPic
ammoMagSPic it = \case
    TINMAG -> noPic $ upperPrismPolyTS 1 (rectNSWE 0 (- (am * 5)) (-1) 1)
    DRUMMAG -> noPic $ upperPrismPolyTS 1 (rectNSWE 0 (- (am * 15)) (-1) 1)
    CHEMFUELPOUCH -> noPic $ colorSH yellow (upperPrismPolyST 3 $ polyCirc 3 5)
    BATTERY -> colorSH blue (upperBox Tiny Superfluous 1 (rectNSWE 0 (-2) (-2) 2))
        :!: setLayer BloomNoZWrite (setDepth 2 . color (mixColorsFrac green red am) $ circleSolid 2)
    _ -> noPic $ upperPrismPolyTS 1 (rectNSWE 0 (- y) (-1) 1)
  where
    y = fromIntegral y' * 0.3
    y' = fromMaybe 0 $ it ^? itConsumables . magLoadStatus . iaLoaded
    am = fractionLoadedAmmo (it ^?! itConsumables . magLoadStatus)

fractionLoadedAmmo :: ReloadStatus -> Float
fractionLoadedAmmo rs = fromIntegral (_iaLoaded rs) / fromIntegral (_iaMax rs)
--
--fractionLoadedAmmo2 :: ReloadStatus -> Float
--fractionLoadedAmmo2 rs =
--    1 - (1 - fromIntegral (_iaLoaded rs) / fromIntegral (_iaMax rs)) ** 2

equipItemSPic :: EquipItemType -> Item -> SPic
equipItemSPic et _ = case et of
    WRIST_ECG -> defSPic
    MAGSHIELD -> defSPic
    FLAMESHIELD -> defSPic
    FRONTARMOUR -> defSPic
    --        ( mempty
    --        , setDepth 20 $
    --            fold
    --                [ color yellow $ thickArc 0 (pi / 2) 10 5
    --                , color yellow $ thickArc (3 * pi / 2) (2 * pi) 10 5
    --                ]
    --        )
    WRISTARMOUR -> defSPic
    INVISIBILITYEQUIPMENT _ -> noPic (colorSH chartreuse $ upperPrismPolySI 3 $ rectWH 2 2)
    BRAINHAT -> noPic (colorSH yellow $ upperPrismPolySU 3 $ rectWH 4 4)
    HAT -> noPic (colorSH yellow $ upperPrismPolySU 3 $ rectWH 4 4)
    HEADLAMP -> noPic headLampShape
    POWERLEGS -> legsSPic yellow
    SPEEDLEGS -> legsSPic green
    JUMPLEGS -> legsSPic red
    BATTERYPACK -> noPic $ colorSH blue backpackShape
    FUELPACK ->
        noPic $ colorSH yellow $ upperPrismPolyMT 10 $ polyCirc 3 5
    BULLETBELTPACK ->
        noPic $ colorSH green backpackShape
    BULLETBELTBRACER ->
        noPic (colorSH green $ upperPrismPolySU 3 $ rectWH 2 2)

backpackShape :: Shape
backpackShape = upperPrismPolyMT 10 $ rectNSWE 5 (-5) (-4) 4

--ammoPosition :: Item -> HeldItemType -> AmmoPosition
--ammoPosition itm hit = case hit of
--    BANGSTICK i -> bangStickAmmoPos i itm
--    PISTOL -> Magazine (V3 5 2 0) lhs
--    MACHINEPISTOL -> Magazine (V3 5 2 0) lhs
--    AUTOPISTOL -> Magazine (V3 5 2 0) lhs
--    SMG -> Magazine (V3 7 (-2) 0) rhs
--    VOLLEYGUN i -> volleygunAmmoPos i
--    MULTIGUN i -> multigunAmmoPos i
--    RIFLE -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)]
--    REPEATER -> Magazine (V3 10 (-2) 0) rhs
--    AUTORIFLE -> Magazine (V3 10 (-2) 0) rhs
--    BURSTRIFLE -> Magazine (V3 10 (-2) 0) rhs
--    BANGROD -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)]
--    ELEPHANTGUN -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)]
--    AMR -> Magazine (V3 10 (-2) 0) rhs
--    AUTOAMR -> Magazine (V3 10 (-2) 0) rhs
--    SNIPERRIFLE -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)]
--    MACHINEGUN -> Magazine (V3 10 (-2) 0) rhs
--    --SONICGUN        -> noPic baseSonicShape
--  where
--    lhs = Q.axisAngle (V3 1 0 0) pi
--    rhs = Q.axisAngle (V3 1 0 0) 0

--bangStickAmmoPos :: Int -> Item -> AmmoPosition
--bangStickAmmoPos _ itm =
--    Bullets
--        [(rotate3z a (V3 5 0 3), Q.axisAngle (V3 0 0 1) a)
--            | a <- map _mzRot (itm ^?! itUse . heldAim . aimMuzzles)]

--volleygunAmmoPos :: Int -> AmmoPosition
--volleygunAmmoPos i =
--    Bullets
--        [(V3 5 (f n) 3, Q.axisAngle (V3 1 0 0) 0) | n <- [0 .. i -1]]
--  where
--    f n = fromIntegral n * 5 - ((fromIntegral i - 1) * 2.5)
--
--multigunAmmoPos :: Int -> AmmoPosition
--multigunAmmoPos i =
--    Bullets
--        [(V3 5 (f n) 3, Q.axisAngle (V3 1 0 0) 0) | n <- [0 .. i -1]]
--  where
--    f n = fromIntegral n * 5 - ((fromIntegral i - 1) * 2.5)

heldItemSPic :: HeldItemType -> Item -> SPic
heldItemSPic ht it = case ht of
    FLATSHIELD -> flatShieldEquipSPic
    TORCH -> noPic torchShape
    BANGSTICK i -> noPic $ baseStickShapeX it i -- <> addBullets it
    PISTOL -> noPic baseStickShape
    MACHINEPISTOL -> noPic baseStickShape
    AUTOPISTOL -> noPic baseStickShape
    SMG -> noPic baseSMGShape
    BANGCONE -> noPic $ bangConeShape 5
    BLUNDERBUSS -> noPic $ bangConeShape 20
    GRAPECANNON _ -> noPic $ bangConeShape 20
    MINIGUNX i -> miniGunXPictItem i it
    VOLLEYGUN i -> noPic $ volleyGunShape i -- <> addBullets it
    RIFLE -> noPic baseRifleShape -- <> addBullets it
    ALTERIFLE -> noPic baseRifleShape -- <> addBullets it
    AUTORIFLE -> noPic baseRifleShape
    BURSTRIFLE -> noPic baseRifleShape
    BANGROD -> noPic baseRodShape -- <> addBullets it
    ELEPHANTGUN -> noPic baseAMRShape -- <> addBullets it
    AMR -> noPic baseAMRShape
    AUTOAMR -> noPic baseAMRShape
    SNIPERRIFLE -> noPic baseAMRShape -- <> addBullets it
    FLAMESPITTER -> flamerPic it
    FLAMETHROWER -> flamerPic it
    FLAMETORRENT -> flamerPic it
    FLAMEWALL -> flamerPic it
    BLOWTORCH -> flamerPic it
    SPARKGUN -> teslaGunPic
    TESLAGUN -> teslaGunPic
    LASER -> lasGunPic it
    TRACTORGUN -> tractorGunPic it
    RLAUNCHER -> rlauncherPic it
    RLAUNCHERX _ -> rlauncherPic it
    GLAUNCHER -> glauncherPic it
    POISONSPRAYER -> flamerPic it
    BLINKER -> defSPic
    BLINKERUNSAFE -> defSPic
    REWINDER -> defSPic
    TIMESTOPPER -> defSPic
    TIMESCROLLER -> defSPic
    SHATTERGUN -> shatterGunSPic
    DETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPolySU 3 $ rectWH 2 2)
    KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi / 2.5) keyPic)

torchShape :: Shape
torchShape =
    colorSH blue $
        translateSHxy 0 1.5 side
            <> translateSHxy 0 (-1.5) side
            <> translateSHz 2.5 top
            <> translateSHz (-0.5) bot
            <> back
  where
    side = upperPrismPolySE 3 $ rectXH 10 0.5
    top = upperPrismPolySE 0.5 $ rectXH 10 2
    bot = upperPrismPolySE 0.5 $ rectXH 9 2
    back = upperPrismPolySE 3 $ rectXH 1 2

baseStickShapeX :: Item -> Int -> Shape
baseStickShapeX it _ = foldMap f (it ^?! itUse . heldAim . aimMuzzles)
  where
    f brl = rotateSH (_mzRot brl) baseStickShape

baseStickShape :: Shape
baseStickShape = colorSH green $ xCylinderST 3 10

bangConeShape :: Float -> Shape
bangConeShape x =
    colorSH cyan $
        xCylinderST 3 x
            <> upperPrismPolyST 6 (rectNSWE 4 (-4) x (10 + x))

defSPic :: SPic
defSPic = noPic $ colorSH green $ upperPrismPolyST 3 $ square 4

shatterGunSPic :: SPic
shatterGunSPic =
    -- TODO cylinderize
    noPic $
        colorSH blue $
            upperPrismPolyST 5 (rectNSWE xb xa 0 8)
                <> upperPrismPolyST 5 (rectNSWE (- xa) (- xb) 0 8)
  where
    xa = 1
    xb = 9

baseCaneShape :: Shape
baseCaneShape = colorSH red $ xCylinderST 3 15

baseRifleShape :: Shape
baseRifleShape = colorSH red $ xCylinderST 3 25

--bulletEffectColor :: BulletEffect -> Color
--bulletEffectColor x = case x of
--    DestroyBullet -> black
--    BounceBullet -> mixColors 0.5 0.5 black yellow
--    PenetrateBullet -> mixColors 0.5 0.5 black blue

--bulletTrajColor :: BulletTrajectory -> Color
--bulletTrajColor x = case x of
--    BasicBulletTrajectory -> black
--    BezierTrajectory{} -> chartreuse
--    FlechetteTrajectory{} -> white
--    MagnetTrajectory{} -> yellow

--bulletPayloadColor :: BulletSpawn -> Color
--bulletPayloadColor x = case x of
--    BulBall y -> energyBallColor y
--    BulSpark -> black
--    BulFlak -> chartreuse
--    BulFrag -> magenta
--    BulGas -> green

--energyBallColor :: EnergyBallType -> Color
--energyBallColor ebt = case ebt of
--    IncBall -> orange
--    TeslaBall -> cyan
--    ConcBall -> white
--    FlashBall -> yellow

volleyGunShape :: Int -> Shape
volleyGunShape i =
    colorSH
        red
        ( foldMap
            ( (\y -> translateSHxy 0 y $ xCylinderST 3 15)
                . (\k -> fromIntegral k * 5 - ((fromIntegral i - 1) * 2.5))
            )
            [0 .. i -1]
        )

-- to get this rotating should probably add extra state to the minigun
miniGunXPictItem :: Int -> Item -> SPic
miniGunXPictItem i it = miniGunXPict i spin
  where
    spin = (-10) + _warmTime (_heldDelay $ _itUse it)

miniGunXPict :: Int -> Int -> SPic
miniGunXPict i spin =
    noPic
        ( colorSH red (rotateSHx a barrels)
            <> baseRifleShape
        )
  where
    aBarrel = translateSH (V3 15 2 2) baseCaneShape
    barrels = foldMap (\an -> aBarrel & rotateSHx (2 * pi * fromIntegral an / fromIntegral i)) [1 .. i]
    a = fromIntegral spin / 100

--x = fromIntegral am / 10
--    clip y z = translateSH (V3 0 (-1) z) (rotateSHx (negate $ pi/4)
--        . upperPrismPoly 2
--        $ rectNESW (negate $ 3 + 0.25 * x) y 3 (y-5))

--baseSonicShape :: Shape
--baseSonicShape = colorSH rose $ upperPrismPoly 3 $ rectXH 25 2

baseSMGShape :: Shape
baseSMGShape = colorSH green $ xCylinderST 3 20

flamerPic :: Item -> SPic
flamerPic _ = noPic . colorSH yellow $ xCylinderST 5 18

rlauncherPic :: Item -> SPic
rlauncherPic _ = noPic . colorSH cyan $ xCylinderST 5 20

glauncherPic :: Item -> SPic
glauncherPic _ = noPic . colorSH green $ xCylinderST 5 20

--launcherPic _ = noPic . colorSH cyan $ xCylinder 4 5 20
--    ( colorSH cyan $
--        prismPoly
--            (map (+.+.+ V3 20 0 5) $ polyCircx 4 5)
--            (map (+.+.+ V3 0 0 5) $ polyCircx 4 5)
--    , mempty
--    )

baseRodShape :: Shape
baseRodShape = colorSH orange $ xCylinderST 3 20

baseAMRShape :: Shape
baseAMRShape = colorSH orange $ xCylinderST 3 30

teslaGunPic :: SPic
teslaGunPic = shatterGunSPic

lasGunPic :: Item -> SPic
lasGunPic _ = noPic $ colorSH blue $ upperPrismPolyST 3 $ square 4
--    colorSH
--        blue
--        ( upperBoxST 4 (rectNSWE 3 1 0 30)
--            <> upperBoxSU 4 (rectNSWE (-1) (-3) 0 30)
--            <> upperBoxSU 1 (rectNSWE 3 (-3) 0 30)
--        )
--        :!: mempty

--dualBeamPic :: Item -> SPic
--dualBeamPic it =
--    ( colorSH blue $
--        upperBoxST 4 (rectNESW gap 3 (- gap) 1)
--            <> upperBoxSU 4 (rectNESW gap (-1) (- gap) (-3))
--            <> upperBoxSU 1 (rectNESW gap 3 (- gap) (-3))
--    , setLayer BloomNoZWrite . color col . setDepth 1.1 . polygon $ rectNESW gap 1 (- gap) (-1)
--    )
--  where
--    --amFrac = fractionLoadedAmmo it
--    amFrac = 0.5
--    col = brightX 2 1.5 $ mixColors amFrac (1 - amFrac) green red
--    gap = _dbGap (_itParams it) - 3

tractorGunPic :: Item -> SPic
tractorGunPic = lasGunPic

flatShieldEquipSPic :: SPic
flatShieldEquipSPic = noPic . colorSH yellow $ upperBoxMT 10 (rectWH 2 10)

headLampShape :: Shape
headLampShape =
    colorSH yellow $
        oneside 5 2 4
            <> oneside 5 2 0
            <> oneside 5 (-2) 4
            <> oneside 5 (-2) 0
  where
    oneside x y z = translateSH (V3 x y z) (upperPrismPolySE 4 $ rectWH 4 1)

detectorColor :: Detector -> Color
detectorColor dt = case dt of
    ITEMDETECTOR -> blue
    CREATUREDETECTOR -> green
    WALLDETECTOR -> red

keyPic :: Picture
keyPic =
    color green $
        fold
            [ translate (-4) 0 $ thickCircle 4 2
            , thickLine 2 $ map toV2 [(0, 0), (8, 0), (8, -4)]
            , thickLine 2 $ map toV2 [(4, 0), (4, -4)]
            ]

--latchkeyPic :: Picture
--latchkeyPic =
--    color yellow $
--        pictures
--            [ translate (-4) 0 $ thickCircle 4 2
--            , thickLine 2 $ map toV2 [(0, 0), (8, 0), (8, -4)]
--            , thickLine 2 $ map toV2 [(4, 0), (4, -4)]
--            ]

legsSPic :: Color -> SPic
legsSPic col = noPic $ translateSH (V3 0 4 0) $ colorSH col $ upperPrismPolyST 3 $ rectWH 2 2