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

Cleanup creature drawing

Browse Source
This commit is contained in:
justin
2025-06-19 12:29:21 +01:00
parent 5a6144dbbd
commit f84ae98aa9
2 changed files with 13 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Picture.hs
+7 -11
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
@@ -39,9 +37,9 @@ basicCrShape cr
| otherwise = | otherwise =
scaleSH (V3 crsize crsize crsize) $ scaleSH (V3 crsize crsize crsize) $
mconcat mconcat
[ colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr [ colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
, colorSH (_skinUpper cskin) $ upperBody cr , colorSH (_skinUpper cskin) $ upperBody cr
, rotmdir $ colorSH (_skinLower cskin) $ feet cr , rotmdir $ colorSH (_skinLower cskin) $ feet cr
] ]
where where
cskin = crShape $ _crType cr cskin = crShape $ _crType cr
@@ -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
src/Dodge/Render/ShapePicture.hs
+6 -7
View File
@@ -37,12 +37,11 @@ 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
barrelShape = noPic $ cylinderPoly Medium Important (map (addZ 20) ps) (map (addZ 0) ps) 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 :: Configuration -> Universe -> Picture
extraPics cfig u = extraPics cfig u =
setLayer FixedCoordLayer (fixedCoordPictures u) setLayer FixedCoordLayer (fixedCoordPictures u)
<> foldMap drawTractorBeam (_tractorBeams lw) <> foldMap drawTractorBeam (_tractorBeams lw)
<> foldMap drawLinearShockwave (_linearShockwaves lw) <> foldMap drawLinearShockwave (_linearShockwaves lw)
<> foldMap drawShockwave (_shockwaves lw) <> foldMap drawShockwave (_shockwaves lw)