Add slime crit, start work on slink crit

src/Dodge/Creature/Picture.hs

@@ -3,16 +3,12 @@ Drawing of creatures.
 Takes into account damage etc.
 -}
 module Dodge.Creature.Picture (
-    basicCrPict,
-    deadScalp,
-    deadUpperBody,
-    deadFeet,
-    drawChaseCrit,
-    drawHoverCrit,
-    drawCrabCrit,
     makeCorpse,
+    drawCreature,
 ) where
 
+import Data.Foldable
+import qualified Data.Strict.Tuple as ST
 import RandomHelp
 import Dodge.Base.Collide
 import Control.Monad
@@ -37,6 +33,42 @@ import Shape
 --import Shape
 import ShapePicture
 
+drawCreature :: World -> IM.IntMap Item -> Creature -> SPic
+drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $
+    case cr ^. crType of
+        _ | CrIsCorpse sp <- cr ^. crHP -> sp
+        _ | null (cr ^? crHP . _HP) -> mempty
+        BarrelCrit{} -> barrelShape
+        LampCrit{_lampHeight = h} -> lampCrSPic h
+        ChaseCrit {} -> noPic $ drawChaseCrit w cr
+        Avatar {} -> basicCrPict m cr
+        SwarmCrit -> basicCrPict m cr
+        AutoCrit -> basicCrPict m cr
+        CrabCrit {} -> noPic $ drawCrabCrit w cr
+        HoverCrit{} -> noPic $ drawHoverCrit cr
+        SlinkCrit{} -> noPic $ drawSlinkCrit cr
+        SlimeCrit{} -> noPic $ drawSlimeCrit cr
+  where
+    fallrot = case cr ^? crStance . carriage . carDir of
+        Just q -> _1 . each . sfVs . each %~ Q.rotate q
+        _ -> id
+
+drawSlimeCrit :: Creature -> Shape
+drawSlimeCrit cr = colorSH green $ upperPrismPolyHalf Medium Undesired r $ polyCirc 6 r
+    & each %~ scaleAlong d s
+    & each %~ scaleAlong (vNormal d) (1 / s)
+    & each %~ rotateV (-cr ^. crDir)
+  where
+    r = cr ^?! crType . slimeRad
+    p = cr ^?! crType . slimeCompression
+    d = normalize p
+    s = norm p / r
+
+-- assumes d is a unit vector
+scaleAlong :: Point2 -> Float -> Point2 -> Point2
+scaleAlong d s p = ((s - 1) * dot d p) *^ d + p
+
+
 basicCrPict :: IM.IntMap Item -> Creature -> SPic
 basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape cr)
 
@@ -58,6 +90,14 @@ basicCrShape cr
     crsize = 0.1 * crRad (cr ^. crType)
     rotmdir = rotateSH (_crMvDir cr - _crDir cr)
 
+drawSlinkCrit :: Creature -> Shape
+drawSlinkCrit cr = snd (foldl' f ((V3 0 0 0,Q.qid), mempty) $ cr ^?! crType . slinkSpine)
+    & each . sfColor .~ cskin ^?! skinUpper
+  where
+    cskin = crShape $ _crType cr
+    f ((p,q),sh) (p',q') = ((p,q) `Q.comp` (p',q'), sh <> (g p' & each . sfVs . each %~ Q.apply (p,q)))
+    g _ = upperPrismPoly Medium Important 2 $ polyCirc 6 10
+
 drawHoverCrit :: Creature -> Shape
 drawHoverCrit cr = colorSH (_skinHead cskin) 
     (overPosSH (Q.apply tpq) $ upperBoxHalf Medium Typical 1 $ square 4)
@@ -332,3 +372,14 @@ upperBody cr = arms cr <> torso cr
 drawEquipment :: IM.IntMap Item -> Creature -> SPic
 {-# INLINE drawEquipment #-}
 drawEquipment m cr = foldMap (itemEquipPict cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)
+
+barrelShape :: SPic
+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 Undesired h $ rectWH 5 5)
+        ST.:!: setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
+