realark/instance-render.lisp

## instance-render.lisp
;;;; Proof-of-concept for opengl instance rendering using cl-opengl

(eval-when (:compile-toplevel :load-toplevel)
  (ql:quickload '(:cl-opengl :sdl2 :cl-soil :glkit)))
(defpackage :ark.gl
  (:use :cl))
(in-package :ark.gl)

(require :sdl2)
(require :cl-opengl)

;;;; gl utils

(defun assert-no-shader-errors (shader-id)
  (let ((success (cffi:foreign-alloc :int :initial-element 0)))
    (unwind-protect
         (progn
           (%gl:get-shader-iv shader-id :compile-status success)
           (when (/= 1 (cffi:mem-aref success :int))
             (error "OpenGl error:~%~A" (gl:get-shader-info-log shader-id))))
      (cffi:foreign-free success))))

(defun assert-no-program-errors (program-id)
  (let ((success (cffi:foreign-alloc :int :initial-element 0)))
    (unwind-protect
         (progn
           (%gl:get-program-iv program-id :link-status success)
           (when (/= 1 (cffi:mem-aref success :int))
             (error "OpenGl error:~%~A" (gl:get-program-info-log program-id))))
      (cffi:foreign-free success))))

(defun make-shader (vertex-source-file fragment-source-file)
  "Create a shader from the source files. Must be called with an opengl constant present."
  (assert (probe-file vertex-source-file))
  (assert (probe-file fragment-source-file))
  (let ((vertex-source-code (uiop:read-file-string vertex-source-file))
        (fragment-source-code (uiop:read-file-string fragment-source-file))
        (vertex-shader (gl:create-shader :vertex-shader))
        (fragment-shader (gl:create-shader :fragment-shader)))
    (unwind-protect
         (progn
           (gl:shader-source vertex-shader vertex-source-code)
           (gl:compile-shader vertex-shader)
           (assert-no-shader-errors vertex-shader)

           (gl:shader-source fragment-shader fragment-source-code)
           (gl:compile-shader fragment-shader)
           (assert-no-shader-errors fragment-shader)

           (let ((shader-program-id (gl:create-program)))
             (gl:attach-shader shader-program-id vertex-shader)
             (gl:attach-shader shader-program-id fragment-shader)
             (gl:link-program shader-program-id)
             (assert-no-program-errors shader-program-id)
             shader-program-id))
      (gl:delete-shader vertex-shader)
      (gl:delete-shader fragment-shader))))

(defun make-texture-from-png (path-to-png)
  (assert (probe-file path-to-png))
  (let ((texture-id (gl:gen-texture))
        (texture-parameters
         '(:texture-wrap-s :repeat
           :texture-wrap-t :repeat
           :texture-min-filter :nearest
           :texture-mag-filter :nearest)))
    (handler-case
        (multiple-value-bind
              (img-pointer width height component-count-file component-count-data)
            (cl-soil:load-image path-to-png :rgba)
          (gl:bind-texture :texture-2d texture-id)
          (unwind-protect
               (progn
                 (assert (= 4 component-count-file component-count-data))
                 (gl:tex-image-2d :texture-2d 0 :rgba width height 0 :rgba :unsigned-byte img-pointer :raw t)
                 (gl:generate-mipmap :texture-2d))
            (cl-soil:free-image-data img-pointer))

          (loop :for (gl-texture-param gl-texture-param-val) :on texture-parameters :by #'cddr :do
               (gl:tex-parameter :texture-2d gl-texture-param gl-texture-param-val))
          texture-id)
      (error (e)
        (gl:delete-texture texture-id)
        (gl:bind-texture :texture-2d 0)
        (error e)))))

(defun alloc-gl-array (type &rest data)
  (declare (dynamic-extent data))
  (loop :with gl-array = (gl:alloc-gl-array type (length data))
     :for val :in data
     :for i :from 0 :do
       (setf (gl:glaref gl-array i) val)
     :finally (return gl-array)))

;;;; frame timer
(defclass frame-timer ()
  ((current-batch-start-timestamp :initform nil)
   (current-frame-start-timestamp :initform nil)
   (frame-samples :initform (make-array 1000 :element-type 'fixnum :adjustable t :fill-pointer 0))))

(defun frame-timer-start (frame-timer)
  (let ((now (sdl2:get-ticks)))
    (with-slots (current-batch-start-timestamp current-frame-start-timestamp) frame-timer
      (when current-frame-start-timestamp
        (error "frame timer already started"))
      (unless current-batch-start-timestamp
        (setf current-batch-start-timestamp now))
      (setf current-frame-start-timestamp now))))

(defun frame-timer-stop (frame-timer)
  (with-slots (frame-samples current-frame-start-timestamp) frame-timer
    (unless current-frame-start-timestamp
      (error "frame timer not started"))
    (let ((delta (- (sdl2:get-ticks) current-frame-start-timestamp)))
      (setf current-frame-start-timestamp nil)
      (vector-push-extend delta frame-samples))))

(defun frame-timer-reset (frame-timer)
  (with-slots (frame-samples current-frame-start-timestamp  current-batch-start-timestamp) frame-timer
    (when current-frame-start-timestamp
      (error "cannot reset in the middle of a frame measure"))
    (setf (fill-pointer frame-samples) 0
          current-batch-start-timestamp nil)))

(defun frame-timer-get-batch-measurements (frame-timer)
  (with-slots (frame-samples current-batch-start-timestamp  current-frame-start-timestamp) frame-timer
    (when current-frame-start-timestamp
      (error "cannot get measurements in the middle of a frame measure"))
    (unless current-batch-start-timestamp
      (error "no frames to report"))
    (let ((frame-sum 0)
          (max-frame -1)
          (batch-delta-seconds (/ (- (sdl2:get-ticks) current-batch-start-timestamp) 1000.0)))
      (loop :for frame :across frame-samples :do
           (incf frame-sum frame)
           (when (> frame max-frame)
             (setf max-frame frame)))
      (values (floor (/ (length frame-samples) batch-delta-seconds))
              (float (/ frame-sum (length frame-samples)))
              max-frame))))

;;;; non-instance rendering

(defun make-sprite-vao ()
  (let ((gl-vertices (alloc-gl-array  :float
                                      ;; render sprites from upper-left coords
                                      ;; positions             texture coords
                                       1.0   1.0  0.0          1.0  0.0 ; top right
                                       1.0   0.0  0.0          1.0 -1.0 ; bottom right
                                       0.0   0.0  0.0          0.0 -1.0 ; bottom left
                                       0.0   1.0  0.0          0.0  0.0 ; top left
                                      ;; -0.5   -0.5  0.0        1.0  0.0 ; left
                                      ;; 0.5  -0.5  0.0           1.0 -1.0 ; right
                                      ;; 0.0  0.5  0.0          0.0 -1.0 ; top
                                      )))
    (unwind-protect
         (let ((vao (gl:gen-vertex-array))
               (vbo (gl:gen-buffer)))

           (gl:bind-vertex-array vao)

           ;; put the vertices in the VBO
           (gl:bind-buffer :array-buffer vbo)
           (gl:buffer-data :array-buffer :static-draw gl-vertices)

           ;; position
           (gl:vertex-attrib-pointer 0 3 :float 0 (* 5 (cffi:foreign-type-size :float)) (* 0 (cffi:foreign-type-size :float)))
           (gl:enable-vertex-attrib-array 0)
           ;; texture coord
           (gl:vertex-attrib-pointer 1 2 :float 0 (* 5 (cffi:foreign-type-size :float)) (* 3 (cffi:foreign-type-size :float)))
           (gl:enable-vertex-attrib-array 1)

           ;; note: this is okay because vertex-attrib-pointer binds the vertex shader's input
           (gl:bind-buffer :array-buffer 0)
           (values vao vbo))
      (gl:free-gl-array gl-vertices))))

(defun sprite-transform (x y w h)
  "Construct a scale and translation matrix."
  (declare (optimize (speed 3)))
  (let ((translate (sb-cga:translate* x y 0.0))
        (dimensions (sb-cga:scale* w h 1.0)))
    ;; (declare (dynamic-extent translate dimensions))
    (sb-cga:matrix* translate
                    dimensions)))

(defun non-instanced-sprit-rendering ()
  (sdl2:with-init (:everything)
    (format t "Using SDL Library Version: ~D.~D.~D~%"
            sdl2-ffi:+sdl-major-version+
            sdl2-ffi:+sdl-minor-version+
            sdl2-ffi:+sdl-patchlevel+)
    (progn
      ;; https://wiki.libsdl.org/SDL_GLattr
      ;; https://wiki.libsdl.org/SDL_GLprofile
      (sdl2:gl-set-attr :context-major-version 3)
      (sdl2:gl-set-attr :context-minor-version 3)
      (sdl2:gl-set-attr :context-profile-mask
                        sdl2-ffi:+sdl-gl-context-profile-core+)
      (sdl2:gl-set-attr :doublebuffer 1))

    (cffi:with-foreign-strings ((hint-name "SDL_VIDEO_X11_NET_WM_BYPASS_COMPOSITOR")
                                (hint-val "0"))
      ;; prevent SDL from disabling the linux compositor
      (sdl2-ffi.functions:sdl-set-hint hint-name hint-val))

    (let ((window-width 800)
          (window-height 600))
      (sdl2:with-window (win :title "Non-instanced rendering" :w window-width :h window-height :flags '(:shown :opengl))
        (sdl2:with-gl-context (gl-context win)
          (format t "Setting up window/gl.~%")
          (progn
            (sdl2:gl-make-current win gl-context)
            ;; https://wiki.libsdl.org/SDL_GL_SetSwapInterval#Remarks
            ;; first try for adaptive vsync
            ;; note: using the ffi directly to bypass the rc assertion in wrapper library
            (gl:viewport 0 0 window-width window-height)

            ;; (when (= -1 (sdl2::sdl-gl-set-swap-interval -1))
            ;;   (sdl2::sdl-gl-set-swap-interval 1))
            (sdl2::sdl-gl-set-swap-interval 0) ; disable vsync to max out the FPS
            (format T "window swap interval (vsync): ~A~%" (sdl2:gl-get-swap-interval)))

          (gl:clear-color 0.0 1.0 1.0 1.0)

          (let ((sprite-program-id (make-shader "sprite-shader.vert" "sprite-shader.frag"))
                (texture-id (make-texture-from-png "rectangle.png"))
                (camera (kit.glm:ortho-matrix 0 window-width window-height 0 100.0 -100.0))
                (frame-timer (make-instance 'frame-timer))
                (frame-measure-period 3000)
                (measure-start-timestamp (sdl2:get-ticks)))
            (multiple-value-bind (vao vbo) (make-sprite-vao)
              (format t "Created shader: ~A~%" sprite-program-id)
              (labels ((render-rect (x y w h)
                         (let ((model (sprite-transform x y w h)))
                           (block prepare
                             (gl:use-program sprite-program-id)
                             (gl:uniformf
                              (gl:get-uniform-location sprite-program-id "spriteColorMod")
                              1.0 1.0 1.0 1.0)

                             (gl:uniform-matrix-4fv
                              (gl:get-uniform-location sprite-program-id "worldModel")
                              model
                              nil)

                             (gl:uniform-matrix-4fv
                              (gl:get-uniform-location sprite-program-id "worldProjection")
                              camera
                              nil)

                             (gl:bind-texture :texture-2d texture-id)
                             (gl:bind-vertex-array vao))

                           (block render
                             (gl:draw-arrays :triangle-fan 0 4)))))
                (sb-ext:gc :full t)
                ;; main loop
                (sdl2:with-event-loop (:method :poll)
                  (:keydown (:keysym keysym)
                            (let ((scancode (sdl2:scancode-value keysym))
                                  (sym (sdl2:sym-value keysym))
                                  (mod-value (sdl2:mod-value keysym)))
                              (declare (ignore sym mod-value))
                              (cond
                                ((sdl2:scancode= scancode :scancode-q) (sdl2:push-event :quit)))))
                  (:idle ()
                         (sb-sys:without-gcing
                           (gl:clear :color-buffer-bit)

                           (frame-timer-start frame-timer)
                           (let* ((rect-w 15.0)
                                  (rect-h 15.0)
                                  (padding 1.0)
                                  (num-cols (floor window-height (+ rect-h padding)))
                                  (num-rows (floor window-width (+ rect-w padding))))
                             (loop :for row :from 0 :below num-cols :do
                                  (loop :for col :from 0 :below num-rows :do
                                       (render-rect (+ (* rect-w col) (* padding col))
                                                    (+ (* rect-h row) (* padding row))
                                                    rect-w
                                                    rect-h))))
                           (frame-timer-stop frame-timer)
                           (sdl2:gl-swap-window win)
                           ;; (sb-ext:gc)

                           (let* ((now (sdl2:get-ticks))
                                  (delta (- now measure-start-timestamp)))
                             (when (>= delta frame-measure-period)
                               (multiple-value-bind (fps frame-avg-ms worst-frame-ms)
                                   (frame-timer-get-batch-measurements frame-timer)
                                 (format t
                                         "~%frame stats~%  fps: ~A~%  avg: ~A~%  max: ~A~%"
                                         fps
                                         frame-avg-ms
                                         worst-frame-ms)
                                 (finish-output))
                               (setf measure-start-timestamp (sdl2:get-ticks))
                               (frame-timer-reset frame-timer)))))

                  (:quit () t)))
              (progn                    ; cleanup
                ;; the removal of the gl contaxt makes this cleanup code unnecessary, but
                ;; showing for completness.
                (gl:delete-vertex-arrays (list vao))
                (gl:delete-buffers (list vbo))
                (gl:delete-texture texture-id)
                (gl:delete-program sprite-program-id))))
          (format t "Done!~%"))))))

;;;; instanced rendering

(defun make-instanced-sprite-vao (c-rect-array)
  (let ((gl-vertices (alloc-gl-array  :float
                                      ;; render sprites from upper-left coords
                                      ;; positions             texture coords
                                       1.0   1.0  0.0          1.0  0.0 ; top right
                                       1.0   0.0  0.0          1.0 -1.0 ; bottom right
                                       0.0   0.0  0.0          0.0 -1.0 ; bottom left
                                       0.0   1.0  0.0          0.0  0.0 ; top left
                                      ;; -0.5   -0.5  0.0        1.0  0.0 ; left
                                      ;; 0.5  -0.5  0.0           1.0 -1.0 ; right
                                      ;; 0.0  0.5  0.0          0.0 -1.0 ; top
                                      )))
    (unwind-protect
         (let ((instance-vbo (gl:gen-buffer)))
           (gl:bind-buffer :array-buffer instance-vbo)
           (gl:buffer-data :array-buffer :dynamic-draw c-rect-array)
           (gl:bind-buffer :array-buffer 0)
           (let ((vao (gl:gen-vertex-array))
                 (vbo (gl:gen-buffer)))

             (gl:bind-vertex-array vao)
             ;; put the vertices in the VBO
             (gl:bind-buffer :array-buffer vbo)
             (gl:buffer-data :array-buffer :static-draw gl-vertices)

             ;; position
             (gl:vertex-attrib-pointer 0 3 :float 0 (* 5 (cffi:foreign-type-size :float)) (* 0 (cffi:foreign-type-size :float)))
             (gl:enable-vertex-attrib-array 0)
             ;; texture coord
             (gl:vertex-attrib-pointer 1 2 :float 0 (* 5 (cffi:foreign-type-size :float)) (* 3 (cffi:foreign-type-size :float)))
             (gl:enable-vertex-attrib-array 1)

             (gl:bind-buffer :array-buffer instance-vbo)
             (gl:enable-vertex-attrib-array 2)
             ;; Note: max vertex attrib size is 4, so we have to break out the data into 4 separate attribs
             ;; inside the shader we can reference the first index as a mat4 and everything works
             ;; (gl:vertex-attrib-pointer 2 16 :float 0 (* 16 (cffi:foreign-type-size :float)) (* 0 (cffi:foreign-type-size :float)))
             (gl:vertex-attrib-pointer 2 4 :float 0 (* 16 (cffi:foreign-type-size :float)) (* 0 4 (cffi:foreign-type-size :float)))
             (gl:enable-vertex-attrib-array 3)
             (gl:vertex-attrib-pointer 3 4 :float 0 (* 16 (cffi:foreign-type-size :float)) (* 1 4 (cffi:foreign-type-size :float)))
             (gl:enable-vertex-attrib-array 4)
             (gl:vertex-attrib-pointer 4 4 :float 0 (* 16 (cffi:foreign-type-size :float)) (* 2 4 (cffi:foreign-type-size :float)))
             (gl:enable-vertex-attrib-array 5)
             (gl:vertex-attrib-pointer 5 4 :float 0 (* 16 (cffi:foreign-type-size :float)) (* 3 4 (cffi:foreign-type-size :float)))

             (gl:bind-buffer :array-buffer 0)
             (%gl:vertex-attrib-divisor 2 1)
             (%gl:vertex-attrib-divisor 3 1)
             (%gl:vertex-attrib-divisor 4 1)
             (%gl:vertex-attrib-divisor 5 1)
             (values vao vbo instance-vbo)))
      (gl:free-gl-array gl-vertices))))

(defun instanced-sprit-rendering ()
  (sdl2:with-init (:everything)
    (format t "Using SDL Library Version: ~D.~D.~D~%"
            sdl2-ffi:+sdl-major-version+
            sdl2-ffi:+sdl-minor-version+
            sdl2-ffi:+sdl-patchlevel+)
    (progn
      ;; https://wiki.libsdl.org/SDL_GLattr
      ;; https://wiki.libsdl.org/SDL_GLprofile
      (sdl2:gl-set-attr :context-major-version 3)
      (sdl2:gl-set-attr :context-minor-version 3)
      (sdl2:gl-set-attr :context-profile-mask
                        sdl2-ffi:+sdl-gl-context-profile-core+)
      (sdl2:gl-set-attr :doublebuffer 1))

    (cffi:with-foreign-strings ((hint-name "SDL_VIDEO_X11_NET_WM_BYPASS_COMPOSITOR")
                                (hint-val "0"))
      ;; prevent SDL from disabling the linux compositor
      (sdl2-ffi.functions:sdl-set-hint hint-name hint-val))

    (let ((window-width 800)
          (window-height 600))
      (sdl2:with-window (win :title "Instanced Rendering" :w window-width :h window-height :flags '(:shown :opengl))
        (sdl2:with-gl-context (gl-context win)
          (format t "Setting up window/gl.~%")
          (progn
            (sdl2:gl-make-current win gl-context)
            ;; https://wiki.libsdl.org/SDL_GL_SetSwapInterval#Remarks
            ;; first try for adaptive vsync
            ;; note: using the ffi directly to bypass the rc assertion in wrapper library
            (gl:viewport 0 0 window-width window-height)

            ;; (when (= -1 (sdl2::sdl-gl-set-swap-interval -1))
            ;;   (sdl2::sdl-gl-set-swap-interval 1))
            (sdl2::sdl-gl-set-swap-interval 0) ; disable vsync to max out the FPS
            (format T "window swap interval (vsync): ~A~%" (sdl2:gl-get-swap-interval)))

          (gl:clear-color 0.0 1.0 1.0 1.0)

          (let* ((sprite-program-id (make-shader "instancing.vert" "instancing.frag"))
                 (texture-id (make-texture-from-png "rectangle.png"))
                 (camera (kit.glm:ortho-matrix 0 window-width window-height 0 100.0 -100.0))
                 (frame-timer (make-instance 'frame-timer))
                 (frame-measure-period 3000)
                 (measure-start-timestamp (sdl2:get-ticks))
                 (num-rects 1850)
                 (c-rect-transforms
                  ;; TODO: hardcoding 1850 rectangles
                  (gl:alloc-gl-array :float
                                     (* num-rects ; total num rects
                                        ;; each transform is a 4x4 matrix
                                        16))))
            (multiple-value-bind (vao vbo instance-vbo) (make-instanced-sprite-vao c-rect-transforms)
              (format t "Created shader: ~A~%" sprite-program-id)
              (sb-ext:gc :full t)
              ;; main loop
              (sdl2:with-event-loop (:method :poll)
                (:keydown (:keysym keysym)
                          (let ((scancode (sdl2:scancode-value keysym))
                                (sym (sdl2:sym-value keysym))
                                (mod-value (sdl2:mod-value keysym)))
                            (declare (ignore sym mod-value))
                            (cond
                              ((sdl2:scancode= scancode :scancode-q) (sdl2:push-event :quit)))))
                (:idle ()
                       (sb-sys:without-gcing
                         (gl:clear :color-buffer-bit)

                         (frame-timer-start frame-timer)
                         (let* ((rect-w 15.0)
                                (rect-h 15.0)
                                (padding 1.0)
                                (num-cols (floor window-height (+ rect-h padding)))
                                (num-rows (floor window-width (+ rect-w padding)))
                                (instance-id 0))
                           (unless (= num-rects (* num-cols num-rows))
                             (error "unexpected number of rectangles: ~A" (* num-cols num-rows)))
                           (loop :for row :from 0 :below num-cols :do
                                (loop :for col :from 0 :below num-rows :do
                                     (let ((model (sprite-transform
                                                   (+ (* rect-w col) (* padding col))
                                                   (+ (* rect-h row) (* padding row))
                                                   rect-w
                                                   rect-h)))
                                       (loop :for i :from 0 :below (length model) :do
                                            (setf (gl:glaref c-rect-transforms (+ i (* instance-id (length model))))
                                                  (elt model i)))
                                       (incf instance-id))))
                           (when (> instance-id 0)
                             (gl:bind-buffer :array-buffer instance-vbo)
                             (gl:buffer-data :array-buffer :dynamic-draw c-rect-transforms)

                             (gl:use-program sprite-program-id)
                             (gl:uniformf
                              (gl:get-uniform-location sprite-program-id "spriteColorMod")
                              1.0 1.0 1.0 1.0)
                             (gl:uniform-matrix-4fv
                              (gl:get-uniform-location sprite-program-id "worldProjection")
                              camera
                              nil)
                             (gl:bind-texture :texture-2d texture-id)
                             (gl:bind-vertex-array vao)

                             (gl:draw-arrays-instanced :triangle-fan 0 4 instance-id)))
                         (frame-timer-stop frame-timer)
                         (sdl2:gl-swap-window win)

                         (let* ((now (sdl2:get-ticks))
                                (delta (- now measure-start-timestamp)))
                           (when (>= delta frame-measure-period)
                             (multiple-value-bind (fps frame-avg-ms worst-frame-ms)
                                 (frame-timer-get-batch-measurements frame-timer)
                               (format t
                                       "~%frame stats~%  fps: ~A~%  avg: ~A~%  max: ~A~%"
                                       fps
                                       frame-avg-ms
                                       worst-frame-ms)
                               (finish-output))
                             (setf measure-start-timestamp (sdl2:get-ticks))
                             (frame-timer-reset frame-timer)))))
                (:quit () t))
              (progn                    ; cleanup
                ;; the removal of the gl contaxt makes this cleanup code unnecessary, but
                ;; showing for completness.
                (when c-rect-transforms
                  (gl:free-gl-array c-rect-transforms))
                (gl:delete-vertex-arrays (list vao))
                (gl:delete-buffers (list vbo instance-vbo))
                (gl:delete-texture texture-id)
                (gl:delete-program sprite-program-id))))
          (format t "Done!~%"))))))

## instancing.frag
#version 330 core
out vec4 FragColor;

// data from vertex shader
in VertexData {
  vec2 textureCoords;
} fragmentData;

// texture sampler
uniform sampler2D ourTexture;
uniform vec4 spriteColorMod;

void main()
{
  vec4 texColor = texture(ourTexture, fragmentData.textureCoords);
  // FragColor = spriteColorMod * colorMappedTexture;
  FragColor = vec4(0.0, 0.0, 1.0, 1.0);
}

## instancing.vert
#version 330 core
layout (location = 0) in vec3 screenPos;
layout (location = 1) in vec2 srcCoord;
layout (location = 2) in mat4 worldModel;

// data sent to fragment shader
out VertexData {
  vec2 textureCoords;
} vertexData;

uniform mat4 worldProjection;
uniform vec4 spriteSrc;

void main()
{
  float spriteSrcX = spriteSrc.x;
  float spriteSrcY = spriteSrc.y;
  float spriteWidth = spriteSrc.z;
  float spriteHeight = spriteSrc.w;

  vertexData.textureCoords = vec2(spriteSrcX + (srcCoord.x * spriteWidth),
                                  spriteSrcY + (srcCoord.y * spriteHeight));
  gl_Position = worldProjection * worldModel * vec4(screenPos, 1.0);
  // gl_Position = vec4(screenPos, 1.0);
}

## sprite-shader.frag
#version 330 core
out vec4 FragColor;

// data from vertex shader
in VertexData {
  vec2 textureCoords;
} fragmentData;

// texture sampler
uniform sampler2D ourTexture;
uniform vec4 spriteColorMod;

void main()
{
  vec4 texColor = texture(ourTexture, fragmentData.textureCoords);
  // FragColor = spriteColorMod * colorMappedTexture;
  FragColor = vec4(1.0, 0.0, 0.0, 1.0);
}

## sprite-shader.vert
#version 330 core
layout (location = 0) in vec3 screenPos;
layout (location = 1) in vec2 srcCoord;

// data sent to fragment shader
out VertexData {
  vec2 textureCoords;
} vertexData;

uniform mat4 worldModel;
uniform mat4 worldProjection;
uniform vec4 spriteSrc;

void main()
{
  float spriteSrcX = spriteSrc.x;
  float spriteSrcY = spriteSrc.y;
  float spriteWidth = spriteSrc.z;
  float spriteHeight = spriteSrc.w;

  vertexData.textureCoords = vec2(spriteSrcX + (srcCoord.x * spriteWidth),
                                  spriteSrcY + (srcCoord.y * spriteHeight));
  gl_Position = worldProjection * worldModel * vec4(screenPos, 1.0);
  // gl_Position = vec4(screenPos, 1.0);
}
	;;;; Proof-of-concept for opengl instance rendering using cl-opengl

	(eval-when (:compile-toplevel :load-toplevel)
	(ql:quickload '(:cl-opengl :sdl2 :cl-soil :glkit)))
	(defpackage :ark.gl
	(:use :cl))
	(in-package :ark.gl)

	(require :sdl2)
	(require :cl-opengl)

	;;;; gl utils

	(defun assert-no-shader-errors (shader-id)
	(let ((success (cffi:foreign-alloc :int :initial-element 0)))
	(unwind-protect
	(progn
	(%gl:get-shader-iv shader-id :compile-status success)
	(when (/= 1 (cffi:mem-aref success :int))
	(error "OpenGl error:~%~A" (gl:get-shader-info-log shader-id))))
	(cffi:foreign-free success))))

	(defun assert-no-program-errors (program-id)
	(let ((success (cffi:foreign-alloc :int :initial-element 0)))
	(unwind-protect
	(progn
	(%gl:get-program-iv program-id :link-status success)
	(when (/= 1 (cffi:mem-aref success :int))
	(error "OpenGl error:~%~A" (gl:get-program-info-log program-id))))
	(cffi:foreign-free success))))

	(defun make-shader (vertex-source-file fragment-source-file)
	"Create a shader from the source files. Must be called with an opengl constant present."
	(assert (probe-file vertex-source-file))
	(assert (probe-file fragment-source-file))
	(let ((vertex-source-code (uiop:read-file-string vertex-source-file))
	(fragment-source-code (uiop:read-file-string fragment-source-file))
	(vertex-shader (gl:create-shader :vertex-shader))
	(fragment-shader (gl:create-shader :fragment-shader)))
	(unwind-protect
	(progn
	(gl:shader-source vertex-shader vertex-source-code)
	(gl:compile-shader vertex-shader)
	(assert-no-shader-errors vertex-shader)

	(gl:shader-source fragment-shader fragment-source-code)
	(gl:compile-shader fragment-shader)
	(assert-no-shader-errors fragment-shader)

	(let ((shader-program-id (gl:create-program)))
	(gl:attach-shader shader-program-id vertex-shader)
	(gl:attach-shader shader-program-id fragment-shader)
	(gl:link-program shader-program-id)
	(assert-no-program-errors shader-program-id)
	shader-program-id))
	(gl:delete-shader vertex-shader)
	(gl:delete-shader fragment-shader))))

	(defun make-texture-from-png (path-to-png)
	(assert (probe-file path-to-png))
	(let ((texture-id (gl:gen-texture))
	(texture-parameters
	'(:texture-wrap-s :repeat
	:texture-wrap-t :repeat
	:texture-min-filter :nearest
	:texture-mag-filter :nearest)))
	(handler-case
	(multiple-value-bind
	(img-pointer width height component-count-file component-count-data)
	(cl-soil:load-image path-to-png :rgba)
	(gl:bind-texture :texture-2d texture-id)
	(unwind-protect
	(progn
	(assert (= 4 component-count-file component-count-data))
	(gl:tex-image-2d :texture-2d 0 :rgba width height 0 :rgba :unsigned-byte img-pointer :raw t)
	(gl:generate-mipmap :texture-2d))
	(cl-soil:free-image-data img-pointer))

	(loop :for (gl-texture-param gl-texture-param-val) :on texture-parameters :by #'cddr :do
	(gl:tex-parameter :texture-2d gl-texture-param gl-texture-param-val))
	texture-id)
	(error (e)
	(gl:delete-texture texture-id)
	(gl:bind-texture :texture-2d 0)
	(error e)))))

	(defun alloc-gl-array (type &rest data)
	(declare (dynamic-extent data))
	(loop :with gl-array = (gl:alloc-gl-array type (length data))
	:for val :in data
	:for i :from 0 :do
	(setf (gl:glaref gl-array i) val)
	:finally (return gl-array)))

	;;;; frame timer
	(defclass frame-timer ()
	((current-batch-start-timestamp :initform nil)
	(current-frame-start-timestamp :initform nil)
	(frame-samples :initform (make-array 1000 :element-type 'fixnum :adjustable t :fill-pointer 0))))

	(defun frame-timer-start (frame-timer)
	(let ((now (sdl2:get-ticks)))
	(with-slots (current-batch-start-timestamp current-frame-start-timestamp) frame-timer
	(when current-frame-start-timestamp
	(error "frame timer already started"))
	(unless current-batch-start-timestamp
	(setf current-batch-start-timestamp now))
	(setf current-frame-start-timestamp now))))

	(defun frame-timer-stop (frame-timer)
	(with-slots (frame-samples current-frame-start-timestamp) frame-timer
	(unless current-frame-start-timestamp
	(error "frame timer not started"))
	(let ((delta (- (sdl2:get-ticks) current-frame-start-timestamp)))
	(setf current-frame-start-timestamp nil)
	(vector-push-extend delta frame-samples))))

	(defun frame-timer-reset (frame-timer)
	(with-slots (frame-samples current-frame-start-timestamp current-batch-start-timestamp) frame-timer
	(when current-frame-start-timestamp
	(error "cannot reset in the middle of a frame measure"))
	(setf (fill-pointer frame-samples) 0
	current-batch-start-timestamp nil)))

	(defun frame-timer-get-batch-measurements (frame-timer)
	(with-slots (frame-samples current-batch-start-timestamp current-frame-start-timestamp) frame-timer
	(when current-frame-start-timestamp
	(error "cannot get measurements in the middle of a frame measure"))
	(unless current-batch-start-timestamp
	(error "no frames to report"))
	(let ((frame-sum 0)
	(max-frame -1)
	(batch-delta-seconds (/ (- (sdl2:get-ticks) current-batch-start-timestamp) 1000.0)))
	(loop :for frame :across frame-samples :do
	(incf frame-sum frame)
	(when (> frame max-frame)
	(setf max-frame frame)))
	(values (floor (/ (length frame-samples) batch-delta-seconds))
	(float (/ frame-sum (length frame-samples)))
	max-frame))))

	;;;; non-instance rendering

	(defun make-sprite-vao ()
	(let ((gl-vertices (alloc-gl-array :float
	;; render sprites from upper-left coords
	;; positions texture coords
	1.0 1.0 0.0 1.0 0.0 ; top right
	1.0 0.0 0.0 1.0 -1.0 ; bottom right
	0.0 0.0 0.0 0.0 -1.0 ; bottom left
	0.0 1.0 0.0 0.0 0.0 ; top left
	;; -0.5 -0.5 0.0 1.0 0.0 ; left
	;; 0.5 -0.5 0.0 1.0 -1.0 ; right
	;; 0.0 0.5 0.0 0.0 -1.0 ; top
	)))
	(unwind-protect
	(let ((vao (gl:gen-vertex-array))
	(vbo (gl:gen-buffer)))

	(gl:bind-vertex-array vao)

	;; put the vertices in the VBO
	(gl:bind-buffer :array-buffer vbo)
	(gl:buffer-data :array-buffer :static-draw gl-vertices)

	;; position
	(gl:vertex-attrib-pointer 0 3 :float 0 (* 5 (cffi:foreign-type-size :float)) (* 0 (cffi:foreign-type-size :float)))
	(gl:enable-vertex-attrib-array 0)
	;; texture coord
	(gl:vertex-attrib-pointer 1 2 :float 0 (* 5 (cffi:foreign-type-size :float)) (* 3 (cffi:foreign-type-size :float)))
	(gl:enable-vertex-attrib-array 1)

	;; note: this is okay because vertex-attrib-pointer binds the vertex shader's input
	(gl:bind-buffer :array-buffer 0)
	(values vao vbo))
	(gl:free-gl-array gl-vertices))))

	(defun sprite-transform (x y w h)
	"Construct a scale and translation matrix."
	(declare (optimize (speed 3)))
	(let ((translate (sb-cga:translate* x y 0.0))
	(dimensions (sb-cga:scale* w h 1.0)))
	;; (declare (dynamic-extent translate dimensions))
	(sb-cga:matrix* translate
	dimensions)))

	(defun non-instanced-sprit-rendering ()
	(sdl2:with-init (:everything)
	(format t "Using SDL Library Version: ~D.~D.~D~%"
	sdl2-ffi:+sdl-major-version+
	sdl2-ffi:+sdl-minor-version+
	sdl2-ffi:+sdl-patchlevel+)
	(progn
	;; https://wiki.libsdl.org/SDL_GLattr
	;; https://wiki.libsdl.org/SDL_GLprofile
	(sdl2:gl-set-attr :context-major-version 3)
	(sdl2:gl-set-attr :context-minor-version 3)
	(sdl2:gl-set-attr :context-profile-mask
	sdl2-ffi:+sdl-gl-context-profile-core+)
	(sdl2:gl-set-attr :doublebuffer 1))

	(cffi:with-foreign-strings ((hint-name "SDL_VIDEO_X11_NET_WM_BYPASS_COMPOSITOR")
	(hint-val "0"))
	;; prevent SDL from disabling the linux compositor
	(sdl2-ffi.functions:sdl-set-hint hint-name hint-val))

	(let ((window-width 800)
	(window-height 600))
	(sdl2:with-window (win :title "Non-instanced rendering" :w window-width :h window-height :flags '(:shown :opengl))
	(sdl2:with-gl-context (gl-context win)
	(format t "Setting up window/gl.~%")
	(progn
	(sdl2:gl-make-current win gl-context)
	;; https://wiki.libsdl.org/SDL_GL_SetSwapInterval#Remarks
	;; first try for adaptive vsync
	;; note: using the ffi directly to bypass the rc assertion in wrapper library
	(gl:viewport 0 0 window-width window-height)

	;; (when (= -1 (sdl2::sdl-gl-set-swap-interval -1))
	;; (sdl2::sdl-gl-set-swap-interval 1))
	(sdl2::sdl-gl-set-swap-interval 0) ; disable vsync to max out the FPS
	(format T "window swap interval (vsync): ~A~%" (sdl2:gl-get-swap-interval)))

	(gl:clear-color 0.0 1.0 1.0 1.0)

	(let ((sprite-program-id (make-shader "sprite-shader.vert" "sprite-shader.frag"))
	(texture-id (make-texture-from-png "rectangle.png"))
	(camera (kit.glm:ortho-matrix 0 window-width window-height 0 100.0 -100.0))
	(frame-timer (make-instance 'frame-timer))
	(frame-measure-period 3000)
	(measure-start-timestamp (sdl2:get-ticks)))
	(multiple-value-bind (vao vbo) (make-sprite-vao)
	(format t "Created shader: ~A~%" sprite-program-id)
	(labels ((render-rect (x y w h)
	(let ((model (sprite-transform x y w h)))
	(block prepare
	(gl:use-program sprite-program-id)
	(gl:uniformf
	(gl:get-uniform-location sprite-program-id "spriteColorMod")
	1.0 1.0 1.0 1.0)

	(gl:uniform-matrix-4fv
	(gl:get-uniform-location sprite-program-id "worldModel")
	model
	nil)

	(gl:uniform-matrix-4fv
	(gl:get-uniform-location sprite-program-id "worldProjection")
	camera
	nil)

	(gl:bind-texture :texture-2d texture-id)
	(gl:bind-vertex-array vao))

	(block render
	(gl:draw-arrays :triangle-fan 0 4)))))
	(sb-ext:gc :full t)
	;; main loop
	(sdl2:with-event-loop (:method :poll)
	(:keydown (:keysym keysym)
	(let ((scancode (sdl2:scancode-value keysym))
	(sym (sdl2:sym-value keysym))
	(mod-value (sdl2:mod-value keysym)))
	(declare (ignore sym mod-value))
	(cond
	((sdl2:scancode= scancode :scancode-q) (sdl2:push-event :quit)))))
	(:idle ()
	(sb-sys:without-gcing
	(gl:clear :color-buffer-bit)

	(frame-timer-start frame-timer)
	(let* ((rect-w 15.0)
	(rect-h 15.0)
	(padding 1.0)
	(num-cols (floor window-height (+ rect-h padding)))
	(num-rows (floor window-width (+ rect-w padding))))
	(loop :for row :from 0 :below num-cols :do
	(loop :for col :from 0 :below num-rows :do
	(render-rect (+ (* rect-w col) (* padding col))
	(+ (* rect-h row) (* padding row))
	rect-w
	rect-h))))
	(frame-timer-stop frame-timer)
	(sdl2:gl-swap-window win)
	;; (sb-ext:gc)

	(let* ((now (sdl2:get-ticks))
	(delta (- now measure-start-timestamp)))
	(when (>= delta frame-measure-period)
	(multiple-value-bind (fps frame-avg-ms worst-frame-ms)
	(frame-timer-get-batch-measurements frame-timer)
	(format t
	"~%frame stats~% fps: ~A~% avg: ~A~% max: ~A~%"
	fps
	frame-avg-ms
	worst-frame-ms)
	(finish-output))
	(setf measure-start-timestamp (sdl2:get-ticks))
	(frame-timer-reset frame-timer)))))

	(:quit () t)))
	(progn ; cleanup
	;; the removal of the gl contaxt makes this cleanup code unnecessary, but
	;; showing for completness.
	(gl:delete-vertex-arrays (list vao))
	(gl:delete-buffers (list vbo))
	(gl:delete-texture texture-id)
	(gl:delete-program sprite-program-id))))
	(format t "Done!~%"))))))

	;;;; instanced rendering

	(defun make-instanced-sprite-vao (c-rect-array)
	(let ((gl-vertices (alloc-gl-array :float
	;; render sprites from upper-left coords
	;; positions texture coords
	1.0 1.0 0.0 1.0 0.0 ; top right
	1.0 0.0 0.0 1.0 -1.0 ; bottom right
	0.0 0.0 0.0 0.0 -1.0 ; bottom left
	0.0 1.0 0.0 0.0 0.0 ; top left
	;; -0.5 -0.5 0.0 1.0 0.0 ; left
	;; 0.5 -0.5 0.0 1.0 -1.0 ; right
	;; 0.0 0.5 0.0 0.0 -1.0 ; top
	)))
	(unwind-protect
	(let ((instance-vbo (gl:gen-buffer)))
	(gl:bind-buffer :array-buffer instance-vbo)
	(gl:buffer-data :array-buffer :dynamic-draw c-rect-array)
	(gl:bind-buffer :array-buffer 0)
	(let ((vao (gl:gen-vertex-array))
	(vbo (gl:gen-buffer)))

	(gl:bind-vertex-array vao)
	;; put the vertices in the VBO
	(gl:bind-buffer :array-buffer vbo)
	(gl:buffer-data :array-buffer :static-draw gl-vertices)

	;; position
	(gl:vertex-attrib-pointer 0 3 :float 0 (* 5 (cffi:foreign-type-size :float)) (* 0 (cffi:foreign-type-size :float)))
	(gl:enable-vertex-attrib-array 0)
	;; texture coord
	(gl:vertex-attrib-pointer 1 2 :float 0 (* 5 (cffi:foreign-type-size :float)) (* 3 (cffi:foreign-type-size :float)))
	(gl:enable-vertex-attrib-array 1)

	(gl:bind-buffer :array-buffer instance-vbo)
	(gl:enable-vertex-attrib-array 2)
	;; Note: max vertex attrib size is 4, so we have to break out the data into 4 separate attribs
	;; inside the shader we can reference the first index as a mat4 and everything works
	;; (gl:vertex-attrib-pointer 2 16 :float 0 (* 16 (cffi:foreign-type-size :float)) (* 0 (cffi:foreign-type-size :float)))
	(gl:vertex-attrib-pointer 2 4 :float 0 (* 16 (cffi:foreign-type-size :float)) (* 0 4 (cffi:foreign-type-size :float)))
	(gl:enable-vertex-attrib-array 3)
	(gl:vertex-attrib-pointer 3 4 :float 0 (* 16 (cffi:foreign-type-size :float)) (* 1 4 (cffi:foreign-type-size :float)))
	(gl:enable-vertex-attrib-array 4)
	(gl:vertex-attrib-pointer 4 4 :float 0 (* 16 (cffi:foreign-type-size :float)) (* 2 4 (cffi:foreign-type-size :float)))
	(gl:enable-vertex-attrib-array 5)
	(gl:vertex-attrib-pointer 5 4 :float 0 (* 16 (cffi:foreign-type-size :float)) (* 3 4 (cffi:foreign-type-size :float)))

	(gl:bind-buffer :array-buffer 0)
	(%gl:vertex-attrib-divisor 2 1)
	(%gl:vertex-attrib-divisor 3 1)
	(%gl:vertex-attrib-divisor 4 1)
	(%gl:vertex-attrib-divisor 5 1)
	(values vao vbo instance-vbo)))
	(gl:free-gl-array gl-vertices))))

	(defun instanced-sprit-rendering ()
	(sdl2:with-init (:everything)
	(format t "Using SDL Library Version: ~D.~D.~D~%"
	sdl2-ffi:+sdl-major-version+
	sdl2-ffi:+sdl-minor-version+
	sdl2-ffi:+sdl-patchlevel+)
	(progn
	;; https://wiki.libsdl.org/SDL_GLattr
	;; https://wiki.libsdl.org/SDL_GLprofile
	(sdl2:gl-set-attr :context-major-version 3)
	(sdl2:gl-set-attr :context-minor-version 3)
	(sdl2:gl-set-attr :context-profile-mask
	sdl2-ffi:+sdl-gl-context-profile-core+)
	(sdl2:gl-set-attr :doublebuffer 1))

	(cffi:with-foreign-strings ((hint-name "SDL_VIDEO_X11_NET_WM_BYPASS_COMPOSITOR")
	(hint-val "0"))
	;; prevent SDL from disabling the linux compositor
	(sdl2-ffi.functions:sdl-set-hint hint-name hint-val))

	(let ((window-width 800)
	(window-height 600))
	(sdl2:with-window (win :title "Instanced Rendering" :w window-width :h window-height :flags '(:shown :opengl))
	(sdl2:with-gl-context (gl-context win)
	(format t "Setting up window/gl.~%")
	(progn
	(sdl2:gl-make-current win gl-context)
	;; https://wiki.libsdl.org/SDL_GL_SetSwapInterval#Remarks
	;; first try for adaptive vsync
	;; note: using the ffi directly to bypass the rc assertion in wrapper library
	(gl:viewport 0 0 window-width window-height)

	;; (when (= -1 (sdl2::sdl-gl-set-swap-interval -1))
	;; (sdl2::sdl-gl-set-swap-interval 1))
	(sdl2::sdl-gl-set-swap-interval 0) ; disable vsync to max out the FPS
	(format T "window swap interval (vsync): ~A~%" (sdl2:gl-get-swap-interval)))

	(gl:clear-color 0.0 1.0 1.0 1.0)

	(let* ((sprite-program-id (make-shader "instancing.vert" "instancing.frag"))
	(texture-id (make-texture-from-png "rectangle.png"))
	(camera (kit.glm:ortho-matrix 0 window-width window-height 0 100.0 -100.0))
	(frame-timer (make-instance 'frame-timer))
	(frame-measure-period 3000)
	(measure-start-timestamp (sdl2:get-ticks))
	(num-rects 1850)
	(c-rect-transforms
	;; TODO: hardcoding 1850 rectangles
	(gl:alloc-gl-array :float
	(* num-rects ; total num rects
	;; each transform is a 4x4 matrix
	16))))
	(multiple-value-bind (vao vbo instance-vbo) (make-instanced-sprite-vao c-rect-transforms)
	(format t "Created shader: ~A~%" sprite-program-id)
	(sb-ext:gc :full t)
	;; main loop
	(sdl2:with-event-loop (:method :poll)
	(:keydown (:keysym keysym)
	(let ((scancode (sdl2:scancode-value keysym))
	(sym (sdl2:sym-value keysym))
	(mod-value (sdl2:mod-value keysym)))
	(declare (ignore sym mod-value))
	(cond
	((sdl2:scancode= scancode :scancode-q) (sdl2:push-event :quit)))))
	(:idle ()
	(sb-sys:without-gcing
	(gl:clear :color-buffer-bit)

	(frame-timer-start frame-timer)
	(let* ((rect-w 15.0)
	(rect-h 15.0)
	(padding 1.0)
	(num-cols (floor window-height (+ rect-h padding)))
	(num-rows (floor window-width (+ rect-w padding)))
	(instance-id 0))
	(unless (= num-rects (* num-cols num-rows))
	(error "unexpected number of rectangles: ~A" (* num-cols num-rows)))
	(loop :for row :from 0 :below num-cols :do
	(loop :for col :from 0 :below num-rows :do
	(let ((model (sprite-transform
	(+ (* rect-w col) (* padding col))
	(+ (* rect-h row) (* padding row))
	rect-w
	rect-h)))
	(loop :for i :from 0 :below (length model) :do
	(setf (gl:glaref c-rect-transforms (+ i (* instance-id (length model))))
	(elt model i)))
	(incf instance-id))))
	(when (> instance-id 0)
	(gl:bind-buffer :array-buffer instance-vbo)
	(gl:buffer-data :array-buffer :dynamic-draw c-rect-transforms)

	(gl:use-program sprite-program-id)
	(gl:uniformf
	(gl:get-uniform-location sprite-program-id "spriteColorMod")
	1.0 1.0 1.0 1.0)
	(gl:uniform-matrix-4fv
	(gl:get-uniform-location sprite-program-id "worldProjection")
	camera
	nil)
	(gl:bind-texture :texture-2d texture-id)
	(gl:bind-vertex-array vao)

	(gl:draw-arrays-instanced :triangle-fan 0 4 instance-id)))
	(frame-timer-stop frame-timer)
	(sdl2:gl-swap-window win)

	(let* ((now (sdl2:get-ticks))
	(delta (- now measure-start-timestamp)))
	(when (>= delta frame-measure-period)
	(multiple-value-bind (fps frame-avg-ms worst-frame-ms)
	(frame-timer-get-batch-measurements frame-timer)
	(format t
	"~%frame stats~% fps: ~A~% avg: ~A~% max: ~A~%"
	fps
	frame-avg-ms
	worst-frame-ms)
	(finish-output))
	(setf measure-start-timestamp (sdl2:get-ticks))
	(frame-timer-reset frame-timer)))))
	(:quit () t))
	(progn ; cleanup
	;; the removal of the gl contaxt makes this cleanup code unnecessary, but
	;; showing for completness.
	(when c-rect-transforms
	(gl:free-gl-array c-rect-transforms))
	(gl:delete-vertex-arrays (list vao))
	(gl:delete-buffers (list vbo instance-vbo))
	(gl:delete-texture texture-id)
	(gl:delete-program sprite-program-id))))
	(format t "Done!~%"))))))
	#version 330 core
	out vec4 FragColor;

	// data from vertex shader
	in VertexData {
	vec2 textureCoords;
	} fragmentData;

	// texture sampler
	uniform sampler2D ourTexture;
	uniform vec4 spriteColorMod;

	void main()
	{
	vec4 texColor = texture(ourTexture, fragmentData.textureCoords);
	// FragColor = spriteColorMod * colorMappedTexture;
	FragColor = vec4(0.0, 0.0, 1.0, 1.0);
	}
	#version 330 core
	layout (location = 0) in vec3 screenPos;
	layout (location = 1) in vec2 srcCoord;
	layout (location = 2) in mat4 worldModel;

	// data sent to fragment shader
	out VertexData {
	vec2 textureCoords;
	} vertexData;

	uniform mat4 worldProjection;
	uniform vec4 spriteSrc;

	void main()
	{
	float spriteSrcX = spriteSrc.x;
	float spriteSrcY = spriteSrc.y;
	float spriteWidth = spriteSrc.z;
	float spriteHeight = spriteSrc.w;

	vertexData.textureCoords = vec2(spriteSrcX + (srcCoord.x * spriteWidth),
	spriteSrcY + (srcCoord.y * spriteHeight));
	gl_Position = worldProjection * worldModel * vec4(screenPos, 1.0);
	// gl_Position = vec4(screenPos, 1.0);
	}