Cleanup
This commit is contained in:
@@ -1,16 +1,9 @@
|
||||
--{-# LANGUAGE TupleSections #-}
|
||||
|
||||
{- |
|
||||
Drawing of creatures.
|
||||
Takes into account damage etc.
|
||||
-}
|
||||
module Dodge.Creature.Picture (
|
||||
basicCrPict,
|
||||
drawCrEquipment,
|
||||
circLine,
|
||||
picAtCrPos,
|
||||
shapeAtCrPos,
|
||||
picAtCrPosNoRot,
|
||||
deadScalp,
|
||||
deadUpperBody,
|
||||
deadFeet,
|
||||
@@ -29,16 +22,8 @@ import Shape
|
||||
import ShapePicture
|
||||
|
||||
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
|
||||
)
|
||||
basicCrPict cr = uncurryV translateSPf (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr)
|
||||
<> (basicCrShape cr, mempty)
|
||||
|
||||
basicCrShape ::
|
||||
Creature ->
|
||||
@@ -48,8 +33,7 @@ basicCrShape cr
|
||||
| otherwise =
|
||||
tr . scaleSH (V3 crsize crsize crsize) $
|
||||
mconcat
|
||||
[ --rotdir . _spShape $ drawEquipment cr
|
||||
rotdir . colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
|
||||
[ rotdir . colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
|
||||
, rotdir $ colorSH (_skinUpper cskin) $ upperBody cr
|
||||
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
|
||||
]
|
||||
@@ -60,25 +44,6 @@ basicCrShape 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
|
||||
@@ -136,26 +101,8 @@ arms cr =
|
||||
translateToRightHand cr aHand
|
||||
<> translateToLeftHand cr aHand
|
||||
where
|
||||
--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
|
||||
|
||||
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
|
||||
|
||||
@@ -177,11 +124,6 @@ scalp cr
|
||||
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
|
||||
@@ -203,7 +145,6 @@ torso cr
|
||||
, 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
|
||||
@@ -215,7 +156,6 @@ baseShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalf 10
|
||||
|
||||
upperBody :: Creature -> Shape
|
||||
{-# INLINE upperBody #-}
|
||||
--upperBody col cr = colorSH (light4 col) $ mconcat
|
||||
upperBody cr =
|
||||
mconcat
|
||||
[ arms cr
|
||||
@@ -225,33 +165,6 @@ upperBody 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
|
||||
|
||||
Reference in New Issue
Block a user