Fix crWallCollisions by using a rectangle zone instead of a point

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

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."
+    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 MAKESHIFT 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."
+    RIFLE -> "A 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."
+    REPEATER -> "A FIREARM FED BY A 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."
+    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 MAKESHIFT 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."
+    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 -> "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."
+    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
+heldPositionInfo = maybe undefined aimStanceInfo . (^? itUse . heldAim . aimStance)
-    Nothing -> undefined
-    Just as -> aimStanceInfo as
 
 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
+itmEquipSiteInfo = maybe "" equipSiteInfo . (^? itUse . equipEffect . eeSite)
-    Nothing -> ""
-    Just es -> equipSiteInfo es
 
 equipSiteInfo :: EquipSite -> String
 equipSiteInfo es = case es of

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

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

src/Dodge/Update.hs

@@ -190,10 +190,10 @@ updateUniverseMid u = case _uvScreenLayers u of
                     . updateClouds
                )
     (_ : _) -> u
-    [] -> functionalUpdate' u
+    [] -> timeFlowUpdate u
 
-functionalUpdate' :: Universe -> Universe
+timeFlowUpdate :: Universe -> Universe
-functionalUpdate' u = case u ^. uvWorld . cWorld . timeFlow of
+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

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
 

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 #-}

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)

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 #-}