Implement slime splitting

src/Dodge/Base/CardinalPoint.hs

@@ -22,7 +22,12 @@ cardVec = \case
     West -> V2 (-1) 0
 
 vecCard :: Point2 -> CardinalPoint
-vecCard (V2 x y) = undefined
+vecCard 0 = error "vecCard null"
+vecCard (V2 x y)
+    | x > abs y = East
+    | -x > abs y = West
+    | y > 0 = North
+    | otherwise = South
 
 card8Vec :: Cardinal8 -> Point2
 card8Vec cp = case cp of

src/Dodge/Creature/Update.hs

@@ -6,7 +6,7 @@ import Dodge.Base.Collide
 import Dodge.Creature.Radius
 import Color
 import Control.Monad
-import qualified Data.IntMap.Strict as IM
+import qualified IntMapHelp as IM
 import Data.Maybe
 import Dodge.Barreloid
 import Dodge.Base.You
@@ -70,7 +70,15 @@ updateLivingCreature cr = case _crType cr of
     cid = cr ^. crID
 
 slimeCritUpdate :: Int -> World -> World
-slimeCritUpdate cid w = w
+slimeCritUpdate cid w 
+    | 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')
+    | otherwise = w
         & cWorld . lWorld . creatures . ix cid .~ mvslime
   where
     txy = w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy
@@ -80,11 +88,12 @@ slimeCritUpdate cid w = w
         | hasLOS cxy txy w = mvslime'
         | otherwise = cr
     mvslime' = cr & crType . slimeCompression .~ p' + x
-        & crPos . _xy +~ g (0.5*x)
+        -- & crPos . _xy +~ g (x)
+        & crPos . _xy +~ 0.1 *^ normalize (txy-cxy)
         & crType . slimeIsCompressing %~ (f . f')
         & crDir .~ argV (txy-cxy)
-    g | cr ^?! crType . slimeIsCompressing = negate
-      | otherwise = id
+--    g | cr ^?! crType . slimeIsCompressing = negate
+--      | otherwise = id
     s | cr ^?! crType . slimeIsCompressing = 2/3
       | otherwise = 1.5
     f | abs (norm v - norm p') < 0.1 = not
@@ -99,6 +108,33 @@ slimeCritUpdate cid w = w
         | otherwise = (-(r*r/norm p) *^ normalize (vNormal p), not)
     x = 0.1 *^ normalize (v - p')
 
+splitSlimeCrit :: Point2 -> Point2 -> Creature -> Maybe (Creature, Creature)
+splitSlimeCrit p v cr = do
+    let mp = closestPointOnLine p (p+v) cxy
+        h = r - distance mp cxy
+        nv = normalize v
+    guard $ h > 0
+    let a1 = segmentArea r h
+        a2 = pi*r*r - a1
+        r1 = sqrt (a1/pi)
+        r2 = sqrt (a2/pi)
+    guard $ r1 > 5 && r2 > 5
+    return (cr' & crPos . _xy +~ r2 *^ vNormal nv
+                & crType . slimeRad .~ r1
+                & crType . slimeCompression .~ V2 r1 0
+        ,cr' & crPos . _xy -~ r1 *^ vNormal nv
+                & crType . slimeRad .~ r2
+                & crType . slimeCompression .~ V2 r2 0
+        )
+  where
+    cxy = cr ^. crPos . _xy
+    r = cr ^?! crType . slimeRad
+    cr' = cr & crDamage .~ []
+
+-- h is the height of the segment, ie r - distance to center
+segmentArea :: Float -> Float -> Float
+segmentArea r h = r*r*acos(1-h/r) - (r-h)*sqrt(h*(2*r-h))
+
 slinkCritUpdate :: Int -> World -> World
 slinkCritUpdate cid w =
     w

src/Dodge/TestString.hs

@@ -45,6 +45,8 @@ testStringInit u = u ^.. tocrs . ix 1 . crPos . _xy . to show
     <> u ^.. tocrs . ix 1 . crType . slimeCompression . to show
     <> u ^.. tocrs . ix 1 . crType . slimeIsCompressing . to show
     <> u ^.. tocrs . ix 1 . crDir . to show
+    <> u ^.. tocrs . ix 1 . crDamage . to show
+--    <> u ^.. tocrs . each . crID . to show
 --  where
 --    tocr = uvWorld . cWorld . lWorld . creatures . ix 0
 --    f = fromMaybe 0