Cleanup creature drawing

This commit is contained in:
2025-06-19 12:29:21 +01:00
parent 5a6144dbbd
commit f84ae98aa9
2 changed files with 13 additions and 18 deletions
+7 -11
View File
@@ -9,10 +9,10 @@ module Dodge.Creature.Picture (
deadFeet,
) where
import Dodge.Creature.Radius
import Dodge.Creature.Shape
import Control.Lens
import Dodge.Creature.HandPos (translateToLeftHand, translateToRightHand)
import Dodge.Creature.Radius
import Dodge.Creature.Shape
import Dodge.Creature.Test
import Dodge.Damage
import Dodge.Data.Creature
@@ -26,9 +26,7 @@ import Shape
import ShapePicture
basicCrPict :: Creature -> SPic
basicCrPict cr =
uncurryV translateSPxy (_crPos cr) . rotateSP (_crDir cr) $ drawEquipment cr
<> noPic ( basicCrShape cr)
basicCrPict cr = drawEquipment cr <> noPic (basicCrShape cr)
crCamouflage :: Creature -> CamouflageStatus
crCamouflage _ = FullyVisible
@@ -39,9 +37,9 @@ basicCrShape cr
| otherwise =
scaleSH (V3 crsize crsize crsize) $
mconcat
[ colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
, colorSH (_skinUpper cskin) $ upperBody cr
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
[ colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
, colorSH (_skinUpper cskin) $ upperBody cr
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
]
where
cskin = crShape $ _crType cr
@@ -57,9 +55,7 @@ feet cr = case cr ^? crStance . carriage of
Just (Walking sa RightForward) ->
translateSHxy (- f sa) off aFoot
<> translateSHxy (f sa) (- off) aFoot
_ ->
translateSHxy 0 off aFoot
<> translateSHxy 0 (- off) aFoot
_ -> translateSHxy 0 off aFoot <> translateSHxy 0 (- off) aFoot
where
aFoot = upperPrismPolyST 10 $ polyCirc 3 4
off = 5
+6 -7
View File
@@ -37,12 +37,11 @@ worldSPic cfig u =
pointIsClose = cullPoint cfig w
drawCreature :: Creature -> SPic
drawCreature cr = case cr ^. crType of
BarrelCrit{} ->
uncurryV translateSPxy (_crPos cr) $ rotateSP (_crDir cr)
$ barrelShape
LampCrit{_lampHeight = h} -> uncurryV translateSPxy (_crPos cr) $ rotateSP (cr ^. crDir)$ lampCrSPic h
_ -> basicCrPict cr
drawCreature cr = uncurryV translateSPxy (_crPos cr) . rotateSP (_crDir cr) $
case cr ^. crType of
BarrelCrit{} -> barrelShape
LampCrit{_lampHeight = h} -> lampCrSPic h
_ -> basicCrPict cr
barrelShape :: SPic
barrelShape = noPic $ cylinderPoly Medium Important (map (addZ 20) ps) (map (addZ 0) ps)
@@ -73,7 +72,7 @@ cullPoint cfig w p
extraPics :: Configuration -> Universe -> Picture
extraPics cfig u =
setLayer FixedCoordLayer (fixedCoordPictures u)
setLayer FixedCoordLayer (fixedCoordPictures u)
<> foldMap drawTractorBeam (_tractorBeams lw)
<> foldMap drawLinearShockwave (_linearShockwaves lw)
<> foldMap drawShockwave (_shockwaves lw)