Catmull–Clark subdivision surface/Tcl Test Code: Difference between revisions
m (correct link) |
|||
Line 4: | Line 4: | ||
==Utility Functions== |
==Utility Functions== |
||
<lang tcl>package require Tk |
<lang tcl>package require Tk |
||
# A simple-minded ordering function for faces |
# A simple-minded ordering function for faces |
||
proc orderf {points face1 face2} { |
proc orderf {points face1 face2} { |
||
set d1 [set d2 0.0] |
set d1 [set d2 0.0] |
||
foreach p [selectFrom $points $face1] { |
foreach p [selectFrom $points $face1] { |
||
lassign $p x y z |
|||
⚫ | |||
set d1 [expr {$d1 + sqrt($x*$x + $y*$y + $z*$z)}] |
|||
} |
|||
⚫ | |||
lassign $p x y z |
|||
set d2 [expr {$d2 + sqrt($x*$x + $y*$y + $z*$z)}] |
|||
} |
|||
expr {$d1<$d2 ? -1 : $d1>$d2 ? 1 : 0} |
expr {$d1<$d2 ? -1 : $d1>$d2 ? 1 : 0} |
||
} |
} |
||
# Plots a net defined in points-and-faces fashion |
# Plots a net defined in points-and-faces fashion |
||
proc visualizeNet {w points faces args} { |
proc visualizeNet {w points faces args} { |
||
Line 18: | Line 24: | ||
set c {} |
set c {} |
||
set polyCoords [selectFrom $points $face] |
set polyCoords [selectFrom $points $face] |
||
set sum {[list 0. 0. 0.]} |
|||
set centroid [centroid $polyCoords] |
|||
foreach coord $polyCoords { |
foreach coord $polyCoords { |
||
lassign $coord x y z |
lassign $coord x y z |
||
lappend c \ |
lappend c \ |
||
[expr { |
[expr {200. + 190. * (0.867 * $x - 0.9396 * $y)}] \ |
||
[expr { |
[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] |
|||
⚫ | |||
} |
} |
||
}</lang> |
}</lang> |
Revision as of 01:18, 18 January 2010
This is the test code for the Tcl solution of the Catmull-Clark problem.
Utility Functions
<lang tcl>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
}
}</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]
- 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}
}
- Try removing one of the faces to demonstrate holes.
set faces {
{0 1 2 3} {0 3 7 4} {0 1 5 4} {3 2 6 7} {1 5 6 2} {4 7 6 5}
}
- Show the initial layout
visualizeNet .c $points $faces -outline black
- 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
- Visualize the new surface
visualizeNet .c $points2 $faces2 -outline green -fill green4</lang>