From 7ab3f9a8fd24abcbd3ea17857661f5f6b2cc2c3e Mon Sep 17 00:00:00 2001 From: Shinmera Date: Sat, 8 Jul 2023 17:19:04 +0200 Subject: [PATCH] More cleanup. --- assets/shader-image.lisp | 10 +++--- effects.lisp | 15 +++++---- pixel-pipeline.lisp | 19 +++++------ renderer/particle.lisp | 12 +++---- renderer/shadow-map.lisp | 6 ++-- resources/compute-shader.lisp | 61 +++++++++++++++++++++++++++++++---- resources/framebuffer.lisp | 42 ++++++++++++++++++------ shader-pass.lisp | 46 +++++--------------------- tile-layer.lisp | 23 +++---------- 9 files changed, 126 insertions(+), 108 deletions(-) diff --git a/assets/shader-image.lisp b/assets/shader-image.lisp index 0e2f30d2d..f68f3dd8f 100644 --- a/assets/shader-image.lisp +++ b/assets/shader-image.lisp @@ -18,15 +18,13 @@ (render (// 'trial 'fullscreen-square) program)) (defmethod render ((renderer image-renderer) (texture texture)) - (let ((fbo (gl:gen-framebuffer))) - (gl:bind-framebuffer :framebuffer fbo) + (let ((framebuffer (make-instance 'framebuffer :data-pointer (gl:gen-framebuffer)))) (unwind-protect (progn - (gl:viewport 0 0 (width texture) (height texture)) - (%gl:framebuffer-texture :framebuffer :color-attachment0 (gl-name texture) 0) + (bind texture framebuffer) + (activate framebuffer) (render renderer NIL)) - (gl:bind-framebuffer :framebuffer 0) - (gl:delete-framebuffers (list fbo))))) + (deallocate framebuffer)))) (define-class-shader (image-renderer :vertex-shader) " diff --git a/effects.lisp b/effects.lisp index f43b2619a..ff940a80f 100644 --- a/effects.lisp +++ b/effects.lisp @@ -47,13 +47,14 @@ void main(){ ((iterations :initarg :iterations :initform 1 :accessor iterations))) (defmethod render ((pass iterative-post-effect-pass) (program shader-program)) - (let* ((color (gl-name (color pass))) + (let* ((color (color pass)) (ocolor color) - (previous (gl-name (previous-pass pass)))) + (framebuffer (framebuffer pass)) + (previous (previous-pass pass))) (flet ((swap-buffers () (rotatef color previous) - (%gl:framebuffer-texture :framebuffer :color-attachment0 color 0) - (gl:bind-texture :texture-2d previous))) + (bind color framebuffer) + (bind previous 0))) (call-next-method) (loop with limit = (iterations pass) for i from 0 @@ -63,8 +64,8 @@ void main(){ (return))) ;; KLUDGE: this is wrong for even number of iterations. It essentially ;; discards the last iteration, as it won't be displayed.... - (when (/= ocolor color) - (%gl:framebuffer-texture :framebuffer :color-attachment0 ocolor 0))))) + (unless (eq ocolor color) + (bind ocolor (framebuffer pass)))))) (define-shader-pass temporal-post-effect-pass (post-effect-pass) ((previous :port-type static-input :accessor previous) @@ -72,7 +73,7 @@ void main(){ (defmethod render :after ((pass temporal-post-effect-pass) thing) (rotatef (gl-name (previous pass)) (gl-name (color pass))) - (%gl:framebuffer-texture :framebuffer :color-attachment0 (gl-name (color pass)) 0)) + (bind (color pass) (framebuffer pass))) (define-shader-pass copy-pass (simple-post-effect-pass) ()) diff --git a/pixel-pipeline.lisp b/pixel-pipeline.lisp index 3054da097..8b94130d3 100644 --- a/pixel-pipeline.lisp +++ b/pixel-pipeline.lisp @@ -68,20 +68,19 @@ ,@(when iterate (destructuring-bind (times (a b)) iterate `((defmethod render ((pass ,name) (program shader-program)) - (let ((in (gl-name (slot-value pass ',a))) - (out (gl-name (slot-value pass ',b))) + (let ((in (slot-value pass ',a)) + (out (slot-value pass ',b)) (unit-id (unit-id (port pass ',a))) (attachment (attachment (port pass ',b))) (times ,times)) - (gl:active-texture unit-id) (dotimes (i times) (call-next-method) (when (< i (1- times)) (rotatef in out) - (%gl:bind-texture :texture-2d in) - (%gl:framebuffer-texture :framebuffer attachment out 0))) - (setf (gl-name (slot-value pass ',a)) in) - (setf (gl-name (slot-value pass ',b)) out)))))))))) + (bind in unit-id) + (bind out framebuffer))) + (setf (gl-name (slot-value pass ',a)) (gl-name in)) + (setf (gl-name (slot-value pass ',b)) (gl-name out))))))))))) (defclass pixel-pipeline (pipeline) ((width :initarg :width :accessor width) @@ -177,13 +176,11 @@ (setf (dirty-p pipeline) NIL)) (let ((in (aref (passes pipeline) 0)) (out (aref (passes pipeline) (1- (length (passes pipeline)))))) - (%gl:bind-framebuffer :framebuffer (gl-name (framebuffer out))) + (activate (framebuffer out)) ,@(loop for (out in) in loopback collect `(rotatef (gl-name (slot-value in ',in)) (gl-name (slot-value out ',out))) - collect `(%gl:framebuffer-texture - :framebuffer (attachment (port out ',out)) - (gl-name (slot-value out ',out)) 0)))) + collect `(bind (slot-value out ',out) (framebuffer out))))) ,@(loop for (kind name type . args) in slots when (eql :uniform kind) diff --git a/renderer/particle.lisp b/renderer/particle.lisp index feb24fd0c..29aef3466 100644 --- a/renderer/particle.lisp +++ b/renderer/particle.lisp @@ -384,14 +384,12 @@ (setf (emit-count struct) to-emit) (setf (randomness struct) (random 1.0))) ;; Simulate with compute shaders - (%gl:bind-buffer :dispatch-indirect-buffer (gl-name particle-argument-buffer)) - (render kickoff-pass NIL) - (render emit-pass NIL) + (render kickoff-pass particle-argument-buffer) + (render emit-pass 0) (simulate-particles particle-emitter) ;; Swap the buffers (rotatef (binding-point alive-particle-buffer-0) (binding-point alive-particle-buffer-1)) - (%gl:bind-buffer :dispatch-indirect-buffer 0) (setf (to-emit particle-emitter) emit-carry)))) (define-handler (particle-emitter class-changed) () @@ -429,10 +427,8 @@ (with-buffer-tx (struct particle-emitter-buffer) (setf (emit-count struct) count) (setf (randomness struct) (random 1.0))) - (%gl:bind-buffer :dispatch-indirect-buffer (gl-name particle-argument-buffer)) - (render kickoff-pass NIL) - (render emit-pass NIL) - (%gl:bind-buffer :dispatch-indirect-buffer 0))) + (render kickoff-pass (gl-name particle-argument-buffer)) + (render emit-pass NIL))) (define-shader-pass depth-colliding-particle-simulate-pass (particle-simulate-pass) ((depth-tex :port-type fixed-input :accessor depth) diff --git a/renderer/shadow-map.lisp b/renderer/shadow-map.lisp index a0a943b56..a4fea9868 100644 --- a/renderer/shadow-map.lisp +++ b/renderer/shadow-map.lisp @@ -156,7 +156,7 @@ (defmethod render-frame :before ((pass standard-shadows-pass) frame) (let ((program (shadow-map-program pass)) - (map (gl-name (shadow-map pass))) + (map (shadow-map pass)) (lights (shadow-map-lights pass))) (activate (shadow-map-framebuffer pass)) (activate program) @@ -168,8 +168,8 @@ (dotimes (id (length lights)) (when (aref lights id) (setf (uniform program "shadow_map_id") id) - (%gl:framebuffer-texture-layer :framebuffer :depth-attachment map 0 id) - (gl:clear :depth-buffer) + (bind map (shadow-map-framebuffer pass)) + (clear (shadow-map-framebuffer pass)) (loop for (object) across frame do (when (typep object 'standard-renderable) (with-pushed-matrix () diff --git a/resources/compute-shader.lisp b/resources/compute-shader.lisp index e10017338..9b1605780 100644 --- a/resources/compute-shader.lisp +++ b/resources/compute-shader.lisp @@ -9,12 +9,29 @@ (defclass compute-shader (shader-program) ((shader-source :initarg :source :initform (arg! :source) :accessor shader-source) (shaders :initform ()) - (workgroup-size :initarg :workgroup-size :initform (vec 1 1 1) :accessor workgroup-size))) + (work-groups :initarg :work-groups :initform (vec 1 1 1) :accessor work-groups) + (barrier :initform 4294967295))) + +(defmethod initialize-instance :after ((shader compute-shader) &key) + (unless (integerp (slot-value shader 'barrier)) + (setf (barrier shader) (slot-value shader 'barrier)))) + +(defmethod shared-initialize :after ((shader compute-shader) slots &key (barrier NIL barrier-p)) + (when barrier-p (setf (barrier shader) barrier))) (defmethod print-object ((shader compute-shader) stream) (print-unreadable-object (shader stream :type T :identity T) (format stream "~:[~;ALLOCATED~]" (allocated-p shader)))) +(defmethod barrier ((shader compute-shader)) + (cffi:foreign-bitfield-symbols '%gl::MemoryBarrierMask (slot-value shader 'barrier))) + +(defmethod (setf barrier) ((bits list) (shader compute-shader)) + (setf (slot-value shader 'barrier) (cffi:foreign-bitfield-value '%gl::MemoryBarrierMask bits))) + +(defmethod (setf barrier) ((bits symbol) (shader compute-shader)) + (setf (slot-value shader 'barrier) (cffi:foreign-bitfield-value '%gl::MemoryBarrierMask (list bits)))) + (defmethod allocate ((shader compute-shader)) (let ((source (shader-source shader)) (shdr (gl:create-shader :compute-shader)) @@ -28,7 +45,7 @@ (when (eql :es (profile *context*)) (setf source (glsl-toolkit:transform source :es (version *context*))))) (gl:shader-source shdr source) - (gl:compile-shader shdr) + (gl:compile-shader shdr)2 (unless (gl:get-shader shdr :compile-status) (error 'shader-compilation-error :shader shader :log (gl:get-shader-info-log shdr))) (v:debug :trial.asset "Compiled shader ~a: ~%~a" shader source) @@ -36,7 +53,39 @@ (gl:delete-shader shdr) (setf (data-pointer shader) prog))))) -(defmethod activate ((shader compute-shader)) - (call-next-method) - (let ((size (workgroup-size shader))) - (%gl:dispatch-compute (truncate (vx size)) (truncate (vy size)) (truncate (vz size))))) +(defmethod render ((shader compute-shader) (target null)) + (let ((work-groups (work-groups shader)) + (barrier (slot-value shader 'barrier))) + (etypecase work-groups + (vec3 + (%gl:dispatch-compute + (truncate (vx work-groups)) + (truncate (vy work-groups)) + (truncate (vz work-groups)))) + (integer + (%gl:dispatch-compute-indirect work-groups)) + (buffer-object + (%gl:bind-buffer :dispatch-indirect-buffer (gl-name work-groups)) + (%gl:dispatch-compute-indirect 0))) + (when (/= 0 barrier) + (%gl:memory-barrier barrier)))) + +(defmethod render ((shader compute-shader) (offset integer)) + (let ((work-groups (work-groups shader)) + (barrier (slot-value shader 'barrier))) + (etypecase work-groups + (buffer-object + (%gl:bind-buffer :dispatch-indirect-buffer (gl-name work-groups)) + (%gl:dispatch-compute-indirect offset))) + (when (/= 0 barrier) + (%gl:memory-barrier barrier)))) + +(defmethod render ((shader compute-shader) (target buffer-object)) + (let ((work-groups (work-groups shader)) + (barrier (slot-value shader 'barrier))) + (%gl:bind-buffer :dispatch-indirect-buffer (gl-name work-groups)) + (%gl:dispatch-compute-indirect (etypecase work-groups + (integer work-groups) + (null 0))) + (when (/= 0 barrier) + (%gl:memory-barrier barrier)))) diff --git a/resources/framebuffer.lisp b/resources/framebuffer.lisp index 23a3222c5..237dc9f97 100644 --- a/resources/framebuffer.lisp +++ b/resources/framebuffer.lisp @@ -29,6 +29,18 @@ (append (call-next-method) (mapcar #'second (attachments framebuffer)))) +(defun check-framebuffer-size (framebuffer texture) + (cond ((null (width framebuffer)) + (setf (width framebuffer) (width texture))) + ((/= (width framebuffer) (width texture)) + (error "Cannot attach~% ~a~%to~% ~a~%, as the width is mismatched." + texture framebuffer))) + (cond ((null (height framebuffer)) + (setf (height framebuffer) (height texture))) + ((/= (height framebuffer) (height texture)) + (error "Cannot attach~% ~a~%to~% ~a~%, as the height is mismatched." + texture framebuffer)))) + (defun bind-framebuffer-attachments (framebuffer attachments) (let ((color-attachments (loop for attachment in attachments unless (find (first attachment) '(:depth-attachment :stencil-attachment :depth-stencil-attachment)) @@ -42,18 +54,9 @@ (check-framebuffer-attachment attachment) (check-type texture texture) (check-allocated texture) + (check-framebuffer-size framebuffer texture) (v:debug :trial.framebuffer "Attaching ~a~@[:~a~] as ~a to ~a." texture layer attachment framebuffer) - (cond ((null (width framebuffer)) - (setf (width framebuffer) (width texture))) - ((/= (width framebuffer) (width texture)) - (error "Cannot attach~% ~a~%to~% ~a~%, as the width is mismatched." - texture framebuffer))) - (cond ((null (height framebuffer)) - (setf (height framebuffer) (height texture))) - ((/= (height framebuffer) (height texture)) - (error "Cannot attach~% ~a~%to~% ~a~%, as the height is mismatched." - texture framebuffer))) (if layer (%gl:framebuffer-texture-layer :framebuffer attachment (gl-name texture) level layer) (%gl:framebuffer-texture :framebuffer attachment (gl-name texture) level)) @@ -78,6 +81,19 @@ (with-cleanup-on-failure (bind-framebuffer-attachments framebuffer (attachments framebuffer)) (bind-framebuffer-attachments framebuffer attachments)))) +(defmethod bind ((texture texture) (framebuffer framebuffer)) + (check-framebuffer-size framebuffer texture) + (gl:bind-framebuffer (gl-name framebuffer)) + (case (internal-format texture) + ((:depth-component :depth-component16 :depth-component24 :depth-component32 :depth-component32f) + (%gl:framebuffer-texture :framebuffer :depth-attachment (gl-name texture) 0)) + ((:stencil-index :stencil-index1 :stencil-index4 :stencil-index8 :stencil-index16) + (%gl:framebuffer-texture :framebuffer :stencil-attachment (gl-name texture) 0)) + ((:depth-stencil :depth24-stencil8 :depth32f-stencil8) + (%gl:framebuffer-texture :framebuffer :depth-stencil-attachment (gl-name texture) 0)) + (T + (%gl:framebuffer-texture :framebuffer :color-attachment0 (gl-name texture) 0)))) + (defmethod allocate ((framebuffer framebuffer)) (let ((fbo (gl:gen-framebuffer))) (with-cleanup-on-failure (gl:delete-framebuffers (list fbo)) @@ -95,12 +111,18 @@ (setf (width framebuffer) width) (setf (height framebuffer) height))) +;; TODO: avoid rebinding framebuffer if already bound (defmethod activate ((framebuffer framebuffer)) (gl:bind-framebuffer :framebuffer (gl-name framebuffer)) (gl:viewport 0 0 (width framebuffer) (height framebuffer)) (let ((bits (slot-value framebuffer 'clear-bits))) (when (< 0 bits) (%gl:clear bits)))) +(defmethod clear ((framebuffer framebuffer)) + (gl:bind-framebuffer :framebuffer (gl-name framebuffer)) + (let ((bits (slot-value framebuffer 'clear-bits))) + (when (< 0 bits) (%gl:clear bits)))) + (defmethod render ((source framebuffer) (target integer)) (gl:bind-framebuffer :read-framebuffer (gl-name source)) (gl:bind-framebuffer :draw-framebuffer target) diff --git a/shader-pass.lisp b/shader-pass.lisp index 10b15ed21..502c882ba 100644 --- a/shader-pass.lisp +++ b/shader-pass.lisp @@ -490,49 +490,19 @@ void main(){ color = texture(previous_pass, uv); }") -(define-shader-pass compute-pass (single-shader-pass) - ((work-groups :initform (vec 1 1 1) :initarg :work-groups :accessor work-groups) - (barrier :initform 4294967295))) - -(defmethod initialize-instance :after ((pass compute-pass) &key) - (unless (integerp (slot-value pass 'barrier)) - (setf (barrier pass) (slot-value pass 'barrier)))) - -(defmethod shared-initialize :after ((pass compute-pass) slots &key (barrier NIL barrier-p)) - (when barrier-p (setf (barrier pass) barrier))) +(define-shader-pass compute-pass (single-shader-pass compute-shader) + ()) (defmethod handle ((event event) (pass compute-pass))) -(defmethod barrier ((pass compute-pass)) - (cffi:foreign-bitfield-symbols '%gl::MemoryBarrierMask (slot-value pass 'barrier))) +(defmethod shader-program ((pass compute-pass)) + pass) -(defmethod (setf barrier) ((bits list) (pass compute-pass)) - (setf (slot-value pass 'barrier) (cffi:foreign-bitfield-value '%gl::MemoryBarrierMask bits))) +(defmethod shaders ((pass compute-pass)) + (shaders (make-shader-program pass))) -(defmethod (setf barrier) ((bits symbol) (pass compute-pass)) - (setf (slot-value pass 'barrier) (cffi:foreign-bitfield-value '%gl::MemoryBarrierMask (list bits)))) - -(defmethod render ((pass compute-pass) (_ null)) - (bind-textures pass) - (render pass (or (shader-program pass) - (error "Shader program was never allocated!!")))) - -(defmethod render ((pass compute-pass) (program shader-program)) - (let ((work-groups (work-groups pass)) - (barrier (slot-value pass 'barrier))) - (etypecase work-groups - (vec3 - (%gl:dispatch-compute - (truncate (vx work-groups)) - (truncate (vy work-groups)) - (truncate (vz work-groups)))) - (integer - (%gl:dispatch-compute-indirect work-groups)) - (buffer-object - (%gl:bind-buffer :dispatch-indirect-buffer (gl-name work-groups)) - (%gl:dispatch-compute-indirect 0))) - (when (/= 0 barrier) - (%gl:memory-barrier barrier)))) +(defmethod render :before ((pass compute-pass) (_ null)) + (bind-textures pass)) (defmethod render ((pass compute-pass) (work-groups vec3)) (setf (work-groups pass) work-groups) diff --git a/tile-layer.lisp b/tile-layer.lisp index 4c940d7ec..33ce14d6f 100644 --- a/tile-layer.lisp +++ b/tile-layer.lisp @@ -60,7 +60,7 @@ (defmethod (setf pixel-data) ((data vector) (layer tile-layer)) (replace (pixel-data (tilemap layer)) data) - (%update-tile-layer layer)) + (update-buffer-data (tilemap layer) T)) (defmethod resize ((layer tile-layer) w h) (let ((size (vec2 (floor w (vx (tile-size layer))) (floor h (vy (tile-size layer)))))) @@ -110,12 +110,8 @@ (let ((idx (* 2 (+ x (* y (truncate (vx (size layer)))))))) (setf (aref dat (+ 0 idx)) (car value)) (setf (aref dat (+ 1 idx)) (cdr value)))) - (%update-tile-layer layer) - #++ ;; TODO: Optimize - (sb-sys:with-pinned-objects (dat) - (bind texture) - (%gl:tex-sub-image-2d :texture-2d 0 x y 1 1 (pixel-format texture) (pixel-type texture) - (cffi:inc-pointer (sb-sys:vector-sap dat) pos)))) + ;; TODO: Optimize + (update-buffer-data (tilemap layer) T)) value) (defmethod tile ((location vec3) (layer tile-layer)) @@ -124,22 +120,11 @@ (defmethod (setf tile) (value (location vec3) (layer tile-layer)) (setf (tile (vxy location) layer) value)) -(defun %update-tile-layer (layer) - (let ((dat (pixel-data layer))) - (sb-sys:with-pinned-objects (dat) - (let ((texture (tilemap layer)) - (width (truncate (vx (size layer)))) - (height (truncate (vy (size layer))))) - (bind texture NIL) - (%gl:tex-sub-image-2d :texture-2d 0 0 0 width height - (pixel-format texture) (pixel-type texture) - (sb-sys:vector-sap dat)))))) - (defmethod clear ((layer tile-layer)) (let ((dat (pixel-data layer))) (dotimes (i (truncate (* 2 (vx (size layer)) (vy (size layer))))) (setf (aref dat i) 0)) - (%update-tile-layer layer))) + (update-buffer-data (tilemap layer) T))) (defmethod render ((layer tile-layer) (program shader-program)) (when (< 0.0 (visibility layer))