Jump to content

Catmull–Clark subdivision surface/Tcl Test Code: Difference between revisions

m
→‎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 [[Catmull-ClaarkCatmull–Clark subdivision surface#Tcl|Catmull-Clark]] problem.
 
{{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] {set d1 [expr {$d1 + [lindex $p 1]}]}
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)}]
}
foreach p [selectFrom $points $face2] {set d2 [expr {$d2 + [lindex $p 1]}]}
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 {100200. + 90190. * (0.867 * $x - 0.59396 * $y)}] \
[expr {100200 + 90190. * (0.865 * $x + 0.3402 * $y - $z)}]
}
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]
$w create polygon $c -fill {}$grey {*}$args
}
}</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]
}
# Try removing one{1 of2 the6 faces5} to demonstrate holes.
set faces {
{0 18 29 31}
{01 39 710 42}
{2 10 11 3}
{3 11 8 0}
{0 1 5 4}
{31 2 6 75}
{12 53 67 26}
{43 70 64 57}
{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 blackwhite -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 green -fill green4#0000cc</lang>
==Program Output==
[[File:Tcl-Catmull.png]]
<br>
This figure shows the result of running the code on this page.
Anonymous user
Cookies help us deliver our services. By using our services, you agree to our use of cookies.