diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 64dd26121..5317ef6c0 100644 --- a/src/Dodge/Base.hs +++ b/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 diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index edf1694aa..424782948 100644 --- a/src/Dodge/Base/Collide.hs +++ b/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 - = safeMinimumOnr (dist p1) +collidePointIndirect p1 p2 + = 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 diff --git a/src/Dodge/Base/Zone.hs b/src/Dodge/Base/Zone.hs index cc7d7f189..3b366f302 100644 --- a/src/Dodge/Base/Zone.hs +++ b/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 diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index a93022d4a..3b5dac694 100644 --- a/src/Dodge/Render.hs +++ b/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 diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 48a3c6e0a..93b009a24 100644 --- a/src/Dodge/Update/Camera.hs +++ b/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 - 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 + x = rotateV camRot $ V2 h maxViewDistance + cpih p = Ap $ Max . verSize <$> collidePointIndirect cpos p wos + verSize = abs . dotV rh . (-.- cpos) + rh = rotateV camRot (V2 0 1) wos = wallsOnScreen w camRot = _cameraRot w hw = halfWidth w diff --git a/src/FoldableHelp.hs b/src/FoldableHelp.hs index 9291de5a2..950f7b378 100644 --- a/src/FoldableHelp.hs +++ b/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 diff --git a/src/Render.hs b/src/Render.hs index 7a6a1cbc6..15282a4b0 100644 --- a/src/Render.hs +++ b/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 - forM_ 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 -- stencil out shadows colorMask $= Color4 Disabled Disabled Disabled Disabled clear [StencilBuffer] diff --git a/src/Shader/Bind.hs b/src/Shader/Bind.hs index 9bbe01cf8..acf430d49 100644 --- a/src/Shader/Bind.hs +++ b/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