Various tweaks

src/Dodge/Base.hs

@@ -67,21 +67,6 @@ wallsOnCirc p r = IM.filter f
   where 
     f wl = uncurry circOnSeg (_wlLine wl) p r
 
-wallsOnScreen :: World -> IM.IntMap Wall
-wallsOnScreen w -- = wallsNearZones (zoneOfScreen w) w
-    = foldl' (flip $ IM.union . \i -> innerFold (f i (_wallsZone w))) IM.empty xs
-  where 
-    innerFold m = foldl' (flip $ IM.union . \ j -> f j m) IM.empty ys
-
-    f i m = case IM.lookup i m of 
-        Just val -> val
-        _        -> IM.empty
-    (x,y) = zoneOfPoint $ _cameraCenter w
-    n = ceiling (wh / (_cameraZoom w * zoneSize))
-    wh = max (getWindowX w) (getWindowY w)
-    xs = [x - n .. x + n]
-    ys = [y - n .. y + n]
-
 allWalls :: World -> IM.IntMap Wall
 allWalls w = IM.unions $ concatMap IM.elems $ IM.elems $ _wallsZone w
 

src/Dodge/Base/Collide.hs

@@ -73,10 +73,10 @@ furthestPointWalkable p1 p2 ws
 
 collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
 {-# INLINE collidePointIndirect #-}
-collidePointIndirect p1 p2 ws 
+collidePointIndirect p1 p2
-    = safeMinimumOnr (dist p1) 
+    = safeMinimumOn (dist p1) 
     . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) 
-    $ IM.filter (not . _wlIsSeeThrough) ws
+    . IM.filter (not . _wlIsSeeThrough)
 {- | Checks to see whether someone can fire bullets effectively between two points. 
  - Not sure if this needs vision as well, need to make this uniform. -}
 collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2

src/Dodge/Base/Zone.hs

@@ -148,6 +148,22 @@ wallsDoubleScreen w -- = IM.unions [f b $ f a $ _wallsZone w | (a,b) <- is]
     xs = [x - n .. x + n]
     ys = [y - n .. y + n]
 
+wallsOnScreen :: World -> IM.IntMap Wall
+wallsOnScreen w -- = wallsNearZones (zoneOfScreen w) w
+    = foldl' (flip $ IM.union . \i -> innerFold (f i (_wallsZone w))) IM.empty xs
+  where 
+    innerFold m = foldl' (flip $ IM.union . \ j -> f j m) IM.empty ys
+
+    f i m = case IM.lookup i m of 
+        Just val -> val
+        _        -> IM.empty
+    (x,y) = zoneOfPoint $ _cameraCenter w
+    n = ceiling (wh / (_cameraZoom w * zoneSize))
+    wh = max (getWindowX w) (getWindowY w)
+    xs = [x - n .. x + n]
+    ys = [y - n .. y + n]
+
+
 wallsNearZones :: [(Int,Int)] -> World -> IM.IntMap Wall
 wallsNearZones is w -- = IM.unions [f b $ f a $ _wallsZone w | (a,b) <- is]
     = foldl' (flip $ IM.union . \(a,b) -> f b (f a (_wallsZone w))) IM.empty is

src/Dodge/Render.hs

@@ -109,7 +109,7 @@ doDrawing pdata w = do
 
     bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
     viewport $= (Position 0 0
-        ,divideSize (w ^. config . shadow_resolution) $ Size (round $ fstV2 wins) (round $ sndV2 wins))
+        , divideSize (w ^. config . shadow_resolution) $ Size (round $ fstV2 wins) (round $ sndV2 wins))
     createLightMap pdata lightPoints nWalls nSils nsurfVs 
     viewport $= (Position 0 0, Size (round $ fstV2 wins) (round $ sndV2 wins))
     colorMask $= Color4 Enabled Enabled Enabled Enabled

src/Dodge/Update/Camera.hs

@@ -8,6 +8,7 @@ module Dodge.Update.Camera
     where
 import Dodge.Data
 import Dodge.Base
+import Dodge.Base.Zone
 import Dodge.Base.Window
 import Dodge.Base.Collide
 import Dodge.Config.KeyConfig
@@ -166,18 +167,16 @@ farWallDist cpos w = getMin . uncurry (<>) $ bimap (toScale hw) (toScale hh) $ s
     distsMaybeTo x = (valueAtWidth x,valueAtHeight x)
     valueAtHeight h  = cpiv (cpos +.+ x) <> cpiv (cpos -.- x)
       where
-        x = viewDistAtHeight h
+        x = rotateV camRot $ V2 maxViewDistance h
+        cpiv p = Ap $ Max . horSize <$> collidePointIndirect cpos p wos
+        horSize = abs . dotV rv . (-.- cpos)
+        rv = rotateV camRot (V2 1 0)
     valueAtWidth h  = cpih (cpos +.+ x) <> cpih (cpos -.- x)
       where
-        x = viewDistAtWidth h
+        x = rotateV camRot $ V2 h maxViewDistance
-    cpiv p = Ap $ Max . horSize <$> collidePointIndirect cpos p wos
         cpih p = Ap $ Max . verSize <$> collidePointIndirect cpos p wos
-    horSize = abs . dotV rv . (-.- cpos)
         verSize = abs . dotV rh . (-.- cpos)
-    rv = rotateV camRot (V2 1 0)
         rh = rotateV camRot (V2 0 1)
-    viewDistAtHeight  = rotateV camRot . V2 maxViewDistance
-    viewDistAtWidth x = rotateV camRot $ V2 x maxViewDistance
     wos = wallsOnScreen w
     camRot = _cameraRot w
     hw = halfWidth w

src/FoldableHelp.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE TupleSections #-}
 module FoldableHelp
     ( safeMinimumOn
-    , safeMinimumOnr
     , safeMinimumOnMaybe
     , module Data.Foldable
     )
@@ -22,14 +21,6 @@ safeMinimumOn f = foldl' g Nothing
         | f x < f y = Just x
         | otherwise = Just y
     g Nothing y = Just y
-safeMinimumOnr :: (Foldable t,Ord b) => (a -> b) -> t a -> Maybe a
-{-# INLINE safeMinimumOnr #-}
-safeMinimumOnr f = foldr g Nothing
-  where
-    g y (Just x)
-        | f x < f y = Just x
-        | otherwise = Just y
-    g y Nothing = Just y
 safeMinimumOnMaybe :: (Ord b) => (a -> Maybe b) -> [a] -> Maybe a
 safeMinimumOnMaybe f ys = fst <$> go Nothing ys
   where

src/Render.hs

@@ -7,14 +7,14 @@ import Data.Preload.Render
 import Picture.Data
 import Geometry.Data
 
-import Data.Foldable
+--import Data.Foldable
 import Foreign hiding (rotate)
 import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T)
 import qualified SDL
 import qualified Data.Vector.Unboxed.Mutable as UMV
 import qualified Data.Vector.Mutable as MV
 import Control.Monad.Primitive
---import qualified Data.Vector.Fusion.Stream.Monadic as VS
+import qualified Data.Vector.Fusion.Stream.Monadic as VS
 
 divideSize :: Int -> Size -> Size
 divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)
@@ -50,8 +50,8 @@ createLightMap pdata lightPoints nWalls nSils nsurfVs = do
     blendFunc $= (Zero, OneMinusSrcAlpha)
     stencilTest $= Enabled
     depthFunc $= Just Lequal
-    --flip VS.mapM_ (VS.fromList lightPoints) $ \(V3 x y z,r,lum) -> do
+    flip VS.mapM_ (VS.fromList lightPoints) $ \(V3 x y z,r,lum) -> do
-    forM_ lightPoints $ \(V3 x y z,r,lum) -> do
+    --forM_ lightPoints $ \(V3 x y z,r,lum) -> do
         -- stencil out shadows
         colorMask $= Color4 Disabled Disabled Disabled Disabled
         clear [StencilBuffer]

src/Shader/Bind.hs

@@ -11,6 +11,7 @@ import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygo
 import Foreign hiding (rotate)
 import qualified Data.Vector.Unboxed.Mutable as UMV
 import qualified Data.Vector.Mutable as MV
+import qualified Data.Vector.Fusion.Stream.Monadic as VS
 import Control.Monad.Primitive
 import Control.Monad
 
@@ -31,7 +32,7 @@ bindShaderLayers shads counts = MV.imapM_ f shads
         let theVBO = _vaoVBO $ _shaderVAO shad
             stride = sum $ _vboAttribSizes theVBO
         bindBuffer ArrayBuffer $= (Just . _vbo $ theVBO)
-        mapM_ (g stride theVBO) [0..5]
+        VS.mapM_ (g stride theVBO) $ VS.enumFromStepN 0 1 6 -- [0..5]
       where
         g stride theVBO lay = do
             numVs <- UMV.unsafeRead counts $ lay * 6 + i