{- |
Drawing of creatures.
Takes into account damage etc.
-}
module Dodge.Creature.Picture (
    basicCrPict,
    deadScalp,
    deadUpperBody,
    deadFeet,
    drawChaseCrit,
    drawHoverCrit,
) where

import Linear
import Dodge.Data.Equipment.Misc
import Dodge.Creature.HandPos
import qualified Data.IntMap.Strict as IM
import Control.Lens
import Dodge.Creature.Radius
import Dodge.Creature.Shape
--import Dodge.Creature.Test
import Dodge.Damage
import Dodge.Data.Creature
import Dodge.Item.Draw
import Dodge.Item.Grammar
import Geometry
import Picture
import qualified Quaternion as Q
import Shape
--import Shape
import ShapePicture

basicCrPict :: IM.IntMap Item -> Creature -> SPic
basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape cr)

crCamouflage :: Creature -> CamouflageStatus
crCamouflage _ = FullyVisible

basicCrShape :: Creature -> Shape
basicCrShape cr
    | crCamouflage cr == Invisible = mempty
    | otherwise =
        scaleSH (V3 crsize crsize crsize) $
            mconcat
                [ colorSH (_skinHead cskin) . overPosSH (translateToES cr OnHead) $ scalp
                , colorSH (_skinUpper cskin) $ upperBody cr
                , rotmdir $ colorSH (_skinLower cskin) $ feet cr
                ]
  where
    cskin = crShape $ _crType cr
    crsize = 0.1 * crRad (cr ^. crType)
    rotmdir = rotateSH (_crMvDir cr - _crDir cr)

drawHoverCrit :: Creature -> Shape
drawHoverCrit cr = colorSH (_skinUpper cskin) 
    (overPosSH (Q.apply tpq) $ upperBoxHalf Medium Typical 2 $ square 5)
  where
    cskin = crShape $ _crType cr
    z = cr ^?! crStance . carriage . flyHeight
    tpq = (V3 0 0 z, Q.qid)

drawChaseCrit :: Creature -> Shape
drawChaseCrit cr = mconcat 
    [ chaseUpperBody cr
    , rotmdir $ colorSH (_skinLower cskin) $ feet cr
    ]
  where
    cskin = crShape $ _crType cr
    rotmdir = rotateSH (_crMvDir cr - _crDir cr)

chaseUpperBody :: Creature -> Shape
chaseUpperBody cr =  colorSH (_skinUpper cskin)
    (overPosSH (Q.apply torsoq) (upperPrismPolyHalfMI tz $ polyCirc 3 12 
        & each %~ vNormal
        & each . _y *~ 0.6) 
    <> overPosSH (Q.apply neckq) (upperPrismPolyHalfMI 3 $ (+ V2 8 0) . vNormal <$> trapTBH 2 5 8)
    )
    <> colorSH (_skinHead cskin)
        (overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4]))
  where
    tz = 4
    cskin = crShape $ _crType cr
    torsoq = (V3 0 0 (10 + tz + tbob),Q.qid)
    mcool = 1 - min 10 (fromIntegral . _meleeCooldown $ _crType cr) / 10
    neckq = torsoq `Q.comp` (V3 6 0 0,Q.axisAngle (V3 0 1 0) (-1.8*mcool))
    headq = neckq `Q.comp` (V3 16 0 0, Q.axisAngle (V3 0 1 0) (2*mcool+vocaltilt))
    vocaltilt = case cr ^? crVocalization . vcTime of
        Just x | x < 20 -> -pi * 0.05 * (10 - abs (fromIntegral x - 10))
        _ -> 0
    sLen = strideLength cr
    tbob = 5 * (1 - oneSmooth (abs llegpos))
    llegpos = case cr ^? crStance . carriage of
        Just (Walking sa LeftForward) -> f sa
        Just (Walking sa RightForward) -> -f sa
        _ -> 0
    --tbob = 2 * oneSmooth ((sLen - 2*i) / sLen)
    f i = ((sLen - 2*i) / sLen)
    

oneSmooth :: Float -> Float
oneSmooth x = sin (pi * x * 0.5)

feet :: Creature -> Shape
{-# INLINE feet #-}
feet cr = case cr ^? crStance . carriage of
    Just (Walking sa LeftForward) -> sh (f sa)
    Just (Walking sa RightForward) -> sh (-f sa)
    _ -> sh 0
  where
    sh x = translateSHxy x off aFoot <> translateSHxy (- x) (- off) aFoot
    aFoot = upperPrismPolyST 10 $ polyCirc 3 4
    off = 5
    sLen = strideLength cr
--    f i = 8 * (sLen - 2*i) / sLen
    f i = 8 * oneSmooth ((sLen - 2*i) / sLen)

deadFeet :: Creature -> Shape
{-# INLINE deadFeet #-}
deadFeet = feet

arms :: Creature -> Shape
{-# INLINE arms #-}
arms cr =
    (^. _1) $
        translateToRightHand cr aHand
            <> translateToLeftHand cr aHand
  where
    aHand = noPic $ translateSHz (-2) . upperPrismPolyHalfST 2 $ polyCirc 3 4

deadScalp :: Creature -> Shape
--deadScalp cr = deadRot cr . translateSHz 5 . scalp $ cr
--deadScalp cr = deadRot cr . translateSHz (-5) . scalp $ cr
deadScalp _ = translateSH (V3 (-13) 0 0) scalp

deadRot :: Creature -> Shape -> Shape
deadRot cr = overPosSH (Q.rotateToZ d)
  where
    d =
        maybe
            (V3 1 0 0)
            (addZ 0 . unitVectorAtAngle . subtract (_crDir cr + pi))
            (damageDirection $ _crDamage cr)

scalp :: Shape
{-# INLINE scalp #-}
scalp = (colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5)
        & each . sfShadowImportance .~ Unimportant

torso :: Creature -> Shape
{-# INLINE torso #-}
torso cr = overPosSH (translateToES cr OnBack) tsh
  where
    tsh = ashoulder 3 (-0.2) <> ashoulder (-3) 0.2
    ashoulder y a = translateSHxy 0 y . rotateSH a $ scaleSH (V3 10 10 1) baseShoulder

deadUpperBody :: Creature -> Shape
deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr

baseShoulder :: Shape
{-# INLINE baseShoulder #-}
--baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
baseShoulder = scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1

upperBody :: Creature -> Shape
{-# INLINE upperBody #-}
upperBody cr = arms cr <> torso cr

drawEquipment :: IM.IntMap Item -> Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment m cr = foldMap (itemEquipPict cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)