Skip to content
Permalink
Browse files

New gl-structs implementation.

  • Loading branch information...
Shinmera committed Jul 5, 2019
1 parent 5d57876 commit 481eee75fc7bf5c04c850991ee3ca8f4740a1b65
Showing with 581 additions and 279 deletions.
  1. +64 −127 assets/uniform-buffer.lisp
  2. +1 −1 deferred.lisp
  3. +364 −0 gl-struct.lisp
  4. +15 −22 package.lisp
  5. +0 −125 resources/gl-struct.lisp
  6. +3 −0 toolkit.lisp
  7. +3 −3 trial.asd
  8. +131 −1 type-info.lisp
@@ -7,164 +7,101 @@
(in-package #:org.shirakumo.fraf.trial)

(defclass uniform-buffer (gl-asset buffer-object)
((layout :initarg :layout :accessor layout)
(qualifiers :initarg :qualifiers :accessor qualifiers)
((qualifiers :initarg :qualifiers :accessor qualifiers)
(binding :initarg :binding :accessor binding)
(offsets :initarg :offsets :initform NIL :accessor offsets))
(struct :accessor struct))
(:default-initargs
:buffer-type :uniform-buffer
:layout :shared
:qualifiers ()))

(defmethod initialize-instance :after ((buffer uniform-buffer) &key name binding)
(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)
;; Clear offsets as the underlying struct might have changed.
(setf (offsets buffer) ()))
(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 (gl-struct (input buffer))))
(gl-type (find-class (input buffer))))

(defmethod fields ((buffer uniform-buffer))
(fields (gl-struct (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-dependant-types buffer)
collect (gl-source (gl-struct dependent)))
,@(loop for dependent in (compute-dependent-types buffer)
collect (gl-source (find-class dependent)))
(glsl-toolkit:interface-declaration
(glsl-toolkit:type-qualifier
,@(when (layout buffer)
`((glsl-toolkit:layout-qualifier
,@(loop for id in (enlist (layout buffer))
collect `(glsl-toolkit:layout-qualifier-id ,@(enlist id))))))
(glsl-toolkit:layout-qualifier
(glsl-toolkit:layout-qualifier-id ,(layout-standard (find-class (input buffer)))))
:uniform
,@(qualifiers buffer))
,(gl-type buffer)
,(if (binding buffer)
`(glsl-toolkit:instance-name ,(binding buffer))
'glsl-toolkit:no-value)
,@(mapcar #'gl-source (fields buffer)))))

(defmethod compute-dependant-types ((buffer uniform-buffer))
(compute-dependant-types (gl-struct (input buffer))))

(defun compute-uniform-buffer-fields (buffer)
(labels ((gather-for-type (type name prefix)
(etypecase type
(cons
(ecase (first type)
(:array
(loop for i from 0 below (third type)
nconc (gather-for-type (second type) ""
(format NIL "~a~a[~d]" prefix name i))))
(:struct
(gather-fields (gl-struct (second type))
(format NIL "~a~a." prefix name)))))
(symbol (list (format NIL "~a~a" prefix name)))))
(gather-fields (struct prefix)
(loop for field in (fields struct)
nconc (gather-for-type (gl-type field) (gl-name field) prefix))))
(gather-fields (gl-struct (input buffer)) (format NIL "~@[~a.~]" (gl-type buffer)))))

(defmethod compute-offsets ((buffer uniform-buffer) (program shader-program))
(let* ((struct (gl-struct (input buffer)))
(index (gl:get-uniform-block-index (gl-name program) (gl-type struct)))
(size (gl:get-active-uniform-block (gl-name program) index :uniform-block-data-size))
(offsets (make-hash-table :test 'equal))
(fields (compute-uniform-buffer-fields buffer)))
(cffi:with-foreign-objects ((names :pointer 1)
(indices :int 1)
(params :int 1))
(dolist (field fields)
(cffi:with-foreign-string (name field)
(setf (cffi:mem-aref names :pointer 0) name)
(%gl:get-uniform-indices (gl-name program) 1 names indices)
(%gl:get-active-uniforms-iv (gl-name program) 1 indices :uniform-offset params)
(setf (gethash field offsets) (cffi:mem-ref params :int)))))
(values offsets size)))

(defmethod compute-offsets ((buffer uniform-buffer) (standard symbol))
(compute-offsets (gl-struct (input buffer)) standard))
,@(mapcar #'gl-source (struct-fields buffer)))))

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

(defmethod load ((buffer uniform-buffer))
;; If the layout is std140 we can compute the size and offsets without a program.
(when (and (find :std140 (enlist (layout buffer)))
(null (offsets buffer)))
(multiple-value-bind (offsets size) (compute-offsets (input buffer) :std140)
(setf (offsets buffer) offsets)
(setf (size buffer) size)))
(allocate buffer)
;; If we have no buffer data supplied already, or bad data, create a data vector so we
;; can do easy batch updates. We do this after allocation to not waste time uploading the data
;; and no earlier because we might not know the size.
(cond ((null (buffer-data buffer))
(setf (buffer-data buffer) (make-static-vector (size buffer) :initial-element 0)))
((/= (size buffer) (length (buffer-data buffer)))
(let ((old (buffer-data buffer))
(new (make-static-vector (size buffer) :initial-element 0)))
(setf (buffer-data buffer) (replace new old))
(maybe-free-static-vector old)))))
(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))
;; Calculate size and offsets now.
(unless (offsets buffer)
(multiple-value-bind (offsets size) (compute-offsets buffer program)
(setf (offsets buffer) offsets)
(setf (size buffer) size)))
;; FIXME: at this point we could compile an optimised accessor for the fields
;; that has the offsets and such rolled out so that there's no lookup
;; costs beyond calling the function from a slot.
;; The problem with this approach is the presence of arrays, as the index
;; to access will very very likely not be constant...
;; It should be possible to infer the stride between array bases and reduce
;; the access functions to a number of multiplications and additions.
;; Allocate the buffer with the correct sizing information.
;; TODO: Once we can do shared/packed, load offsets here.
(load buffer)
;; Bind the buffer to the program's specified binding point.
(let ((index (gl:get-uniform-block-index (gl-name program) (gl-type buffer))))
(%gl:uniform-block-binding (gl-name program) index binding-point)
(%gl:bind-buffer-base :uniform-buffer binding-point (gl-name buffer))))

(defmethod buffer-field ((buffer uniform-buffer) field)
(let ((offset (gethash field (offsets buffer)))
(type :FIXME))
#-elide-buffer-access-checks
(unless offset
(error "Field ~s not found in ~a." field buffer))
(with-pointer-to-vector-data (ptr (buffer-data buffer))
(gl-memref (cffi:inc-pointer ptr offset) type))))

(defmethod (setf buffer-field) (value (buffer uniform-buffer) field)
;; FIXME: wouldn't it be better to keep the C-memory block for the UBO around,
;; write the values in there ourselves, and then call an update call
;; instead of going through the slow, generic variants of buffer-object?
(let ((offset (gethash field (offsets buffer))))
#-elide-buffer-access-checks
(unless offset
(error "Field ~s not found in ~a." field buffer))
(update-buffer-data buffer value :buffer-start offset)))

(defun gl-memref (ptr type)
(etypecase type
(symbol
(ecase type
;; FIXME: stride and layout of matrices is dependant on layout used!
(:int (cffi:mem-ref ptr :int))
(:uint (cffi:mem-ref ptr :uint))
(:float (cffi:mem-ref ptr :float))
(:double (cffi:mem-ref ptr :double))
(:vec2 (vec2 (cffi:mem-aref ptr :float 0)
(cffi:mem-aref ptr :float 1)))
(:vec3 (vec3 (cffi:mem-aref ptr :float 0)
(cffi:mem-aref ptr :float 1)
(cffi:mem-aref ptr :float 2)))
(:vec4 (vec4 (cffi:mem-aref ptr :float 0)
(cffi:mem-aref ptr :float 1)
(cffi:mem-aref ptr :float 2)
(cffi:mem-aref ptr :float 3)))))
(cons
;; TODO: this
(error "Cannot handle compound types at this point."))))
(defmethod update-buffer-data ((buffer uniform-buffer) (data (eql T)) &key)
(update-buffer-data/ptr buffer (static-vector-pointer (buffer-data buffer)) (size buffer)))

(defmacro with-buffer-tx ((struct buffer) &body body)
(let ((bufferg (gensym "BUFFER")))
`(let* ((,bufferg ,buffer)
(,struct (struct ,bufferg)))
(multiple-value-prog1
(progn ,@body)
(with-context (*context*)
(update-buffer-data ,bufferg T))))))
@@ -147,7 +147,7 @@ void main(){
(cutoff :float))

(define-gl-struct light-block
(lights (:struct light) :count MAX-LIGHTS)
(lights (:array (:struct light) #.MAX-LIGHTS))
(count :int))

(define-asset (trial light-block) uniform-buffer

0 comments on commit 481eee7

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