Refactor vertex poking

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