Fix crWallCollisions by using a rectangle zone instead of a point

This commit is contained in:
2023-01-03 17:36:28 +00:00
parent 5fc39bd12d
commit 5b4e8d75bb
9 changed files with 58 additions and 35 deletions
+3
View File
@@ -48,6 +48,9 @@ data DebugBool
| Show_dda_test
| Collision_test
| Show_far_wall_detect
| Show_walls_near_point_cursor
| Show_walls_near_point_you
| Show_zone_near_point_cursor
| Show_select
| Inspect_wall
| Show_nodes_near_select
+15 -19
View File
@@ -8,7 +8,7 @@ itmInfo :: Item -> String
itmInfo itm = itmBaseInfo itm ++ " " ++ itmUsageInfo itm
itmBaseInfo :: Item -> String
itmBaseInfo itm = case (itm ^. itType . iyBase) of
itmBaseInfo itm = case itm ^. itType . iyBase of
HELD hit -> heldInfo hit
LEFT lit -> leftInfo lit
EQUIP eit -> equipInfo eit
@@ -35,13 +35,13 @@ showInt i = case i of
heldInfo :: HeldItemType -> String
heldInfo hit = case hit of
BANGSTICK 1 -> "A MAKESHIFT FIREARM WITH A SHORT BARREL THAT REQUIRES RELOADING AFTER EACH SHOT."
BANGSTICK 1 -> "A FIREARM WITH A SHORT BARREL THAT REQUIRES RELOADING AFTER EACH SHOT."
BANGSTICK i -> showInt i++" SMALL GUN BARRELS STRAPPED TOGETHER. EACH BARREL MUST BE INDIVIDUALLY LOADED, BUT NOT ALL NEED BE LOADED FOR THE WEAPON TO FIRE. ALL LOADED BARRELS DISCHARGE SIMULATNEOUSLY, WITH SIGNIFICANT SPREAD."
PISTOL -> "A SMALL FIREARM FED BY A MAKESHIFT MAGAZINE. THE ENTIRE MAGAZINE MUST BE REPLACED WHEN RELOADING THE WEAPON."
PISTOL -> "A SMALL FIREARM FED BY A MAGAZINE. THE ENTIRE MAGAZINE MUST BE REPLACED WHEN RELOADING THE WEAPON."
REVOLVER -> "A SMALL FIREARM FED BY A REVOLVING CYLINDER. SINGLE SHOT AND LOAD."
REVOLVERX i -> "A SMALL FIREARM FED BY "++ showInt i++ "REVOLVING CYLINDERS."
MACHINEPISTOL -> "A SMALL FIREARM AUTOMATICALLY, AND EXTREMELY RAPIDLY, FED BY A MAKESHIFT MAGAZINE. THE ENTIRE MAGAZINE MUST BE REPLACED WHEN RELOADING THE WEAPON."
AUTOPISTOL -> "A SMALL FIREARM AUTOMATICALLY FED BY A MAKESHIFT MAGAZINE. THE ENTIRE MAGAZINE MUST BE REPLACED WHEN RELOADING THE WEAPON."
MACHINEPISTOL -> "A SMALL FIREARM AUTOMATICALLY, AND EXTREMELY RAPIDLY, FED BY A MAGAZINE. THE ENTIRE MAGAZINE MUST BE REPLACED WHEN RELOADING THE WEAPON."
AUTOPISTOL -> "A SMALL FIREARM AUTOMATICALLY FED BY A MAGAZINE. THE ENTIRE MAGAZINE MUST BE REPLACED WHEN RELOADING THE WEAPON."
SMG -> "A SMALL FIREARM WITH AN ATTACHED STOCK FOR STABILITY."
BANGCONE -> "A CONTAINER FOR DEBRIS. EXPOSIVE ACTION PROPELS THE DEBRIS AWAY FROM THE USER. QUITE UNWEILDY."
BLUNDERBUSS -> "A CONTAINER FOR DEBRIS ON THE END OF A STICK. EXPLOSIVE ACTION PROPELS THE DEBRIS AWAY FROM THE USER."
@@ -49,17 +49,17 @@ heldInfo hit = case hit of
GRAPECANNON i -> "AN "++ replicate (i-1) 'X' ++"L CONTAINER FOR DEBRIS ON THE END OF A STICK. EXPLOSIVE ACTION PROPELS THE DEBRIS AWAY FROM THE USER."
MINIGUNX i -> showInt i ++ " GUN BARRELS THAT REVOLVE RAPIDLY AROUND A CENTRAL STICK. REQUIRES CONSIDERABLE TIME TO WARM UP, BUT HAS AN EXTREMELY RAPID RATE OF FIRE. IT IS ALSO EXTREMELY DIFFICULT TO STABILISE."
VOLLEYGUN i -> showInt i ++ " GUN BARRELS LINED UP TO BE ROUGHLY PARALLEL. EACH BARREL MUST BE INDIVIDUALLY LOADED, BUT NOT ALL NEED BE LOADED FOR THE WEAPON TO FIRE. ALL LOADED BARRELS DISCHARGE SIMULTANEOUSLY."
RIFLE -> "A MAKESHIFT FIREARM WITH A MID LENGTH BARREL THAT REQUIRES RELOADING AFTER EACH SHOT."
REPEATER -> "A FIREARM FED BY A MAKESHIFT MAGAZINE. THE ENTIRE MAGAZINE MUST BE REPLACED WHEN RELOADING THE WEAPON."
AUTORIFLE -> "A FIREARM AUTOMATICALLY FED BY A MAKESHIFT MAGAZINE. THE ENTIRE MAGAZINE MUST BE REPLACED WHEN RELOADING THE WEAPON."
BURSTRIFLE -> "A FIREARM THAT RAPIDLY FIRES THREE PROJECTILES FROM ITS MAKESHIFT MAGAZINE. THE ENTIRE MAGAZINE MUST BE REPLACED WHEN RELOADING THE WEAPON."
RIFLE -> "A FIREARM WITH A MID LENGTH BARREL THAT REQUIRES RELOADING AFTER EACH SHOT."
REPEATER -> "A FIREARM FED BY A MAGAZINE. THE ENTIRE MAGAZINE MUST BE REPLACED WHEN RELOADING THE WEAPON."
AUTORIFLE -> "A FIREARM AUTOMATICALLY FED BY A MAGAZINE. THE ENTIRE MAGAZINE MUST BE REPLACED WHEN RELOADING THE WEAPON."
BURSTRIFLE -> "A FIREARM THAT RAPIDLY FIRES THREE PROJECTILES FROM ITS MAGAZINE. THE ENTIRE MAGAZINE MUST BE REPLACED WHEN RELOADING THE WEAPON."
BANGROD -> "A FIREARM WITH A LONG BARREL THAT REQUIRES RELOADING AFTER EACH SHOT."
ELEPHANTGUN -> "A FIREARM WITH A LONG BARREL THAT REQUIRES RELOADING AFTER EACH SHOT. ITS STOPPING POWER IS ONLY NOMINAL."
AMR -> "A MAKESHIFT ANTIMATERIEL RIFLE, DESIGNED TO DISABLE MILITARY EQUIPMENT. ITS LONG BARREL IS FED BY A MAKESHIFT MAGAZINE THAT MUST BE REPLACED WHEN RELOADING THE WEAPON."
AUTOAMR -> "A MAKESHIFT AUTOMATIC ANTIMATERIEL RIFLE, DESIGNED TO DISABLE MILITARY EQUIPMENT. ITS LONG BARREL IS FED BY A MAKESHIFT MAGAZINE THAT MUST BE REPLACED WHEN RELOADING THE WEAPON."
AMR -> "AN ANTIMATERIEL RIFLE, DESIGNED TO DISABLE MILITARY EQUIPMENT. ITS LONG BARREL IS FED BY A MAGAZINE THAT MUST BE REPLACED WHEN RELOADING THE WEAPON."
AUTOAMR -> "AN AUTOMATIC ANTIMATERIEL RIFLE, DESIGNED TO DISABLE MILITARY EQUIPMENT. ITS LONG BARREL IS FED BY A MAGAZINE THAT MUST BE REPLACED WHEN RELOADING THE WEAPON."
SNIPERRIFLE -> "A FIREARM DESIGNED WITH LONG RANGE CAPABILITY IN MIND. ITS LONG BARREL REQUIRES RELOADING AFTER EACH SHOT."
MACHINEGUN -> "A HEAVY FIREARM WHOSE RATE OF FIRE INCREASES DURING A BARRAGE."
FLAMESPITTER -> "A WEAPON THAT SQUIRTS OUT GLOBULES OF BURNING FUEL."
FLAMESPITTER -> "A WEAPON THAT GLOBS OUT BURNING FUEL."
FLAMETHROWER -> "A WEAPON THAT SQUIRTS OUT BURNING FUEL."
FLAMETORRENT -> "A WEAPON THAT STREAMS OUT BURNING FUEL IN A TORRENT."
FLAMEWALL -> "A WEAPON THAT SQUIRTS OUT BURNING FUEL ALL AROUND THE USER."
@@ -182,7 +182,7 @@ detectorInfo d = case d of
WALLDETECTOR -> "WALLS"
itmUsageInfo :: Item -> String
itmUsageInfo itm = case (itm ^. itType . iyBase) of
itmUsageInfo itm = case itm ^. itType . iyBase of
HELD _ -> heldPositionInfo itm
LEFT _ -> "THIS ITEM CAN BE EQUIPPED" ++ itmEquipSiteInfo itm
++ ". WHEN EQUIPPED, IT CAN BE ACTIVATED."
@@ -192,9 +192,7 @@ itmUsageInfo itm = case (itm ^. itType . iyBase) of
_ -> "THIS SHOULD NOT BE DISPLAYED"
heldPositionInfo :: Item -> String
heldPositionInfo itm = case itm ^? itUse . heldAim . aimStance of
Nothing -> undefined
Just as -> aimStanceInfo as
heldPositionInfo = maybe undefined aimStanceInfo . (^? itUse . heldAim . aimStance)
aimStanceInfo :: AimStance -> String
aimStanceInfo as = case as of
@@ -204,9 +202,7 @@ aimStanceInfo as = case as of
LeaveHolstered -> "IT IS TO BE LEFT HOLSTERED."
itmEquipSiteInfo :: Item -> String
itmEquipSiteInfo itm = case itm ^? itUse . equipEffect . eeSite of
Nothing -> ""
Just es -> equipSiteInfo es
itmEquipSiteInfo = maybe "" equipSiteInfo . (^? itUse . equipEffect . eeSite)
equipSiteInfo :: EquipSite -> String
equipSiteInfo es = case es of
+1 -1
View File
@@ -85,7 +85,7 @@ listCursorChooseBorderScale ygap s borders xoff yoff cfig yint col cursxsize cur
winScale cfig
. translate
(15 - (9 * s) + xoff - halfWidth cfig)
(halfHeight cfig + negate (yoff - s * 12.5) - ((s * 10 + ygap) * (fromIntegral yint + 1)))
(halfHeight cfig + s * 12.5 - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
. color col
$ chooseCursorBorders (s * wth) (s * hgt) borders
where
+26
View File
@@ -169,6 +169,9 @@ debugDraw' cfig w bl = case bl of
Show_wall_search_rays -> drawWallSearchRays w
Show_dda_test -> drawDDATest w
Show_far_wall_detect -> drawFarWallDetect w
Show_walls_near_point_cursor -> drawWallsNearCursor w
Show_walls_near_point_you -> drawWallsNearYou w
Show_zone_near_point_cursor -> drawZoneNearPointCursor w
Show_select -> drawWorldSelect w
Inspect_wall -> drawInspectWalls w
Cr_awareness -> drawCreatureDisplayTexts w
@@ -218,6 +221,22 @@ drawPathBetween w =
-- where
-- sp = _lSelect w
drawWallsNearYou :: World -> Picture
drawWallsNearYou w = fromMaybe mempty $ do
p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
return $ setLayer DebugLayer $ foldMap f $ wlsNearPoint p w
where
f wl = color violet $ thickLine 3 [a, b]
where
(a,b) = _wlLine wl
drawWallsNearCursor :: World -> Picture
drawWallsNearCursor w =
setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_camPos $ _cWorld w)) w
where
f wl = color rose $ thickLine 3 [a, b]
where
(a,b) = _wlLine wl
drawInspectWalls :: World -> Picture
drawInspectWalls w =
setLayer DebugLayer (color orange $ line [a,b]) <>
@@ -278,6 +297,13 @@ drawFarWallDetect w =
where
p = w ^. cWorld . camPos . camViewFrom
drawZoneNearPointCursor :: World -> Picture
drawZoneNearPointCursor w =
foldMap (drawZoneCol orange 50) ps
where
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)
ps = [zoneOfPoint 50 mwp]
drawDDATest :: World -> Picture
drawDDATest w =
foldMap (drawZoneCol orange 50) ps
+3 -8
View File
@@ -190,10 +190,10 @@ updateUniverseMid u = case _uvScreenLayers u of
. updateClouds
)
(_ : _) -> u
[] -> functionalUpdate' u
[] -> timeFlowUpdate u
functionalUpdate' :: Universe -> Universe
functionalUpdate' u = case u ^. uvWorld . cWorld . timeFlow of
timeFlowUpdate :: Universe -> Universe
timeFlowUpdate u = case u ^. uvWorld . cWorld . timeFlow of
NormalTimeFlow -> functionalUpdate u
ScrollTimeFlow smoothing _ _ _ -> over uvWorld (doTimeScroll smoothing) u
RewindLeftClick 0 _ -> u & uvWorld . cWorld . timeFlow .~ NormalTimeFlow
@@ -259,13 +259,8 @@ scrollTimeForward w = case w ^? cWorld . timeFlow . futureWorlds . _head of
functionalUpdate :: Universe -> Universe
functionalUpdate w =
checkEndGame
-- . updateRandGen
. over uvWorld (cWorld . lWorld . lClock +~ 1)
. over uvWorld updateWorldSelect'
-- . over uvWorld doRewind
-- . over uvWorld (hammers . each %~ moveHammerUp)
-- . over (uvWorld . hammers . each) moveHammerUp
-- . over uvWorld (hammers %~ fmap moveHammerUp)
. moveHammersUp
. over uvWorld updateDistortions
. over uvWorld updateCreatureSoundPositions
+5 -3
View File
@@ -37,15 +37,17 @@ colCrWall w c
%~ pushOutFromCorners rad ls'
. pushOutFromWalls rad ls'
. fst
. flip (collidePoint p1) wls' -- check push throughs
. flip (collidePoint p1) wls -- check push throughs
-- . flip (collidePointWalls' p1) wls -- check push throughs
rad = _crRad c + wallBuffer
p1 = _crOldPos c
p2 = _crPos c
ls = _wlLine <$> wls
ls' = filter (uncurry $ isLHS p1) ls
wls' = filter (not . _wlWalkable) $ wlsNearPoint p2 w
wls = filter (not . _wlWalkable) $ wlsNearPoint p2 w
--wls = filter (not . _wlWalkable) $ wlsNearPoint p2 w
wls = filter (not . _wlWalkable) $ wlsNearRect (p2 +.+ V2 r r) (p2 -.- V2 r r) w
r = _crRad c
--wls = filter (not . _wlWalkable) $ IM.elems $ _walls $ _lWorld $ _cWorld w
--wallPoints = map fst ls
+4 -2
View File
@@ -15,7 +15,7 @@ module Dodge.Zoning.Base
import Control.Lens
import qualified Data.IntSet as IS
import Data.Maybe
--import Data.Maybe
import Geometry
import Geometry.Zone
import qualified IntMapHelp as IM
@@ -24,6 +24,7 @@ zoneOfCirc :: Float -> Point2 -> Float -> [Int2]
zoneOfCirc zsize p r = zoneOfRect zsize (p +.+ V2 r r) (p -.- V2 r r)
zoneOfRect :: Float -> Point2 -> Point2 -> [Int2]
{-# INLINE zoneOfRect #-}
zoneOfRect s sp ep = [V2 x y | x <- makeIntInterval sx ex, y <- makeIntInterval sy ey]
where
V2 sx sy = zoneOfPoint s sp
@@ -45,9 +46,10 @@ zoneOfSeg :: Float -> Point2 -> Point2 -> [Int2]
{-# INLINE zoneOfSeg #-}
zoneOfSeg s sp ep = map (zoneOfPoint s) (sp : xIntercepts s sp ep ++ yIntercepts' s sp ep)
-- | zoneExtract (V2 x y) == fromMaybe mempty . (^? ix x . ix y)
zoneExtract :: Monoid m => Int2 -> IM.IntMap (IM.IntMap m) -> m
{-# INLINE zoneExtract #-}
zoneExtract (V2 x y) = fromMaybe mempty . (^? ix x . ix y)
zoneExtract (V2 x y) = foldOf (ix x . ix y)
zonesExtract :: Monoid m => IM.IntMap (IM.IntMap m) -> [Int2] -> m
{-# INLINE zonesExtract #-}
+1 -1
View File
@@ -16,4 +16,4 @@ nearSeg size f sp ep w = zonesExtract (f $ w ^. cWorld . lWorld) (zoneOfSeg size
nearRect :: Monoid m => Float -> (LWorld -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
{-# INLINE nearRect #-}
nearRect size f sp ep w = zonesExtract (f $ w ^. cWorld . lWorld) (zoneOfSeg size sp ep)
nearRect size f sp ep w = zonesExtract (f $ w ^. cWorld . lWorld) (zoneOfRect size sp ep)
-1
View File
@@ -12,7 +12,6 @@ import Dodge.Zoning.Common
wlIXsNearPoint :: Point2 -> World -> IS.IntSet
wlIXsNearPoint = nearPoint wlZoneSize _wlZoning
--wlIXsNearPoint p w = zoneExtract (zoneOfPoint wlZoneSize p) (w ^. cWorld . lWorld . wlZoning)
wlIXsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
{-# INLINE wlIXsNearSeg #-}