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

Commit before strictifying points

Browse Source
This commit is contained in:
justin
2021-07-29 20:15:49 +02:00
parent 192e2c9c57
commit 67aa5c05c7
1 changed files with 8 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Shader/Poke.hs
+8 -2
View File
@@ -1,4 +1,5 @@
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# LANGUAGE BangPatterns #-}
module Shader.Poke module Shader.Poke
( pokeArrayOff ( pokeArrayOff
, pokeVX , pokeVX
@@ -54,10 +55,11 @@ pokeVerxs :: PicShads VBO -> [Verx] -> IO (PicShads Int)
pokeVerxs vbos vxs0 = go vxs0 (pure 0) pokeVerxs vbos vxs0 = go vxs0 (pure 0)
where where
go [] count = return count go [] count = return count
go (vx:vxs) count = pokeVerx vbos count vx >> go vxs (addCountVerx count vx) go (!vx:vxs) count = pokeVerx vbos count vx >> go vxs (addCountVerx count vx)
-- this is very brittle, but want to optimise speed if possible here -- this is very brittle, but want to optimise speed if possible here
pokeVerx :: PicShads VBO -> PicShads Int -> Verx -> IO () pokeVerx :: PicShads VBO -> PicShads Int -> Verx -> IO ()
{-# INLINE pokeVerx #-}
pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType} = case theType of 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 PolyV -> poke34 (plusPtr (_vboPtr $ _psPoly vbos) (_psPoly offsets * 7 * floatSize)) thePos theCol
PolyzV x -> poke34 thePtr thePos theCol PolyzV x -> poke34 thePtr thePos theCol
@@ -85,6 +87,7 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType} = case t
EllV -> poke34 (plusPtr (_vboPtr $ _psEll vbos) (_psEll offsets * 7 * floatSize)) thePos theCol EllV -> poke34 (plusPtr (_vboPtr $ _psEll vbos) (_psEll offsets * 7 * floatSize)) thePos theCol
poke34 :: Ptr Float -> Point3 -> Point4 -> IO () poke34 :: Ptr Float -> Point3 -> Point4 -> IO ()
{-# INLINE poke34 #-}
poke34 ptr (a,b,c) (d,e,f,g) = do poke34 ptr (a,b,c) (d,e,f,g) = do
pokeElemOff ptr 0 a pokeElemOff ptr 0 a
pokeElemOff ptr 1 b pokeElemOff ptr 1 b
@@ -95,6 +98,7 @@ poke34 ptr (a,b,c) (d,e,f,g) = do
pokeElemOff ptr 6 g pokeElemOff ptr 6 g
addCountVerx :: PicShads Int -> Verx -> PicShads Int addCountVerx :: PicShads Int -> Verx -> PicShads Int
{-# INLINE addCountVerx #-}
addCountVerx ps@PicShads addCountVerx ps@PicShads
{ _psPoly = sPoly { _psPoly = sPoly
, _psPolyz = sPolyz , _psPolyz = sPolyz
@@ -171,10 +175,11 @@ pokeLayVerxs :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int))
pokeLayVerxs vbos vxs0 = go vxs0 (IM.fromList $ (, pure 0) <$> [0..5]) pokeLayVerxs vbos vxs0 = go vxs0 (IM.fromList $ (, pure 0) <$> [0..5])
where where
go [] count = return count go [] count = return count
go (vx:vxs) count = pokeLayVerx vbos count vx >> go vxs (addLayCountVerx count vx) go (!vx:vxs) count = pokeLayVerx vbos count vx >> go vxs (addLayCountVerx count vx)
-- this is very brittle, but want to optimise speed if possible here -- this is very brittle, but want to optimise speed if possible here
pokeLayVerx :: PicShads VBO -> IM.IntMap (PicShads Int) -> Verx -> IO () pokeLayVerx :: PicShads VBO -> IM.IntMap (PicShads Int) -> Verx -> IO ()
{-# INLINE pokeLayVerx #-}
pokeLayVerx vbos imoffsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType, _vxLayer = theLay} = case theType of 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 PolyV -> poke34 (plusPtr (_vboPtr $ _psPoly vbos) ((_psPoly offsets + layOff) * 7 * floatSize)) thePos theCol
PolyzV x -> poke34 thePtr thePos theCol PolyzV x -> poke34 thePtr thePos theCol
@@ -205,6 +210,7 @@ pokeLayVerx vbos imoffsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType, _vx
offsets = imoffsets IM.! theLay offsets = imoffsets IM.! theLay
addLayCountVerx :: IM.IntMap (PicShads Int) -> Verx -> IM.IntMap (PicShads Int) addLayCountVerx :: IM.IntMap (PicShads Int) -> Verx -> IM.IntMap (PicShads Int)
{-# INLINE addLayCountVerx #-}
addLayCountVerx m vx = IM.adjust f (_vxLayer vx) m addLayCountVerx m vx = IM.adjust f (_vxLayer vx) m
where where
f = flip addCountVerx vx f = flip addCountVerx vx