Batch vertices for large shapes.

src/drawing.lisp

@@ -81,16 +81,64 @@
                                 (vector (env-model-matrix *env*)))
   (gl:bind-texture :texture-2d texture)
   (symbol-macrolet ((position (env-buffer-position *env*)))
-    (when (> (* *bytes-per-vertex* (+ position (length vertices))) *buffer-size*)
+    (when (not (enough-space-for-vertices-p (length vertices)))
       (start-draw))
-    (let ((buffer-pointer (%gl:map-buffer-range :array-buffer
-                                                (* position *bytes-per-vertex*)
-                                                (* (length vertices) *bytes-per-vertex*)
-                                                +access-mode+)))
-      (fill-buffer buffer-pointer vertices color)
-      (%gl:unmap-buffer :array-buffer)
-      (%gl:draw-arrays primitive position (length vertices))
-      (setf position (+ position (length vertices))))))
+    ;; Important to calculate the bounding box before they've been batched so that
+    ;; there are no discontinuities in the texture.
+    (loop with bb = (bounding-box vertices)
+          for (batch-size batch last-batch-p) in (batch-vertices vertices primitive)
+          do (let* ((buffer-pointer
+                      (%gl:map-buffer-range :array-buffer
+                                            (* position *bytes-per-vertex*)
+                                            (* batch-size *bytes-per-vertex*)
+                                            +access-mode+)))
+               (fill-buffer buffer-pointer
+                            batch
+                            color
+                            :num-vertices batch-size
+                            :bounding-box bb)
+               (%gl:unmap-buffer :array-buffer)
+               (%gl:draw-arrays primitive position batch-size)
+               (incf position batch-size)
+               (when (not last-batch-p)
+                 (start-draw))))))
+
+(defun enough-space-for-vertices-p (num-vertices)
+  (<= (* *bytes-per-vertex*
+        (+ (env-buffer-position *env*)
+           num-vertices))
+     *buffer-size*))
+
+(defun batch-vertices (vertices primitive)
+  (let ((num-vertices (length vertices)))
+    (cond
+      ((enough-space-for-vertices-p num-vertices)
+       (list (list num-vertices vertices t)))
+      ((eq primitive :triangles)
+       ;; Assuming that the draw buffer is empty whenever we resort to batching.
+       (loop with max-per-batch = (let ((buff-capacity (floor *buffer-size* *bytes-per-vertex*)))
+                                    ;; This is needed to ensure that the vertices
+                                    ;; for each triangle are in the same batch.
+                                    (- buff-capacity (mod buff-capacity 3)))
+             while (> num-vertices 2)
+             for n = (min max-per-batch num-vertices)
+             collect (list n vertices (zerop (- num-vertices n)))
+             ;; Keep the last 2 vertices for the next batch so
+             ;; that there isn't a gap in the triangle strip.
+             do (setf vertices (nthcdr n vertices))
+             do (decf num-vertices n)))
+      ((eq primitive :triangle-strip)
+       (loop with max-per-batch = (floor *buffer-size* *bytes-per-vertex*)
+             while (> num-vertices 2)
+             for n = (min max-per-batch num-vertices)
+             collect (list n vertices (zerop (- num-vertices n)))
+             ;; Keep the last 2 vertices for the next batch so
+             ;; that there isn't a gap in the triangle strip.
+             do (setf vertices (nthcdr (- n 2) vertices))
+             do (decf num-vertices (- n 2))))
+      ;; Better to fail early rather than crashing with an obscure
+      ;; OpenGL error.
+      (t (error "Draw buffer not large enough for this shape.")))))
 
 (defmethod push-vertices (vertices color texture primitive (draw-mode (eql :figure)))
   (let* ((vertices (mapcar (lambda (v) (transform-vertex v (env-model-matrix *env*)))
@@ -109,24 +157,32 @@
   ;; TODO: Drawing in event handlers could be useful with COPY-PIXELS set to to T.
   (warn "Can't draw from current context (e.g. an event handler)."))
 
-(defun fit-uv-to-rect (uv)
-  (if *uv-rect*
-      (destructuring-bind (u-in v-in) uv
+(defun normalize-and-fit-uv-to-rect (box x y)
+  (multiple-value-bind (u-in v-in)
+      (normalize-to-bounding-box box x y)
+    (if *uv-rect*
         (destructuring-bind (u1 v1 u-range v-range) *uv-rect*
-          (list (+ u1 (* u-range u-in))
-                (+ v1 (* v-range v-in)))))
-      uv))
+          (values (+ u1 (* u-range u-in))
+                  (+ v1 (* v-range v-in))))
+        (values u-in v-in))))
 
-(defun fill-buffer (buffer-pointer vertices color)
+(defun fill-buffer (buffer-pointer vertices color &key num-vertices bounding-box)
   (loop
+    with bb = (or bounding-box
+                  (bounding-box (if (null num-vertices)
+                                    vertices
+                                    (subseq vertices 0 num-vertices))))
+    for j from 0
+    while (or (null num-vertices) (< j num-vertices))
     for idx from 0 by *vertex-attributes*
     for (x y) in vertices
-    for (tx ty) in (mapcar #'fit-uv-to-rect (normalize-to-bounding-box vertices))
-    do (setf (cffi:mem-aref buffer-pointer :float idx) (coerce-float x)
-             (cffi:mem-aref buffer-pointer :float (+ idx 1)) (coerce-float y)
-             (cffi:mem-aref buffer-pointer :float (+ idx 2)) (coerce-float tx)
-             (cffi:mem-aref buffer-pointer :float (+ idx 3)) (coerce-float (* ty (env-y-axis-sgn *env*)))
-             (cffi:mem-aref buffer-pointer :uint8 (* 4 (+ idx 4))) (aref color 0)
-             (cffi:mem-aref buffer-pointer :uint8 (+ (* 4 (+ idx 4)) 1)) (aref color 1)
-             (cffi:mem-aref buffer-pointer :uint8 (+ (* 4 (+ idx 4)) 2)) (aref color 2)
-             (cffi:mem-aref buffer-pointer :uint8 (+ (* 4 (+ idx 4)) 3)) (aref color 3))))
+    do (multiple-value-bind (tx ty)
+           (normalize-and-fit-uv-to-rect bb x y)
+         (setf (cffi:mem-aref buffer-pointer :float idx) (coerce-float x)
+               (cffi:mem-aref buffer-pointer :float (+ idx 1)) (coerce-float y)
+               (cffi:mem-aref buffer-pointer :float (+ idx 2)) (coerce-float tx)
+               (cffi:mem-aref buffer-pointer :float (+ idx 3)) (coerce-float (* ty (env-y-axis-sgn *env*)))
+               (cffi:mem-aref buffer-pointer :uint8 (* 4 (+ idx 4))) (aref color 0)
+               (cffi:mem-aref buffer-pointer :uint8 (+ (* 4 (+ idx 4)) 1)) (aref color 1)
+               (cffi:mem-aref buffer-pointer :uint8 (+ (* 4 (+ idx 4)) 2)) (aref color 2)
+               (cffi:mem-aref buffer-pointer :uint8 (+ (* 4 (+ idx 4)) 3)) (aref color 3)))))

src/geometry.lisp

@@ -83,10 +83,7 @@
         maximize y into max-y
         finally (return (list (list min-x min-y) (list max-x max-y)))))
 
-(defun normalize-to-bounding-box (vertices)
-  (let ((box (bounding-box vertices)))
-    (with-lines (box)
-      (mapcar (lambda (vertex)
-                (list (normalize (first vertex) x1 x2)
-                      (normalize (second vertex) y1 y2)))
-              vertices))))
+(defun normalize-to-bounding-box (box x y)
+  (with-lines (box)
+    (values (normalize x x1 x2)
+            (normalize y y1 y2))))