{- |
Drawing of creatures. 
Takes into account damage etc. -}
module Dodge.Creature.Picture
    ( basicCrPict
    , circLine
    , picAtCrPos
    , picAtCrPosNoRot
    ) where
import Dodge.Data
--import Dodge.Data.DamageType
--import Dodge.Base
--import Dodge.Creature.Stance.Data
import Dodge.Creature.Perception.Data
--import Dodge.Creature.State.Data
import Dodge.Creature.Stance.Data
--import Dodge.Creature.Memory.Data
import Dodge.Creature.Test
--import Dodge.Creature.AlertLevel.Data
--import Dodge.Picture.Layer
import Dodge.Item.Data
import Dodge.Clock
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 
    -> World
    -> SPic
basicCrPict col cr w = SPic (basicCrShape col cr) $ pictures $
    targetingPic ++
    [ creatureDisplayText 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 w) . snd) (it ^? itTargeting . _Just)
    tr = uncurryV translate (_crPos cr) 
    rotdir = rotate (_crDir cr)

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

creatureDisplayText :: World -> Creature -> Picture
creatureDisplayText w cr 
    = setLayer 4 
    . setDepth 50 
    . translate x y 
    . color white 
    . rotate a 
    . scale theScale theScale 
    . text 
    $ clockCycle 50 (V.fromList [crDisplayAwake, crDisplayAlert]) w cr
  where
    campos = _cameraViewFrom w
    theScale = 0.15 / _cameraZoom w
    cpos = _crPos cr
    v = cpos -.- campos
    a = argV v - 0.5 * pi
    (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 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
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
arms cr 
    | oneH cr = shoulderSH . translateSHf 11 (-3) . rotateSH (-0.5) $ scaleSH (V3 1 1.5 1) aHand
    | twists cr = shoulderSH . translateSHf 0 (0.5* crad) . rotateSH (-1) $ mconcat 
        [ translateSHf 12 4    aHand
        , translateSHf 4 (-10) 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) . upperPrismPoly 4 $ polyCirc 3 4
    crad = _crRad cr
    off = 8
    sLen = _strideLength $ _crStance cr
    f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen

scalp :: Creature -> Shape
scalp cr
    | twists cr = translateSHf 0 (0.5*crad) . rotateSH (-1) $ translateSHf (negate 0.25 * crad) 0.25 fhead
    | oneH   cr = rotateSH 0.5 $ translateSHf (0.25 * crad) 0 fhead
    | otherwise = translateSHf (0.25 * crad) 0 fhead
  where
    fhead = colorSH (greyN 0.9) . upperPrismPoly 5 . polyCirc 3 $ crad * 0.5
    crad = _crRad cr

oneH :: Creature -> Bool
oneH cr = crIsAiming' cr && crIt ^? itAimStance == Just OneHand
  where
    crIt = _crInv cr IM.! _crInvSel cr

twists :: Creature -> Bool
twists cr = crIsAiming' cr && crIt ^? itAimStance == Just TwoHandTwist
  where
    crIt = _crInv cr IM.! _crInvSel cr

torso :: Creature -> Shape
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 (0.5* crad) . 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 crad crad 1) baseShoulder
    crad = _crRad cr

baseShoulder :: Shape
baseShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPoly 10 $ polyCirc 3 1



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

--naked :: Color -> Creature -> Picture
--naked _ cr
--    | strikeMelee   = shoulderH . color white $ circleSolid $ _crRad cr
--    | pdam > 200    = shoulderH . color red $ circleSolid $ _crRad cr
--    | pdam > 99     = shoulderH . color white $ circleSolid $ _crRad cr
--    | otherwise = []
--  where
--    strikeMelee = _crMeleeCooldown cr > 5
--    pdam = sum $ concatMap (map _dmAmount) pastDams
--    pastDams = _crPastDamage $ _crState 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
drawEquipment cr = mconcat $ map f $ IM.toList (_crInv cr)
  where 
    f (i,it) = case it ^? itEquipPict of
        Just g -> g cr i
        _      -> emptyBlank

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

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

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