Work on slime crits

This commit is contained in:
2026-04-13 19:54:11 +01:00
parent 8a57aa2f2c
commit b8bec2c830
14 changed files with 294 additions and 260 deletions
+2 -1
View File
@@ -66,10 +66,11 @@ slimeCrit :: Creature
slimeCrit = defaultCreature
& crName .~ "slimeCrit"
& crHP .~ HP 1000
& crType .~ SlimeCrit 40 (V2 30 0) False True
& crType .~ SlimeCrit 40 0 (V2 50 0) False True
& crFaction .~ ColorFaction (light green)
& crPerception . cpVision . viFOV .~ FloatFOV pi
& crActionPlan .~ SlimeIntelligence
& crStance . carriage .~ Crawling
hoverCrit :: Creature
hoverCrit =
+1 -1
View File
@@ -13,4 +13,4 @@ crMass = \case
BarrelCrit{} -> 10
SlinkCrit{} -> 100
LampCrit {} -> 3
SlimeCrit {_slimeRad = r} -> r
SlimeCrit {_slimeRad = r} -> r * r / 10
+1
View File
@@ -58,6 +58,7 @@ drawSlimeCrit cr = colorSH green $ upperPrismPolyHalf Medium Typical r $ polyCir
& each %~ scaleAlong d s
& each %~ scaleAlong (vNormal d) (1 / s)
& each %~ rotateV (-cr ^. crDir)
& each %~ (((r-cr^?!crType.slimeRadWobble)/r) *^)
where
r = cr ^?! crType . slimeRad
p = cr ^?! crType . slimeCompression
+1 -1
View File
@@ -16,4 +16,4 @@ crRad = \case
BarrelCrit{} -> 10
LampCrit {} -> 3
SlinkCrit {} -> 10
SlimeCrit {_slimeRad = r} -> r
SlimeCrit {_slimeRad = r,_slimeRadWobble = x} -> r - x
+1
View File
@@ -26,6 +26,7 @@ updateCarriage' cid cr w = \case
Walking -> maybeTakeStep cid cr w
& tocr . crPos . _xy +~ 0.5 *^ (cr ^. crOldPos - oop) ^. _xy
& chasmTestCliffPush walkCliffPush cr
Crawling -> w & chasmTestCliffPush walkCliffPush cr
Floating -> w
Flying {_zSpeed = dz, _flyInertia = x} ->
w & tocr . crPos . _xy +~ x *^ f (cr ^. crOldPos . _xy - oop ^. _xy)
+16 -6
View File
@@ -79,12 +79,13 @@ slimeCritUpdate cid w
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
| otherwise = updateCarriage cid $ w
& cWorld . lWorld . creatures . ix cid .~ mvslime
& cWorld . lWorld . creatures . ix cid . crDamage .~ []
& cWorld . lWorld . creatures . ix cid . crDir .~ d
& cWorld . lWorld . creatures . ix cid . crType . slimeResetDir .~ rb'
& randGen .~ g
& cWorld . lWorld . creatures . ix cid %~ doSlimeRadChange
where
txy = w ^?! cWorld . lWorld . creatures . ix 0 . crPos . _xy
cr = w ^?! cWorld . lWorld . creatures . ix cid
@@ -110,7 +111,8 @@ slimeCritUpdate cid w
f | abs (norm v - norm p') < 0.2 = not
| otherwise = id
v = (s * r) *^ unitVectorAtAngle (cr ^. crDir)
r = crRad (cr ^. crType)
--r = crRad (cr ^. crType)
r = (cr ^?! crType . slimeRad)
p = cr ^?! crType . slimeCompression
(p',f')
| dot p v > 0 && dot p v > dot p (vNormal v) && dot p v > dot p (-vNormal v) = (p, id)
@@ -119,6 +121,13 @@ slimeCritUpdate cid w
| otherwise = (-(r*r/norm p) *^ normalize (vNormal p), not)
x = 0.1 *^ normalize (v - p')
doSlimeRadChange :: Creature -> Creature
doSlimeRadChange = crType . slimeRadWobble %~ f
where
f x | x > 1 = x - 1
| x < -1 = x + 1
| otherwise = 0
splitSlimeCrit :: Point2 -> Point2 -> Creature -> Maybe (Creature, Creature)
splitSlimeCrit p v cr = do
let mp = closestPointOnLine p (p+v) cxy
@@ -129,14 +138,14 @@ splitSlimeCrit p v cr = do
r1 = sqrt (a1/pi)
r2 = sqrt (a2/pi)
-- guard $ r1 > 5 && r2 > 5
return (cr' & crPos . _xy .~ mp + r1 *^ normalize (mp - cxy)
return (cr' & crPos . _xy .~ mp + (r1 + 0.5) *^ normalize (mp - cxy)
& crType . slimeRad .~ r1
& crType . slimeCompression .~ V2 r1 0
& crType . slimeCompression .~ rotateV (argV (mp-cxy)) (V2 r1 0)
& crDir .~ argV (mp - cxy)
& crType . slimeResetDir .~ not (cr ^?! crType . slimeIsCompressing)
,cr' & crPos . _xy .~ mp - r2 *^ normalize (mp - cxy)
,cr' & crPos . _xy .~ mp - (r2 + 0.5) *^ normalize (mp - cxy)
& crType . slimeRad .~ r2
& crType . slimeCompression .~ V2 r2 0
& crType . slimeCompression .~ rotateV (argV (cxy-mp)) (V2 r2 0)
& crDir .~ argV (cxy - mp)
& crType . slimeResetDir .~ not (cr ^?! crType . slimeIsCompressing)
)
@@ -144,6 +153,7 @@ splitSlimeCrit p v cr = do
cxy = cr ^. crPos . _xy
r = cr ^?! crType . slimeRad
cr' = cr & crDamage .~ []
& crType . slimeRadWobble .~ 0
-- h is the height of the segment, ie r - distance to center
segmentArea :: Float -> Float -> Float
+1
View File
@@ -72,6 +72,7 @@ data CreatureType
}
| SlimeCrit
{ _slimeRad :: Float
, _slimeRadWobble :: Float
, _slimeCompression :: Point2
, _slimeIsCompressing :: Bool
, _slimeResetDir :: Bool
+1
View File
@@ -22,6 +22,7 @@ data Stance = Stance
data Carriage
= Walking
| Crawling
| Floating
| Flying {_zSpeed :: Float, _flyInertia :: Float}
| Boosting Point2
-1
View File
@@ -60,7 +60,6 @@ data WdBl
| WdBlNegate WdBl
| WdBlCrFilterNearPoint Float Point2 CrBl
| WdBlBtOn Int
-- | WdBlBtNotOff Int
data WdP2f
= WdP2f0
+17 -11
View File
@@ -6,13 +6,12 @@ module Dodge.Layout (
shuffleRoomPos,
) where
import Control.Monad
-- import Dodge.Path.Translate
import qualified Control.Foldl as L
import Control.Lens
import Control.Monad
import Data.Foldable
import Data.Function
import Linear
-- import Data.Graph.Inductive (labEdges, labNodes)
import Data.List (nubBy, sortOn)
import Data.Maybe
@@ -33,6 +32,7 @@ import Dodge.Wall.Zone
import Dodge.Zoning.Pathing
import Geometry
import qualified IntMapHelp as IM
import Linear
import RandomHelp
generateLevelFromRoomList :: IM.IntMap Room -> World -> GenWorld
@@ -68,9 +68,12 @@ randomCompass w =
setTiles :: GenWorld -> GenWorld
setTiles gw = foldr setTile gw . reverse . IM.elems $ _genRooms gw
-- setTiles gw = foldl' (flip setTile) gw . reverse . IM.elems $ _genRooms gw
roomTileZeroShift :: Room -> Point2A
roomTileZeroShift rm = fromMaybe (rm ^. rmShift)
$ rm ^? rmFloor . tiles . ix 0 . tileZeroShift . _Just
roomTileZeroShift rm =
fromMaybe (rm ^. rmShift) $
rm ^? rmFloor . tiles . ix 0 . tileZeroShift . _Just
setTile :: Room -> GenWorld -> GenWorld
setTile r gw = case _rmFloor r of
@@ -78,16 +81,18 @@ setTile r gw = case _rmFloor r of
pid <- r ^. rmMParent
rm <- gw ^? genRooms . ix pid
guard $ rm ^? rmFloor . tiles . ix 0 . tileArrayZ == xs ^? ix 0 . tileArrayZ
return $ gw & genRooms . ix (fromJust (_rmMID r)) . rmFloor . tiles . ix 0 . tileZeroShift
?~ roomTileZeroShift rm
return $
gw
& genRooms . ix (fromJust (_rmMID r)) . rmFloor . tiles . ix 0 . tileZeroShift
?~ roomTileZeroShift rm
InheritFloor ->
gw & genRooms . ix (fromJust (_rmMID r)) . rmFloor .~ Tiled [t & tilePoly .~ poly]
where
t = fromMaybe (Tile poly (V2 0 0) (V2 1 0) 16 Nothing) $ do
pid <- r ^. rmMParent
rm <- gw ^? genRooms . ix pid
(rm ^? rmFloor . tiles . ix 0)
<&> tileZeroShift ?~ roomTileZeroShift rm
pid <- r ^. rmMParent
rm <- gw ^? genRooms . ix pid
(rm ^? rmFloor . tiles . ix 0)
<&> tileZeroShift ?~ roomTileZeroShift rm
poly =
orderPolygon
. convexHullSafe
@@ -108,7 +113,7 @@ doInPlacements w =
g rm = (rm ^?! rmMID . _Just,) <$> (rm ^. rmInPmnt)
rplaceSpot i gw rx = placeSpot i (gw & gwWorld . randGen .~ gen) x
where
(x,gen) = runState rx (gw ^. gwWorld . randGen)
(x, gen) = runState rx (gw ^. gwWorld . randGen)
doIndividualPlacements :: GenWorld -> GenWorld
doIndividualPlacements gw = foldl' doRoomPlacements gw (_genRooms gw)
@@ -219,6 +224,7 @@ tilesFromRooms = concatMap (getTiles . _rmFloor . doRoomShift)
getTiles :: Floor -> [Tile]
getTiles fl = case fl of
Tiled xs -> xs
-- _ -> []
_ -> error "tiles not correctly set for some room"
-- divideWall :: Wall -> [Wall]
+3 -2
View File
@@ -56,8 +56,9 @@ tutAnoTree :: State LayoutVars MTRS
tutAnoTree = do
foldMTRS
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
-- , corDoor
-- , chasmSpitTerminal
, corDoor
, tToBTree "" . return . cleatOnward <$> (cChasm
<&> rmPmnts .:~ (sps0 (PutCrit slimeCrit) & plSpot . psPos .~ V2 100 20))
, corDoor
, loadAmmoTut
, corDoor
+2
View File
@@ -46,6 +46,8 @@ testStringInit u = 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
<> u ^.. tocrs . ix 1 . crType . to crRad . to show
<> u ^.. tocrs . ix 1 . crType . slimeRad . to show
<> u ^.. tocrs . ix 1 . crType . slimeRadWobble . to show
<> u ^.. tocrs . ix 1 . crType . slimeIsCompressing . to show
<> u ^.. tocrs . ix 1 . crDir . to show
<> u ^.. tocrs . ix 1 . crDamage . to show
+9 -5
View File
@@ -1019,8 +1019,8 @@ 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 +~ (2*m2 / (m1+m2)) *^ normalize (xy2 - xy1)
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)
id1 = _crID c1
id2 = _crID c2
@@ -1037,14 +1037,18 @@ crCrSpring c1 c2
m2 = crMass $ c2 ^. crType
fuseSlimes :: Creature -> Creature -> World -> World
fuseSlimes c1 c2 = (cWorld . lWorld . creatures . ix i1 .~ c)
. (cWorld . lWorld . creatures . at i2 .~ Nothing)
fuseSlimes c1 c2 = (cWorld . lWorld . creatures . ix mini .~ (c & crID .~ mini))
. (cWorld . lWorld . creatures . at maxi .~ Nothing)
where
mini = min i1 i2
maxi = max i1 i2
i1 = c1 ^. crID
i2 = c2 ^. crID
c = c1 & crType . slimeRad .~ r
& crType . slimeRadWobble +~ r - max r1 r2
& crType . slimeCompression .~ V2 r 0
& crPos . _xy .~ (r1/(r1+r2)) *^ xy1 + (r2/(r1+r2)) *^ xy2
-- & crPos . _xy .~ (r1/(r1+r2)) *^ xy1 + (r2/(r1+r2)) *^ xy2
& crPos . _xy .~ if r1 > r2 then xy1 else xy2
xy1 = c1 ^. crPos . _xy
xy2 = c2 ^. crPos . _xy
r1 = c1 ^?! crType . slimeRad