From 1d7f23092f697cc280e0005510ee00387a731156 Mon Sep 17 00:00:00 2001 From: Kevin Galligan Date: Wed, 17 Apr 2024 15:50:52 +0100 Subject: [PATCH 1/6] First draft (doesn't work yet). --- src/drawing.lisp | 46 +++++++++++++++++++++++++++++++++++++--------- 1 file changed, 37 insertions(+), 9 deletions(-) diff --git a/src/drawing.lisp b/src/drawing.lisp index 7c66a66..72855cf 100644 --- a/src/drawing.lisp +++ b/src/drawing.lisp @@ -81,16 +81,44 @@ (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 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)))))) + (loop for (batch-size batch) 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+))) + ;; TODO: tweak fill-buffer to account for (optional) batch size. + (fill-buffer buffer-pointer batch color batch-size) + (%gl:unmap-buffer :array-buffer) + (%gl:draw-arrays primitive position batch-size) + (incf position batch-size) + ;; TODO: do we need to draw after every iteration? + (start-draw))))) + +(defun enough-space-for-vertices-p (vertices) + (< (* *bytes-per-vertex* + (+ (env-buffer-position *env*) + (length vertices))) + *buffer-size*)) + +(defun batch-vertices (vertices primitive) + (let ((num-vertices (length vertices))) + (cond + ;; In future, may wish to support batching for other primitive types. + ((not (eq :triangle-strip primitive)) + (list num-vertices vertices)) + ((enough-space-for-vertices-p vertices) + (list num-vertices vertices)) + (t + ;; TODO include the last 2 vertices for the continuity of the strip? + (loop with max-per-batch = (floor *buffer-size* *bytes-per-vertex*) + while vertices + for n = (min max-per-batch num-vertices) + collect (list n vertices) + do (decf num-vertices n) + do (setf vertices (nthcdr n vertices))))))) (defmethod push-vertices (vertices color texture primitive (draw-mode (eql :figure))) (let* ((vertices (mapcar (lambda (v) (transform-vertex v (env-model-matrix *env*))) From 7f59fe25e195f3157371db21d0179c56fd594379 Mon Sep 17 00:00:00 2001 From: Kevin Galligan Date: Thu, 18 Apr 2024 16:32:31 +0100 Subject: [PATCH 2/6] Working code. --- src/drawing.lisp | 50 +++++++++++++++++++++++++++-------------------- src/geometry.lisp | 19 ++++++++++-------- 2 files changed, 40 insertions(+), 29 deletions(-) diff --git a/src/drawing.lisp b/src/drawing.lisp index 72855cf..75898fb 100644 --- a/src/drawing.lisp +++ b/src/drawing.lisp @@ -81,44 +81,49 @@ (vector (env-model-matrix *env*))) (gl:bind-texture :texture-2d texture) (symbol-macrolet ((position (env-buffer-position *env*))) - (when (not (enough-space-for-vertices-p vertices)) + (when (not (enough-space-for-vertices-p (length vertices))) + ;; Try to clear as much space in draw buffer as possible. (start-draw)) - (loop for (batch-size batch) in (batch-vertices vertices primitive) + (loop 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+))) - ;; TODO: tweak fill-buffer to account for (optional) batch size. (fill-buffer buffer-pointer batch color batch-size) (%gl:unmap-buffer :array-buffer) (%gl:draw-arrays primitive position batch-size) (incf position batch-size) - ;; TODO: do we need to draw after every iteration? - (start-draw))))) + (when (not last-batch-p) + (start-draw)))))) -(defun enough-space-for-vertices-p (vertices) - (< (* *bytes-per-vertex* +(defun enough-space-for-vertices-p (num-vertices) + (<= (* *bytes-per-vertex* (+ (env-buffer-position *env*) - (length vertices))) + num-vertices)) *buffer-size*)) (defun batch-vertices (vertices primitive) (let ((num-vertices (length vertices))) (cond - ;; In future, may wish to support batching for other primitive types. - ((not (eq :triangle-strip primitive)) - (list num-vertices vertices)) - ((enough-space-for-vertices-p vertices) - (list num-vertices vertices)) - (t - ;; TODO include the last 2 vertices for the continuity of the strip? + ((enough-space-for-vertices-p num-vertices) + (list (list num-vertices vertices t))) + ((member primitive '(:triangles :triangle-strip)) + ;; Assuming that the draw buffer is empty whenever we resort to batching. (loop with max-per-batch = (floor *buffer-size* *bytes-per-vertex*) - while vertices + while (> num-vertices (if (eq primitive :triangles) 0 2)) for n = (min max-per-batch num-vertices) - collect (list n vertices) - do (decf num-vertices n) - do (setf vertices (nthcdr n vertices))))))) + for num-to-skip = (if (eq primitive :triangles) + n + ;; Keep the last 2 vertices for the next batch so + ;; that there isn't a gap in the triangle strip. + (- n 2)) + collect (list n vertices (zerop (- num-vertices n))) + do (setf vertices (nthcdr n vertices)) + do (decf num-vertices n))) + ;; 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*))) @@ -145,11 +150,14 @@ (+ v1 (* v-range v-in))))) uv)) -(defun fill-buffer (buffer-pointer vertices color) +(defun fill-buffer (buffer-pointer vertices color &optional num-vertices) (loop + 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)) + for (tx ty) in (mapcar #'fit-uv-to-rect (normalize-to-bounding-box vertices + num-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) diff --git a/src/geometry.lisp b/src/geometry.lisp index 236fc89..fd68ce8 100644 --- a/src/geometry.lisp +++ b/src/geometry.lisp @@ -75,18 +75,21 @@ (make-array (length points) :initial-contents points) :winding-rule (pen-winding-rule (env-pen *env*)))))) -(defun bounding-box (vertices) - (loop for (x y) in vertices +(defun bounding-box (vertices &optional num-vertices) + (loop for j from 0 + while (or (null num-vertices) (< j num-vertices)) + for (x y) in vertices minimize x into min-x maximize x into max-x minimize y into min-y 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))) +(defun normalize-to-bounding-box (vertices &optional num-vertices) + (let ((box (bounding-box vertices num-vertices))) (with-lines (box) - (mapcar (lambda (vertex) - (list (normalize (first vertex) x1 x2) - (normalize (second vertex) y1 y2))) - vertices)))) + (loop for j from 0 + while (or (null num-vertices) (< j num-vertices)) + for vertex in vertices + collect (list (normalize (first vertex) x1 x2) + (normalize (second vertex) y1 y2)))))) From ae6f77e879242530f2cce56a7339d1c9287e6c6d Mon Sep 17 00:00:00 2001 From: Kevin Galligan Date: Thu, 18 Apr 2024 17:45:59 +0100 Subject: [PATCH 3/6] Separate batching logic for :triangles and :triangle-strip. --- src/drawing.lisp | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/src/drawing.lisp b/src/drawing.lisp index 75898fb..c531f89 100644 --- a/src/drawing.lisp +++ b/src/drawing.lisp @@ -108,22 +108,31 @@ (cond ((enough-space-for-vertices-p num-vertices) (list (list num-vertices vertices t))) - ((member primitive '(:triangles :triangle-strip)) + ((eq primitive :triangles) ;; Assuming that the draw buffer is empty whenever we resort to batching. - (loop with max-per-batch = (floor *buffer-size* *bytes-per-vertex*) - while (> num-vertices (if (eq primitive :triangles) 0 2)) + (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) - for num-to-skip = (if (eq primitive :triangles) - n - ;; Keep the last 2 vertices for the next batch so - ;; that there isn't a gap in the triangle strip. - (- n 2)) 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."))))) + (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*))) From 386ceca64fc68ac8b394af62dfbdb2360c40c578 Mon Sep 17 00:00:00 2001 From: Kevin Galligan Date: Tue, 23 Apr 2024 13:46:13 +0100 Subject: [PATCH 4/6] Calculate bounding box over all vertices rather than per-batch. This prevents discontinuities in the texture. Also removed some of the excess cons-ing when normalizing vertices. --- src/drawing.lisp | 53 ++++++++++++++++++++++++++++------------------- src/geometry.lisp | 18 ++++++---------- 2 files changed, 38 insertions(+), 33 deletions(-) diff --git a/src/drawing.lisp b/src/drawing.lisp index c531f89..78da947 100644 --- a/src/drawing.lisp +++ b/src/drawing.lisp @@ -82,15 +82,21 @@ (gl:bind-texture :texture-2d texture) (symbol-macrolet ((position (env-buffer-position *env*))) (when (not (enough-space-for-vertices-p (length vertices))) - ;; Try to clear as much space in draw buffer as possible. (start-draw)) - (loop for (batch-size batch last-batch-p) in (batch-vertices vertices primitive) + ;; 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 batch-size) + (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) @@ -132,7 +138,7 @@ 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.")))))) + (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*))) @@ -151,27 +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 &optional num-vertices) +(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 - num-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)))))) diff --git a/src/geometry.lisp b/src/geometry.lisp index fd68ce8..19dc1f9 100644 --- a/src/geometry.lisp +++ b/src/geometry.lisp @@ -75,21 +75,15 @@ (make-array (length points) :initial-contents points) :winding-rule (pen-winding-rule (env-pen *env*)))))) -(defun bounding-box (vertices &optional num-vertices) - (loop for j from 0 - while (or (null num-vertices) (< j num-vertices)) - for (x y) in vertices +(defun bounding-box (vertices) + (loop for (x y) in vertices minimize x into min-x maximize x into max-x minimize y into min-y maximize y into max-y finally (return (list (list min-x min-y) (list max-x max-y))))) -(defun normalize-to-bounding-box (vertices &optional num-vertices) - (let ((box (bounding-box vertices num-vertices))) - (with-lines (box) - (loop for j from 0 - while (or (null num-vertices) (< j num-vertices)) - for vertex in vertices - collect (list (normalize (first vertex) x1 x2) - (normalize (second vertex) y1 y2)))))) +(defun normalize-to-bounding-box (box x y) + (with-lines (box) + (values (normalize x x1 x2) + (normalize y y1 y2)))) From 1029b20fdbbdd6062889ff2a49b6dce7e1c31bb0 Mon Sep 17 00:00:00 2001 From: Kevin Galligan Date: Tue, 23 Apr 2024 14:11:48 +0100 Subject: [PATCH 5/6] Fix indentation. --- src/drawing.lisp | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/drawing.lisp b/src/drawing.lisp index 78da947..03efa9a 100644 --- a/src/drawing.lisp +++ b/src/drawing.lisp @@ -179,10 +179,10 @@ 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)))))) + (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)))))) From 6af5dcaae458878928af224aa3c9835149763bf8 Mon Sep 17 00:00:00 2001 From: Kevin Galligan Date: Wed, 19 Jun 2024 18:08:45 +0100 Subject: [PATCH 6/6] Fix unbalanced parens. --- src/drawing.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/drawing.lisp b/src/drawing.lisp index 03efa9a..2dfa8f5 100644 --- a/src/drawing.lisp +++ b/src/drawing.lisp @@ -185,4 +185,4 @@ (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)))))) + (cffi:mem-aref buffer-pointer :uint8 (+ (* 4 (+ idx 4)) 3)) (aref color 3)))))