Cleanup

Hack to prevent slime split error
Smooth out slime splitting
2026-05-09 09:05:42 +01:00 · 2026-05-09 00:13:56 +01:00 · 2026-05-08 23:44:28 +01:00 · 2026-05-08 10:50:36 +01:00 · 2026-05-08 10:45:05 +01:00 · 2026-05-08 10:10:06 +01:00
74 changed files with 1767 additions and 1494 deletions
@@ -29,8 +29,8 @@ updateExpBarrel ps cr w = case cr ^. crHP of
            & flip (foldl' f) ps
    HP _ ->
        w
-            & makeExplosionAt ((cr ^. crPos) & _z +~ 20) 0
-            & cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrDestroyed Gibbed
+            & makeExplosionAt (CrIndirectO (cr ^. crID)) ((cr ^. crPos) & _z +~ 20) 0
+            & cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
    _ -> w
  where
    f w' p = makeSpark NormalSpark (p + normalizeV p + cr ^. crPos . _xy) (argV p) w'
@@ -43,7 +43,7 @@ updateExpBarrel ps cr w = case cr ^. crHP of
 updateBarrel :: Creature -> World -> World
 updateBarrel cr = case cr ^. crHP of
    HP x | x > 0 -> doDamage (cr ^. crID)
-    HP _ -> cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrDestroyed Gibbed
+    HP _ -> cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
    _ -> id

 damsToExpBarrel :: [Damage] -> Creature -> Creature
@@ -51,7 +51,7 @@ damsToExpBarrel = flip $ foldl' damToExpBarrel

 damToExpBarrel :: Creature -> Damage -> Creature
 damToExpBarrel cr dm = case dm of
-    Piercing x p _ ->
+    Piercing x p _ _ ->
        cr & crHP . _HP -~ div x 200
            & crType . barrelType . piercedPoints .:~ (p - cr ^. crPos . _xy)
    Poison{} -> cr
@@ -36,6 +36,7 @@ module Dodge.Base.Collide (
    crHeight,
 ) where

+import AesonHelp
 import Control.Applicative
 import Data.Foldable
 import qualified Data.IntMap.Strict as IM
@@ -192,12 +193,13 @@ crHeight cr = case cr ^. crHP of
        Avatar {} -> 25
        CrabCrit {} -> 25
        SlinkCrit {} -> 25
-        SlimeCrit {_slimeRad = r} -> min 15 r
+        SlimeCrit {_slimeSlime = r} -> min 15 $ slimeToRad r
        BeeCrit {} -> 10
        HiveCrit {} -> 25
-        _ -> error "Need to define crHeight for this crType"
+        BarrelCrit{} -> 20
+        _ -> error $ "Need to define crHeight for this crType:\n" <> unlines (prettyShort (cr ^. crType))
    CrIsCorpse{} -> Just 5
-    CrDestroyed{} -> Nothing
+    AvatarDestroyed{} -> Nothing

 wallToSurface :: Wall -> (Point3, Point3, [(Point3, Point3)])
 wallToSurface wl = (g x, g $ vNormal (x - y), [(g x, g (y - x)), (g y, g (x - y))])
@@ -119,15 +119,17 @@ useBulletPayload bu = case _buPayload bu of
    BulPlain _ -> const id
    BulFlak -> makeFlak bu
    BulFrag -> makeFragBullets
-    BulGas -> (`makeGasCloud` V2 0 0)
-    BulBall ExplosiveBall -> makeMovingEB (_buVel bu) ExplosiveBall
+    BulGas -> (\p -> makeGasCloud o p (V2 0 0))
+    BulBall eb@ExplosiveBall{} -> makeMovingEB (_buVel bu) eb o
    BulBall ElectricalBall{} ->
        makeMovingEB
            (_buVel bu)
-            (ElectricalBall (round $ bu ^. buPos . _1))
-    BulBall FlashBall -> makeMovingEB (_buVel bu) FlashBall
-    BulBall (FlameletBall x) -> makeMovingEB (_buVel bu) (FlameletBall x)
-    BulBall IncendiaryBall -> makeMovingEB (_buVel bu) IncendiaryBall
+            (ElectricalBall (round $ bu ^. buPos . _1)) o
+    BulBall eb@FlashBall{} -> makeMovingEB (_buVel bu) eb o
+    BulBall eb@FlameletBall{} -> makeMovingEB (_buVel bu) eb o
+    BulBall eb@IncendiaryBall{} -> makeMovingEB (_buVel bu) eb o
+  where
+    o = bu ^. buOrigin

 makeFragBullets :: Point2 -> World -> World
 makeFragBullets p w = w & cWorld . lWorld . bullets .++~ bus
@@ -172,8 +174,8 @@ hitEffFromBul w bu = case _buEffect bu of

 getBulHitDams :: Bullet -> Point2 -> [Damage]
 getBulHitDams bu p = case _buPayload bu of
-    BulPlain x -> [Piercing x p v
-        ,Inertial 0 p v]
+    BulPlain x -> [Piercing x p v (bu ^. buOrigin)
+        ,Inertial 0 p v (bu ^. buOrigin)]
    _ -> []
  where
    v = _buVel bu
@@ -12,7 +12,6 @@ module Dodge.Creature (
    module Dodge.Creature.Perception,
    module Dodge.Creature.ReaderUpdate,
    module Dodge.Creature.State,
-    module Dodge.Creature.Strategy,
    module Dodge.Creature.Test,
    module Dodge.Creature.Volition,
    module Dodge.Creature.YourControl,
@@ -35,7 +34,6 @@ import Dodge.Creature.Perception
 import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.SpreadGunCrit
 import Dodge.Creature.State
-import Dodge.Creature.Strategy
 import Dodge.Creature.Test
 import Dodge.Creature.Volition
 import Dodge.Creature.YourControl
@@ -84,7 +84,7 @@ performAction cr w ac = case ac of
 --    DoActions acs ->
 --        let (imps, newAcs) = foldMap (performAction cr w) acs
 --         in (imps, newAcs)
-    StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], NoAction)
+--    StartSentinelPost -> ([AddGoal $ SentinelAt (cr ^. crPos . _xy) (_crDir cr)], NoAction)
    PathTo p a -> performPathTo a cr w p
    EvadeAim -> tryEvadeSideways cr w
    TurnToPoint p -> performTurnToA cr p
@@ -92,8 +92,8 @@ performAction cr w ac = case ac of
        i <- cr ^? crIntention . targetCr . _Just
        tcr <- w ^? cWorld . lWorld . creatures . ix i
        return ([TurnTo (tcr ^. crPos . _xy +.+ rotateV (_crDir tcr) p)], NoAction)
-    UseSelf f -> performAction cr w $ doCrAc f cr
-    ArbitraryAction f -> performAction cr w (doCrWdAc f cr w)
+--    UseSelf f -> performAction cr w $ doCrAc f cr
+--    ArbitraryAction f -> performAction cr w (doCrWdAc f cr w)
    DoImpulsesAlongside sideImp mainAc -> performAction cr w mainAc & _1 <>~ sideImp
    DoReplicate t nxtac -> performAction cr w $ DoReplicatePartial nxtac t nxtac
    DoReplicatePartial _ 0 pac -> performAction cr w pac
@@ -147,6 +147,8 @@ crMoveImpulses cr p = case crMvType cr of
    MvWalking {} -> [MvTurnToward p, MvForward]
    JitMvType {_mvTurnJit = x} -> [MvTurnToward p, MvForward, RandomTurn x]
    StartStopMvType {} -> [MvTurnToward p, MvForward]
+    BeeMvType {} | cr ^?! crType . startStopMv == 0 -> [SetBeeRandomMovement, MvForward, MvTurnToward p]
+    BeeMvType {} -> [MvTurnToward p, MvForward]

 performTurnToA :: Creature -> Point2 -> ActionUpdate
 performTurnToA cr p
@@ -29,7 +29,7 @@ blinkActionMousePos cr w =
        & blinkDistortions cpos p3
        & cWorld . lWorld . creatures . ix cid . crPos . _xy .~ p3
        & blinkShockwave cid p3
-        & inverseShockwaveAt (cpos `v2z` 20) 40 2 2
+        & inverseShockwaveAt (cpos `v2z` 20) 40 2 2 (CrIndirectO cid)
  where
    cid = _crID cr
    p1 = w ^. cWorld . lWorld . lAimPos
@@ -63,11 +63,11 @@ unsafeBlinkAction cr w
            . blinkDistortions cpos mwp
            . set (cWorld . lWorld . creatures . ix cid . crPos . _xy) mwp
            . blinkShockwave cid mwp
-            $ inverseShockwaveAt (cpos `v2z` 20) 40 2 2 w
+            $ inverseShockwaveAt (cpos `v2z` 20) 40 2 2 (CrIndirectO cid) w 
    | otherwise =
        w
            & blinkActionFail cr
-            & cWorld . lWorld . creatures . ix cid . crDamage .:~ Enterrement 100000000
+            & cWorld . lWorld . creatures . ix cid . crDamage .:~ Enterrement 100000000 (CrIndirectO cid)
  where
    success = fromMaybe True $ do
        wl <- snd $ collidePointWallsFilter (const True) mwp cpos w
@@ -82,7 +82,7 @@ blinkShockwave ::
    Point2 ->
    World ->
    World
-blinkShockwave i p = makeShockwaveAt [i] (p `v2z` 20) 60 1 2 cyan
+blinkShockwave i p = makeShockwaveAt [i] (p `v2z` 20) 60 1 2 cyan (CrIndirectO i)

 -- | Like a blink action, but no ingoing distortion
 blinkActionFail :: Creature -> World -> World
@@ -91,7 +91,7 @@ blinkActionFail cr w =
        & soundMultiFrom [TeleSound 0, TeleSound 1] p3 teleS Nothing
 --        & cWorld . lWorld . distortions .:~ distortionBulge
        & cWorld . lWorld . creatures . ix cid . crPos . _xy .~ p3
-        & inverseShockwaveAt (cpos `v2z` 20) 40 2 2
+        & inverseShockwaveAt (cpos `v2z` 20) 40 2 2 (CrIndirectO cid)
  where
 --    distR = 120
 --    distortionBulge = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
@@ -24,7 +24,7 @@ flockArmourChaseCrit =
            ActionPlan
                { _apAction = NoAction
                , _apStrategy = FollowImpulses
-                , _apGoal = [Kill 0]
+                , _apGoal = Kill 0
                }
        , _crGroup = ShieldGroup
 --        , _crMvType = defaultChaseMvType
@@ -69,13 +69,14 @@ slimeCrit :: Creature
 slimeCrit = defaultCreature
        & crName .~ "slimeCrit"
        & crHP .~ HP 1000
-        & crType .~ SlimeCrit r 0 0 (V2 r 0) False 0
+--        & crType .~ SlimeCrit r 0 0 (V2 (slimeToRad r) 0) False 0
+        & crType .~ SlimeCrit r 0 Nothing 1 False 0
        & crFaction .~ ColorFaction (light green)
        & crPerception . cpVision . viFOV .~ FloatFOV pi
        & crActionPlan .~ SlimeIntelligence
        & crStance . carriage .~ Crawling
  where
-    r = 50
+    r = 250000

 hoverCrit :: Creature
 hoverCrit =
@@ -91,7 +92,7 @@ beeCrit =
    defaultCreature
        & crName .~ "beeCrit"
        & crHP .~ HP 100
-        & crType .~ BeeCrit 0 Nothing 0 0
+        & crType .~ BeeCrit 0 Nothing 0 0 0 Nothing 1
        & crFaction .~ ColorFaction yellow
        & crStance . carriage .~ Flying 15

@@ -100,6 +101,6 @@ hiveCrit =
    defaultCreature
        & crName .~ "hiveCrit"
        & crHP .~ HP 100000
-        & crType .~ HiveCrit mempty 0
+        & crType .~ HiveCrit mempty 0 400
        & crStance . carriage .~ Rooted
        & crFaction .~ ColorFaction yellow
@@ -12,32 +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
--  case dm of
--    Piercing{} -> applyPiercingDamage cr dm w
--    _ -> w & damageHP cr (_dmAmount dm)
+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

--applyPiercingDamage :: Creature -> Damage -> World -> World
--applyPiercingDamage cr dm w
--    | crIsArmouredFrom (w ^. cWorld . lWorld . items) p cr 
--        = f . makeSpark NormalSpark p1 (argV (p1 - p)) $ w
--    | otherwise = f . damageHP cr (_dmAmount dm) $ w
--  where
--    f = cWorld . lWorld . creatures . ix (_crID cr) . crPos . _xy +~ _dmVector dm
--            / V2 x x
--    x = crMass (_crType cr)
--    p = _dmPos dm
--    p1 = p + 2 *.* squashNormalizeV (p - cr ^. crPos . _xy)
-
-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)
@@ -3,8 +3,9 @@

 module Dodge.Creature.Impulse (followImpulse) where

+import RandomHelp
 import Control.Applicative
-import Control.Monad.Trans.State.Lazy
+--import Control.Monad.Trans.State.Lazy
 --import Control.Monad.State -- moving from mtl to transformers
 import Data.Maybe
 import Dodge.Creature.Impulse.Movement
@@ -19,12 +20,12 @@ import Dodge.SoundLogic
 import Geometry
 import LensHelp
 import Linear
-import System.Random
+--import System.Random

 -- note SwitchToItem doesn't necessarily update the root item correctly
 followImpulse :: Int -> World -> Impulse -> World
 followImpulse cid w = \case
-    UpdateRandGen -> w & randGen %~ (snd . (randomR (0::Int,0)))
+    UpdateRandGen -> w & randGen %~ (snd . randomR (0::Int,1))
    ImpulseNothing -> w
    RandomImpulse rimp ->
        let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w)
@@ -42,11 +43,8 @@ followImpulse cid w = \case
    ChangePosture post -> crup $ crStance . posture .~ post
    UseItem -> undefined
 --    SwitchToItem i -> crup $ crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
-    Melee cid' ->
-        hitCr cid' $
-            crup
-                ( crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) . (crType . meleeCooldown .~ 20)
-                )
+    Melee tid ->
+        hitCr tid $ crup $ meleeMovement w tid . (crType . meleeCooldown .~ 20)
    MeleeL cid' ->
        hitCrd (-pi/2) cid' $
            crup
@@ -66,7 +64,7 @@ followImpulse cid w = \case
    MakeSound sid -> soundStart (CrSound (_crID cr)) (cr ^. crPos . _xy) sid Nothing w
    DropItem -> undefined
    ChangeStrategy strat -> crup $ crActionPlan . apStrategy .~ strat
-    AddGoal gl -> crup $ crActionPlan . apGoal .:~ gl
+--    AddGoal gl -> crup $ crActionPlan . apGoal .:~ gl
    ImpulseUseTarget f -> fromMaybe w $ do
        i <- cr ^? crIntention . targetCr . _Just
        tcr <- w ^? cWorld . lWorld . creatures . ix i
@@ -74,7 +72,8 @@ followImpulse cid w = \case
    MvForward -> crup $ crMvForward' (w ^. cWorld . lWorld)
    MvTurnToward p ->
        crup $
-            creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir))
+            mvTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir))
+    SetBeeRandomMovement -> w & setBeeRandomMovement cid
  where
    clens = cWorld . lWorld . creatures . ix cid
    cr = w ^?! cWorld . lWorld . creatures . ix cid
@@ -91,9 +90,30 @@ followImpulse cid w = \case
    rr a = randomR (- a, a) $ _randGen w
    hitCr i =
        cWorld . lWorld . creatures . ix i . crDamage
-            .:~ Blunt 100 (posFromID i) (posFromID i - cpos)
+            .:~ Blunt 100 (posFromID i) (posFromID i - cpos) (CrMeleeO cid)
    hitCrd a i =
        cWorld . lWorld . creatures . ix i . crDamage
-            <>~ [Blunt 100 (posFromID i) (posFromID i - cpos)
-                , Inertial 0 (posFromID i) (50 * unitVectorAtAngle (cr ^. crDir + a))
+            <>~ [Blunt 100 (posFromID i) (posFromID i - cpos) (CrMeleeO cid)
+                , Inertial 0 (posFromID i) (50 * unitVectorAtAngle (cr ^. crDir + a)) (CrMeleeO cid)
                ]
+
+meleeMovement :: World -> Int -> Creature -> Creature
+meleeMovement w tid cr = case cr ^. crType of
+    HoverCrit {} -> fromMaybe cr $ do
+        txy <- w ^? cWorld . lWorld . creatures . ix tid . crPos . _xy
+        return $ crMvAbsolute (w ^. cWorld . lWorld) (5 *^ normalizeV (cr ^. crPos . _xy - txy)) cr
+    ChaseCrit {} -> fromMaybe cr $ do
+        txy <- w ^? cWorld . lWorld . creatures . ix tid . crPos . _xy
+        return $ crMvAbsolute (w ^. cWorld . lWorld) (5 *^ normalizeV (txy - cr ^. crPos . _xy)) cr
+    _ -> cr
+
+setBeeRandomMovement :: Int -> World -> World
+setBeeRandomMovement cid w = fromMaybe w $ do
+    mff <- w ^? cWorld . lWorld . creatures . ix cid . crType . beeRandomMovement
+    return $ case mff of
+        Just _ -> w & cWorld . lWorld . creatures . ix cid . crType . beeRandomMovement .~ Nothing
+        Nothing -> w & cWorld . lWorld . creatures . ix cid . crType . beeRandomMovement .~ x
+            & randGen .~ g
+  where
+    (x,g) = runState (takeOne [Nothing,Just LeftForward,Just RightForward]) (w ^. randGen)
+    
@@ -8,8 +8,10 @@ module Dodge.Creature.Impulse.Movement (
    crMvForward,
    crMvForward',
    creatureTurnTo,
+    mvTurnToward,
 ) where

+import Dodge.Creature.State.WalkCycle
 import Dodge.Creature.MoveType
 import Linear
 import Control.Lens
@@ -26,20 +28,12 @@ p is the movement translation vector, will be made relative to creature directio
 crMvBy :: Point2 -> LWorld -> Creature -> Creature
 crMvBy p lw cr = crMvAbsolute lw (rotateV (_crDir cr) p) cr

-crWalk ::
-    -- | Movement translation vector, will be made relative to creature direction
-    Point2 ->
-    LWorld ->
-    Creature ->
-    Creature
+-- | p is the movement translation vector, made relative to creature direction
+crWalk :: Point2 -> LWorld -> Creature -> Creature
 crWalk p lw cr = crWalkAbsolute lw (rotateV (_crDir cr) p) cr

-crMvByNoStride ::
-    -- | Movement translation vector, will be made relative to creature direction
-    Point2 ->
-    LWorld ->
-    Creature ->
-    Creature
+-- | p is the movement translation vector, made relative to creature direction
+crMvByNoStride :: Point2 -> LWorld -> Creature -> Creature
 crMvByNoStride p lw cr = crMvAbsoluteNoStride lw (rotateV (_crDir cr) p) cr

 crMvAbsolute :: LWorld -> Point2 -> Creature -> Creature
@@ -48,7 +42,7 @@ crMvAbsolute lw p' cr =
        & crPos . _xy +~ p
        & crMvDir .~ argV (p + cr ^. crOldPos . _xy - cr ^. crOldOldPos . _xy)
  where
-    p = strengthFactor (getCrMoveSpeed lw cr) *.* p'
+    p = strengthFactor (getCrMoveSpeed lw cr) *^ p'

 crWalkAbsolute :: LWorld -> Point2 -> Creature -> Creature
 crWalkAbsolute lw p' cr 
@@ -78,6 +72,15 @@ crMvForward' lw cr = case crMvType cr of
                | otherwise = s
        in crMvBy (V2 speed 0) lw cr
            & crType . startStopMv %~ ((`mod` (n*2)) . (+1))
+    BeeMvType s _ n ->
+        let speed | cr ^?! crType . startStopMv > n = 0
+                | otherwise = s
+            v = case cr ^?! crType . beeRandomMovement of
+                Nothing -> V2 speed 0
+                Just LeftForward -> V2 0 speed
+                Just RightForward -> V2 0 (-speed)
+        in crMvBy v lw cr
+            & crType . startStopMv %~ ((`mod` (n*2)) . (+1))
    NoMvType -> cr
    MvWalking s -> crMvBy (V2 s 0) lw cr
    
@@ -117,3 +120,23 @@ creatureTurnToward p turnSpeed cr
  where
    vToTarg = p -.- cr ^. crPos . _xy
    dirToTarget = argV vToTarg
+
+-- I feel like this is inefficient
+mvTurnToward :: Point2 -> Float -> Creature -> Creature
+mvTurnToward p' turnSpeed cr
+    | vToTarg == V2 0 0 = cr -- this should deal with the angleVV error
+    | angleVV vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed =
+        cr & crDir .~ dirToTarget
+    | isLeftOfA (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr) = cr & crDir +~ turnSpeed
+    | otherwise = cr & crDir -~ turnSpeed
+  where
+    -- when flying, inertia is high enough that overturning can be useful
+    p | Flying {} <- cr ^. crStance . carriage
+            = let v = flyInertia cr *^ (cr ^. crOldPos . _xy - cr ^. crOldOldPos . _xy)
+               --   u = normalize $ vNormal $ p' - cxy
+               --in p' - dot v u *^ u
+               in p' - v
+        | otherwise = p'
+    cxy = cr ^. crPos . _xy
+    vToTarg = p -.- cxy
+    dirToTarget = argV vToTarg
@@ -13,6 +13,6 @@ crMass = \case
    BarrelCrit{} -> 10
    SlinkCrit{} -> 100
    LampCrit {} -> 3
-    SlimeCrit {_slimeRad = r} -> r * r / 10
-    BeeCrit {_beeSlime = x} -> 3 + x
+    SlimeCrit {_slimeSlime = r} -> fromIntegral r / 1000
+    BeeCrit {_beeSlime = x} -> 3 + fromIntegral x / 100
    HiveCrit {} -> 100
@@ -17,7 +17,8 @@ crMvType cr = case _crType cr of
    BarrelCrit {} -> defaultAimMvType
    LampCrit {} -> defaultAimMvType
    SlimeCrit {} -> NoMvType
-    BeeCrit {} -> StartStopMvType 0.2 0.1 25
+    BeeCrit {} -> BeeMvType 0.2 0.1 15
+    --BeeCrit {} -> BeeMvType 0.2 0.1 25
    HiveCrit{} -> NoMvType

 defaultAimMvType :: CrMvType
@@ -132,14 +132,10 @@ decreaseAwareness (Cognizant 0) = Just $ Suspicious 1000
 decreaseAwareness (Cognizant x) = Just $ Cognizant $ x - 50

 {- | Given a fixed group of creatures, direct attention to those of them that
- - are in view.
+are in view.
+The ints are ids of creatures that may attract this creature's attention
 -}
-basicAttentionUpdate ::
-    -- | Creatures that may attract this creature's attention
-    [Int] ->
-    World ->
-    Creature ->
-    Creature
+basicAttentionUpdate :: [Int] -> World -> Creature -> Creature
 basicAttentionUpdate cids w cr =
    cr & crPerception . cpAttention
        .~ AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
@@ -7,30 +7,29 @@ module Dodge.Creature.Picture (
    drawCreature,
 ) where

-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
@@ -40,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
@@ -56,33 +55,27 @@ 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) $ polyCirc 6 r
-    & each %~ scaleAlong d s
-    & each %~ scaleAlong (vNormal d) (1 / s)
-    & each %~ rotateV (-cr ^. crDir)
-    & each %~ (((r-cr^?!crType.slimeRadWobble)/r) *^)
+drawSlimeCrit cr =
+    colorSH green $
+        upperPrismPolyHalf Medium Typical (cr ^?! crType . slimeEngulfProgress + min 15 r) ps
  where
-    r = cr ^?! crType . slimeRad
-    p = cr ^?! crType . slimeCompression
-    d = normalize p
-    s = norm p / r
+    r = slimeToRad $ cr ^?! crType . slimeSlime - cr ^?! crType . slimeSlimeChange
+    so = slimeOutline cr
+    ps = fromMaybe so $ do
+        (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)

 -- 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 =
+basicCrShape cr =
    scaleSH (V3 crsize crsize crsize) $
        mconcat
            [ colorSH (_skinHead cskin) . overPosSH (translateToES cr OnHead) $ scalp
@@ -95,22 +88,27 @@ basicCrShape cr
    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
  where
-    shead = polyCirc 6 15
+    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) 
+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]])
+        <> 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)
@@ -120,18 +118,28 @@ drawHive :: SPic
 drawHive = noPic $ upperPrismPolyHalfMI 25 $ polyCirc 6 20

 drawBeeCrit :: Creature -> Shape
-drawBeeCrit cr = colorSH col
-    (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))))
+        | otherwise = id
+    g x
+        | x > 0.5 = 1 - x
+        | otherwise = x

 drawCrabCrit :: World -> Creature -> Shape
-drawCrabCrit w cr = mconcat 
+drawCrabCrit w cr =
+    mconcat
        [ crabUpperBody w cr
        , colorSH (_skinLower cskin) $ crabFeet w cr
        ]
@@ -139,7 +147,8 @@ drawCrabCrit w cr = mconcat
    cskin = crShape $ _crType cr

 drawChaseCrit :: World -> Creature -> Shape
-drawChaseCrit w cr = mconcat 
+drawChaseCrit w cr =
+    mconcat
        [ chaseUpperBody w cr
        , rotmdir $ colorSH (_skinLower cskin) $ feet cr
        ]
@@ -148,17 +157,23 @@ drawChaseCrit w cr = mconcat
    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) 
+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)
+        <> 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
@@ -170,104 +185,115 @@ crabUpperBody _ cr =  colorSH (_skinUpper cskin)
    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 
+chaseUpperBody w cr =
+    colorSH
+        (_skinUpper cskin)
+        ( overPosSH
+            (Q.apply torsoq)
+            ( upperPrismPolyHalfMI tz $
+                polyCirc 3 12
                    & each %~ vNormal
-        & each . _y *~ 0.6) 
+                    & each . _y *~ 0.6
+            )
            <> overPosSH (Q.apply neckq) (upperPrismPolyHalfMI 3 $ (+ V2 8 0) . vNormal <$> trapTBH 2 5 8)
        )
-    <> colorSH (_skinHead cskin)
+        <> 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 =
    uncurryV translateSHxy rpos (afoot & each . sfVs . each %~ Q.rotate r1)
-    <> (afoot 
+        <> ( afoot
                & each . sfVs . each %~ Q.rotate r2
-        & each . sfVs . each +~ V3 0 2 5)
+                & each . sfVs . each +~ V3 0 2 5
+           )
        <> uncurryV translateSHxy rpos' (afoot & each . sfVs . each %~ Q.rotate r1')
-    <> (afoot 
+        <> ( afoot
                & each . sfVs . each %~ Q.rotate r2'
-        & each . sfVs . each +~ V3 0 2 5)
+                & each . sfVs . each +~ V3 0 2 5
+           )
        <> uncurryV translateSHxy lpos (afoot & each . sfVs . each %~ Q.rotate l1)
-    <> (afoot 
+        <> ( afoot
                & each . sfVs . each %~ Q.rotate l2
-        & each . sfVs . each +~ V3 0 (-2) 5)
+                & each . sfVs . each +~ V3 0 (-2) 5
+           )
        <> uncurryV translateSHxy lpos' (afoot & each . sfVs . each %~ Q.rotate l1')
-    <> (afoot 
+        <> ( afoot
                & each . sfVs . each %~ Q.rotate l2'
-        & each . sfVs . each +~ V3 0 (-2) 5)
+                & each . sfVs . each +~ V3 0 (-2) 5
+           )
  where
    rpos = rot (cr ^?! crType . rFootPos - cxy)
    rot = rotateV cdir
-    lpos = rot ( cr ^?! crType . lFootPos - cxy)
+    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
@@ -295,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)
+        , 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)
+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)
+        , 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'
+        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 & 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
@@ -355,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
@@ -370,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
@@ -385,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
@@ -405,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)
-
@@ -11,11 +11,11 @@ crRad = \case
    ChaseCrit {} -> 10
    CrabCrit {} -> 10
    HoverCrit {} -> 8
-    BeeCrit {_beeSlime = x} -> sqrt $ 2^(2::Int) + x
+    BeeCrit {_beeSlime = x} -> sqrt $ 4 + (fromIntegral x / 100)
    SwarmCrit -> 2
    AutoCrit -> 10
    BarrelCrit{} -> 10
    LampCrit {} -> 3
    SlinkCrit {} -> 10
    HiveCrit {} -> 20
-    SlimeCrit {_slimeRad = r,_slimeRadWobble = x} -> r - x
+    SlimeCrit {_slimeSlime = r,_slimeSlimeChange = x} -> slimeToRad (r - x)
@@ -1,6 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
 module Dodge.Creature.ReaderUpdate (
-    doStrategyActions,
    targetYouWhenCognizant,
    overrideMeleeCloseTarget,
    watchUpdateStrat,
@@ -25,7 +24,7 @@ import Dodge.Base
 import Dodge.Creature.Perception
 import Dodge.Creature.Radius
 import Dodge.Creature.Vocalization
-import Dodge.Data.CreatureEffect
+--import Dodge.Data.CreatureEffect
 import Dodge.Data.World
 import Dodge.Zoning.Creature
 import FoldableHelp
@@ -45,7 +44,7 @@ tryMeleeAttack cr tcr
    | _meleeCooldown (_crType cr) == 0
        && Just (_crID tcr) == cr ^? crActionPlan . apStrategy . meleeTarget
        && dist tpos cpos < crRad (cr ^. crType) + crRad (tcr ^. crType) + 5
-        && abs (_crDir cr - argV (tpos -.- cpos)) < pi / 4 =
+        && abs (_crDir cr - argV (tpos - cpos)) < pi / 4 =
        cr & crActionPlan . apAction
                .~ DoImpulses [Melee $ _crID tcr] `DoActionThen`
                        DoReplicate 10 NoAction
@@ -141,7 +140,7 @@ crabActionUpdate cid w = case _apStrategy (_crActionPlan cr) of
            | dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) ->
                w & tocr . crActionPlan . apAction .~ PathTo p (DoImpulses [ChangeStrategy Wander])
            | otherwise ->
-                w & tocr . crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
+                w -- & tocr . crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
                    & tocr . crActionPlan . apStrategy .~ Search
                    & tocr . crIntention . mvToPoint .~ Nothing
        _ -> w & tocr %~ viewTarget w
@@ -215,8 +214,8 @@ chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
            | dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) ->
                cr & crActionPlan . apAction .~ PathTo p (DoImpulses [ChangeStrategy Wander])
            | otherwise ->
-                cr & crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
-                    & crActionPlan . apStrategy .~ WatchAndWait
+                cr -- & crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
+                    & crActionPlan . apStrategy .~ Search
                    & crIntention . mvToPoint .~ Nothing
        _ -> viewTarget w cr
  where
@@ -235,8 +234,8 @@ hoverCritMv w cr = case _apStrategy (_crActionPlan cr) of
            | dist (cr ^. crPos . _xy) p > crRad (cr ^. crType) ->
                cr & crActionPlan . apAction .~ PathTo p (DoImpulses [ChangeStrategy Wander])
            | otherwise ->
-                cr & crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
-                    & crActionPlan . apStrategy .~ WatchAndWait
+                cr -- & crActionPlan . apAction .~ bfsThenReturn 500 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
+                    & crActionPlan . apStrategy .~ Search
                    & crIntention . mvToPoint .~ Nothing
        _ -> viewTarget w cr
  where
@@ -269,15 +268,6 @@ viewTarget w cr = case cr ^? crIntention . viewPoint . _Just of
 --replaceNullWith x [] = [x]
 --replaceNullWith _ xs = xs

-doStrategyActions :: Creature -> Creature
-doStrategyActions cr = case cr ^? crActionPlan . apStrategy of
-    Just (StrategyActions strat acs) ->
-        cr
--            & crActionPlan . apAction .~ acs
-            & crActionPlan . apAction .~ head acs
-            & crActionPlan . apStrategy .~ strat
-    _ -> cr
-
 overrideInternal :: (Creature -> Bool) -> (Creature -> Creature) -> Creature -> Creature
 overrideInternal test update cr
    | test cr = update cr
@@ -316,16 +306,11 @@ searchIfDamaged cr
    | _crPain cr > 0
        && _apStrategy (_crActionPlan cr) == WatchAndWait =
        cr & crPerception . cpVigilance .~ Vigilant
-            & crActionPlan . apStrategy
-                .~ StrategyActions
-                    LookAround
-                    [ TurnToPoint (cr ^. crPos . _xy -.- unitVectorAtAngle (_crDir cr))
-                        `DoActionThen` 40 `WaitThen` bfsThenReturn 500
-                    ]
+            & crActionPlan . apStrategy .~ LookAround
    | otherwise = cr

-bfsThenReturn :: Int -> Action
-bfsThenReturn t = ArbitraryAction (CrWdBFSThenReturn t)
+--bfsThenReturn :: Int -> Action
+--bfsThenReturn t = ArbitraryAction (CrWdBFSThenReturn t)

 --    theaction
 --  where
@@ -0,0 +1,16 @@
+module Dodge.Creature.Slime (slimeOutline) where
+
+import Control.Lens
+import Dodge.Data.Creature
+import Geometry.Data
+import Linear
+import Shape
+
+slimeOutline :: Creature -> [Point2]
+slimeOutline cr =
+    polyCirc 6 r
+        & each . _x *~ a
+        & each . _y %~ (/ a)
+  where
+    r = slimeToRad $ cr ^?! crType . slimeSlime - cr ^?! crType . slimeSlimeChange
+    a = cr ^?! crType . slimeCompression
@@ -4,6 +4,7 @@ module Dodge.Creature.State (
    invItemEffs,
 ) where

+import Dodge.Creature.Radius
 import qualified Data.IntMap.Strict as IM
 import Linear
 import NewInt
@@ -43,16 +44,38 @@ import qualified SDL
 doDamage :: Int -> World -> World
 doDamage cid w = fromMaybe w $ do
    cr <- w ^? cWorld . lWorld . creatures . ix cid
-    return $ applyPastDamages cr $ applyCreatureDamage (cr ^. crDamage) cr w
+    return $ crPainEffect cr $ applyCreatureDamage cid cr w

 -- TODO generalise shake to arbitrary damage amounts
-applyPastDamages :: Creature -> World -> World
-applyPastDamages cr w
-    | HoverCrit {} <- cr ^. crType 
-    , _crPain cr > 50 = w
-                & cWorld . lWorld . creatures . ix (_crID cr) . crPain -~ 50
-                & cWorld . lWorld . creatures . ix (_crID cr) . crPos . _z %~ max 12 . subtract 1
-    | HoverCrit {} <- cr ^. crType  = w
+crPainEffect :: Creature -> World -> World
+crPainEffect cr = case cr ^. crType of
+    HoverCrit {} -> hoverPainEffect cr
+    HiveCrit{} -> hivePainEffect cr
+    _ -> jitterPain cr
+
+
+hoverPainEffect :: Creature -> World -> World
+hoverPainEffect cr
+    | _crPain cr > 50 =
+                (cWorld . lWorld . creatures . ix (_crID cr) . crPain -~ 50)
+                . (cWorld . lWorld . creatures . ix (_crID cr) . crPos . _z %~ max 12 . subtract 1)
+    | otherwise = id
+
+
+hivePainEffect :: Creature -> World -> World
+hivePainEffect cr w
+    | _crPain cr > 0 = w & cWorld . lWorld . creatures . ix (cr ^. crID) . crPain %~ (max 0 . subtract 5)
+        & cWorld . lWorld . beePheremones .:~ BPheremone (cr ^. crPos & _xy +~ p & _z .~ 20) v 200
+        & randGen .~ g
+    | otherwise = w
+  where
+    (a,g') = randomR (0,2*pi) $ w ^. randGen
+    (b,g) = runState randOnUnitSphere $ g'
+    p = (crRad (cr ^. crType) + 5) *^ unitVectorAtAngle a
+    v = 3 *^ b
+
+jitterPain :: Creature -> World -> World
+jitterPain cr w
    | _crPain cr > 200 = dojitter 3 100
    | _crPain cr > 20 = dojitter 2 10
    | _crPain cr > 0 = dojitter 1 1
@@ -225,6 +248,7 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
                    , _lpPos = pos
 --                    , _lpColor = col
                    , _lpType = TargetingLaser (_itID itm)
+                    , _lpOrigin = CrWeaponO $ cr ^. crID
                    }
  where
    o = locOrient loc cr
@@ -1,7 +1,9 @@
 {-# LANGUAGE LambdaCase #-}

 module Dodge.Creature.State.WalkCycle (updateCarriage
-    ,compressionScale) where
+    ,compressionScale
+    , flyInertia
+    ) where

 import qualified Quaternion as Q
 import Dodge.Creature.Radius
@@ -55,8 +57,7 @@ updateCarriage' cid cr w = \case
        mcr <- w ^? cWorld . lWorld . creatures . ix mid
        mp <- mcr ^? crPos
        d <- mcr ^? crType . slimeCompression
-        r <- mcr ^? crType . slimeRad
-        return $ w & tocr . crPos .~ mp + (p & _xy %~ compressionScale ((1/r) *^ d))
+        return $ w & tocr . crPos .~ mp + (p & _x *~ d & _y %~ (/d))
  where
    tocr = cWorld . lWorld . creatures . ix cid
    oop = cr ^. crOldOldPos
@@ -85,7 +86,7 @@ walkCliffPush :: Creature -> [(Point2,Point2)] -> Point2
 walkCliffPush cr xs = pushAgainst (cr ^. crOldPos . _xy - cr ^. crOldOldPos . _xy) (-h xs)
  where
    cxy = cr ^. crPos . _xy
-    h = circSegsInside cxy (cr ^. crType . to crRad)
+    h = circSegsInside cxy (min 10 (cr ^. crType . to crRad))

 groundCliffPush :: Creature -> [(Point2,Point2)] -> Point2
 groundCliffPush cr xs = x *^ circSegsInside cxy r xs
@@ -136,9 +137,14 @@ chasmTestCliffPush f' cr w
  where
    cxy = cr ^. crPos . _xy
    tocr = cWorld . lWorld . creatures . ix (_crID cr)
-    g = uncurry $ crOnSeg cr
+    --g = uncurry $ crOnSeg cr
+    g = uncurry $ crOnSeg' cr
    f = pointInPoly cxy

+crOnSeg' :: Creature -> Point2 -> Point2 -> Bool
+{-# INLINE crOnSeg' #-}
+crOnSeg' cr = circOnSeg (cr ^. crPos . _xy) (min 10 (cr ^. crType . to crRad))
+
 chasmRotate :: Creature -> Point2 -> World -> World
 chasmRotate cr v w
    | t = rotateTo8 (argV v) w
@@ -1,27 +0,0 @@
-module Dodge.Creature.Strategy (
-    goToPostStrat,
-) where
-
-import Data.List
-import Dodge.Creature.Test
-import Dodge.Creature.Volition
-import Dodge.Data.Creature
-
-goToPostStrat :: Creature -> Strategy
-goToPostStrat cr = case find sentinelGoal $ _apGoal $ _crActionPlan cr of
-    Just (SentinelAt p _) ->
-        StrategyActions
-            (GetTo p)
-            [ DoActionThen (WaitThen 150 holsterIfAiming) $
-                DoActionThen
-                    (PathTo p NoAction)
-                    NoAction
-                    --     $ DoImpulses [ChangeStrategy WatchAndWait]
-            ]
-    _ -> WatchAndWait
-  where
-    sentinelGoal (SentinelAt _ _) = True
-    sentinelGoal _ = False
-    holsterIfAiming
-        | crIsAiming cr = holsterWeapon
-        | otherwise = NoAction
@@ -29,7 +29,6 @@ import Dodge.Creature.Radius
 import Dodge.Data.Equipment.Misc
 import Dodge.Data.AimStance
 import Control.Lens
-import Data.List (find)
 import Data.Maybe
 import Dodge.Base.Collide
 import Dodge.Data.World
@@ -81,12 +80,9 @@ crStratConMatches strat cr = strat == _apStrategy (_crActionPlan cr)
 -- this equality check might be slow...

 crAwayFromPost :: Creature -> Bool
-crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
-    Just (SentinelAt p _) -> dist p (cr ^. crPos . _xy) > 15
+crAwayFromPost cr = case _apGoal $ _crActionPlan cr of
+    SentinelAt p _ -> dist p (cr ^. crPos . _xy) > 15
    _ -> False
-  where
-    sentinelGoal (SentinelAt _ _) = True
-    sentinelGoal _ = False

 crInAimStance :: AimStance -> Creature -> Bool
 crInAimStance as cr = cr ^? crStance . posture == Just Aiming
@@ -133,12 +129,19 @@ isAnimate :: Creature -> Bool
 {-# INLINE isAnimate #-}
 isAnimate cr = case _crActionPlan cr of
    Inanimate -> False
-    SlimeIntelligence -> False
+    SlimeIntelligence -> True
    ActionPlan{} -> True

 hasAutoDoorBody :: Creature -> Bool
-hasAutoDoorBody cr = case cr ^. crHP of
+hasAutoDoorBody cr = crittype && notdestroyed
+  where
+    notdestroyed = case cr ^. crHP of
        HP {} -> True
        CrIsCorpse {} -> True
-    CrDestroyed {} -> False
+        AvatarDestroyed {} -> False
+    crittype = case cr ^. crType of
+        SlimeCrit {} -> False
+        BeeCrit {} -> False
+        HiveCrit {} -> False
+        _ -> True
    
@@ -2,10 +2,11 @@

 module Dodge.Creature.Update (updateCreature) where

--import Dodge.WorldEvent.ThingsHit
+import Dodge.Creature.Slime
+import Dodge.Creature.Radius
+import Dodge.Creature.MoveType
 import Dodge.Base.Collide
 import Data.List (sortOn)
-import Dodge.Creature.Radius
 import Dodge.Zoning.Creature
 import Dodge.Creature.ChaseCrit
 import Dodge.Creature.Damage
@@ -15,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
@@ -45,17 +45,14 @@ import qualified Data.IntSet as IS
 -- allow for knockbacks etc to be determined as well as intended movements
 updateCreature :: Creature -> World -> World
 updateCreature cr
-    | cr ^. crPos . _z < negate 300 = (tocr . crHP .~ CrDestroyed Pitted) . destroyAllInvItems 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
-        CrDestroyed{} -> id
+        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
@@ -65,16 +62,12 @@ updateLivingCreature cr = case cr ^. crType of
            . yourControl
    LampCrit{} -> updateLampoid cr
    BarrelCrit bt -> updateBarreloid bt cr
-    ChaseCrit{} -> \w ->
-        crUpdate cid . performActions cid $
-            over (cWorld . lWorld . creatures . ix cid) (chaseCritInternal w) w
-    CrabCrit{} ->
-        crUpdate cid . performActions cid . crabCritInternal cid
+    ChaseCrit{} -> crUpdate cid . performActions cid . updateChaseCrit cid
+    CrabCrit{} -> crUpdate cid . performActions cid . crabCritInternal cid
    AutoCrit{} -> crUpdate cid
    SwarmCrit{} -> crUpdate cid
-    HoverCrit{} -> \w ->
-        crUpdate cid . performActions cid . hoverCritHoverSound cr $
-            over (cWorld . lWorld . creatures . ix cid) (hoverCritInternal w) w
+    HoverCrit{} -> crUpdate cid . performActions cid . hoverCritHoverSound cr .
+            updateHoverCrit cid
    SlinkCrit{} -> slinkCritUpdate cid
    SlimeCrit{} -> slimeCritUpdate cid
    BeeCrit{} -> crUpdate cid . performActions cid . updateBeeFromPheremones cr cid . updateBeeCrit cr cid
@@ -87,16 +80,20 @@ updateHiveCrit cr cid w
    | Just x <- cr ^? crType . hiveChildren . to IS.size
    , x < nbees
    , Just y <- cr ^? crType . hiveGestation
-    , y == 0 = w 
+    , y == 0 
+    , Just z <- cr ^? crType . hiveSlime
+    , z >= 400
+        = w 
        & tocr . crType . hiveChildren %~ IS.insert nid
        & tocr . crType . hiveGestation .~ 50
        & cWorld . lWorld . creatures . at nid ?~ ncr
+        & tocr . crType . hiveSlime -~ 400
    | Just x <- cr ^? crType . hiveChildren . to IS.size
    , x < nbees = w
        & tocr . crType . hiveGestation %~ (max 0 . subtract 1)
    | otherwise = w
  where
-    nbees = 10
+    nbees = 15
    tocr = cWorld . lWorld . creatures . ix cid
    nid = IM.newKey $ w ^. cWorld . lWorld . creatures
    ncr = beeCrit & crPos .~ (cr ^. crPos + (0 & _xy +~ 25))
@@ -105,78 +102,136 @@ 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) < 20
+    f bp = distance (cr ^. crPos . _xy) (bp ^. bpPos . _xy) < 20

 updateBeeCrit :: Creature -> Int -> World -> World
-updateBeeCrit cr
-    | cr ^?! crType . beeAggro > 0 = updateAggroBee cr
-    | otherwise = updateCalmBee cr
+updateBeeCrit cr cid
+    | cr ^?! crType . beeAggro > 0 = updateAggroBee cr cid
+    | otherwise = beeLifespanCheck cr cid . updateCalmBee cr cid
+
+beeLifespanCheck :: Creature -> Int -> World -> World
+beeLifespanCheck cr cid
+    | Just ls <- cr ^? crType . beeLifespan
+    , Just x <- cr ^? crType . beeSlime
+    , ls < 1
+    , x < 5
+        = cWorld . lWorld . creatures . ix cid . crHP . _HP -~ 1
+    | otherwise = id

 updateAggroBee :: Creature -> Int -> World -> World
 updateAggroBee cr cid w
-    | Just tcr <- listToMaybe . sortOn (distance cxy . (^. crPos . _xy)) . IM.elems . IM.filter istarget $ crsNearCirc cxy 100 w = w & tocr . crActionPlan . apStrategy .~ CloseToMelee (tcr ^. crID)
+    | Mounted{} <- cr ^. crStance . carriage = w & tocr . crStance . carriage .~ Flying 0 
+    | Just tcr <- atarget
+    , distance (tcr ^. crPos . _xy) (cr ^. crPos . _xy) < crRad (cr ^. crType) + crRad (tcr ^. crType) + 1
+    , nearZeroAngle (argV (tcr ^. crPos . _xy - cr ^. crPos . _xy) - cr ^. crDir) < pi / 2
+    , 0 <- cr ^?! crType . meleeCooldown
+        = w & tocr . crPos .~ (cr ^. crOldPos & _xy -~ 5 *^ unitVectorAtAngle (cr ^. crDir))
+            & tocr . crType . startStopMv .~ (cr ^?! to crMvType . mvPulseTime)
+            & cWorld . lWorld . creatures . ix (tcr ^. crID) . crDamage 
+                .:~ Blunt 50 (cxy + crRad (cr ^. crType) *^ vdir) vdir (CrMeleeO (cr ^. crID))
+            & tocr . crType . meleeCooldown .~ 20
+    | Just tcr <- atarget = w & tocr . crActionPlan . apStrategy .~ CloseToMelee (tcr ^. crID)
        & tocr . crActionPlan . apAction .~ PathTo (tcr ^. crPos . _xy) NoAction
+        & tocr . crType . meleeCooldown %~ (max 0 . subtract 1)
+    | Just PathTo{} <- cr ^? crActionPlan . apAction = w & tocr . crType . beeAggro -~ 1
+        & tocr . crType . meleeCooldown %~ (max 0 . subtract 1)
    | otherwise = w & tocr . crType . beeAggro -~ 1
-        & tocr . crActionPlan . apStrategy .~ Search
+        & tocr . crActionPlan . apAction .~ PathTo (cxy + p) NoAction
+        & tocr . crType . meleeCooldown %~ (max 0 . subtract 1)
+        & randGen .~ g 
  where
+    (p,g) = runState (randOnCirc 150) (w ^. randGen)
+    atarget = listToMaybe . sortOn (distance cxy . (^.crPos._xy)) . IM.elems . IM.filter istarget $ crsNearCirc cxy 100 w
+    vdir = unitVectorAtAngle (cr ^. crDir)
    cxy = cr ^. crPos . _xy
    tocr = cWorld . lWorld . creatures . ix cid
-    istarget tcr = tcr ^. crID == 0
+    istarget tcr = t (tcr ^. crType)
+        && isJust (tcr ^? crHP . _HP)
        && hasLOS cxy (tcr ^. crPos . _xy) w
+    t = \case
+        Avatar{} -> True
+        ChaseCrit{} -> True
+        CrabCrit{} -> True
+        _ -> False

 -- do bees need to be able to see slime targets?
 -- if no path can be made, reset harvest action
+-- this should all be simplified
+-- should count how many are mounted on an individual slime, try for a different
+-- slime if too many
 updateCalmBee :: Creature -> Int -> World -> World
 updateCalmBee cr cid w 
    | Just hcr <- gethive
    , distance (cr ^. crPos . _xy) (hcr ^. crPos . _xy) < 30 
    , Just x <- cr ^? crType . beeSlime 
-    , x >= 0.5
-        = w & tocr . crType . beeSlime -~ 0.5
-    | Just hcr <- gethive
-    , Just _ <- cr ^? crStance . carriage . mountID
-    , Just x <- cr ^? crType . beeSlime 
-    , x >= 15
-        = w & tocr . crActionPlan . apAction .~ PathTo (hcr ^. crPos . _xy) NoAction
-            & tocr . crStance . carriage .~ Flying 0
+    , x >= 50 = w 
+        & tocr . crType . beeSlime -~ 50
+        & cWorld . lWorld . creatures . ix (hcr ^. crID) . crType . hiveSlime +~ 50
+    | Just x <- cr ^? crType . beeSlime 
+    , x < 50
+    , Just hcr <- gethive
+    , distance (cr ^. crPos . _xy) (hcr ^. crPos . _xy) < 30 
+    , Just ReturnToHive <- cr ^? crActionPlan . apStrategy = startsearch
+    | Just ReturnToHive <- cr ^? crActionPlan . apStrategy = w 
+    | Just x <- cr ^? crType . beeSlime 
+    , x >= 1500 = starthivereturn
+        & randGen .~ gsa
+        & tocr . crType . beeLifespan %~ max 0 . subtract sa
    | Just mid <- cr ^? crStance . carriage . mountID
-    , mountshakeoff mid = w & tocr . crActionPlan . apStrategy .~ Search
-            & tocr . crStance . carriage .~ Flying 0
-    | Just hcr <- gethive
-    , Just x <- cr ^? crType . beeSlime 
-    , x >= 15
-        = w & tocr . crActionPlan . apAction .~ PathTo (hcr ^. crPos . _xy) NoAction
+    , mountshakeoff mid = startsearch
    | Nothing <- cr ^? crActionPlan . apStrategy . harvestTarget 
-    ,  Just tcr <- listToMaybe . sortOn (distance cxy . (^. crPos . _xy)) . IM.elems . IM.filter istarget $ crsNearCirc cxy 100 w =
+    ,  xs@(_:_) <- IM.elems . IM.filter istarget $ crsNearCirc cxy 100 w 
+    , (tcr,g') <- runState (takeOne xs) (w ^. randGen) =
         w & tocr . crActionPlan . apStrategy .~ HarvestFrom (tcr ^. crID)
+            & randGen .~ g'
    | 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.9*crRad (tcr ^. crType) 
-    , Just r <- tcr ^? crType . slimeRad
+    , distance (cr ^. crPos . _xy) (tcr ^. crPos . _xy) < 0.8*crRad (tcr ^. crType) 
    , 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
            & tocr . crActionPlan . apAction .~ PathTo (tcr ^. crPos . _xy) NoAction
-    | otherwise = w & tocr . crActionPlan . apStrategy .~ Search
+    | Just (HarvestFrom{}) <- cr ^? crActionPlan . apStrategy = startsearch
+    | Just (SearchTimed 0) <- cr ^? crActionPlan . apStrategy = starthivereturn
+    | Just PathTo{} <- cr ^? crActionPlan . apAction = w
+        & tocr . crActionPlan . apStrategy . searchTimer %~ (max 0 . subtract 1)
+    | otherwise = startsearch
  where
+    (sa,gsa) = runState (takeOne [0,1]) (w ^. randGen)
+    starthivereturn = fromMaybe w $ do
+        hcr <- gethive
+        return $ w
+            & tocr . crActionPlan . apAction .~ PathTo (hcr ^. crPos . _xy) NoAction
+            & tocr . crActionPlan . apStrategy .~ ReturnToHive
+            & tocr . crStance . carriage %~ dounmount
+    dounmount x = case x of
+        Flying{} -> x
+        _ -> Flying 0
+    startsearch = w
+        & tocr . crActionPlan . apAction .~ PathTo (cxy + p) NoAction
+        & tocr . crStance . carriage %~ dounmount
+        & randGen .~ g
+        & tocr . crActionPlan . apStrategy .~ SearchTimed 200
+    (p,g) = runState (randOnCirc 200) (w ^. randGen)
    cxy = cr ^. crPos . _xy
    mountshakeoff mid = fromMaybe True $ do
        mcr <- w ^? cWorld . lWorld . creatures . ix mid
        SlimeCrit {_slimeSplitTimer = x} <- mcr ^? crType
-        return $ x > 0
-    sspeed = 0.05
+        return $ isJust x
+    sspeed = 5
    gettarg = do
        i <- cr ^? crActionPlan . apStrategy . harvestTarget 
        tcr <-  w ^? cWorld . lWorld . creatures . ix i
-        x <- tcr ^? crType . slimeRad
+        x <- tcr ^? crType . slimeSlime . to slimeToRad
        guard $ x > 12
        return (tcr,i)
    gethive = do
@@ -184,42 +239,41 @@ updateCalmBee cr cid w
        w ^? cWorld . lWorld . creatures . ix i
    tocr = cWorld . lWorld . creatures . ix cid
    istarget tcr = fromMaybe False $ do
-        r <- tcr ^? crType . slimeRad
+        r <- tcr ^? crType . slimeSlime . to slimeToRad
        return $ r > 12

 slimeCritUpdate :: Int -> World -> World
 slimeCritUpdate cid w 
-    | r < 5 = w & cWorld . lWorld . creatures . ix cid . crHP .~ CrDestroyed Gibbed
+    | r < 5 = w & cWorld . lWorld . creatures . at cid .~ Nothing
    | Just hitp <- w ^? cWorld . lWorld . creatures . ix cid . crDamage . ix 0 . dmPos
        , Just hitv <-  w ^? cWorld . lWorld . creatures . ix cid . crDamage . ix 0 . dmVector
--        , Just (cr1,cr2) <- splitSlimeCrit hitp hitv cr
--            = 
--        let cid' = IM.newKey $ w ^. cWorld . lWorld . creatures
--        in w & cWorld . lWorld . creatures . ix cid .~ cr1
--            & cWorld . lWorld . creatures . at cid' ?~ (cr2 & crID .~ cid')
        , Just w' <- splitSlimeCrit' hitp hitv cid cr w = w'
-    | (cr ^?! crType . slimeIsCompressing) && r > norm p
+    | (cr ^?! crType . slimeIsCompressing) && 1 > p
        = let (w',g) = runState (setSlimeDir cid (cr & crDamage .~ []) w) (w ^. randGen)
            in w' & randGen .~ g
    | otherwise = updateCarriage cid $ w
        & cWorld . lWorld . creatures . ix cid .~ mvslime
        & cWorld . lWorld . creatures . ix cid . crDamage .~ []
        & tocr %~ doSlimeRadChange
-        & tocr . crType . slimeSplitTimer %~ (max 0 . subtract 1)
+        & tocr . crType . slimeSplitTimer %~ fsst
        & tocr . crType . slimeEngulfProgress %~ (max 0 . subtract 0.5)
  where
+    fsst Nothing = Nothing
+    fsst (Just (x,ps))
+        | x > 0 = Just (x-1,ps)
+        | otherwise = Nothing
    tocr = cWorld . lWorld . creatures . ix cid
    cr = w ^?! cWorld . lWorld . creatures . ix cid
-    v = 0.1 *^ normalize p 
-    mvslime = cr & crType . slimeCompression +~ f v
+    v = 0.1 *^ unitVectorAtAngle (cr ^. crDir)
+    mvslime = cr & crType . slimeCompression +~ f (0.1/r)
        & crPos . _xy +~ v
        & crType . slimeIsCompressing %~ f'
    f | t = negate
      | otherwise = id
-    f'  | norm p > 3*r/2 = const True
+    f'  | p > 1.5 = const True
        | otherwise = id
    t = cr ^?! crType . slimeIsCompressing
-    r = cr ^?! crType . slimeRad
+    r = cr ^?! crType . slimeSlime . to slimeToRad
    p = cr ^?! crType . slimeCompression

 setSlimeDir :: Int -> Creature -> World -> State StdGen World
@@ -230,24 +284,18 @@ setSlimeDir cid cr w = do
        then do
            x <- randInCirc 1
            return $ fromMaybe w $ splitSlimeCrit' (x + cxy) (unitVectorAtAngle d) cid cr w
--            let (cr1,cr2) = splitSlimeCrit (x + cxy) (unitVectorAtAngle d) cr ^?! _Just
--                cid' = IM.newKey $ w ^. cWorld . lWorld . creatures
--            return $ w & tocr .~ cr1
--                & tocr' cid' ?~ (cr2 & crID .~ cid')
-        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
--    tocr' i = cWorld . lWorld . creatures . at i
    cxy = cr ^. crPos . _xy
-    r = cr ^?! crType . slimeRad
-    
+    r = cr ^?! crType . slimeSlime . to slimeToRad

 doSlimeRadChange :: Creature -> Creature
-doSlimeRadChange = crType . slimeRadWobble %~ f
+doSlimeRadChange = crType . slimeSlimeChange %~ f
  where
-    f x | x > 1 = x - 1
-        | x < -1 = x + 1
+    f x | x > 1000 = x - 1000
+        | x < -1000 = x + 1000
        | otherwise = 0

 splitSlimeCrit' :: Point2 -> Point2 -> Int -> Creature -> World -> Maybe World
@@ -272,23 +320,31 @@ splitSlimeCrit p v cr = do
        mvdir 
            | isLHS p (p+v) cxy = normalize (vNormal v)
            | otherwise = - normalize (vNormal v)
-    return (cr' & crPos . _xy .~ mp + (r1 + 0.51) *^ mvdir
-                & crType . slimeRad .~ r1
-                & crType . slimeCompression .~ rotateV (argV mvdir) (V2 r1 0)
+        (ps',qs') 
+            | isLHS p (p+v) cxy = (ps,qs)
+            | otherwise = (qs,ps)
+        c1 = cr' & crPos . _xy .~ mp + r1 *^ mvdir
+                & crType . slimeSlime .~ round (r1 ^ (2 :: Int) * 100)
                & crDir .~ argV mvdir
-        ,cr' & crPos . _xy .~ mp - (r2 + 0.51) *^ mvdir
-                & crType . slimeRad .~ r2
-                & crType . slimeCompression .~ rotateV (argV (-mvdir)) (V2 r2 0)
+        c2 = cr' & crPos . _xy .~ mp - r2 *^ mvdir
+                & crType . slimeSlime .~ round (r2^(2::Int) * 100)
                & crDir .~ argV (-mvdir)
-                & crType . slimeEngulfProgress .~ 0
+        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 .~ f c1ps c1
+        ,c2 & crType . slimeSplitTimer . _Just . _2 .~ f c2ps c2
        )
  where
+    f xs@(_:_) c = polyInPoly (centroid xs) xs (slimeOutline c)
+    f _ _ = mempty
    cxy = cr ^. crPos . _xy
-    r = cr ^?! crType . slimeRad
+    r = cr ^?! crType . slimeSlime . to slimeToRad
    cr' = cr & crDamage .~ []
-        & crType . slimeRadWobble .~ 0
-        & crType . slimeSplitTimer .~ 10
+        & crType . slimeSlimeChange .~ 0
+        & crType . slimeSplitTimer .~ Just (10, mempty)
        & crType . slimeIsCompressing .~ False
+        & 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
@@ -307,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
@@ -346,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
@@ -371,11 +422,15 @@ crDeathEffects cr w = case cr ^. crType of
        return $ w & cWorld . lWorld . creatures . ix hid . crType . hiveChildren %~ IS.delete (cr ^. crID)
    _ -> w
  where
-    beepheremone = cWorld . lWorld . beePheremones .:~ BPheremone (cr ^. crPos . _xy) 200
+    beepheremone 
+        | Just x <- cr ^? crType . beeLifespan
+        ,   x < 1 = id
+        | otherwise = cWorld . lWorld . beePheremones .:~ BPheremone (cr ^. crPos) (cr ^. crPos - cr ^. crOldPos) 200

 startDeathTimer :: Creature -> Creature
 startDeathTimer cr = cr & crDeathTimer ?~ case cr ^. crType of
            HoverCrit{} -> 0
+            BeeCrit{} -> 0
            _ -> 5

 toDeathCarriage :: Carriage -> Carriage
@@ -397,7 +452,7 @@ corpseOrGib cr w =
        Just PhysicalDamage
            | _crPain cr > 300 ->
                makeCrGibs cr
-                    . sethp (CrDestroyed Gibbed)
+                    . (cWorld . lWorld . creatures . at (cr ^. crID) %~ destroyCreature)
                    . dodeathsound GibsDeath
        _ ->
            sethp (CrIsCorpse thecorpse)
@@ -426,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
@@ -36,18 +36,9 @@ doCrBl cb = case cb of
    CrIsAnimate -> isAnimate
    CrOpenAutoDoor -> \cr -> isAnimate cr && hasAutoDoorBody cr

-doCrAc :: CrAc -> Creature -> Action
-doCrAc ca = case ca of
-    CrTurnAround -> \cr -> TurnToPoint 
-        (cr ^. crPos . _xy -.- 10 *.* unitVectorAtAngle (_crDir cr))
--    CrFleeFromTarget -> fleeFromTarget
-
--fleeFromTarget :: Creature -> Action
--fleeFromTarget cr = fleeFrom cr (_targetCr (_crIntention cr))
-
-doCrWdAc :: CrWdAc -> Creature -> World -> Action
-doCrWdAc cw = case cw of
-    CrWdBFSThenReturn _ -> const $ const NoAction
+--doCrWdAc :: CrWdAc -> Creature -> World -> Action
+--doCrWdAc cw = case cw of
+--    CrWdBFSThenReturn _ -> const $ const NoAction
 --    CrWdBFSThenReturn t -> \cr w -> fromMaybe NoAction $ do
 --        n <- walkableNodeNear w (cr ^. crPos . _xy)
 --        let as = take 20 $ map PathTo $ bfsNodePoints n w
@@ -56,7 +47,7 @@ doCrWdAc cw = case cw of
 --            DoReplicate t $
 --                foldr DoActionThen NoAction as
 --    ChooseMovementSpreadGun -> chooseMovementSpreadGun
-    ChooseMovementLtAuto -> chooseMovementLtAuto
+--    ChooseMovementLtAuto -> chooseMovementLtAuto

 --chooseMovementSpreadGun :: Creature -> World -> Action
 --chooseMovementSpreadGun cr w
@@ -17,8 +17,8 @@ data ActionPlan
    | ActionPlan
        { -- _apImpulse :: [Impulse] -- done per frame
         _apAction :: Action -- updated per frame, likely persist across frames
-        , _apStrategy :: Strategy -- current strategy
-        , _apGoal :: [Goal] -- particular ordered goals
+        , _apStrategy :: Strategy
+        , _apGoal :: Goal
        }
    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
    deriving (Eq, Ord, Show) --Generic, Flat)
@@ -45,10 +45,11 @@ data Impulse
    | ChangePosture Posture
    | MakeSound SoundID
    | ChangeStrategy Strategy
-    | AddGoal Goal
+--    | AddGoal Goal
    | ImpulseUseTarget { _impulseUseTarget :: CrImp }
    | ImpulseNothing
    | UpdateRandGen
+    | SetBeeRandomMovement
    deriving (Eq, Ord, Show) --Generic, Flat)

 data RandImpulse
@@ -120,9 +121,9 @@ data Action
        }
    | LeadTarget { _leadTargetBy :: Point2 }
    | NoAction
-    | StartSentinelPost
-    | UseSelf { _useSelf :: CrAc }
-    | ArbitraryAction {_arbitraryAction :: CrWdAc}
+--    | StartSentinelPost
+--    | UseSelf { _useSelf :: CrAc }
+--    | ArbitraryAction {_arbitraryAction :: CrWdAc}
 -- | Repeatedly perform impulses alongside a main action until the main action terminates
    | DoImpulsesAlongside
        { _sideImpulses :: [Impulse]
@@ -144,13 +145,13 @@ data Strategy
    | LookAround
    | Wander
    | CloseToMelee {_meleeTarget :: Int}
-    | StrategyActions Strategy [Action]
    | GetTo Point2
--    | Reload
    | Flee
--    | MeleeStrike
    | Search
+    | SearchTimed {_searchTimer :: Int}
+    | ReturnToHive
    | HarvestFrom {_harvestTarget :: Int}
+    | StrategyInt {_strategyInt :: Int}
    deriving (Eq, Ord, Show) --Generic, Flat)
    --deriving (Eq, Ord, Show, Read) --Generic, Flat)

@@ -20,6 +20,7 @@ data Bullet = Bullet
    , _buDrag :: Float
    , _buPos :: Point2
    , _buOldPos :: Point2
+    , _buOrigin :: DamageOrigin
    }
    deriving (Show, Eq, Ord, Read) --Generic, Flat)

@@ -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
@@ -3,6 +3,7 @@

 module Dodge.Data.Cloud where

+import Dodge.Data.Damage
 import Dodge.Data.Material
 import Control.Lens
 import Data.Aeson
@@ -36,6 +37,7 @@ data Gas = Gas
    , _gsVel :: Point3
    , _gsTimer :: Int
    , _gsType :: GasType
+    , _gsOrigin :: DamageOrigin
    }
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

@@ -43,7 +45,8 @@ data GasType = PoisonGas
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

 data BeePheremone = BPheremone
-    { _bpPos :: Point2
+    { _bpPos :: Point3
+    , _bpVel :: Point3
    , _bpTimer :: Int
    }

@@ -108,6 +108,8 @@ data DebugBool
    | Show_writable_values
    | Show_mouse_click_pos
    | Muzzle_positions
+    | Show_cr_hitboxes
+    | Clipboard_cr
    deriving (Eq, Ord, Bounded, Enum, Show)

 data ResFactor = DoubleRes | FullRes | HalfRes | QuarterRes | EighthRes | SixteenthRes
@@ -63,7 +63,14 @@ data Creature = Creature
 data CrHP
    = HP Int
    | CrIsCorpse SPic
-    | CrDestroyed CrDestructionType
+    | AvatarDestroyed
+--    | CrDestroyed CrDestructionType
+
+destroyCreature :: Maybe Creature -> Maybe Creature
+destroyCreature mcr
+    | Just cr <- mcr
+    , _crID cr == 0 = Just cr{_crHP = AvatarDestroyed}
+    | otherwise = Nothing

 data CrDestructionType = Gibbed | Pitted | Swallowed

@@ -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
@@ -36,6 +32,11 @@ data CrMvType
        , _mvTurnSpeed :: Float
        , _mvPulseTime :: Int
        }
+    | BeeMvType
+        { _mvSpeed :: Float
+        , _mvTurnSpeed :: Float
+        , _mvPulseTime :: Int
+        }
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

 data Pulse = PulseStatus
@@ -73,28 +74,37 @@ data CreatureType
        , _slinkHeadPos :: Point3Q
        }
    | SlimeCrit
-        { _slimeRad :: Float
-        , _slimeRadWobble :: Float
-        , _slimeSplitTimer :: Int
-        , _slimeCompression :: Point2
+        { _slimeSlime :: Int -- note multiplied by 100
+        , _slimeSlimeChange :: Int
+--        , _slimeRadWobble :: Float
+        --, _slimeSplitTimer :: Int
+        , _slimeSplitTimer :: Maybe (Int, [Point2])
+        , _slimeCompression :: Float
        , _slimeIsCompressing :: Bool
        , _slimeEngulfProgress :: Float
        } 
    | BeeCrit
-        { _beeSlime :: Float
+        { _beeSlime :: Int
        , _beeHive :: Maybe Int
        , _startStopMv :: Int
        , _beeAggro :: Int
+        , _meleeCooldown :: Int
+        , _beeRandomMovement :: Maybe FootForward
+        , _beeLifespan :: Int
        }
    | HiveCrit
        { _hiveChildren :: IS.IntSet
        , _hiveGestation :: Int
+        , _hiveSlime :: Int
        }
    | SwarmCrit
    | AutoCrit
    | BarrelCrit {_barrelType :: BarrelType}
    | LampCrit {_lampHeight :: Float, _lampColor :: Point3, _lampLSID :: Maybe Int}

+slimeToRad :: Int -> Float
+slimeToRad x = sqrt $ fromIntegral x * 0.01
+
 data AvatarPosture = AvPosture

 data CreatureShape
@@ -24,14 +24,14 @@ data CrBl = CrCanShoot | CrIsAiming | CrIsAnimate
 data CrAc = CrTurnAround
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

-data CrWdAc
-    = CrWdBFSThenReturn Int
--    | ChooseMovementSpreadGun
-    | ChooseMovementLtAuto
-    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+--data CrWdAc
+--    = CrWdBFSThenReturn Int
+----    | ChooseMovementSpreadGun
+----    | ChooseMovementLtAuto
+--    deriving (Eq, Ord, Show, Read) --Generic, Flat)

 deriveJSON defaultOptions ''CrImp
 deriveJSON defaultOptions ''CrBl
 deriveJSON defaultOptions ''WdCrBl
 deriveJSON defaultOptions ''CrAc
-deriveJSON defaultOptions ''CrWdAc
+--deriveJSON defaultOptions ''CrWdAc
@@ -13,20 +13,32 @@ import Data.Aeson.TH
 import Geometry.Data

 data Damage
-    = Piercing {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
-    | Blunt {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
-    | Sparking {_dmAmount :: Int}
-    | Crushing {_dmAmount :: Int, _dmVector :: Point2}
-    | Shattering {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
-    | Flaming {_dmAmount :: Int}
-    | Lasering {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
-    | Flashing {_dmAmount :: Int, _dmPos :: Point2}
-    | Electrical {_dmAmount :: Int}
-    | Explosive {_dmAmount :: Int, _dmCenter :: Point2}
-    | Poison {_dmAmount :: Int}
-    | Enterrement {_dmAmount :: Int}
-    | Inertial {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2}
+    = Piercing {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2, _dmOrigin :: DamageOrigin}
+    | Blunt {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2, _dmOrigin :: DamageOrigin}
+    | Sparking {_dmAmount :: Int, _dmOrigin :: DamageOrigin}
+    | Crushing {_dmAmount :: Int, _dmVector :: Point2, _dmOrigin :: DamageOrigin}
+    | Shattering {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2, _dmOrigin :: DamageOrigin}
+    | Flaming {_dmAmount :: Int, _dmOrigin :: DamageOrigin}
+    | Lasering {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2, _dmOrigin :: DamageOrigin}
+    | Flashing {_dmAmount :: Int, _dmPos :: Point2, _dmOrigin :: DamageOrigin}
+    | Electrical {_dmAmount :: Int, _dmOrigin :: DamageOrigin}
+    | Explosive {_dmAmount :: Int, _dmOrigin :: DamageOrigin, _dmCenter :: Point2}
+    | Poison {_dmAmount :: Int, _dmOrigin :: DamageOrigin}
+    | Enterrement {_dmAmount :: Int, _dmOrigin :: DamageOrigin}
+    | Inertial {_dmAmount :: Int, _dmPos :: Point2, _dmVector :: Point2, _dmOrigin :: DamageOrigin}
+    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+data DamageOrigin 
+    = CrMeleeO { _doCID :: Int}
+    | CrWeaponO { _doCID :: Int}
+    | CrIndirectO {_doCID :: Int}
+    | McMeleeO { _doMID :: Int}
+    | McWeaponO { _doMID :: Int}
+    | McIndirectO {_doMID :: Int}
+    | UnassignedO
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

 makeLenses ''Damage
+makeLenses ''DamageOrigin
+deriveJSON defaultOptions ''DamageOrigin
 deriveJSON defaultOptions ''Damage
@@ -6,6 +6,7 @@ module Dodge.Data.EnergyBall (
    module Dodge.Data.EnergyBall.Type,
 ) where

+import Dodge.Data.Damage
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -17,6 +18,7 @@ data EnergyBall = EnergyBall
    , _ebPos :: Point3
    , _ebTimer :: Int
    , _ebType :: EnergyBallType
+    , _ebOrigin :: DamageOrigin
    }
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

@@ -8,11 +8,11 @@ import Data.Aeson
 import Data.Aeson.TH

 data EnergyBallType
-    = IncendiaryBall
+    = IncendiaryBall{}
    | FlameletBall {_fbSize :: Float}
    | ElectricalBall {_ebID :: Int}
-    | ExplosiveBall
-    | FlashBall
+    | ExplosiveBall{}
+    | FlashBall{}
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

 makeLenses ''EnergyBallType
@@ -3,6 +3,7 @@

 module Dodge.Data.Flame where

+import Dodge.Data.Damage
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -12,6 +13,7 @@ data Flame = Flame
    { _flTimer :: Int
    , _flPos :: Point2
    , _flVel :: Point2
+    , _flOrigin :: DamageOrigin
    }
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

@@ -3,6 +3,7 @@

 module Dodge.Data.Laser where

+import Dodge.Data.Damage
 import NewInt
 import Dodge.Data.Item.Location
 --import Color
@@ -21,6 +22,7 @@ data Laser = Laser
    , _lpPos :: Point2
    , _lpDir :: Float
    , _lpType :: LaserType
+    , _lpOrigin :: DamageOrigin
    }
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

@@ -1,10 +1,9 @@
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}

-module Dodge.Data.PlasmaBall (
-    module Dodge.Data.PlasmaBall
-) where
+module Dodge.Data.PlasmaBall (module Dodge.Data.PlasmaBall) where

+import Dodge.Data.Damage
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -14,6 +13,7 @@ data PlasmaBall = PBall
    { _pbType :: PlasmaBallType
    , _pbVel :: Point2
    , _pbPos :: Point2
+    , _pbOrigin :: DamageOrigin
    }
    deriving (Show, Eq, Ord, Read) --Generic, Flat)

@@ -3,6 +3,7 @@

 module Dodge.Data.Projectile where

+import Dodge.Data.Damage
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -24,6 +25,7 @@ data Projectile = Shell
    , _pjType :: ProjectileType
    , _pjDetonatorID :: Maybe (NewInt ItmInt)
    , _pjScreenID :: Maybe (NewInt ItmInt)
+    , _pjOrigin :: DamageOrigin
    }
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

@@ -3,6 +3,7 @@

 module Dodge.Data.PulseLaser where

+import Dodge.Data.Damage
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -14,6 +15,7 @@ data PulseLaser = PulseLaser
    , _pzDir :: Float
    , _pzDamage :: Int
    , _pzTimer :: Int
+    , _pzOrigin :: DamageOrigin
    }
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

@@ -22,6 +24,7 @@ data PulseBall = PulseBall
    , _pzbPos :: Point2
    , _pzbTimer :: Int
    , _pzbID :: Int
+    , _pzbOrigin :: DamageOrigin
    }
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

@@ -3,6 +3,7 @@

 module Dodge.Data.Shockwave where

+import Dodge.Data.Damage
 import Color
 import Control.Lens
 import Data.Aeson
@@ -22,6 +23,7 @@ data Shockwave = Shockwave
    , _swPush :: Float
    , _swMaxTime :: Int
    , _swTimer :: Int
+    , _swOrigin :: DamageOrigin
    }
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

@@ -6,6 +6,7 @@ module Dodge.Data.TeslaArc (
    module Dodge.Data.ArcStep,
 ) where

+import Dodge.Data.Damage
 import Color
 import Control.Lens
 import Data.Aeson
@@ -16,6 +17,7 @@ data TeslaArc = TeslaArc
    { _taTimer :: Int
    , _taArcSteps :: [ArcStep]
    , _taColor :: Color
+    , _taOrigin :: DamageOrigin
    }
    deriving (Eq, Ord, Show, Read) --Generic, Flat)

@@ -2,6 +2,9 @@

 module Dodge.Debug (debugEvents, drawDebug) where

+import Dodge.Base.Coordinate
+import Dodge.Zoning.Creature
+import Dodge.Creature.Radius
 import Geometry.Data
 import Dodge.Render.Label
 import Dodge.HeldUse
@@ -24,6 +27,7 @@ import Picture.Base
 import qualified SDL
 import System.Hclip
 import Text.Read
+import Data.List (sortOn)

 debugEvents :: Universe -> Universe
 debugEvents u = case dbools ^. at Display_debug of
@@ -81,6 +85,15 @@ debugEvent' = \case
    Debug_get -> id
    Debug_put -> id
    Muzzle_positions -> id
+    Show_cr_hitboxes -> id
+    Clipboard_cr -> clipboardCr
+
+clipboardCr :: Universe -> Universe
+clipboardCr u = fromMaybe u $ do
+    guard (u ^. uvWorld . input . mouseButtons . at SDL.ButtonLeft == Just 0)
+    return $ u & uvIOEffects %~ (\m u' -> setClipboard s >> m u')
+  where
+    s = unlines . prettyShort $ closestCrToMouse $ u ^. uvWorld

 debugItem :: DebugBool -> Universe -> Maybe [DebugItem]
 debugItem = \case
@@ -117,6 +130,8 @@ debugItem = \case
    Debug_get -> doDebugGet
    Debug_put -> debugPutItems
    Muzzle_positions -> mempty
+    Show_cr_hitboxes -> mempty
+    Clipboard_cr -> mempty

 debugGet :: Universe -> [String]
 debugGet u = foldMap getPretty $ u ^. uvWorld . cWorld . lWorld . shockwaves
@@ -287,7 +302,20 @@ drawDebug u = \case
    Show_writable_values -> mempty
    Show_mouse_click_pos -> mempty
    Muzzle_positions -> showMuzzlePositions u
+    Show_cr_hitboxes -> foldMap drawCreatureRad (u ^. uvWorld . cWorld . lWorld . creatures)
+    Clipboard_cr -> foldMap drawCreatureRad (closestCrToMouse $ u^.uvWorld)

+closestCrToMouse :: World -> Maybe Creature
+closestCrToMouse w = listToMaybe . sortOn (distance mwp . (^. crPos . _xy))
+        $ crsNearPoint mwp w
+  where
+    mwp = mouseWorldPos (w^.input) (w^.wCam)
+
+drawCreatureRad :: Creature -> Picture
+drawCreatureRad cr = setLayer DebugLayer
+    . translate3 (cr ^. crPos)
+    . color orange
+    $ circle (crRad (cr ^. crType))

 showMuzzlePositions :: Universe -> Picture
 showMuzzlePositions  u = fold $ do
@@ -43,7 +43,7 @@ defaultCreature =
                , _posture = AtEase
                }
        , _crVocalization = VocReady
-        , _crActionPlan = ActionPlan NoAction (StrategyActions WatchAndWait [StartSentinelPost]) [LiveLongAndProsper]
+        , _crActionPlan = ActionPlan NoAction WatchAndWait LiveLongAndProsper
        , _crPerception = defaultPerceptionState
        , _crMemory = defaultCreatureMemory
        , _crFaction = NoFaction
@@ -18,33 +18,34 @@ import Linear.V3
 import Picture
 import RandomHelp

-makeFlamelet :: Point3 -> Point3 -> Float -> Int -> World -> World
-makeFlamelet p v s t =
+makeFlamelet :: DamageOrigin -> Point3 -> Point3 -> Float -> Int -> World -> World
+makeFlamelet o p v s t =
    cWorld . lWorld . energyBalls
        .:~ EnergyBall
            { _ebVel = v
            , _ebPos = p
            , _ebTimer = t
            , _ebType = FlameletBall s
+            , _ebOrigin = o
            }

 updateEnergyBall :: World -> EnergyBall -> (World, Maybe EnergyBall)
 updateEnergyBall w eb
    | _ebTimer eb <= 0 = (w, Nothing)
    | otherwise =
-        ( ebEffect eb . ebFlicker eb $ ebDamage (eb ^. ebPos) (_ebType eb) w
+        ( ebEffect eb . ebFlicker eb $ ebDamage eb w
        , Just $ eb & ebTimer -~ 1 & ebPos . _xy .~ bp & ebVel . _xy .~ drag * bv
        )
  where
    drag = case eb ^. ebType of
-        ExplosiveBall -> 0.9
+        ExplosiveBall{} -> 0.9
        _ -> 0.85
    p = (eb ^. ebPos + eb ^. ebVel) ^. _xy
    (bp, bv) = fromMaybe (p, eb ^. ebVel . _xy) $ bouncePoint (const True) 0 (eb ^. ebPos . _xy) p w

 ebEffect :: EnergyBall -> World -> World
 ebEffect eb = case _ebType eb of
-    ElectricalBall i ->
+    ElectricalBall {_ebID = i} ->
        soundContinue (EBSound i) (eb ^. ebPos . _xy) elecCrackleS (Just 2)
            . randSparkExtraVel
                (eb ^. ebVel . _xy)
@@ -57,14 +58,15 @@ ebEffect eb = case _ebType eb of
            soundStart (EBSound (-1)) (eb ^. ebPos . _xy) fireFadeS Nothing
    _ -> id

-makeMovingEB :: Point2 -> EnergyBallType -> Point2 -> World -> World
-makeMovingEB v ebt p =
+makeMovingEB :: Point2 -> EnergyBallType -> DamageOrigin -> Point2 -> World -> World
+makeMovingEB v ebt o p =
    cWorld . lWorld . energyBalls
        .:~ EnergyBall
            { _ebVel = v `v2z` 0
            , _ebPos = p `v2z` 20
            , _ebTimer = 20
            , _ebType = ebt
+            , _ebOrigin = o
            }

 ebFlicker :: EnergyBall -> World -> World
@@ -79,21 +81,24 @@ ebColor eb = case eb ^. ebType of
    IncendiaryBall{} -> red
    FlameletBall{} -> red
    ElectricalBall{} -> cyan
-    ExplosiveBall -> white
-    FlashBall -> white
+    ExplosiveBall{} -> white
+    FlashBall{} -> white

-ebDamage :: Point3 -> EnergyBallType -> World -> World
-ebDamage sp dt
-    | z > 0 && z < 25 = damageInCircle (const $ ebtToDamage (sp ^. _xy) dt) (sp ^. _xy) r
+ebDamage :: EnergyBall -> World -> World
+ebDamage eb
+    | z > 0 && z < 25 = damageInCircle (const $ ebtToDamage (sp ^. _xy) o dt) (sp ^. _xy) r
    | otherwise = id
  where
+    sp = eb ^. ebPos
+    dt = eb ^. ebType
+    o = eb ^. ebOrigin
    z = sp ^. _z
    r = fromMaybe 5 $ dt ^? fbSize

-ebtToDamage :: Point2 -> EnergyBallType -> Damage
-ebtToDamage p = \case
-    FlameletBall{} -> Flaming 1
-    IncendiaryBall{} -> Flaming 10
-    ElectricalBall{} -> Electrical 10
-    ExplosiveBall -> Explosive 10 p
-    FlashBall -> Flashing 10 p
+ebtToDamage :: Point2 -> DamageOrigin -> EnergyBallType -> Damage
+ebtToDamage p o = \case
+    FlameletBall{} -> Flaming 1 o
+    IncendiaryBall{} -> Flaming 10 o
+    ElectricalBall{} -> Electrical 10 o
+    ExplosiveBall{} -> Explosive 10 o p
+    FlashBall{} -> Flashing 10 p o
@@ -6,11 +6,11 @@ import Picture

 drawEnergyBall :: EnergyBall -> Picture
 drawEnergyBall eb = case _ebType eb of
-    FlameletBall x -> drawFlamelet x eb
-    IncendiaryBall -> drawFlamelet 5 eb
+    FlameletBall {_fbSize=x} -> drawFlamelet x eb
+    IncendiaryBall{} -> drawFlamelet 5 eb
    ElectricalBall{} -> drawStaticBall eb
-    ExplosiveBall -> drawExplosiveBall eb
-    FlashBall -> mempty
+    ExplosiveBall{} -> drawExplosiveBall eb
+    FlashBall{} -> mempty

 drawExplosiveBall :: EnergyBall -> Picture
 drawExplosiveBall eb =
@@ -29,7 +29,7 @@ updateFlame w pt
    reflame wl = pt & flTimer -~ 1 & flVel %~ reflVelWallDamp 0.9 wl
    doupdate =
        soundContinue FlameSound sp fireLoudS (Just 2) $
-            damageInCircle (const $ Flaming 1) ep r w
+            damageInCircle (const $ Flaming 1 (pt ^. flOrigin)) ep r w
    thit = List.safeHead $ thingsHit sp ep w
    sp = _flPos pt
    ep = sp + _flVel pt
@@ -43,10 +43,10 @@ flFlicker pt
            .:~ LSParam (addZ 10 $ _flPos pt) 70 (0.5 *.*.* xyzV4 red)
    | otherwise = id

-makeFlame :: Point2 -> Point2 -> World -> World
-makeFlame pos vel w =
+makeFlame :: Point2 -> Point2 -> DamageOrigin -> World -> World
+makeFlame pos vel d w =
    w
-        & cWorld . lWorld . flames .:~ Flame t pos vel
+        & cWorld . lWorld . flames .:~ Flame t pos vel d
        & randGen .~ g
  where
    (t, g) = randomR (99, 102) (_randGen w)
@@ -14,11 +14,11 @@ createGas gc = case gc of

 aGasCloud :: Float -> Point2 -> Float -> Creature -> World -> World
 aGasCloud pressure pos dir cr =
-    makeGasCloud pos $
+    makeGasCloud (CrWeaponO (cr ^. crID)) pos $
        (cr ^. crPos . _xy - cr ^. crOldPos . _xy) + pressure *^ unitVectorAtAngle dir

 aFlame :: Float -> Point2 -> Float -> Creature -> World -> World
-aFlame pressure pos dir cr = makeFlame pos vel
+aFlame pressure pos dir cr = makeFlame pos vel (CrWeaponO (cr ^. crID))
  where
    --w & instantParticles .:~ aFlameParticle t pos vel Nothing -- (Just $ _crID cr)

@@ -743,11 +743,11 @@ useLoadedAmmo
 useLoadedAmmo loc cr mz m w =
    makeMuzzleFlare pq loc (mz ^. mzFlareType) $ case _mzEffect mz of
        MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w
-        MuzzleLaser -> creatureShootLaser pq' loc (w & randGen .~ g)
+        MuzzleLaser -> creatureShootLaser (CrWeaponO (cr ^. crID)) pq' loc (w & randGen .~ g)
        MuzzlePulseLaser -> creatureShootPulseLaser pq' cr (w & randGen .~ g)
-        MuzzlePulseBall -> shootPulseBall pq' (w & randGen .~ g)
-        MuzzlePlasmaBall -> shootPlasmaBall pq' (w & randGen .~ g)
-        MuzzleTesla -> shootTeslaArc pq' loc (w & randGen .~ g)
+        MuzzlePulseBall -> shootPulseBall o pq' (w & randGen .~ g)
+        MuzzlePlasmaBall -> shootPlasmaBall o pq' (w & randGen .~ g)
+        MuzzleTesla -> shootTeslaArc o pq' loc (w & randGen .~ g)
        MuzzleTractor -> shootTractorBeam cr w
        MuzzleRLauncher -> createProjectileR pq loc magtree cr w
        MuzzleGLauncher ->
@@ -776,6 +776,7 @@ useLoadedAmmo loc cr mz m w =
        MuzzleStopper -> useStopWatch itm cr w
        MuzzleScroller -> useTimeScrollGun itm cr w
  where
+    o = CrWeaponO $ cr ^. crID
    pq = muzzlePos loc cr mz
    (pq', g) = muzzleRandPos loc cr mz `runState` (w ^. randGen)
    itmtree = loc ^. locDT
@@ -856,9 +857,10 @@ tractorBeamAt pos outpos dir power =
        , _tbTime = 10
        }

-creatureShootLaser :: Point3Q -> LocationDT OItem -> World -> World
-creatureShootLaser (p, q) loc =
+creatureShootLaser :: DamageOrigin -> Point3Q -> LocationDT OItem -> World -> World
+creatureShootLaser o (p, q) loc =
    shootLaser
+        o
        (ItemSound (loc ^. locDT . dtValue . _1 . itID . unNInt) 0)
        (getLaserDamage loc)
        (getLaserPhaseV loc)
@@ -866,6 +868,7 @@ creatureShootLaser (p, q) loc =
        (Q.qToAng q)

 shootLaser ::
+    DamageOrigin ->
    SoundOrigin ->
    LaserType ->
    Float ->
@@ -873,13 +876,14 @@ shootLaser ::
    Float ->
    World ->
    World
-shootLaser so lt pv p dir =
+shootLaser o so lt pv p dir =
    ( cWorld . lWorld . lasers
        .:~ Laser
            { _lpType = lt
            , _lpPhaseV = pv
            , _lpPos = p
            , _lpDir = dir
+            , _lpOrigin = o
            }
    )
        . soundContinue so p tone440sawtoothquietS (Just 2)
@@ -887,12 +891,13 @@ shootLaser so lt pv p dir =
 creatureShootPulseLaser :: Point3Q -> Creature -> World -> World
 creatureShootPulseLaser (p, q) cr =
    shootPulseLaser
+        (CrWeaponO $ cr ^. crID)
        (CrWeaponSound (_crID cr) 0)
        (p ^. _xy)
        (Q.qToAng q)

-shootPulseLaser :: SoundOrigin -> Point2 -> Float -> World -> World
-shootPulseLaser so p dir w =
+shootPulseLaser :: DamageOrigin -> SoundOrigin -> Point2 -> Float -> World -> World
+shootPulseLaser o so p dir w =
    w
        & cWorld . lWorld . pulseLasers
            .:~ PulseLaser
@@ -901,23 +906,25 @@ shootPulseLaser so p dir w =
                , _pzDir = dir
                , _pzDamage = 101
                , _pzTimer = 5
+                , _pzOrigin = o
                }
        & soundStart so p lasPulseS Nothing

-shootPlasmaBall :: Point3Q -> World -> World
-shootPlasmaBall (p, q) w =
+shootPlasmaBall :: DamageOrigin -> Point3Q -> World -> World
+shootPlasmaBall o (p, q) w =
    w
        & cWorld . lWorld . plasmaBalls .:~
            PBall
                { _pbPos = p ^. _xy
                , _pbVel = 6 * unitVectorAtAngle (Q.qToAng q)
                , _pbType = DefaultPlasma
+                , _pbOrigin = o
                }
 --        & soundStart (PBSound i) (p ^. _xy) energyReleaseS Nothing


-shootPulseBall :: Point3Q -> World -> World
-shootPulseBall (p, q) w =
+shootPulseBall :: DamageOrigin -> Point3Q -> World -> World
+shootPulseBall o (p, q) w =
    w
        & cWorld . lWorld . pulseBalls . at i
            ?~ PulseBall
@@ -925,6 +932,7 @@ shootPulseBall (p, q) w =
                , _pzbVel = 3.5 * unitVectorAtAngle (Q.qToAng q)
                , _pzbTimer = 200
                , _pzbID = i
+                , _pzbOrigin = o
                }
        & soundStart (PBSound i) (p ^. _xy) energyReleaseS Nothing
  where
@@ -990,7 +998,8 @@ shootBullets
    :: LocationDT OItem -> Creature -> (Muzzle, Int, DTree OItem) -> World -> World
 shootBullets loc cr (mz, x, magtree) w = fromMaybe w $ do
    thebullet <- getBulletType magtree
-    return $ foldl' (&) w (replicate x (shootBullet thebullet loc cr mz))
+    let bu = thebullet & buOrigin .~ CrWeaponO (cr ^. crID)
+    return $ foldl' (&) w (replicate x (shootBullet bu loc cr mz))

 shootBullet :: Bullet -> LocationDT OItem -> Creature -> Muzzle -> World -> World
 shootBullet bu loc cr mz w = makeBullet bu itm pq . (randGen .~ g) $ w
@@ -1180,7 +1189,7 @@ doGenFloat (UniRandFloat x y) g = randomR (x, y) g

 mcShootLaser :: Item -> Machine -> World -> World
 mcShootLaser _ mc =
-    shootLaser (MachinePrimarySound (_mcID mc)) (DamageLaser 11) 1 pos dir
+    shootLaser (McWeaponO (mc ^. mcID)) (MachinePrimarySound (_mcID mc)) (DamageLaser 11) 1 pos dir
  where
    pos = _mcPos mc +.+ 20 *.* unitVectorAtAngle dir
    dir = (mc ^?! mcType . mctTurret . tuDir)
@@ -1203,14 +1212,14 @@ mcShootAuto itm mc w
 --    dir = mc ^?! mcType . _McTurret . tuDir

 -- | assumes that the item is held
-shootTeslaArc :: Point3Q -> LocationDT OItem -> World -> World
-shootTeslaArc (p, q) loc w =
+shootTeslaArc :: DamageOrigin -> Point3Q -> LocationDT OItem -> World -> World
+shootTeslaArc o (p, q) loc w =
    w' & cWorld . lWorld . items . ix itid . itParams .~ ip
        & soundContinue (ItemSound itid 0) pos elecCrackleS (Just 2)
  where
    itm = loc ^. locDT . dtValue . _1
    itid = itm ^. itID . unNInt
-    (w', ip) = makeTeslaArc (itm ^. itParams) pos (Q.qToAng q) w
+    (w', ip) = makeTeslaArc o (itm ^. itParams) pos (Q.qToAng q) w
    pos = p ^. _xy

 determineProjectileTracking :: DTree OItem -> DTree OItem -> RocketHoming
@@ -1,64 +1,54 @@
 module Dodge.Humanoid (
-    chaseCritInternal,
+    updateChaseCrit,
    crabCritInternal,
-    hoverCritInternal,
+    updateHoverCrit,
 ) where

-import Data.Foldable
 import Dodge.Creature
 import Dodge.Data.World
 import LensHelp

-chaseCritInternal :: World -> Creature -> Creature
-chaseCritInternal w cr =
-    foldl'
-        (\c f -> f w c)
-        cr
-        [ const doStrategyActions
-        , overrideMeleeCloseTarget
-        , setViewPos
-        , setMvPosToTargetCr
-        , chaseCritMv
-        , perceptionUpdate [0]
-        , targetYouWhenCognizant
-        , const searchIfDamaged
-        , const (crType . meleeCooldown %~ max 0 . subtract 1)
-        , const (crVocalization %~ updateVocTimer)
-        ]
-
-crabCritInternal :: Int -> World -> World
-crabCritInternal cid w =
--    (crVocalization %~ updateVocTimer)
-        (tocr %~ (crType . meleeCooldownL %~ max 0 . subtract 1))
-        . (tocr %~ (crType . meleeCooldownR %~ max 0 . subtract 1))
-        . (tocr %~ (crType . dodgeCooldown %~ max 0 . subtract 1))
-        . (tocr %~ searchIfDamaged)
-        . (tocr %~ targetYouWhenCognizant w)
-        . (tocr %~ perceptionUpdate [0] w)
-        . crabActionUpdate cid
-        . (tocr %~ setMvPosToTargetCr w)
-        . (tocr %~ setViewPos w)
--        . overrideMeleeCloseTarget w
-        $ (tocr %~ doStrategyActions) w
+updateChaseCrit :: Int -> World -> World
+updateChaseCrit cid w = w
+    & tocr %~ overrideMeleeCloseTarget w
+    & tocr %~ setViewPos w
+    & tocr %~ setMvPosToTargetCr w
+    & tocr %~ chaseCritMv w
+    & tocr %~ perceptionUpdate [0] w
+    & tocr %~ targetYouWhenCognizant w
+    & tocr %~ searchIfDamaged
+    & tocr . crType . meleeCooldown %~ max 0 . subtract 1
+    & tocr . crVocalization %~ updateVocTimer
  where
    tocr = cWorld . lWorld . creatures . ix cid

-hoverCritInternal :: World -> Creature -> Creature
-hoverCritInternal w cr =
-    foldl'
-        (\c f -> f w c)
-        cr
-        [ const doStrategyActions
-        , overrideMeleeCloseTarget
-        , setViewPos
-        , setMvPosToTargetCr
-        , hoverCritMv
-        , perceptionUpdate [0]
-        , targetYouWhenCognizant
-        , const searchIfDamaged
-        , const (crType . meleeCooldown %~ max 0 . subtract 1)
-        , const (crVocalization %~ updateVocTimer)
-        ]
+crabCritInternal :: Int -> World -> World
+crabCritInternal cid w = w
+    & tocr %~ setViewPos w
+    & tocr %~ setMvPosToTargetCr w
+    & crabActionUpdate cid
+    & tocr %~ perceptionUpdate [0] w
+    & tocr %~ targetYouWhenCognizant w
+    & tocr %~ searchIfDamaged
+    & tocr . crType . dodgeCooldown %~ max 0 . subtract 1
+    & tocr . crType . meleeCooldownR %~ max 0 . subtract 1
+    & tocr . crType . meleeCooldownL %~ max 0 . subtract 1
+  where
+    tocr = cWorld . lWorld . creatures . ix cid
+
+updateHoverCrit :: Int -> World -> World
+updateHoverCrit cid w = w
+        & tocr %~ overrideMeleeCloseTarget w
+        & tocr %~ setViewPos w
+        & tocr %~ setMvPosToTargetCr w
+        & tocr %~ hoverCritMv w
+        & tocr %~ perceptionUpdate [0] w
+        & tocr %~ targetYouWhenCognizant w
+        & tocr %~ searchIfDamaged
+        & tocr . crType . meleeCooldown %~ max 0 . subtract 1
+        & tocr . crVocalization %~ updateVocTimer
+  where
+    tocr = cWorld . lWorld . creatures . ix cid

 updateVocTimer :: Vocalization -> Vocalization
 updateVocTimer VocTimer{_vcTime = x, _vcMaxTime = y} | x < y = VocTimer (x + 1) y
@@ -16,6 +16,7 @@ defaultBullet =
        , _buDrag = 1
        , _buPos = 0
        , _buOldPos = 0
+        , _buOrigin = UnassignedO
        }

 --basicBulDams :: [Damage]
@@ -14,7 +14,7 @@ updateLaser w pt =
    ( case _lpType pt of
        DamageLaser dam ->
            damThingHitWith
-                (\p2 -> Lasering dam p2 (xp - sp))
+                (\p2 -> Lasering dam p2 (xp - sp) (pt ^. lpOrigin))
                thHit
                w
        TargetingLaser itid -> w & pointerToItemID itid . itTargeting . itTgPos ?~ last ps
@@ -16,7 +16,7 @@ destroyMachine mc =
    (cWorld . lWorld . machines %~ IM.delete (_mcID mc))
        . deleteWallIDs (IM.keysSet $ _mcFootPrint mc)
        . makeMachineDebris mc
-        . makeSmallExplosionAt (20 & _xy .~ _mcPos mc) 0
+        . makeSmallExplosionAt (McIndirectO (mc ^. mcID)) (20 & _xy .~ _mcPos mc) 0
        . mcKillTerm mc
        . mcKillBut mc
        . destroyMcType (mc ^. mcType) mc
@@ -40,14 +40,14 @@ laserSpark = makeSpark FireSpark

 damageStone :: Damage -> ECW -> World -> (Int,World)
 damageStone dm ecw w = case dm of
-        Lasering _ p t -> f 0 $ laserSpark (outTo p t) (rdir p t)
-        Piercing _ p t -> 
+        Lasering _ p t _ -> f 0 $ laserSpark (outTo p t) (rdir p t)
+        Piercing _ p t _ -> 
            f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t)
                . makeDustAt Stone 200 (addZ 20 (outTo p t))
 --                . randsound p [slapS, slap1S,slap2S,slap3S,slap4S,slap5S,slap6S,slap7S]
                . randsound p [slapS, slap1S, slap2S]
-        Blunt _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
-        Shattering _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
+        Blunt _ p t _ -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
+        Shattering _ p t _ -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
        Crushing{} -> f dmam  id
        Explosive{} -> f dmam  id
        Sparking{} -> f 0  id
@@ -91,14 +91,14 @@ damagePiezoelectric = damageStone

 damagePhotovoltaic :: Damage -> ECW -> World -> (Int,World)
 damagePhotovoltaic dm ecw w = case dm of
-        Lasering _ p t -> f (10*dmam) $ laserSpark (outTo p t) (rdir p t)
-        Piercing _ p t -> 
+        Lasering _ p t _ -> f (10*dmam) $ laserSpark (outTo p t) (rdir p t)
+        Piercing _ p t _ -> 
            f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t)
                . makeDustAt Stone 200 (addZ 20 (outTo p t))
 --                . randsound p [slapS, slap1S,slap2S,slap3S,slap4S,slap5S,slap6S,slap7S]
                . randsound p [slapS, slap1S, slap2S]
-        Blunt _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
-        Shattering _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
+        Blunt _ p t _ -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
+        Shattering _ p t _ -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
        Crushing{} -> f dmam  id
        Explosive{} -> f dmam  id
        Sparking{} -> f 0  id
@@ -124,11 +124,11 @@ damagePhotovoltaic dm ecw w = case dm of

 damageMetal :: Damage -> ECW -> World -> (Int,World)
 damageMetal dm ecw w = case dm of
-        Lasering _ p t -> f 0 $ laserSpark (outTo p t) (rdir p t)
-        Piercing _ p t -> f dmam $
+        Lasering _ p t _ -> f 0 $ laserSpark (outTo p t) (rdir p t)
+        Piercing _ p t _ -> f dmam $
            makeSpark NormalSpark (outTo p t) (rdir p t)
                . randsound p [tingS, ting1S, ting2S, ting3S, ting4S, ting5S]
-        Blunt _ p t -> f dmam $
+        Blunt _ p t _ -> f dmam $
            makeSpark NormalSpark (outTo p t) (rdir p t)
                . randsound p [clangS,clang1S,clang2S]
        Shattering {} -> f dmam  id
@@ -158,7 +158,7 @@ damageMetal dm ecw w = case dm of
 damageFlesh :: Damage -> ECW -> World -> (Int,World)
 damageFlesh dm _ w = (dm ^. dmAmount,) $ w & case dm of
    Lasering {} -> id
-    Piercing _ p t ->
+    Piercing _ p t _ ->
        randsound
            p
            [ bloodShort1S
@@ -171,7 +171,7 @@ damageFlesh dm _ w = (dm ^. dmAmount,) $ w & case dm of
            , bloodShort8S
            ]
                . makeDustAt Flesh 50 (addZ 20 (outTo p t))
-    Blunt _ p _ -> randsound p [hitS]
+    Blunt _ p _ _ -> randsound p [hitS]
    Shattering {} -> id
    Crushing{} -> id
    Explosive{} -> id
@@ -192,14 +192,14 @@ damageFlesh dm _ w = (dm ^. dmAmount,) $ w & case dm of
 damageDirt :: Damage -> ECW -> World -> (Int,World)
 damageDirt dm _ w =
    (dm^. dmAmount,) $ w & case dm of
-        Lasering _ p t -> --  makeSpark FireSpark (outTo p t) (rdir p t)
+        Lasering _ p t _ -> --  makeSpark FireSpark (outTo p t) (rdir p t)
            makeDustAt Dirt 200 (addZ 20 (outTo p t))
-        Piercing _ p t ->
+        Piercing _ p t _ ->
            makeDustAt Dirt 200 (addZ 20 (outTo p t))
                -- . randsound p [slapS, slap1S]
                . randsound p [slapS, slap1S,slap2S,slap3S,slap4S,slap5S,slap6S,slap7S]
-        Blunt _ p t -> makeDustAt Dirt 200 (addZ 20 (outTo p t))
-        Shattering _ p t -> makeDustAt Dirt 200 (addZ 20 (outTo p t))
+        Blunt _ p t _ -> makeDustAt Dirt 200 (addZ 20 (outTo p t))
+        Shattering _ p t _ -> makeDustAt Dirt 200 (addZ 20 (outTo p t))
        Crushing{} -> id
        Explosive{} -> id
        Sparking{} -> id
@@ -219,16 +219,16 @@ damageDirt dm _ w =
 damageGlass :: Damage -> ECW -> World -> (Int,World)
 damageGlass dm ecw w = case dm of
        Lasering {} -> f 0  id
-        Piercing _ p t -> 
+        Piercing _ p t _ -> 
            f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t)
 --                . makeDustAt Stone 200 (addZ 20 (outTo p t))
                 . randsound p [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
-        Blunt _ p _ -> f dmam $ -- makeDustAt Stone 200 (addZ 20 (outTo p t))
+        Blunt _ p _ _ -> f dmam $ -- makeDustAt Stone 200 (addZ 20 (outTo p t))
                 randsound p [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
-        Shattering _ p t -> f dmam $ makeDustAt Glass 200 (addZ 20 (outTo p t))
+        Shattering _ p t _ -> f dmam $ makeDustAt Glass 200 (addZ 20 (outTo p t))
                . randsound p [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
        Crushing{} -> f dmam  id
-        Explosive _ p -> f dmam  -- the sound comes from the explosion center, which is not correct...
+        Explosive _ _ p -> f dmam  -- the sound comes from the explosion center, which is not correct...
            $ randsound p [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
        Sparking{} -> f 0  id
        Flaming{} -> f 0  id
@@ -286,14 +286,14 @@ damageGlass dm ecw w = case dm of
 damageCrystal :: Damage -> ECW -> World -> (Int,World)
 damageCrystal dm ecw w = case dm of
        Lasering {} -> f  id
-        Piercing _ p t -> 
+        Piercing _ p t _ -> 
            f $ makeSpark NormalSpark (outTo p t) (rdir p t)
                 . randsound p [marimbaC5S,marimbaE5S,marimbaG5S,marimbaB6S]
-        Blunt _ p _ -> f $ -- makeDustAt Stone 200 (addZ 20 (outTo p t))
+        Blunt _ p _ _ -> f $ -- makeDustAt Stone 200 (addZ 20 (outTo p t))
                 randsound p [marimbaC5S,marimbaE5S,marimbaG5S,marimbaB6S]
-        Shattering _ p _ -> f $ randsound p [marimbaC5S,marimbaE5S,marimbaG5S,marimbaB6S]
+        Shattering _ p _ _ -> f $ randsound p [marimbaC5S,marimbaE5S,marimbaG5S,marimbaB6S]
        Crushing{} -> f  id
-        Explosive _ p -> f  -- the sound comes from the explosion center, which is not correct...
+        Explosive _ _ p -> f  -- the sound comes from the explosion center, which is not correct...
            $ randsound p [smallGlass1S, smallGlass2S, smallGlass3S, smallGlass4S]
        Sparking{} -> f   id
        Flaming{} -> f   id
@@ -15,19 +15,20 @@ import Geometry.Data
 import LensHelp
 import Linear.V3

-usePayload :: Payload -> Point3 -> Point3 -> World -> World
+usePayload :: Payload -> DamageOrigin -> Point3 -> Point3 -> World -> World
 usePayload = \case
    ExplosionPayload -> makeExplosionAt
    ShrapnelBomb -> makeShrapnelAt
-    DudPayload -> const (const id)
+    DudPayload -> const (const (const id))

-makeShrapnelAt :: Point3 -> Point3 -> World -> World
-makeShrapnelAt p' vel' w =
+-- potential turn the origin indirect?
+makeShrapnelAt :: DamageOrigin -> Point3 -> Point3 -> World -> World
+makeShrapnelAt o p' vel' w =
    w
        & soundMultiFrom [Explosion 0, Explosion 1] p bangS Nothing
        & cWorld . lWorld . worldEvents
            .:~ MakeTempLight (LSParam p' 150 (V3 0.8 0.8 0.8)) 20
-        & makeShockwaveAt [] p' 50 5 0 white
+        & makeShockwaveAt [] p' 50 5 0 white o
        & cWorld . lWorld . bullets .++~ buls
  where
    p = p' ^. _xy
@@ -43,3 +44,4 @@ makeShrapnelAt p' vel' w =
        & buDrag .~ drag
        & buPos .~ (p - v)
        & buOldPos .~ (p - v)
+        & buOrigin .~ o
@@ -45,6 +45,7 @@ createShell (p, q) mdetonator mscreen stab pjtype payload cr w =
                , _pjType = pjtype
                , _pjDetonatorID = mdetonator
                , _pjScreenID = mscreen
+                , _pjOrigin = CrWeaponO $ cr ^. crID
                }
  where
    dir = Q.qToAng q
@@ -143,6 +143,7 @@ doThrust pj smoke w =
        %~ (\v -> accel + frict *^ v)
        & soundContinue (ShellSound i) (ep ^. _xy) missileLaunchS (Just 1)
        & makeFlamelet
+            (pj ^. pjOrigin)
            (sp - 0.5 *^ vel)
            (vel + rotateV (pi + sparkD) accel `v2z` 0)
            3
@@ -283,7 +284,7 @@ explodeShell pj w =
        & pjlens
        . pjTimer
        .~ 30
-        & usePayload (_pjPayload pj) (pj ^. pjPos) (pj ^. pjVel)
+        & usePayload (_pjPayload pj) (pj ^. pjOrigin) (pj ^. pjPos) (pj ^. pjVel)
        & stopSoundFrom (ShellSound pjid)
        & updatedetonator
  where
@@ -411,8 +411,8 @@ doDrawing' win pdata u = do
            glDrawArrays GL_TRIANGLES 0 6
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    -- draw the overlay
-    glDepthFunc GL_LEQUAL
-    --glDepthFunc GL_ALWAYS
+    --glDepthFunc GL_LEQUAL
+    glDepthFunc GL_ALWAYS
    glDepthMask GL_FALSE
    glEnable GL_BLEND
    --glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
@@ -56,10 +56,16 @@ tutAnoTree :: State LayoutVars MTRS
 tutAnoTree = do
    foldMTRS
        [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
+--        , corDoor
+--        , chasmSpitTerminal
+--        , tToBTree "" . return . cleatOnward <$> slowDoorRoom
        , corDoor
        --, tToBTree "" . return . cleatOnward <$> (xChasm 200 200
        , tToBTree "" . return . cleatOnward <$> ((putSingleLight =<< roomRectAutoLights 300 300)
-            <&> rmPmnts <>~ [sps0 (PutCrit slimeCrit) & plSpot . psPos .~ V2 150 100
+            <&> rmPmnts <>~ 
+            [sps0 (PutCrit slimeCrit) & plSpot . psPos .~ V2 150 100
+            ,sps0 (PutCrit slimeCrit) & plSpot . psPos .~ V2 50 50
+            ,sps0 (PutCrit slimeCrit) & plSpot . psPos .~ V2 50 150
            , sps0 (PutCrit hiveCrit) & plSpot . psPos .~ V2 250 50
            , sps0 (PutCrit chaseCrit) & plSpot . psPos .~ V2 250 100
            ]
@@ -370,11 +376,13 @@ chasmSpitTerminal = do
                   , [sps0 $ putShape $ gird (V2 0 20) (V2 300 20), sps0 $ putShape $ gird (V2 0 280) (V2 300 280)]
                   ]
    let y' = y & rmPmnts <>~ ls <> dec
-        cr = PutCrit chaseCrit
+        cr = PutCrit hoverCrit
    return $
        tToBTree "chasmTerm" $
            Node
-                (addDoorToggleTerminal' i1 (PS 150 0) y')
+                (addDoorToggleTerminal' i1 (PS 150 0) y'
+--                    & rmPmnts .:~ (sps0 (PutCrit slimeCrit) & plSpot . psPos .~ V2 150 100)
+                )
                [ treePost [triggerDoorRoom i1, deadEndPSType cr]
                , treePost [triggerDoorRoom i1, deadEndPSType cr]
                , return $ cleatOnward $ triggerDoorRoom i1
@@ -25,7 +25,7 @@ moveShockwave w sw
    doDams 
        | (p ^. _z >= 0) && (p ^. _z < 25)
            && t > 5
-            = damageInCircle (Explosive dam) (p ^. _xy) rad
+            = damageInCircle (Explosive dam (sw ^. swOrigin)) (p ^. _xy) rad
        | otherwise = id

 moveInverseShockwave ::
@@ -39,9 +39,9 @@ sparkDam = damageCrWl . sparkToDamage

 sparkToDamage :: Spark -> [Damage]
 sparkToDamage sp = case _skType sp of
-    ElectricSpark -> [Electrical 10]
-    FireSpark -> [Flaming 1]
-    NormalSpark -> [Sparking 10]
+    ElectricSpark -> [Electrical 10 UnassignedO]
+    FireSpark -> [Flaming 1 UnassignedO]
+    NormalSpark -> [Sparking 10 UnassignedO]

 makeSpark :: SparkType -> Point2 -> Float -> World -> World
 makeSpark st p d =
@@ -25,14 +25,15 @@ import Picture
 import RandomHelp
 --import Shape

-makeTeslaArc :: ItemParams -> Point2 -> Float -> World -> (World, ItemParams)
-makeTeslaArc ip pos dir w =
+makeTeslaArc :: DamageOrigin -> ItemParams -> Point2 -> Float -> World -> (World, ItemParams)
+makeTeslaArc o ip pos dir w =
    ( w & randGen .~ g
        & cWorld . lWorld . teslaArcs
            .:~ TeslaArc
                { _taArcSteps = newarc
                , _taTimer = 2
                , _taColor = brightX 100 1.5 col
+                , _taOrigin = o
                }
    , ip & currentArc .~ newarc
    )
@@ -35,17 +35,32 @@ import NewInt
 import RandomHelp
 import qualified SDL
 import ShortShow
+import qualified Data.IntSet as IS

 tocrs :: (IM.IntMap Creature
          -> Const (Endo [String]) (IM.IntMap Creature))
         -> Universe -> Const (Endo [String]) Universe
 tocrs = uvWorld . cWorld . lWorld . creatures

+isBee :: Creature -> Bool
+isBee cr = case cr ^. crType of
+    BeeCrit{} -> True
+    _ -> False
+
+crslime :: Creature -> Int
+crslime cr = case cr ^. crType of
+    SlimeCrit {_slimeSlime=r} | HP{} <- cr ^. crHP -> r -- r ^ (2::Int)
+    HiveCrit {_hiveSlime=x} -> x
+    BeeCrit {_beeSlime=x} -> 400 + x
+    _ -> 0
+
+crs :: Universe -> [Creature]
+crs u = u ^.. uvWorld . cWorld . lWorld . creatures . each
+
 testStringInit :: Universe -> [String]
-testStringInit u = u ^.. tocrs . ix 2 . crType . hiveChildren . to show
-    <> u ^.. tocrs . ix 3 . crStance . carriage . to show
-    <> u ^.. tocrs . ix 3 . crDir . to show
-    <> u ^.. tocrs . ix 3 . crActionPlan . apAction . to show
+testStringInit _ = mempty
+    --[show . getSum $ foldMap (Sum . crslime) (crs u)]
+--     u ^.. tocrs . each . crType . slimeSplitTimer . to show
 --    u ^.. tocrs . ix 1 . crPos . _xy . to show
 --    <> u ^.. tocrs . ix 1 . crType . slimeCompression . to show
 --    <> u ^.. tocrs . ix 1 . crType . slimeCompression . to norm . to show
@@ -283,7 +283,7 @@ functionalUpdate =
        . over uvWorld updateDistortions
        . over uvWorld updateCreatureSoundPositions
        . over uvWorld updateCreatureStrides
-        . over uvWorld pushYouOutFromWalls
+        . pushYouOutFromWalls
        . colCrsWalls
        . over uvWorld simpleCrSprings
        . over uvWorld updateDoors
@@ -316,8 +316,8 @@ functionalUpdate =
            (updateIMl' (_linearShockwaves . _lWorld . _cWorld) updateLinearShockwave)
        . over uvWorld (updateIMl' (_projectiles . _lWorld . _cWorld) updateProjectile)
        . over uvWorld updateClouds
-        . over uvWorld updateBeePheremones
-        . over uvWorld updateGasses
+        . over uvWorld (updateObjMapMaybe beePheremones updateBeePheremone)
+        . over uvWorld (updateObjCatMaybes gasses updateGas)
        . over uvWorld updateDusts
        . over uvWorld updateGusts
        . over uvWorld (updateIMl' (_terminals . _lWorld . _cWorld) updateTerminal)
@@ -342,8 +342,10 @@ functionalUpdate =
        . updateAimPos
        . over uvWorld updatePastWorlds -- it might be possible to do this without storing stuff such as the temporary lights/flares etc

-pushYouOutFromWalls :: World -> World
-pushYouOutFromWalls w = w & cWorld . lWorld . creatures . ix 0 %~ muzzleWallCheck w
+pushYouOutFromWalls :: Universe -> Universe
+pushYouOutFromWalls u
+    | debugOn Noclip (u ^. uvConfig) = u
+    | otherwise = u & uvWorld . cWorld . lWorld . creatures . ix 0 %~ muzzleWallCheck (u ^. uvWorld)

 -- rotate creature as well? behaviour on ledges?
 muzzleWallCheck :: World -> Creature -> Creature
@@ -540,7 +542,7 @@ updatePlasmaBall w pb
    dodam = \case
        Left cr -> creatures . ix (_crID cr) . crDamage .:~ thedam
        Right wl -> wallDamages . at (_wlID wl) . non mempty .:~ thedam
-    thedam = Lasering 100 ep (pb ^. pbVel)
+    thedam = Lasering 100 ep (pb ^. pbVel) (pb ^. pbOrigin)
    sp = pb ^. pbPos
    ep = sp + pb ^. pbVel
    thit = thingHit sp ep w
@@ -560,7 +562,7 @@ updatePulseBall pb w
    dodam = \case
        Left cr -> creatures . ix (_crID cr) . crDamage .:~ thedam
        Right wl -> wallDamages . at (_wlID wl) . non mempty .:~ thedam
-    thedam = Lasering 100 ep (pb ^. pzbVel)
+    thedam = Lasering 100 ep (pb ^. pzbVel) (pb ^. pzbOrigin)
    sp = pb ^. pzbPos
    ep = sp + pb ^. pzbVel
    thit = listToMaybe $ thingsHitZ 20 sp ep w
@@ -609,13 +611,14 @@ setOldPos cr = cr & crOldPos .~ _crPos cr

 zoneCreatures :: World -> World
 zoneCreatures w =
-    w & crZoning .~ foldl' zoneCreature mempty (IM.filter zonableCreature $ w ^. cWorld . lWorld . creatures)
+--    w & crZoning .~ foldl' zoneCreature mempty (IM.filter zonableCreature $ w ^. cWorld . lWorld . creatures)
+    w & crZoning .~ foldl' zoneCreature mempty (w ^. cWorld . lWorld . creatures)

-zonableCreature :: Creature -> Bool
-zonableCreature cr = case cr ^. crHP of
-    HP{} -> True
-    CrIsCorpse{} -> True
-    CrDestroyed{} -> False
+--zonableCreature :: Creature -> Bool
+--zonableCreature cr = case cr ^. crHP of
+--    HP{} -> True
+--    CrIsCorpse{} -> True
+--    AvatarDestroyed{} -> False

 updateCreatureSoundPositions :: World -> World
 updateCreatureSoundPositions w =
@@ -718,7 +721,7 @@ updateTeslaArc w pt
            , randWallReflect ld' wl
            )
        | ArcStep lp' ld' _ <- last thearc = (lp', rp ld')
-    damthings (ArcStep _ _ crwl) = damageCrWlID [Electrical 50] crwl
+    damthings (ArcStep _ _ crwl) = damageCrWlID [Electrical 50 (pt ^. taOrigin)] crwl

 updatePulseLaser :: PulseLaser -> (Endo World, [PulseLaser])
 updatePulseLaser pz = case pz ^. pzTimer of
@@ -734,14 +737,14 @@ updatePulseLaser pz = case pz ^. pzTimer of
    dodam thit = case thit of
        ((p, OCreature cr) : _) ->
            cWorld . lWorld . creatures . ix (_crID cr) . crDamage
-                .:~ Lasering (pz ^. pzDamage) p (xp - sp)
+                .:~ Lasering (pz ^. pzDamage) p (xp - sp) (pz ^. pzOrigin)
        ((p, OWall wl) : _) ->
            cWorld . lWorld . wallDamages . at (_wlID wl) . non mempty
-                .:~ Lasering (pz ^. pzDamage) p (xp - sp)
+                .:~ Lasering (pz ^. pzDamage) p (xp - sp) (pz ^. pzOrigin)
        ((_, OPulseBall pb) : xs) ->
            dodam xs
                . (cWorld . lWorld . pulseBalls . ix (_pzbID pb) . pzbTimer .~ 0)
-                . makeExplosionAt (_pzbPos pb `v2z` 20) 0
+                . makeExplosionAt (pb ^. pzbOrigin) (_pzbPos pb `v2z` 20) 0
        _ -> id
    phasev = _pzPhaseV pz
    sp = _pzPos pz
@@ -780,17 +783,13 @@ updateSparks = updateObjCatMaybes sparks updateSpark
 updateClouds :: World -> World
 updateClouds w = updateObjMapMaybe clouds (updateCloud w) w

-updateBeePheremones :: World -> World
-updateBeePheremones w = updateObjMapMaybe beePheremones updateBeePheremone w
-
 updateBeePheremone :: BeePheremone -> Maybe BeePheremone
 updateBeePheremone bp 
    | x <- bp ^. bpTimer
    , x <= 0 = Nothing
    | otherwise = Just $ bp & bpTimer -~ 1
-
-updateGasses :: World -> World
-updateGasses = updateObjCatMaybes gasses updateGas
+        & bpVel *~ 0.90
+        & bpPos +~ (bp ^. bpVel)

 updateDusts :: World -> World
 updateDusts w = updateObjMapMaybe dusts (updateDust w) w
@@ -1007,7 +1006,7 @@ canSpring cr =
    cr ^. crPos . _z >= 0 && case cr ^. crHP of
        HP{} -> True
        CrIsCorpse{} -> True
-        CrDestroyed{} -> False
+        AvatarDestroyed{} -> False

 crCrSpring :: Creature -> Creature -> World -> World
 crCrSpring c1 c2
@@ -1015,6 +1014,10 @@ crCrSpring c1 c2
    | vec == V2 0 0 = id
    | diff >= comRad = id
    | diffheight = id
+    | Rooted <- c2 ^. crStance . carriage = id
+    | Rooted <- c1 ^. crStance . carriage 
+        = cWorld . lWorld . creatures . ix id2 . crPos . _xy +~ 
+            (diff - comRad) *^ signorm vec
    | SlimeCrit{} <- c1 ^. crType
    , SlimeCrit{} <- c2 ^. crType
    , id2 > id1 
@@ -1023,9 +1026,8 @@ crCrSpring c1 c2
    , slimeFood c2
    , distance xy1 xy2 < r1 - (r2 + 5)
        = feedSlime c1 c2
-    | Just t <- c1 ^? crType . slimeSplitTimer 
-        , slimeFood c2
-        , t <= 0 = slimeSuck c1 c2
+    | Just Nothing <- c1 ^? crType . slimeSplitTimer 
+        , slimeFood c2 = slimeSuck c1 c2
    | SlimeCrit{} <- c1 ^. crType = id
    | SlimeCrit{} <- c2 ^. crType = id
    | otherwise = cWorld . lWorld . creatures %~ ( olap c1 c2 . olap' c2 c1)
@@ -1074,6 +1076,7 @@ slimeFood cr = case cr ^. crType of
    Avatar{} -> True
    ChaseCrit{} -> True
    CrabCrit {} -> True
+    BeeCrit{} | CrIsCorpse{} <- cr ^. crHP -> True
    _ -> False

 feedSlime :: Creature -> Creature -> World -> World
@@ -1084,35 +1087,31 @@ feedSlime s c w = fromMaybe w $ do
                & slimeSuck s c
        else
             w
-            & cWorld . lWorld . creatures . ix (c ^. crID) . crHP .~ CrDestroyed Swallowed
+            & cWorld . lWorld . creatures . at (c ^. crID) %~ destroyCreature
            & cWorld . lWorld . creatures . ix (s ^. crID) %~ f
            & slimeEatSound (s ^. crID) (s ^. crPos . _xy)
  where
-    f cr = cr & crType . slimeRad .~ r
-            & crType . slimeRadWobble +~ r - r1
-            & crType . slimeCompression %~ ((r/r1) *^)
-    r1 = s ^?! crType . slimeRad
+    f cr = cr
+            & crType . slimeSlime +~ round (r2^(2::Int) * 100)
+            & crType . slimeSlimeChange +~ round (r2^(2::Int) * 100)
+    r1 = s ^?! crType . slimeSlime . to slimeToRad
    r2 = c ^. crType . to crRad
-    r = sqrt (r1*r1 + r2*r2)

 fuseSlimes :: Creature -> Creature -> World -> World
 fuseSlimes c1 c2 = (cWorld . lWorld . creatures . ix mini .~ c)
    . (cWorld . lWorld . creatures . at maxi .~ Nothing)
-    . slimeEatSound i1 (c ^. crPos . _xy)
+    . slimeEatSound mini (c ^. crPos . _xy)
  where
-    c' | c1 ^?! crType . slimeRad > c2 ^?! crType . slimeRad = c1
+    c' | c1 ^?! crType . slimeSlime > c2 ^?! crType . slimeSlime = c1
       | otherwise = c2
    mini = min i1 i2
    maxi = max i1 i2
    i1 = c1 ^. crID
    i2 = c2 ^. crID
-    c = c' & crType . slimeRad .~ r
-            & crType . slimeRadWobble +~ r - max r1 r2
-            & crType . slimeCompression %~ ((r/max r1 r2) *^)
+    c = c' & crType . slimeSlime +~ eslime
+            & crType . slimeSlimeChange +~ eslime
            & crID .~ mini
-    r1 = c1 ^?! crType . slimeRad
-    r2 = c2 ^?! crType . slimeRad
-    r = sqrt (r1*r1 + r2*r2)
+    eslime = min (c1 ^?! crType . slimeSlime) (c2 ^?! crType . slimeSlime)

 slimeEatSound :: Int -> Point2 -> World -> World
 slimeEatSound i p w = w & soundStart (CrSound i) p s Nothing
@@ -14,7 +14,7 @@ cloudPoisonDamage :: Gas -> World -> World
 cloudPoisonDamage c w = foldl' (flip doDam) w (filter f $ crsNearPoint clpos w)
  where
    doDam cr =
-        cWorld . lWorld . creatures . ix (_crID cr) . crDamage .:~ Poison 1
+        cWorld . lWorld . creatures . ix (_crID cr) . crDamage .:~ Poison 1 (c ^. gsOrigin)
    f cr = dist3 (_crPos cr & _z +~ 20) (_gsPos c) < crRad (cr ^. crType) + 20
        && isJust (cr ^? crHP . _HP)
    clpos = stripZ $ _gsPos c
@@ -50,7 +50,7 @@ damageMachine dam x mcid w = case w ^? cWorld . lWorld . machines . ix mcid of
        , sensorTypeDamages (se ^. sensType) dam
        -> (mempty,mcDamSensorUpdate' (_dmAmount dam) se mc w)
    Just mc | McTurret{} <- mc ^. mcType
-        , Electrical edam <- dam
+        , Electrical {_dmAmount=edam} <- dam
            -> (mempty, w & cWorld . lWorld . machines . ix mcid . mcType . mctTurretStun %~ (min 100 . (+ edam)))
    Just mc | _mcHP mc < x -> destroyMachine' mc w
    _ -> (mempty, w & cWorld . lWorld . machines . ix mcid . mcHP -~ x)
@@ -30,7 +30,8 @@ colCrWall w c = cornpush . wallpush $ pushthrough c
    cornpush = crPos . _xy %~ pushOutFromCorners r ls'
    wallpush = pushCr (w ^. cWorld . lWorld) wls
    pushthrough = crPos . _xy %~ fst . flip (collidePoint p1) wls -- check push throughs
-    r = crRad (c ^. crType) + wallBuffer
+    r   | SlimeCrit {} <- c ^. crType = min 10 . crRad $ c ^. crType
+        | otherwise = crRad $ c ^. crType
    p1 = c ^. crOldPos . _xy
    p2 = c ^. crPos . _xy
    ls = _wlLine <$> IM.elems wls
@@ -45,7 +46,7 @@ pushCr w wls cr
 --        || wlsCrush' w (cr ^. crPos . _xy) twls =
    | wlsCrush' w (cr ^. crPos . _xy) twls =
        ecr
-            & crDamage <>~ [Crushing 1000 0]
+            & crDamage <>~ [Crushing 1000 0 UnassignedO]
            & crPos . _xy .~ ap
 --    | Just s <- wlsCrush w (cr ^. crPos . _xy) twls =
 --        ecr
@@ -60,7 +61,8 @@ pushCr w wls cr
    ap = cr ^. crOldPos . _xy
 --    sp = cr ^. crPos . _xy
    ecr = foldl' f (cr & crWallTouch .~ mempty) wls
-    r = crRad (cr ^. crType)
+    r   | SlimeCrit {} <- cr ^. crType = min 10 . crRad $ cr ^. crType
+        | otherwise = crRad $ cr ^. crType
    f acr wl = case pushOutFromWall' r (acr ^. crPos . _xy) (wl ^. wlLine) of
        Just (p,hitp) -> acr & crPos . _xy .~ p & crWallTouch . at (wl ^. wlID) ?~ hitp
        Nothing -> acr
@@ -95,10 +97,6 @@ wlWlCrush' w p w1 w2 = (t w1 w2 || t w2 w1) -- test either wall is moving toward
        (wallMovement w p x - wallMovement w p y) > 0
    f = normalizeV . uncurry (-) . (^. wlLine)

-- the amount to push creatures out from walls, extra to their radius
-wallBuffer :: Float
-wallBuffer = 0
-
 ---- assumes that the wall is orientated
 ---- assumes wall points are different
 --pushOutFromWall :: Float -> Point2 -> (Point2, Point2) -> Maybe Point2
@@ -22,14 +22,10 @@ import Linear
 import Picture
 import RandomHelp

-makePoisonExplosionAt ::
-    -- | Position
-    Point2 ->
-    World ->
-    World
-makePoisonExplosionAt p w =
+makePoisonExplosionAt :: DamageOrigin -> Point2 -> World -> World
+makePoisonExplosionAt o p w =
    soundMultiFrom [Explosion 0, Explosion 1] p bangS Nothing $
-        foldl' (flip $ makeGasCloud p) w $
+        foldl' (flip $ makeGasCloud o p) w $
            replicateM 25 (randInCirc 2) & evalState $ _randGen w

 -- just change the number after replicateM to get more or less clouds
@@ -53,47 +49,44 @@ makeTeslaExplosionAt = undefined
 --            (\i -> over projectiles (IM.insert (pks!!i) (makeTeslaArcAt (pks!!i) pos (xs!!i))))
 --            [1 .. 29]

-makeFlameExplosionAt ::
-    Point2 ->
-    World ->
-    World
-makeFlameExplosionAt p w =
+makeFlameExplosionAt :: DamageOrigin -> Point2 -> World -> World
+makeFlameExplosionAt o p w =
    soundMultiFrom [Explosion 0, Explosion 1] p bangS Nothing w
        & cWorld . lWorld . flames .++~ newFlames
  where
    newFlames = zipWith makeFlameWithVelAndTime velocities timers
-    makeFlameWithVelAndTime vel time = Flame time vel p
+    makeFlameWithVelAndTime vel time = Flame time vel p o
    velocities = replicateM 15 (randInCirc 1) & evalState $ _randGen w
    timers = randomRs (80, 100) $ _randGen w

-makeExplosionAt :: Point3 -> Point3 -> World -> World
-makeExplosionAt p vel w =
+makeExplosionAt :: DamageOrigin -> Point3 -> Point3 -> World -> World
+makeExplosionAt o p vel w =
    w
        & soundStart (Explosion (w ^. cWorld . lWorld . lClock)) (p ^. _xy) bangS Nothing
        & addFlames
        & cWorld . lWorld . worldEvents .:~ MakeTempLight (LSParam p 150 (V3 1 0.5 0)) 20
-        & makeShockwaveAt [] p 50 100 1 white
+        & makeShockwaveAt [] p 50 100 1 white o
  where
    fVs = fmap (`v2z` 0) $ replicateM 100 (randInCirc 8) & evalState $ _randGen w
    fdamps = replicateM 100 (state $ randomR (0, 1)) & evalState $ _randGen w
    sizes = randomRs (2, 9) $ _randGen w
    times = randomRs (15, 20) $ _randGen w
-    mF v damp = makeFlamelet p (v + damp *^ vel)
+    mF v damp = makeFlamelet o p (v + damp *^ vel)
    newFs = zipWith4 mF fVs fdamps sizes times
    addFlames w' = foldl' (&) w' newFs

-makeSmallExplosionAt :: Point3 -> Point3 -> World -> World
-makeSmallExplosionAt p vel w =
+makeSmallExplosionAt :: DamageOrigin -> Point3 -> Point3 -> World -> World
+makeSmallExplosionAt o p vel w =
    w
        & soundStart (Explosion (w ^. cWorld . lWorld . lClock)) (p ^. _xy) bangS Nothing
        & addFlames
        & cWorld . lWorld . worldEvents .:~ MakeTempLight (LSParam p 150 (V3 1 0.5 0)) 20
-        & makeShockwaveAt [] p 40 100 1 white
+        & makeShockwaveAt [] p 40 100 1 white o
  where
    fVs = fmap (`v2z` 0) $ replicateM 5 (randInCirc 2) & evalState $ _randGen w
    fdamps = replicateM 100 (state $ randomR (0, 1)) & evalState $ _randGen w
    sizes = randomRs (2, 9) $ _randGen w
    times = randomRs (15, 20) $ _randGen w
-    mF v damp = makeFlamelet p (v + damp *^ vel)
+    mF v damp = makeFlamelet o p (v + damp *^ vel)
    newFs = zipWith4 mF fVs fdamps sizes times
    addFlames w' = foldl' (&) w' newFs
@@ -22,9 +22,10 @@ makeShockwaveAt ::
    -- | Color of shockwave.
    Color ->
    -- | Start world.
+    DamageOrigin ->
    World ->
    World
-makeShockwaveAt is p rad dam push col =
+makeShockwaveAt is p rad dam push col d =
    cWorld . lWorld . shockwaves
        .:~ Shockwave
            { _swInvulnerableCrs = is
@@ -36,6 +37,7 @@ makeShockwaveAt is p rad dam push col =
            , _swPush = push
            , _swMaxTime = 10
            , _swTimer = 10
+            , _swOrigin = d
            }

 {- Create a shockwave going from an outside circle into a center point.  -}
@@ -44,9 +46,10 @@ inverseShockwaveAt ::
    Float -> -- Radius
    Int -> -- Damage
    Float -> -- Push amount
+    DamageOrigin ->
    World ->
    World
-inverseShockwaveAt p rad dam push =
+inverseShockwaveAt p rad dam push d =
    cWorld . lWorld . shockwaves
        .:~ Shockwave
            { _swDirection = InwardShockwave
@@ -58,4 +61,5 @@ inverseShockwaveAt p rad dam push =
            , _swPush = push
            , _swMaxTime = 10
            , _swTimer = 10
+            , _swOrigin = d
            }
@@ -9,17 +9,19 @@ import LensHelp

 -- | At writing the radius is half the size of the effect area
 makeGasCloud ::
+    DamageOrigin ->
    -- | Position
    Point2 ->
    -- | Velocity
    Point2 ->
    World ->
    World
-makeGasCloud pos vel = cWorld . lWorld . gasses .:~ Gas
+makeGasCloud o pos vel = cWorld . lWorld . gasses .:~ Gas
            { _gsPos = addZ 20 pos
            , _gsVel = addZ 0 vel
            , _gsTimer = 400
            , _gsType = PoisonGas
+            , _gsOrigin = o
            }

 {- Attach poison cloud damage to creatures near cloud.  -}
@@ -4,6 +4,7 @@
 {- Testing for and finding intersection points.  -}
 module Geometry.Intersect where

+import Data.Monoid
 import Data.List (sortOn)
 import Control.Applicative
 import Control.Lens
@@ -272,6 +273,12 @@ intersectLinePoly a b (p:ps) = sortOn (dotV (b - a))
    $ zipWith (\x y -> intersectSegLine x y a b) (p:ps) (ps ++[p])
 intersectLinePoly _ _ [] = error "intersectLinePoly empty polygon"

+intersectRayPoly :: Point2 -> Point2 -> [Point2] -> Maybe Point2
+intersectRayPoly a b (p:ps) = getFirst . mconcat $ zipWith f (p:ps) (ps++[p])
+  where
+    f x y = First $ intersectSegRay x y a b
+intersectRayPoly _ _ _ = error "intersectRayPoly: polygon too small"
+

 {- | Given a line and a point return the point on the line closest to the
 point.
@@ -188,7 +188,7 @@ grahamEliminate (x : y : z : xs)
    | not $ isLHS x y z = grahamEliminate (x : z : xs)
 grahamEliminate xs = xs

-- this isn't the centroid of the polygon...
+-- not sure what definition of centroid is applicable here
 centroid :: (Num (f a),Functor f, Fractional a,Foldable t) => t (f a) -> f a
 centroid = L.fold $ (^/) <$> L.Fold (+) 0 id <*> L.genericLength

@@ -234,9 +234,15 @@ cutPolyR a b [] e x ls rs = case intersectSegLine x e a b of
    Nothing -> (reverse ls,reverse rs)
    Just p -> (reverse (p\:ls), reverse (p\:rs))

+polyInPoly :: Point2 -> [Point2] -> [Point2] -> [Point2]
+polyInPoly p ps = mapMaybe f
+  where
+    f q = intersectRayPoly p q ps
+
 infixr 5 \:
 (\:) :: Eq a => a -> [a] -> [a]
 (\:) x (y:ys) 
    | x /= y = x:y:ys
    | otherwise = y:ys 
 (\:) x [] = [x]
+
@@ -24,7 +24,7 @@ pokeBeePheremone :: Ptr Float -> Int -> BeePheremone -> IO Int
 pokeBeePheremone vptr nv = pokeCloudLike vptr nv . mkBeePheremoneCloudLike

 mkBeePheremoneCloudLike :: BeePheremone -> (Point3, Point4)
-mkBeePheremoneCloudLike x = (20 & _xy .~ (x ^. bpPos), V4 1 1 0 a)
+mkBeePheremoneCloudLike x = (x ^. bpPos, V4 1 1 0 a)
  where
    a = 0.8 * min 1 (fromIntegral (_bpTimer x) / 100)
Author	SHA1	Message	Date
justin	437ca007ef	Cleanup	2026-05-09 09:05:42 +01:00
justin	fada3c73bc	Hack to prevent slime split error	2026-05-09 00:13:56 +01:00
justin	12e4a278d0	Smooth out slime splitting There are probably possible errors from the use of cutPoly	2026-05-08 23:44:28 +01:00
justin	34d8425520	Speed up slime rad change	2026-05-08 10:50:36 +01:00
justin	ad998fb622	Remove destroyed creatures rather than setting flag Sill only set flag for avatar	2026-05-08 10:45:05 +01:00
justin	84e95da2b5	Cleanup	2026-05-08 10:10:06 +01:00
justin	7c1ada4546	Simplify slime compression	2026-05-07 10:04:42 +01:00
justin	b76148ae2a	Track slime amount using ints	2026-05-06 15:40:31 +01:00
justin	e927de6508	Improve bee crit update	2026-05-05 20:41:09 +01:00
justin	62a9f34a26	Simplify bee harvesting	2026-05-05 09:43:17 +01:00
justin	1ec855c2fc	Tweak debug/fixed render, depthfunc always	2026-05-04 21:41:16 +01:00
justin	5d5d0a539b	Add debug to copy to clipboard any clicked-on creature	2026-05-04 21:17:22 +01:00
justin	6b3d75cbb2	Tweak melee movement	2026-05-03 08:17:42 +01:00
justin	aef3671063	Work on bee movement	2026-05-02 22:08:06 +01:00
justin	b827827951	Tweak slime wall collisions, all creatures cliff collisions (min 10)	2026-05-02 19:46:12 +01:00
justin	b7aea0eb1f	Tweak bee speed	2026-05-02 16:01:22 +01:00
justin	31f24283d7	Add bee random movement	2026-05-02 15:55:59 +01:00
justin	199f1b11b5	Commit before simplifying actions	2026-04-29 20:58:13 +01:00
justin	cfe34555b3	Add stretch animation to feeding bees	2026-04-29 20:21:20 +01:00
justin	39bc480c03	Cleanup	2026-04-28 22:37:33 +01:00
justin	284ea32333	Allow bees to target chase crits	2026-04-27 22:29:57 +01:00
justin	259325f81f	Improve creature turning wrt inertia	2026-04-27 22:23:39 +01:00
justin	f4c59612ea	Improve bee pheremones	2026-04-26 09:14:55 +01:00
justin	264651d34a	Prevent rooted creatures from being pushed by other creatures	2026-04-25 09:04:01 +01:00
justin	e0e346aade	Add damage origins	2026-04-24 20:34:20 +01:00