--{-# LANGUAGE TupleSections #-}
{- |
Drawing of creatures. 
Takes into account damage etc. -}
module Dodge.Creature.Picture
    ( basicCrPict
    , drawCrEquipment
    , circLine
    , picAtCrPos
    , shapeAtCrPos
    , picAtCrPosNoRot
--    , basicCrCorpse
    , deadScalp
    , deadUpperBody
    , deadFeet
    ) where
import Dodge.Data
import Dodge.Creature.HandPos (translateToRightHand,translateToLeftHand)
import Dodge.Creature.Test
import Dodge.Damage
import Dodge.Item.Draw
import Picture
import Geometry
import Shape
import ShapePicture
import qualified Quaternion as Q

import Control.Lens

basicCrPict :: Creature -> SPic
basicCrPict cr = drawCrEquipment cr <> (basicCrShape cr , mempty)

drawCrEquipment :: Creature -> SPic
drawCrEquipment cr = uncurryV translateSPf (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr)

shapeAtCrPos :: Shape -> Creature -> SPic
shapeAtCrPos sh cr = 
    ( uncurryV translateSHf (_crPos cr) $ rotateSH (_crDir cr) sh
    , mempty
    )

basicCrShape 
    :: Creature 
    -> Shape
basicCrShape cr 
    | _crCamouflage cr == Invisible = mempty
    | otherwise = tr . scaleSH (V3 crsize crsize crsize) $ mconcat
        [ --rotdir . _spShape $ drawEquipment cr
         rotdir . colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
        , rotdir $ colorSH (_skinUpper cskin) $ upperBody cr
        , rotmdir $ colorSH (_skinLower cskin) $ feet cr
        ]
  where 
    cskin = _crType cr
    crsize = 0.1 * _crRad cr
    tr = uncurryV translateSHf (_crPos cr)
    rotdir = rotateSH (_crDir cr)
    rotmdir = rotateSH (_crMvDir cr)

--damageMod :: Creature -> Picture -> Picture
--damageMod cr pic = piercingMod $ bluntScale pic
--  where
--    cdir = _crDir cr
--    pastDams = _crPastDamage $ _crState cr
--    bluntDam :: Maybe Point2
--    bluntDam = find isBluntDam (concat pastDams) >>= (\dm -> (-.-) <$> dm ^? dmFrom <*> dm ^? dmTo)
--    bluntScale = case fmap argV bluntDam of
--        Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
--        _   -> id
--    isBluntDam Blunt{} = True
--    isBluntDam _ = False
--    piercingDam = find isPiercingDam (concat pastDams) >>= (\dm -> (-.-) <$> dm ^? dmFrom <*> dm ^? dmTo)
--    isPiercingDam Piercing{} = True
--    isPiercingDam _ = False
--    piercingMod = case fmap argV piercingDam of
--        Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
--        _   -> id

feet :: Creature -> Shape
{-# INLINE feet #-}
feet cr = case cr ^? crStance . carriage of
    Just (Walking sa LeftForward)  -> mconcat
        [ translateSHf ( f sa)   off  aFoot
        , translateSHf (-f sa) (-off) aFoot
        ]
    Just (Walking sa RightForward) -> mconcat
        [ translateSHf (-f sa)   off  aFoot
        , translateSHf ( f sa) (-off) aFoot
        ]
    _ -> mconcat
        [ translateSHf 0   off  aFoot
        , translateSHf 0 (-off) aFoot
        ]
  where
    aFoot :: Shape
    aFoot = upperPrismPoly 10 $ polyCirc 3 4
    off = 5
    sLen = _strideLength $ _crStance cr
    f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen

deadFeet :: Creature -> Shape
{-# INLINE deadFeet #-}
deadFeet cr = case cr ^? crStance . carriage of
    Just (Walking sa LeftForward)  -> mconcat
        [ translateSHf ( f sa)   off  aFoot
        , translateSHf (-f sa) (-off) aFoot
        ]
    Just (Walking sa RightForward) -> mconcat
        [ translateSHf (-f sa)   off  aFoot
        , translateSHf ( f sa) (-off) aFoot
        ]
    _ -> mconcat
        [ translateSHf 0   off  aFoot
        , translateSHf 0 (-off) aFoot
        ]
  where
    aFoot :: Shape
    aFoot = upperPrismPoly 3 $ polyCirc 3 4
    off = 5
    sLen = _strideLength $ _crStance cr
    f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen

arms :: Creature -> Shape
{-# INLINE arms #-}
arms cr = fst $ translateToRightHand cr aHand
    <> translateToLeftHand cr aHand
--arms cr 
--    | oneH cr = shoulderSH . translateSHf 11 (-3) . rotateSH (-0.5) $ scaleSH (V3 1 1.5 1) aHand
--    | twists cr = shoulderSH . translateSHf 0 5 . rotateSH (-1) $ mconcat 
--        [ translateSHf 12 4    aHand
--        , translateSHf 4 (-10) aHand
--        ]
--    | twoFlat cr = waistSH $ translateSHf 4 8 aHand
--        <> translateSHf 4 (-8) aHand
--    | otherwise = case cr ^? crStance . carriage of
--        Just (Walking sa LeftForward)  -> waistSH $ translateSHf (-f sa) (-off) aHand
--        Just (Walking sa RightForward) -> waistSH $ translateSHf (-f sa) off    aHand
--        _ -> emptySH 
  where
    aHand :: SPic
    aHand = noPic $ translateSHz (-4) . upperPrismPolyHalf 4 $ polyCirc 3 4
--    off = 8
--    sLen = _strideLength $ _crStance cr
--    f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen

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 . _csDamage $ _crState cr)

scalp :: Creature -> Shape
{-# INLINE scalp #-}
scalp cr
    | twists cr = translateSHf 0 5 . rotateSH (-1) $ translateSHf (negate 2.5) 0.25 fhead
    | oneH   cr = rotateSH 0.5 $ translateSHf 2.5 0 fhead
    | otherwise = translateSHf 2.5 0 fhead
  where
    fhead = colorSH (greyN 0.9) . upperPrismPolyHalf 5 $ polyCirc 4 5

--hasAmmo :: Creature -> Bool
--hasAmmo cr = case cr ^? crInv . ix (_crInvSel cr) . itConsumption . ammoLoaded of
--    Just x -> x > 0
--    _ -> False

torso :: Creature -> Shape
{-# INLINE torso #-}
torso cr 
    | oneH cr   = rotateSH 0.5 $ mconcat
        [ translateSHf 0 3 . rotateSH (negate 0.2) $ aShoulder
        , translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
        ]
    | twists cr = translateSHf 0 5 . rotateSH (-1) $ mconcat
        [ rotateSH (negate 0.2) . translateSHf 2 3 . rotateSH (negate 0.4) $ aShoulder
        , rotateSH (negate 0.2) . translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
        ]
    | otherwise = mconcat
        [ translateSHf 0 3 . rotateSH (negate 0.2) $ aShoulder
        , translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
        ]
  where
    --aShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPoly 10 $ polyCirc 3 crad
    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) . upperPrismPolyHalf 10 $ polyCirc 3 1

upperBody :: Creature -> Shape
{-# INLINE upperBody #-}
--upperBody col cr = colorSH (light4 col) $ mconcat
upperBody cr = mconcat
    [ arms cr
    , shoulderSH $ torso cr
    ]

shoulderSH :: Shape -> Shape
shoulderSH = translateSHz 20
--waistSH :: Shape -> Shape
--waistSH = translateSHz 10


--drawAwakeLevel
--    :: Creature
--    -> Picture
--drawAwakeLevel cr = case cr ^? crAttentionDir of
--    Just (AttentiveTo [0]) -> setPos . color red $ circleSolid 5
--    _        -> setPos . color blue $ circleSolid 5
--  where
--    setPos = translate 0 (_crRad cr)

drawEquipment :: Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment cr = foldMap (itemEquipPict cr) (_crInv cr)
--drawEquipment cr = foldMap f (_crInv cr)
--  where 
--    f itm = _itEquipPict itm cr itm

circLine :: Float -> Picture
circLine x = line [V2 0 0,V2 x 0]

picAtCrPos :: Picture -> Creature -> SPic
--{-# INLINE picAtCrPos #-}
picAtCrPos thePic cr = (,) emptySH $ tranRot (_crPos cr) (_crDir cr) thePic

picAtCrPosNoRot :: Picture -> Creature -> SPic
--{-# INLINE picAtCrPos #-}
picAtCrPosNoRot thePic cr = (,) emptySH $ uncurryV translate (_crPos cr) thePic