--{-# LANGUAGE TupleSections #-}
{- |
Drawing of creatures. 
Takes into account damage etc. -}
module Dodge.Creature.Picture
    ( basicCrPict
    , drawCrEquipment
    , circLine
    , picAtCrPos
    , shapeAtCrPos
    , picAtCrPosNoRot
    ) where
import Dodge.Data
--import Dodge.Base
import Dodge.Creature.Test
--import Dodge.Render.InfoBox
--import Dodge.Render.List
--import Dodge.Creature.AlertLevel.Data
--import Dodge.Picture.Layer
import Dodge.Clock
--import Dodge.Debug.Picture
import Picture
import Geometry
import Shape
import ShapePicture
--import Geometry.Vector3D

import Control.Lens
import qualified Data.IntMap.Strict as IM
import qualified Data.Vector as V
basicCrPict :: Color    -- ^ Creature color
    -> Creature 
    -> Configuration
    -> World
    -> SPic
basicCrPict col cr cfig w = 
    drawCrEquipment cr
    <>
    (basicCrShape col cr
    , pictures $
        targetingPic ++
        [ creatureDisplayText cfig w cr
        --, tr . rotdir $ _spPicture $ drawEquipment cr
        ]
    )
  where 
    targetingPic = IM.elems $ IM.mapMaybeWithKey f $ _crInv cr
    f invid it = fmap (\g -> g invid it cr cfig w) (it ^? itTargeting . tgDraw)

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

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

basicCrShape 
    :: Color    -- ^ Creature color
    -> Creature 
    -> Shape
basicCrShape col cr = tr . scaleSH (V3 crsize crsize crsize) $ mconcat
    [ --rotdir . _spShape $ drawEquipment cr
     rotdir . dm . translateSHz 20 $ scalp cr
    , rotdir . dm $ upperBody col cr
    , dm . rotmdir $ feet cr
    ]
  where 
    crsize = 0.1 * _crRad cr
    dm = damageModSH cr
    tr = uncurryV translateSHf (_crPos cr)
    rotdir = rotateSH (_crDir cr)
    rotmdir = rotateSH (_crMvDir cr)
        . colorSH (greyN 0.3)

creatureDisplayText :: Configuration -> World -> Creature -> Picture
creatureDisplayText cfig w cr 
  | not (_debug_cr_awareness cfig) = []
  | otherwise
    = setLayer DebugLayer 
    . setDepth 20 
    . translate x y 
    . color white 
    . rotate (0.5 * pi)
--    . rotate (argV v - 0.5 * pi)
    . scale theScale theScale 
    . stackText 
    $ clockCycle 25 (V.fromList 
        [ \cr' -> [crDisplayAwake cr']
        , \cr' -> [crDisplayAlert cr']
        ]
        ) w cr
  where
    campos = _cameraViewFrom w
    theScale = 0.15 / _cameraZoom w
    cpos = _crPos cr
    v = cpos -.- campos
    (V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v

crDisplayAlert :: Creature -> String
crDisplayAlert cr
    | isSuspicious = "?"
    | isCognizant  = "!"
    | otherwise    = "."
  where
    imAwarenesses = _crAwarenessLevel (_crPerception cr)
    isSuspicious = any f imAwarenesses && not (null imAwarenesses)
    isCognizant  = any g imAwarenesses && not (null imAwarenesses)
    f (Suspicious _) = True
    f _ = False
    g (Cognizant _) = True
    g _ = False

crDisplayAwake :: Creature -> String
crDisplayAwake = show . _crAwakeLevel . _crPerception
--crDisplayAwake cr = case _crAwakeLevel (_crPerception cr) of
--    Comatose    -> "-"
--    Asleep      -> "Z"
--    Lethargic   -> "L"
--    Vigilant    -> "V"
--    Overstrung  -> "O"

--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
damageModSH :: Creature -> Shape -> Shape
damageModSH _ = 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

arms :: Creature -> Shape
{-# INLINE arms #-}
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 :: Shape
    aHand = translateSHz (-4) . upperPrismPolyHalf 4 $ polyCirc 3 4
    off = 8
    sLen = _strideLength $ _crStance cr
    f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen

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

crInStance :: AimStance -> Creature -> Bool
crInStance as cr = crIsAiming' cr -- || (_posture (_crStance cr) == Reloading && hasAmmo cr)
    && cr ^? crInv . ix (_crInvSel cr) . itUse . useAim . aimStance == Just as

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

oneH :: Creature -> Bool
oneH = crInStance OneHand

twoFlat :: Creature -> Bool
twoFlat = crInStance TwoHandFlat

twists :: Creature -> Bool
twists = crInStance TwoHandTwist

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

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

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

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

light4 :: Color -> Color
light4 = light . light . light . light

--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 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 -> Configuration -> World -> SPic
--{-# INLINE picAtCrPos #-}
picAtCrPos thePic cr _ _ = (,) emptySH $ tranRot (_crPos cr) (_crDir cr) thePic

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