justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup creature picture

Browse Source
This commit is contained in:
justin
2021-09-04 14:53:05 +01:00
parent 1ab3f1773c
commit 215a3dda36
13 changed files with 318 additions and 307 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Picture.hs
+89 -76
View File
@@ -15,10 +15,9 @@ 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 Geometry.Vector3D
import Control.Lens
import Data.List
@@ -28,24 +27,28 @@ basicCrPict
-> 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
]
basicCrPict col cr w = setLayer 0 $ pictures $
targetingPic ++
[ tr . dm . rotdir $ scalp cr
, tr . dm . rotdir $ upperBody col cr
, tr . dm . rotmdir $ feet cr
, tr . rotdir $ drawEquipment cr
]
where
crad = _crRad cr
dm = damageMod 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)
tr = uncurryV translate (_crPos cr)
rotdir = rotate (_crDir cr)
rotmdir = rotate (_crMvDir cr)
. setDepth 1
. color (greyN 0.3)
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
@@ -59,94 +62,104 @@ basicCrPict col cr w
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 LeftForward) -> pictures
[ translate ( f sa) off aFoot
, translate (-f sa) (-off) aFoot
]
Just (Walking sa RightForward) -> setL
[ translate (-f sa) off $ circleSolid 5
, translate (f sa) (-off) $ circleSolid 5
Just (Walking sa RightForward) -> pictures
[ translate (-f sa) off aFoot
, translate ( f sa) (-off) aFoot
]
_ -> setL
[ translate 0 off $ circleSolid 5
, translate 0 (-off) $ circleSolid 5
_ -> pictures
[ translate 0 off aFoot
, translate 0 (-off) aFoot
]
where
--setL = onLayerL [levLayer CrLayer, -5] . color (greyN 0.3) . pictures
setL = setDepth 1 . color (greyN 0.3) . pictures
aFoot = circleSolid 4
off = 5
sLen = _strideLength $ _crStance cr
f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
arms :: Color -> Creature -> Picture
arms col cr
| aimingTwist = blank
arms :: Creature -> Picture
arms cr
| oneH cr = shoulderH . translate 11 (-3) . rotate (-0.5) $ scale 1 1.5 aHand
| twists cr = shoulderH . translate 0 (0.5* crad) . rotate (-1) $ pictures
[ translate 12 4 aHand
, translate 4 (-10) aHand
]
| 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
]
Just (Walking sa LeftForward) -> waistH $ translate (-f sa) (-off) aHand
Just (Walking sa RightForward) -> waistH $ translate (-f sa) off aHand
_ -> blank
where
sc = scale 1 1
--setL = onLayerL [levLayer CrLayer, -4] . color (light4 col) . pictures
setL = setDepth 20 . color (light4 col) . pictures
aHand = circleSolid 4
crad = _crRad cr
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
]
scalp :: Creature -> Picture
scalp cr
| twists cr = translate 0 (0.5*crad) . rotate (-1) $ translate (negate 0.25 * crad) 0.25 fhead
| oneH cr = rotate 0.5 $ translate (0.25 * crad) 0 fhead
| otherwise = translate (0.25 * crad) 0 fhead
where
v = 0.25 *.* (x -.- y)
a = argV v
fhead = setDepth 22 $ circleSolid $ 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 -> Picture
torso cr
| oneH cr = rotate 0.5 $ pictures
[ translate 0 3 . rotate (negate 0.2) $ aShoulder
, translate 0 (negate 3) . rotate 0.2 $ aShoulder
]
| twists cr = translate 0 (0.5* crad) . rotate (-1) $ pictures
[ rotate (negate 0.2) . translate 2 3 . rotate (negate 0.4) $ aShoulder
, rotate (negate 0.2) . translate 0 (negate 3) . rotate 0.2 $ aShoulder
]
| otherwise = pictures
[ translate 0 3 . rotate (negate 0.2) $ aShoulder
, translate 0 (negate 3) . rotate 0.2 $ aShoulder
]
where
aShoulder = scale 0.5 1 $ circleSolid crad
crad = _crRad cr
upperBody :: Color -> Creature -> Picture
upperBody col cr = color (light4 col) $ pictures
[ arms cr
, shoulderH $ torso cr
]
naked :: Color -> Creature -> Picture
naked col cr
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
| 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
]
| otherwise = []
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 = _crMeleeCooldown cr > 5
pdam = sum $ concatMap (map _dmAmount) pastDams
crad = _crRad cr
pastDams = _crPastDamage $ _crState cr
col' = light . light . light $ light col
shoulderH :: Picture -> Picture
shoulderH = setDepth 20
waistH :: Picture -> Picture
waistH = setDepth 10
light4 :: Color -> Color
light4 = light . light . light . light