Performance tweaks
This commit is contained in:
+55
-66
@@ -4,11 +4,11 @@ module Shader.Poke
|
||||
( pokeVerxs
|
||||
, pokeLayVerxs
|
||||
, pokeArrayOff
|
||||
, pokePoint3s
|
||||
, pokePoint33s
|
||||
, poke224s
|
||||
, pokeShape
|
||||
, pokeShapeVs
|
||||
, pokePoint3s
|
||||
) where
|
||||
import Shader.Data
|
||||
import Shader.Parameters
|
||||
@@ -21,6 +21,7 @@ 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 qualified Data.DList as DL
|
||||
|
||||
pokeVerxs
|
||||
:: MV.MVector (PrimState IO) FullShader
|
||||
@@ -42,37 +43,37 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=the
|
||||
|
||||
pokeShape :: Ptr Float -> Ptr Float -> Shape -> IO (Int,Int)
|
||||
pokeShape vptr eptr sh = do
|
||||
nVs <- pokeShapeVs vptr (_shVertices sh)
|
||||
nEs <- pokeShapeEs eptr (_shEdges sh)
|
||||
nVs <- pokeShapeVs vptr (VS.fromList $ shVList sh)
|
||||
nEs <- pokePoint3s eptr (VS.fromList $ shEList sh)
|
||||
return (nVs,nEs)
|
||||
|
||||
pokeShapeVs :: Ptr Float -> [ShapeV] -> IO Int
|
||||
pokeShapeVs ptr vals0 = go vals0 0
|
||||
where
|
||||
go [] n = return n
|
||||
go ( sh:vals) !n = 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
|
||||
pokeElemOff ptr (off 6) g
|
||||
go vals (n+1)
|
||||
where
|
||||
off i = n*7 + i
|
||||
V3 a b c = _svPos sh
|
||||
V4 d e f g = _svCol sh
|
||||
pokeShapeVs :: Ptr Float -> VS.Stream IO ShapeV -> IO Int
|
||||
pokeShapeVs ptr = VS.foldlM' (pokeShapeV ptr) 0
|
||||
|
||||
pokeShapeEs :: Ptr Float -> [Point3] -> IO Int
|
||||
pokeShapeEs ptr vals0 = go vals0 0
|
||||
pokeShapeV :: Ptr Float -> Int -> ShapeV -> IO Int
|
||||
pokeShapeV ptr n sh = 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
|
||||
pokeElemOff ptr (off 6) g
|
||||
return (n+1)
|
||||
where
|
||||
go [] n = return n
|
||||
go ((V3 a b c) :vals) !n = do
|
||||
pokeElemOff ptr (n * 3) a
|
||||
pokeElemOff ptr (n * 3 + 1) b
|
||||
pokeElemOff ptr (n * 3 + 2) c
|
||||
go vals (n+1)
|
||||
off i = n*7 + i
|
||||
V3 a b c = _svPos sh
|
||||
V4 d e f g = _svCol sh
|
||||
|
||||
pokePoint3s :: Ptr Float -> VS.Stream IO Point3 -> IO Int
|
||||
pokePoint3s ptr = VS.foldlM' (pokePoint3 ptr) 0
|
||||
|
||||
pokePoint3 :: Ptr Float -> Int -> Point3 -> IO Int
|
||||
pokePoint3 ptr n (V3 a b c) = do
|
||||
pokeElemOff ptr (n * 3) a
|
||||
pokeElemOff ptr (n * 3 + 1) b
|
||||
pokeElemOff ptr (n * 3 + 2) c
|
||||
return $ n + 1
|
||||
|
||||
pokeLayVerxs
|
||||
:: MV.MVector (PrimState IO) FullShader
|
||||
@@ -153,45 +154,33 @@ pokeArrayOff ptr i = pokeArray (plusPtr ptr (floatSize * i))
|
||||
-- pokeElemOff ptr (4*n+3) w
|
||||
|
||||
pokePoint33s :: Ptr Float -> [(Point3,Point3)] -> IO Int
|
||||
pokePoint33s ptr vals0 = go vals0 0
|
||||
where
|
||||
go [] n = return n
|
||||
go ( (V3 a b c,V3 d e f):vals) !n = 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
|
||||
go vals (n+1)
|
||||
where
|
||||
off i = n*6 + i
|
||||
pokePoint33s ptr = VS.foldlM' (pokePoint33 ptr) 0 . VS.fromList
|
||||
|
||||
pokePoint3s :: Ptr Float -> [Point3] -> IO Int
|
||||
pokePoint3s ptr vals0 = go vals0 0
|
||||
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
|
||||
go [] n = return n
|
||||
go ( V3 a b c:vals) !n = do
|
||||
pokeElemOff ptr (off 0) a
|
||||
pokeElemOff ptr (off 1) b
|
||||
pokeElemOff ptr (off 2) c
|
||||
go vals (n+1)
|
||||
where
|
||||
off i = n*3 + i
|
||||
off i = n*6 + i
|
||||
|
||||
pokePoint224 :: Ptr Float -> Int -> ((Point2,Point2),Point4) -> IO Int
|
||||
pokePoint224 ptr n ((V2 a b,V2 c d),V4 e f g h) = 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
|
||||
pokeElemOff ptr (off 6) g
|
||||
pokeElemOff ptr (off 7) h
|
||||
return (n + 1)
|
||||
where
|
||||
off i = n*8 + i
|
||||
|
||||
poke224s :: Ptr Float -> [((Point2,Point2),Point4)] -> IO Int
|
||||
poke224s ptr vals0 = go vals0 0
|
||||
where
|
||||
go [] n = return n
|
||||
go (((V2 a b,V2 c d),V4 e f g h):vals) !n = 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
|
||||
pokeElemOff ptr (off 6) g
|
||||
pokeElemOff ptr (off 7) h
|
||||
go vals (n+1)
|
||||
where
|
||||
off i = n*8 + i
|
||||
poke224s ptr = VS.foldlM' (pokePoint224 ptr) 0 . VS.fromList
|
||||
|
||||
Reference in New Issue
Block a user