Cleanup

src/Dodge/Base.hs

@@ -234,10 +234,13 @@ collidePointWalls p1 p2
     findPoint (x,y) p = fromMaybe p $ intersectSegSeg p1 p x y
 
 collidePointWallsFilter :: (Wall -> Bool) -> Point2 -> Point2 -> IM.IntMap Wall -> Point2
-collidePointWallsFilter t p1 p2 
-    = foldr findPoint p2 . fmap _wlLine . IM.filter t
+collidePointWallsFilter t p1 p2 = foldr findPoint p2 . fmap _wlLine . IM.filter t
   where
     findPoint (x,y) p = fromMaybe p $ intersectSegSeg p1 p x y
+collidePointWallsFilter' :: (Wall -> Bool) -> Point2 -> Point2 -> IM.IntMap Wall -> Point2
+collidePointWallsFilter' t p1 p2 = foldl' findPoint p2 . fmap _wlLine . IM.filter t
+  where
+    findPoint p = fromMaybe p . uncurry (intersectSegSeg p1 p)
 
 -- | Looks for first collision of a circle with walls.
 -- If found, gives point and reflection velocity, reflection damped in normal.

src/Dodge/Base/Collide.hs

@@ -166,13 +166,13 @@ ssfold :: Foldable t => (a -> Bool) -> (a -> b -> a) -> a -> t b -> a
 {-# INLINABLE ssfold #-}
 ssfold p f a0 xs = foldr (\x g a -> if p a then a else g (f a x)) id xs a0
 
-collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
-{-# INLINE collidePointIndirect #-}
-collidePointIndirect p1 p2 = test . foldr f p2 . IM.filter wlIsOpaque
-  where
-    f wl p = fromMaybe p $ uncurry (intersectSegSeg p1 p) $ _wlLine wl
-    test p | p == p2 = Nothing
-           | otherwise = Just p
+--collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
+--{-# INLINE collidePointIndirect #-}
+--collidePointIndirect p1 p2 = test . foldr f p2 . IM.filter wlIsOpaque
+--  where
+--    f wl p = fromMaybe p $ uncurry (intersectSegSeg p1 p) $ _wlLine wl
+--    test p | p == p2 = Nothing
+--           | otherwise = Just p
 
 collidePointIndirect' :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
 {-# INLINE collidePointIndirect' #-}
@@ -260,7 +260,8 @@ canSee i j w = hasLOS p1 p2 w
 --    jpos = _crPos (_creatures w IM.! j)
 
 canSeeIndirect :: Int -> Int -> World -> Bool
-canSeeIndirect i j w = isNothing . collidePointIndirect ipos jpos $ wallsAlongLine ipos jpos w
+canSeeIndirect i j w = any (isJust . uncurry (intersectSegSeg ipos jpos) . _wlLine) 
+    $ IM.filter wlIsOpaque $ wallsAlongLine ipos jpos w
   where 
     ipos = _crPos (_creatures w IM.! i)
     jpos = _crPos (_creatures w IM.! j)

src/Dodge/Base/Window.hs

@@ -48,7 +48,7 @@ halfWidth w = _windowX w / 2
 halfHeight w = _windowY w / 2
 -- | A box of the size of the screen in screen centered coordinates
 screenBox :: Configuration -> [Point2]
-screenBox w = reverse $ rectNSWE hh (-hh) (-hw) hw
+screenBox w = rectNSWE hh (-hh) (-hw) hw
   where
     hw = halfWidth w
     hh = halfHeight w

src/Dodge/Config/Data.hs

@@ -6,6 +6,7 @@ import Data.Aeson
 import qualified Data.Set as S
 import GHC.Generics
 import Control.Lens
+{-# ANN module "HLint: ignore Use camelCase" #-}
 data Configuration = Configuration
     { _volume_master        :: Float
     , _volume_sound         :: Float
@@ -24,8 +25,8 @@ data Configuration = Configuration
     }
   deriving (Generic, Show)
 data DebugBool
-    = Show_sound
-    | Show_ms_frame
+    = Show_ms_frame
+    | Show_sound
     | Noclip
     | Cr_status
     | Cr_awareness
@@ -35,6 +36,9 @@ data DebugBool
     | Pathing        
     | Remove_LOS    
     | Cull_more_lights
+    | Close_shape_culling
+    | Show_bound_box
+    | Bound_box_screen
   deriving (Generic, Eq,Ord,Bounded, Enum, Show)
 data ResFactor = FullRes | HalfRes | QuarterRes
   deriving (Generic, Show, Eq, Ord, Enum, Bounded)

src/Dodge/CullBox.hs

@@ -3,7 +3,7 @@ module Dodge.CullBox
     ) where
 import Dodge.Data
 --import Dodge.GameRoom
---import Dodge.Base
+import Dodge.Base.Window
 --import Dodge.Zone
 import Geometry
 import Dodge.Update.Camera
@@ -13,8 +13,10 @@ import Dodge.Update.Camera
 
 cullBox :: Configuration -> World -> [Point2]
 --cullBox cfig w = farWallPoints cp w
-cullBox cfig w' = let (n,s,e,w) = farWallDistDirection (_cameraCenter w') cfig w'
-    in map ((+.+ _cameraCenter w') . rotateV (_cameraRot w') ) $ rectNSWE n (negate s) (negate w) e
+cullBox cfig w' 
+    | debugOn Bound_box_screen cfig = screenPolygon cfig w'
+    | otherwise = let (n,s,e,w) = farWallDistDirection (_cameraCenter w') cfig w'
+            in map ((+.+ _cameraCenter w') . rotateV (_cameraRot w') ) $ rectNSWE n (negate s) (negate w) e
 --    --mapMaybe (fmap (fst . _wlLine . snd) . f) $ screenPolygon cfig w
 --  where
 --    grs = filter (pointInOrOnPolygon cp . _grBound) (_gameRooms w)

src/Dodge/Debug/Picture.hs

@@ -43,7 +43,7 @@ lineOnScreenCone cfig w p1 p2 = pointInPolygon p1 sp
     sps = zip sp (tail sp ++ [head sp])
 
 pointOnScreen :: Configuration -> World -> Point2 -> Bool
-pointOnScreen cfig w p = pointInPolygon p . reverse $ screenPolygon cfig w
+pointOnScreen cfig w p = pointInPolygon p $ screenPolygon cfig w
 
 drawWallFace :: Configuration -> World -> Wall -> Picture
 drawWallFace cfig w wall
@@ -58,7 +58,7 @@ extendConeToScreenEdge :: Configuration -> World -> Point2 -> (Point2,Point2) ->
 extendConeToScreenEdge cfig w c (x,y) = orderPolygon $ wallScreenIntersect ++ [x,y] ++ borderPs ++ cornerPs
   where 
     borderPs = mapMaybe (intersectLinefromScreen cfig w c) [x,y]
-    scpoly = screenPolygon cfig w
+    scpoly = reverse $ screenPolygon cfig w
     cornerPs = filter (pointIsInCone c (x,y)) scpoly
     wallScreenIntersect = mapMaybe (uncurry $ intersectSegSeg y ((2*.*y) -.- x)) 
                               . loopPairs $ scpoly

src/Dodge/Render.hs

@@ -39,7 +39,7 @@ doDrawing pdata u = do
         wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
         resFact             = resFactorNum $ cfig ^. graphics_resolution_factor
         (wallPointsCol,windowPoints,wallSPics) = wallsToDrawStreams cfig w
-        lightPoints             = lightsForGloom cfig w
+        lightPoints             = lightsToRender cfig w
         viewFroms@(V2 vfx vfy)  = _cameraViewFrom w
         viewFrom3d              = Vector3 vfx vfy 20
         shadV   = _pictureShaders pdata
@@ -107,7 +107,7 @@ doDrawing pdata u = do
     currentProgram $= Just (_shadProg lwShad)
     uniform (head $  _shadUnis lwShad) $= viewFrom3d
     bindVertexArrayObject $= Just (_vao $ _shadVAO lwShad)
-    when (not (debugOn Remove_LOS cfig)) $ glDrawArrays 
+    unless (debugOn Remove_LOS cfig) $ glDrawArrays 
         (marshalEPrimitiveMode $ _shadPrim lwShad) 
         0 
         (fromIntegral nWalls)

src/Dodge/Render/Lights.hs

@@ -1,5 +1,5 @@
 module Dodge.Render.Lights
-    ( lightsForGloom
+    ( lightsToRender
     ) where
 import Dodge.Data
 import Dodge.CullBox
@@ -8,8 +8,8 @@ import Geometry
 import Data.Maybe
 import qualified Data.IntMap.Lazy as IM
 
-lightsForGloom :: Configuration -> World -> [(Point3,Float,Point3)]
-lightsForGloom cfig w = mapMaybe getLS (IM.elems $ _lightSources w) 
+lightsToRender :: Configuration -> World -> [(Point3,Float,Point3)]
+lightsToRender cfig w = mapMaybe getLS (IM.elems $ _lightSources w) 
     ++ mapMaybe getTLS (_tempLightSources w)
   where 
     getLS  = getlsparam . _lsParam

src/Dodge/Render/MenuScreen.hs

@@ -73,7 +73,7 @@ optionValueOffset u mo = case _moString mo u of
     Right (s,_) -> length s
 
 darkenBackground :: Configuration -> Picture
-darkenBackground = color (withAlpha 0.5 black) . polygon . screenBox
+darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox
 
 drawTitle :: Configuration -> String -> Picture
 drawTitle cfig = placeString (-hw + 30) (hh - 50) 0.4

src/Dodge/Render/ShapePicture.hs

@@ -41,12 +41,12 @@ worldSPic cfig w =
     <> foldMap mcSPic (filtOn _mcPos _machines)
   where
     filtOn f g = IM.filter (pointIsClose . f) (g w)
-    --pointIsClose p = dist camCen p < _viewDistance w
-    pointIsClose = cullPoint w
-    --camCen = _cameraCenter w
+    pointIsClose = cullPoint cfig w
 
-cullPoint :: World -> Point2 -> Bool
-cullPoint w p = pointInPolygon p (_boundBox w)
+cullPoint :: Configuration -> World -> Point2 -> Bool
+cullPoint cfig w p 
+    | debugOn Close_shape_culling cfig = pointInPolygon p (_boundBox w)
+    | otherwise = dist (_cameraCenter w) p < _viewDistance w
 
 extraShapes :: World -> Shape
 extraShapes = _foregroundShape
@@ -69,9 +69,15 @@ extraPics cfig w = pictures (_decorations w)
     <> drawWallIDs cfig w
     <> drawPathing cfig w
     <> drawCrInfo cfig w
+    <> drawBoundingBox cfig w
 
 testPic :: Configuration -> World -> Picture
-testPic cfig w = setLayer DebugLayer $ color green $ line $ (x:xs) ++ [x]
+testPic _ _ = mempty
+
+drawBoundingBox :: Configuration -> World -> Picture
+drawBoundingBox cfig w 
+    | debugOn Show_bound_box cfig = setLayer DebugLayer $ color green $ line $ (x:xs) ++ [x]
+    | otherwise = mempty
   where
     (x:xs) = cullBox cfig w
 

src/Dodge/Update/Camera.hs

@@ -210,7 +210,7 @@ farWallDistDirection :: Point2 -> Configuration -> World -> (Float,Float,Float,F
 --farWallDist p cfig w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps
 farWallDistDirection p cfig w = foldr (m . f) (0,0,0,0) vps
   where
-    f q = g $ rotateV (negate $ _cameraRot w) $ collidePointWallsFilter wlIsOpaque p q wos -.- p
+    f q = g $ rotateV (negate $ _cameraRot w) $ collidePointWallsFilter' wlIsOpaque p q wos -.- p
     g (V2 x y) = (y, negate y, x, negate x)
     m (a,b,c,d) (x,y,z,w') = (max a x, max b y, max c z, max d w')
     vps = concatMap _grViewpoints grs ++ extendedViewPoints p grs

src/Geometry/LHS.hs

@@ -11,13 +11,10 @@ isLHS
     -> Point2  -- ^ Point not on line.
     -> Bool
 {-# INLINE isLHS #-}
-isLHS 
-    (V2 x y)      
-    (V2 x' y')   
-    (V2 x'' y'') 
+isLHS (V2 x y)      (V2 x' y')   (V2 x'' y'') 
     | (x,y) == (x',y')  = False
     | otherwise = a1 * b2 - a2 * b1 > 0
-  where 
+  where
     a1 = x' - x
     a2 = y' - y
     b1 = x'' - x