Refactor vertex poking

2021-08-10 02:29:17 +02:00
parent 79eb031637
commit 51b8fab214
4 changed files with 57 additions and 66 deletions
@@ -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 #-}
@@ -20,7 +20,7 @@ import Control.Lens
 data Verx = Verx
    { _vxPos    :: !Point3
    , _vxCol    :: !Point4
-    , _vxType   :: !VertexType
+    , _vxExt    :: [Float]
    , _vxLayer  :: !Int
    , _vxShadNum  :: !ShadNum
    }
@@ -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
@@ -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