justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Commit before attempting to stream worldSPic more effectively

Browse Source
This commit is contained in:
justin
2022-07-04 11:04:09 +01:00
parent 7fa391eb6c
commit 1e32b05406
9 changed files with 51 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Config/Data.hs
+1
View File
@@ -29,6 +29,7 @@ data Configuration = Configuration
deriving (Generic, Show)
data DebugBool
= Show_ms_frame
| Show_debug
| Show_sound
| Noclip
| Cr_status
src/Dodge/Default/World.hs
-1
View File
@@ -20,7 +20,6 @@ import qualified Data.Map as M
import qualified Data.Set as S
import Data.Graph.Inductive.Graph hiding ((&))
--import Data.Graph.Inductive.NodeMap
--import qualified Data.Vector.Fusion.Stream.Monadic as VS
defaultWorld :: World
defaultWorld = World
{ _keys = S.empty
src/Dodge/Render/ShapePicture.hs
+24 -16
View File
@@ -26,6 +26,7 @@ import Picture
import Sound.Data
import Geometry.ConvexPoly
import ShortShow
import Shape.Data
--import Dodge.Base.Collide
--import Data.Foldable
@@ -35,27 +36,31 @@ import qualified Data.Map.Strict as M
import Control.Lens
import Data.Maybe
import qualified Streaming.Prelude as S
import Streaming
import qualified Data.Graph.Inductive as FGL
import qualified Data.Set as Set
import Padding
import Data.Foldable
--import Data.Foldable
-- TODO only filter out shapes outside the range of the furthest shown light source
worldSPic :: Configuration -> World -> SPic
worldSPic cfig w = (mempty, extraPics cfig w)
<> foldMap' (dbArg _prDraw) (filtOn _prPos _props)
<> foldMap' (shiftDraw _blPos _blDir _blDraw) (filtOn _blPos _blocks)
<> foldMap' (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _shapes)
<> foldMap' (dbArg _cpPict) (filtOn _cpPos _corpses)
<> foldMap' (dbArg _crPict) (filtOn _crPos _creatures)
<> foldMap' floorItemSPic (filtOn _flItPos _floorItems)
<> foldMap' btSPic (filtOn _btPos _buttons)
<> foldMap' mcSPic (filtOn _mcPos _machines)
<> anyTargeting cfig w
worldSPic cfig w
= ((mempty, extraPics cfig w) )
<> (foldMap (dbArg _prDraw) (filtOn _prPos _props) )
<> (foldMap (shiftDraw _blPos _blDir _blDraw) (filtOn _blPos _blocks) )
<> (foldMap (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _shapes) )
<> (foldMap (dbArg _cpPict) (filtOn _cpPos _corpses) )
<> (foldMap (dbArg _crPict) (filtOn _crPos _creatures) )
<> (foldMap floorItemSPic (filtOn _flItPos _floorItems) )
<> (foldMap btSPic (filtOn _btPos _buttons) )
<> (foldMap mcSPic (filtOn _mcPos _machines) )
<> (anyTargeting cfig w )
where
filtOn f g = IM.filter (pointIsClose . f) (g w)
pointIsClose = cullPoint cfig w
type SPicStream = Stream (Of ShapeObj) (Stream (Of Verx) IO) ()
anyTargeting :: Configuration -> World -> SPic
anyTargeting cfig w = (mempty,pictures $ IM.elems $ IM.mapMaybe f $ _crInv cr)
where
@@ -82,20 +87,23 @@ extraPics cfig w = pictures (_decorations w)
<> concatMapPic clDraw (_clouds w )
<> concatMapPic ppDraw (_pressPlates w )
<> viewClipBounds cfig w
-- <> debugDraw cfig w
<> debugDraw cfig w
debugDraw :: Configuration -> World -> Picture
{-# INLINE debugDraw #-}
debugDraw cfig w =
pic
<>
setLayer FixedCoordLayer (listPicturesAt (0.5*halfWidth cfig) 0 cfig $ map text ts)
debugDraw cfig w
| Show_debug `Set.member` _debug_booleans cfig =
pic
<>
setLayer FixedCoordLayer (listPicturesAt (0.5*halfWidth cfig) 0 cfig $ map text ts)
| otherwise = mempty
where
(ts, pic) = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
debugDraw' :: Configuration -> World -> DebugBool -> ([String],Picture)
{-# INLINE debugDraw' #-}
debugDraw' cfig w bl = case bl of
Show_debug -> lstring "Show debug"
Noclip -> lstring "Noclip"
Remove_LOS -> lstring "No line of sight"
Cull_more_lights -> lstring "Cull more lights"
src/Picture/Data.hs
-1
View File
@@ -4,7 +4,6 @@ module Picture.Data
where
import Geometry.Data
--import qualified Data.Vector.Fusion.Stream.Monadic as VS
import Control.Lens
import Streaming
data Verx = Verx
src/Render.hs
+2 -2
View File
@@ -19,9 +19,9 @@ import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygo
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 Graphics.GL.Core43
import Control.Monad
import qualified Streaming.Prelude as S
divideSize :: Int -> Size -> Size
divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)
@@ -53,7 +53,7 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos = do
-- to consider: adding normals/a "material" for each fragment
blendFunc $= (Zero, OneMinusSrcColor)
stencilTest $= Enabled
flip VS.mapM_ (VS.fromList lightPoints) $ \(V3 x y z,rad,V3 r g b) -> do
flip S.mapM_ (S.each lightPoints) $ \(V3 x y z,rad,V3 r g b) -> do
depthFunc $= Just Less
-- setup stencil
colorMask $= Color4 Disabled Disabled Disabled Disabled
src/Shader/Bind.hs
+4 -2
View File
@@ -10,9 +10,9 @@ 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
import qualified Streaming.Prelude as S
bindArrayBuffers :: Int -> VBO -> IO ()
{-# INLINABLE bindArrayBuffers #-}
@@ -32,7 +32,9 @@ bindShaderLayers shads counts = MV.imapM_ f shads
let theVBO = _vaoVBO $ _shadVAO shad
stride = sum $ _vboAttribSizes theVBO
bindBuffer ArrayBuffer $= (Just . _vbo $ theVBO)
VS.mapM_ (g stride theVBO) $ VS.enumFromStepN 0 1 6 -- [0..5]
--VS.mapM_ (g stride theVBO) $ VS.enumFromStepN 0 1 6 -- [0..5]
S.mapM_ (g stride theVBO) $ S.each [0..5]
where
g stride theVBO lay = do
numVs <- UMV.unsafeRead counts $ lay * 6 + i
src/Shader/Poke.hs
+17 -18
View File
@@ -2,7 +2,7 @@ module Shader.Poke
( pokeVerxs
, pokeLayVerxs
, pokeArrayOff
, pokePoint33s
-- , pokePoint33s
, pokeShape
, pokeWallsWindowsFloor
) where
@@ -18,7 +18,6 @@ import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as UV
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 Data.Vector.Fusion.Util
import Control.Monad.Primitive
--import qualified Control.Monad.Parallel as MP
@@ -52,9 +51,9 @@ pokeWallsWindowsFloor
-> [ ( Point3 , Point3 ) ]
-> IO (Int,Int,Int)
pokeWallsWindowsFloor wlptr wiptr flptr wls wis fls = do
wlcounts1 <- VS.foldM' (pokeW wlptr) 0 (VS.fromList wls)
wlcounts2 <- VS.foldM' (pokeW wiptr) 0 (VS.fromList wis)
flcounts <- VS.foldM' (pokeF flptr) 0 (VS.fromList fls)
wlcounts1 <- S.foldM_ (pokeW wlptr) (return 0) return (S.each wls)
wlcounts2 <- S.foldM_ (pokeW wiptr) (return 0) return (S.each wis)
flcounts <- S.foldM_ (pokeF flptr) (return 0) return (S.each fls)
return (wlcounts1,wlcounts2,flcounts)
pokeF :: Ptr Float -> Int -> (Point3,Point3) -> IO Int
@@ -232,17 +231,17 @@ pokeArrayOff :: Ptr Float -> Int -> [Float] -> IO ()
{-# INLINE pokeArrayOff #-}
pokeArrayOff ptr i = pokeArray (plusPtr ptr (floatSize * i))
pokePoint33s :: Ptr Float -> [(Point3,Point3)] -> IO Int
pokePoint33s ptr = VS.foldlM' (pokePoint33 ptr) 0 . VS.fromList
--pokePoint33s :: Ptr Float -> [(Point3,Point3)] -> IO Int
--pokePoint33s ptr = S.foldM_ (pokePoint33 ptr) (return 0) return . S.each
pokePoint33 :: Ptr Float -> Int -> (Point3,Point3) -> IO Int
pokePoint33 ptr n (V3 a b c,V3 d e f) = do
pokeElemOff ptr (off 0) a
pokeElemOff ptr (off 1) b
pokeElemOff ptr (off 2) c
pokeElemOff ptr (off 3) d
pokeElemOff ptr (off 4) e
pokeElemOff ptr (off 5) f
return (n+1)
where
off i = n*6 + i
--pokePoint33 :: Ptr Float -> Int -> (Point3,Point3) -> IO Int
--pokePoint33 ptr n (V3 a b c,V3 d e f) = do
-- pokeElemOff ptr (off 0) a
-- pokeElemOff ptr (off 1) b
-- pokeElemOff ptr (off 2) c
-- pokeElemOff ptr (off 3) d
-- pokeElemOff ptr (off 4) e
-- pokeElemOff ptr (off 5) f
-- return (n+1)
-- where
-- off i = n*6 + i
src/Shape/Data.hs
-1
View File
@@ -7,7 +7,6 @@ module Shape.Data
where
import Geometry.Data
--import qualified Data.Vector.Fusion.Stream.Monadic as VS
--import Data.Vector.Fusion.Util
import Control.Lens
import Streaming
src/Sound.hs
+3 -3
View File
@@ -26,7 +26,7 @@ import qualified SDL.Mixer as Mix
import Data.Maybe
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
import qualified Data.Vector.Fusion.Stream.Monadic as VS
import qualified Streaming.Prelude as S
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
@@ -140,9 +140,9 @@ playIfFree c times = do
As for 'playSoundQueue', but with positional information in the form of an Int16. -}
playPositionalSoundQueue :: IM.IntMap Mix.Chunk -> [(Int,Int16)] -> IO ()
playPositionalSoundQueue chunkMap
= VS.mapM_ ( \(n,a) ->
= S.mapM_ ( \(n,a) ->
runMaybeT $ playIfFree (chunkMap IM.! n) Mix.Once >>= setChannelPos a )
. VS.fromList
. S.each
setChannelPos :: Int16 -> Mix.Channel -> MaybeT IO Mix.Channel
setChannelPos a i = do