Cleanup

src/Dodge/Creature/Damage.hs

@@ -12,17 +12,17 @@ import Dodge.Data.World
 --import Geometry
 import LensHelp
 
-applyCreatureDamage :: [Damage] -> Creature -> World -> World
-applyCreatureDamage dms cr w = foldl' (applyIndividualDamage cr) w dms
+applyCreatureDamage :: Int -> Creature -> World -> World
+applyCreatureDamage cid cr w = foldl' (applyIndividualDamage cid cr) w (cr ^. crDamage)
 
-applyIndividualDamage :: Creature -> World -> Damage -> World
-applyIndividualDamage cr w (Inertial _ _ v _) = w 
-    & cWorld . lWorld . creatures . ix (_crID cr) . crPos . _xy +~ fmap (/ crMass (cr ^. crType)) v
-applyIndividualDamage cr w dm = 
-    let (i,w') = damMatSideEffect dm (crMaterial (_crType cr)) (Left cr) w
-    in w' & damageHP cr i
+applyIndividualDamage :: Int -> Creature -> World -> Damage -> World
+applyIndividualDamage cid cr w (Inertial _ _ v _) = w 
+    & cWorld . lWorld . creatures . ix cid . crPos . _xy +~ fmap (/ crMass (cr ^. crType)) v
+applyIndividualDamage cid cr w dm = 
+    let (x,w') = damMatSideEffect dm (crMaterial (_crType cr)) (Left cr) w
+    in w' & damageHP cid x
 
-damageHP :: Creature -> Int -> World -> World
-damageHP cr x =
-    (cWorld . lWorld . creatures . ix (_crID cr) . crHP . _HP -~ x)
-    . (cWorld . lWorld . creatures . ix (_crID cr) . crPain +~ x)
+damageHP :: Int -> Int -> World -> World
+damageHP cid x =
+    (cWorld . lWorld . creatures . ix cid . crHP . _HP -~ x)
+    . (cWorld . lWorld . creatures . ix cid . crPain +~ x)

src/Dodge/Creature/Picture.hs

@@ -7,32 +7,29 @@ module Dodge.Creature.Picture (
     drawCreature,
 ) where
 
-import Dodge.Creature.Slime
-import Geometry.Zone
-import Data.Foldable
-import qualified Data.Strict.Tuple as ST
-import RandomHelp
-import Dodge.Base.Collide
-import Control.Monad
-import Data.Maybe
-import Dodge.Data.World
-import Linear
-import Dodge.Data.Equipment.Misc
-import Dodge.Creature.HandPos
-import qualified Data.IntMap.Strict as IM
 import Control.Lens
+import Control.Monad
+import Data.Foldable
+import qualified Data.IntMap.Strict as IM
+import Data.Maybe
+import qualified Data.Strict.Tuple as ST
+import Dodge.Base.Collide
+import Dodge.Creature.HandPos
 import Dodge.Creature.Radius
 import Dodge.Creature.Shape
---import Dodge.Creature.Test
+import Dodge.Creature.Slime
 import Dodge.Damage
---import Dodge.Data.Creature
+import Dodge.Data.Equipment.Misc
+import Dodge.Data.World
 import Dodge.Item.Draw
 import Dodge.Item.Grammar
 import Geometry
+import Geometry.Zone
+import Linear
 import Picture
 import qualified Quaternion as Q
+import RandomHelp
 import Shape
---import Shape
 import ShapePicture
 
 drawCreature :: World -> IM.IntMap Item -> Creature -> SPic
@@ -42,11 +39,11 @@ drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $
         _ | null (cr ^? crHP . _HP) -> mempty
         BarrelCrit{} -> barrelShape
         LampCrit{_lampHeight = h} -> lampCrSPic h
-        ChaseCrit {} -> noPic $ drawChaseCrit w cr
-        Avatar {} -> basicCrPict m cr
+        ChaseCrit{} -> noPic $ drawChaseCrit w cr
+        Avatar{} -> basicCrPict m cr
         SwarmCrit -> basicCrPict m cr
         AutoCrit -> basicCrPict m cr
-        CrabCrit {} -> noPic $ drawCrabCrit w cr
+        CrabCrit{} -> noPic $ drawCrabCrit w cr
         HoverCrit{} -> noPic $ drawHoverCrit cr
         SlinkCrit{} -> noPic $ drawSlinkCrit cr
         SlimeCrit{} -> noPic $ drawSlimeCrit cr
@@ -58,113 +55,125 @@ drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $
         _ -> id
 
 drawSlimeCrit :: Creature -> Shape
-drawSlimeCrit cr = colorSH green 
-    $ upperPrismPolyHalf Medium Typical (cr ^?! crType . slimeEngulfProgress + min 15 r) ps
+drawSlimeCrit cr =
+    colorSH green $
+        upperPrismPolyHalf Medium Typical (cr ^?! crType . slimeEngulfProgress + min 15 r) ps
   where
     r = slimeToRad $ cr ^?! crType . slimeSlime - cr ^?! crType . slimeSlimeChange
     so = slimeOutline cr
     ps = fromMaybe so $ do
-        (x',qs) <- cr ^? crType . slimeSplitTimer . _Just
+        (x', qs) <- cr ^? crType . slimeSplitTimer . _Just
         let x = fromIntegral x'
         guard $ length qs == 12
-        return $ zipWith (+) (fmap (0.1*(10 - x) *^) so) (fmap (0.1*x*^) qs)
+        return $ zipWith (+) (fmap (0.1 * (10 - x) *^) so) (fmap (0.1 * x *^) qs)
 
 -- 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)
 
-crCamouflage :: Creature -> CamouflageStatus
-crCamouflage _ = FullyVisible
-
 basicCrShape :: Creature -> Shape
-basicCrShape cr
-    | crCamouflage cr == Invisible = mempty
-    | otherwise =
-        scaleSH (V3 crsize crsize crsize) $
-            mconcat
-                [ colorSH (_skinHead cskin) . overPosSH (translateToES cr OnHead) $ scalp
-                , colorSH (_skinUpper cskin) $ upperBody cr
-                , rotmdir $ colorSH (_skinLower cskin) $ feet cr
-                ]
+basicCrShape cr =
+    scaleSH (V3 crsize crsize crsize) $
+        mconcat
+            [ colorSH (_skinHead cskin) . overPosSH (translateToES cr OnHead) $ scalp
+            , colorSH (_skinUpper cskin) $ upperBody cr
+            , rotmdir $ colorSH (_skinLower cskin) $ feet cr
+            ]
   where
     cskin = crShape $ _crType 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)
+drawSlinkCrit cr =
+    snd (foldl' f ((V3 0 0 0, Q.qid), mempty) $ cr ^?! crType . slinkSpine)
         <> shead
-    & each . sfColor .~ cskin ^?! skinUpper
+        & each . sfColor .~ cskin ^?! skinUpper
   where
-    shead = polyCirc 6 15
-        & upperPrismPoly Medium Important 10
-        & each . sfVs . each %~ Q.apply (cr ^?! crType . slinkHeadPos)
+    shead =
+        polyCirc 6 15
+            & upperPrismPoly Medium Important 10
+            & each . sfVs . each %~ Q.apply (cr ^?! crType . slinkHeadPos)
     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)))
+    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 15
 
 drawHoverCrit :: Creature -> Shape
-drawHoverCrit cr = colorSH (_skinHead cskin) 
-    (overPosSH (Q.apply tpq) $ upperBoxHalf Medium Typical 1 $ square 4)
-    <> colorSH (_skinUpper cskin)
-    (mconcat [overPosSH (Q.apply $ f a) $ upperBox Medium Typical 1 $ polyCirc 3 5 | a <- [0,pi/2,pi,1.5*pi]])
+drawHoverCrit cr =
+    colorSH
+        (_skinHead cskin)
+        (overPosSH (Q.apply tpq) $ upperBoxHalf Medium Typical 1 $ square 4)
+        <> colorSH
+            (_skinUpper cskin)
+            (mconcat [overPosSH (Q.apply $ f a) $ upperBox Medium Typical 1 $ polyCirc 3 5 | a <- [0, pi / 2, pi, 1.5 * pi]])
   where
     cskin = crShape $ _crType cr
     f a = tpq `Q.comp` (1 & _xy .~ rotateV a 5, Q.qid)
     tpq = (V3 0 0 0, Q.qid)
 
 drawHive :: SPic
-drawHive =  noPic $ upperPrismPolyHalfMI 25 $ polyCirc 6 20
+drawHive = noPic $ upperPrismPolyHalfMI 25 $ polyCirc 6 20
 
 drawBeeCrit :: Creature -> Shape
-drawBeeCrit cr = colorSH col
-    (f . upperPrismPolyHalfMI 3 $ polyCirc 6 r)
-        <>
-    colorSH (dark col) (overPosSH (Q.apply (beakpos)) $ upperPrismPolyHalfST 1 $ [V2 0 (-2), V2 4 0,V2 0 2])
+drawBeeCrit cr =
+    colorSH
+        col
+        (f . upperPrismPolyHalfMI 3 $ polyCirc 6 r)
+        <> colorSH (dark col) (overPosSH (Q.apply (beakpos)) $ upperPrismPolyHalfST 1 $ [V2 0 (-2), V2 4 0, V2 0 2])
   where
     r = cr ^. crType . to crRad
-    beakpos = (V3 (r-1) 0 0, Q.qid)
-    col | cr ^?! crType . beeAggro > 0 = red
+    beakpos = (V3 (r - 1) 0 0, Q.qid)
+    col
+        | cr ^?! crType . beeAggro > 0 = red
         | otherwise = yellow
-    f   | Mounted {} <- cr ^. crStance . carriage
-            = each . sfVs . each . _xy %~ scaleAlong (V2 0 1) (1 + g ( modTo 1 (cr ^?! crType . beeSlime . to ((/100) . fromIntegral))))
+    f
+        | Mounted{} <- cr ^. crStance . carriage =
+            each . sfVs . each . _xy %~ scaleAlong (V2 0 1) (1 + g (modTo 1 (cr ^?! crType . beeSlime . to ((/ 100) . fromIntegral))))
         | otherwise = id
-    g x | x > 0.5 = 1 - x
+    g x
+        | x > 0.5 = 1 - x
         | otherwise = x
 
 drawCrabCrit :: World -> Creature -> Shape
-drawCrabCrit w cr = mconcat 
-    [ crabUpperBody w cr
-    , colorSH (_skinLower cskin) $ crabFeet w cr
-    ]
+drawCrabCrit w cr =
+    mconcat
+        [ crabUpperBody w cr
+        , colorSH (_skinLower cskin) $ crabFeet w cr
+        ]
   where
     cskin = crShape $ _crType cr
 
 drawChaseCrit :: World -> Creature -> Shape
-drawChaseCrit w cr = mconcat 
-    [ chaseUpperBody w cr
-    , rotmdir $ colorSH (_skinLower cskin) $ feet cr
-    ]
+drawChaseCrit w cr =
+    mconcat
+        [ chaseUpperBody w cr
+        , rotmdir $ colorSH (_skinLower cskin) $ feet cr
+        ]
   where
     cskin = crShape $ _crType cr
     rotmdir = rotateSH (_crMvDir cr - _crDir cr)
 
 crabUpperBody :: World -> Creature -> Shape
-crabUpperBody _ cr =  colorSH (_skinUpper cskin)
-    (
-    overPosSH (Q.apply torsoq) (upperPrismPolyHalfMI 5 $ polyCirc 4 10 
-        & each . _x *~ 0.6) 
-    <> overPosSH (Q.apply lclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 20 0 (-2) 2)
-    <> overPosSH (Q.apply rclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 0 (-20) (-2) 2)
-    )
-    <> colorSH (_skinHead cskin)
-        (overPosSH (Q.apply headq) (upperPrismPolyHalfMI 1 $ square 2))
+crabUpperBody _ cr =
+    colorSH
+        (_skinUpper cskin)
+        ( overPosSH
+            (Q.apply torsoq)
+            ( upperPrismPolyHalfMI 5 $
+                polyCirc 4 10
+                    & each . _x *~ 0.6
+            )
+            <> overPosSH (Q.apply lclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 20 0 (-2) 2)
+            <> overPosSH (Q.apply rclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 0 (-20) (-2) 2)
+        )
+        <> colorSH
+            (_skinHead cskin)
+            (overPosSH (Q.apply headq) (upperPrismPolyHalfMI 1 $ square 2))
   where
-    torsoq = (V3 0 0 10,Q.qid)
+    torsoq = (V3 0 0 10, Q.qid)
     lclawq = torsoq `Q.comp` (V3 2 8 1, Q.slerp latck lrest lcool)
     latck = Q.axisAngle (V3 0 0 1) (-0.5 * pi)
     lrest = Q.axisAngle (V3 1 0 0) 1
@@ -175,105 +184,116 @@ crabUpperBody _ cr =  colorSH (_skinUpper cskin)
     rrest = Q.axisAngle (V3 1 0 0) (-1)
     rcool = 1 - min 10 (fromIntegral . _meleeCooldownR $ _crType cr) / 10
     headq = torsoq `Q.comp` (V3 3 0 4, Q.qid)
-    
 
 chaseUpperBody :: World -> Creature -> Shape
-chaseUpperBody w cr =  colorSH (_skinUpper cskin)
-    (overPosSH (Q.apply torsoq) (upperPrismPolyHalfMI tz $ polyCirc 3 12 
-        & each %~ vNormal
-        & each . _y *~ 0.6) 
-    <> overPosSH (Q.apply neckq) (upperPrismPolyHalfMI 3 $ (+ V2 8 0) . vNormal <$> trapTBH 2 5 8)
-    )
-    <> colorSH (_skinHead cskin)
-        (overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4]))
+chaseUpperBody w cr =
+    colorSH
+        (_skinUpper cskin)
+        ( overPosSH
+            (Q.apply torsoq)
+            ( upperPrismPolyHalfMI tz $
+                polyCirc 3 12
+                    & each %~ vNormal
+                    & each . _y *~ 0.6
+            )
+            <> overPosSH (Q.apply neckq) (upperPrismPolyHalfMI 3 $ (+ V2 8 0) . vNormal <$> trapTBH 2 5 8)
+        )
+        <> colorSH
+            (_skinHead cskin)
+            (overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4]))
   where
---    time = fromIntegral (mod (w ^. unpauseClock) 100) / 5
+    --    time = fromIntegral (mod (w ^. unpauseClock) 100) / 5
     tz = 4
     cskin = crShape $ _crType cr
-    torsoq = (V3 0 0 (10 + tz + tbob),Q.qid)
+    torsoq = (V3 0 0 (10 + tz + tbob), Q.qid)
     mcool = 1 - min 10 (fromIntegral . _meleeCooldown $ _crType cr) / 10
-    neckq = torsoq `Q.comp` (V3 6 0 0, Q.qz aimrot * Q.axisAngle (V3 0 1 0) (-1.8*mcool))
-    headq = neckq `Q.comp` (V3 16 0 0, Q.axisAngle (V3 0 1 0) (2*mcool+vocaltilt) * Q.qz aimrot )
+    neckq = torsoq `Q.comp` (V3 6 0 0, Q.qz aimrot * Q.axisAngle (V3 0 1 0) (-1.8 * mcool))
+    headq = neckq `Q.comp` (V3 16 0 0, Q.axisAngle (V3 0 1 0) (2 * mcool + vocaltilt) * Q.qz aimrot)
     vocaltilt = case cr ^? crVocalization . vcTime of
         Just x | x < 20 -> -pi * 0.05 * (10 - abs (fromIntegral x - 10))
         _ -> 0
     sLen = strideLength cr
     tbob = 5 * (1 - oneSmooth (abs llegpos))
-    llegpos = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
+    llegpos = case (cr ^? crType . strideAmount, cr ^? crType . footForward) of
         (Just sa, Just LeftForward) -> f sa
         (Just sa, Just RightForward) -> -f sa
         _ -> 0
-    --tbob = 2 * oneSmooth ((sLen - 2*i) / sLen)
-    f i = (sLen - 2*i) / sLen
+    -- tbob = 2 * oneSmooth ((sLen - 2*i) / sLen)
+    f i = (sLen - 2 * i) / sLen
     cxy = cr ^. crPos . _xy
     aimrot = fromMaybe pi $ do
         i <- cr ^. crIntention . targetCr
         tcxy <- w ^? cWorld . lWorld . creatures . ix i . crPos . _xy
         guard $ hasLOSIndirect cxy tcxy w
-        return . (0.5*) . nearZeroAngle $  argV (tcxy - cxy) - cr ^. crDir
+        return . (0.5 *) . nearZeroAngle $ argV (tcxy - cxy) - cr ^. crDir
 
 oneSmooth :: Float -> Float
 oneSmooth x = sin (pi * x * 0.5)
 
 feet :: Creature -> Shape
 {-# INLINE feet #-}
-feet cr = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
-    (Just sa,Just LeftForward) -> sh (f sa)
-    (Just sa,Just RightForward) -> sh (-f sa)
+feet cr = case (cr ^? crType . strideAmount, cr ^? crType . footForward) of
+    (Just sa, Just LeftForward) -> sh (f sa)
+    (Just sa, Just RightForward) -> sh (-f sa)
     _ -> sh 0
   where
-    sh x = translateSHxy x off aFoot <> translateSHxy (- x) (- off) aFoot
+    sh x = translateSHxy x off aFoot <> translateSHxy (-x) (-off) aFoot
     aFoot = upperPrismPolyST 10 $ polyCirc 3 4
     off = 5
     sLen = strideLength cr
---    f i = 8 * (sLen - 2*i) / sLen
-    f i = 8 * oneSmooth ((sLen - 2*i) / sLen)
+    --    f i = 8 * (sLen - 2*i) / sLen
+    f i = 8 * oneSmooth ((sLen - 2 * i) / sLen)
 
 crabFeet :: World -> Creature -> Shape
 {-# INLINE crabFeet #-}
-crabFeet _ cr = 
+crabFeet _ cr =
     uncurryV translateSHxy rpos (afoot & each . sfVs . each %~ Q.rotate r1)
-    <> (afoot 
-        & each . sfVs . each %~ Q.rotate r2
-        & each . sfVs . each +~ V3 0 2 5)
-    <> uncurryV translateSHxy rpos' (afoot & each . sfVs . each %~ Q.rotate r1')
-    <> (afoot 
-        & each . sfVs . each %~ Q.rotate r2'
-        & each . sfVs . each +~ V3 0 2 5)
-    <> uncurryV translateSHxy lpos (afoot & each . sfVs . each %~ Q.rotate l1)
-    <> (afoot 
-        & each . sfVs . each %~ Q.rotate l2
-        & each . sfVs . each +~ V3 0 (-2) 5)
-    <> uncurryV translateSHxy lpos' (afoot & each . sfVs . each %~ Q.rotate l1')
-    <> (afoot 
-        & each . sfVs . each %~ Q.rotate l2'
-        & each . sfVs . each +~ V3 0 (-2) 5)
+        <> ( afoot
+                & each . sfVs . each %~ Q.rotate r2
+                & each . sfVs . each +~ V3 0 2 5
+           )
+        <> uncurryV translateSHxy rpos' (afoot & each . sfVs . each %~ Q.rotate r1')
+        <> ( afoot
+                & each . sfVs . each %~ Q.rotate r2'
+                & each . sfVs . each +~ V3 0 2 5
+           )
+        <> uncurryV translateSHxy lpos (afoot & each . sfVs . each %~ Q.rotate l1)
+        <> ( afoot
+                & each . sfVs . each %~ Q.rotate l2
+                & each . sfVs . each +~ V3 0 (-2) 5
+           )
+        <> uncurryV translateSHxy lpos' (afoot & each . sfVs . each %~ Q.rotate l1')
+        <> ( afoot
+                & each . sfVs . each %~ Q.rotate l2'
+                & each . sfVs . each +~ V3 0 (-2) 5
+           )
   where
     rpos = rot (cr ^?! crType . rFootPos - cxy)
-    rot = rotateV cdir 
-    lpos = rot ( cr ^?! crType . lFootPos - cxy)
+    rot = rotateV cdir
+    lpos = rot (cr ^?! crType . lFootPos - cxy)
     f p q = q + 2 *^ (p - q)
     cdir = -cr ^. crDir
     cxy = cr ^. crPos . _xy
     afoot = upperPrismPolyHalfST 10 $ polyCirc 3 2
-    (r1,r2) = spiderJoint (0 & _xy .~ rpos) (V3 0 2 5)
+    (r1, r2) = spiderJoint (0 & _xy .~ rpos) (V3 0 2 5)
     rpos' = f (V2 0 10) rpos
-    (r1',r2') = spiderJoint (0 & _xy .~ rpos') (V3 0 2 5)
-    (l1,l2) = spiderJoint (0 & _xy .~ lpos) (V3 0 (-2) 5)
+    (r1', r2') = spiderJoint (0 & _xy .~ rpos') (V3 0 2 5)
+    (l1, l2) = spiderJoint (0 & _xy .~ lpos) (V3 0 (-2) 5)
     lpos' = f (V2 0 (-10)) lpos
-    (l1',l2') = spiderJoint (0 & _xy .~ lpos') (V3 0 (-2) 5)
+    (l1', l2') = spiderJoint (0 & _xy .~ lpos') (V3 0 (-2) 5)
 
 spiderJoint :: Point3 -> Point3 -> (Q.Quaternion Float, Q.Quaternion Float)
-spiderJoint p q = (f $ Q.axisAngle (V3 0 (-1) 0) (pi - (a+b)), f . Q.axisAngle (V3 0 (-1) 0) $ a - b)
---spiderJoint p q = (Q.qz c, Q.axisAngle (V3 0 (-1) 0) $ a)
+spiderJoint p q = (f $ Q.axisAngle (V3 0 (-1) 0) (pi - (a + b)), f . Q.axisAngle (V3 0 (-1) 0) $ a - b)
   where
+    -- spiderJoint p q = (Q.qz c, Q.axisAngle (V3 0 (-1) 0) $ a)
+
     a = angleThreeSides 10 (distance p q) 10
-    b = angleVV3 (q-p) (V3 0 0 (-1))
-    c = argV $ (p-q) ^. _xy
+    b = angleVV3 (q - p) (V3 0 0 (-1))
+    c = argV $ (p - q) ^. _xy
     f x = Q.qz c * x
 
---spiderJoint' :: Point3 -> Float -> Float -> Point3 -> (Q.Quaternion Float, Q.Quaternion Float)
---spiderJoint' p l1 l2 q = (f $ Q.axisAngle (V3 0 (-1) 0) (pi - (a+b)), f . Q.axisAngle (V3 0 (-1) 0) $ a - b)
+-- spiderJoint' :: Point3 -> Float -> Float -> Point3 -> (Q.Quaternion Float, Q.Quaternion Float)
+-- spiderJoint' p l1 l2 q = (f $ Q.axisAngle (V3 0 (-1) 0) (pi - (a+b)), f . Q.axisAngle (V3 0 (-1) 0) $ a - b)
 ----spiderJoint p q = (Q.qz c, Q.axisAngle (V3 0 (-1) 0) $ a)
 --  where
 --    a = angleThreeSides 10 (distance p q) 10
@@ -301,48 +321,59 @@ makeCorpse g cr = case cr ^. crType of
     rotmdir = rotateSH (_crMvDir cr - _crDir cr)
 
 chaseCorpse :: StdGen -> Creature -> Shape
-chaseCorpse g cr = mconcat
-            [colorSH (_skinUpper cskin) . upperPrismPolyHalfMI 0 $ polyCirc 3 12 
+chaseCorpse g cr =
+    mconcat
+        [ colorSH (_skinUpper cskin) . upperPrismPolyHalfMI 0 $
+            polyCirc 3 12
                 & each %~ vNormal
                 & each . _y *~ 0.6
-            , colorSH (_skinUpper cskin) . overPosSH (Q.apply neckq) $ 
-                upperPrismPolyHalfMI 3 ((+ V2 8 0) . vNormal <$> trapTBH 2 5 8)
-    , colorSH (_skinHead cskin)
-        (overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4]))
-            , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
+        , colorSH (_skinUpper cskin) . overPosSH (Q.apply neckq) $
+            upperPrismPolyHalfMI 3 ((+ V2 8 0) . vNormal <$> trapTBH 2 5 8)
+        , colorSH
+            (_skinHead cskin)
+            (overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4]))
+        , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
         ]
   where
     neckq = (V3 6 0 0, Q.qz a)
-    (a,g') = randomR (-2,2) g
-    b = fst $ randomR (-2,2) g'
+    (a, g') = randomR (-2, 2) g
+    b = fst $ randomR (-2, 2) g'
     cskin = crShape $ _crType cr -- this should be fixed
     rotmdir = rotateSH (_crMvDir cr - _crDir cr)
-    headq = neckq `Q.comp` (V3 16 0 0, Q.qz b )
+    headq = neckq `Q.comp` (V3 16 0 0, Q.qz b)
 
 crabCorpse :: StdGen -> Creature -> Shape
-crabCorpse g cr = mconcat
-    [ colorSH (_skinUpper cskin) $ overPosSH (Q.apply torsoq) (upperPrismPolyHalfMI 5 $ polyCirc 4 10 
-        & each . _x *~ 0.6) 
-    , colorSH (_skinUpper cskin) $ overPosSH (Q.apply lclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 20 0 (-2) 2)
-    <> overPosSH (Q.apply rclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 0 (-20) (-2) 2)
-    , colorSH (cskin ^?! skinLower) $
-        foldMap (mkfoot 5) (take 2 ps)
-        <> foldMap (mkfoot (-5)) (take 2 $ drop 2 ps)
-    , colorSH (_skinHead cskin)
-        (overPosSH (Q.apply headq) (upperPrismPolyHalfMI 1 $ square 2))
+crabCorpse g cr =
+    mconcat
+        [ colorSH (_skinUpper cskin) $
+            overPosSH
+                (Q.apply torsoq)
+                ( upperPrismPolyHalfMI 5 $
+                    polyCirc 4 10
+                        & each . _x *~ 0.6
+                )
+        , colorSH (_skinUpper cskin) $
+            overPosSH (Q.apply lclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 20 0 (-2) 2)
+                <> overPosSH (Q.apply rclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 0 (-20) (-2) 2)
+        , colorSH (cskin ^?! skinLower) $
+            foldMap (mkfoot 5) (take 2 ps)
+                <> foldMap (mkfoot (-5)) (take 2 $ drop 2 ps)
+        , colorSH
+            (_skinHead cskin)
+            (overPosSH (Q.apply headq) (upperPrismPolyHalfMI 1 $ square 2))
         ]
   where
     headq = torsoq `Q.comp` (V3 3 0 4, Q.qid)
-    torsoq = (V3 0 0 0,Q.qid)
+    torsoq = (V3 0 0 0, Q.qid)
     lclawq = torsoq `Q.comp` (V3 2 8 1, Q.axisAngle (V3 1 0 0) (-0.1) * Q.qz la)
-    (la,g') =  randomR (-2,2) g
-    ra = fst $ randomR (-2,2) g'
+    (la, g') = randomR (-2, 2) g
+    ra = fst $ randomR (-2, 2) g'
     ps = evalState (replicateM 4 (randInCirc 9)) g
-    mkfoot y p = 
-        let p' = 0 & _xy .~ p + V2 0 (3*y)
-            (q1,q2) = spiderJoint (V3 0 y 0) p'
-        in (afoot & each . sfVs . each %~ Q.apply (V3 0 y 0, q1))
-            <> (afoot & each . sfVs . each %~ Q.apply (p',q2))
+    mkfoot y p =
+        let p' = 0 & _xy .~ p + V2 0 (3 * y)
+            (q1, q2) = spiderJoint (V3 0 y 0) p'
+         in (afoot & each . sfVs . each %~ Q.apply (V3 0 y 0, q1))
+                <> (afoot & each . sfVs . each %~ Q.apply (p', q2))
     afoot = upperPrismPolyST 10 $ polyCirc 3 2
     rclawq = torsoq `Q.comp` (V3 2 (-8) 1, Q.axisAngle (V3 1 0 0) 0.1 * Q.qz ra)
     cskin = crShape $ _crType cr -- this should be fixed
@@ -361,8 +392,8 @@ arms cr =
     aHand = noPic $ translateSHz (-2) . upperPrismPolyHalfST 2 $ polyCirc 3 4
 
 deadScalp :: Creature -> Shape
---deadScalp cr = deadRot cr . translateSHz 5 . scalp $ cr
---deadScalp cr = deadRot cr . translateSHz (-5) . scalp $ cr
+-- deadScalp cr = deadRot cr . translateSHz 5 . scalp $ cr
+-- deadScalp cr = deadRot cr . translateSHz (-5) . scalp $ cr
 deadScalp _ = translateSH (V3 (-13) 0 0) scalp
 
 deadRot :: Creature -> Shape -> Shape
@@ -376,7 +407,8 @@ deadRot cr = overPosSH (Q.rotateToZ d)
 
 scalp :: Shape
 {-# INLINE scalp #-}
-scalp = (colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5)
+scalp =
+    (colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5)
         & each . sfShadowImportance .~ Unimportant
 
 torso :: Creature -> Shape
@@ -391,7 +423,7 @@ deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr
 
 baseShoulder :: Shape
 {-# INLINE baseShoulder #-}
---baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
+-- baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
 baseShoulder = scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
 
 upperBody :: Creature -> Shape
@@ -411,4 +443,3 @@ lampCrSPic :: Float -> SPic
 lampCrSPic h =
     colorSH blue (upperBox Small Undesired h $ rectWH 5 5)
         ST.:!: setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
-

src/Dodge/Creature/State.hs

@@ -44,7 +44,7 @@ import qualified SDL
 doDamage :: Int -> World -> World
 doDamage cid w = fromMaybe w $ do
     cr <- w ^? cWorld . lWorld . creatures . ix cid
-    return $ crPainEffect cr $ applyCreatureDamage (cr ^. crDamage) cr w
+    return $ crPainEffect cr $ applyCreatureDamage cid cr w
 
 -- TODO generalise shake to arbitrary damage amounts
 crPainEffect :: Creature -> World -> World

src/Dodge/Creature/Update.hs

@@ -2,7 +2,6 @@
 
 module Dodge.Creature.Update (updateCreature) where
 
---import Dodge.WorldEvent.ThingsHit
 import Dodge.Creature.Slime
 import Dodge.Creature.Radius
 import Dodge.Creature.MoveType
@@ -17,7 +16,6 @@ import qualified IntMapHelp as IM
 import Data.Maybe
 import Dodge.Barreloid
 import Dodge.Base.You
--- import Dodge.Base.NewID
 import Dodge.Creature.Action
 import Dodge.Creature.Picture
 import Dodge.Creature.State
@@ -50,15 +48,11 @@ updateCreature cr
     | cr ^. crPos . _z < negate 300 = (cWorld . lWorld . creatures . at (cr ^. crID) %~ destroyCreature) 
         . destroyAllInvItems cr
     | otherwise = case cr ^. crHP of
-        CrIsCorpse{} -> cleardamage . updateCarriage (_crID cr) . damageCorpse (_crID cr) cr
+        CrIsCorpse{} -> cleardamage . updateCarriage (_crID cr) . applyCreatureDamage (_crID cr) cr
         AvatarDestroyed{} -> id
         HP{} -> cleardamage . updateLivingCreature cr
   where
-    cleardamage = tocr . crDamage .~ mempty
-    tocr = cWorld . lWorld . creatures . ix (_crID cr)
-
-damageCorpse :: Int -> Creature -> World -> World
-damageCorpse _ cr w = w & applyCreatureDamage (cr ^. crDamage) cr
+    cleardamage = cWorld . lWorld . creatures . ix (cr^.crID) . crDamage .~ mempty
 
 updateLivingCreature :: Creature -> World -> World
 updateLivingCreature cr = case cr ^. crType of
@@ -108,7 +102,8 @@ updateHiveCrit cr cid w
 
 updateBeeFromPheremones :: Creature -> Int -> World -> World
 updateBeeFromPheremones cr cid w
-    | any f (w ^. cWorld . lWorld . beePheremones) = w & cWorld . lWorld . creatures . ix cid . crType . beeAggro .~ 300
+    | any f (w ^. cWorld . lWorld . beePheremones) = w 
+        & cWorld . lWorld . creatures . ix cid . crType . beeAggro .~ 300
     | otherwise = w
   where
     f bp = distance (cr ^. crPos . _xy) (bp ^. bpPos . _xy) < 20
@@ -196,14 +191,11 @@ updateCalmBee cr cid w
     | Just tid <- cr ^? crStance . carriage . mountID
     , Just SlimeCrit{} <- w ^? cWorld . lWorld . creatures . ix tid . crType = w
         & tocr . crType . beeSlime +~ sspeed
-        -- & cWorld . lWorld . creatures . ix tid . crType . slimeRad %~ (sqrt . subtract sspeed . (^(2::Int)))
         & cWorld . lWorld . creatures . ix tid . crType . slimeSlime -~ sspeed
     | Just (tcr,ti) <- gettarg
     , distance (cr ^. crPos . _xy) (tcr ^. crPos . _xy) < 0.8*crRad (tcr ^. crType) 
---    , Just r <- tcr ^? crType . slimeSlime . to slimeToRad
     , Just d <- tcr ^? crType . slimeCompression
         = w
---        & tocr . crStance . carriage .~ Mounted ti (cr ^. crPos - tcr ^. crPos & _xy %~ compressionScale (vNormal ((1/r) *^d)))
         & tocr . crStance . carriage .~ Mounted ti (cr ^. crPos - tcr ^. crPos & _x %~ (/d) & _y *~ d)
         & tocr . crActionPlan . apAction .~ NoAction
     | Just (tcr,_) <- gettarg = w
@@ -235,7 +227,6 @@ updateCalmBee cr cid w
         mcr <- w ^? cWorld . lWorld . creatures . ix mid
         SlimeCrit {_slimeSplitTimer = x} <- mcr ^? crType
         return $ isJust x
-    --sspeed = 0.05
     sspeed = 5
     gettarg = do
         i <- cr ^? crActionPlan . apStrategy . harvestTarget 
@@ -273,7 +264,6 @@ slimeCritUpdate cid w
         | otherwise = Nothing
     tocr = cWorld . lWorld . creatures . ix cid
     cr = w ^?! cWorld . lWorld . creatures . ix cid
---    v = 0.1 *^ normalize p 
     v = 0.1 *^ unitVectorAtAngle (cr ^. crDir)
     mvslime = cr & crType . slimeCompression +~ f (0.1/r)
         & crPos . _xy +~ v
@@ -294,14 +284,12 @@ setSlimeDir cid cr w = do
         then do
             x <- randInCirc 1
             return $ fromMaybe w $ splitSlimeCrit' (x + cxy) (unitVectorAtAngle d) cid cr w
---        else return $ w & tocr . crType . slimeCompression .~ r *^ unitVectorAtAngle d
         else return $ w & tocr . crDir .~ d
                 & tocr . crType . slimeIsCompressing .~ False
   where
     tocr = cWorld . lWorld . creatures . ix cid
     cxy = cr ^. crPos . _xy
     r = cr ^?! crType . slimeSlime . to slimeToRad
-    
 
 doSlimeRadChange :: Creature -> Creature
 doSlimeRadChange = crType . slimeSlimeChange %~ f
@@ -343,8 +331,6 @@ splitSlimeCrit p v cr = do
                 & crDir .~ argV (-mvdir)
         c1ps = qs' & each +~ cxy - (mp + r1 *^ mvdir) & each %~ rotateV (- c1 ^. crDir)
         c2ps = ps' & each +~ cxy - (mp - r2 *^ mvdir) & each %~ rotateV (- c2 ^. crDir)
-    --return (c1 & crType . slimeSplitTimer . _Just . _2 .~ polyInPoly (centroid c1ps) c1ps (slimeOutline c1)
-    --    ,c2 & crType . slimeSplitTimer . _Just . _2 .~ polyInPoly (centroid c2ps) c2ps (slimeOutline c2)
     return (c1 & crType . slimeSplitTimer . _Just . _2 .~ f c1ps c1
         ,c2 & crType . slimeSplitTimer . _Just . _2 .~ f c2ps c2
         )
@@ -360,7 +346,6 @@ splitSlimeCrit p v cr = do
         & crType . slimeCompression .~ 1 -- rotateV (argV mvdir) (V2 r1 0)
     (ps,qs) = cutPoly (p-cxy) (p+v-cxy) $ slimeOutline cr & each %~ rotateV (cr ^. crDir)
     
-
 -- h is the height of the segment, ie r - distance to center
 segmentArea :: Float -> Float -> Float
 segmentArea r h = r*r*acos(1-h/r) - (r-h)*sqrt(h*(2*r-h))
@@ -378,9 +363,6 @@ slinkCritUpdate cid w =
         . _2
         *~ Q.axisAngle (V3 0 1 0) (pi / 1000)
 
--- spineWalk :: [Point3Q]
--- spineWalk = replicate 15 (V3
-
 hoverCritHoverSound :: Creature -> World -> World
 hoverCritHoverSound cr w = fromMaybe w $ do
     guard $ d < 100
@@ -417,9 +399,7 @@ checkDeath cid w = maybe id checkDeath' (w ^? cWorld . lWorld . creatures . ix c
 checkDeath' :: Creature -> World -> World
 checkDeath' cr w = case cr ^. crHP of
     HP x | x > 0 -> w
-    HP x
-        | x > -200 && null (cr ^. crDeathTimer) ->
-            w & tocr %~ startDeathTimer
+    HP x | x > -200 && null (cr ^. crDeathTimer) -> w & tocr %~ startDeathTimer
     HP x
         | x > -200
         , Just y <- cr ^. crDeathTimer
@@ -501,11 +481,6 @@ poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)
 dropAll :: Creature -> World -> World
 dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys . _unNIntMap $ _crInv cr
 
--- startFalling :: Creature -> Creature
--- startFalling cr = case cr ^. crStance . carriage of
---    Walking -> cr & crStance . carriage .~ Falling
---    _ -> cr & crStance . carriage .~ Falling
-
 updatePulse :: Pulse -> Pulse
 updatePulse p
     | p ^. pulseProgress >= p ^. pulseRate = p & pulseProgress .~ 0

src/Dodge/Data/CamouflageStatus.hs

@@ -1,10 +0,0 @@
-{-# LANGUAGE StrictData #-}
-
-module Dodge.Data.CamouflageStatus where
-
-data CamouflageStatus
-    = FullyVisible
-    | Invisible
-    deriving (Eq, Ord, Enum, Show, Bounded, Read) --Generic, Flat)
-
---deriveJSON defaultOptions ''CamouflageStatus

src/Dodge/Data/Creature/Misc.hs

@@ -1,17 +1,13 @@
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Dodge.Data.Creature.Misc (
-    module Dodge.Data.Creature.Misc,
-    module Dodge.Data.CamouflageStatus,
-) where
+module Dodge.Data.Creature.Misc (module Dodge.Data.Creature.Misc) where
 
 import Dodge.Data.Creature.Stance
 import Color
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
-import Dodge.Data.CamouflageStatus
 import Dodge.Data.FloatFunction
 import Dodge.Data.Material
 import Geometry.Data

tags

@@ -2724,7 +2724,7 @@ argV	src/Geometry/Vector.hs	89;"	f
 armourChaseCrit	src/Dodge/Creature/ArmourChase.hs	34;"	f
 armouredChasers	src/Dodge/Room/Boss.hs	58;"	f
 armouredCorridor	src/Dodge/Room/RoadBlock.hs	20;"	f
-arms	src/Dodge/Creature/Picture.hs	348;"	f
+arms	src/Dodge/Creature/Picture.hs	354;"	f
 arrow	src/Picture/Composite.hs	19;"	f
 arrowPath	src/Picture/Composite.hs	8;"	f
 assignHotkey	src/Dodge/AssignHotkey.hs	9;"	f
@@ -2767,7 +2767,7 @@ bangS	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	890;"	f
 bangStick	src/Dodge/Item/Held/Stick.hs	15;"	f
 barPP	src/Dodge/Room/Foreground.hs	231;"	f
 barrel	src/Dodge/Creature/Inanimate.hs	17;"	f
-barrelShape	src/Dodge/Creature/Picture.hs	399;"	f
+barrelShape	src/Dodge/Creature/Picture.hs	405;"	f
 baseAMRShape	src/Dodge/Item/Draw/SPic.hs	411;"	f
 baseBlockPane	src/Dodge/Placement/Instance/Wall.hs	76;"	f
 baseCI	src/Dodge/Item/Grammar.hs	167;"	f
@@ -2776,14 +2776,14 @@ baseItemTriggerType	src/Dodge/BaseTriggerType.hs	21;"	f
 baseRifleShape	src/Dodge/Item/Draw/SPic.hs	325;"	f
 baseRodShape	src/Dodge/Item/Draw/SPic.hs	408;"	f
 baseSMGShape	src/Dodge/Item/Draw/SPic.hs	396;"	f
-baseShoulder	src/Dodge/Creature/Picture.hs	386;"	f
+baseShoulder	src/Dodge/Creature/Picture.hs	392;"	f
 baseStickShape	src/Dodge/Item/Draw/SPic.hs	302;"	f
 baseStickShapeX	src/Dodge/Item/Draw/SPic.hs	294;"	f
 baseStickSpread	src/Dodge/HeldUse.hs	346;"	f
 basicAttentionUpdate	src/Dodge/Creature/Perception.hs	138;"	f
 basicAwarenessUpdate	src/Dodge/Creature/Perception.hs	31;"	f
-basicCrPict	src/Dodge/Creature/Picture.hs	71;"	f
-basicCrShape	src/Dodge/Creature/Picture.hs	77;"	f
+basicCrPict	src/Dodge/Creature/Picture.hs	77;"	f
+basicCrShape	src/Dodge/Creature/Picture.hs	83;"	f
 basicItemDisplay	src/Dodge/Item/Display.hs	23;"	f
 basicMachineApplyDamage	src/Dodge/Machine/Damage.hs	6;"	f
 basicMuzFlare	src/Dodge/HeldUse.hs	731;"	f
@@ -2901,10 +2901,10 @@ changeSwapWith	src/Dodge/Inventory.hs	283;"	f
 charToTuple	src/Picture/Base.hs	312;"	f
 charToTupleGrad	src/Picture/Text.hs	18;"	f
 chartreuse	src/Color.hs	51;"	f
-chaseCorpse	src/Dodge/Creature/Picture.hs	297;"	f
+chaseCorpse	src/Dodge/Creature/Picture.hs	303;"	f
 chaseCrit	src/Dodge/Creature/ChaseCrit.hs	35;"	f
 chaseCritMv	src/Dodge/Creature/ReaderUpdate.hs	193;"	f
-chaseUpperBody	src/Dodge/Creature/Picture.hs	174;"	f
+chaseUpperBody	src/Dodge/Creature/Picture.hs	180;"	f
 chasmRotate	src/Dodge/Creature/State/WalkCycle.hs	148;"	f
 chasmSimpleMaze	src/Dodge/Room/Tutorial.hs	417;"	f
 chasmSpitTerminal	src/Dodge/Room/Tutorial.hs	348;"	f
@@ -2912,8 +2912,8 @@ chasmTestCliffPush	src/Dodge/Creature/State/WalkCycle.hs	125;"	f
 chasmWallToSurface	src/Dodge/Base/Collide.hs	133;"	f
 checkCombineSelectionExists	src/Dodge/DisplayInventory.hs	100;"	f
 checkConnection	src/Dodge/Inventory/Swap.hs	66;"	f
-checkDeath	src/Dodge/Creature/Update.hs	401;"	f
-checkDeath'	src/Dodge/Creature/Update.hs	404;"	f
+checkDeath	src/Dodge/Creature/Update.hs	411;"	f
+checkDeath'	src/Dodge/Creature/Update.hs	414;"	f
 checkEndGame	src/Dodge/Update.hs	890;"	f
 checkErrorGL	src/Shader/Compile.hs	86;"	f
 checkFBO	src/Framebuffer/Check.hs	6;"	f
@@ -3040,7 +3040,7 @@ copierItemUpdate	src/Dodge/Creature/State.hs	159;"	f
 copyItemToFloor	src/Dodge/FloorItem.hs	14;"	f
 corDoor	src/Dodge/Room/Room.hs	411;"	f
 cornerList	src/Preload/Render.hs	236;"	f
-corpseOrGib	src/Dodge/Creature/Update.hs	450;"	f
+corpseOrGib	src/Dodge/Creature/Update.hs	460;"	f
 corridor	src/Dodge/Room/Corridor.hs	17;"	f
 corridorBoss	src/Dodge/LockAndKey.hs	135;"	f
 corridorN	src/Dodge/Room/Corridor.hs	58;"	f
@@ -3048,11 +3048,11 @@ corridorWallN	src/Dodge/Room/Corridor.hs	77;"	f
 crAdd	src/Dodge/Room/RezBox.hs	116;"	f
 crAwayFromPost	src/Dodge/Creature/Test.hs	82;"	f
 crBlips	src/Dodge/RadarSweep.hs	88;"	f
-crCamouflage	src/Dodge/Creature/Picture.hs	74;"	f
+crCamouflage	src/Dodge/Creature/Picture.hs	80;"	f
 crCanSeeCr	src/Dodge/Creature/Test.hs	49;"	f
 crCrSpring	src/Dodge/Update.hs	1011;"	f
 crCurrentEquipment	src/Dodge/Creature/Statistics.hs	68;"	f
-crDeathEffects	src/Dodge/Creature/Update.hs	425;"	f
+crDeathEffects	src/Dodge/Creature/Update.hs	435;"	f
 crDeathSounds	src/Dodge/Creature/Vocalization.hs	40;"	f
 crDexterity	src/Dodge/Creature/Statistics.hs	19;"	f
 crDisplayAwareness	src/Dodge/Creature/Picture/Awareness.hs	39;"	f
@@ -3093,7 +3093,7 @@ crShape	src/Dodge/Creature/Shape.hs	8;"	f
 crSpring	src/Dodge/Update.hs	999;"	f
 crStratConMatches	src/Dodge/Creature/Test.hs	77;"	f
 crStrength	src/Dodge/Creature/Statistics.hs	30;"	f
-crUpdate	src/Dodge/Creature/Update.hs	394;"	f
+crUpdate	src/Dodge/Creature/Update.hs	404;"	f
 crUpdateInvidLocations	src/Dodge/Inventory/Location.hs	67;"	f
 crUpdateItemLocations	src/Dodge/Inventory/Location.hs	49;"	f
 crVocalResetTime	src/Dodge/Creature/Vocalization.hs	69;"	f
@@ -3104,12 +3104,12 @@ crWlPbHit	src/Dodge/WorldEvent/ThingsHit.hs	71;"	f
 crWlPbHitZ	src/Dodge/WorldEvent/ThingsHit.hs	81;"	f
 crZoneSize	src/Dodge/Zoning/Creature.hs	43;"	f
 crabActionUpdate	src/Dodge/Creature/ReaderUpdate.hs	123;"	f
-crabCorpse	src/Dodge/Creature/Picture.hs	316;"	f
+crabCorpse	src/Dodge/Creature/Picture.hs	322;"	f
 crabCrit	src/Dodge/Creature/ChaseCrit.hs	42;"	f
 crabCritInternal	src/Dodge/Humanoid.hs	25;"	f
-crabFeet	src/Dodge/Creature/Picture.hs	226;"	f
+crabFeet	src/Dodge/Creature/Picture.hs	232;"	f
 crabRoom	src/Dodge/Room/Tutorial.hs	471;"	f
-crabUpperBody	src/Dodge/Creature/Picture.hs	150;"	f
+crabUpperBody	src/Dodge/Creature/Picture.hs	156;"	f
 craftInfo	src/Dodge/Item/Info.hs	168;"	f
 craftItemSPic	src/Dodge/Item/Draw/SPic.hs	41;"	f
 crankSlowS	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	642;"	f
@@ -3211,10 +3211,10 @@ deZoneIX	src/Dodge/Zoning/Base.hs	91;"	f
 deZoneWall	src/Dodge/Zoning/Wall.hs	69;"	f
 deadEndPSType	src/Dodge/Room/Room.hs	264;"	f
 deadEndRoom	src/Dodge/Room/Room.hs	267;"	f
-deadFeet	src/Dodge/Creature/Picture.hs	344;"	f
-deadRot	src/Dodge/Creature/Picture.hs	362;"	f
-deadScalp	src/Dodge/Creature/Picture.hs	357;"	f
-deadUpperBody	src/Dodge/Creature/Picture.hs	383;"	f
+deadFeet	src/Dodge/Creature/Picture.hs	350;"	f
+deadRot	src/Dodge/Creature/Picture.hs	368;"	f
+deadScalp	src/Dodge/Creature/Picture.hs	363;"	f
+deadUpperBody	src/Dodge/Creature/Picture.hs	389;"	f
 debrisS	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	778;"	f
 debrisSPic	src/Dodge/Prop/Draw.hs	17;"	f
 debrisSize	src/Dodge/Block/Debris.hs	131;"	f
@@ -3430,14 +3430,14 @@ drawAllShadows	src/Dodge/Shadows.hs	5;"	f
 drawAnySelectionBox	src/Dodge/Render/Picture.hs	132;"	f
 drawArrowDown	src/Dodge/Render/Picture.hs	225;"	f
 drawBaseMachine	src/Dodge/Machine/Draw.hs	70;"	f
-drawBeeCrit	src/Dodge/Creature/Picture.hs	117;"	f
+drawBeeCrit	src/Dodge/Creature/Picture.hs	123;"	f
 drawBlip	src/Dodge/RadarBlip.hs	16;"	f
 drawBlock	src/Dodge/Render/ShapePicture.hs	81;"	f
 drawBoundingBox	src/Dodge/Debug/Picture.hs	368;"	f
 drawBullet	src/Dodge/Render/ShapePicture.hs	156;"	f
 drawButton	src/Dodge/Button/Draw.hs	11;"	f
 drawCPUShadows	src/Dodge/Render/Shadow.hs	19;"	f
-drawChaseCrit	src/Dodge/Creature/Picture.hs	141;"	f
+drawChaseCrit	src/Dodge/Creature/Picture.hs	147;"	f
 drawCircCollisionTest	src/Dodge/Debug/Picture.hs	118;"	f
 drawCliff	src/Dodge/Render/ShapePicture.hs	87;"	f
 drawCollisionTest	src/Dodge/Debug/Picture.hs	103;"	f
@@ -3448,7 +3448,7 @@ drawCoord	src/Dodge/Debug/Picture.hs	396;"	f
 drawCountMod	src/Render.hs	231;"	f
 drawCrInfo	src/Dodge/Debug.hs	230;"	f
 drawCrInfo'	src/Dodge/Debug.hs	225;"	f
-drawCrabCrit	src/Dodge/Creature/Picture.hs	133;"	f
+drawCrabCrit	src/Dodge/Creature/Picture.hs	139;"	f
 drawCreature	src/Dodge/Creature/Picture.hs	38;"	f
 drawCreatureDisplayTexts	src/Dodge/Debug/Picture.hs	199;"	f
 drawCreatureRad	src/Dodge/Debug.hs	314;"	f
@@ -3468,7 +3468,7 @@ drawDragSelecting	src/Dodge/Render/HUD.hs	162;"	f
 drawDumbSwitch	src/Dodge/Button/Draw.hs	31;"	f
 drawEmptySet	src/Dodge/Render/Picture.hs	153;"	f
 drawEnergyBall	src/Dodge/EnergyBall/Draw.hs	7;"	f
-drawEquipment	src/Dodge/Creature/Picture.hs	395;"	f
+drawEquipment	src/Dodge/Creature/Picture.hs	401;"	f
 drawExamineInventory	src/Dodge/Render/HUD.hs	199;"	f
 drawExplosiveBall	src/Dodge/EnergyBall/Draw.hs	15;"	f
 drawFarWallDetect	src/Dodge/Debug/Picture.hs	271;"	f
@@ -3478,8 +3478,8 @@ drawForceField	src/Dodge/Wall/Draw.hs	15;"	f
 drawGapPlus	src/Dodge/Render/Picture.hs	284;"	f
 drawGib	src/Dodge/Prop/Draw.hs	31;"	f
 drawHUD	src/Dodge/Render/HUD.hs	53;"	f
-drawHive	src/Dodge/Creature/Picture.hs	114;"	f
-drawHoverCrit	src/Dodge/Creature/Picture.hs	104;"	f
+drawHive	src/Dodge/Creature/Picture.hs	120;"	f
+drawHoverCrit	src/Dodge/Creature/Picture.hs	110;"	f
 drawInputMenu	src/Dodge/Render/MenuScreen.hs	33;"	f
 drawInspectWall	src/Dodge/Debug/Picture.hs	256;"	f
 drawInspectWalls	src/Dodge/Debug/Picture.hs	244;"	f
@@ -3533,7 +3533,7 @@ drawShadowsByImportance	src/Dodge/Shadows.hs	8;"	f
 drawShell	src/Dodge/Projectile/Draw.hs	22;"	f
 drawShockwave	src/Dodge/Shockwave/Draw.hs	6;"	f
 drawSlimeCrit	src/Dodge/Creature/Picture.hs	60;"	f
-drawSlinkCrit	src/Dodge/Creature/Picture.hs	92;"	f
+drawSlinkCrit	src/Dodge/Creature/Picture.hs	98;"	f
 drawSpark	src/Dodge/Spark/Draw.hs	7;"	f
 drawStaticBall	src/Dodge/EnergyBall/Draw.hs	28;"	f
 drawSubInventory	src/Dodge/Render/HUD.hs	173;"	f
@@ -3561,7 +3561,7 @@ drawZone	src/Dodge/Debug/Picture.hs	152;"	f
 drawZoneCirc	src/Dodge/Debug/Picture.hs	293;"	f
 drawZoneCol	src/Dodge/Debug/Picture.hs	149;"	f
 drawZoneNearPointCursor	src/Dodge/Debug/Picture.hs	286;"	f
-dropAll	src/Dodge/Creature/Update.hs	488;"	f
+dropAll	src/Dodge/Creature/Update.hs	498;"	f
 dropInventoryPath	src/Dodge/HeldUse.hs	1380;"	f
 dropItem	src/Dodge/Creature/Action.hs	180;"	f
 dropper	src/Dodge/Item/Scope.hs	82;"	f
@@ -3652,7 +3652,7 @@ facesToVF	src/Polyhedra/Geodesic.hs	70;"	f
 farWallDistDirection	src/Dodge/Update/Camera.hs	245;"	f
 fdiv	src/ShortShow.hs	41;"	f
 feedSlime	src/Dodge/Update.hs	1082;"	f
-feet	src/Dodge/Creature/Picture.hs	212;"	f
+feet	src/Dodge/Creature/Picture.hs	218;"	f
 filter3	src/FoldableHelp.hs	76;"	f
 filterSectionsPair	src/Dodge/DisplayInventory.hs	160;"	f
 findBlips	src/Dodge/RadarSweep.hs	63;"	f
@@ -3908,7 +3908,7 @@ hotkeyToChar	src/Dodge/Inventory/SelectionList.hs	201;"	f
 hotkeyToScancode	src/Dodge/Creature/YourControl.hs	62;"	f
 hotkeyToString	src/Dodge/Inventory/SelectionList.hs	198;"	f
 hoverCrit	src/Dodge/Creature/ChaseCrit.hs	81;"	f
-hoverCritHoverSound	src/Dodge/Creature/Update.hs	371;"	f
+hoverCritHoverSound	src/Dodge/Creature/Update.hs	381;"	f
 hoverCritMv	src/Dodge/Creature/ReaderUpdate.hs	228;"	f
 hoverDeathSounds	src/Dodge/Creature/Vocalization.hs	62;"	f
 hoverPainEffect	src/Dodge/Creature/State.hs	57;"	f
@@ -4114,7 +4114,7 @@ lConnectCol	src/Dodge/Render/Connectors.hs	46;"	f
 lConnectMulti	src/Dodge/Render/Connectors.hs	51;"	f
 lShape	src/Dodge/Placement/Instance/LightSource.hs	61;"	f
 lamp	src/Dodge/Creature/Lamp.hs	18;"	f
-lampCrSPic	src/Dodge/Creature/Picture.hs	404;"	f
+lampCrSPic	src/Dodge/Creature/Picture.hs	410;"	f
 lasCenRunClose'	src/Dodge/Room/LasTurret.hs	308;"	f
 lasCenRunClose1	src/Dodge/Room/LasTurret.hs	397;"	f
 lasCenRunClose2	src/Dodge/Room/LasTurret.hs	470;"	f
@@ -4241,7 +4241,7 @@ makeButton	src/Dodge/LevelGen/Switch.hs	16;"	f
 makeCloudAt	src/Dodge/WorldEvent/Cloud.hs	7;"	f
 makeColorTermLine	src/Dodge/Terminal.hs	124;"	f
 makeColorTermPara	src/Dodge/Terminal.hs	121;"	f
-makeCorpse	src/Dodge/Creature/Picture.hs	278;"	f
+makeCorpse	src/Dodge/Creature/Picture.hs	284;"	f
 makeCrGibs	src/Dodge/Prop/Gib.hs	19;"	f
 makeDebris	src/Dodge/Block/Debris.hs	75;"	f
 makeDebrisDirected	src/Dodge/Block/Debris.hs	101;"	f
@@ -4490,7 +4490,7 @@ oldMachineBootS	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	684;"	f
 onEquipWristShield	src/Dodge/Euse.hs	89;"	f
 onRemoveWristShield	src/Dodge/Euse.hs	79;"	f
 oneH	src/Dodge/Creature/Test.hs	91;"	f
-oneSmooth	src/Dodge/Creature/Picture.hs	209;"	f
+oneSmooth	src/Dodge/Creature/Picture.hs	215;"	f
 openConsole	src/Dodge/Update.hs	140;"	f
 optionMenu	src/Dodge/Menu.hs	110;"	f
 optionScreenDefaultEffect	src/Dodge/Update/Input/ScreenLayer.hs	62;"	f
@@ -4611,7 +4611,7 @@ pointerToItemID	src/Dodge/Item/Location.hs	42;"	f
 pointerYourRootItem	src/Dodge/Item/Location.hs	33;"	f
 pointerYourSelectedItem	src/Dodge/Item/Location.hs	26;"	f
 pointsToPoly	src/Geometry/ConvexPoly.hs	37;"	f
-poisonSPic	src/Dodge/Creature/Update.hs	484;"	f
+poisonSPic	src/Dodge/Creature/Update.hs	494;"	f
 poisonSprayer	src/Dodge/Item/Held/SprayGuns.hs	17;"	f
 poke34	src/Shader/Poke.hs	518;"	f
 pokeArrayOff	src/Shader/Poke.hs	530;"	f
@@ -4980,14 +4980,14 @@ sawtoothFailS	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	852;"	f
 scToTS	src/Dodge/Event/Input.hs	34;"	f
 scale	src/Picture/Base.hs	141;"	f
 scale3	src/Picture/Base.hs	137;"	f
-scaleAlong	src/Dodge/Creature/Picture.hs	67;"	f
+scaleAlong	src/Dodge/Creature/Picture.hs	73;"	f
 scaleMat	src/MatrixHelper.hs	71;"	f
 scaleMatrix	src/MatrixHelper.hs	68;"	f
 scaleSH	src/Shape.hs	271;"	f
-scalp	src/Dodge/Creature/Picture.hs	371;"	f
+scalp	src/Dodge/Creature/Picture.hs	377;"	f
 scancodeToHotkey	src/Dodge/Creature/YourControl.hs	82;"	f
 scodeToChar	src/Dodge/ScodeToChar.hs	6;"	f
-scorchSPic	src/Dodge/Creature/Update.hs	481;"	f
+scorchSPic	src/Dodge/Creature/Update.hs	491;"	f
 screenBox	src/Dodge/Base/Window.hs	54;"	f
 screenPolygon	src/Dodge/Base/Window.hs	18;"	f
 screenPolygonBord	src/Dodge/Base/Window.hs	28;"	f
@@ -5015,7 +5015,7 @@ sectionsSizes	src/Dodge/DisplayInventory.hs	205;"	f
 seedStartMenu	src/Dodge/Menu.hs	85;"	f
 seedStartOptions	src/Dodge/Menu.hs	88;"	f
 segOnCirc	src/Geometry.hs	113;"	f
-segmentArea	src/Dodge/Creature/Update.hs	352;"	f
+segmentArea	src/Dodge/Creature/Update.hs	362;"	f
 selNumPos	src/Dodge/Render/HUD.hs	475;"	f
 selNumPosCardinal	src/Dodge/Render/HUD.hs	492;"	f
 selSecDrawCursor	src/Dodge/Render/List.hs	101;"	f
@@ -5187,11 +5187,11 @@ slimeCrit	src/Dodge/Creature/ChaseCrit.hs	68;"	f
 slimeCritUpdate	src/Dodge/Creature/Update.hs	253;"	f
 slimeEatSound	src/Dodge/Update.hs	1116;"	f
 slimeFood	src/Dodge/Update.hs	1074;"	f
-slimeOutline	src/Dodge/Creature/Slime.hs	11;"	f
+slimeOutline	src/Dodge/Creature/Slime.hs	9;"	f
 slimeSuck	src/Dodge/Update.hs	1058;"	f
 slimeToRad	src/Dodge/Data/Creature/Misc.hs	109;"	f
 slinkCrit	src/Dodge/Creature/ChaseCrit.hs	56;"	f
-slinkCritUpdate	src/Dodge/Creature/Update.hs	355;"	f
+slinkCritUpdate	src/Dodge/Creature/Update.hs	365;"	f
 slowCrush90	src/Dodge/Room/LongDoor.hs	263;"	f
 slowCrushRoom	src/Dodge/Room/LongDoor.hs	148;"	f
 slowDoorRoom	src/Dodge/Room/LongDoor.hs	309;"	f
@@ -5251,7 +5251,7 @@ spawnAt	src/Dodge/SpawnAt.hs	14;"	f
 spawnerCrit	src/Dodge/Creature.hs	47;"	f
 spawnerRoom	src/Dodge/Room/Room.hs	390;"	f
 speedLegs	src/Dodge/Item/Equipment.hs	74;"	f
-spiderJoint	src/Dodge/Creature/Picture.hs	260;"	f
+spiderJoint	src/Dodge/Creature/Picture.hs	266;"	f
 splashMenu	src/Dodge/Menu.hs	31;"	f
 splashMenuOptions	src/Dodge/Menu.hs	36;"	f
 splashScreen	src/Dodge/Initialisation.hs	10;"	f
@@ -5297,7 +5297,7 @@ stackText	src/Picture/Base.hs	180;"	f
 stackedInventory	src/Dodge/Creature.hs	318;"	f
 startCr	src/Dodge/Creature.hs	83;"	f
 startCrafts	src/Dodge/Room/Start.hs	94;"	f
-startDeathTimer	src/Dodge/Creature/Update.hs	437;"	f
+startDeathTimer	src/Dodge/Creature/Update.hs	447;"	f
 startDrag	src/Dodge/Update/Input/InGame.hs	319;"	f
 startInvList	src/Dodge/Creature.hs	97;"	f
 startInventory	src/Dodge/Creature.hs	100;"	f
@@ -5449,7 +5449,7 @@ toBinary	src/Dodge/Inventory/SelectionList.hs	154;"	f
 toBothLnk	src/Dodge/RoomLink.hs	136;"	f
 toClosestMultiple	src/HelpNum.hs	3;"	f
 toColor8	src/Color.hs	158;"	f
-toDeathCarriage	src/Dodge/Creature/Update.hs	443;"	f
+toDeathCarriage	src/Dodge/Creature/Update.hs	453;"	f
 toFloatVAs	src/Shader/Compile.hs	66;"	f
 toLabel	src/Dodge/Cleat.hs	16;"	f
 toMultiset	src/Multiset.hs	64;"	f
@@ -5477,7 +5477,7 @@ topTestPart	src/Dodge/TestString.hs	122;"	f
 torchShape	src/Dodge/Item/Draw/SPic.hs	278;"	f
 torqueAmount	src/Dodge/HeldUse.hs	606;"	f
 torqueCr	src/Dodge/WorldEffect.hs	85;"	f
-torso	src/Dodge/Creature/Picture.hs	376;"	f
+torso	src/Dodge/Creature/Picture.hs	382;"	f
 tractCr	src/Dodge/TractorBeam/Update.hs	28;"	f
 tractFlIt	src/Dodge/TractorBeam/Update.hs	23;"	f
 tractorBeamAt	src/Dodge/HeldUse.hs	851;"	f
@@ -5608,7 +5608,7 @@ updateCloud	src/Dodge/Update.hs	919;"	f
 updateClouds	src/Dodge/Update.hs	783;"	f
 updateCombinePositioning	src/Dodge/DisplayInventory.hs	40;"	f
 updateCombineSections	src/Dodge/DisplayInventory.hs	47;"	f
-updateCreature	src/Dodge/Creature/Update.hs	47;"	f
+updateCreature	src/Dodge/Creature/Update.hs	48;"	f
 updateCreatureGroups	src/Dodge/Update.hs	644;"	f
 updateCreatureSoundPositions	src/Dodge/Update.hs	623;"	f
 updateCreatureStride	src/Dodge/Update.hs	379;"	f
@@ -5675,7 +5675,7 @@ updatePlasmaBall	src/Dodge/Update.hs	530;"	f
 updatePlasmaBalls	src/Dodge/Update.hs	679;"	f
 updatePreload	src/Preload/Update.hs	21;"	f
 updateProjectile	src/Dodge/Projectile/Update.hs	26;"	f
-updatePulse	src/Dodge/Creature/Update.hs	496;"	f
+updatePulse	src/Dodge/Creature/Update.hs	506;"	f
 updatePulseBall	src/Dodge/Update.hs	550;"	f
 updatePulseLaser	src/Dodge/Update.hs	726;"	f
 updatePulseLasers	src/Dodge/Update.hs	525;"	f
@@ -5717,7 +5717,7 @@ updateWheelEvent	src/Dodge/Update/Scroll.hs	21;"	f
 updateWheelEvents	src/Dodge/Update.hs	495;"	f
 updateWorldEventFlag	src/Dodge/Update.hs	129;"	f
 updateWorldEventFlags	src/Dodge/Update.hs	117;"	f
-upperBody	src/Dodge/Creature/Picture.hs	391;"	f
+upperBody	src/Dodge/Creature/Picture.hs	397;"	f
 upperBox	src/Shape.hs	149;"	f
 upperBoxHalf	src/Shape.hs	224;"	f
 upperBoxMT	src/Shape.hs	140;"	f