Added subdiv-mesh subclasses

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")

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))))

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)))))))
+

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))))
+

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))

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)