Permalink
Browse files

Some more minor fixes.

  • Loading branch information...
Shinmera committed Mar 2, 2018
1 parent cf35732 commit 5f90cd0293b68d80a68556d4fca8e180e60b885f
Showing with 126 additions and 114 deletions.
  1. +1 −1 asset.lisp
  2. +9 −10 assets/font.lisp
  3. +51 −40 assets/mesh.lisp
  4. +56 −57 formats/vertex-format.lisp
  5. +4 −1 resources/texture.lisp
  6. +5 −5 resources/vertex-array.lisp
@@ -78,7 +78,7 @@
(T
(make-instance ',type ,@options :input ,input :name ',name :pool ',pool)))))
(trivial-indent:define-indentation define-asset (4 6 4 &rest))
(trivial-indent:define-indentation define-asset (4 6 4 &body))
(defclass gl-asset (asset gl-resource) ())
@@ -8,9 +8,8 @@
;; LATIN-1
(defparameter *default-charset*
#.(with-output-to-string (out)
(loop for i from #x0000 to #x00FF
do (write-char (code-char i) out))))
" !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~
¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ")
(defclass font (gl-asset)
((charset :initarg :charset :accessor charset)
@@ -41,22 +40,22 @@
(size :initarg :size :accessor size)
(vbo) (ebo) (vao))
(:default-initargs
:text ""
:size 24.0))
:text ""))
(defmethod initialize-instance :after ((text text) &key)
(defmethod initialize-instance :after ((text text) &key size)
(let* ((vbo (make-instance 'vertex-buffer :buffer-type :array-buffer
:data-usage :dynamic-draw
:size 0))
(ebo (make-instance 'vertex-buffer :buffer-type :element-array-buffer
:data-usage :dynamic-draw
:size 0))
(vao (make-instance 'vertex-array :buffers `((,vbo :size 2 :stride 16 :offset 0)
(,vbo :size 2 :stride 16 :offset 8)
,ebo))))
(vao (make-instance 'vertex-array :bindings `((,vbo :size 2 :stride 16 :offset 0)
(,vbo :size 2 :stride 16 :offset 8)
,ebo))))
(setf (slot-value text 'vbo) vbo)
(setf (slot-value text 'ebo) ebo)
(setf (slot-value text 'vao) vao)))
(setf (slot-value text 'vao) vao)
(unless size (setf (size text) (size (font text))))))
(defmethod dependencies ((text text))
(list (font text)))
@@ -11,49 +11,60 @@
(attributes :initarg :attributes :accessor attributes)
(data-usage :initarg :data-usage :accessor data-usage))
(:default-initargs
:bindings NIL
:geometry-name NIL
:data-usage :static-draw
:attributes T))
(defun vertex-mesh->vertex-array (mesh)
)
;;; FIXME FIXME FIXME FIXME
(defmethod load ((mesh mesh))
(let* ((input (coerce-asset-input mesh T))
(mesh (etypecase input
(pathname (gethash (geometry-name mesh) (meshes (read-geometry input T))))
(geometry (gethash (geometry-name mesh) (meshes input)))
(vertex-mesh input))))
(let* ((vertices (vertices mesh))
(primer (aref vertices 0))
(attributes (etypecase (attributes mesh)
((eql T) (vertex-attributes primer))
(list (attributes mesh))))
(sizes (loop for attr in attributes collect (vertex-attribute-size primer attr)))
(total-size (* (length vertices) (reduce #'+ sizes)))
(buffer (make-static-vector total-size :element-type 'single-float)))
;; Copy the contents of the mesh into the data buffer, packed.
(loop with buffer-offset = 0
for vertex across vertices
do (dolist (attribute attributes)
(setf buffer-offset (fill-vertex-attribute vertex attribute buffer buffer-offset))))
;; Construct the buffers and specs
(let* ((vbo (make-instance 'vertex-buffer :buffer-data buffer :buffer-type :array-buffer
:data-usage (data-usage mesh) :element-type :float))
(ebo (make-instance 'vertex-buffer :buffer-data (faces mesh) :buffer-type :element-array-buffer
:data-usage (data-usage mesh) :element-type :uint))
(specs (loop with stride = (reduce #'+ sizes)
for offset = 0 then (+ offset size)
for size in sizes
for index from 0
collect (list vbo :stride (* stride (cffi:foreign-type-size :float))
:offset (* offset (cffi:foreign-type-size :float))
:size size
:index index))))
(setf (buffers mesh) (list* ebo specs))
(setf (size mesh) (length vertices))
(allocate mesh)
;; Clean up
(deallocate vbo)
(deallocate ebo)
(setf (buffer-data vbo) NIL)
(setf (buffer-data ebo) NIL)
(setf (buffers mesh) NIL)
(static-vectors:free-static-vector buffer)))))
(mesh* (etypecase input
(pathname (gethash (geometry-name mesh) (meshes (read-geometry input T))))
(geometry (gethash (geometry-name mesh) (meshes input)))
(vertex-mesh input))))
(etypecase mesh*
(vertex-array
(setf (bindings mesh) (copy-tree (bindings mesh*)))
(allocate mesh)
(setf (bindings mesh) NIL))
(vertex-mesh
(let* ((vertices (vertices mesh*))
(primer (aref vertices 0))
(attributes (etypecase (attributes mesh*)
((eql T) (vertex-attributes primer))
(list (attributes mesh*))))
(sizes (loop for attr in attributes collect (vertex-attribute-size primer attr)))
(total-size (* (length vertices) (reduce #'+ sizes)))
(buffer (make-static-vector total-size :element-type 'single-float)))
;; Copy the contents of the mesh into the data buffer, packed.
(loop with buffer-offset = 0
for vertex across vertices
do (dolist (attribute attributes)
(setf buffer-offset (fill-vertex-attribute vertex attribute buffer buffer-offset))))
;; Construct the buffers and specs
(let* ((vbo (make-instance 'vertex-buffer :buffer-data buffer :buffer-type :array-buffer
:data-usage (data-usage mesh) :element-type :float))
(ebo (make-instance 'vertex-buffer :buffer-data (faces mesh*) :buffer-type :element-array-buffer
:data-usage (data-usage mesh) :element-type :uint))
(specs (loop with stride = (reduce #'+ sizes)
for offset = 0 then (+ offset size)
for size in sizes
for index from 0
collect (list vbo :stride (* stride (cffi:foreign-type-size :float))
:offset (* offset (cffi:foreign-type-size :float))
:size size
:index index))))
(setf (bindings mesh) (list* ebo specs))
(setf (size mesh) (length vertices))
(allocate mesh)
;; Clean up
(deallocate vbo)
(deallocate ebo)
(setf (buffer-data vbo) NIL)
(setf (buffer-data ebo) NIL)
(setf (bindings mesh) NIL)
(static-vectors:free-static-vector buffer)))))))
@@ -214,61 +214,60 @@
(setf (vertices mesh) (vformat-read-vertices buffer (vertex-type mesh)))
mesh)
;; FIXME
;; (defmethod vformat-write (buffer (vbo vertex-buffer))
;; (fast-io:writeu8 (vertex-buffer-type->int (buffer-type vbo)) buffer)
;; (fast-io:writeu8 (vertex-buffer-usage->int (data-usage vbo)) buffer)
;; (vformat-write-vector buffer (coerced-inputs vbo) (element-type vbo)))
;; (defmethod vformat-read (buffer (vbo vertex-buffer))
;; (let ((btype (int->vertex-buffer-type (fast-io:readu8 buffer)))
;; (usage (int->vertex-buffer-usage (fast-io:readu8 buffer))))
;; (multiple-value-bind (array size etype) (vformat-read-vector buffer)
;; (initialize-instance vbo :buffer-type btype
;; :data-usage usage
;; :element-type etype
;; :size size
;; :input array))))
;; (defmethod vformat-write (buffer (vao vertex-array))
;; (fast-io:write32-le (or (size vao) -1) buffer)
;; (let* ((inputs (coerced-inputs vao))
;; (count (length inputs))
;; (buffers (remove-duplicates (mapcar #'first inputs))))
;; (when (< 256 count)
;; (error "More than 2⁸ buffers are not supported."))
;; ;; Write input list
;; (fast-io:writeu8 count buffer)
;; (loop for i from 0
;; for input in inputs
;; do (destructuring-bind (vbo &key (index i) (size 3) (stride 0) (offset 0) (normalized NIL)) input
;; (fast-io:writeu8 (position vbo buffers) buffer)
;; (fast-io:writeu8 index buffer)
;; (fast-io:writeu8 size buffer)
;; (fast-io:writeu32-le stride buffer)
;; (fast-io:writeu32-le offset buffer)
;; (fast-io:writeu8 (if normalized 1 0) buffer)))
;; ;; Write buffer list
;; (fast-io:writeu8 (length buffers) buffer)
;; (dolist (vbo buffers)
;; (vformat-write buffer vbo))))
;; (defmethod vformat-read (buffer (vao vertex-array))
;; (let* ((size (fast-io:read32-le buffer))
;; (inputs (loop repeat (fast-io:readu8 buffer)
;; collect (list (fast-io:readu8 buffer)
;; :index (fast-io:readu8 buffer)
;; :size (fast-io:readu8 buffer)
;; :stride (fast-io:readu32-le buffer)
;; :offset (fast-io:readu32-le buffer)
;; :normalized (= (fast-io:readu8 buffer) 1))))
;; (buffers (loop repeat (fast-io:readu8 buffer)
;; collect (vformat-read buffer T))))
;; ;; Resolve buffer indexing
;; (dolist (input inputs)
;; (setf (first input) (nth (first input) buffers)))
;; (when (< size 0) (setf size NIL))
;; (initialize-instance vao :size size :inputs inputs)))
(defmethod vformat-write (buffer (vbo vertex-buffer))
(fast-io:writeu8 (vertex-buffer-type->int (buffer-type vbo)) buffer)
(fast-io:writeu8 (vertex-buffer-usage->int (data-usage vbo)) buffer)
(vformat-write-vector buffer (input vbo) (element-type vbo)))
(defmethod vformat-read (buffer (vbo vertex-buffer))
(let ((btype (int->vertex-buffer-type (fast-io:readu8 buffer)))
(usage (int->vertex-buffer-usage (fast-io:readu8 buffer))))
(multiple-value-bind (array size etype) (vformat-read-vector buffer)
(initialize-instance vbo :buffer-type btype
:data-usage usage
:element-type etype
:size size
:buffer-data array))))
(defmethod vformat-write (buffer (vao vertex-array))
(fast-io:write32-le (or (size vao) -1) buffer)
(let* ((bindings (bindings vao))
(count (length bindings))
(buffers (remove-duplicates (mapcar #'first bindings))))
(when (< 256 count)
(error "More than 2⁸ buffers are not supported."))
;; Write input list
(fast-io:writeu8 count buffer)
(loop for i from 0
for binding in bindings
do (destructuring-bind (vbo &key (index i) (size 3) (stride 0) (offset 0) (normalized NIL)) bindings
(fast-io:writeu8 (position vbo buffers) buffer)
(fast-io:writeu8 index buffer)
(fast-io:writeu8 size buffer)
(fast-io:writeu32-le stride buffer)
(fast-io:writeu32-le offset buffer)
(fast-io:writeu8 (if normalized 1 0) buffer)))
;; Write buffer list
(fast-io:writeu8 (length buffers) buffer)
(dolist (vbo buffers)
(vformat-write buffer vbo))))
(defmethod vformat-read (buffer (vao vertex-array))
(let* ((size (fast-io:read32-le buffer))
(bindings (loop repeat (fast-io:readu8 buffer)
collect (list (fast-io:readu8 buffer)
:index (fast-io:readu8 buffer)
:size (fast-io:readu8 buffer)
:stride (fast-io:readu32-le buffer)
:offset (fast-io:readu32-le buffer)
:normalized (= (fast-io:readu8 buffer) 1))))
(buffers (loop repeat (fast-io:readu8 buffer)
collect (vformat-read buffer T))))
;; Resolve buffer indexing
(dolist (binding bindings)
(setf (first binding) (nth (first binding) buffers)))
(when (< size 0) (setf size NIL))
(initialize-instance vao :size size :bindings bindings)))
(defmethod vformat-write (buffer (mesh sphere-mesh))
(vformat-write-double buffer (size mesh)))
@@ -303,13 +302,13 @@
(defmethod vformat-read (buffer (type (eql T)))
(vformat-read buffer (allocate-instance (find-class (vformat-read-symbol buffer)))))
(defmethod write-geometry ((geometry geometry) file (format (eql :vf)) &key (if-exists :error))
(defmethod write-geometry (thing file (format (eql :vf)) &key (if-exists :error))
(with-open-file (stream file :direction :output
:element-type '(unsigned-byte 8)
:if-exists if-exists)
(when stream
(fast-io:with-fast-output (buffer stream)
(vformat-write buffer geometry))
(vformat-write buffer thing))
file)))
(defmethod read-geometry (file (format (eql :vf)) &key (if-does-not-exist :error))
@@ -134,6 +134,7 @@
(gl:tex-parameter target :texture-wrap-t (second wrapping)))
(when (eql target :texture-cube-map)
(gl:tex-parameter target :texture-wrap-r (third wrapping))))
(gl:bind-texture target 0)
(setf (data-pointer texture) tex)))))
(defmethod resize ((texture texture) width height)
@@ -143,10 +144,12 @@
(setf (width texture) width)
(setf (height texture) height)
(when (allocated-p texture)
(gl:bind-texture (target texture) (gl-name texture))
(allocate-texture-storage texture)
(when (find (min-filter texture) '(:linear-mipmap-linear :linear-mipmap-nearest
:nearest-mipmap-linear :nearest-mipmap-nearest))
(gl:generate-mipmap (target texture))))))
(gl:generate-mipmap (target texture)))
(gl:bind-texture (target texture) 0))))
;;;; Texture spec wrangling
;; The idea of this is that, in order to maximise sharing of texture resources
@@ -8,30 +8,30 @@
(defclass vertex-array (gl-resource)
((size :initarg :size :initform NIL :accessor size)
(buffers :initarg :buffers :accessor buffers))
(bindings :initarg :bindings :accessor bindings))
(:default-initargs
:buffers (error "BUFFERS required.")))
:bindings (error "BINDINGS required.")))
(defmethod destructor ((array vertex-array))
(let ((vao (gl-name array)))
(lambda () (gl:delete-vertex-arrays (list vao)))))
(defmethod dependencies ((array vertex-array))
(mapcar #'unlist (buffers array)))
(mapcar #'unlist (bindings array)))
(defmethod allocate ((array vertex-array))
(let ((vao (gl:gen-vertex-array)))
(with-cleanup-on-failure (gl:delete-vertex-arrays (list vao))
(gl:bind-vertex-array vao)
(unwind-protect
(loop for buffer in (buffers array)
(loop for binding in (bindings array)
for i from 0
do (destructuring-bind (buffer &key (index i)
(size 3)
(stride 0)
(offset 0)
(normalized NIL))
(enlist buffer)
(enlist binding)
(check-allocated buffer)
(gl:bind-buffer (buffer-type buffer) (gl-name buffer))
(ecase (buffer-type buffer)

0 comments on commit 5f90cd0

Please sign in to comment.