Fix bugs in zoning

src/Dodge/Base/Collide.hs

@@ -327,7 +327,7 @@ canSeeIndirect i j w = hasLOSIndirect ipos jpos w
 anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
 anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
   where
-    hitCr = IS.foldr f False $ crsNearSeg sp ep w
+    hitCr = IS.foldr f False $ crixsNearSeg sp ep w
     f cid bl =
         maybe
             False

src/Dodge/Damage.hs

@@ -1,23 +1,28 @@
-module Dodge.Damage where
+{-# LANGUAGE LambdaCase #-}
+module Dodge.Damage 
+    ( damageCrWl
+    , damageDirection
+    , damageCrWlID
+    , maxDamageType
+    ) where
 
 import qualified Data.Map.Strict as M
 import Dodge.Data.CrWlID
 import Dodge.Data.World
-import Dodge.Wall.Damage
 import FoldableHelp
 import Geometry.Vector
 import LensHelp
 import qualified IntMapHelp as IM
 
 damageCrWlID :: Damage -> CrWlID -> World -> World
-damageCrWlID dam crwl = case crwl of
+damageCrWlID dam = \case
     NothingID -> id
     CrID cid -> cWorld . creatures . ix cid . crState . csDamage .:~ dam
     WlID wlid -> cWorld . wallDamages %~ IM.insertWith (++) wlid [dam]
 
-damageCrWall :: Damage -> Either Creature Wall -> World -> World
+damageCrWl :: Damage -> Either Creature Wall -> World -> World
-damageCrWall dt (Left cr) = cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ dt
+damageCrWl dt (Left cr) = cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ dt
-damageCrWall dt (Right wl) = damageWall dt wl
+damageCrWl dt (Right wl) = cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) [dt]
 
 damageDirection :: [Damage] -> Maybe Float
 damageDirection ds = do

src/Dodge/Data.hs

@@ -1,10 +1,5 @@
-{-# LANGUAGE StrictData #-}
-{-# LANGUAGE TemplateHaskell #-}
-
 {- |
-Contains base datatypes that cannot be seperated into
+Rexports all Dodge.Data.x files.
-different modules because they are interdependent;
-circular imports are probably not a good idea.
 -}
 module Dodge.Data (
     module Dodge.Data.World,

src/Dodge/Data/Config.hs

@@ -46,6 +46,7 @@ data DebugBool
     | Bound_box_screen
     | Show_wall_search_rays
     | Show_dda_test
+    | Collision_test
     | Show_far_wall_detect
     | Show_select
     | Inspect_wall

src/Dodge/Data/World.hs

@@ -34,6 +34,7 @@ data World = World
     , _testFloat :: Float
     , _lLine :: (Point2, Point2)
     , _rLine :: (Point2, Point2)
+    , _lrLine :: (Point2, Point2)
     , _lSelect :: Point2
     , _rSelect :: Point2
     , _backspaceTimer :: Int

src/Dodge/Default/World.hs

@@ -23,6 +23,7 @@ defaultWorld =
         , _mousePos = V2 0 0
         , _hammers = defaultWorldHammers
         , _testFloat = 0
+        , _lrLine = (0, 0)
         , _lLine = (0, 0)
         , _rLine = (0, 0)
         , _lSelect = 0

src/Dodge/Draw.hs

@@ -0,0 +1,46 @@
+{- |
+Rexports all Dodge.x.Draw files.
+-}
+module Dodge.Draw (
+    module Dodge.Beam.Draw,
+    module Dodge.Block.Draw,
+    module Dodge.Item.Draw,
+    module Dodge.Bullet.Draw,
+    module Dodge.Button.Draw,
+    module Dodge.Cloud.Draw,
+    module Dodge.EnergyBall.Draw,
+    module Dodge.Flame.Draw,
+    module Dodge.Laser.Draw,
+    module Dodge.LightSource.Draw,
+    module Dodge.LinearShockwave.Draw,
+    module Dodge.Machine.Draw,
+    module Dodge.Projectile.Draw,
+    module Dodge.Prop.Draw,
+    module Dodge.RadarSweep.Draw,
+    module Dodge.Spark.Draw,
+    module Dodge.Targeting.Draw,
+    module Dodge.Tesla.Arc.Draw,
+    module Dodge.TractorBeam.Draw,
+    module Dodge.Shockwave.Draw,
+) where
+
+import Dodge.Beam.Draw
+import Dodge.Item.Draw
+import Dodge.Block.Draw
+import Dodge.Bullet.Draw
+import Dodge.Button.Draw
+import Dodge.Cloud.Draw
+import Dodge.EnergyBall.Draw
+import Dodge.Flame.Draw
+import Dodge.Laser.Draw
+import Dodge.LightSource.Draw
+import Dodge.LinearShockwave.Draw
+import Dodge.Machine.Draw
+import Dodge.Projectile.Draw
+import Dodge.Prop.Draw
+import Dodge.RadarSweep.Draw
+import Dodge.Shockwave.Draw
+import Dodge.Spark.Draw
+import Dodge.Targeting.Draw
+import Dodge.Tesla.Arc.Draw
+import Dodge.TractorBeam.Draw

src/Dodge/Machine/Update.hs

@@ -70,7 +70,7 @@ mcSensorTriggerUpdate :: Sensor -> Machine -> World -> World
 mcSensorTriggerUpdate se mc = fromMaybe id $ do
     trid <- mc ^? mcMounts . ix ObTrigger
     bval <- mcTriggerVal se
-    return $ cWorld . triggers . ix trid .~ bval
+    return $ cWorld . triggers . ix trid ||~ bval
 
 mcTriggerVal :: Sensor -> Maybe Bool
 mcTriggerVal se = case se of

src/Dodge/Placement/Instance/Sensor.hs

@@ -19,26 +19,34 @@ damageSensor ::
     PlacementSpot ->
     Placement
 damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
-    \lsid -> psPtJpl ps $
+    \lsid -> psPtJpl ps
-        PutUsingGenParams $
+        . PutUsingGenParams
-            \gw ->
+        $ \gw ->
-                ( gw
+            ( gw
-                , PutMachine
+            , PutMachine
-                    (reverse $ square wdth)
+                (reverse $ square wdth)
-                    ( defaultMachine
+                ( defaultMachine
-                        & mcColor .~ yellow
+                    & mcColor .~ yellow
-                        & mcMounts . at ObTrigger .~ mtrid
+                    & mcMounts . at ObTrigger .~ mtrid
-                        & mcMounts . at ObLightSource ?~ lsid
+                    & mcMounts . at ObLightSource ?~ lsid
-                        & mcType .~ McSensor (DamageSensor False 0 dt (_sensorCoding (_genParams (_cWorld gw)) M.! dt) (damageTypeThreshold dt))
+                    & mcType
-                    )
+                        .~ McSensor
-                    defaultSensorWall
+                            ( DamageSensor
+                                False
+                                0
+                                dt
+                                (_sensorCoding (_genParams (_cWorld gw)) M.! dt)
+                                (damageTypeThreshold dt)
+                            )
                 )
+                defaultSensorWall
+            )
 
 damageTypeThreshold :: DamageType -> Int
 damageTypeThreshold dt = case dt of
-    FLAMING     -> 1000
+    FLAMING -> 1000
-    LASERING    -> 1000
+    LASERING -> 1000
-    ELECTRICAL  -> 5
+    ELECTRICAL -> 500
     _ -> undefined
 
 lightSensor ::

src/Dodge/Render/Label.hs

@@ -0,0 +1,31 @@
+module Dodge.Render.Label
+    where
+import Dodge.Base.Coordinate
+import Dodge.ShortShow
+import Dodge.Base.WinScale
+import Picture
+import Dodge.Data.Universe
+import Geometry
+
+drawLabCrossCol :: Configuration -> World -> Color -> Point2 -> Picture
+drawLabCrossCol cfig w col p = drawCrossCol col p
+    <> drawPointLabel cfig w p
+
+drawPointLabel :: Configuration -> World -> Point2 -> Picture 
+drawPointLabel cfig w p =
+    setLayer FixedCoordLayer . winScale cfig
+        . uncurryV translate p'
+        . scale 0.1 0.1
+        . text
+        $ shortPoint2 p
+  where
+    p' = worldPosToScreen w p
+
+drawCrossCol :: Color -> Point2 -> Picture
+drawCrossCol col p = setLayer DebugLayer . color col . uncurryV translate p $ crossPic 5
+
+drawCross :: Point2 -> Picture
+drawCross = drawCrossCol red
+
+crossPic :: Float -> Picture
+crossPic x = line [V2 x x, V2 (- x) (- x)] <> line [V2 (- x) x, V2 x (- x)]

src/Dodge/Render/ShapePicture.hs

@@ -2,7 +2,8 @@ module Dodge.Render.ShapePicture (
     worldSPic,
 ) where
 
-import Dodge.Zoning.Base
+import Dodge.Render.Label
+import Dodge.WorldEvent.ThingsHit
 import Control.Lens
 import Data.Foldable
 import qualified Data.Graph.Inductive as FGL
@@ -10,47 +11,28 @@ import qualified Data.Map.Strict as M
 import Data.Maybe
 import qualified Data.Set as Set
 import Dodge.Base
-import Dodge.Beam.Draw
-import Dodge.Block.Draw
-import Dodge.Bullet.Draw
-import Dodge.Button.Draw
-import Dodge.Cloud.Draw
 import Dodge.Creature.Picture
 import Dodge.Creature.Picture.Awareness
 import Dodge.Data.Config
 import Dodge.Data.World
 import Dodge.Debug.Picture
-import Dodge.EnergyBall.Draw
+import Dodge.Draw
-import Dodge.Flame.Draw
 import Dodge.Flare
 import Dodge.GameRoom
 import Dodge.Graph
-import Dodge.Item.Draw.SPic
-import Dodge.Laser.Draw
-import Dodge.LightSource.Draw
-import Dodge.LinearShockwave.Draw
-import Dodge.Machine.Draw
 import Dodge.Path
 import Dodge.Picture.SizeInvariant
-import Dodge.Projectile.Draw
-import Dodge.Prop.Draw
 import Dodge.RadarBlip
-import Dodge.RadarSweep.Draw
 import Dodge.Render.InfoBox
 import Dodge.Render.List
-import Dodge.Shockwave.Draw
 import Dodge.ShortShow
 import Dodge.SoundLogic.LoadSound
-import Dodge.Spark.Draw
-import Dodge.Targeting.Draw
-import Dodge.Tesla.Arc.Draw
-import Dodge.TractorBeam.Draw
 import Dodge.Update.Camera
 import Dodge.Zone
 import Dodge.Zoning
+import Dodge.Zoning.Base
 import Geometry
 import Geometry.ConvexPoly
---import Geometry.Zone
 import qualified IntMapHelp as IM
 import Padding
 import Picture
@@ -172,36 +154,47 @@ debugDraw cfig w
             <> setLayer FixedCoordLayer (listPicturesAt (0.5 * halfWidth cfig) 0 cfig $ map text ts)
     | otherwise = mempty
   where
-    (ts, pic) = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
+    pic = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
+    ts = map show (Set.toList $ _debug_booleans cfig)
 
-debugDraw' :: Configuration -> World -> DebugBool -> ([String], Picture)
+debugDraw' :: Configuration -> World -> DebugBool -> Picture
 {-# INLINE debugDraw' #-}
 debugDraw' cfig w bl = case bl of
-    Show_debug -> lstring "Show debug"
+    Show_debug -> mempty
-    Noclip -> lstring "Noclip"
+    Noclip -> mempty
-    Remove_LOS -> lstring "No line of sight"
+    Remove_LOS -> mempty
-    Cull_more_lights -> lstring "Cull more lights"
+    Cull_more_lights -> mempty
-    Close_shape_culling -> lstring "Close shape culling"
+    Close_shape_culling -> mempty
-    Bound_box_screen -> lstring "bound box screen, this should be moved"
+    Bound_box_screen -> mempty
-    Show_ms_frame -> rdraw mempty
+    Show_ms_frame -> mempty
-    View_boundaries -> rdraw $ viewBoundaries w
+    View_boundaries -> viewBoundaries w
-    Show_bound_box -> rdraw $ drawBoundingBox w
+    Show_bound_box -> drawBoundingBox w
-    Show_wall_search_rays -> rdraw $ drawWallSearchRays w
+    Show_wall_search_rays -> drawWallSearchRays w
-    Show_dda_test -> rdraw $ drawDDATest w
+    Show_dda_test -> drawDDATest w
-    Show_far_wall_detect -> rdraw $ drawFarWallDetect w
+    Show_far_wall_detect -> drawFarWallDetect w
-    Show_select -> rdraw $ drawWorldSelect w
+    Show_select -> drawWorldSelect w
-    Inspect_wall -> rdraw $ drawInspectWalls w
+    Inspect_wall -> drawInspectWalls w
-    Cr_awareness -> rdraw $ drawCreatureDisplayTexts w
+    Cr_awareness -> drawCreatureDisplayTexts w
-    Show_sound -> rdraw $ pictures $ M.map (soundPic cfig w) $ _playingSounds w
+    Show_sound -> pictures $ M.map (soundPic cfig w) $ _playingSounds w
-    Cr_status -> rdraw $ drawCrInfo cfig w
+    Cr_status -> drawCrInfo cfig w
-    Mouse_position -> rdraw $ drawMousePosition cfig w
+    Mouse_position -> drawMousePosition cfig w
-    Walls_info -> rdraw $ drawWlIDs cfig w
+    Walls_info -> drawWlIDs cfig w
-    Pathing -> rdraw $ drawPathing cfig w
+    Pathing -> drawPathing cfig w
-    Show_nodes_near_select -> rdraw $ drawNodesNearSelect w
+    Show_nodes_near_select -> drawNodesNearSelect w
-    Show_path_between -> rdraw $ drawPathBetween w
+    Show_path_between -> drawPathBetween w
+    Collision_test -> drawCollisionTest cfig w
+
+drawCollisionTest :: Configuration -> World -> Picture
+drawCollisionTest cfig w =
+    setLayer DebugLayer (color orange $ line [a,b])
+    <> foldMap (drawCross . fst) (crHit a b w) 
+    <> foldMap (drawCross . _crPos) (crsNearSeg a b w) 
+--    <> foldMap (drawZoneCol green crZoneSize) (zoneOfSeg' crZoneSize a b)
+    <> foldMap (drawZoneCol green crZoneSize . zoneOfPoint' crZoneSize) (xIntercepts' crZoneSize a b)
+    <> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint' crZoneSize) (yIntercepts' crZoneSize a b)
+    <> foldMap (drawLabCrossCol cfig w blue) (xIntercepts' crZoneSize a b)
   where
-    lstring str = ([str], mempty)
+    (a, b) = _lrLine w
-    rdraw pic = (mempty, pic)
 
 drawCreatureDisplayTexts :: World -> Picture
 drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures (_cWorld w))
@@ -229,9 +222,11 @@ drawNodesNearSelect w =
 
 drawInspectWalls :: World -> Picture
 drawInspectWalls w =
-    foldMap (drawInspectWall w) $
+    setLayer DebugLayer (color orange $ line [a,b]) <>
+    foldMap (drawInspectWall w) (
         filter (isJust . uncurry (intersectSegSeg a b) . _wlLine) $
             IM.elems $ _walls (_cWorld w)
+    )
   where
     (a, b) = _lLine w
 
@@ -287,25 +282,21 @@ drawFarWallDetect w =
 drawDDATest :: World -> Picture
 drawDDATest w =
     foldMap (drawZoneCol orange 50) ps
---    runIdentity (S.foldMap_ (drawZoneCol orange 50) ps)
+        --    runIdentity (S.foldMap_ (drawZoneCol orange 50) ps)
---        <> runIdentity (S.foldMap_ (drawZoneCol green 50) ps')
+        --        <> runIdentity (S.foldMap_ (drawZoneCol green 50) ps')
---        <> runIdentity (S.foldMap_ drawCross qs)
+        --        <> runIdentity (S.foldMap_ drawCross qs)
---        <> color blue (runIdentity (S.foldMap_ drawCross qs'))
+        --        <> color blue (runIdentity (S.foldMap_ drawCross qs'))
         <> setLayer DebugLayer (color yellow (line [cvf, mwp]))
   where
     cvf = _cameraViewFrom (_cWorld w)
     mwp = mouseWorldPos w
     --ps = ddaStreamX 50 cvf mwp
     ps = zoneOfSeg' 50 cvf mwp
-    --ps' = ddaStreamY 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
-    --qs = xIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
-    --qs' = yIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
 
-drawCross :: Point2 -> Picture
+--ps' = ddaStreamY 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
-drawCross p = setLayer DebugLayer . color red . uncurryV translate p $ crossPic 5
+--qs = xIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
+--qs' = yIntercepts 50 (_cameraViewFrom (_cWorld w)) (mouseWorldPos w)
 
-crossPic :: Float -> Picture
-crossPic x = line [V2 x x, V2 (- x) (- x)] <> line [V2 (- x) x, V2 x (- x)]
 
 drawZoneCol :: Color -> Float -> V2 Int -> Picture
 drawZoneCol col s (V2 x y) = setLayer DebugLayer . color col $ thickLine 2 (p : ps ++ [p])

src/Dodge/Spark.hs

@@ -7,12 +7,12 @@ module Dodge.Spark (
     randSpark,
 ) where
 
+import Dodge.Damage
 import Color
 import Control.Monad.State
 import Dodge.Data.World
 import Dodge.WorldEvent.ThingsHit
 import Geometry
-import qualified IntMapHelp as IM
 import LensHelp
 import System.Random
 
@@ -37,8 +37,7 @@ sparkDam ::
     World ->
     World
 sparkDam sk sp ep mayEiCrWl = case mayEiCrWl of
-    (hitp, Left cr) -> cWorld . creatures . ix (_crID cr) . crState . csDamage .:~ thedam hitp
+    (hitp, eicrwl) -> damageCrWl (thedam hitp) eicrwl
-    (hitp, Right wl) -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) [thedam hitp]
   where
     thedam hitp = Damage (_skDamageType sk) 1 sp hitp ep NoDamageEffect
 
@@ -56,22 +55,21 @@ randColDirSpark ::
     World
 randColDirSpark randcol randdir pos w =
     w
-        & cWorld . sparks .:~ spark
         & randGen .~ g
+        & cWorld . sparks
+            .:~ Spark
+                { _skVel = rotateV dir (V2 5 0)
+                , _skColor = col
+                , _skPos = pos
+                , _skOldPos = pos
+                , _skWidth = 1
+                , _skDamageType = SPARKING
+                }
   where
     ((col, dir), g) = (`runState` _randGen w) $ do
         c <- randcol
         d <- randdir
         return (c, d)
-    spark =
-        Spark
-            { _skVel = rotateV dir (V2 5 0)
-            , _skColor = col
-            , _skPos = pos
-            , _skOldPos = pos
-            , _skWidth = 1
-            , _skDamageType = SPARKING
-            }
 
 randSpark ::
     DamageType ->

src/Dodge/Update.hs

@@ -158,12 +158,15 @@ zoneClouds w =
 
 updateWorldSelect :: World -> World
 updateWorldSelect w = f . g $ case (w ^? mouseButtons . ix ButtonLeft, w ^? mouseButtons . ix ButtonRight) of
-    (Nothing, Nothing) -> w
     (Just False, Nothing) -> w & lLine . _1 .~ mwp
+        & lrLine . _1 .~ mwp
     (Just True, Nothing) -> w & lLine . _2 .~ mwp
-    (Nothing, _) -> w
+        & lrLine . _1 .~ mwp
-    (Just False, _) -> w & rLine . _1 .~ mwp
+    (Nothing,Just False) -> w & rLine . _1 .~ mwp
-    (Just True, _) -> w & rLine . _2 .~ mwp
+        & lrLine . _2 .~ mwp
+    (Nothing,Just True) -> w & rLine . _2 .~ mwp
+        & lrLine . _2 .~ mwp
+    _ -> w
   where
     mwp = mouseWorldPos w
     f

src/Dodge/WorldEvent/ThingsHit.hs

@@ -10,6 +10,7 @@ module Dodge.WorldEvent.ThingsHit (
     thingsHitExceptCr,
     crsHitRadial,
     wlsHitRadial,
+    crHit,
 ) where
 
 import Control.Lens
@@ -38,16 +39,6 @@ thingsHit sp ep w =
         (map (second Left) (crsHit sp ep w))
         (map (second Right) (wlsHit sp ep w))
 
---{- List those objects that appear on a line.  -}
---thingsHit
---    :: Point2    -- ^ Line start point
---    -> Point2    -- ^ Line end point
---    -> World
---    -> StreamOf (Point2, Either Creature Wall)
---thingsHit sp ep w = void $ S.mergeOn (dist sp . fst)
---    (S.map (second Left)  (S.each $ crsHit sp ep w))
---    (S.map (second Right) (wlsHit sp ep w))
-
 crsHit :: Point2 -> Point2 -> World -> [(Point2, Creature)]
 crsHit sp ep w
     | sp == ep = mempty
@@ -56,7 +47,7 @@ crsHit sp ep w
             . overlap1SegCrs sp ep
             . mapMaybe (\cid -> w ^? cWorld . creatures . ix cid)
             . IS.toList
-            . crsNearSeg sp ep
+            . crixsNearSeg sp ep
             $ w
 
 thingHitFilt ::
@@ -71,16 +62,12 @@ thingHitFilt fcr fwl sp ep = List.find (f . snd) . thingsHit sp ep
     f (Left cr) = fcr cr
     f (Right wl) = fwl wl
 
---thingHitFilt :: (Creature -> Bool) -> (Wall -> Bool)
---    -> Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
---thingHitFilt fcr fwl sp ep = runIdentity . S.head_ . S.filter (f . snd) . thingsHit sp ep
---  where
---    f (Left cr) = fcr cr
---    f (Right wl) = fwl wl
-
 thingHit :: Point2 -> Point2 -> World -> Maybe (Point2, Either Creature Wall)
 thingHit sp ep = listToMaybe . thingsHit sp ep
 
+crHit :: Point2 -> Point2 -> World -> Maybe (Point2,Creature)
+crHit sp ep = listToMaybe . sortOn (dist sp . fst) . crsHit sp ep
+
 {- List objects that appear on a line.
 Can filter out a creature.  -}
 thingsHitExceptCr ::
@@ -98,20 +85,6 @@ thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
     crNotCid (_, Left cr) = _crID cr /= cid
     crNotCid _ = True
 
---{- List objects that appear on a line.
---Can filter out a creature.  -}
---thingsHitExceptCr
---    :: Maybe Int -- ^ A possible creature ID
---    -> Point2    -- ^ Line start point
---    -> Point2    -- ^ Line end point
---    -> World
---    -> StreamOf (Point2, Either Creature Wall)
---thingsHitExceptCr Nothing    sp ep = thingsHit sp ep
---thingsHitExceptCr (Just cid) sp ep = S.filter crNotCid . thingsHit sp ep
---  where
---    crNotCid (_,Left cr) = _crID cr /= cid
---    crNotCid _ = True
-
 wlsHit :: Point2 -> Point2 -> World -> [(Point2, Wall)]
 wlsHit sp ep
     | sp == ep = const mempty
@@ -120,13 +93,6 @@ wlsHit sp ep
             . overlapSegWalls sp ep
             . wlsNearSeg sp ep
 
---wlsHit :: Point2 -> Point2 -> World -> StreamOf (Point2, Wall)
---wlsHit sp ep
---    | sp == ep  = const mempty
---    | otherwise = sortStreamOn (dist sp . fst)
---        . overlapSegWalls sp ep
---        . wlsNearSeg sp ep
-
 wlsHitRadial :: Point2 -> Float -> World -> [(Point2, Wall)]
 wlsHitRadial p r = mapMaybe f . wlsNearCirc p r
   where
@@ -134,13 +100,6 @@ wlsHitRadial p r = mapMaybe f . wlsNearCirc p r
       where
         v = normalizeV $ vNormal $ uncurry (-.-) $ _wlLine wl
 
---wlsHitRadial :: Point2 -> Float -> World -> StreamOf (Point2, Wall)
---wlsHitRadial p r = S.mapMaybe f . wlsInsideCirc p r
---  where
---    f wl = uncurry (intersectSegSeg p (p -.- r *.* v)) (_wlLine wl) <&> (,wl)
---      where
---        v = normalizeV $ vNormal $ uncurry (-.-) $ _wlLine wl
-
 crsHitRadial :: Point2 -> Float -> World -> [(Point2, Creature)]
 crsHitRadial p r = mapMaybe f . crsNearCirc p r
   where

src/Dodge/Zoning/Base.hs

@@ -43,9 +43,11 @@ xIntercepts' :: Float -> Point2 -> Point2 -> [Point2]
 {-# INLINE xIntercepts' #-}
 xIntercepts' s (V2 sx sy) (V2 ex ey)
     | xdx == 0 = []
-    | xdx > 0 = zipWith V2 [sx', sx' + xdx * 50 .. ex] ([sy', sy' + ydx * 50 .. ey] ++ repeat ey)
+    | otherwise = zipWith V2 [halfstep + sx', halfstep + sx' + xdx * s .. ex] ([sy', sy' + ydx * s .. ey] ++ repeat ey)
-    | otherwise = zipWith V2 [sx' -50, sx' + xdx * 50 -50 .. ex -50] ([sy', sy' + ydx * 50 .. ey] ++ repeat ey)
   where
+    halfstep
+        | xdx > 0 = -s/2
+        | otherwise = s/2
     xdx = signum (ex - sx)
     ydx = (ey - sy) / abs (ex - sx) -- carefull: if this is zero
     sy' = sy + ydx * abs (sx - sx')

src/Dodge/Zoning/Creature.hs

@@ -15,8 +15,14 @@ crIXsNearPoint p w = zoneExtract (zoneOfPoint' crZoneSize p) (w ^. cWorld . crZo
 crsNearPoint :: Point2 -> World -> [Creature]
 crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w
 
-crsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
+crsNearSeg :: Point2 -> Point2 -> World -> [Creature]
-crsNearSeg sp ep w = zonesExtract (w ^. cWorld . crZoning) (zoneOfSeg' crZoneSize sp ep)
+crsNearSeg sp ep w = 
+    mapMaybe (\cid -> w ^? cWorld . creatures . ix cid)
+    . IS.toList
+    $ crixsNearSeg sp ep w
+
+crixsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
+crixsNearSeg sp ep w = zonesExtract (w ^. cWorld . crZoning) (zoneOfSeg' crZoneSize sp ep)
 
 crIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
 crIXsNearCirc p r = crsNearRect (p +.+ V2 r r) (p -.- V2 r r)