⚠️ Warning: This is a draft ⚠️
This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.
If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.
This is the test code for the [[Tcl]] solution of the [[Catmull–Clark subdivision surface#Tcl|Catmull-Clark]] problem.
{{libheader|Tk}} ==Utility Functions==
package require Tk # 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} } # 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 } }
==Demonstration== (Using the utility functions from above, plus the code from the main solution page.)
# Make a display surface pack [canvas .c -width 400 -height 400 -background #7f7f7f] # 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] } # 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} } # Show the initial layout visualizeNet .c $points $faces -outline white -fill {} # Apply the Catmull-Clark algorithm to generate a new surface lassign [CatmullClark $points $faces] points2 faces2 ## Uncomment the next line to get the second level of subdivision lassign [CatmullClark $points2 $faces2] points2 faces2 lassign [CatmullClark $points2 $faces2] points2 faces2 # Visualize the new surface visualizeNet .c $points2 $faces2 -outline #0000cc
==Program Output== [[File:Tcl-Catmull.png]]
This figure shows the result of running the code on this page.