From 5b4e8d75bb8d553f94d870d009a3680d8ccd0c45 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 3 Jan 2023 17:36:28 +0000 Subject: [PATCH] Fix crWallCollisions by using a rectangle zone instead of a point --- src/Dodge/Data/Config.hs | 3 +++ src/Dodge/Item/Info.hs | 34 +++++++++++++---------------- src/Dodge/Render/List.hs | 2 +- src/Dodge/Render/ShapePicture.hs | 26 ++++++++++++++++++++++ src/Dodge/Update.hs | 11 +++------- src/Dodge/WallCreatureCollisions.hs | 8 ++++--- src/Dodge/Zoning/Base.hs | 6 +++-- src/Dodge/Zoning/Common.hs | 2 +- src/Dodge/Zoning/Wall.hs | 1 - 9 files changed, 58 insertions(+), 35 deletions(-) diff --git a/src/Dodge/Data/Config.hs b/src/Dodge/Data/Config.hs index 32b6e0b57..2184f9023 100644 --- a/src/Dodge/Data/Config.hs +++ b/src/Dodge/Data/Config.hs @@ -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 diff --git a/src/Dodge/Item/Info.hs b/src/Dodge/Item/Info.hs index 54c28cfd2..34a38b01d 100644 --- a/src/Dodge/Item/Info.hs +++ b/src/Dodge/Item/Info.hs @@ -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 diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index e6163f99a..d6bd479a5 100644 --- a/src/Dodge/Render/List.hs +++ b/src/Dodge/Render/List.hs @@ -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 diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 13e212783..ff665e68b 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 0d9951720..6faf841f5 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -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 diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index 7a1a5efd7..00e8e7a16 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/src/Dodge/WallCreatureCollisions.hs @@ -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 diff --git a/src/Dodge/Zoning/Base.hs b/src/Dodge/Zoning/Base.hs index 0b8069326..731d45fe7 100644 --- a/src/Dodge/Zoning/Base.hs +++ b/src/Dodge/Zoning/Base.hs @@ -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 #-} diff --git a/src/Dodge/Zoning/Common.hs b/src/Dodge/Zoning/Common.hs index 29469c53e..c9faae335 100644 --- a/src/Dodge/Zoning/Common.hs +++ b/src/Dodge/Zoning/Common.hs @@ -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) diff --git a/src/Dodge/Zoning/Wall.hs b/src/Dodge/Zoning/Wall.hs index 7dbe71eb7..d5c5633e6 100644 --- a/src/Dodge/Zoning/Wall.hs +++ b/src/Dodge/Zoning/Wall.hs @@ -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 #-}