abstract buffer creation and arrays

package.nix

@@ -5,7 +5,7 @@
   pkgs,
   ...
 }: let
-  ghcExeOptions = "-Wall -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N";
+  ghcExeOptions = "-O -Wall -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N";
   ghcPackages = p: [
     p.bytestring
     p.data-default

src/IO.hs

@@ -21,12 +21,15 @@ import Model
 
 -- VIEW --
 
+backgroundColor :: GL.Color4 GL.GLfloat
+backgroundColor = GL.Color4 0 0 0 1
+
 view :: GLFW.Window -> Descriptor -> Model -> IO ()
 view window descriptor@(Descriptor vertices firstIndex numVertices) model = do
-  GL.clearColor $= GL.Color4 1 0 1 1
+  GL.clearColor $= backgroundColor
   GL.clear [GL.ColorBuffer]
   GL.bindVertexArrayObject $= Just vertices
-  GL.drawArrays GL.Triangles firstIndex numVertices
+  GL.drawArrays GL.TriangleStrip firstIndex numVertices
   GLFW.swapBuffers window
   GLFW.pollEvents
 
@@ -43,82 +46,66 @@ data Descriptor =
 bufferOffset :: Integral a => a -> Ptr b
 bufferOffset integral = plusPtr nullPtr $ fromIntegral integral
 
+verticesArray :: [GL.Vertex2 GL.GLfloat]
+verticesArray =
+  [ GL.Vertex2 0.9 0.9
+  , GL.Vertex2 0.5 0.9
+  , GL.Vertex2 0.9 0.5
+  , GL.Vertex2 0.5 0.5
+  , GL.Vertex2 0.9 0.0
+  , GL.Vertex2 0.5 0.0
+  ]
+
+generateRGBA :: Int -> [GL.Color4 GL.GLfloat]
+generateRGBA i =
+  take i $ cycle rgba
+
+rgba :: [GL.Color4 GL.GLfloat]
+rgba =
+  [ GL.Color4 1.0 0.0 0.0 1.0
+  , GL.Color4 0.0 1.0 0.0 1.0
+  , GL.Color4 0.0 0.0 1.0 1.0
+  ]
+
+sizeOfArray :: (Storable a, Num b) => [a] -> b
+sizeOfArray [] = 0
+sizeOfArray (x:xs) = fromIntegral $ (*) ( 1 + length xs) $ sizeOf x
+
+makeBuffer :: Storable (a GL.GLfloat) => [a GL.GLfloat] -> GL.NumComponents -> GL.GLuint -> IO ()
+makeBuffer array numComponents i = do
+  let vPosition = GL.AttribLocation i
+  buffer <- GL.genObjectName
+  GL.bindBuffer GL.ArrayBuffer $= Just buffer
+  withArray array $ \ptr ->
+    GL.bufferData GL.ArrayBuffer $= (sizeOfArray array, ptr, GL.StaticDraw)
+  GL.vertexAttribPointer vPosition $=
+    (GL.ToFloat, GL.VertexArrayDescriptor numComponents GL.Float 0 (bufferOffset 0))
+  GL.vertexAttribArray vPosition $= GL.Enabled
+  
+
 initResources :: IO Descriptor
 initResources = do
-
   -- vertices array
   verticesGLArray <- GL.genObjectName
   GL.bindVertexArrayObject $= Just verticesGLArray
-  let 
+  let verticesDescriptor = Descriptor
-    verticesArray =
+                             verticesGLArray
-      [ GL.Vertex2 0.9 0.9
+                             0
-      , GL.Vertex2 0.9 (-0.85)
+                             $ fromIntegral
-      , GL.Vertex2 (-0.85) 0.9
+                               $ length verticesArray
-      , GL.Vertex2 (-0.9) (-0.9)
-      , GL.Vertex2 (-0.9) 0.85
-      , GL.Vertex2 0.85 (-0.9)
-      ] :: [GL.Vertex2 GL.GLfloat]
-    numVertices = length verticesArray
-  vertexBuffer <- GL.genObjectName
-  GL.bindBuffer GL.ArrayBuffer $= Just vertexBuffer
-  withArray verticesArray $ \ptr -> do
-    let
-      size
-        = fromIntegral
-        $ (*)
-          numVertices
-          $ sizeOf
-            $ case viaNonEmpty head verticesArray of
-                Nothing -> (GL.Vertex2 0 0) :: (GL.Vertex2 GL.GLfloat)
-                Just a -> a
-    GL.bufferData GL.ArrayBuffer $= (size, ptr, GL.StaticDraw)
-  let
-    firstIndex = 0
-    vPosition = GL.AttribLocation 0
-  GL.vertexAttribPointer vPosition $=
-    (GL.ToFloat, GL.VertexArrayDescriptor 2 GL.Float 0 (bufferOffset firstIndex))
-  GL.vertexAttribArray vPosition $= GL.Enabled
 
-  -- colors array
+  makeBuffer verticesArray 2 0
-
+  makeBuffer (generateRGBA $ length verticesArray) 4 1
-  let
-    rgba =
-      [ GL.Color4 1.0 0.0 0.0 1.0
-      , GL.Color4 0.0 1.0 0.0 1.0
-      , GL.Color4 0.0 0.0 1.0 1.0
-      , GL.Color4 1.0 0.0 0.0 1.0
-      , GL.Color4 0.0 1.0 0.0 1.0
-      , GL.Color4 0.0 0.0 1.0 1.0
-      ] :: [GL.Color4 GL.GLfloat]
-  colorBuffer <- GL.genObjectName
-  GL.bindBuffer GL.ArrayBuffer $= Just colorBuffer
-  withArray rgba $ \ptr -> do
-    let
-      size
-        = fromIntegral
-        $ (*)
-          numVertices
-          $ sizeOf
-            $ case viaNonEmpty head rgba of
-                Nothing ->
-                  (GL.Color4 0.0 0.0 0.0 0.0) :: (GL.Color4 GL.GLfloat)
-                Just a ->
-                  a
-    GL.bufferData GL.ArrayBuffer $= (size, ptr, GL.StaticDraw)
-  let
-    firstIndex = 0
-    vPosition = GL.AttribLocation 1
-  GL.vertexAttribPointer vPosition $=
-    (GL.ToFloat, GL.VertexArrayDescriptor 4 GL.Float 0 (bufferOffset firstIndex))
-  GL.vertexAttribArray vPosition $= GL.Enabled
   
+  -- load shaders
   program <- loadShaders
     [ ShaderInfo GL.VertexShader (FileSource "vert.glsl")
     , ShaderInfo GL.FragmentShader (FileSource "frag.glsl")
     ]
   GL.currentProgram $= Just program
 
-  return $ Descriptor verticesGLArray firstIndex $ fromIntegral numVertices
+  -- return descriptor for vertices array
+  return verticesDescriptor
 
 -- INPUT --