Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

loading and saving meshes in the builtin format

 * When loading meshes -- from whatever format -- if the
   mesh is transformed on load, we cannot reuse the old KD tree.

 * In our own .mesh format, write the KD tree into the same file as
   the vertex data.

 * Let's not keep huge models in the repo...
  • Loading branch information...
commit ef8405b820d519f153491ed29494e60e9f0f0409 1 parent f894c35
@nikodemus authored
View
6 kernel/base.lisp
@@ -50,6 +50,12 @@
(defconstant float-positive-infinity (/ 1.0 0.0))
(defconstant float-negative-infinity (/ -1.0 0.0))
+(defun negative-infinity-vec ()
+ (vec float-negative-infinity float-negative-infinity float-negative-infinity))
+
+(defun positive-infinity-vec ()
+ (vec float-positive-infinity float-positive-infinity float-positive-infinity))
+
;;;# Utilities
;;;
;;; Note: RAYLISP shadows VECTOR and SIMPLE-VECTOR; we set up things
View
175 kernel/kd-tree.lisp
@@ -135,8 +135,8 @@
;;;; single (plane position)
;;;; NODE END
;;;;
-;;;; node 0 is the root, and always last. child nodes always
-;;;; come before their parents.
+;;;; child nodes always come before their parents -- the last
+;;;; node is the root.
(defconstant +kd-tree-magic-bytes+ #x4dee75ee)
(defconstant +kd-tree-format-version+ #x0)
@@ -172,93 +172,100 @@
(logeqv #xffffffff word)
word))))
-(defun save-kd-tree (tree pathname &key (if-exists :error))
- (assert (member if-exists '(:error :supersede)))
- (let ((nodes (make-hash-table))
- (n -1))
+(defun map-kd-tree (function tree)
+ (declare (function function))
+ (labels ((walk (node)
+ (unless (kd-leaf-p node)
+ (walk (kd-left node))
+ (walk (kd-right node)))
+ (funcall function node)))
+ (walk tree)))
+
+(defun load-kd-tree (pathname)
+ (let ((pathname (merge-pathnames pathname (make-pathname :type "kd"))))
+ (with-open-file (f pathname :element-type '(unsigned-byte 8))
+ (read-kd-tree f))))
+
+(defun save-kd-tree (tree pathname)
+ (let ((pathname (merge-pathnames pathname (make-pathname :type "kd"))))
(with-open-file (f pathname
:element-type '(unsigned-byte 8)
- :direction :output
- :if-exists if-exists)
- (write-word +kd-tree-magic-bytes+ f)
- (write-word +kd-tree-format-version+ f)
- ;; Number of nodes to dumped -- patched in after we're done
- (write-word 0 f)
- (macrolet ((inc (x)
- `(setf ,x (logand #xffffffff (+ ,x 1)))))
- (labels ((number-node (node)
- (setf (gethash node nodes) (inc n)))
- (write-node (node)
- (write-word (gethash node nodes) f)
- (let ((min (kd-min node))
- (max (kd-max node)))
- (write-single (aref min 0) f)
- (write-single (aref min 1) f)
- (write-single (aref min 2) f)
- (write-single (aref max 0) f)
- (write-single (aref max 1) f)
- (write-single (aref max 2) f)
- (cond ((kd-leaf-p node)
- (write-byte +kd-tree-leaf-mark+ f)
- (let* ((objects (kd-objects node))
- (n (length objects)))
- (write-word (length objects) f)
- (dotimes (i n)
- (write-word (aref objects i) f))))
- (t
- (write-byte (kd-axis node) f)
- (write-word (gethash (kd-left node) nodes) f)
- (write-word (gethash (kd-right node) nodes) f)
- (write-single (kd-plane-position node) f)))))
- (walk (node)
- (number-node node)
- (cond ((kd-leaf-p node)
- (write-node node))
- (t
- (walk (kd-left node))
- (walk (kd-right node))
- (write-node node)))))
- (walk tree)
- ;; Patch the number of nodes to header.
- (file-position f (* 4 2))
- (write-word (hash-table-count nodes) f)
- tree)))))
+ :direction :output)
+ (write-kd-tree tree f))))
-(defun load-kd-tree (pathname)
- (with-open-file (f pathname :element-type '(unsigned-byte 8))
- (unless (= +kd-tree-magic-bytes+ (read-word f))
- (error "Not a Raylisp KD-tree file: ~S" pathname))
- (let ((version (read-word f)))
- (unless (= +kd-tree-format-version+ version)
- (error "Unknown KD-tree format version: ~S" version)))
- (let* ((n-nodes (read-word f))
- (nodes (make-array n-nodes)))
- (loop
- (let ((node-number (read-word f))
- (min (vec (read-single f) (read-single f) (read-single f)))
- (max (vec (read-single f) (read-single f) (read-single f)))
- (axis-or-leaf-mark (read-byte f)))
- (setf (aref nodes node-number)
- (if (= +kd-tree-leaf-mark+ axis-or-leaf-mark)
- (let ((n-objects (read-word f)))
- (make-kd-leaf-node
- :min min
- :max max
- :objects
- (when (plusp n-objects)
- (let ((objects (make-array n-objects :element-type '(unsigned-byte 32))))
- (dotimes (i n-objects)
- (setf (aref objects i) (read-word f)))
- objects))))
- (make-kd-interior-node
+(defun write-kd-tree (tree stream)
+ (let ((nodes (make-hash-table))
+ (last -1))
+ ;; Number the nodes
+ (map-kd-tree (lambda (node)
+ (setf (gethash node nodes)
+ (hash-table-count nodes)))
+ tree)
+ ;; Write header
+ (write-word +kd-tree-magic-bytes+ stream)
+ (write-word +kd-tree-format-version+ stream)
+ (write-word (hash-table-count nodes) stream)
+ (flet ((write-node (node)
+ (write-word (setf last (gethash node nodes)) stream)
+ (let ((min (kd-min node))
+ (max (kd-max node)))
+ (write-single (aref min 0) stream)
+ (write-single (aref min 1) stream)
+ (write-single (aref min 2) stream)
+ (write-single (aref max 0) stream)
+ (write-single (aref max 1) stream)
+ (write-single (aref max 2) stream)
+ (cond ((kd-leaf-p node)
+ (write-byte +kd-tree-leaf-mark+ stream)
+ (let* ((objects (kd-objects node))
+ (n (length objects)))
+ (write-word (length objects) stream)
+ (dotimes (i n)
+ (write-word (aref objects i) stream))))
+ (t
+ (write-byte (kd-axis node) stream)
+ (write-word (gethash (kd-left node) nodes) stream)
+ (write-word (gethash (kd-right node) nodes) stream)
+ (write-single (kd-plane-position node) stream))))))
+ (map-kd-tree #'write-node tree)
+ tree)))
+
+(defun read-kd-tree (stream)
+ (assert (equal '(unsigned-byte 8) (stream-element-type stream)))
+ (unless (= +kd-tree-magic-bytes+ (read-word stream))
+ (error "Not a serialized Raylisp KD-tree: ~S" (pathname stream)))
+ (let ((version (read-word stream)))
+ (unless (= +kd-tree-format-version+ version)
+ (error "Unknown KD-tree format version: ~S" version)))
+ (let* ((n-nodes (read-word stream))
+ (nodes (make-array n-nodes))
+ (root (1- n-nodes)))
+ (loop
+ (let ((node-number (read-word stream))
+ (min (vec (read-single stream) (read-single stream) (read-single stream)))
+ (max (vec (read-single stream) (read-single stream) (read-single stream)))
+ (axis-or-leaf-mark (read-byte stream)))
+ (setf (aref nodes node-number)
+ (if (= +kd-tree-leaf-mark+ axis-or-leaf-mark)
+ (let ((n-objects (read-word stream)))
+ (make-kd-leaf-node
:min min
:max max
- :left (aref nodes (read-word f))
- :right (aref nodes (read-word f))
- :axis axis-or-leaf-mark
- :plane-position (read-single f))))
- (when (zerop node-number)
- (return-from load-kd-tree (aref nodes 0))))))))
+ :objects
+ (when (plusp n-objects)
+ (let ((objects (make-array n-objects :element-type '(unsigned-byte 32))))
+ (dotimes (i n-objects)
+ (setf (aref objects i) (read-word stream)))
+ objects))))
+ (make-kd-interior-node
+ :min min
+ :max max
+ :left (aref nodes (read-word stream))
+ :right (aref nodes (read-word stream))
+ :axis axis-or-leaf-mark
+ :plane-position (read-single stream))))
+ (when (= node-number root)
+ (return-from read-kd-tree (aref nodes root)))))))
;;;; TRAVERSING A KD-TREE
View
105,410 models/stanford-bunny.ply
0 additions, 105,410 deletions not shown
View
134 objects/mesh.lisp
@@ -55,11 +55,17 @@
(defun %mesh-vertex (index vertex-index indices vertices)
(aref vertices (aref indices index vertex-index)))
+(defun mesh-face-count (mesh)
+ (array-dimension (slot-value mesh 'indices) 0))
+
+(defun mesh-vertex-count (mesh)
+ (length (slot-value mesh 'vertices)))
+
;;;; We compute a separate KD tree for each mesh. This tells the tree
;;;; code how to handle meshes.
(defmethod kd-set-size ((mesh mesh))
- (array-dimension (slot-value mesh 'indices) 0))
+ (mesh-face-count mesh))
(defmethod map-kd-set (function (mesh mesh))
(dotimes (i (kd-set-size mesh))
@@ -193,8 +199,8 @@
(sx (/ (- (float x-samples) 1.0) (float width)))
(sz (/ (- (float z-samples) 1.0) (float depth)))
(v -1)
- (max (vec float-negative-infinity float-negative-infinity float-negative-infinity))
- (min (vec float-positive-infinity float-positive-infinity float-positive-infinity)))
+ (min (positive-infinity-vec))
+ (max (negative-infinity-vec)))
(dotimes (z z-samples)
(let ((rz (/ z sz)))
(dotimes (x x-samples)
@@ -243,27 +249,35 @@
(let* ((type (pathname-type pathname))
(mesh-format (if (stringp type)
(or format (intern (string-upcase type) :keyword))
- (or format (error "Filetype not apparent, please specify :FORMAT")))))
- (multiple-value-bind (vertices faces)
- (funcall (find-mesh-loader mesh-format) pathname)
- (let ((mesh (build-mesh vertices faces (parse-transform-arguments initargs)))
- (kd-file (make-pathname :type "kd" :defaults pathname)))
- (cond ((probe-file kd-file)
- (setf (mesh-kd-tree mesh)
- (load-kd-tree kd-file)))
- (t
- (let ((tree (build-mesh-kd-tree mesh)))
- (setf (mesh-kd-tree mesh) tree)
- (save-kd-tree tree kd-file))))
- mesh))))
+ (or format (error "Filetype not apparent, please specify :FORMAT"))))
+ (matrix (parse-transform-arguments initargs)))
+ (if (eq :mesh mesh-format)
+ (load-builtin-mesh pathname matrix)
+ (multiple-value-bind (vertices faces)
+ (funcall (find-mesh-loader mesh-format) pathname)
+ (let ((mesh (build-mesh vertices faces matrix)))
+ (if (matrix= matrix (identity-matrix))
+ ;; If we did not transform on load, we can reuse an old
+ ;; KD-tree -- if we have one. If not, build and save one.
+ (let ((kd-file (make-pathname :type "kd" :defaults pathname)))
+ (cond ((probe-file kd-file)
+ (setf (mesh-kd-tree mesh)
+ (load-kd-tree kd-file)))
+ (t
+ (let ((tree (build-mesh-kd-tree mesh)))
+ (setf (mesh-kd-tree mesh) tree)
+ (save-kd-tree tree kd-file)))))
+ (let ((tree (build-mesh-kd-tree mesh)))
+ (setf (mesh-kd-tree mesh) tree)))
+ mesh)))))
(defun build-mesh (vertices faces matrix)
(declare (simple-vector vertices faces))
(let ((map (make-hash-table :test #'equalp))
(indices (make-array (list (length faces) 3) :element-type '(unsigned-byte 32)))
(p 0)
- (max (vec float-negative-infinity float-negative-infinity float-negative-infinity))
- (min (vec float-positive-infinity float-positive-infinity float-positive-infinity)))
+ (min (positive-infinity-vec))
+ (max (negative-infinity-vec)))
(labels ((vertex (face i)
(let ((vertex (transform-point (aref vertices (elt face i)) matrix)))
(%vec-min min min vertex)
@@ -286,3 +300,87 @@
:vertices merged-vertices
:min min
:max max)))))
+
+;;;; BUILT-IN MESH SERIALIZATION
+;;;;
+;;;; Binary format:
+;;;;
+;;;; #x4D455348 (magic bytes, ascii codes for MESH)
+;;;; ub32 (format version, currently zero)
+;;;; ub32 (number of vertices)
+;;;; ub32 (number of indices)
+;;;; single,single,single (vertex)
+;;;; ...repeats for specified number of times
+;;;; ub32,ub32,ub32 (face triplet)
+;;;; ...repeats for specifid number of times
+
+(defconstant +mesh-magic-bytes+ #x4d455348)
+(defconstant +mesh-format-version+ 0)
+
+(defun save-mesh (mesh pathname &key (if-exists :error))
+ (with-open-file (f pathname
+ :element-type '(unsigned-byte 8)
+ :direction :output
+ :if-does-not-exist :create
+ :if-exists if-exists)
+ (let* ((vertices (mesh-vertices mesh))
+ (indices (mesh-indices mesh))
+ (vertex-count (length vertices))
+ (face-count (mesh-face-count mesh)))
+ (write-word +mesh-magic-bytes+ f)
+ (write-word +mesh-format-version+ f)
+ (write-word vertex-count f)
+ (write-word face-count f)
+ (dotimes (i vertex-count)
+ (let ((vertex (aref vertices i)))
+ (dotimes (j 3)
+ (write-single (aref vertex j) f))))
+ (dotimes (i face-count)
+ (dotimes (j 3)
+ (write-word (aref indices i j) f))))
+ (write-kd-tree (mesh-kd-tree mesh) f))
+ mesh)
+
+(defun load-builtin-mesh (pathname matrix)
+ (let ((pathname (merge-pathnames pathname (make-pathname :type "mesh")))
+ (transformp (not (matrix= matrix (identity-matrix)))))
+ (with-open-file (f pathname
+ :element-type '(unsigned-byte 8)
+ :if-does-not-exist :error)
+ (unless (= +mesh-magic-bytes+ (read-word f))
+ (error "~A is not a Raylisp mesh file" pathname))
+ (let ((version (read-word f)))
+ (unless (= +mesh-format-version+ version)
+ (error "Unknown Raylisp mesh format: ~A" version)))
+ (let* ((vertex-count (read-word f))
+ (face-count (read-word f))
+ (vertices (make-array vertex-count))
+ (faces (make-array (list face-count 3) :element-type '(unsigned-byte 32)))
+ (min (positive-infinity-vec))
+ (max (negative-infinity-vec)))
+ (if transformp
+ (dotimes (i vertex-count)
+ (let ((vertex (transform-point
+ (vec (read-single f) (read-single f) (read-single f))
+ matrix)))
+ (%vec-min min min vertex)
+ (%vec-max max max vertex)
+ (setf (aref vertices i) vertex)))
+ (dotimes (i vertex-count)
+ (let ((vertex (vec (read-single f) (read-single f) (read-single f))))
+ (%vec-min min min vertex)
+ (%vec-max max max vertex)
+ (setf (aref vertices i) vertex))))
+ (dotimes (i face-count)
+ (dotimes (j 3)
+ (setf (aref faces i j) (read-word f))))
+ (let ((mesh (make-instance 'mesh
+ :min min
+ :max max
+ :vertices vertices
+ :indices faces)))
+ (setf (mesh-kd-tree mesh)
+ (if transformp
+ (build-mesh-kd-tree mesh)
+ (read-kd-tree f)))
+ mesh)))))
View
16 tests.lisp
@@ -55,17 +55,9 @@
(:camera
*view*))
-;;; The Stanford meshes need to be scaled up on load: otherwise we get
-;;; numerical artifacts trying to intersect tiny triangles -- esp. with
-;;; transformed rays!
-(defvar *stanford-bunny*
- (load-mesh "models/stanford-bunny.ply" :scale 30))
-(defvar *stanford-dragon*
- (load-mesh "models/stanford-dragon.ply" :scale 30))
-
-(defparameter *utah-teapot*
- (load-mesh "models/utah-teapot.obj"
- :rotate (v (deg -90) 0 0)))
+(defparameter *stanford-bunny* (load-mesh "models/stanford-bunny.mesh"))
+(defparameter *stanford-dragon* (load-mesh "models/stanford-dragon.mesh"))
+(defparameter *utah-teapot* (load-mesh "models/utah-teapot.mesh"))
(defscene test-bunny
(:objects
@@ -83,7 +75,7 @@
(make-instance 'pinhole-camera
:location (v 0 10 -15)
:look-at (v 2 2.5 0)
- :focal-length 3.0)))
+ :focal-length 4.0)))
(defscene test-dragon
(:objects
Please sign in to comment.
Something went wrong with that request. Please try again.