Simplify creature drawing positioning

This commit is contained in:
2025-06-19 12:15:24 +01:00
parent 3f9b76b8d0
commit 5a6144dbbd
3 changed files with 13 additions and 28 deletions
+4 -16
View File
@@ -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)