diff --git a/kons-9.asd b/kons-9.asd index 49aca1b..c87a022 100644 --- a/kons-9.asd +++ b/kons-9.asd @@ -103,6 +103,9 @@ (:file "src/plugins/sprite") (:file "src/plugins/poly-mesh") (:file "src/plugins/subdiv-mesh") + (:file "src/plugins/refine-subdiv-mesh") + (:file "src/plugins/smooth-subdiv-mesh") + (:file "src/plugins/fractal-subdiv-mesh") (:file "src/plugins/usd") (:file "src/plugins/obj") (:file "src/plugins/stl") diff --git a/src/plugins/fractal-subdiv-mesh.lisp b/src/plugins/fractal-subdiv-mesh.lisp new file mode 100644 index 0000000..f687482 --- /dev/null +++ b/src/plugins/fractal-subdiv-mesh.lisp @@ -0,0 +1,26 @@ +(in-package #:kons-9) + +;;;; fractal-subdiv-mesh =============================================================== + +;;; subclass of subdiv-mesh which does fractal mesh subdivision + +(defclass-kons-9 fractal-subdiv-mesh (refine-subdiv-mesh) + ((vertex-displacement 1.0))) + +(defmethod compute-subdiv-points ((mesh fractal-subdiv-mesh) (subdiv fractal-subdiv-mesh)) + (call-next-method) ;generate refined vertex positions + (setf (points subdiv) (map 'vector #'point (sm-vertices subdiv))) ;update polyhedron points + (compute-normals subdiv) ;update normals + (set-fractal-points mesh subdiv)) + +(defun set-fractal-points (mesh subdiv) + (let ((points (points subdiv)) + (normals (point-normals subdiv)) + (vertices (sm-vertices subdiv)) + (displacement (vertex-displacement mesh))) + (loop for i from (length (sm-vertices mesh)) below (length (sm-vertices subdiv)) + do (let ((p (aref points i)) + (n (aref normals i))) + (setf (point (aref vertices i)) + (p+ p (p* n (rand1 displacement)))))) + (setf (vertex-displacement subdiv) (/ displacement 2.0)))) diff --git a/src/plugins/refine-subdiv-mesh.lisp b/src/plugins/refine-subdiv-mesh.lisp new file mode 100644 index 0000000..2dbf2cd --- /dev/null +++ b/src/plugins/refine-subdiv-mesh.lisp @@ -0,0 +1,42 @@ +(in-package #:kons-9) + +;;;; refine-subdiv-mesh =============================================================== + +;;; subclass of subdiv-mesh which does simple mesh refinement + +(defclass-kons-9 refine-subdiv-mesh (subdiv-mesh) + ()) + +(defmethod compute-subdiv-points ((mesh refine-subdiv-mesh) (subdiv refine-subdiv-mesh)) + (set-refine-face-vertex-points mesh subdiv) + (set-refine-edge-vertex-points mesh subdiv) + (set-refine-vertex-vertex-points mesh subdiv)) + +;;; the methods below are the same as for smooth-subdiv-mesh paper but simply assume +;;; all edges and vertices are boundary + +(defun set-refine-face-vertex-points (mesh subdiv) + (do-array (x h (sm-half-edges mesh)) + (let ((m (half-edge-cycle-length mesh h)) + (v (vertex h)) + (i (+ (length (sm-vertices mesh)) (face h)))) + (setf (point (sm-nth-vertex subdiv i)) + (p+ (point (sm-nth-vertex subdiv i)) + (p/ (point (sm-nth-vertex mesh v)) m)))))) + +(defun set-refine-edge-vertex-points (mesh subdiv) + (do-array (x h (sm-half-edges mesh)) + (let ((v0 (vertex h)) + (v1 (vertex (sm-nth-half-edge mesh (next-half-edge h)))) + (j (+ (length (sm-vertices mesh)) (length (sm-faces mesh)) (edge h)))) + (setf (point (sm-nth-vertex subdiv j)) + (p/ (p+ (point (sm-nth-vertex mesh v0)) + (point (sm-nth-vertex mesh v1))) + 2))))) + +(defun set-refine-vertex-vertex-points (mesh subdiv) + (do-array (x h (sm-half-edges mesh)) + (let ((v (vertex h))) + (setf (point (sm-nth-vertex subdiv v)) + (p:copy (point (sm-nth-vertex mesh v))))))) + diff --git a/src/plugins/smooth-subdiv-mesh.lisp b/src/plugins/smooth-subdiv-mesh.lisp new file mode 100644 index 0000000..4c60582 --- /dev/null +++ b/src/plugins/smooth-subdiv-mesh.lisp @@ -0,0 +1,94 @@ +(in-package #:kons-9) + +;;;; smooth-subdiv-mesh ======================================================== + +;;; subclass of subdiv-mesh which does smooth mesh refinement +;;; smoothing based on https://onrendering.com/data/papers/catmark/HalfedgeCatmullClark.pdf + +(defclass-kons-9 smooth-subdiv-mesh (subdiv-mesh) + ()) + +(defmethod compute-subdiv-points ((mesh smooth-subdiv-mesh) (subdiv smooth-subdiv-mesh)) + (set-smooth-face-vertex-points mesh subdiv) + (set-smooth-edge-vertex-points mesh subdiv) + (set-smooth-vertex-vertex-points mesh subdiv)) + ;; TODO - sharp creases + ;; (set-subdiv-edge-vertex-crease-points mesh subdiv) + ;; (set-subdiv-vertex-vertex-crease-points mesh subdiv) + ;; (set-subdiv-edge-sharpness mesh subdiv) + +(defun set-smooth-face-vertex-points (mesh subdiv) + (do-array (x h (sm-half-edges mesh)) + (let ((m (half-edge-cycle-length mesh h)) + (v (vertex h)) + (i (+ (length (sm-vertices mesh)) (face h)))) + (setf (point (sm-nth-vertex subdiv i)) + (p+ (point (sm-nth-vertex subdiv i)) + (p/ (point (sm-nth-vertex mesh v)) m)))))) + +(defun set-smooth-edge-vertex-points (mesh subdiv) + (do-array (x h (sm-half-edges mesh)) + (if (is-boundary-edge? (sm-nth-edge mesh (edge h))) + (let ((v0 (vertex h)) + (v1 (vertex (sm-nth-half-edge mesh (next-half-edge h)))) + (j (+ (length (sm-vertices mesh)) (length (sm-faces mesh)) (edge h)))) + (setf (point (sm-nth-vertex subdiv j)) + (p/ (p+ (point (sm-nth-vertex mesh v0)) + (point (sm-nth-vertex mesh v1))) + 2))) + (let ((v (vertex h)) + (i (+ (length (sm-vertices mesh)) (face h))) + (j (+ (length (sm-vertices mesh)) (length (sm-faces mesh)) (edge h)))) + (setf (point (sm-nth-vertex subdiv j)) + (p+ (point (sm-nth-vertex subdiv j)) + (p/ (p+ (point (sm-nth-vertex mesh v)) + (point (sm-nth-vertex subdiv i))) + 4))))))) + +;;; TODO - sharp creases +;; (defun set-smooth-edge-vertex-crease-points (mesh subdiv) +;; (do-array (x h (sm-half-edges mesh)) +;; (when (> (sharpness (sm-nth-edge mesh (edge h))) 0) +;; (let ((v0 (vertex h)) +;; (v1 (vertex (sm-nth-half-edge mesh (next-half-edge h)))) +;; (j (+ (length (sm-vertices mesh)) (length (sm-faces mesh)) (edge h)))) +;; (setf (point (sm-nth-vertex subdiv j)) +;; (p:lerp (point (sm-nth-vertex subdiv j)) +;; (p/ (p+ (point (sm-nth-vertex mesh v0)) +;; (point (sm-nth-vertex mesh v1))) +;; 2) +;; (sharpness (sm-nth-edge mesh (edge h))))))))) + +(defun set-smooth-vertex-vertex-points (mesh subdiv) + (do-array (x h (sm-half-edges mesh)) + (let ((v (vertex h))) + (if (is-boundary-vertex? (sm-nth-vertex mesh v)) + (setf (point (sm-nth-vertex subdiv v)) + (p:copy (point (sm-nth-vertex mesh v)))) + (let ((n (half-edge-valence mesh h)) + (i (+ (length (sm-vertices mesh)) (face h))) + (j (+ (length (sm-vertices mesh)) (length (sm-faces mesh)) (edge h)))) + (setf (point (sm-nth-vertex subdiv v)) + (p+ (point (sm-nth-vertex subdiv v)) + (p/ (p+ (p+ (p* (point (sm-nth-vertex subdiv j)) 4) + (p:negate (point (sm-nth-vertex subdiv i)))) + (p* (point (sm-nth-vertex mesh v)) (- n 3))) + (* n n))))))))) + +;;; TODO - sharp creases +;; (defun set-smooth-vertex-vertex-crease-points (mesh subdiv) +;; (do-array (x h (sm-half-edges mesh)) +;; (let* ((v (vertex h)) +;; (sharpness (sm-vertex-sharpness mesh v))) +;; (when (> sharpness 0) +;; (setf (point (sm-nth-vertex subdiv v)) +;; (p:lerp (point (sm-nth-vertex subdiv v)) +;; (point (sm-nth-vertex mesh v)) +;; sharpness)))))) + +;;; TODO - sharp creases +;; (defun set-smooth-edge-sharpness (mesh subdiv) +;; (do-array (i e (sm-edges mesh)) +;; (setf (sharpness (sm-nth-edge subdiv (* 2 i))) (sharpness e)) +;; (setf (sharpness (sm-nth-edge subdiv (+ (* 2 i) 1))) (sharpness e)))) + diff --git a/src/plugins/subdiv-mesh.lisp b/src/plugins/subdiv-mesh.lisp index 490b34c..81c3132 100644 --- a/src/plugins/subdiv-mesh.lisp +++ b/src/plugins/subdiv-mesh.lisp @@ -19,7 +19,8 @@ (selected? nil))) (defclass-kons-9 sm-edge () - ((is-boundary-edge? nil))) + (;(sharpness 0);;; TODO - sharp creases + (is-boundary-edge? nil))) (defclass-kons-9 sm-half-edge () ((mesh nil) @@ -41,6 +42,9 @@ (declare (ignore initargs)) (initialize-topology mesh)) +(defmethod compute-subdiv-points ((mesh subdiv-mesh) (subdiv subdiv-mesh)) + (error "SUBDIV-MESH ~a has no COMPUTE-SUBDIV-POINTS method defined" mesh)) + (defmethod add-vertex ((mesh subdiv-mesh) (vertex sm-vertex)) (vector-push-extend vertex (sm-vertices mesh))) @@ -69,11 +73,21 @@ (let* ((e0 (sm-half-edge (sm-nth-vertex mesh v))) (e e0)) (loop :do (setf e (prev-half-edge (sm-nth-half-edge mesh (pair-half-edge (sm-nth-half-edge mesh e))))) - :collect e - :while (not (eq e e0))))) + :collect (sm-nth-half-edge mesh e) + :while (not (= e e0))))) + +(defmethod sm-vertex-edges ((mesh subdiv-mesh) v) + (mapcar (lambda (e) (sm-nth-edge mesh (edge e))) + (sm-vertex-half-edges mesh v))) + +;;; TODO - sharp creases +;; (defmethod sm-vertex-sharpness ((mesh subdiv-mesh) v) +;; (let ((edge-sharpness-list (mapcar #'sharpness (sm-vertex-edges mesh v)))) +;; (/ (reduce #'+ edge-sharpness-list) (length edge-sharpness-list)))) (defmethod sm-vertex-vertices ((mesh subdiv-mesh) v) - (mapcar (lambda (e) (vertex (sm-nth-half-edge mesh e))) (sm-vertex-half-edges mesh v))) + (mapcar (lambda (e) (sm-nth-vertex mesh (vertex e))) + (sm-vertex-half-edges mesh v))) ;; (let* ((e0 (sm-half-edge (sm-nth-vertex mesh v))) ;; (e e0)) @@ -226,6 +240,16 @@ (= (pair-half-edge e1) (pair-half-edge e2)) )))) +;;; return array of all levels of a subdiv-mesh +(defmethod subdivide-mesh-into-array ((mesh subdiv-mesh) &optional (levels 1)) + (let* ((mesh-array (make-array levels)) + (curr-mesh mesh)) + (dotimes (i levels) + (let ((level-mesh (if (= 0 i) mesh (subdivide-mesh curr-mesh 1)))) + (setf (aref mesh-array i) level-mesh) + (setf curr-mesh level-mesh))) + mesh-array)) + (defmethod subdivide-mesh ((mesh subdiv-mesh) &optional (levels 1)) (if (<= levels 0) mesh @@ -240,7 +264,7 @@ (ne (+ (* 2 (length (sm-edges mesh))) (faces-num-points-refs mesh))) (nhe (* 4 (length (sm-half-edges mesh)))) - (subdiv (make-instance 'subdiv-mesh + (subdiv (make-instance (class-name (class-of mesh)) ;'subdiv-mesh :sm-vertices (make-array-with-fn nv (lambda () (make-instance 'sm-vertex))) :sm-faces (make-array-with-fn nf (lambda () @@ -330,9 +354,7 @@ (setf (faces subdiv) prefs)) ;; compute point locations - (set-subdiv-face-vertex-points mesh subdiv) - (set-subdiv-edge-vertex-points mesh subdiv) - (set-subdiv-vertex-vertex-points mesh subdiv) + (compute-subdiv-points mesh subdiv) (setf (points subdiv) (map 'vector #'point (sm-vertices subdiv))) (compute-normals subdiv) subdiv)) @@ -353,49 +375,6 @@ :while (not (eq h0 h))) n)) -(defun set-subdiv-face-vertex-points (mesh subdiv) - (do-array (x h (sm-half-edges mesh)) - (let ((m (half-edge-cycle-length mesh h)) - (v (vertex h)) - (i (+ (length (sm-vertices mesh)) (face h)))) - (setf (point (sm-nth-vertex subdiv i)) (p+ (point (sm-nth-vertex subdiv i)) - (p/ (point (sm-nth-vertex mesh v)) m)))))) - -(defun set-subdiv-edge-vertex-points (mesh subdiv) - (do-array (x h (sm-half-edges mesh)) - (if (is-boundary-edge? (sm-nth-edge mesh (edge h))) - (let ((v0 (vertex h)) - (v1 (vertex (sm-nth-half-edge mesh (next-half-edge h)))) - (j (+ (length (sm-vertices mesh)) (length (sm-faces mesh)) (edge h)))) - (setf (point (sm-nth-vertex subdiv j)) - (p+ (point (sm-nth-vertex subdiv j)) - (p/ (p+ (point (sm-nth-vertex mesh v0)) - (point (sm-nth-vertex mesh v1))) - 2)))) - (let ((v (vertex h)) - (i (+ (length (sm-vertices mesh)) (face h))) - (j (+ (length (sm-vertices mesh)) (length (sm-faces mesh)) (edge h)))) - (setf (point (sm-nth-vertex subdiv j)) - (p+ (point (sm-nth-vertex subdiv j)) - (p/ (p+ (point (sm-nth-vertex mesh v)) - (point (sm-nth-vertex subdiv i))) - 4))))))) - -(defun set-subdiv-vertex-vertex-points (mesh subdiv) - (do-array (x h (sm-half-edges mesh)) - (let ((v (vertex h))) - (if (is-boundary-vertex? (sm-nth-vertex mesh v)) - (setf (point (sm-nth-vertex subdiv v)) - (point (sm-nth-vertex mesh v))) - (let ((n (half-edge-valence mesh h)) - (i (+ (length (sm-vertices mesh)) (face h))) - (j (+ (length (sm-vertices mesh)) (length (sm-faces mesh)) (edge h)))) - (setf (point (sm-nth-vertex subdiv v)) - (p+ (point (sm-nth-vertex subdiv v)) - (p/ (p+ (p+ (p* (point (sm-nth-vertex subdiv j)) 4) - (p:negate (point (sm-nth-vertex subdiv i)))) - (p* (point (sm-nth-vertex mesh v)) (- n 3))) - (* n n))))))))) #| (defmethod verify-topology ((mesh subdiv-mesh)) diff --git a/test/demo-misc.lisp b/test/demo-misc.lisp index eaef89d..cf9bba1 100644 --- a/test/demo-misc.lisp +++ b/test/demo-misc.lisp @@ -98,20 +98,70 @@ Make sure you have opened the graphics window by doing: ;;; subdiv-mesh ---------------------------------------------------------------- (with-clear-scene - (let ((mesh (translate-to (make-cube 2.0 :name 'cube :mesh-type 'subdiv-mesh) - ;(make-square-polyhedron 2.0 :name 'square :mesh-type 'subdiv-mesh) + (let ((mesh (translate-to (make-cube 2.0 :mesh-type 'refine-subdiv-mesh) + ;(make-square-polyhedron 2.0 :mesh-type 'refine-subdiv-mesh) (p! 4 0 0)))) -; (randomize-points mesh (p! 1 1 1)) (add-shape *scene* mesh) (let* ((subdiv (subdivide-mesh mesh))) (add-shape *scene* subdiv) - (randomize-points subdiv (p! .5 .5 .5)) -; (randomize-points subdiv (p! 0 0 1)) + (randomize-points subdiv (p! .25 .25 .25)) (let ((subdiv2 (subdivide-mesh subdiv 4))) (add-shape *scene* subdiv2) (translate-to subdiv2 (p! -4 0 0)) )))) +(with-clear-scene + (let ((mesh (translate-to (make-cube 2.0 :mesh-type 'smooth-subdiv-mesh) + ;(make-square-polyhedron 2.0 :mesh-type 'smooth-subdiv-mesh) + (p! 4 0 0)))) + (add-shape *scene* mesh) + (let* ((subdiv (subdivide-mesh mesh))) + (add-shape *scene* subdiv) + (randomize-points subdiv (p! .25 .25 .25)) + (let ((subdiv2 (subdivide-mesh subdiv 4))) + (add-shape *scene* subdiv2) + (translate-to subdiv2 (p! -4 0 0)) + )))) + +(with-clear-scene + (let ((mesh (translate-to (make-cube 2.0 :mesh-type 'fractal-subdiv-mesh) + ;(make-square-polyhedron 2.0 :mesh-type 'fractal-subdiv-mesh) + (p! 2 0 0)))) + (add-shape *scene* mesh) + (setf (vertex-displacement mesh) 0.4) + (let* ((subdiv (subdivide-mesh mesh 5))) + (add-shape *scene* subdiv) + (translate-to subdiv (p! -2 0 0)) + ))) + +;;; animated subdivide-mesh ---------------------------------------------------- + +(defun make-animated-subdiv-scene (mesh levels) + (let ((group (make-instance 'variant-manager-group + :children (subdivide-mesh-into-array mesh levels)))) + (compute-procedural-node group) ;need to manually trigger compute node after creation + (add-shape *scene* group) + (add-motion *scene* + (make-instance 'animator + :setup-fn (lambda () (setf (visible-index group) 0)) + :update-fn (lambda () (setf (visible-index group) + (current-frame *scene*))))) + (setf (end-frame *scene*) (1- (length (children group)))))) + +(with-clear-scene + (let* ((base-mesh (freeze-transform (rotate-by (make-square-polyhedron 6.0 :mesh-type 'fractal-subdiv-mesh) (p! -90 0 0))))) + (make-animated-subdiv-scene base-mesh 7))) + +(with-clear-scene + (let* ((base-mesh (make-cube 4.0 :mesh-type 'smooth-subdiv-mesh))) + (randomize-points base-mesh (p! 1 1 1)) + (make-animated-subdiv-scene base-mesh 7))) + +(with-clear-scene + (let* ((base-mesh (make-cube 4.0 :mesh-type 'refine-subdiv-mesh))) + (randomize-points base-mesh (p! 1 1 1)) + (make-animated-subdiv-scene base-mesh 7))) + ;;; l-system ------------------------------------------------------------------ (format t " l-system...~%") (finish-output)