184 lines
6.7 KiB
Haskell
184 lines
6.7 KiB
Haskell
{- |
|
|
Drawing of creatures.
|
|
Takes into account damage etc. -}
|
|
module Dodge.Creature.Picture
|
|
( basicCrPict
|
|
, circLine
|
|
, picAtCrPos
|
|
, picAtCrPosNoRot
|
|
) where
|
|
import Dodge.Data
|
|
--import Dodge.Creature.Stance.Data
|
|
import Dodge.Creature.State.Data
|
|
import Dodge.Creature.Stance.Data
|
|
import Dodge.Creature.Test
|
|
--import Dodge.Creature.AlertLevel.Data
|
|
--import Dodge.Picture.Layer
|
|
import Dodge.Item.Data
|
|
import Dodge.Base.Window
|
|
import Picture
|
|
import Geometry
|
|
import Geometry.Vector3D
|
|
|
|
import Control.Lens
|
|
import Data.List
|
|
import qualified Data.IntMap.Strict as IM
|
|
basicCrPict
|
|
:: Color -- ^ Creature color
|
|
-> Creature
|
|
-> World
|
|
-> Picture
|
|
basicCrPict col cr w
|
|
| dist (_crPos cr) (_cameraCenter w) > 1.5 * max (getWindowX w) (getWindowY w) = blank
|
|
| otherwise = setLayer 0 $ pictures $
|
|
targetingPic ++
|
|
[ tr . setDepth 0 $ color yellow $ circleSolid 10
|
|
, tr . piercingMod $ bluntScale $ naked col cr
|
|
, tr $ torso (light4 col) (V2 0 (-crad)) (V2 0 crad)
|
|
, trFeet $ feet cr
|
|
, tr $ arms col cr
|
|
, tr $ drawEquipment cr
|
|
]
|
|
where
|
|
crad = _crRad cr
|
|
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) . rotate (_crDir cr)
|
|
trFeet = uncurryV translate (_crPos cr) . rotate (_crMvDir cr)
|
|
cdir = _crDir 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
|
|
pastDams = _crPastDamage $ _crState cr
|
|
|
|
feet :: Creature -> Picture
|
|
feet cr = case cr ^? crStance . carriage of
|
|
Just (Walking sa LeftForward) -> setL
|
|
[ translate (f sa) off $ circleSolid 5
|
|
, translate (-f sa) (-off) $ circleSolid 5
|
|
]
|
|
Just (Walking sa RightForward) -> setL
|
|
[ translate (-f sa) off $ circleSolid 5
|
|
, translate (f sa) (-off) $ circleSolid 5
|
|
]
|
|
_ -> setL
|
|
[ translate 0 off $ circleSolid 5
|
|
, translate 0 (-off) $ circleSolid 5
|
|
]
|
|
where
|
|
--setL = onLayerL [levLayer CrLayer, -5] . color (greyN 0.3) . pictures
|
|
setL = setDepth 1 . color (greyN 0.3) . pictures
|
|
off = 5
|
|
sLen = _strideLength $ _crStance cr
|
|
f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
|
|
|
|
arms :: Color -> Creature -> Picture
|
|
arms col cr
|
|
| aimingTwist = blank
|
|
| otherwise = case cr ^? crStance . carriage of
|
|
Just (Walking sa LeftForward) -> setL
|
|
[ translate (-f sa) (-off) . sc $ circleSolid 4
|
|
]
|
|
Just (Walking sa RightForward) -> setL
|
|
[ translate (-f sa) off . sc $ circleSolid 4
|
|
]
|
|
_ -> blank
|
|
where
|
|
sc = scale 1 1
|
|
--setL = onLayerL [levLayer CrLayer, -4] . color (light4 col) . pictures
|
|
setL = setDepth 20 . color (light4 col) . pictures
|
|
off = 8
|
|
sLen = _strideLength $ _crStance cr
|
|
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
|
|
aimingTwist = crIsAiming' cr -- && crIt ^? itAimStance == Just TwoHandTwist
|
|
--crIt = _crInv cr IM.! _crInvSel cr
|
|
|
|
torso :: Color -> Point2 -> Point2 -> Picture
|
|
torso col x y = color col $ pictures
|
|
[ poly3 [addZ 20 x, addZ 12 v, addZ 12 (V2 0 0 -.- v), addZ 20 y]
|
|
, setDepth 12 . rotate a . scale 1 1 $ circleSolid $ magV v
|
|
]
|
|
where
|
|
v = 0.25 *.* (x -.- y)
|
|
a = argV v
|
|
|
|
naked :: Color -> Creature -> Picture
|
|
naked col cr
|
|
| strikeMelee = shoulderH . color white $ circleSolid $ _crRad cr
|
|
| pdam > 200 = shoulderH . color red $ circleSolid $ _crRad cr
|
|
| pdam > 99 = shoulderH . color white $ circleSolid $ _crRad cr
|
|
| aimingOneHand = rotate (negate twistA * 0.5) $ pictures
|
|
[ translate (0.25 * crad) 0 fhead
|
|
, shoulderH . translate 8 (-8) . color col' $ circleSolid 4
|
|
, translate 0 3 . rotate (negate 0.2) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
|
|
, translate 0 (negate 3) . rotate 0.2 . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
|
|
]
|
|
| aimingTwist = translate 0 (0.5* crad) . rotate twistA $ pictures
|
|
[ translate (negate 0.25 * crad) 0.25 fhead
|
|
, shoulderH . translate 12 4 . color col' $ circleSolid 4
|
|
, shoulderH . translate 4 (-10) . color col' $ circleSolid 4
|
|
, shoulderH . rotate (negate 0.2) . translate 2 3 . rotate (negate 0.4) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
|
|
, shoulderH . rotate (negate 0.2) . translate 0 (negate 3) . rotate 0.2 . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
|
|
]
|
|
| otherwise = pictures
|
|
[ translate (0.25 * crad) 0 fhead
|
|
, shoulderH . translate 0 3 . rotate (negate 0.2) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
|
|
, shoulderH . translate 0 (negate 3) . rotate 0.2 . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
|
|
]
|
|
where
|
|
fhead = setDepth 22 $ circleSolid $ crad * 0.5
|
|
shoulderH = setDepth 20
|
|
twistA = negate 1
|
|
aimingOneHand = crIsAiming' cr && crIt ^? itAimStance == Just OneHand
|
|
aimingTwist = crIsAiming' cr && crIt ^? itAimStance == Just TwoHandTwist
|
|
crIt = _crInv cr IM.! _crInvSel cr
|
|
strikeMelee = case _crMeleeCooldown cr of
|
|
Nothing -> False
|
|
Just x -> x > 5
|
|
pdam = sum $ concatMap (map _dmAmount) pastDams
|
|
crad = _crRad cr
|
|
pastDams = _crPastDamage $ _crState cr
|
|
col' = light . light . light $ light col
|
|
|
|
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
|
|
-> Picture
|
|
drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr)
|
|
where
|
|
f (i,it) = case it ^? itEquipPict of
|
|
Just g -> g cr i
|
|
_ -> blank
|
|
|
|
circLine :: Float -> Picture
|
|
circLine x = line [V2 0 0,V2 x 0]
|
|
|
|
picAtCrPos :: Picture -> Creature -> World -> Picture
|
|
--{-# INLINE picAtCrPos #-}
|
|
picAtCrPos thePic cr _ = tranRot (_crPos cr) (_crDir cr) thePic
|
|
|
|
picAtCrPosNoRot :: Picture -> Creature -> World -> Picture
|
|
--{-# INLINE picAtCrPos #-}
|
|
picAtCrPosNoRot thePic cr _ = uncurryV translate (_crPos cr) thePic
|