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

Attempt to stream SPics, not sure if this improves speed

Browse Source
This commit is contained in:
justin
2022-07-04 20:34:47 +01:00
parent 1e32b05406
commit 6972256751
5 changed files with 64 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/ShapePicture.hs
+12 -15
View File
@@ -26,9 +26,9 @@ import Picture
import Sound.Data
import Geometry.ConvexPoly
import ShortShow
import Shape.Data
--import Dodge.Base.Collide
import StreamingHelp
--import Data.Foldable
import qualified Data.IntMap.Strict as IM -- Lazy?
import qualified Data.Map.Strict as M
@@ -36,31 +36,28 @@ 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
-- TODO only filter out shapes outside the range of the furthest shown light source
worldSPic :: Configuration -> World -> SPic
worldSPic :: Configuration -> World -> Stream (Of SPic) IO ()
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 )
= (S.yield (mempty, extraPics cfig w) )
<> (S.each $ fmap (dbArg _prDraw) (filtOn _prPos _props) )
<> (S.each $ fmap (shiftDraw _blPos _blDir _blDraw) (filtOn _blPos _blocks) )
<> (S.each $ fmap (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _shapes) )
<> (S.each $ fmap (dbArg _cpPict) (filtOn _cpPos _corpses) )
<> (S.each $ fmap (dbArg _crPict) (filtOn _crPos _creatures) )
<> (S.each $ fmap floorItemSPic (filtOn _flItPos _floorItems) )
<> (S.each $ fmap btSPic (filtOn _btPos _buttons) )
<> (S.each $ fmap mcSPic (filtOn _mcPos _machines) )
<> S.yield (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