Implement poking using Verx lists

src/Data/Preload/Render.hs

@@ -1,5 +1,7 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
+  , TemplateHaskell 
+  #-}
+--{-# OPTIONS_GHC -Wno-unused-top-binds #-}
 module Data.Preload.Render
     where
 import Shader.Data

src/Dodge/Render.hs

@@ -45,27 +45,21 @@ doDrawing pdata w = do
     let rot     = _cameraRot w
         camzoom    = _cameraZoom w
         trans = _cameraCenter w
-        wins    = (V2 (getWindowX w) (getWindowY w))
+        wins    = V2 (getWindowX w) (getWindowY w)
         (wallPointsCol,windowPoints) = wallsAndWindows w
         lightPoints     = lightsForGloom w
         viewFroms = _cameraViewFrom w
         pic = worldPictures w
     -- bind as much data into vbos as feasible at this point
     -- poke wall points and colors
-    --pokeArray (_vboPointer . _vaoVBO . _shaderVAO $ _wallTextureShader pdata) $ wallsToList wallPointsCol
+    nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol
-    --let nWalls = length wallPointsCol
-    nWalls <- pokeWalls (shadVBOptr $ _wallTextureShader pdata) wallPointsCol
-    --poke
-
-    -- poke silhouette vertex data
     nSils <- pokePoint3s (shadVBOptr $ _lightingLineShadowShader pdata) 
                 (_foregroundEdgeVerx w)
-
     -- poke foreground geometry and floor
     let addC (V2 xx yy) = (V3 xx yy 0)
     nsurfVs <- pokePoint3s (shadVBOptr $ _lightingSurfaceShader pdata)
         $ polyToTris (map addC $ screenPolygon w)
-        ++ concatMap polyToGeoRender' (foregroundPics w)
+        ++ concatMap polyToGeoRender (foregroundPics w)
 
     -- bind wall points, silhouette data, surface geometry
     uncurry bindShaderBuffers $ unzip
@@ -213,7 +207,7 @@ renderWindows
     -> [((Point2,Point2),Point4)]   -- ^ List: wall positions and color
     -> IO ()
 renderWindows pdata wps = do
-    n <- pokeWalls (shadVBOptr $ _wallBlankShader pdata) wps
+    n <- poke224s (shadVBOptr $ _wallBlankShader pdata) wps
     bindShaderBuffers [_wallBlankShader pdata] [n]
     currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata)
     cullFace $= Just Back

src/Geometry.hs

@@ -255,10 +255,10 @@ anyPolyssIntersect x y = or $ polysIntersect <$> x <*> y
 -- split a list into triples, forms triangles from a polygon
 polyToTris :: [s] -> [s]
 {-# INLINE polyToTris #-}
-polyToTris (a:as) = f a as
+polyToTris (a:as) = go a as
   where
-    f x (y:z:ys) = x : y : z : f x (z:ys)
+    go !x (y:z:ys) = x : y : z : go x (z:ys)
-    f _ _ = []
+    go _ _ = []
 polyToTris _ = []
 
 -- | Return n equidistant points on a circle with a radius of 600.

src/Geometry/Vector.hs

@@ -22,12 +22,12 @@ V2 x1 y1 +.+ V2 x2 y2 =
 {- | 2D coordinate-wise subtraction.  -}
 (-.-) :: Point2 -> Point2 -> Point2
 {-# INLINE (-.-) #-}
-(-.-) = (-)
+--(-.-) = (-)
---(x1, y1) -.- (x2, y2) =
+V2 x1 y1 -.- V2 x2 y2 =
---  let
+  let
---    !x = x1 - x2
+    !x = x1 - x2
---    !y = y1 - y2
+    !y = y1 - y2
---  in (x, y)
+  in V2 x  y
 {- | 2D scalar multiplication.  -}
 (*.*) :: Float -> Point2 -> Point2
 {-# INLINE (*.*) #-}

src/Music.hs

@@ -3,6 +3,6 @@ module Music
 import qualified SDL.Mixer as Mix
 import qualified Data.IntMap.Strict as IM
 
-data MusicData = MusicData
+newtype MusicData = MusicData
     { _loadedMusic   :: IM.IntMap Mix.Music
     }

src/Picture.hs

@@ -1,6 +1,9 @@
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TupleSections
+  , BangPatterns 
+  #-}
 module Picture
     ( module Picture.Data
+    , blank
     , polygon
     , polygonZ
     , polygonCol
@@ -62,8 +65,9 @@ import Picture.Data
 --import Graphics.Rendering.OpenGL (lineWidth, ($=))
 import Control.Lens
 
-black :: RGBA
+blank :: Picture
-black = (V4 0 0 0 1)
+{-# INLINE blank #-}
+blank = []
 
 polygon :: [Point2] -> Picture
 {-# INLINE polygon #-}
@@ -79,9 +83,9 @@ polygonZ ps z = map (f . zeroZ) $ polyToTris ps
 
 polygonCol :: [(Point2,RGBA)] -> Picture
 {-# INLINE polygonCol #-}
-polygonCol vs = map f $ polyToTris vs
+polygonCol vs = polyToTris $ map f vs
   where
-    f ((V2 x y),col) = Verx (V3 x y 0) col PolyV 0
+    f (V2 x y,col) = Verx (V3 x y 0) col PolyV 0
 
 poly3 :: [Point3] -> Picture
 {-# INLINE poly3 #-}
@@ -99,14 +103,13 @@ bezierQuad cola colc ra rc a b c
     | a == b && b == c = blank
     | a == b || b == c = bezierQuad cola colc ra rc a (0.5 *.* (a +.+ c)) c
     | otherwise = bzhelp
-        [-- ( (0,0) , cola, (0,0), (0,0) )
+        [(aIn, cola, V2 (fa aIn) (fc aIn) , V2 1        0         )
-         (aIn, cola, (V2 (fa aIn) (fc aIn)) , (V2 1 0) )
+        ,(aIn, cola, V2 (fa aIn) (fc aIn) , V2 1        0         )
-        ,(aIn, cola, (V2 (fa aIn) (fc aIn)) , (V2 1 0) )
+        ,(cIn, colc, V2 (fa cIn) (fc cIn) , V2 0        1         )
-        ,(cIn, colc, (V2 (fa cIn) (fc cIn)) , (V2 0 1) )
+        ,( aX, cola, V2 1        0        , V2 (fa' aX) (fc' aX)  )
-        ,( aX, cola, (V2 1 0) , (V2 (fa' aX) (fc' aX))  )
+        ,( cX, colc, V2 0        1        , V2 (fa' cX) (fc' cX)  )
-        ,( cX, colc, (V2 0 1) , (V2 (fa' cX) (fc' cX))  )
+        ,( bX, colb, V2 0        0        , V2 (fa' bX) (fc' bX)  )
-        ,( bX, colb, (V2 0 0) , (V2 (fa' bX) (fc' bX))  )
+        ,( bX, colb, V2 0        0        , V2 (fa' bX) (fc' bX)  )
-        ,( bX, colb, (V2 0 0) , (V2 (fa' bX) (fc' bX))  )
         ]
   where 
     colb = mixColors 0.5 0.5 cola colc
@@ -131,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
+    f (V2 x y,col,V2 a b,V2 c d) = Verx (V3 x y 0) col (BezV (V4 a b c d)) 0
 
 -- given a one and two zeros of a linear function over x and y,
 -- determine the function
@@ -154,12 +157,12 @@ color c = map $ overCol (const c)
 
 translate3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE translate3 #-}
-translate3 a b (V3 x y z) = V3 (x+a) (y+b) z
+translate3 !a !b !(V3 x y z) = V3 (x+a) (y+b) z
 
 translate :: Float -> Float -> Picture -> Picture
 --{-# INLINE translate #-}
 --translate x y = map $ second $ overPos (translate3 x y)
-translate x y = map $ overPos (translate3 x y)
+translate !x !y = map $! overPos $! translate3 x y
 
 setDepth :: Float -> Picture -> Picture
 --{-# INLINE setDepth #-}
@@ -311,20 +314,22 @@ withAlpha :: Float -> RGBA -> RGBA
 {-# INLINE withAlpha #-}
 withAlpha a (V4 x y z a') = (V4 x y z (a*a'))
 
-red,green,blue,yellow,cyan,magenta,rose,violet,azure,aquamarine,chartreuse,orange,white::Color
+red,green,blue,yellow,cyan,magenta,rose
-red       = toV4 (1,0,0,1) 
+    ,violet,azure,aquamarine,chartreuse,orange,white,black::Color
-green     = toV4 (0,1,0,1) 
+red       = V4   1   0   0 1 
-blue      = toV4 (0,0,1,1) 
+green     = V4   0   1   0 1 
-yellow    = toV4 (1,1,0,1)  
+blue      = V4   0   0   1 1 
-cyan      = toV4 (0,1,1,1) 
+yellow    = V4   1   1   0 1  
-magenta   = toV4 (1,0,1,1)  
+cyan      = V4   0   1   1 1 
-rose      = toV4 (1,0,0.5,1) 
+magenta   = V4   1   0   1 1  
-violet    = toV4 (0.5,0,1,1)  
+rose      = V4   1   0 0.5 1 
-azure     = toV4 (0,0.5,1,1) 
+violet    = V4 0.5   0   1 1  
-aquamarine= toV4 (0,1,0.5,1) 
+azure     = V4   0 0.5   1 1 
-chartreuse= toV4 (0.5,1,0,1)
+aquamarine= V4   0   1 0.5 1 
-orange    = toV4 (1,0.5,0,1)  
+chartreuse= V4 0.5   1   0 1
-white     = toV4 (1,1,1,1) 
+orange    = V4   1 0.5   0 1  
+white     = V4   1   1   1 1 
+black     = V4   0   0   0 1
 
 
 mixColors :: Float -> Float -> Color -> Color -> Color

src/Picture/Data.hs

@@ -1,13 +1,13 @@
 {-# LANGUAGE TemplateHaskell #-}
 --{-# LANGUAGE Strict #-}
-{-# LANGUAGE DeriveGeneric #-}
 module Picture.Data
     where
 import Geometry.Data
 
-import GHC.Generics (Generic)
+import Control.Lens
-import Control.DeepSeq
+--import GHC.Generics (Generic)
-import Data.Foldable
+--import Control.DeepSeq
+--import Data.Foldable
 --import qualified Data.List as L
 --import Data.Monoid
 --import Data.Traversable
@@ -15,7 +15,6 @@ import Data.Foldable
 --import qualified Data.Sequence as Se
 --import qualified Data.DList as DL
 --import qualified Data.Vector as V
-import Control.Lens
 --import Control.Monad 
 
 data Verx = Verx
@@ -32,10 +31,9 @@ data VertexType
     | ArcV      !Point3
     | EllV
 
-type RGBA = Point4
+type RGBA  = Point4
 type Color = Point4
 
-
 flat2 :: V2 a -> [a]
 flat2 (V2 x y) = [x,y]
 flat3 :: V3 a -> [a]
@@ -57,8 +55,4 @@ tflat4 (x,y,z,w) = [x,y,z,w]
 
 type Picture = [Verx]
 
-blank :: Picture
-{-# INLINE blank #-}
-blank = []
-
 makeLenses ''Verx

src/Polyhedra.hs

@@ -96,5 +96,5 @@ polysToPic = pictures . concatMap polyToPics
 polyToEdges :: Polyhedra -> [(Point3,Point3,Point3,Point3)]
 polyToEdges = constructEdges . map (map fst) . _pyFaces
 
-polyToGeoRender' :: Polyhedra -> [Point3]
+polyToGeoRender :: Polyhedra -> [Point3]
-polyToGeoRender' = concatMap (polyToTris . map fst) . _pyFaces
+polyToGeoRender = concatMap (polyToTris . map fst) . _pyFaces

src/Render.hs

@@ -12,6 +12,7 @@ import Picture.Data
 import Geometry.Data
 --import Polyhedra.Data
 --import Polyhedra
+import Layers
 
 --import Control.Lens
 import Control.Monad
@@ -20,7 +21,7 @@ import Foreign hiding (rotate)
 import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T)
 --import Data.Foldable
 --import Data.Tuple.Extra
-import qualified Data.IntMap.Strict as IM
+--import qualified Data.IntMap.Strict as IM
 import qualified SDL
 
 divideSize :: Int -> Size -> Size
@@ -160,12 +161,10 @@ pokeBindFoldableLayer
 --    :: Foldable f
     :: RenderData
     -> [Verx]
-    -> IO (IM.IntMap (PicShads Int))
+    -> IO (Layers (PicShads Int))
 pokeBindFoldableLayer pdata m = do
     let shads = _pictureShaders pdata
-        --slist' = (IM.fromList ((,) <$> [0..6] <*> [zeroCounts])) :: IM.IntMap (PicShads Int)
 
-    --slist'' <- foldM (pokeVX shads) slist' m
     slist'' <- pokeLayVerxs (fmap (_vaoVBO . _vshaderVAO) shads) m
     bindShaderLay shads slist''
 
@@ -187,9 +186,8 @@ renderFoldable pdata struct = do
     return $ pokeEndTicks - pokeStartTicks
 ------------------------------end renderFoldable
 
-renderLayer :: Int -> PicShads VShader -> IM.IntMap (PicShads Int) -> IO ()
+renderLayer :: Int -> PicShads VShader -> Layers (PicShads Int) -> IO ()
-renderLayer i shads counts = 
+renderLayer i shads counts = sequence_ $ drawShaderLay i <$> shads <*> getLay i counts
-    mapM_ (uncurry $ drawShaderLay i) ((,) <$> shads <*> counts IM.! i)
 
 pokeTwoOff 
     :: Ptr Float 

src/Shader.hs

@@ -13,13 +13,14 @@ module Shader
 import Shader.Data
 import Shader.Parameters
 import Shader.ExtraPrimitive
+import Layers
 --import MatrixHelper
 
 import Foreign
 import Control.Monad
 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
 import Graphics.GL.Core43
-import qualified Data.IntMap.Strict as IM
+--import qualified Data.IntMap.Strict as IM
 --import Data.Bifunctor
 --import Text.RawString.QQ
 --import Linear.Matrix
@@ -59,10 +60,10 @@ bindArrayBuffersLayer numVs lay theVBO = do
   where
     stride = sum $ _vboAttribSizes theVBO
 
-bindShaderLay :: PicShads VShader -> IM.IntMap (PicShads Int) -> IO ()
+bindShaderLay :: PicShads VShader -> Layers (PicShads Int) -> IO ()
-bindShaderLay shads = mapM_ f . IM.toList
+bindShaderLay shads = sequenceLayers_ f
   where
-    f (lay,counts) = sequence_ $ bindArrayBuffersLayer' lay <$> counts <*> (_vaoVBO . _vshaderVAO <$> shads)
+    f lay counts = sequence_ $ bindArrayBuffersLayer' lay <$> counts <*> (_vaoVBO . _vshaderVAO <$> shads)
 
 bindShader :: PicShads VShader -> PicShads Int -> IO ()
 bindShader shads counts = sequence_ $ bindArrayBuffers <$> counts <*> (_vaoVBO . _vshaderVAO <$> shads)

src/Shader/Data.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
 {- |
 Datatypes used to setup and pass data to shaders.
 -}

src/Shader/Poke.hs

@@ -1,66 +1,38 @@
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TupleSections 
-{-# LANGUAGE BangPatterns #-}
+  , BangPatterns 
+  #-}
 module Shader.Poke
     ( pokeArrayOff
-    , pokeVX
-    , pokeVX'
     , pokePoint3s
     , pokePoint33s
     , pokeVerxs
     , pokeLayVerxs
-    , pokeWalls
+    , pokeLayVerxsM
+    , poke224s
     ) where
 import Shader.Data
 import Shader.Parameters
 import Picture.Data
 import Geometry.Data
+import Layers
 
 --import Data.Maybe
 --import Data.List
 import Foreign
---import Control.Monad
+import Control.Monad
 --import qualified Control.Foldl as F
-import qualified Data.IntMap.Strict as IM
+--import qualified Data.IntMap.Strict as IM
 import Control.Lens
 
-getterPicShad :: VertexType -> PicShads a -> a
---{-# INLINE getterPicShad #-}
-getterPicShad PolyV    = _psPoly
-getterPicShad PolyzV{} = _psPolyz
-getterPicShad BezV{}   = _psBez
-getterPicShad TextV{}  = _psText
-getterPicShad ArcV{}   = _psArc
-getterPicShad EllV     = _psEll
-
-setterPicShad :: VertexType -> ASetter (PicShads a) (PicShads a) a a
-setterPicShad PolyV    = psPoly
-setterPicShad PolyzV{} = psPolyz
-setterPicShad BezV{}   = psBez
-setterPicShad TextV{}  = psText
-setterPicShad ArcV{}   = psArc
-setterPicShad EllV     = psEll
-
-pokeVX' :: PicShads VShader -> PicShads Int -> Verx -> IO (PicShads Int)
-pokeVX' shads count vx = do
-    let f = setterPicShad (_vxType vx)
-        g = getterPicShad (_vxType vx)
-        vshad = g shads
-        n = g count
-        theVBO = _vaoVBO $ _vshaderVAO vshad
-        ptr = _vboPtr theVBO
-        stride = _vboStride theVBO
-    pokeArrayOff ptr (stride * n) (toFls' vx)
-    return $ count & f +~ 1
-
 pokeVerxs :: PicShads VBO -> [Verx] -> IO (PicShads Int)
 pokeVerxs vbos vxs0 = go vxs0 (pure 0)
   where
-    go [] count = return count
+    go [] !count = return count
     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
 pokeVerx :: PicShads VBO -> PicShads Int -> Verx -> IO ()
-{-# INLINE pokeVerx #-}
+--{-# INLINE pokeVerx #-}
 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
     PolyzV x        -> poke34 thePtr thePos theCol
@@ -88,7 +60,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
 
 poke34 :: Ptr Float -> Point3 -> Point4 -> IO ()
-{-# INLINE poke34 #-}
+--{-# INLINE poke34 #-}
 poke34 ptr (V3 a b c) (V4 d e f g) = do
     pokeElemOff ptr 0 a
     pokeElemOff ptr 1 b
@@ -99,15 +71,15 @@ poke34 ptr (V3 a b c) (V4 d e f g) = do
     pokeElemOff ptr 6 g
 
 addCountVerx :: PicShads Int -> Verx -> PicShads Int
-{-# INLINE addCountVerx #-}
+--{-# INLINE addCountVerx #-}
-addCountVerx ps@PicShads 
+addCountVerx !ps@PicShads 
     { _psPoly   = sPoly 
     , _psPolyz  = sPolyz
     , _psBez    = sBez  
     , _psText   = sText 
     , _psArc    = sArc  
     , _psEll    = sEll  
-    }   Verx{_vxType=theType} = case theType of
+    }   !Verx{_vxType=theType} = case theType of
     PolyV       -> ps {_psPoly = sPoly + 1} 
     PolyzV _    -> ps {_psPolyz = sPolyz + 1} 
     BezV _      -> ps {_psBez  = sBez  + 1}
@@ -115,31 +87,6 @@ addCountVerx ps@PicShads
     ArcV _      -> ps {_psArc  = sArc  + 1}
     EllV        -> ps {_psEll  = sEll  + 1}
 
-
-pokeVX :: PicShads VShader -> IM.IntMap (PicShads Int) -> Verx -> IO (IM.IntMap (PicShads Int))
-pokeVX shads laycounts vx = do
-    let theType = _vxType vx
-        offset = _vxLayer vx
-        counts = laycounts IM.! offset
-        getF = getterPicShad theType
-        vshad = getF shads
-        n = getF counts
-        theVBO = _vaoVBO $ _vshaderVAO vshad
-        ptr = _vboPtr theVBO
-        stride = _vboStride theVBO
-    pokeArrayOff ptr (stride * (n+offset * numSubElements)) (toFls' vx)
-    return $ laycounts & ix offset . setterPicShad theType +~ 1
-
-
-toFls' :: Verx -> [Float]
-toFls' vx = flat3 (_vxPos vx) ++ flat4 (_vxCol vx) ++ f (_vxType vx)
-  where
-    f (PolyzV x) = [x]
-    f (BezV x) = flat4 x
-    f (TextV x) = flat2 x
-    f (ArcV x) = flat3 x
-    f _ = []
-
 pokeArrayOff :: Storable a => Ptr a -> Int -> [a] -> IO ()
 --{-# INLINE pokeArrayOff #-}
 --pokeArrayOff ptr i = zipWithM_ (pokeElemOff ptr) [i..]
@@ -149,7 +96,7 @@ pokePoint33s :: Ptr Float -> [(Point3,Point3)] -> IO Int
 pokePoint33s ptr vals0 = go vals0 0
   where
     go [] n = return n
-    go ( ((V3 a b c),(V3 d e f)):vals) n = do
+    go ( !(!(V3 a b c),!(V3 d e f)):vals) !n = do
         pokeElemOff ptr (off 0) a
         pokeElemOff ptr (off 1) b
         pokeElemOff ptr (off 2) c
@@ -164,7 +111,7 @@ pokePoint3s :: Ptr Float -> [Point3] -> IO Int
 pokePoint3s ptr vals0 = go vals0 0
   where
     go [] n = return n
-    go ( (V3 a b c):vals) n = do
+    go ( !(V3 a b c):vals) !n = do
         pokeElemOff ptr (off 0) a
         pokeElemOff ptr (off 1) b
         pokeElemOff ptr (off 2) c
@@ -172,15 +119,20 @@ pokePoint3s ptr vals0 = go vals0 0
       where
         off i = n*3 + i
 
-pokeLayVerxs :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int))
+pokeLayVerxsM :: PicShads VBO -> [Verx] -> IO (Layers (PicShads Int))
-pokeLayVerxs vbos vxs0 = go vxs0 (IM.fromList $ (, pure 0) <$> [0..5])
+pokeLayVerxsM !vbos = foldM f (pure $ pure 0)
+  where
+    f counts vx = pokeLayVerx vbos counts vx >> return (addLayCountVerx counts vx)
+
+pokeLayVerxs :: PicShads VBO -> [Verx] -> IO (Layers (PicShads Int))
+pokeLayVerxs !vbos vxs0 = go vxs0 (pure (pure 0))
   where
     go [] count = return count
     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
-pokeLayVerx :: PicShads VBO -> IM.IntMap (PicShads Int) -> Verx -> IO ()
+pokeLayVerx :: PicShads VBO -> Layers (PicShads Int) -> Verx -> IO ()
-{-# INLINE pokeLayVerx #-}
+--{-# INLINE pokeLayVerx #-}
 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
     PolyzV x        -> poke34 thePtr thePos theCol
@@ -208,16 +160,23 @@ pokeLayVerx vbos imoffsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType, _vx
     EllV            -> poke34 (plusPtr (_vboPtr $ _psEll vbos) ((_psEll offsets + layOff) * 7 * floatSize)) thePos theCol
   where
     layOff = theLay * numSubElements
-    offsets = imoffsets IM.! theLay
+    offsets = getLay theLay imoffsets
 
-addLayCountVerx :: IM.IntMap (PicShads Int) -> Verx -> IM.IntMap (PicShads Int)
+addLayCountVerx :: Layers (PicShads Int) -> Verx -> Layers (PicShads Int)
-{-# INLINE addLayCountVerx #-}
+--{-# INLINE addLayCountVerx #-}
-addLayCountVerx m vx = IM.adjust f (_vxLayer vx) m
+addLayCountVerx !m !vx = case _vxLayer vx of
+    0 -> m & lay0 %~ f
+    1 -> m & lay1 %~ f
+    2 -> m & lay2 %~ f
+    3 -> m & lay3 %~ f
+    4 -> m & lay4 %~ f
+    5 -> m & lay5 %~ f
+    _ -> undefined
   where
     f = flip addCountVerx vx
 
-pokeWalls :: Ptr Float -> [((Point2,Point2),Point4)] -> IO Int
+poke224s :: Ptr Float -> [((Point2,Point2),Point4)] -> IO Int
-pokeWalls ptr vals0 = go vals0 0
+poke224s ptr vals0 = go vals0 0
   where
     go [] n = return n
     go ((((V2 a b),(V2 c d)),(V4 e f g h)):vals) !n = do