Fix bug in line zoning by using less ambitious algorithm

src/Dodge/Update.hs

@@ -143,7 +143,7 @@ updateInstantParticles w = case _instantParticles w of
         in updateInstantParticles $ w' & particles %~ (catMaybes ps' ++)
 
 updateMIM :: ASetter' World (IM.IntMap a) -> (a -> a -> Maybe a) -> World -> World
-updateMIM f up w = w & f %~ IM.mapMaybe (dbArg up)
+updateMIM f up = f %~ IM.mapMaybe (dbArg up)
 
 -- Note that this updates the randgen
 --updateCreatures :: World -> World
@@ -160,12 +160,15 @@ updateMIM f up w = w & f %~ IM.mapMaybe (dbArg up)
 ppEvents :: World -> World
 ppEvents w = IM.foldl' (flip $ \pp -> _ppEvent pp pp) w $ _pressPlates w
 
+-- this is not working correctly, maybe a problem with wallsAlongLine
 updateSeenWalls :: World -> World
 updateSeenWalls w = foldl' markWallSeen w wallsToUpdate
   where 
     vPos = _cameraViewFrom w
     wallsToUpdate = concatMap (\p -> visibleWalls vPos (vPos +.+p) $ wallsAlongLine vPos (vPos +.+ p) w)
                              $ nRays 20
+--    wallsToUpdate = concatMap (\p -> visibleWalls vPos (vPos +.+p) $ _walls w)
+--                             $ nRays 20
 
 markWallSeen :: World -> Wall -> World
 markWallSeen w wl = w { _walls = IM.adjust mw (_wlID wl) $ _walls w }
@@ -269,7 +272,7 @@ crCrSpring c1 c2 w
 {- Finds the visible walls from a point to another point.  -}
 visibleWalls :: Point2 -> Point2 -> IM.IntMap Wall -> [Wall]
 visibleWalls p1 p2 ws 
-    = takeUntil theTest
+    = takeUntil isOpaque
     . map snd 
     . sortOn (dist p1 . fromJust . fst) 
     . filter (isJust . fst) 
@@ -277,7 +280,7 @@ visibleWalls p1 p2 ws
     $ IM.elems ws
   where 
     f wl = (uncurry intersectSegSeg (_wlLine wl) p1 p2, wl)
-    theTest wl = _wlOpacity wl /= Opaque
+    isOpaque wl = _wlOpacity wl == Opaque
 
 updateDelayedEvents :: World -> World
 updateDelayedEvents w = let (neww,newde) = mapAccumR f w (_delayedEvents w)

src/Dodge/WallCreatureCollisions.hs

@@ -81,11 +81,13 @@ pushOrCrush wls cr = case mapMaybe (pushOutFromWall (_crRad cr) cpos) wls of
 
 -- note the inclusion of endpoints in circOnSeg
 crOnWall :: Creature -> World -> Bool
-crOnWall cr w = any (\(a,b) -> circOnSeg a b p r) wls
+crOnWall cr = any (\(a,b) -> circOnSeg a b p r)
+    . fmap _wlLine 
+    . IM.filter (not . _wlWalkable) 
+    . wallsNearPoint p
   where
     p = _crPos cr
     r = _crRad cr
-    wls = fmap _wlLine . IM.filter (not . _wlWalkable) $ wallsNearPoint p w
  
 -- assumes that the wall is orientated
 -- assumes wall points are different

src/Dodge/World.hs

@@ -1,5 +0,0 @@
-{- |
-Placeholder... not sure of its purpose, but might deal with pure world change functions.
-The world datatype itself is very intertwined with the creature, weapon, etc datatypes.
- -}
-module Dodge.World where

src/Dodge/Zone.hs

@@ -29,6 +29,9 @@ import Data.List
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
 
+--flattenZones ::  Zone (IM.IntMap a) -> IM.IntMap a
+--flattenZones = flattenIMIMIM . _znObjects
+
 zoneSize :: Float
 zoneSize = 50
 
@@ -68,10 +71,12 @@ zoneOfLine (V2 aa ab) (V2 ba bb)
     $ digitalLine (zoneOfPoint (V2 aa ab)) (zoneOfPoint (V2 ba bb))
   where 
     f (x,y) = [(p,r) | p <-[x-1,x,x+1] , r<-[y-1,y,y+1]]
+    --f (x,y) = [(p,r) | p <-[x-2..x+2] , r<-[y-2..y+2]]
 
 zoneOfLineIntMap :: Point2 -> Point2 -> IM.IntMap IS.IntSet
 --{-# INLINE zoneOfLineIntMap #-}
-zoneOfLineIntMap = ddaExt zoneSize
+--zoneOfLineIntMap = ddaExt zoneSize
+zoneOfLineIntMap = ddaSq zoneSize
 
 zoneOfCircle :: Point2 -> Float -> [(Int,Int)]
 zoneOfCircle p r = concatMap zoneNearPoint $ divideCircle (1.5 * zoneSize) p r
@@ -148,7 +153,8 @@ cloudsNearPoint p w = f (IM.lookup x (_znObjects $ _cloudsZone w) >>= IM.lookup
 -- within this function
 wallsAlongLine :: Point2 -> Point2 -> World -> IM.IntMap Wall
 --{-# INLINE wallsAlongLine #-}
-wallsAlongLine a b w = IM.foldlWithKey' g IM.empty kps
+wallsAlongLine a b w =
+    IM.foldlWithKey' g IM.empty kps
   where 
     g m x s = IM.union (IM.unions (IM.restrictKeys (f x $ _znObjects $ _wallsZone w) s)) m
     kps = zoneOfLineIntMap a b

src/Geometry.hs

@@ -140,7 +140,7 @@ prependTwo sep (x:y:xs) = sep : x : y : prependTwo sep (y:xs)
 
 -- | Return n equidistant points on a circle with a radius of 600.
 nRays :: Int -> [Point2]
-nRays n = take n $ iterate (rotateV (2*pi/fromIntegral n)) (V2 600 0)
+nRays n = nRaysRad n 600
 -- | Return n equidistant points on a circle with a radius of x.
 nRaysRad :: Int -> Float -> [Point2]
 nRaysRad n x = take n $ iterate (rotateV (2*pi/fromIntegral n)) (V2 x 0)

src/Geometry/Zone.hs

@@ -1,8 +1,9 @@
 --{-# LANGUAGE TupleSections #-}
 module Geometry.Zone
     ( ddaExt
-    ) 
-    where
+    , ddaExt'
+    , ddaSq
+    ) where
 import Geometry.Data
 
 import Data.Foldable
@@ -77,10 +78,49 @@ sizeZoneOfPoint' s = fmap (divTo s)
 --    | y > x = [x .. y]
 --    | otherwise = [y .. x]
 
+-- | Determines a "square" zone of points for a line
+ddaSq :: Float -> V2 Float -> V2 Float -> IM.IntMap IS.IntSet
+ddaSq s (V2 sx sy) (V2 ex ey) = IM.fromSet (const ys) xs
+  where
+    maxMin a b | a >= b = (a,b)
+        | otherwise = (b,a)
+    (maxx,minx) = maxMin (divTo s sx) (divTo s ex)
+    (maxy,miny) = maxMin (divTo s sy) (divTo s ey)
+    xs = IS.fromDistinctAscList [minx-1..maxx+1]
+    ys = IS.fromDistinctAscList [miny-1..maxy+1]
+
 -- | Determines which horizontal and vertical lines on a grid are crossed by a
 -- line. For each adds the x-y index of the square to the right or above the
 -- crossed grid line. Also adds the index of the square containing the start
 -- point.
+ddaExt' :: Float -> V2 Float -> V2 Float -> IM.IntMap IS.IntSet
+ddaExt' s sp@(V2 sx sy) ep@(V2 ex ey) 
+    | x1 <= x2 = addsp . addys . IM.fromDistinctAscList $ zip [x1 .. x2] 
+                    $ map (IS.singleton . divTo s) [x1y,x1y+ydx..]
+    | otherwise = ddaExt' s ep sp
+  where
+    addsp im = let V2 x y = sizeZoneOfPoint' s sp
+        in insertXY im (x,y)
+    x1 = divTo s sx
+    x2 = divTo s ex
+    x1y = fx' sp ep $ s * fromIntegral x1
+    ydx = s * ydx' sp ep
+    addys m = add2s m ypairs 
+    y1 = divTo s sy
+    y2 = divTo s ey
+    y1x = fy' sp ep $ s * fromIntegral y1
+    y2x = fy' sp ep $ s * fromIntegral y2
+    xdy = s * xdy' sp ep
+    ypairs 
+        | y1 <= y2  = zip (map (divTo s) [y1x,y1x+xdy..])
+                         [y1 .. y2] 
+        | otherwise = zip (map (divTo s) [y2x,y2x+xdy..])
+                         [y2-1 .. y1-1] 
+-- | Determines which horizontal and vertical lines on a grid are crossed by a
+-- line. For each adds the x-y index of the square to the right or above the
+-- crossed grid line. Also adds the index of the square containing the start
+-- point.
+-- Not correct, eg ddaExt 10 (V2 40 50) (V2 0 0)
 ddaExt :: Float -> V2 Float -> V2 Float -> IM.IntMap IS.IntSet
 ddaExt s sp@(V2 sx sy) ep@(V2 ex ey) 
     | x1 <= x2 = addsp . addys . IM.fromDistinctAscList $ zip [x1 .. x2] 
@@ -89,7 +129,7 @@ ddaExt s sp@(V2 sx sy) ep@(V2 ex ey)
                     $ map (IS.singleton . divTo s) [x2y,x2y+ydx..]
   where
     addsp im = let V2 x y = sizeZoneOfPoint' s sp
-            in insertXY im (x,y)
+        in insertXY im (x,y)
     x1 = divTo s sx
     x2 = divTo s ex
     x1y = fx' sp ep $ s * fromIntegral x1

src/ListHelp.hs

@@ -1,6 +1,6 @@
 module ListHelp 
-    (module Data.List
-    ,initOrNull
+    ( module Data.List
+    , initOrNull
     , insertOver
     , swapIndices
     , (!?)

src/Preload/Render.hs

@@ -239,4 +239,3 @@ cleanUpRenderPreload pd = do
     --mapM_ freeShaderPointers $ _pictureShaders pd
     freeShaderPointers $ _lightingWallShadShader pd
     freeShaderPointers $ _fullscreenShader pd
-

src/Shader/Compile.hs

@@ -243,4 +243,3 @@ compileAndCheckShader str (theShaderType,sourceCode) = do
 
 bufferOffset :: Integral a => a -> Ptr b
 bufferOffset = plusPtr nullPtr . (* floatSize) . fromIntegral
-

src/Shader/Poke.hs

@@ -26,7 +26,7 @@ pokeVerxs
     -> UMV.MVector (PrimState IO) Int 
     -> Picture 
     -> IO ()
-pokeVerxs vbos count vxs = VS.mapM_ (pokeVerx vbos count) $ VS.fromList vxs
+pokeVerxs vbos count = VS.mapM_ (pokeVerx vbos count) . VS.fromList
 
 pokeVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
 pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do
@@ -243,4 +243,3 @@ pokePoint33 ptr n (V3 a b c,V3 d e f) = do
     return (n+1)
   where
     off i = n*6 + i
-