Add slime sounds

src/Dodge/Creature/Update.hs

@@ -73,11 +73,12 @@ slimeCritUpdate cid w
     | r < 5 = w & cWorld . lWorld . creatures . ix cid . crHP .~ CrDestroyed Gibbed
     | 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 (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
         = let (w',g) = runState (setSlimeDir cid (cr & crDamage .~ []) w) (w ^. randGen)
             in w' & randGen .~ g
@@ -108,15 +109,16 @@ setSlimeDir cid cr w = do
     if i < (r - 11) / 50
         then do
             x <- randInCirc 1
-            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')
+            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
                 & tocr . crType . slimeIsCompressing .~ False
   where
     tocr = cWorld . lWorld . creatures . ix cid
-    tocr' i = cWorld . lWorld . creatures . at i
+--    tocr' i = cWorld . lWorld . creatures . at i
     cxy = cr ^. crPos . _xy
     r = cr ^?! crType . slimeRad
     
@@ -128,6 +130,16 @@ doSlimeRadChange = crType . slimeRadWobble %~ f
         | x < -1 = x + 1
         | otherwise = 0
 
+splitSlimeCrit' :: Point2 -> Point2 -> Int -> Creature -> World -> Maybe World
+splitSlimeCrit' p v cid cr w = do
+    (cr1,cr2) <- splitSlimeCrit p v cr
+    let cid' = IM.newKey $ w ^. cWorld . lWorld . creatures
+        (s,g) = runState (takeOne [popS,pop1S,pop2S]) (w ^. randGen)
+    return $ w & cWorld . lWorld . creatures . ix cid .~ cr1
+            & cWorld . lWorld . creatures . at cid' ?~ (cr2 & crID .~ cid')
+            & soundStart (CrSound cid) (cr ^. crPos . _xy) s Nothing
+            & randGen .~ g
+
 splitSlimeCrit :: Point2 -> Point2 -> Creature -> Maybe (Creature, Creature)
 splitSlimeCrit p v cr = do
     let mp = closestPointOnLine p (p+v) cxy

src/Dodge/Room/Tutorial.hs

@@ -58,7 +58,7 @@ tutAnoTree = do
         [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
         , corDoor
         --, tToBTree "" . return . cleatOnward <$> (xChasm 200 200
-        , tToBTree "" . return . cleatOnward <$> (roomRectAutoLights 200 200
+        , tToBTree "" . return . cleatOnward <$> (roomRectAutoLights 300 300
             <&> rmPmnts .:~ (sps0 (PutCrit slimeCrit) & plSpot . psPos .~ V2 100 100))
 --        , tToBTree "" . return . cleatOnward <$> (cChasm
 --            <&> rmPmnts .:~ (sps0 (PutCrit slimeCrit) & plSpot . psPos .~ V2 100 20))

src/Dodge/TestString.hs

@@ -51,7 +51,6 @@ testStringInit u = u ^.. tocrs . ix 1 . crPos . _xy . 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 . crType . to crRad . to show
 --    <> u ^.. tocrs . each . crID . to show
 --  where
 --    tocr = uvWorld . cWorld . lWorld . creatures . ix 0

src/Dodge/Update.hs

@@ -1019,9 +1019,10 @@ crCrSpring c1 c2
         return $ z c1 > h2 || z c2 > h1
     olap a b = ix (a ^. crID) . crPos . _xy +~ overlap b
     olap' a b = ix (a ^. crID) . crPos . _xy -~ overlap b
-    suckx = min 1 $ 2 * (1 - distance xy1 xy2 / (r1 + r2))
-    rolap = ix id1 . crPos . _xy +~ (suckx * 1.5 * m2 / (m1+m2)) *^ normalize (xy2 - xy1)
-    rolap' = ix id2 . crPos . _xy +~ (suckx * 1.5*m1 / (m1+m2)) *^ normalize (xy1 - xy2)
+    suckx = (min 1 $ 2 * (1 - distance xy1 xy2 / (r1 + r2))) ^ (2:: Int)
+    rolap = ix id1 . crPos . _xy +~ f (suckx * 1.5 * m2 / (m1+m2)) *^ normalize (xy2 - xy1)
+    rolap' = ix id2 . crPos . _xy +~ f (suckx * 1.5*m1 / (m1+m2)) *^ normalize (xy1 - xy2)
+    f = min (distance xy1 xy2/2)
     id1 = _crID c1
     id2 = _crID c2
     xy1 = c1 ^. crPos . _xy
@@ -1039,6 +1040,7 @@ crCrSpring c1 c2
 fuseSlimes :: Creature -> Creature -> World -> World
 fuseSlimes c1 c2 = (cWorld . lWorld . creatures . ix mini .~ c)
     . (cWorld . lWorld . creatures . at maxi .~ Nothing)
+    . dosound
   where
     c' | c1 ^?! crType . slimeRad > c2 ^?! crType . slimeRad = c1
         | otherwise = c2
@@ -1053,6 +1055,10 @@ fuseSlimes c1 c2 = (cWorld . lWorld . creatures . ix mini .~ c)
     r1 = c1 ^?! crType . slimeRad
     r2 = c2 ^?! crType . slimeRad
     r = sqrt (r1*r1 + r2*r2)
+    dosound w = w & soundStart (CrSound i1) (c ^. crPos . _xy) s Nothing
+        & randGen .~ g
+      where
+        (s,g) = runState (takeOne [slurp1S,slurp2S,slurp3S,slurp4S,slurp5S]) (w ^. randGen)
     
 
 updateDelayedEvents :: World -> World