From 51b8fab21498708f8ff675ac3abdb3f1ebe201a5 Mon Sep 17 00:00:00 2001 From: jgk Date: Tue, 10 Aug 2021 02:29:17 +0200 Subject: [PATCH] Refactor vertex poking --- src/Picture.hs | 16 +++---- src/Picture/Data.hs | 2 +- src/Polyhedra.hs | 2 +- src/Shader/Poke.hs | 103 ++++++++++++++++++++------------------------ 4 files changed, 57 insertions(+), 66 deletions(-) diff --git a/src/Picture.hs b/src/Picture.hs index 6856ab58e..a7871dca9 100644 --- a/src/Picture.hs +++ b/src/Picture.hs @@ -73,19 +73,19 @@ polygon :: [Point2] -> Picture {-# INLINE polygon #-} polygon ps = map (f . zeroZ) $ polyToTris ps where - f pos = Verx pos black PolyV 0 polyNum + f pos = Verx pos black [] 0 polyNum polygonZ :: [Point2] -> Float -> Picture {-# INLINE polygonZ #-} polygonZ ps z = map (f . zeroZ) $ polyToTris ps where - f pos = Verx pos black (PolyzV z) 0 polyzNum + f pos = Verx pos black [z] 0 polyzNum polygonCol :: [(Point2,RGBA)] -> Picture {-# INLINE polygonCol #-} polygonCol vs = polyToTris $ map f vs where - f (V2 x y,col) = Verx (V3 x y 0) col PolyV 0 polyNum + f (V2 x y,col) = Verx (V3 x y 0) col [] 0 polyNum poly3 :: [Point3] -> Picture {-# INLINE poly3 #-} @@ -95,7 +95,7 @@ poly3Col :: [(Point3,RGBA)] -> Picture {-# INLINE poly3Col #-} poly3Col vs = map f $ polyToTris vs where - f (pos,col) = Verx pos col PolyV 0 polyNum + f (pos,col) = Verx pos col [] 0 polyNum -- note that much of work computing the width of the bezier curve is done here bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture @@ -134,7 +134,7 @@ bezierQuad cola colc ra rc a b c bzhelp :: [(Point2, Point4, Point2, Point2)] -> Picture bzhelp = map f where - f (V2 x y,col,V2 a b,V2 c d) = Verx (V3 x y 0) col (BezV (V4 a b c d)) 0 bezNum + f (V2 x y,col,V2 a b,V2 c d) = Verx (V3 x y 0) col [a,b,c,d] 0 bezNum -- given a one and two zeros of a linear function over x and y, -- determine the function @@ -215,7 +215,7 @@ circleSolidCol colC colE r = map f ,( (V3 ( r) (-r) (0)), black) ] where - f (pos,col) = Verx pos col EllV 0 ellNum + f (pos,col) = Verx pos col [] 0 ellNum circle :: Float -> Picture {-# INLINE circle #-} @@ -225,7 +225,7 @@ text :: String -> Picture {-# INLINE text #-} text s = map f $ stringToList s where - f (pos,col,val) = Verx pos col (TextV val) 0 textNum + f (pos,col,V2 a b) = Verx pos col [a,b] 0 textNum line :: [Point2] -> Picture {-# INLINE line #-} @@ -306,7 +306,7 @@ thickArcHelp startA endA rad wdth = map f (V2 xa ya) = rotateV startA (V2 rad 0) (V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * sqrt 2) (0)) (V2 xc yc) = rotateV endA (V2 rad 0) - f (pos,col,val) = Verx pos col (ArcV val) 0 arcNum + f (pos,col,V3 a b c) = Verx pos col [a,b,c] 0 arcNum withAlpha :: Float -> RGBA -> RGBA {-# INLINE withAlpha #-} diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs index 457150ebd..4bf908a4b 100644 --- a/src/Picture/Data.hs +++ b/src/Picture/Data.hs @@ -20,7 +20,7 @@ import Control.Lens data Verx = Verx { _vxPos :: !Point3 , _vxCol :: !Point4 - , _vxType :: !VertexType + , _vxExt :: [Float] , _vxLayer :: !Int , _vxShadNum :: !ShadNum } diff --git a/src/Polyhedra.hs b/src/Polyhedra.hs index a567889c5..355b9eb3b 100644 --- a/src/Polyhedra.hs +++ b/src/Polyhedra.hs @@ -88,7 +88,7 @@ polyToPics = map helpPoly3D . _pyFaces helpPoly3D :: [(Point3, Point4)] -> [Verx] helpPoly3D vs = map f $ polyToTris vs where - f (pos,col) = Verx pos col PolyV 0 polyNum + f (pos,col) = Verx pos col [] 0 polyNum polysToPic :: [Polyhedra] -> Picture polysToPic = pictures . concatMap polyToPics diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index d5df16aeb..5b2029dde 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -20,7 +20,7 @@ import Geometry.Data --import Data.List import Foreign import Control.Monad -import qualified Control.Foldl as F +--import qualified Control.Foldl as F import qualified Data.IntMap.Strict as IM --import Control.Lens import qualified Data.Vector.Unboxed.Mutable as MV @@ -43,40 +43,41 @@ vToPicShad :: MV.MVector (PrimState IO) Int -> IO (PicShads Int) vToPicShad mv = mapM (MV.unsafeRead mv) $ PicShads 0 1 2 3 4 5 pokeVerx :: PicShads VBO -> MV.MVector (PrimState IO) Int -> Verx -> IO () -{-# INLINE pokeVerx #-} -pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType} = case theType of - PolyV -> do - typeOff <- MV.unsafeRead offsets 0 - poke34 (plusPtr (_vboPtr $ _psPoly vbos) (typeOff * 7 * floatSize)) thePos theCol - PolyzV x -> do - typeOff <- MV.unsafeRead offsets 1 - let thePtr = plusPtr (_vboPtr $ _psPolyz vbos) (typeOff * 8 * floatSize) - poke34 thePtr thePos theCol - pokeElemOff thePtr 7 x - BezV (V4 x y z w) -> do - typeOff <- MV.unsafeRead offsets 2 - let thePtr = plusPtr (_vboPtr $ _psBez vbos) (typeOff * 11 * floatSize) - poke34 thePtr thePos theCol - pokeElemOff thePtr 7 x - pokeElemOff thePtr 8 y - pokeElemOff thePtr 9 z - pokeElemOff thePtr 10 w - TextV (V2 x y) -> do - typeOff <- MV.unsafeRead offsets 3 - let thePtr = plusPtr (_vboPtr $ _psText vbos) (typeOff * 9 * floatSize) - poke34 thePtr thePos theCol - pokeElemOff thePtr 7 x - pokeElemOff thePtr 8 y - ArcV (V3 x y z) -> do - typeOff <- MV.unsafeRead offsets 4 - let thePtr = plusPtr (_vboPtr $ _psArc vbos) (typeOff * 10 * floatSize) - poke34 thePtr thePos theCol - pokeElemOff thePtr 7 x - pokeElemOff thePtr 8 y - pokeElemOff thePtr 9 z - EllV -> do - typeOff <- MV.unsafeRead offsets 5 - poke34 (plusPtr (_vboPtr $ _psEll vbos) (typeOff * 7 * floatSize)) thePos theCol +--{-# INLINE pokeVerx #-} +pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do + typeOff <- MV.unsafeRead offsets sn + let thePtr = plusPtr (_vboPtr $ vboFromType vbos sn) (typeOff * pokeStride sn * floatSize) + poke34 thePtr thePos theCol + pokeArrayOff thePtr 7 ext + where + sn = _unShadNum theShadNum +-- case _unShadNum theShadNum of +-- 0 -> do +-- typeOff <- MV.unsafeRead offsets 0 +-- poke34 (plusPtr (_vboPtr $ vboFromType vbos 0) (typeOff * 7 * floatSize)) thePos theCol +-- 1 -> do +-- typeOff <- MV.unsafeRead offsets 1 +-- let thePtr = plusPtr (_vboPtr $ _psPolyz vbos) (typeOff * 8 * floatSize) +-- poke34 thePtr thePos theCol +-- pokeArrayOff thePtr 7 ext +-- 2 -> do +-- typeOff <- MV.unsafeRead offsets 2 +-- let thePtr = plusPtr (_vboPtr $ _psBez vbos) (typeOff * 11 * floatSize) +-- poke34 thePtr thePos theCol +-- pokeArrayOff thePtr 7 ext +-- 3 -> do +-- typeOff <- MV.unsafeRead offsets 3 +-- let thePtr = plusPtr (_vboPtr $ _psText vbos) (typeOff * 9 * floatSize) +-- poke34 thePtr thePos theCol +-- pokeArrayOff thePtr 7 ext +-- 4 -> do +-- typeOff <- MV.unsafeRead offsets 4 +-- let thePtr = plusPtr (_vboPtr $ _psArc vbos) (typeOff * 10 * floatSize) +-- poke34 thePtr thePos theCol +-- pokeArrayOff thePtr 7 ext +-- 5 -> do +-- typeOff <- MV.unsafeRead offsets 5 +-- poke34 (plusPtr (_vboPtr $ _psEll vbos) (typeOff * 7 * floatSize)) thePos theCol poke34 :: Ptr Float -> Point3 -> Point4 -> IO () {-# INLINE poke34 #-} @@ -131,29 +132,17 @@ comLayVerx vbos counts vx = do theOff <- MV.unsafeRead counts vecPos let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize) poke34 thePtr thePos theCol - pokeVerxType thePtr theType + pokeArrayOff thePtr 7 (_vxExt vx) MV.unsafeModify counts (+ 1) vecPos where sn = _unShadNum (_vxShadNum vx) vecPos = theLayer * 6 + sn theLayer = _vxLayer vx - theType = _vxType vx thePos = _vxPos vx theCol = _vxCol vx basePtr = _vboPtr $ vboFromType vbos sn layOff = theLayer * numSubElements - 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 - >> pokeElemOff thePtr 9 z >> pokeElemOff thePtr 10 w - TextV (V2 x y) -> pokeElemOff thePtr 7 x >> pokeElemOff thePtr 8 y - ArcV (V3 x y z) -> pokeElemOff thePtr 7 x >> pokeElemOff thePtr 8 y - >> pokeElemOff thePtr 9 z - _ -> return () + theStride = pokeStride sn vboFromType :: PicShads VBO -> Int -> VBO {-# INLINE vboFromType #-} @@ -164,6 +153,7 @@ vboFromType ps sn = case sn of 3 -> _psText ps 4 -> _psArc ps 5 -> _psEll ps + _ -> undefined pokeLayVerxs :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int)) @@ -177,14 +167,15 @@ vToLayPicShad mv = foldM f IM.empty [0..5] where f m i = fmap (\ps -> IM.insert i ps m) (vToPicShad $ MV.unsafeSlice (i * 6) 6 mv) -pokeStride :: VertexType -> Int +pokeStride :: Int -> Int {-# INLINE pokeStride #-} -pokeStride PolyV = 7 -pokeStride PolyzV{} = 8 -pokeStride BezV{} = 11 -pokeStride TextV{} = 9 -pokeStride ArcV{} = 10 -pokeStride EllV = 7 +pokeStride 0 = 7 +pokeStride 1 = 8 +pokeStride 2 = 11 +pokeStride 3 = 9 +pokeStride 4 = 10 +pokeStride 5 = 7 +pokeStride _ = undefined poke224s :: Ptr Float -> [((Point2,Point2),Point4)] -> IO Int poke224s ptr vals0 = go vals0 0