Allow tweaking z buffer when rendering polygon, improve explosion render

src/Dodge/Creature/Inanimate.hs

@@ -26,29 +26,29 @@ import Control.Lens
 defaultInanimate :: Creature
 defaultInanimate = defaultCreature & crActionPlan .~ Inanimate
 
-lamp :: Creature
-lamp = defaultInanimate
-    { _crUpdate = initialiseLamp
+lamp :: Float -> Creature
+lamp h = defaultInanimate
+    { _crUpdate = initialiseLamp h
     , _crHP = 100
-    , _crPict = picAtCrPos lampPic
+    , _crPict = picAtCrPos (lampPic h)
     , _crRad = 3
     , _crMass = 3
     }
-lampPic :: Picture
-lampPic = pictures
-    [ pictures . map (Poly3D 0 . map ((, blue) . (-.-.- (2.5,2.5,0)))) $ boxXYZ 5 5 99
-    , setDepth (100) $ color white $ circleSolid 3
+lampPic :: Float -> Picture
+lampPic h = pictures
+    [ pictures . map (Poly3D 0 . map ((, blue) . (-.-.- (2.5,2.5,0)))) $ boxXYZ 5 5 (h-1)
+    , setDepth h $ color white $ circleSolid 3
     ]
 
-initialiseLamp :: CRUpdate
-initialiseLamp w (f,g) cr = ( (addLS . f , g), Just $ cr & crUpdate .~ updateLamp i)
+initialiseLamp :: Float -> CRUpdate
+initialiseLamp h w (f,g) cr = ( (addLS . f , g), Just $ cr & crUpdate .~ updateLamp h i)
   where
     i = IM.newKey $ _lightSources $ f w -- to give different lights different keys
-    addLS = over lightSources (IM.insert i (lightAt (x,y,20) i))
+    addLS = over lightSources (IM.insert i (lightAt (x,y,h) i))
     (x,y) = _crPos cr
 
-updateLamp :: Int -> CRUpdate
-updateLamp i = unrandUpdate handleLS internalUpdate
+updateLamp :: Float -> Int -> CRUpdate
+updateLamp h i = unrandUpdate handleLS internalUpdate
   where
     handleLS cr w 
         | _crHP cr < 0 = explosionFlashAt cPos 
@@ -56,7 +56,7 @@ updateLamp i = unrandUpdate handleLS internalUpdate
         | otherwise    = w & lightSources . ix i . lsPos .~ f cPos
       where
         cPos = _crPos cr
-        f (x,y) = (x,y,120)
+        f (x,y) = (x,y,h)
     internalUpdate cr 
         | _crHP cr < 0 = Nothing
         | otherwise    = Just $ doDamage cr

src/Dodge/Creature/Picture.hs

@@ -16,6 +16,7 @@ import Dodge.Creature.Test
 import Dodge.Item.Data
 import Picture
 import Geometry
+import Geometry.Vector3D
 
 import Control.Lens
 import Data.List
@@ -29,12 +30,13 @@ basicCrPict col cr w = pictures $
     targetingPic ++
     [ tr . setDepth 0 $ color yellow $ circleSolid 10
     , tr . piercingMod $ bluntScale $ naked col cr
-    , tr $ waist col
+    , tr $ torso (light4 col) (0,-crad) (0,crad)
     , trFeet $ feet cr
     , tr $ arms col cr
     , tr $ drawEquipment cr
     ]
   where 
+    crad = _crRad cr
     targetingPic = IM.elems $ IM.mapMaybeWithKey f $ _crInv cr
     f invid it = fmap ((\g -> g invid it cr w) . snd) (it ^? itTargeting . _Just)
     tr = uncurry translate (_crPos cr) . rotate (_crDir cr)
@@ -55,9 +57,6 @@ basicCrPict col cr w = pictures $
         _   -> id
     pastDams = _crPastDamage $ _crState cr
 
-waist :: Color -> Picture
-waist col = setDepth 10 . color (light4 col) . scale 0.5 1 $ circleSolid 8
-
 feet :: Creature -> Picture
 feet cr = case cr ^? crStance . carriage of
     Just (Walking sa LeftForward)  -> setL
@@ -99,7 +98,15 @@ arms col cr
     f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
     aimingTwist = crIsAiming' cr -- && crIt ^? itAimStance == Just TwoHandTwist
     --crIt = _crInv cr IM.! _crInvSel cr
-    
+
+torso :: Color -> Point2 -> Point2 -> Picture
+torso col x y = color col $ pictures
+    [ poly3 [addZ 20 x, addZ 12 v, addZ 12 ((0,0) -.- v), addZ 20 y]
+    , setDepth 12 . rotate a . scale 1 1 $ circleSolid $ magV v
+    ]
+  where
+    v = 0.25 *.* (x -.- y)
+    a = argV v
 
 naked :: Color -> Creature -> Picture
 naked col cr
@@ -125,7 +132,7 @@ naked col cr
         , shoulderH . translate 0 (negate 3) . rotate 0.2 . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
         ]
   where
-    fhead = setDepth 30 $ circleSolid $ crad * 0.5
+    fhead = setDepth 22 $ circleSolid $ crad * 0.5
     shoulderH = setDepth 20
     twistA = negate 1
     aimingOneHand = crIsAiming' cr && crIt ^? itAimStance == Just OneHand

src/Dodge/Creature/State.hs

@@ -93,6 +93,7 @@ movementSideEff cr w
             Just (Boosting v) 
                 -> makeFlameletTimed 
                             (oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
+                            20
                             (momentum +.+ 1 *.* rotateV randDir (vInverse v)) 
                             Nothing
                             1