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

Stop gibbed/pitted creatures from pushing other creatures

Browse Source
This commit is contained in:
justin
2026-03-26 23:09:23 +00:00
parent 9e42bb4117
commit 8b088425a9
3 changed files with 218 additions and 197 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update.hs
+72 -52
View File
@@ -3,28 +3,23 @@
module Dodge.Update (updateUniverse) where
import Data.Function (on)
import Dodge.Zoning.Wall
import Bound
import Dodge.HeldUse
import Dodge.DoubleTree
import Dodge.Item.Grammar
import Dodge.Creature.MoveType
import Dodge.Render.List
import Data.Foldable
import qualified Data.Set as S
import Color
import Control.Applicative
import Control.Monad
import Data.Foldable
import Data.Function (on)
import Data.List
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid
import qualified Data.Set as S
import Dodge.Base
import Dodge.Bullet
import Dodge.Cloud
import Dodge.CrGroupUpdate
import Dodge.Creature.Mass
import Dodge.Creature.MoveType
import Dodge.Creature.Radius
import Dodge.Creature.Update
import Dodge.Damage
@@ -35,9 +30,12 @@ import Dodge.Debug
import Dodge.DisplayInventory
import Dodge.Distortion
import Dodge.Door
import Dodge.DoubleTree
import Dodge.EnergyBall
import Dodge.Flame
import Dodge.HeldUse
import Dodge.Inventory
import Dodge.Item.Grammar
import Dodge.Item.Weapon.LaserPath
import Dodge.Laser.Update
import Dodge.LinearShockwave.Update
@@ -48,6 +46,7 @@ import Dodge.Projectile.Update
import Dodge.Prop.Moving
import Dodge.RadarBlip
import Dodge.RadarSweep
import Dodge.Render.List
import Dodge.ScrollValue
import Dodge.SelectionSections
import Dodge.Shockwave.Update
@@ -69,6 +68,7 @@ import Dodge.WorldEvent.Explosion
import Dodge.WorldEvent.ThingsHit
import Dodge.Zoning.Cloud
import Dodge.Zoning.Creature
import Dodge.Zoning.Wall
import Geometry
import qualified IntMapHelp as IM
import LensHelp
@@ -175,7 +175,7 @@ doMouseWarping _ = id
-- (0.5 * windowYFloat cfig - fromIntegral y)
-- p@(V2 x y) = (cwin + (msp & each %~ round)) & each %~ fromIntegral
-- cwin :: V2 Int
-- cwin = ((getWindowSize _gr_world_res (u' ^. uvConfig)))
-- cwin = ((getWindowSize _gr_world_res (u' ^. uvConfig)))
-- mwp = mouseWorldPosW (u' ^. uvWorld)
-- msp = u' ^. uvWorld . input . mousePos & _y %~ negate
-- cc = u' ^. uvWorld . wCam . camCenter
@@ -188,7 +188,7 @@ updateUniverseMid u = case _uvScreenLayers u of
[] ->
(uvWorld . unpauseClock +~ 1)
. (uvWorld . cWorld . highlightItems %~ IM.mapMaybe minusone)
-- . (uvWorld . cWorld . highlightItems . filteredBy . non 0 -~ 1)
-- . (uvWorld . cWorld . highlightItems . filteredBy . non 0 -~ 1)
. timeFlowUpdate
. updateUseInputInGame
$ over
@@ -196,7 +196,7 @@ updateUniverseMid u = case _uvScreenLayers u of
(updateMouseInGame (u ^. uvConfig) . updateCamera (u ^. uvConfig))
u
where
minusone x
minusone x
| x > 0 = Just $ x - 1
| otherwise = Nothing
@@ -212,7 +212,7 @@ timeFlowUpdate u = case u ^. uvWorld . timeFlow of
RewindLeftClick _ _ -> over uvWorld scrollTimeBack u
RespawnDelay{} -> functionalUpdate u
PausedTimeFlow _ itmloc -> over uvWorld (pauseTime itmloc) u
PauseTimeMessage {} -> u
PauseTimeMessage{} -> u
pauseTime :: NewInt ItmInt -> World -> World
pauseTime _ w
@@ -337,7 +337,7 @@ functionalUpdate =
. set (uvWorld . cWorld . lWorld . lights) []
. set (uvWorld . cWorld . lWorld . tempSPic) mempty
. updateAimPos
. over uvWorld updatePastWorlds -- it might be possible to do this without storing stuff such as the temporary lights/flares etc
. 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
@@ -346,22 +346,25 @@ pushYouOutFromWalls w = w & cWorld . lWorld . creatures . ix 0 %~ muzzleWallChec
muzzleWallCheck :: World -> Creature -> Creature
muzzleWallCheck w cr = fromMaybe cr $ do
invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
loc <- invIndents ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
^? ix invid . _2
loc <-
invIndents ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
^? ix invid . _2
let ps = reduceLocDT f loc ^.. each . _1 . _xy
cp = cr ^. crPos . _xy
-- cop = cr ^. crOldPos . _xy
-- cop = cr ^. crOldPos . _xy
r <- boundPointsRect (cp : ps)
let wls = uncurry wlsNearRect r w & IM.elems & filter (not . _wlTouchThrough)
vs = mapMaybe (g cp wls) ps
return $ if null vs
then cr
else let v = minimumBy (compare `on` norm) vs
in cr & crPos . _xy +~ normalize v
return $
if null vs
then cr
else
let v = minimumBy (compare `on` norm) vs
in cr & crPos . _xy +~ normalize v
where
f loc = map (muzzlePos loc cr) (itemMuzzles loc)
f loc = map (muzzlePos loc cr) (itemMuzzles loc)
g cp wls p = case collidePoint cp p wls of
(ep,Just _) -> Just (ep - p)
(ep, Just _) -> Just (ep - p)
_ -> Nothing
updateCreatureStrides :: World -> World
@@ -409,11 +412,11 @@ updateMouseContextGame cfig u = \case
_ -> fromMaybe aimcontext (overterm <|> overinv <|> overcomb)
where
w = u ^. uvWorld
-- isrotatedrag = do
-- t1 <- w ^. input . mouseButtons . at ButtonLeft
-- t2 <- w ^. input . mouseButtons . at ButtonRight
-- guard $ t1 > t2
-- return $ MouseGameRotate (dist (mouseWorldPosW w) (w ^. wCam . camCenter))
-- isrotatedrag = do
-- t1 <- w ^. input . mouseButtons . at ButtonLeft
-- t2 <- w ^. input . mouseButtons . at ButtonRight
-- guard $ t1 > t2
-- return $ MouseGameRotate (dist (mouseWorldPosW w) (w ^. wCam . camCenter))
aimcontext
| ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
| Display_debug `S.member` (cfig ^. debug_booleans) = getDebugMouseOver u
@@ -449,15 +452,15 @@ updateMouseContextGame cfig u = \case
getDebugMouseOver :: Universe -> MouseContext
getDebugMouseOver u = fromMaybe MouseInGame $ do
guard $ x >0 && x < 100
(db,j) <- m ^? ix i
guard $ x > 0 && x < 100
(db, j) <- m ^? ix i
return $ OverDebug db j
where
f (a,as) = (a,) <$> [0..length as - 1]
f (a, as) = (a,) <$> [0 .. length as - 1]
m = foldMap f . M.toList $ u ^. uvDebug
i = floor (y /20)
y = halfHeight (u^.uvConfig) - y'
V2 x y' = u^.uvWorld.input.mousePos
i = floor (y / 20)
y = halfHeight (u ^. uvConfig) - y'
V2 x y' = u ^. uvWorld . input . mousePos
getMenuMouseContext :: ScreenLayer -> Universe -> MouseContext
getMenuMouseContext screen u = case screen ^. scOptions of
@@ -509,11 +512,16 @@ updatePulseLasers w = f w & cWorld . lWorld . pulseLasers .~ pzs
updatePlasmaBall :: World -> PlasmaBall -> (World, Maybe PlasmaBall)
updatePlasmaBall w pb
| Just (_, ecrwl) <- thit = ( w
& cWorld . lWorld %~ dodam ecrwl, Nothing)
| Just (_, ecrwl) <- thit =
( w
& cWorld . lWorld %~ dodam ecrwl
, Nothing
)
| norm (pb ^. pbVel) <= 0 = (w, Nothing)
| otherwise = ( w -- flicker?
, Just $ pb & pbPos .~ ep )
| otherwise =
( w -- flicker?
, Just $ pb & pbPos .~ ep
)
where
dodam = \case
Left cr -> creatures . ix (_crID cr) . crDamage .:~ thedam
@@ -553,7 +561,7 @@ pbFlicker pt =
zoneClouds :: World -> World
zoneClouds w =
w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
& gasZoning .~ foldl' (flip zoneGas) mempty (w ^. cWorld . lWorld . gasses)
& gasZoning .~ foldl' (flip zoneGas) mempty (w ^. cWorld . lWorld . gasses)
zoneDusts :: World -> World
zoneDusts w = w & dsZoning .~ foldl' (flip zoneDust) mempty (w ^. cWorld . lWorld . dusts)
@@ -919,8 +927,9 @@ updateGas w c
newVel@(V3 _ _ nvz) = (0.95 *^ springVels) + V3 0 0 (0.01 * vertVel)
newVel2 = stripZ newVel
vertVel = min 5 $ 20 - opz
springVels = c ^. gsPos
+ alaf Sum foldMap (radiusSpring 10 oldPos . _gsPos) (gassesNearPoint oldPos2 w)
springVels =
c ^. gsPos
+ alaf Sum foldMap (radiusSpring 10 oldPos . _gsPos) (gassesNearPoint oldPos2 w)
oldPos@(V3 _ _ opz) = _gsPos c
oldPos2 = stripZ oldPos
newPos@(V3 _ _ npz) = oldPos + newVel
@@ -940,8 +949,9 @@ updateDust w c
& dsVel .~ newvel
& dsTimer -~ 1
where
v@(V3 _ _ vz) = c ^. dsVel
+ alaf Sum foldMap (radiusSpring 10 oldPos . _dsPos) (dssNearPoint oldPos2 w)
v@(V3 _ _ vz) =
c ^. dsVel
+ alaf Sum foldMap (radiusSpring 10 oldPos . _dsPos) (dssNearPoint oldPos2 w)
newvel = 0.95 * (maybe v (addZ vz . snd) hitWl - V3 0 0 0.05)
oldPos = _dsPos c
oldPos2 = stripZ oldPos
@@ -956,26 +966,36 @@ radiusSpring r a b
simpleCrSprings :: World -> World
simpleCrSprings w =
IM.foldl' (flip crSpring) w $
IM.foldl' (flip crSpring) (w & cWorld . lWorld . lTestString .~ mempty) $
IM.filter (\cr -> cr ^. crPos . _z >= 0) $ w ^. cWorld . lWorld . creatures
-- note that this may in rare cases not push creatures away from each other
crSpring :: Creature -> World -> World
--crSpring c w = foldl' (flip $ crCrSpring c) w $ crsNearPoint (c ^. crPos . _xy) w
crSpring c w = foldl' (flip $ crCrSpring c) w $ crsNearCirc (c ^. crPos . _xy)
(crRad $ c ^. crType) w
crSpring c w =
foldl' (flip $ crCrSpring c) w $
crsNearCirc
(c ^. crPos . _xy)
(crRad $ c ^. crType)
w
crCrSpring :: Creature -> Creature -> World -> World
crCrSpring c1 c2
| id1 == id2 = id
| vec == V2 0 0 = id
| diff >= comRad = id
| diff >= comRad || nopush c1 || nopush c2
= id
| otherwise =
cWorld . lWorld . creatures
%~ ( over (ix id1 . crPos . _xy) (+.+ overlap1)
. over (ix id2 . crPos . _xy) (-.- overlap2)
)
(cWorld . lWorld . creatures
%~ ( (ix id1 . crPos . _xy +~ overlap1)
. (ix id2 . crPos . _xy -~ overlap2)
))
. (cWorld . lWorld . lTestString .:~ show id1 <> " " <> show id2 )
where
nopush cr = case cr ^. crHP of
HP {} -> False
CrIsCorpse {} -> False
CrIsGibs -> True
CrIsPitted -> True
id1 = _crID c1
id2 = _crID c2
vec = c1 ^. crPos . _xy - c2 ^. crPos . _xy