Fix arc rendering bug (make vertex attribs correct size)

2021-03-12 01:22:10 +01:00
parent e8e3dd8f50
commit 9bdc6fddd7
21 changed files with 63 additions and 347 deletions
@@ -1,6 +1,10 @@
 {-# LANGUAGE TemplateHaskell #-}
 --{-# LANGUAGE Strict #-}
 module Picture.Preload
+    ( RenderData (..)
+    , preloadRender
+    , cleanUpRenderPreload
+    )
    where

 import Picture.Data
@@ -25,6 +29,57 @@ data RenderData = RenderData

 makeLenses ''RenderData

+preloadRender :: IO RenderData
+preloadRender = do
+-- compile shader programs
+    lsShad <- makeShader "lightmapCircle" [vert,geom,frag] [(0,4)] Points (return . return . flat4)
+--    fcs <- makeSourcedShader "lightmapCircle" [VertexShader,GeometryShader,FragmentShader]
+
+    bgShad <- makeTextureShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat
+                                "data/texture/smudgedDirt.png"
+
+    wsShad <- makeShaderCustomUnis "wallShadow" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPStrat
+                ["lightPos"]
+
+    bslist <- makeShader "basic"   [vert,frag]      [(0,3),(1,4)]       Triangles pokeTriStrat
+    lslist <- makeShader "basic"   [vert,frag]      [(0,3),(1,4)]       Lines     pokeLineStrat
+    aslist <- makeShader "arc"     [vert,geom,frag] [(0,3),(1,4),(2,4)] Points    pokeArcStrat
+    eslist <- makeShader "ellipse" [vert,geom,frag] [(0,3),(1,4)]       Triangles pokeEllStrat
+    cslist <- makeTextureShader "character" [vert,geom,frag] 
+                                [(0,3),(1,4),(2,3)] Points pokeCharStrat
+                                "data/texture/charMap.png"
+
+--the following vbo is set up to contain one fixed vertex
+    dummyvbo <- genObjectName
+    dummyptr <- mallocArray numDrawableElements
+    pokeArray dummyptr [0..2000]
+    bindBuffer ArrayBuffer $= Just dummyvbo
+    bufferData ArrayBuffer $= (fromIntegral floatSize, dummyptr, StaticDraw)
+
+-- input a list of (attribute location, attrib length) pairs
+-- these will have buffers and pointers created
+    backgroundvao <- setupVAO [(0,4),(1,2)]
+    
+    return $ RenderData
+        { _listShaders = [bslist,lslist,cslist,aslist,eslist]
+        , _dummyVBO = dummyvbo
+        , _dummyPtr = dummyptr
+        , _lightSourceShader = lsShad
+        , _wallShadowShader  = wsShad
+        , _backgroundShader  = bgShad
+        }
+
+
+--------------------end preloadRender
+cleanUpRenderPreload :: RenderData -> IO ()
+cleanUpRenderPreload pd = do
+    mapM_ freeShaderPointers $ _listShaders pd
+    freeShaderPointers $ _lightSourceShader pd
+    freeShaderPointers $ _wallShadowShader pd
+    freeShaderPointers $ _backgroundShader pd
+    free $ _dummyPtr pd
+
+{-# INLINE pokeTriStrat #-}
 pokeTriStrat (RenderPoly vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
 pokeTriStrat _ = []

@@ -53,53 +108,3 @@ pokeWPStrat ((x,y),(z,w),(a,b),(c,d)) = [[[x,y,z,w],[a,b,c,d]]]
 pokeBGStrat :: a -> [[[Float]]]
 pokeBGStrat = const []

-preloadRender :: IO RenderData
-preloadRender = do
-- compile shader programs
-    lsShad <- makeShader "lightmapCircle" [vert,geom,frag] [(0,4)] Points (return . return . flat4)
--    fcs <- makeSourcedShader "lightmapCircle" [VertexShader,GeometryShader,FragmentShader]
-
-    bgShad <- makeTextureShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat
-                                "data/texture/smudgedDirt.png"
-
-    wsShad <- makeShaderCustomUnis "wallShadow" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPStrat
-                ["lightPos"]
-
-    bslist <- makeShader "basic"   [vert,frag]      [(0,3),(1,4)]       Triangles pokeTriStrat
-    lslist <- makeShader "basic"   [vert,frag]      [(0,3),(1,4)]       Lines     pokeLineStrat
-    aslist <- makeShader "arc"     [vert,geom,frag] [(0,3),(1,4),(2,3)] Points    pokeArcStrat
-    eslist <- makeShader "ellipse" [vert,geom,frag] [(0,3),(1,4)]       Triangles pokeEllStrat
-    cslist <- makeTextureShader "character" [vert,geom,frag] 
-                                [(0,3),(1,4),(2,3)] Points pokeCharStrat
-                                "data/texture/charMap.png"
-
--the following vbo is set up to contain one fixed vertex
-    dummyvbo <- genObjectName
-    dummyptr <- mallocArray numDrawableElements
-    pokeArray dummyptr [0..2000]
-    bindBuffer ArrayBuffer $= Just dummyvbo
-    bufferData ArrayBuffer $= (fromIntegral floatSize, dummyptr, StaticDraw)
-
-- input a list of (attribute location, attrib length) pairs
-- these will have buffers and pointers created
-    backgroundvao <- setupVAO [(0,4),(1,2)]
-    
-    return $ RenderData
-        { _listShaders = [bslist,lslist,cslist,aslist,eslist]
-        , _dummyVBO = dummyvbo
-        , _dummyPtr = dummyptr
-        , _lightSourceShader = lsShad
-        , _wallShadowShader  = wsShad
-        , _backgroundShader  = bgShad
-        }
-
-vaoPointers :: VAO -> [Ptr Float]
-vaoPointers = (\(_,ps,_) -> ps) . unzip3 . _vaoBufferTargets
-
-cleanUpRenderPreload :: RenderData -> IO ()
-cleanUpRenderPreload pd = do
-    mapM_ freeShaderPointers $ _listShaders pd
-    freeShaderPointers $ _lightSourceShader pd
-    freeShaderPointers $ _wallShadowShader pd
-    freeShaderPointers $ _backgroundShader pd
-    free $ _dummyPtr pd