works, but worse than expected

.plan.nix/canvas.nix

@@ -62,6 +62,7 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }:
             (hsPkgs."affection" or (buildDepError "affection"))
             (hsPkgs."sdl2" or (buildDepError "sdl2"))
             (hsPkgs."OpenGL" or (buildDepError "OpenGL"))
+            (hsPkgs."OpenGLRaw" or (buildDepError "OpenGLRaw"))
             (hsPkgs."GLUtil" or (buildDepError "GLUtil"))
             (hsPkgs."JuicyPixels" or (buildDepError "JuicyPixels"))
             (hsPkgs."JuicyPixels-extra" or (buildDepError "JuicyPixels-extra"))
@@ -69,6 +70,7 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }:
             (hsPkgs."containers" or (buildDepError "containers"))
             (hsPkgs."linear" or (buildDepError "linear"))
             (hsPkgs."bytestring" or (buildDepError "bytestring"))
+            (hsPkgs."random" or (buildDepError "random"))
             ];
           buildable = true;
           };

app/Main.hs

@@ -7,6 +7,7 @@ import SDL (($=))
 import qualified SDL
 
 import qualified Graphics.Rendering.OpenGL as GL
+import qualified Graphics.GL as GLRaw
 import qualified Graphics.GLUtil as GLU
 
 import Codec.Picture
@@ -18,6 +19,8 @@ import Control.Concurrent.STM
 
 import qualified Data.Map.Strict as M
 
+import Foreign (nullPtr, plusPtr)
+
 -- internal imports
 
 import Types
@@ -25,6 +28,8 @@ import Types.Sprite
 import Renderer
 import Classes.Renderable as CR
 
+cattyness = 1000
+
 main :: IO ()
 main =
   withAffection AffectionConfig
@@ -33,9 +38,9 @@ main =
     , windowConfigs =
       [ ( 0
         , SDL.defaultWindow
-          { SDL.windowInitialSize = SDL.V2 1600 900
+          { SDL.windowInitialSize = SDL.V2 1920 1080
           , SDL.windowGraphicsContext = SDL.OpenGLContext SDL.defaultOpenGL
-            { SDL.glProfile = SDL.Core SDL.Debug 3 3
+            { SDL.glProfile = SDL.Core SDL.Normal 3 3
             }
           }
         )
@@ -67,7 +72,7 @@ loadStateImpl = do
     <$> (SubWindow <$> newTVarIO [])
     <*> (SubMouse <$> newTVarIO [])
   
-  spriteDetails <- loadSprites
+  spriteDetails <- loadSprites cattyness
 
   return UserData
     { udSubsystems = subs
@@ -78,9 +83,12 @@ loadStateImpl = do
 
 handle event = return ()
 
-updateLoopImpl dt = return ()
+updateLoopImpl dt = do
+  liftIO $ putStrLn (show $ 1 / dt)
+  return ()
 
 drawLoopImpl = do
+  -- liftIO $ putStrLn "I'm in your draw"
   ud@(UserData subs rassets) <- getAffection
   let (RenderAssets sDetails@(AssetDetails svo sso sto sdo)) = rassets
   liftIO $ do
@@ -91,12 +99,15 @@ drawLoopImpl = do
           (sso :: ShaderObjects Sprite)
           (sto M.! ident)
           (head (sdo M.! ident))
-        mapM_ 
-          (draw
-            (svo :: VertexObjects Sprite)
-            (sso :: ShaderObjects Sprite)
-            )
-          (sdo M.! ident)
+        -- mapM_ 
+        --   (draw
+        --     (svo :: VertexObjects Sprite)
+        --     (sso :: ShaderObjects Sprite)
+        --     )
+        --   (sdo M.! ident)
+        GL.drawArraysInstanced GL.Triangles 0 6 (fromIntegral cattyness)
+        -- GL.drawElementsInstanced GL.Triangles 6 GL.UnsignedInt (nullPtr `plusPtr` 1) 9999
+        -- GLRaw.glDrawElementsInstanced GLRaw.GL_TRIANGLES 6 GLRaw.GL_UNSIGNED_INT nullPtr 9999
         clean
           (head (sdo M.! ident))
         )

app/Renderer.hs

@@ -1,9 +1,11 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE BangPatterns #-}
 module Renderer where
 
 import SDL (($=))
 
 import qualified Graphics.Rendering.OpenGL as GL
+import qualified Graphics.GL.Functions as GLRaw (glVertexAttribDivisor)
 import qualified Graphics.GLUtil as GLU
 
 import qualified Data.Map.Strict as M
@@ -16,18 +18,36 @@ import Linear
 
 import Foreign
 
+import Control.Monad (replicateM)
+
+import System.Random
+
 -- internal imports
 
 import Types
 
-initSpriteRenderObjects = do
+initSpriteRenderObjects aggModel = do
   quadVAO <- GL.genObjectName
   quadVBO <- GL.genObjectName
+  quadInstances <- GL.genObjectName
+
+
+  GL.bindBuffer GL.ArrayBuffer $= Just quadInstances
+
+  withArray aggModel $ \ptr ->
+    GL.bufferData GL.ArrayBuffer $=
+      ( fromIntegral $ length aggModel * sizeOf (undefined :: Float)
+      , ptr
+      , GL.StaticDraw
+      )
+
+  GL.bindBuffer GL.ArrayBuffer $= Nothing
 
   GL.bindBuffer GL.ArrayBuffer $= Just quadVBO
+
   withArray rawVertices $ \ptr ->
     GL.bufferData GL.ArrayBuffer $=
-      ( fromIntegral $ length rawVertices * sizeOf (0 :: Float)
+      ( fromIntegral $ length rawVertices * sizeOf (undefined :: Float)
       , ptr
       , GL.StaticDraw
       )
@@ -38,9 +58,32 @@ initSpriteRenderObjects = do
 
   GL.vertexAttribPointer (GL.AttribLocation 0) $=
     ( GL.ToFloat
-    , GL.VertexArrayDescriptor 4 GL.Float 0 (plusPtr nullPtr 0)
+    , GL.VertexArrayDescriptor 4 GL.Float 0 (nullPtr)
     )
 
+  mapM_
+    (\intId -> do
+      GL.bindBuffer GL.ArrayBuffer $= Just quadInstances
+
+      GL.vertexAttribArray (GL.AttribLocation (3 + fromIntegral intId)) $=
+        GL.Enabled
+ 
+      GL.vertexAttribPointer (GL.AttribLocation (3 + fromIntegral intId)) $=
+        ( GL.ToFloat
+        , GL.VertexArrayDescriptor
+          4
+          GL.Float
+          (fromIntegral $ 4 * 4 * (sizeOf (undefined :: GL.GLfloat)))
+          (nullPtr `plusPtr` (intId * 4 * sizeOf (undefined :: GL.GLfloat)))
+        )
+
+      GL.bindBuffer GL.ArrayBuffer $= Nothing
+
+      GLRaw.glVertexAttribDivisor (3 + fromIntegral intId) 1
+      )
+    ([ 0 .. 3 ] :: [Int])
+
+
   -- GL.bindBuffer GL.ArrayBuffer $= Nothing
   GL.bindVertexArrayObject $= Nothing
 
@@ -95,19 +138,48 @@ loadTex fp = do
   let size = V2 (imageWidth img) (imageHeight img)
   return (t, size)
 
-loadSprites :: IO (AssetDetails SpriteRenderObjects SpriteShaderObjects Sprite)
-loadSprites = do
+loadSprites
+  :: Int
+  -> IO (AssetDetails SpriteRenderObjects SpriteShaderObjects Sprite)
+loadSprites amount = do
   let lookups =
         [ ("lynx", "assets/img/lynx.png")
         ]
-      positions =
-        [ (V2 0 0)
-        ]
+      -- positions =
+      --   [ (V2 0 0)
+      --   ]
 
-  vertObj <- initSpriteRenderObjects
-  shadObj <- initSpriteShaderObjects
   textObj <- initSpriteTextureObjects lookups
 
+  positions <- replicateM amount $ do
+    x <- randomRIO (-1, 1)
+    y <- randomRIO (-1, 1)
+    return (V2 x y)
+  sizes <- mapM
+    (\origSize -> do
+      scale <- randomRIO (0.1, (2 :: Float))
+      return (fmap (scale *) $
+        (fmap fromIntegral origSize) / (V2 980 540))
+      )
+    (replicate amount (snd $ snd $ head $ M.assocs textObj))
+
+  let aggModel :: [Float]
+      !aggModel = foldl
+        (\acc (pos@(V2 px py), size@(V2 sx sy)) ->
+          let qMatrix =
+                [ sx,  0,  0,  0
+                , 0,  sy,  0,  0
+                , 0,  0,  1,  0
+                , fromIntegral px, fromIntegral py,  0,  1
+                ]
+          in (acc ++ qMatrix)
+          )
+        []
+        (zip positions sizes)
+
+  vertObj <- initSpriteRenderObjects aggModel
+  shadObj <- initSpriteShaderObjects
+
   return AssetDetails
     { adVertObj = vertObj
     , adShadObj = shadObj

app/Types/Sprite.hs

@@ -43,6 +43,8 @@ instance Renderable Sprite where
       GL.activeTexture $= GL.TextureUnit 0
       GL.textureBinding GL.Texture2D $= Just texture
       GL.clearColor $= GL.Color4 1 1 1 1
+      -- let projection = ortho (-960) 960 (-540) 540 (-1) 1 :: M44 Float
+      -- GLU.setUniform prog "projection" (projection)
 
   draw
     (SpriteRenderObjects vao vbo)
@@ -55,8 +57,8 @@ instance Renderable Sprite where
             (V4 0 0 1 0)
             (V4 0 0 0 1)
             :: M44 Float
-          projection = ortho (-1920) 1920 (-1080) 1080 (-1) 1
-      putStrLn $ show model
+          projection = ortho (-960) 960 (-540) 540 (-1) 1
+      -- putStrLn $ show model
       GLU.setUniform prog "pm" (projection !*! model)
       GL.drawArrays GL.Triangles 0 6
 

cabal.project

@@ -1,3 +1,4 @@
 packages:
   ./
   ../affection
+profiling: true

canvas.cabal

@@ -30,6 +30,7 @@ executable canvas
                      , affection
                      , sdl2 ^>=2.5.0.0
                      , OpenGL
+                     , OpenGLRaw
                      , GLUtil
                      , JuicyPixels
                      , JuicyPixels-extra
@@ -37,5 +38,6 @@ executable canvas
                      , containers
                      , linear
                      , bytestring
+                     , random
   hs-source-dirs:      app
   default-language:    Haskell2010

default.nix

@@ -47,6 +47,10 @@ let
       happy
     ];
     modules = [
+      {
+        enableExecutableProfiling = true;
+        enableLibraryProfiling = true;
+      }
       # specific package overrides would go here
       # example:
       #  packages.cbors.package.ghcOptions = "-Werror";

shader/vertex.sl

@@ -1,14 +1,17 @@
 #version 330 core
 layout (location = 0) in vec4 vertex; // <vec2 position, vec2 texCoords>
+layout (location = 3) in mat4 instanceMatrix;
 
 out vec2 TexCoords;
 
-uniform mat4 pm;
+//uniform mat4 pm;
 //uniform mat4 projection;
 
 void main()
 {
     TexCoords = vertex.zw;
     //gl_Position = projection * model * vec4(vertex.xy, 0.0, 1.0);
-    gl_Position = pm * vec4(vertex.xy, 0.0, 1.0);
+    //gl_Position = pm * vec4(vertex.xy, 0.0, 1.0);
+    //gl_Position = projection * instanceMatrix * vec4(vertex.xy, 0.0, 1.0);
+    gl_Position = instanceMatrix * vec4(vertex.xy, 0.0, 1.0);
 }