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
+4 -8
View File
@@ -9,10 +9,10 @@ module Dodge.Creature.Picture (
deadFeet, deadFeet,
) where ) where
import Dodge.Creature.Radius
import Dodge.Creature.Shape
import Control.Lens import Control.Lens
import Dodge.Creature.HandPos (translateToLeftHand, translateToRightHand) import Dodge.Creature.HandPos (translateToLeftHand, translateToRightHand)
import Dodge.Creature.Radius
import Dodge.Creature.Shape
import Dodge.Creature.Test import Dodge.Creature.Test
import Dodge.Damage import Dodge.Damage
import Dodge.Data.Creature import Dodge.Data.Creature
@@ -26,9 +26,7 @@ import Shape
import ShapePicture import ShapePicture
basicCrPict :: Creature -> SPic basicCrPict :: Creature -> SPic
basicCrPict cr = basicCrPict cr = drawEquipment cr <> noPic (basicCrShape cr)
uncurryV translateSPxy (_crPos cr) . rotateSP (_crDir cr) $ drawEquipment cr
<> noPic ( basicCrShape cr)
crCamouflage :: Creature -> CamouflageStatus crCamouflage :: Creature -> CamouflageStatus
crCamouflage _ = FullyVisible crCamouflage _ = FullyVisible
@@ -57,9 +55,7 @@ feet cr = case cr ^? crStance . carriage of
Just (Walking sa RightForward) -> Just (Walking sa RightForward) ->
translateSHxy (- f sa) off aFoot translateSHxy (- f sa) off aFoot
<> 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 where
aFoot = upperPrismPolyST 10 $ polyCirc 3 4 aFoot = upperPrismPolyST 10 $ polyCirc 3 4
off = 5 off = 5
+4 -5
View File
@@ -37,11 +37,10 @@ worldSPic cfig u =
pointIsClose = cullPoint cfig w pointIsClose = cullPoint cfig w
drawCreature :: Creature -> SPic drawCreature :: Creature -> SPic
drawCreature cr = case cr ^. crType of drawCreature cr = uncurryV translateSPxy (_crPos cr) . rotateSP (_crDir cr) $
BarrelCrit{} -> case cr ^. crType of
uncurryV translateSPxy (_crPos cr) $ rotateSP (_crDir cr) BarrelCrit{} -> barrelShape
$ barrelShape LampCrit{_lampHeight = h} -> lampCrSPic h
LampCrit{_lampHeight = h} -> uncurryV translateSPxy (_crPos cr) $ rotateSP (cr ^. crDir)$ lampCrSPic h
_ -> basicCrPict cr _ -> basicCrPict cr
barrelShape :: SPic barrelShape :: SPic