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

Working element buffer object

Browse Source
This commit is contained in:
justin
2021-09-20 12:36:35 +01:00
parent c605ac74ff
commit 5cbcbec101
22 changed files with 242 additions and 212 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Shader/Poke.hs
+22 -11
View File
@@ -7,7 +7,6 @@ module Shader.Poke
, pokePoint33s
, poke224s
, pokeShape
, pokeShapeVs
, pokePoint3s
) where
import Shader.Data
@@ -16,11 +15,13 @@ import Picture.Data
import Shape.Data
import Geometry.Data
import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
import Foreign
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 Data.Bifoldable
--import qualified Data.DList as DL
pokeVerxs
@@ -41,17 +42,25 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=the
where
sn = _unShadNum theShadNum
pokeShape :: Ptr Float -> Ptr Float -> Shape -> IO (Int,Int)
pokeShape vptr eptr sh = do
nVs <- pokeShapeVs vptr (VS.fromList $ shVList sh)
nEs <- pokePoint3s eptr (VS.fromList $ shEList sh)
return (nVs,nEs)
pokeShape :: Ptr Float -> Ptr Float -> Ptr GLushort -> Shape -> IO (Int,Int)
pokeShape vptr eptr iptr = bifoldlM (pokeShapeVs' vptr iptr) (pokeShapeEs' eptr) (0,0)
pokeShapeVs :: Ptr Float -> VS.Stream IO ShapeV -> IO Int
pokeShapeVs ptr = VS.foldlM' (pokeShapeV ptr) 0
pokeShapeVs' :: Ptr Float -> Ptr GLushort -> (Int,Int) -> [ShapeV] -> IO (Int, Int)
pokeShapeVs' ptr iptr count = VS.foldlM' (pokeShapeV' ptr iptr) count . VS.fromList
pokeShapeV :: Ptr Float -> Int -> ShapeV -> IO Int
pokeShapeV ptr n sh = do
pokeShapeEs' :: Ptr Float -> (Int,Int) -> [Point3] -> IO (Int, Int)
pokeShapeEs' ptr count = VS.foldlM' (pokeShapeE' ptr) count . VS.fromList
pokeShapeE' :: Ptr Float -> (Int,Int) -> Point3 -> IO (Int,Int)
pokeShapeE' ptr (nv,n) (V3 a b c) = do
pokeElemOff ptr (n * 3) a
pokeElemOff ptr (n * 3 + 1) b
pokeElemOff ptr (n * 3 + 2) c
return $ (nv,n + 1)
pokeShapeV' :: Ptr Float -> Ptr GLushort -> (Int,Int) -> ShapeV -> IO (Int,Int)
pokeShapeV' ptr iptr (n,ne) sh = do
pokeElemOff ptr (off 0) a
pokeElemOff ptr (off 1) b
pokeElemOff ptr (off 2) c
@@ -59,12 +68,14 @@ pokeShapeV ptr n sh = do
pokeElemOff ptr (off 4) e
pokeElemOff ptr (off 5) f
pokeElemOff ptr (off 6) g
return (n+1)
pokeElemOff iptr n (fromIntegral n)
return (n+1,ne)
where
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