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

import Control.Lens
import Dodge.Creature.HandPos (translateToLeftHand, translateToRightHand)
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 :: Creature -> SPic
basicCrPict cr = drawEquipment 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) . translateSHz 20 $ scalp cr
                , 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)

feet :: Creature -> Shape
{-# INLINE feet #-}
feet cr = case cr ^? crStance . carriage of
    Just (Walking sa LeftForward) ->
        translateSHxy (f sa) off aFoot
            <> translateSHxy (- f sa) (- off) aFoot
    Just (Walking sa RightForward) ->
        translateSHxy (- f sa) off aFoot
            <> translateSHxy (f sa) (- off) aFoot
    _ -> translateSHxy 0 off aFoot <> translateSHxy 0 (- off) aFoot
  where
    aFoot = upperPrismPolyST 10 $ polyCirc 3 4
    off = 5
    sLen = _strideLength $ _crStance cr
    f i = 6 * fromIntegral (sLen - i) / fromIntegral 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 (-4) . upperPrismPolyHalfST 4 $ polyCirc 3 4

deadScalp :: Creature -> Shape
deadScalp cr = deadRot cr . translateSHz 10 . scalp $ cr

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 :: Creature -> Shape
{-# INLINE scalp #-}
scalp cr
    | twists cr = translateSHxy 0 5 . rotateSH (-1) $ translateSHxy (negate 2.5) 0.25 fhead
    | oneH cr = rotateSH 0.5 $ translateSHxy 2.5 0 fhead
    | otherwise = translateSHxy 2.5 0 fhead
  where
    fhead = colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5

torso :: Creature -> Shape
{-# INLINE torso #-}
torso cr
    | oneH cr =
        rotateSH 0.5 $
            mconcat
                [ translateSHxy 0 3 . rotateSH (negate 0.2) $ aShoulder
                , translateSHxy 0 (negate 3) . rotateSH 0.2 $ aShoulder
                ]
    | twists cr =
        translateSHxy 0 5 . rotateSH (-1) $
            mconcat
                [ rotateSH (negate 0.2) . translateSHxy 2 3 . rotateSH (negate 0.4) $ aShoulder
                , rotateSH (negate 0.2) . translateSHxy 0 (negate 3) . rotateSH 0.2 $ aShoulder
                ]
    | otherwise =
        mconcat
            [ translateSHxy 0 3 . rotateSH (negate 0.2) $ aShoulder
            , translateSHxy 0 (negate 3) . rotateSH 0.2 $ aShoulder
            ]
  where
    aShoulder = scaleSH (V3 10 10 1) baseShoulder

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

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

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

shoulderSH :: Shape -> Shape
shoulderSH = translateSHz 20

drawEquipment :: Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment cr = foldMap (itemEquipPict cr) (invDT $ _crInv cr)