Skip to content
Permalink
Browse files

Rework things to allow struct-buffers, especially vertex-struct-buffe…

…rs, and use this system for particles.

There's still some oddities, but I'm not sure from what.
  • Loading branch information...
Shinmera committed Aug 3, 2019
1 parent 9162e87 commit ab39da04a0c3fbf47db41dd18ad04822f658d6ff
Showing with 285 additions and 163 deletions.
  1. +3 −0 asset.lisp
  2. +93 −0 assets/struct-buffer.lisp
  3. +2 −69 assets/uniform-buffer.lisp
  4. +45 −0 assets/vertex-struct-buffer.lisp
  5. +36 −6 gl-struct.lisp
  6. +1 −1 package.lisp
  7. +22 −54 particle.lisp
  8. +10 −6 resources/vertex-array.lisp
  9. +3 −1 trial.asd
  10. +39 −8 type-info.lisp
  11. +31 −18 workbench.lisp
@@ -69,6 +69,9 @@
(defmethod coerce-asset-input ((asset asset) (list list))
(loop for item in list collect (coerce-asset-input asset item)))

(defmethod input* ((asset asset))
(coerce-asset-input asset (input asset)))

(defmacro define-asset ((pool name) type input &rest options)
(check-type pool symbol)
(check-type name symbol)
@@ -0,0 +1,93 @@
#|
This file is a part of trial
(c) 2017 Shirakumo http://tymoon.eu (shinmera@tymoon.eu)
Author: Nicolas Hafner <shinmera@tymoon.eu>
|#

(in-package #:org.shirakumo.fraf.trial)

(defclass struct-buffer (gl-asset buffer-object)
((struct :accessor struct))
(:default-initargs
:data-usage :stream-draw))

(defmethod print-object ((buffer struct-buffer) stream)
(print-unreadable-object (buffer stream :type T :identity T)
(format stream "~a/~a ~a ~a"
(when (pool buffer) (name (pool buffer))) (name buffer)
(buffer-type buffer) (data-usage buffer))))

(defmethod coerce-asset-input ((asset struct-buffer) (input symbol))
(find-class input))

(defmethod reinitialize-instance :before ((buffer struct-buffer) &key input)
(when (and (not (equal input (input buffer)))
(allocated-p buffer))
(c2mop:remove-dependent (find-class (input buffer)) buffer)
(c2mop:add-dependent (find-class input) buffer)))

(defmethod reinitialize-instance :after ((buffer struct-buffer) &key)
(when (allocated-p buffer)
(c2mop:update-dependent (input* buffer) buffer)))

(defmethod buffer-field-size ((buffer struct-buffer) standard base)
(buffer-field-size (input* buffer) standard 0))

;;; FIXME: we update the buffer just fine, but what about the shader programs?
(defmethod c2mop:update-dependent ((class gl-struct-class) (buffer struct-buffer) &rest _)
(declare (ignore _))
(when (buffer-data buffer)
;; FIXME: This currently zeroes out the data.
;; We might be able to fix things up better and retain old values by copying across.
(let ((new-size (buffer-field-size buffer T 0)))
(when (/= new-size (size buffer))
(setf (size buffer) new-size)
(let ((old (buffer-data buffer))
(new (make-static-vector new-size :initial-element 0)))
(maybe-free-static-vector old)
(setf (buffer-data buffer) new)
(when (allocated-p buffer)
(resize-buffer buffer new-size :data new)))))))

(defmethod (setf buffer-data) :after (data (buffer struct-buffer))
(setf (struct buffer) (make-instance (input buffer) :storage-ptr (static-vector-pointer data))))

(defmethod gl-type ((buffer struct-buffer))
(gl-type (input* buffer)))

(defmethod struct-fields ((buffer struct-buffer))
(struct-fields (input* buffer)))

(defmethod compute-dependent-types ((buffer struct-buffer))
(compute-dependent-types (input* buffer)))

(defmethod load ((buffer struct-buffer))
(unless (size buffer)
(setf (size buffer) (buffer-field-size buffer T 0))
(setf (buffer-data buffer) (make-static-vector (size buffer) :initial-element 0)))
(allocate buffer))

(defmethod allocate :after ((buffer struct-buffer))
(c2mop:add-dependent (input* buffer) buffer))

(defmethod deallocate :after ((buffer struct-buffer))
(c2mop:remove-dependent (input* buffer) buffer)
(maybe-free-static-vector (buffer-data buffer))
(setf (size buffer) NIL)
(setf (buffer-data buffer) NIL)
(slot-makunbound buffer 'struct))

(defmethod update-buffer-data ((buffer struct-buffer) (data (eql T)) &key)
(update-buffer-data/ptr buffer (static-vector-pointer (buffer-data buffer)) (size buffer)))

(defvar *buffers-in-tx* ())
(defmacro with-buffer-tx ((struct buffer) &body body)
(let ((bufferg (gensym "BUFFER")))
`(let ((,bufferg ,buffer))
(multiple-value-prog1
(let ((*buffers-in-tx* (list* ,bufferg *buffers-in-tx*))
(,struct (struct ,bufferg)))
,@body)
(unless (find ,bufferg *buffers-in-tx*)
(with-context (*context*)
(update-buffer-data ,bufferg T)))))))
@@ -6,10 +6,9 @@

(in-package #:org.shirakumo.fraf.trial)

(defclass uniform-buffer (gl-asset buffer-object)
(defclass uniform-buffer (struct-buffer)
((qualifiers :initarg :qualifiers :accessor qualifiers)
(binding :initarg :binding :accessor binding)
(struct :accessor struct))
(binding :initarg :binding :accessor binding))
(:default-initargs
:buffer-type :uniform-buffer
:qualifiers ()))
@@ -18,40 +17,6 @@
(unless binding
(setf (binding buffer) (cffi:translate-underscore-separated-name name))))

(defmethod reinitialize-instance :before ((buffer uniform-buffer) &key input)
(when (and (not (equal input (input buffer)))
(allocated-p buffer))
(c2mop:remove-dependent (find-class (input buffer)) buffer)
(c2mop:add-dependent (find-class input) buffer)))

(defmethod reinitialize-instance :after ((buffer uniform-buffer) &key)
(when (allocated-p buffer)
(c2mop:update-dependent (find-class (input buffer)) buffer)))

;;; FIXME: we update the buffer just fine, but what about the shader programs?
(defmethod c2mop:update-dependent ((class gl-struct-class) (buffer uniform-buffer) &rest _)
(declare (ignore _))
(when (allocated-p buffer)
;; FIXME: This currently zeroes out the data.
;; We might be able to fix things up better and retain old values by copying across.
(let ((new-size (buffer-field-size (input buffer) T 0)))
(when (/= new-size (size buffer))
(setf (size buffer) new-size)
(let ((old (buffer-data buffer))
(new (make-static-vector new-size :initial-element 0)))
(maybe-free-static-vector old)
(setf (buffer-data buffer) new)
(resize-buffer buffer new-size :data new))))))

(defmethod (setf buffer-data) :after (data (buffer uniform-buffer))
(setf (struct buffer) (make-instance (input buffer) :storage-ptr (static-vector-pointer data))))

(defmethod gl-type ((buffer uniform-buffer))
(gl-type (find-class (input buffer))))

(defmethod struct-fields ((buffer uniform-buffer))
(struct-fields (find-class (input buffer))))

(defmethod gl-source ((buffer uniform-buffer))
`(glsl-toolkit:shader
,@(loop for dependent in (compute-dependent-types buffer)
@@ -68,24 +33,6 @@
'glsl-toolkit:no-value)
,@(mapcar #'gl-source (struct-fields buffer)))))

(defmethod compute-dependent-types ((buffer uniform-buffer))
(compute-dependent-types (input buffer)))

(defmethod load ((buffer uniform-buffer))
(unless (size buffer)
(setf (size buffer) (buffer-field-size (input buffer) T 0))
(setf (buffer-data buffer) (make-static-vector (size buffer) :initial-element 0)))
(allocate buffer))

(defmethod allocate :after ((buffer uniform-buffer))
(c2mop:add-dependent (find-class (input buffer)) buffer))

(defmethod deallocate :after ((buffer uniform-buffer))
(c2mop:remove-dependent (find-class (input buffer)) buffer)
(maybe-free-static-vector (buffer-data buffer))
(setf (size buffer) NIL)
(setf (buffer-data buffer) NIL))

(defmethod bind ((buffer uniform-buffer) (program shader-program) (binding-point integer))
;; TODO: Once we can do shared/packed, load offsets here.
(load buffer)
@@ -94,17 +41,3 @@
(%gl:uniform-block-binding (gl-name program) index binding-point)
(%gl:bind-buffer-base :uniform-buffer binding-point (gl-name buffer))))

(defmethod update-buffer-data ((buffer uniform-buffer) (data (eql T)) &key)
(update-buffer-data/ptr buffer (static-vector-pointer (buffer-data buffer)) (size buffer)))

(defvar *buffers-in-tx* ())
(defmacro with-buffer-tx ((struct buffer) &body body)
(let ((bufferg (gensym "BUFFER")))
`(let ((,bufferg ,buffer))
(multiple-value-prog1
(let ((*buffers-in-tx* (list* ,bufferg *buffers-in-tx*))
(,struct (struct ,bufferg)))
,@body)
(unless (find ,bufferg *buffers-in-tx*)
(with-context (*context*)
(update-buffer-data ,bufferg T)))))))
@@ -0,0 +1,45 @@
#|
This file is a part of trial
(c) 2017 Shirakumo http://tymoon.eu (shinmera@tymoon.eu)
Author: Nicolas Hafner <shinmera@tymoon.eu>
|#

(in-package #:org.shirakumo.fraf.trial)

(defclass vertex-struct-buffer (struct-buffer vertex-buffer)
((struct-count :initarg :struct-count :initform (error "STRUCT-COUNT required.") :accessor struct-count)
(struct-vector :accessor struct-vector)))

(defmethod vertex-layout ((buffer vertex-struct-buffer))
(vertex-layout (input* buffer)))

(defmethod add-vertex-bindings ((vbo vertex-struct-buffer) (vao vertex-array))
(let ((idx (loop for i from 0
for binding in (bindings vao)
when (listp binding)
maximize (getf (rest binding) :index i))))
(loop for i from (1+ idx)
for binding in (vertex-layout vbo)
do (push (list* vbo :index i :instancing 1 binding) (bindings vao)))
(values vao (+ 1 idx))))

(defmethod buffer-field-size ((buffer vertex-struct-buffer) standard base)
(* (call-next-method)
(struct-count buffer)))

(defmethod (setf struct-count) :after (value (buffer vertex-struct-buffer))
(c2mop:update-dependent (input* buffer) buffer))

(defmethod (setf buffer-data) :after (data (buffer vertex-struct-buffer))
(loop with struct = (input* buffer)
with vector = (make-array (struct-count buffer))
with size = (buffer-field-stride struct :vertex-buffer)
for i from 0 below (length vector)
for offset = 0 then (+ offset size)
do (setf (aref vector i) (make-instance struct
:storage-ptr (static-vector-pointer data)
:base-offset offset))
finally (setf (struct-vector buffer) vector)))

(defmethod deallocate :after ((buffer vertex-struct-buffer))
(slot-makunbound buffer 'struct-vector))
@@ -50,13 +50,18 @@

(defclass gl-struct-class (standard-class)
((gl-type :initarg :gl-type :accessor gl-type)
(layout-standard :initarg :layout-standard :initform :std140 :reader layout-standard)))
(layout-standard :initform :std140 :reader layout-standard)))

(defmethod initialize-instance :after ((class gl-struct-class) &key)
(unless (slot-boundp class 'gl-type)
(setf (gl-type class) (cffi:translate-camelcase-name (class-name class)
:upper-initial-p T))))

(defmethod shared-initialize :after ((class gl-struct-class) slots &key layout-standard)
(when layout-standard
(setf (slot-value class 'layout-standard)
(unlist layout-standard))))

(defmethod c2mop:validate-superclass ((a gl-struct-class) (b T)) NIL)
(defmethod c2mop:validate-superclass ((a gl-struct-class) (b standard-class)) T)
(defmethod c2mop:validate-superclass ((a T) (b gl-struct-class)) NIL)
@@ -89,9 +94,26 @@
,(gl-type class)
,@(mapcar #'gl-source (struct-fields class))))

(defmethod vertex-layout ((class gl-struct-class))
(let ((stride (buffer-field-stride class :vertex-buffer)))
(values (loop for offset = 0 then (+ offset size)
for field in (struct-fields class)
for size = (buffer-field-size (gl-type field) :vertex-buffer 0)
collect (list :offset offset
:size (ecase (gl-type field)
((:float :int) 1)
((:vec2) 2)
((:vec3) 3)
((:vec4) 4)
((:mat2) 4)
((:mat3) 9)
((:mat4) 16))
:stride stride))
stride)))

(defmethod c2mop:compute-slots ((class gl-struct-class))
(let ((slots (call-next-method))
(standard (layout-standard class))
(standard (slot-value class 'layout-standard))
(offset 0))
;; Compute discrete slot offsets.
(loop for slot in slots
@@ -119,6 +141,9 @@
(loop for field in (struct-fields class)
maximize (buffer-field-base (gl-type field) standard))))

(defmethod buffer-field-base ((class gl-struct-class) (standard (eql :vertex-buffer)))
1)

(defmethod buffer-field-base ((class gl-struct-class) (standard (eql T)))
(buffer-field-base class (layout-standard class)))

@@ -133,6 +158,9 @@
(defmethod buffer-field-stride ((class gl-struct-class) (standard (eql :std140)))
(buffer-field-size class standard 0))

(defmethod buffer-field-stride ((class gl-struct-class) (standard (eql :vertex-buffer)))
(buffer-field-size class standard 0))

(defmethod buffer-field-stride ((class gl-struct-class) (standard (eql T)))
(buffer-field-stride class (layout-standard class)))

@@ -298,10 +326,12 @@
;; FIXME: Figure out direct accessor functions

(defmacro define-gl-struct (name &body slots)
`(defclass ,name (gl-struct)
,(loop for (slot type . args) in slots
collect (list* slot :gl-type type args))
(:metaclass gl-struct-class)))
(destructuring-bind (name . options) (enlist name)
`(defclass ,name (,@(cdr (assoc :include options)) gl-struct)
,(loop for (slot type . args) in slots
collect (list* slot :gl-type type args))
(:metaclass gl-struct-class)
,@(remove :include options :key #'car))))

;;; Only for primitive types.
;;; FIXME: factor out into trivial-* library
@@ -8,7 +8,7 @@
(defpackage #:trial
(:nicknames #:org.shirakumo.fraf.trial)
(:use #:cl #:3d-vectors #:3d-matrices #:flare)
(:shadow #:scene #:entity #:load #:update)
(:shadow #:scene #:entity #:load #:update #:particle)
(:import-from #:static-vectors #:static-vector-pointer)
(:import-from #:flow #:port)
;; assets/font.lisp

0 comments on commit ab39da0

Please sign in to comment.
You can’t perform that action at this time.