diff --git a/src/drawing.lisp b/src/drawing.lisp index 7c66a66..2dfa8f5 100644 --- a/src/drawing.lisp +++ b/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))))) diff --git a/src/geometry.lisp b/src/geometry.lisp index 236fc89..19dc1f9 100644 --- a/src/geometry.lisp +++ b/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))))