[Keith Vetter] 2003-04-07: this [whizzlet] draws both the standard [Hilbert Curve] and a analogous one in 3-dimensions. One clever aspect of this program is how it does hidden surface removal. The simple painters algorithm--drawing distant objects first so nearer objects ''paint'' over obscured surfaces (as used in [Fractal Mountains])--doesn't work easily because the components of the curve can't be generated in a back-to-front ordering. Instead, it uses tk's canvas stacking order. As each object gets generated it is tagged with its depth; then when everything is drawn, then '''canvas raise''' is used to place nearer objects before distant ones. This method won't work for complex objects but for the simple ones here it makes an effective hidden surface algorithm. ---- [LV] is there a relationship between this code and the [sdarchive] [starkit] that talks about the same thing? In cases where wiki code is turned into starkits, perhaps the starkit's url could be added to the appropriate page, and, vice versa, the wikit page could be placed in the starkit's help information, so that someone with problems knows where to submit questions and comments? ---- ##+########################################################################## # # hilbert3d.tcl -- draws the Hilbert Curve in both 2 and 3 dimensions # by Keith Vetter # package require Tk namespace eval 3D { variable matrix variable 3d set 3d(ex) 3 ;# Eye position set 3d(ey) 4 set 3d(ez) 3 set 3d(rx) 0 ;# Reference point set 3d(ry) 0 set 3d(rz) 0 } array set S {lvl 0 color cyan connect 1 3d 3 eye 3 3Dtype 0} array set DIRS {E {S E E N} N {W N N E} S {E S S W} W {N W W S}} array set QTRS {E {1 2 3 4} N {3 2 1 4} S {1 4 3 2} W {3 4 1 2}} array set XY {E {l t r t r b l b} N {r b r t l t l b} W {r b l b l t r t} S {l t l b r b r t}} array set hpath3d { 0,start 1 0,path {X z x Y X Z x} 0,sub { 1 2 2 20 20 4 4 5} 1,start 1 1,path {z Y Z X z y Z} 1,sub { 6 7 7 19 19 9 9 10} 2,start 1 2,path {X Y x z X y x} 2,sub {11 0 0 23 23 14 14 15} 3,start 4 3,path {x Z X Y x z X} 3,sub {16 17 17 7 7 13 13 8} 4,start 2 4,path {X y x Z X Y x} 4,sub {19 14 14 10 10 0 0 22} 5,start 7 5,path {z y Z x z Y Z} 5,sub {23 9 9 15 15 7 7 21} 6,start 1 6,path {Y X y z Y x y} 6,sub { 0 11 11 13 13 15 15 14} 7,start 1 7,path {z X Z Y z x Z} 7,sub { 2 1 1 3 3 5 5 4} 8,start 2 8,path {Z y z X Z Y z} 8,sub {21 18 18 11 11 20 20 23} 9,start 7 9,path {z x Z y z X Z} 9,sub {13 5 5 14 14 1 1 17} 10,start 4 10,path {Y x y Z Y X y} 10,sub { 3 15 15 4 4 11 11 12} 11,start 1 11,path {Y z y X Y Z y} 11,sub { 7 6 6 8 8 10 10 9} 12,start 7 12,path {x z X y x Z X} 12,sub { 5 13 13 18 18 17 17 1} 13,start 7 13,path {x y X z x Y X} 13,sub {22 12 12 6 6 3 3 19} 14,start 2 14,path {X Z x y X z x} 14,sub { 8 4 4 9 9 2 2 16} 15,start 4 15,path {Y Z y x Y z y} 15,sub {20 10 10 5 5 6 6 18} 16,start 4 16,path {Z Y z x Z y z} 16,sub {10 20 20 22 22 18 18 6} 17,start 4 17,path {x Y X Z x y X} 17,sub {15 3 3 21 21 12 12 11} 18,start 2 18,path {Z X z y Z x z} 18,sub { 4 8 8 12 12 16 16 2} 19,start 2 19,path {y Z Y X y z Y} 19,sub {18 21 21 1 1 23 23 20} 20,start 4 20,path {Z x z Y Z X z} 20,sub {17 16 16 0 0 8 8 13} 21,start 2 21,path {y X Y Z y x Y} 21,sub {14 19 19 17 17 22 22 0} 22,start 7 22,path {y z Y x y Z Y} 22,sub { 9 23 23 16 16 21 21 7} 23,start 7 23,path {y x Y z y X Y} 23,sub {12 22 22 2 2 19 19 3} } proc DoDisplay {} { global S wm title . TkHilbert option add *Scale.highlightThickness 0 option add *Scale.orient horizontal pack [frame .ctrl -relief ridge -bd 2 -padx 5 -pady 5] \ -side right -fill both -ipady 5 pack [frame .top -relief raised -bd 2] -side top -fill x pack [frame .screen -bd 2 -relief raised] -side top -fill both -expand 1 canvas .c -relief raised -borderwidth 0 -height 500 -width 500 label .msg -textvariable S(msg) -bd 2 -bg white -relief ridge pack .msg -side bottom -fill both -in .screen pack .c -side top -expand 1 -fill both -in .screen set colors {red orange yellow green blue cyan purple violet white} lappend colors [lindex [.c config -bg] 3] black foreach color $colors { radiobutton .top.b$color -width 1 -padx 0 -pady 0 -bg $color \ -variable S(color) -value $color -command ReColor bind .top.b$color <3> [list .c config -bg $color] } eval pack [winfo children .top] -side left -fill y DoCtrlFrame ReColor update trace variable S(draw) w Tracer trace variable S(3d) w Tracer bind .sLevel {if {! $S(draw)} DrawHilbertA} } proc DoCtrlFrame {} { frame .ctrl.top scale .sLevel -from 0 -to 7 -label Level -variable S(lvl) -relief ridge .sLevel configure -font "[font actual [.sLevel cget -font]] -weight bold" button .draw -text "Draw Curve" -command DrawHilbertA -bd 4 button .clear -text "Clear Curve" -command {.c delete all} -bd 4 button .stop -text "Stop Drawing" -command {set S(draw) 0} -bd 4 .draw configure -font "[font actual [.draw cget -font]] -weight bold" .clear configure -font [.draw cget -font] .stop configure -font [.draw cget -font] image create bitmap ::img::up -data { #define up_width 11 #define up_height 9 static char up_bits = { 0x00, 0x00, 0x20, 0x00, 0x70, 0x00, 0xf8, 0x00, 0xfc, 0x01, 0xfe, 0x03, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00 }} image create bitmap ::img::down -data { #define down_width 11 #define down_height 9 static char down_bits = { 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0xfe, 0x03, 0xfc, 0x01, 0xf8, 0x00,0x70, 0x00, 0x20, 0x00, 0x00, 0x00 }} button .up -image ::img::up -command {UpDown 1} button .down -image ::img::down -command {UpDown -1} checkbutton .connect -text "Show Connections" -variable S(connect) \ -relief raised -command ShowConnectors button .about -text About -command About frame .3df -bd 2 -relief ridge radiobutton .2d -text "2 Dimensions" -variable S(3d) -value 2 \ -command DrawHilbertA -relief ridge radiobutton .3d -text "3 Dimensions" -variable S(3d) -value 3 \ -command DrawHilbertA label .leye -text "Eye Position" -bd 2 -relief raised foreach q {x y z} { frame .feye$q -bd 2 -relief raised label .leye$q -text [string toupper $q] scale .eye$q -from -0 -to 10 -relief ridge -length 75 -orient v \ -variable ::3D::3d(e$q) bind .eye$q {if {$S(3d)==3 && !$S(draw)} DrawHilbertA} pack .leye$q .eye$q -in .feye$q -side top -fill x } grid .ctrl.top -in .ctrl -row 0 -sticky news grid .sLevel .up -in .ctrl.top -row 0 -sticky news grid ^ .down -in .ctrl.top -row 1 -sticky news grid .draw -in .ctrl -row 21 -sticky ew grid .clear -in .ctrl -row 22 -sticky ew grid .stop -in .ctrl -row 23 -sticky ew -pady 10 grid .2d -in .ctrl -row 31 -sticky ew grid .3df -in .ctrl -row 32 -sticky ew grid rowconfigure .3df 1 -minsize 10 grid .3d - - -in .3df -row 1 -sticky ew grid .leye - - -in .3df -row 2 -sticky ew grid .feyex .feyey .feyez -in .3df -row 3 grid .connect -in .ctrl -row 101 -sticky ew grid .about -in .ctrl -row 102 -sticky ew grid rowconfigure .ctrl 10 -minsize 10 grid rowconfigure .ctrl 20 -minsize 10 grid rowconfigure .ctrl 30 -minsize 50 grid rowconfigure .ctrl 50 -weight 1 grid configure .up -ipadx 5 grid configure .down -ipadx 5 } ##+########################################################################## # # Tracer -- traces the S(draw) variable and activates widgets accordingly # proc Tracer {var1 var2 op} { global S set eyes {.leye .eyex .eyey .eyez .leyex .leyey .leyez} set ww {.up .down .connect .draw .clear .3d} if {$var1 == "S" && $var2 == "3d"} { if {$S(3d) == 3} {set state1 normal} else { set state1 disabled } foreach w $eyes {$w config -state $state1} return } if {$S(draw) == 0} { ;# Turning off drawing .stop config -state disabled .sLevel config -state normal -fg [lindex [.sLevel config -fg] 3] foreach w $ww { $w config -state normal} if {$S(3d) == 3} {foreach w $eyes {$w config -state normal}} } else { .stop config -state normal .sLevel config -state disabled -fg [.up cget -disabledforeground] foreach w $ww { $w config -state disabled} if {$S(3d) == 3} {foreach w $eyes {$w config -state disabled}} } } ##+########################################################################## # # DrawHilbert -- sets up the state and draws the Hilbert curve # proc DrawHilbertA {} {after 1 DrawHilbert} proc DrawHilbert {{lvl {}}} { global S 3D depths if {$lvl == {}} { set lvl $S(lvl) } else { set S(lvl) $lvl } .c delete all set S(draw) 1 set S(first) {} set S(ccolor) [expr {$S(connect) ? $S(color) : [.c cget -bg]}] if {$S(3d) == 3} { set S(width) [expr {$lvl < 3 ? (20 - 5*$lvl) : 5}] set n [expr {int(pow(2,3*($lvl+1)) - 1)}] set S(msg) "Hilbert 3D Curve Level $lvl ($n edges)" catch {unset depths} Hilbert3d $S(3Dtype) $lvl [GetStartCube] ZBuffer } else { set S(width) [expr {$lvl <= 4 ? (25 - 5*$lvl) : 8 - $lvl}] set n [expr {int(pow(4,$lvl+1) - 1)}] set S(msg) "Hilbert Curve Level $lvl ($n edges)" Hilbert [GetStartBox] E $lvl } set S(draw) 0 set S(first) {} if {! $::S(connect)} {.c lower connect} } ##+########################################################################## # # UpDown -- draws the curve one level up or down from current # proc UpDown {dlvl} { global S if {$dlvl < 0 && $S(lvl) == 0} return if {$dlvl > 0 && $S(lvl) >= [.sLevel cget -to]} return incr S(lvl) $dlvl DrawHilbert } ##+########################################################################## # # Hilbert -- draws a specified level Hilbert curve # proc Hilbert {box dir lvl} { global S DIRS QTRS if {! $S(draw)} return if {$lvl == 0} { Hilbert0 $box $dir return } set lvl2 [expr {$lvl - 1}] foreach quarter $QTRS($dir) newDir $DIRS($dir) { set b2 [QuarterBox $box $quarter] Hilbert $b2 $newDir $lvl2 } if {$lvl >= 4} update } ##+########################################################################## # # Hilbert0 -- draws the most basic hilbert curve inside $box facing $dir # proc Hilbert0 {box dir} { global S XY set xy $S(first) ;# Possibly connect to last set xy {} foreach {l t r b} [ShrinkBox $box] break foreach i $XY($dir) { ;# Walk coord list for this dir lappend xy [set $i] } if {$S(first) != ""} { .c create line [concat $S(first) [lrange $xy 0 1]] -width $S(width) \ -tag {hilbert connect} -fill $S(ccolor) } .c create line $xy -tag hilbert -width $S(width) -fill $S(color) \ -capstyle round set S(first) [lrange $xy end-1 end] ;# So next connects w/ this one } ##+########################################################################## # # GetStartBox -- returns coordinates of the area to draw our shape in # proc GetStartBox {} { return [list 9 9 [expr {[winfo width .c]-9}] [expr {[winfo height .c]-9}]] } ##+########################################################################## # # ShrinkBox -- shrinks a box to 1/4 of it's size # proc ShrinkBox {box} { foreach {l t r b} $box break set dx [expr {($r - $l) / 4.0}] set dy [expr {($b - $t) / 4.0}] set l [expr {$l + $dx}] ; set r [expr {$r - $dx}] set t [expr {$t + $dy}] ; set b [expr {$b - $dy}] return [list $l $t $r $b] } ##+########################################################################## # # QuarterBox -- Returns coordinates of 1 of the 4 quadrants of BOX. # 1 = up/left, 2 = up/right, 3 = lower/right, 4 = lower/left # proc QuarterBox {box corner} { foreach {l t r b} $box break set hx [expr {($r - $l) / 2.0}] set hy [expr {($b - $t) / 2.0}] if {$corner == 1} { ;# Upper left set r [expr {$r - $hx}] set b [expr {$b - $hy}] } elseif {$corner == 2} { ;# Upper right set l [expr {$l + $hx}] set b [expr {$b - $hy}] } elseif {$corner == 3} { ;# Lower right set l [expr {$l + $hx}] set t [expr {$t + $hy}] } elseif {$corner == 4} { ;# Lower left set r [expr {$r - $hx}] set t [expr {$t + $hy}] } return [list $l $t $r $b] } proc ShowConnectors {} { if {$::S(connect)} { .c itemconfig connect -fill $::S(color) ZBuffer } else { .c itemconfig connect -fill [.c cget -bg] .c lower connect } } proc ReColor {} { global S foreach {S(red) S(green) S(blue)} [winfo rgb . $S(color)] break if {$S(color) == "black"} { foreach {S(red) S(green) S(blue)} [winfo rgb . white] break } if {$S(3d) == 3} { if {[.c find withtag line] != {}} { after 1 DrawHilbert } return } .c itemconfig hilbert -fill $::S(color) if {! $::S(connect)} {.c itemconfig connect -fill [.c cget -bg]} } proc About {} { set msg "TkHilbert\nby Keith Vetter, Feb 2003\n\n" append msg "Draws the Hilbert Curve and a 3-Dimensional analog.\n" append msg "This curve was discovered by David Hilbert in 1891 and\n" append msg "was one of the first plane-filling curves ever found." tk_messageBox -title "About TkHilbert" -message $msg } ##+########################################################################## # # 3D Hilbert curver routines # proc GetStartCube {} { global 3D set 3D(X) [expr {[winfo width .c] - 20}] set 3D(Y) [expr {[winfo height .c] - 20}] set 3D(X2) [expr {$3D(X) / 2.0}] ;# Mid-point set 3D(Y2) [expr {$3D(Y) / 2.0}] set 3D(X3) [expr {$3D(X2) - 100.0}] ;# Scaling factor set 3D(Y3) [expr {$3D(Y2) - 120.0}] 3D::Init return [list 1 1 1 -1 -1 -1] } ##+########################################################################## # # Hilbert3d # # Main routine to draw a 3-D Hilbert curve. If level is 0 then we just # draw the base figure (with TYPE orientation). Otherwise we divide up # the volume (CUBE) into 8 quadrants in the order of the path for TYPE. # We then draw Hilbert curves in each of the quadrants of LEVEL - 1. # proc Hilbert3d {type lvl c} { global S hpath3d if {! $S(draw)} return if {$lvl == 0} { Hilbert3d0 $type $c return } # Draw the 8 sub Hilbert shapes for this type. We start in the starting # quadrant for this type, draw the correctly oriented sub-unit based on # the info in hpath3d. We continue along the path for this type and draw # the remaining sub-units. set lvl2 [expr {$lvl - 1}] ;# Down a level set oct $hpath3d($type,start) ;# Octant to start in foreach path $hpath3d($type,path) sub $hpath3d($type,sub) { set c2 [Octant $c $oct] ;# Divide up the cube world Hilbert3d $sub $lvl2 $c2 ;# Draw next level Hilbert curve set oct [NewOctant $oct $path] ;# Move to next octant } update } ##+########################################################################## # # Hilbert3d0 -- draws the lowest level of the 3-d Hilbert curve # # hpath3d specifies start corner of the cube and also the path of the curve. # Each letter in the path specifies an axis to follow with capital meaning # to go in. # proc Hilbert3d0 {type c} { global hpath3d foreach {x1 y1 z1 x2 y2 z2} [ShrinkCube $c] break # Get starting location set x [expr {$hpath3d($type,start) & 4 ? $x1 : $x2}] set y [expr {$hpath3d($type,start) & 2 ? $y1 : $y2}] set z [expr {$hpath3d($type,start) & 1 ? $z1 : $z2}] x_line $x $y $z connect ;# Start the line foreach p $hpath3d($type,path) { switch $p { X { set x $x1 } x { set x $x2 } Y { set y $y1 } y { set y $y2 } Z { set z $z1 } z { set z $z2 } } x_line $x $y $z } } proc ShrinkCube {cube} { foreach {x1 y1 z1 x2 y2 z2} $cube break set dx [expr {($x1 - $x2) / 4.0}] set dy [expr {($y1 - $y2) / 4.0}] set dz [expr {($z1 - $z2) / 4.0}] set x1 [expr {$x1 - $dx}] set x2 [expr {$x2 + $dx}] set y1 [expr {$y1 - $dy}] set y2 [expr {$y2 + $dy}] set z1 [expr {$z1 - $dz}] set z2 [expr {$z2 + $dz}] return [list $x1 $y1 $z1 $x2 $y2 $z2] } proc x_line {x y z {connect ""}} { global S foreach {sx sy} [3D::Obj2screen $x $y $z] break lappend S(xyz) $x $y $z if {$S(first) != {}} { foreach {color tag} [DepthColor $S(lastZ) $z] break if {! $S(connect) && $connect != ""} {set color $S(ccolor)} .c create line [concat $S(first) $sx $sy] -fill $color \ -width $S(width) -capstyle round -tag "line $tag $connect" } set S(first) [list $sx $sy] set S(lastZ) $z } ##+########################################################################## # # Obj2screen - converts 3-d coordinates (x,y,z) into screen coordinates. # The eye is fixed on the Z axis and we project onto a x-y plane # through the origin. It boils down to essentially dividing by Z. # proc obj2screen {x y z} { global S 3D set eye $S(eye) set x [expr {double($x) * $eye / ($eye - $z)}] ;# Depth adjustment set y [expr {double($y) * $eye / ($eye - $z)}] set sx [expr {$3D(X2) + round($x * $3D(X3))}] ;# To world coord set sy [expr {$3D(Y2) + round($y * $3D(Y3))}] return [list $sx $sy] } ##+########################################################################## # # DepthColor -- provides depth cueing by shading per depth # proc DepthColor {z1 z2} { global S depths set z [expr {($z1 + $z2) / 2.0}] ;# Mid point depth set z [expr {1 - (($z + 1) / 2)}] ;# Convert to 1-0 scale set zz [expr {1 - $z/2}] ;# .5 - 1 scale set red [expr {int($zz * $S(red))}] set green [expr {int($zz * $S(green))}] set blue [expr {int($zz * $S(blue))}] set color [format "\#%04X%04X%04X" $red $green $blue] set tag [format "Z%03d" [expr {int(999*$z)}]] set depths($tag) 1 ;# Used for Z buffering return [list $color $tag] } ##+########################################################################## # # Octant -- returns a CUBE which is one of the eight sub-quadrants of C # proc Octant {cube which} { foreach {x1 y1 z1 x2 y2 z2} $cube break set hx [expr {($x1 + $x2) / 2.0}] set hy [expr {($y1 + $y2) / 2.0}] set hz [expr {($z1 + $z2) / 2.0}] if {$which & 1} {set z2 $hz} else {set z1 $hz} if {$which & 2} {set y2 $hy} else {set y1 $hy} if {$which & 4} {set x2 $hx} else {set x1 $hx} return [list $x1 $y1 $z1 $x2 $y2 $z2] } proc NewOctant {which dir} { switch $dir { X { incr which 4} x { incr which -4} Y { incr which 2} y { incr which -2} Z { incr which 1} z { incr which -1} } return $which } ##+########################################################################## # # ZBuffer -- do a Z buffer hidden line algorithm by ordering every line # in the canvas stacking list based on the lines "Z###" tag that we # added to every line, the number in which is the depth of the line. # The hash depths keeps a list of all "Z###" tags used. # proc ZBuffer {} { foreach d [lsort [array names ::depths]] { .c lower $d } } ################################################################ ################################################################ ################################################################ ################################################################ ##+########################################################################## # # 3d Canvas # # Simple 3d canvas package. After specifying the eye, the page size and a # few other variables, this package will draw points and lines in 3d space. # # A simple example is given at the bottom. # # This is very simple. No clipping, z-buffering, or rotation is provided. # # Procedures: # 3D::Init # Generates the transformation matrix needed to map from world to screen. # Must be called after setting or changing the eye, etc. # 3D::Line canvas x1 y1 z1 x2 y2 z3 ?x3 y3 z3 ...? ?options? # Draws a line between all the 3d points specified. # # Variables: # 3d(ex) 3d(ey) 3d(ez) == eye position # 3d(rx) 3d(ry) 3d(rz) == reference point # 3d(x) 3d(y) == canvas size # 3d(cx) 3d(cy) == viewport center (reference point goes here) # 3d(sx) 3d(sy) == size of viewport # # Revision history # Keith Vetter 12/17/95 Initial revision from a C based version into tcl. # Keith Vetter 1/10/95 Finished the revision. # ##+########################################################################## # # 3D::Init # # Computes the transformation matrix for the current eye and center. # Note, calling this resets all scaling, translations, etc. # proc 3D::Init {} { variable matrix variable 3d set xy [expr {sqrt($3d(ex)*$3d(ex) + $3d(ey)*$3d(ey))}] set xyz [expr {sqrt($xy*$xy + $3d(ez)*$3d(ez))}] 3D::Ident matrix 3D::Ident t ;# T0 - Center to origin set t(3,0) [expr {-$3d(rx)}] set t(3,1) [expr {-$3d(ry)}] set t(3,2) [expr {-$3d(rz)}] 3D::M44 matrix t matrix 3D::Ident t ;# T1 -- Origin To eye set t(3,0) [expr {-$3d(ex)}] set t(3,1) [expr {-$3d(ey)}] set t(3,2) [expr {-$3d(ez)}] 3D::M44 matrix t matrix 3D::Ident t ;# T2 -- Rotate 90 around X set t(1,1) 0 set t(2,2) 0 set t(1,2) -1 set t(2,1) 1 3D::M44 matrix t matrix if {$xy != 0} { 3D::Ident t ;# T3 -- Rotate to eye line set t(0,0) [set t(2,2) [expr {-$3d(ey) / $xy}]] set t(0,2) [expr {$3d(ex) / $xy}] set t(2,0) [expr {-$t(0,2)}] 3D::M44 matrix t matrix } 3D::Ident t ;# T4 -- Rotate to eye line set t(1,1) [set t(2,2) [expr {$xy / $xyz}]] set t(1,2) [expr {$3d(ez) / $xyz}] set t(2,1) [expr {-$t(1,2)}] 3D::M44 matrix t matrix 3D::Ident t ;# T5 -- Left-Handed coords set t(2,2) -1 3D::M44 matrix t matrix 3D::Ident t ;# N - Scale By D/S set t(0,0) [set t(1,1) 4] 3D::M44 matrix t matrix set 3d(x) [winfo width .c] ;# Page size set 3d(y) [winfo height .c] set 3d(cx) [expr {$3d(x) / 2.0}] ;# Mid-point set 3d(cy) [expr {$3d(y) / 2.0}] set 3d(sx) [expr {$3d(cx) - 5.0}] ;# Viewport size set 3d(sy) [expr {$3d(cy) - 6.0}] } ##+########################################################################## # # 3D::Ident matrix # # Returns $mm as the identity matrix of size 4 # proc 3D::Ident mm { upvar 1 $mm m catch "uplevel [list unset $mm]" ;# Erase all entries foreach a {0,1 0,2 0,3 1,0 1,2 1,3 2,0 2,1 2,3 3,0 3,1 3,2} { set m($a) 0 } set m(0,0) [set m(1,1) [set m(2,2) [set m(3,3) 1.0]]] } ##+########################################################################## # # 3D::M44 ma mb mc # # Matrix multiply ma x mb => mc of size 4. mc can be either ma or mb. # proc 3D::M44 {ma mb mc} { upvar 1 $ma aa upvar 1 $mb bb upvar 1 $mc cc for {set r 0} {$r < 4} {incr r} { set result($r,0) [expr {.0 + $aa($r,0)*$bb(0,0) + $aa($r,1)*$bb(1,0) \ + $aa($r,2)*$bb(2,0) + $aa($r,3)*$bb(3,0)}] set result($r,1) [expr {.0 + $aa($r,0)*$bb(0,1) + $aa($r,1)*$bb(1,1) \ + $aa($r,2)*$bb(2,1) + $aa($r,3)*$bb(3,1)}] set result($r,2) [expr {.0 + $aa($r,0)*$bb(0,2) + $aa($r,1)*$bb(1,2) \ + $aa($r,2)*$bb(2,2) + $aa($r,3)*$bb(3,2)}] set result($r,3) [expr {.0 + $aa($r,0)*$bb(0,3) + $aa($r,1)*$bb(1,3) \ + $aa($r,2)*$bb(2,3) + $aa($r,3)*$bb(3,3)}] } catch "uplevel [list unset $mc]" foreach arr [array names result] { set cc($arr) $result($arr) } } ##+########################################################################## # # 3D::PrintMatrix matrix # # Prints out the 4x4 matrix $mm # proc m {} {::3D::PrintMatrix ::matrix} proc 3D::PrintMatrix {mm} { upvar 1 $mm m for {set r 0} {$r < 4} {incr r} { for {set c 0} {$c < 4} {incr c} { puts -nonewline [format "%.3f\t" $m($r,$c)] } puts "" } puts "" } ##+########################################################################## # # 3D::Obj2screen # # Converts a 3d position into 2d screen coordinates based on the current # transformation matrix matrix set up by 3D::Init. # proc 3D::Obj2screen {x y z} { variable matrix variable 3d set xe [expr {$x*$matrix(0,0)+$y*$matrix(1,0)+$z*$matrix(2,0)+$matrix(3,0)}] set ye [expr {$x*$matrix(0,1)+$y*$matrix(1,1)+$z*$matrix(2,1)+$matrix(3,1)}] set ze [expr {$x*$matrix(0,1)+$y*$matrix(1,2)+$z*$matrix(2,2)+$matrix(3,2)}] set sx [expr $3d(cx) + ($xe / $ze) * $3d(sx)] set sy [expr $3d(cx) - ($ye / $ze) * $3d(sy)] return [list $sx $sy] } ################################################################ ################################################################ DoDisplay DrawHilbert ---- [Category Graphics] | [Category Mathematics] | [Category Application] | [Category Whizzlet] | [Category 3D Graphics]