Anonymous user
Catmull–Clark subdivision surface/Tcl Test Code: Difference between revisions
Catmull–Clark subdivision surface/Tcl Test Code (view source)
Revision as of 01:35, 18 January 2010
, 14 years ago→Program Output: add break to make wrapping better
(My demonstration code) |
m (→Program Output: add break to make wrapping better) |
||
| (5 intermediate revisions by 2 users not shown) | |||
Line 1:
This is the test code for the [[Tcl]] solution of the [[
{{libheader|Tk}}
==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
foreach p [selectFrom $points $face2] {set d2 [expr {$d2 + [lindex $p 1]}]}▼
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}
}
# Plots a net defined in points-and-faces fashion
proc visualizeNet {w points faces args} {
Line 18 ⟶ 24:
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 {
[expr {
}
lassign $centroid x y z
$w create polygon $c -fill {} {*}$args▼
set depth [expr {int(255*sqrt($x*$x + $y*$y + $z*$z) / sqrt(3.))}]
set grey [format #%02x%02x%02x $depth $depth $depth]
}
}</lang>
Line 31 ⟶ 42:
(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]
# Points to define the unit cube
set points {
Line 44 ⟶ 55:
{0.0 1.0 1.0}
}
foreach pt $points {
# Try removing one of the faces to demonstrate holes.▼
lassign $pt x y z
lappend points [list [expr {0.25 + 0.5*$x}] [expr {0.25 + 0.5*$y}] $z]
}
set faces {
{0
{
{2 10 11 3}
{3 11 8 0}
{0 1 5 4}
{
{
{
{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
# 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
==Program Output==
[[File:Tcl-Catmull.png]]
<br>
This figure shows the result of running the code on this page.
| |||