Catmull–Clark subdivision surface/Tcl Test Code

This is the test code for the Tcl solution of the Catmull-Clark problem.

Library: Tk

Utility Functions

<lang tcl>package require Tk

1. A simple-minded ordering function for faces

proc orderf {points face1 face2} {

   set d1 [set d2 0.0]
   foreach p [selectFrom $points $face1] {

lassign $p x y z set d1 [expr {$d1 + sqrt($x*$x + $y*$y + $z*$z)}]

   }
   foreach p [selectFrom $points $face2] {

lassign $p x y z set d2 [expr {$d2 + sqrt($x*$x + $y*$y + $z*$z)}]

   }
   expr {$d1<$d2 ? -1 : $d1>$d2 ? 1 : 0}

}

1. Plots a net defined in points-and-faces fashion

proc visualizeNet {w points faces args} {

   foreach face [lsort -command [list orderf $points] $faces] {

set c {} set polyCoords [selectFrom $points $face] set sum {[list 0. 0. 0.]} set centroid [centroid $polyCoords] foreach coord $polyCoords { lassign $coord x y z lappend c \ [expr {200. + 190. * (0.867 * $x - 0.9396 * $y)}] \ [expr {200 + 190. * (0.5 * $x + 0.3402 * $y - $z)}] } lassign $centroid x y z set depth [expr {int(255*sqrt($x*$x + $y*$y + $z*$z) / sqrt(3.))}] set grey [format #%02x%02x%02x $depth $depth $depth] $w create polygon $c -fill $grey {*}$args

   }

}</lang>

Demonstration

(Using the utility functions from above, plus the code from the main solution page.) <lang tcl># Make a display surface pack [canvas .c -width 400 -height 400 -background #7f7f7f]

1. Points to define the unit cube

set points {

   {0.0 0.0 0.0}
   {1.0 0.0 0.0}
   {1.0 1.0 0.0}
   {0.0 1.0 0.0}
   {0.0 0.0 1.0}
   {1.0 0.0 1.0}
   {1.0 1.0 1.0}
   {0.0 1.0 1.0}

} foreach pt $points {

   lassign $pt x y z
   lappend points [list [expr {0.25 + 0.5*$x}] [expr {0.25 + 0.5*$y}] $z]

}

1. Try removing {1 2 6 5} to demonstrate holes.

set faces {

   {0 8 9 1}
   {1 9 10 2}
   {2 10 11 3}
   {3 11 8 0}
   {0 1 5 4}
   {1 2 6 5}
   {2 3 7 6}
   {3 0 4 7}
   {4 5 13 12}
   {5 6 14 13}
   {6 7 15 14}
   {7 4 12 15}
   {8 9 13 12}
   {9 10 14 13}
   {10 11 15 14}
   {11 8 12 15}

}

1. Show the initial layout

visualizeNet .c $points $faces -outline white -fill {}

1. Apply the Catmull-Clark algorithm to generate a new surface

lassign [CatmullClark $points $faces] points2 faces2

1. 1. Uncomment the next line to get the second level of subdivision

lassign [CatmullClark $points2 $faces2] points2 faces2 lassign [CatmullClark $points2 $faces2] points2 faces2

1. Visualize the new surface

visualizeNet .c $points2 $faces2 -outline #0000cc</lang>