justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Smooth out slime splitting

Browse Source 
There are probably possible errors from the use of cutPoly
This commit is contained in:
justin
2026-05-08 23:44:28 +01:00
parent 34d8425520
commit 12e4a278d0
10 changed files with 243 additions and 204 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/ChaseCrit.hs
+1 -1
View File
@@ -70,7 +70,7 @@ slimeCrit = defaultCreature
& crName .~ "slimeCrit"
& crHP .~ HP 1000
-- & crType .~ SlimeCrit r 0 0 (V2 (slimeToRad r) 0) False 0
& crType .~ SlimeCrit r 0 0 1 False 0
& crType .~ SlimeCrit r 0 Nothing 1 False 0
& crFaction .~ ColorFaction (light green)
& crPerception . cpVision . viFOV .~ FloatFOV pi
& crActionPlan .~ SlimeIntelligence
src/Dodge/Creature/Picture.hs
+7 -9
View File
@@ -7,6 +7,7 @@ module Dodge.Creature.Picture (
drawCreature,
) where
import Dodge.Creature.Slime
import Geometry.Zone
import Data.Foldable
import qualified Data.Strict.Tuple as ST
@@ -58,17 +59,14 @@ drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $
drawSlimeCrit :: Creature -> Shape
drawSlimeCrit cr = colorSH green
$ upperPrismPolyHalf Medium Typical (cr ^?! crType . slimeEngulfProgress + min 15 r) $ polyCirc 6 r
& each . _x *~ p
& each . _y %~ (/p)
-- & each %~ scaleAlong d s
-- & each %~ scaleAlong (vNormal d) (1 / s)
-- & each %~ rotateV (-cr ^. crDir)
$ upperPrismPolyHalf Medium Typical (cr ^?! crType . slimeEngulfProgress + min 15 r) ps
where
r = slimeToRad $ cr ^?! crType . slimeSlime - cr ^?! crType . slimeSlimeChange
p = cr ^?! crType . slimeCompression
-- d = normalize p
-- s = norm p / r
so = slimeOutline cr
ps = fromMaybe so $ do
(x',qs) <- cr ^? crType . slimeSplitTimer . _Just
let x = fromIntegral x'
return $ zipWith (+) (fmap (0.1*(10 - x) *^) so) (fmap (0.1*x*^) qs)
-- assumes d is a unit vector
scaleAlong :: Point2 -> Float -> Point2 -> Point2
src/Dodge/Creature/Slime.hs
+16
View File
@@ -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
src/Dodge/Creature/Update.hs
+20 -12
View File
@@ -3,6 +3,7 @@
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
@@ -233,7 +234,7 @@ updateCalmBee cr cid w
mountshakeoff mid = fromMaybe True $ do
mcr <- w ^? cWorld . lWorld . creatures . ix mid
SlimeCrit {_slimeSplitTimer = x} <- mcr ^? crType
return $ x > 0
return $ isJust x
--sspeed = 0.05
sspeed = 5
gettarg = do
@@ -263,9 +264,13 @@ slimeCritUpdate 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
@@ -327,27 +332,30 @@ 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
(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)
& crType . slimeCompression .~ 1 -- rotateV (argV mvdir) (V2 r1 0)
& crType . slimeIsCompressing .~ False
& crDir .~ argV mvdir
,cr' & crPos . _xy .~ mp - (r2 + 0.51) *^ mvdir
-- & crType . slimeRad .~ r2
c2 = cr' & crPos . _xy .~ mp - r2 *^ mvdir
& crType . slimeSlime .~ round (r2^(2::Int) * 100)
& crType . slimeCompression .~ 1 -- rotateV (argV (-mvdir)) (V2 r2 0)
& crType . slimeIsCompressing .~ False
& 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 .~ polyInPoly (centroid c1ps) c1ps (slimeOutline c1)
,c2 & crType . slimeSplitTimer . _Just . _2 .~ polyInPoly (centroid c2ps) c2ps (slimeOutline c2)
)
where
cxy = cr ^. crPos . _xy
r = cr ^?! crType . slimeSlime . to slimeToRad
cr' = cr & crDamage .~ []
& crType . slimeSlimeChange .~ 0
& crType . slimeSplitTimer .~ 10
& 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
src/Dodge/Data/Creature/Misc.hs
+2 -1
View File
@@ -81,7 +81,8 @@ data CreatureType
{ _slimeSlime :: Int -- note multiplied by 100
, _slimeSlimeChange :: Int
-- , _slimeRadWobble :: Float
, _slimeSplitTimer :: Int
--, _slimeSplitTimer :: Int
, _slimeSplitTimer :: Maybe (Int, [Point2])
, _slimeCompression :: Float
, _slimeIsCompressing :: Bool
, _slimeEngulfProgress :: Float
src/Dodge/TestString.hs
+3 -2
View File
@@ -58,8 +58,9 @@ crs :: Universe -> [Creature]
crs u = u ^.. uvWorld . cWorld . lWorld . creatures . each
testStringInit :: Universe -> [String]
testStringInit u = -- [show . getSum $ foldMap (Sum . crslime) (crs u)]
u ^.. tocrs . each . crType . slimeSlimeChange . 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
src/Dodge/Update.hs
+2 -3
View File
@@ -1026,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)
src/Geometry/Intersect.hs
+7
View File
@@ -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.
src/Geometry/Polygon.hs
+7 -1
View File
@@ -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]