From 5a6144dbbdea8e7a9e67b179d89ca9675bd767ab Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Thu, 19 Jun 2025 12:15:24 +0100
Subject: [PATCH] Simplify creature drawing positioning

---
 src/Dodge/Creature/Picture.hs    | 20 ++++++++------------
 src/Dodge/Render/ShapePicture.hs | 20 ++++----------------
 src/Shape.hs                     |  1 +
 3 files changed, 13 insertions(+), 28 deletions(-)

diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs
index ebfdde015..a98387f11 100644
--- a/src/Dodge/Creature/Picture.hs
+++ b/src/Dodge/Creature/Picture.hs
@@ -27,30 +27,26 @@ import ShapePicture
 
 basicCrPict :: Creature -> SPic
 basicCrPict cr =
-    uncurryV translateSPxy (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr)
-        <> noPic (basicCrShape cr)
+    uncurryV translateSPxy (_crPos cr) . rotateSP (_crDir cr) $ drawEquipment cr
+        <> noPic ( basicCrShape cr)
 
 crCamouflage :: Creature -> CamouflageStatus
 crCamouflage _ = FullyVisible
 
-basicCrShape ::
-    Creature ->
-    Shape
+basicCrShape :: Creature -> Shape
 basicCrShape cr
     | crCamouflage cr == Invisible = mempty
     | otherwise =
-        tr . scaleSH (V3 crsize crsize crsize) $
+        scaleSH (V3 crsize crsize crsize) $
             mconcat
-                [ rotdir . colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
-                , rotdir $ 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
     crsize = 0.1 * crRad (cr ^. crType)
-    tr = uncurryV translateSHxy (_crPos cr)
-    rotdir = rotateSH (_crDir cr)
-    rotmdir = rotateSH (_crMvDir cr)
+    rotmdir = rotateSH (_crMvDir cr - _crDir cr)
 
 feet :: Creature -> Shape
 {-# INLINE feet #-}
diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs
index faf010da6..4de70dcb5 100644
--- a/src/Dodge/Render/ShapePicture.hs
+++ b/src/Dodge/Render/ShapePicture.hs
@@ -41,31 +41,19 @@ drawCreature cr = case cr ^. crType of
     BarrelCrit{} -> 
             uncurryV translateSPxy (_crPos cr) $ rotateSP (_crDir cr)
             $ barrelShape
---        picAtCrPos1
---            ( setDepth 20 $
---                fold
---                    [ color orange $ circleSolid 10
---                    , setDepth 0.049 . color (greyN 0.5) $ circleSolid 8
---                    , color (greyN 0.5) $ circleSolid 8
---                    ]
---            )
---            cr
-    LampCrit{_lampHeight = h} -> uncurryV translateSPxy (_crPos cr) $ lampCrSPic h
+    LampCrit{_lampHeight = h} -> uncurryV translateSPxy (_crPos cr) $ rotateSP (cr ^. crDir)$ lampCrSPic h
     _ -> basicCrPict cr
---    NonDrawnCreature -> mempty
 
 barrelShape :: SPic
-barrelShape = noPic $ upperPrismPoly Medium Important 20 $ polyCirc 3 10
+barrelShape = noPic $ cylinderPoly Medium Important (map (addZ 20) ps) (map (addZ 0) ps)
+  where
+    ps = polyCirc 3 10
 
 lampCrSPic :: Float -> SPic
 lampCrSPic h =
     colorSH blue (upperBox Small Typical h $ rectWH 5 5)
         :!: setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
 
-picAtCrPos1 :: Picture -> Creature -> SPic
---{-# INLINE picAtCrPos #-}
-picAtCrPos1 thePic cr = (:!:) mempty $ tranRot (_crPos cr) (_crDir cr) thePic
-
 shiftDraw :: (a -> Point2) -> (a -> Float) -> (a -> a -> SPic) -> a -> SPic
 shiftDraw fpos fdir fdraw x =
     uncurryV translateSPxy (fpos x)
diff --git a/src/Shape.hs b/src/Shape.hs
index c0888a9e0..c2ad3fb05 100644
--- a/src/Shape.hs
+++ b/src/Shape.hs
@@ -83,6 +83,7 @@ prismBox size shads upps downps = [Surface (FlatFaces n) (f upps downps) white s
     f (a : as) (b : bs) = a : b : f as bs
     f _ _ = []
 
+-- to check: should the polygons be anticlockwise? does this matter?
 cylinderPoly ::
     Size ->
     Importance ->