Catmull–Clark subdivision surface/Tcl Test Code: Difference between revisions
Content added Content deleted
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> |