Store number of vertices in an intmap
This commit is contained in:
@@ -71,7 +71,6 @@ sequenceLayers_ f lays = sequence_ $ f <$> layIndices <*> lays
|
||||
sequenceLayers :: (Int -> a -> IO b) -> Layers a -> IO (Layers b)
|
||||
sequenceLayers f lays = sequence $ f <$> layIndices <*> lays
|
||||
|
||||
|
||||
data Layers a = Layers
|
||||
{ _lay0 :: a
|
||||
, _lay1 :: a
|
||||
|
||||
+10
-14
@@ -12,16 +12,17 @@ import Picture.Data
|
||||
import Geometry.Data
|
||||
--import Polyhedra.Data
|
||||
--import Polyhedra
|
||||
import Layers
|
||||
--import Layers
|
||||
|
||||
import Data.Foldable
|
||||
--import Control.Lens
|
||||
import Control.Monad
|
||||
--import Control.Monad
|
||||
--import qualified Control.Foldl as F
|
||||
import Foreign hiding (rotate)
|
||||
import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T)
|
||||
--import Data.Foldable
|
||||
--import Data.Tuple.Extra
|
||||
--import qualified Data.IntMap.Strict as IM
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import qualified SDL
|
||||
|
||||
divideSize :: Int -> Size -> Size
|
||||
@@ -156,20 +157,14 @@ pokeBindFoldable pdata m = do
|
||||
zeroCounts :: PicShads Int
|
||||
zeroCounts = PicShads 0 0 0 0 0 0
|
||||
|
||||
pokeVerxLayers
|
||||
:: PicShads VBO
|
||||
-> [Verx]
|
||||
-> Layers (PicShads Int)
|
||||
-> IO (Layers (PicShads Int))
|
||||
pokeVerxLayers = undefined
|
||||
|
||||
pokeBindFoldableLayer
|
||||
:: RenderData
|
||||
-> Picture
|
||||
-> IO (Layers (PicShads Int))
|
||||
-> IO (IM.IntMap (PicShads Int))
|
||||
pokeBindFoldableLayer pdata m = do
|
||||
let shads = _pictureShaders pdata
|
||||
|
||||
--slist'' <- fmap toIMLayers $ pokeLayVerxsFold (fmap (_vaoVBO . _vshaderVAO) shads) m
|
||||
slist'' <- pokeLayVerxsFold (fmap (_vaoVBO . _vshaderVAO) shads) m
|
||||
bindShaderLay shads slist''
|
||||
|
||||
@@ -185,14 +180,15 @@ renderFoldable pdata struct = do
|
||||
count <- pokeBindFoldable pdata struct
|
||||
let shads = _pictureShaders pdata
|
||||
|
||||
mapM_ (uncurry (drawShaderLay 0)) ((,) <$> shads <*> count)
|
||||
sequence_ (drawShaderLay 0 <$> shads <*> count)
|
||||
|
||||
pokeEndTicks <- SDL.ticks
|
||||
return $ pokeEndTicks - pokeStartTicks
|
||||
------------------------------end renderFoldable
|
||||
|
||||
renderLayer :: Int -> PicShads VShader -> Layers (PicShads Int) -> IO ()
|
||||
renderLayer i shads counts = sequence_ $ drawShaderLay i <$> shads <*> getLay i counts
|
||||
renderLayer :: Int -> PicShads VShader -> IM.IntMap (PicShads Int) -> IO ()
|
||||
renderLayer i shads counts = sequence_ $ drawShaderLay i <$> shads <*> counts IM.! i
|
||||
where
|
||||
|
||||
pokeTwoOff
|
||||
:: Ptr Float
|
||||
|
||||
+4
-4
@@ -13,14 +13,14 @@ module Shader
|
||||
import Shader.Data
|
||||
import Shader.Parameters
|
||||
import Shader.ExtraPrimitive
|
||||
import Layers
|
||||
--import Layers
|
||||
--import MatrixHelper
|
||||
|
||||
import Foreign
|
||||
import Control.Monad
|
||||
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
|
||||
import Graphics.GL.Core43
|
||||
--import qualified Data.IntMap.Strict as IM
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
--import Data.Bifunctor
|
||||
--import Text.RawString.QQ
|
||||
--import Linear.Matrix
|
||||
@@ -60,8 +60,8 @@ bindArrayBuffersLayer numVs lay theVBO = do
|
||||
where
|
||||
stride = sum $ _vboAttribSizes theVBO
|
||||
|
||||
bindShaderLay :: PicShads VShader -> Layers (PicShads Int) -> IO ()
|
||||
bindShaderLay shads = sequenceLayers_ f
|
||||
bindShaderLay :: PicShads VShader -> IM.IntMap (PicShads Int) -> IO ()
|
||||
bindShaderLay shads = mapM_ (uncurry f) . IM.toList
|
||||
where
|
||||
f lay counts = sequence_ $ bindArrayBuffersLayer' lay <$> counts <*> (_vaoVBO . _vshaderVAO <$> shads)
|
||||
|
||||
|
||||
+34
-106
@@ -13,7 +13,7 @@ import Shader.Data
|
||||
import Shader.Parameters
|
||||
import Picture.Data
|
||||
import Geometry.Data
|
||||
import Layers
|
||||
--import Layers
|
||||
|
||||
--import qualified Streaming.Prelude as SP
|
||||
--import Data.Maybe
|
||||
@@ -21,8 +21,8 @@ import Layers
|
||||
import Foreign
|
||||
--import Control.Monad
|
||||
import qualified Control.Foldl as F
|
||||
--import qualified Data.IntMap.Strict as IM
|
||||
--import Control.Lens
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Control.Lens
|
||||
|
||||
pokeVerxs :: PicShads VBO -> [Verx] -> IO (PicShads Int)
|
||||
pokeVerxs vbos = F.foldM $ F.FoldM
|
||||
@@ -36,7 +36,7 @@ pokeVerxs vbos = F.foldM $ F.FoldM
|
||||
|
||||
-- this is very brittle, but want to optimise speed if possible here
|
||||
pokeVerx :: PicShads VBO -> PicShads Int -> Verx -> IO ()
|
||||
--{-# INLINE pokeVerx #-}
|
||||
{-# INLINE pokeVerx #-}
|
||||
pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType} = case theType of
|
||||
PolyV -> poke34 (plusPtr (_vboPtr $ _psPoly vbos) (_psPoly offsets * 7 * floatSize)) thePos theCol
|
||||
PolyzV x -> poke34 thePtr thePos theCol
|
||||
@@ -63,8 +63,6 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType} = case t
|
||||
thePtr = plusPtr (_vboPtr $ _psArc vbos) (_psArc offsets * 10 * floatSize)
|
||||
EllV -> poke34 (plusPtr (_vboPtr $ _psEll vbos) (_psEll offsets * 7 * floatSize)) thePos theCol
|
||||
|
||||
|
||||
|
||||
poke34 :: Ptr Float -> Point3 -> Point4 -> IO ()
|
||||
{-# INLINE poke34 #-}
|
||||
poke34 ptr (V3 a b c) (V4 d e f g) = do
|
||||
@@ -76,23 +74,6 @@ poke34 ptr (V3 a b c) (V4 d e f g) = do
|
||||
pokeElemOff ptr 5 f
|
||||
pokeElemOff ptr 6 g
|
||||
|
||||
addCountVerx' :: VertexType -> PicShads Int -> PicShads Int
|
||||
{-# INLINE addCountVerx' #-}
|
||||
addCountVerx' theType !ps@PicShads
|
||||
{ _psPoly = sPoly
|
||||
, _psPolyz = sPolyz
|
||||
, _psBez = sBez
|
||||
, _psText = sText
|
||||
, _psArc = sArc
|
||||
, _psEll = sEll
|
||||
} = case theType of
|
||||
PolyV -> ps {_psPoly = sPoly + 1}
|
||||
PolyzV _ -> ps {_psPolyz = sPolyz + 1}
|
||||
BezV _ -> ps {_psBez = sBez + 1}
|
||||
TextV _ -> ps {_psText = sText + 1}
|
||||
ArcV _ -> ps {_psArc = sArc + 1}
|
||||
EllV -> ps {_psEll = sEll + 1}
|
||||
|
||||
addCountVerx :: PicShads Int -> Verx -> PicShads Int
|
||||
{-# INLINE addCountVerx #-}
|
||||
addCountVerx !ps@PicShads
|
||||
@@ -142,15 +123,15 @@ pokePoint3s ptr vals0 = go vals0 0
|
||||
where
|
||||
off i = n*3 + i
|
||||
|
||||
comLayVerx :: PicShads VBO -> Layers (PicShads Int) -> Verx -> IO (Layers (PicShads Int))
|
||||
{-# INLINE comLayVerx #-}
|
||||
comLayVerx :: PicShads VBO -> IM.IntMap (PicShads Int) -> Verx -> IO (IM.IntMap (PicShads Int))
|
||||
--{-# INLINE comLayVerx #-}
|
||||
comLayVerx vbos counts vx = do
|
||||
poke34 thePtr thePos theCol
|
||||
pokeVerxType thePtr theType
|
||||
return $ addLayCountVerx' counts theLayer theType
|
||||
return $ addLayCountVerx counts theLayer theType
|
||||
where
|
||||
theLayer = _vxLayer vx
|
||||
layCounts = getLay theLayer counts
|
||||
layCounts = counts IM.! theLayer
|
||||
theType = _vxType vx
|
||||
thePos = _vxPos vx
|
||||
theCol = _vxCol vx
|
||||
@@ -160,6 +141,7 @@ comLayVerx vbos counts vx = do
|
||||
theStride = pokeStride theType
|
||||
|
||||
pokeVerxType :: Ptr Float -> VertexType -> IO ()
|
||||
{-# INLINE pokeVerxType #-}
|
||||
pokeVerxType thePtr vt = case vt of
|
||||
PolyzV x -> pokeElemOff thePtr 7 x
|
||||
BezV (V4 x y z w) -> pokeElemOff thePtr 7 x >> pokeElemOff thePtr 8 y
|
||||
@@ -168,9 +150,9 @@ pokeVerxType thePtr vt = case vt of
|
||||
ArcV (V3 x y z) -> pokeElemOff thePtr 7 x >> pokeElemOff thePtr 8 y
|
||||
>> pokeElemOff thePtr 9 z
|
||||
_ -> return ()
|
||||
|
||||
|
||||
intFromType :: PicShads Int -> VertexType -> Int
|
||||
{-# INLINE intFromType #-}
|
||||
intFromType ps vt = case vt of
|
||||
PolyV -> _psPoly ps
|
||||
PolyzV{} -> _psPolyz ps
|
||||
@@ -180,6 +162,7 @@ intFromType ps vt = case vt of
|
||||
EllV -> _psEll ps
|
||||
|
||||
vboFromType :: PicShads VBO -> VertexType -> VBO
|
||||
{-# INLINE vboFromType #-}
|
||||
vboFromType ps vt = case vt of
|
||||
PolyV -> _psPoly ps
|
||||
PolyzV{} -> _psPolyz ps
|
||||
@@ -188,14 +171,20 @@ vboFromType ps vt = case vt of
|
||||
ArcV{} -> _psArc ps
|
||||
EllV -> _psEll ps
|
||||
|
||||
pokeLayVerxsFold :: PicShads VBO -> [Verx] -> IO (Layers (PicShads Int))
|
||||
pokeLayVerxsFold :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int))
|
||||
pokeLayVerxsFold vbos = F.foldM $ F.FoldM
|
||||
--(\counts vx -> pokeLayVerx vbos counts vx >> return (addLayCountVerx counts vx))
|
||||
(comLayVerx vbos)
|
||||
(pure . pure $ pure 0)
|
||||
(return $ imLayers 0)
|
||||
return
|
||||
|
||||
imLayers :: a -> IM.IntMap (PicShads a)
|
||||
{-# INLINE imLayers #-}
|
||||
imLayers x = IM.fromList $ zip [0..5] $ repeat ps
|
||||
where
|
||||
ps = pure x
|
||||
|
||||
pokeStride :: VertexType -> Int
|
||||
{-# INLINE pokeStride #-}
|
||||
pokeStride PolyV = 7
|
||||
pokeStride PolyzV{} = 8
|
||||
pokeStride BezV{} = 11
|
||||
@@ -203,81 +192,21 @@ pokeStride TextV{} = 9
|
||||
pokeStride ArcV{} = 10
|
||||
pokeStride EllV = 7
|
||||
|
||||
-- this is very brittle, but want to optimise speed if possible here
|
||||
pokeLayVerx :: PicShads VBO -> Layers (PicShads Int) -> Verx -> IO ()
|
||||
{-# INLINE pokeLayVerx #-}
|
||||
pokeLayVerx vbos imoffsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType, _vxLayer = theLay} = case theType of
|
||||
PolyV -> poke34 (plusPtr (_vboPtr $ _psPoly vbos) ((_psPoly offsets + layOff) * 7 * floatSize)) thePos theCol
|
||||
PolyzV x -> poke34 thePtr thePos theCol
|
||||
>> pokeElemOff thePtr 7 x
|
||||
where
|
||||
thePtr = plusPtr (_vboPtr $ _psPolyz vbos) ((_psPolyz offsets + layOff) * 8 * floatSize)
|
||||
BezV (V4 x y z w) -> poke34 thePtr thePos theCol
|
||||
>> pokeElemOff thePtr 7 x
|
||||
>> pokeElemOff thePtr 8 y
|
||||
>> pokeElemOff thePtr 9 z
|
||||
>> pokeElemOff thePtr 10 w
|
||||
where
|
||||
thePtr = plusPtr (_vboPtr $ _psBez vbos) ((_psBez offsets + layOff) * 11 * floatSize)
|
||||
TextV (V2 x y) -> poke34 thePtr thePos theCol
|
||||
>> pokeElemOff thePtr 7 x
|
||||
>> pokeElemOff thePtr 8 y
|
||||
where
|
||||
thePtr = plusPtr (_vboPtr $ _psText vbos) ((_psText offsets + layOff) * 9 * floatSize)
|
||||
ArcV (V3 x y z) -> poke34 thePtr thePos theCol
|
||||
>> pokeElemOff thePtr 7 x
|
||||
>> pokeElemOff thePtr 8 y
|
||||
>> pokeElemOff thePtr 9 z
|
||||
where
|
||||
thePtr = plusPtr (_vboPtr $ _psArc vbos) ((_psArc offsets + layOff) * 10 * floatSize)
|
||||
EllV -> poke34 (plusPtr (_vboPtr $ _psEll vbos) ((_psEll offsets + layOff) * 7 * floatSize)) thePos theCol
|
||||
where
|
||||
layOff = theLay * numSubElements
|
||||
offsets = getLay theLay imoffsets
|
||||
|
||||
addLayCountVerx :: Layers (PicShads Int) -> Verx -> Layers (PicShads Int)
|
||||
addLayCountVerx :: IM.IntMap (PicShads Int) -> Int -> VertexType -> IM.IntMap (PicShads Int)
|
||||
{-# INLINE addLayCountVerx #-}
|
||||
addLayCountVerx !m@Layers
|
||||
{ _lay0 = a0
|
||||
, _lay1 = a1
|
||||
, _lay2 = a2
|
||||
, _lay3 = a3
|
||||
, _lay4 = a4
|
||||
, _lay5 = a5
|
||||
}
|
||||
vx = case _vxLayer vx of
|
||||
0 -> m { _lay0 = f $! a0 }
|
||||
1 -> m { _lay1 = f $! a1 }
|
||||
2 -> m { _lay2 = f $! a2 }
|
||||
3 -> m { _lay3 = f $! a3 }
|
||||
4 -> m { _lay4 = f $! a4 }
|
||||
5 -> m { _lay5 = f $! a5 }
|
||||
_ -> undefined
|
||||
where
|
||||
f = flip addCountVerx vx
|
||||
|
||||
|
||||
|
||||
addLayCountVerx' :: Layers (PicShads Int) -> Int -> VertexType -> Layers (PicShads Int)
|
||||
{-# INLINE addLayCountVerx' #-}
|
||||
addLayCountVerx' m@Layers
|
||||
{ _lay0 = a0
|
||||
, _lay1 = a1
|
||||
, _lay2 = a2
|
||||
, _lay3 = a3
|
||||
, _lay4 = a4
|
||||
, _lay5 = a5
|
||||
}
|
||||
lay vt = case lay of
|
||||
0 -> m { _lay0 = f a0 }
|
||||
1 -> m { _lay1 = f a1 }
|
||||
2 -> m { _lay2 = f a2 }
|
||||
3 -> m { _lay3 = f a3 }
|
||||
4 -> m { _lay4 = f a4 }
|
||||
5 -> m { _lay5 = f a5 }
|
||||
_ -> undefined
|
||||
where
|
||||
f = addCountVerx' vt
|
||||
addLayCountVerx m lay vt = case vt of
|
||||
PolyV -> m & ix lay . psPoly +~ 1
|
||||
PolyzV _ -> m & ix lay . psPolyz +~ 1
|
||||
BezV _ -> m & ix lay . psBez +~ 1
|
||||
TextV _ -> m & ix lay . psText +~ 1
|
||||
ArcV _ -> m & ix lay . psArc +~ 1
|
||||
EllV -> m & ix lay . psEll +~ 1
|
||||
--PolyV -> IM.adjust (psPoly +~ 1) lay m
|
||||
--PolyzV _ -> IM.adjust (psPolyz +~ 1) lay m
|
||||
--BezV _ -> IM.adjust (psBez +~ 1) lay m
|
||||
--TextV _ -> IM.adjust (psText +~ 1) lay m
|
||||
--ArcV _ -> IM.adjust (psArc +~ 1) lay m
|
||||
--EllV -> IM.adjust (psEll +~ 1) lay m
|
||||
|
||||
poke224s :: Ptr Float -> [((Point2,Point2),Point4)] -> IO Int
|
||||
poke224s ptr vals0 = go vals0 0
|
||||
@@ -295,4 +224,3 @@ poke224s ptr vals0 = go vals0 0
|
||||
go vals (n+1)
|
||||
where
|
||||
off i = n*8 + i
|
||||
|
||||
|
||||
Reference in New Issue
Block a user