Keith Vetter -- this is a fun little graphical animation which morphs an octahedron into an open cuboctahedron and back. Hidden w/i this code is actually a simple 3-d to 2-d transformation package. #!/bin/sh # The next line is executed by /bin/sh, but not Tcl \ exec wish $0 ${1+"$@"} ##+########################################################################## # # Octabug # # Animates the morphing of a octahedron into an open cuboctahedron. # by Keith Vetter # # Revisions: # KPV Mar 07, 1995 - initial revision # KPV Jun 07, 2002 - some minor code clean up # ##+########################################################################## # # do_display # # Sets up the display # proc do_display {} { wm title . "Octabug" canvas .c -relief raised -borderwidth 4 pack .c -side top .c config -height 600 -width 600 xyz .eye "Eye Position" eye_ {5 4 3} frame .buttons button .anim -text Animate -command { set go [expr 1 - $go]; animate} button .qbtn -text Quit -command exit pack .buttons -side left -expand yes -fill both pack .anim .qbtn -side top -expand yes -in .buttons } ##+########################################################################## # # animate # # Sets things in motion # proc animate {} { global go param if $go { set param [expr ($param + 1) % 100] triag after 1 animate } } ##+########################################################################## # # Triag # # Draws all 8 triangles of the octabug. # proc triag {} { global mem param set t $param set t [expr $t*2.0/100] ;# Change to 0-2 range set t1 $t ;# Remember if {$t > 1} { set t [expr 2.0 - $t] } ;# Exploit symmetry set t [expr $t + 1.0] ;# 1.0-2.0 range .c delete poly if [info exists mem($t1,a)] { ;# Did we memoize entry already? set a $mem($t1,a) set b $mem($t1,b) } else { ;# Nope, recompute set d [expr sqrt(12 - 3 * $t * $t)] set a [expr (3*$t + $d) / 6] set b [expr $t - $a] if {$t1 > 1} { ;# In or out? set d $a ; set a $b ; set b $d } set mem($t1,a) $a ;# Memoize--faster on next loop set mem($t1,b) $b } triag2 $a $b 7 -1 -1 -1 ;# Draw all the triangles... triag2 $a $b 6 -1 1 -1 ;# ...back to front if we can triag2 $a $b 5 1 -1 -1 triag2 $a $b 4 1 1 -1 triag2 $a $b 3 -1 -1 1 triag2 $a $b 2 -1 1 1 triag2 $a $b 1 1 -1 1 triag2 $a $b 0 1 1 1 update } ##+########################################################################## # # Triag2 # # Draws an individual triangle # proc triag2 {a b color x y z} { global colors set color [lindex $colors $color] set p1 [3d_obj2screen 0 [expr $y*$a] [expr $z*$b]] set p2 [3d_obj2screen [expr $x*$b] 0 [expr $z*$a]] set p3 [3d_obj2screen [expr $x*$a] [expr $y*$b] 0 ] eval .c create polygon $p1 $p2 $p3 -fill $color -tags poly } ##+########################################################################## # # 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. # # 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_obj2screen # Converts x,y,z of world coordinates into x,y of screen coordinates # # 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 # set 3d(ex) 5 ;# Eye position set 3d(ey) 4 set 3d(ez) 3 set 3d(rx) 0 ;# Reference point set 3d(ry) 0 set 3d(rz) 0 set 3d(x) 600 ;# Page size set 3d(y) 600 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_init # # Computes the transformation matrix for the current eye and center. # Note, calling this resets all scaling, translations, etc. # proc 3d_init {} { global 3d_mat 3d if {$3d(ex) == 0 && $3d(ey) == 0} { set 3d(ey) .01 } set xy [expr sqrt($3d(ex)*$3d(ex) + $3d(ey)*$3d(ey))] set xyz [expr sqrt($xy*$xy + $3d(ez)*$3d(ez))] 3d_ident 3d_mat 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 3d_mat t 3d_mat 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 3d_mat t 3d_mat 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 3d_mat t 3d_mat 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 3d_mat t 3d_mat 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 3d_mat t 3d_mat 3d_ident t ;# T5 -- Left-Handed Coords set t(2,2) -1 3d_m44 3d_mat t 3d_mat 3d_ident t ;# N - Scale By D/S set t(0,0) [set t(1,1) 4] 3d_m44 3d_mat t 3d_mat } ##+########################################################################## # # 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_obj2screen # # Converts a 3d position into 2d screen coordinates based on the current # transformation matrix 3d_mat set up by 3d_init. # proc 3d_obj2screen {x y z} { global 3d_mat 3d set xe [expr $x*$3d_mat(0,0)+$y*$3d_mat(1,0)+$z*$3d_mat(2,0)+$3d_mat(3,0)] set ye [expr $x*$3d_mat(0,1)+$y*$3d_mat(1,1)+$z*$3d_mat(2,1)+$3d_mat(3,1)] set ze [expr $x*$3d_mat(0,1)+$y*$3d_mat(1,2)+$z*$3d_mat(2,2)+$3d_mat(3,2)] set sx [expr $3d(cx) + ($xe / $ze) * $3d(sx)] set sy [expr $3d(cx) - ($ye / $ze) * $3d(sy)] return [list $sx $sy] } ##+########################################################################## # # 3d_axis # # Draws x,y,z axes # proc 3d_axis {c} { $c delete axis set o [3d_obj2screen 0 0 0] $c create line $o [3d_obj2screen 1.2 0 0] -fill black -arrow last -tag axis $c create line $o [3d_obj2screen 0 1.2 0] -fill black -arrow last -tag axis $c create line $o [3d_obj2screen 0 0 1.2] -fill black -arrow last -tag axis } ##+########################################################################## # # Xyz # # Creates the subwindow with XYZ scales. # proc xyz {w title tag values} { global eyex eyey eyez centerx centery centerz num_steps catch {set x [expr round([lindex $values 0])]} catch {set y [expr round([lindex $values 1])]} catch {set z [expr round([lindex $values 2])]} set values [list $x $y $z] frame $w pack $w -side left -expand y;# -pady .1i label $w.ltitle -text $title -relief raised -bd 3 bind $w.ltitle reeye pack $w.ltitle -side top -fill x foreach l {x y z} { ;# Create 3 scales for x,y,z frame $w.f$l -bd 2 -relief raised ;# Holds scale & label scale $w.f$l.$l -from 10 -to 0 -relief ridge -length 75 $w.f$l.$l config -var 3d(e$l) ;# -comm "redraw" bind $w.f$l.$l "after 1 redraw" label $w.f$l.l$l -text [string toupper $l] $w.f$l.l$l config -bg [lindex [$w.f$l.$l config -bg] 4] pack $w.f$l -side left -expand yes pack $w.f$l.l$l $w.f$l.$l -side top -fill x $w.f$l.$l set [lindex $values 0] ;# Set the scale value set values [lrange $values 1 end] } } ##+########################################################################## # # redraw # # Updates 3d stuff when eye position changes # proc redraw {} { global param 3d_init triag } ##+########################################################################## # # reeye # # Repositions the eye to the default location # proc reeye {} { global 3d set 3d(ex) 5 ; set 3d(ey) 4 ; set 3d(ez) 3 redraw } ##+########################################################################## ############################################################################# ############################################################################# set go 0 ;# Animation off set param 0 ;# Time parameter set colors {red green blue cyan slateblue magenta chocolate yellow} 3d_init ;# Initialize the 3d world do_display ;# Draw the display triag ;# Draw initial shape ---- [GPS] This is very impressive! Thanks for sharing it. I've been playing with perspective based projection for a while, but stereographic has stumped me (mostly I can't find simple examples). What kind of projection does this use?