[Keith Vetter] 2002-06-07 : 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. ---- [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? ''DKF'' - This appears to be using a simple perspective projection ''i.e.'' take a view plane and an eye point, and map from points in your 3D space to points on your view plane by drawing a line passing through the target point and the eye point, and plotting a point on the view plane where the line intersects it. Stereographic projection is something else - it is used to map points on a sphere to points on a plane, and it tends to map distances to their inverses (the closer two things are together in the real world, the further apart they are in the projection.) Stereographic projections (or at least things that are conceptually very similar) are used when studying atomic structures with X-Ray crystallography. [KPV] - Yes, as DKF says, it's a simple perspective projection. ---- A [starkit] version of this code is available on [sdarchive]. ---- [Jeff Smith] 2019-09- : Below is an online demo using [CloudTk] <> <> ---- ====== #! /bin/env tclsh ##+########################################################################## # # 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 # ##+########################################################################## package require Tk # # 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 ====== ------ [uniquename] 2013aug17 This non-trivial script deserves at least one image, to give readers, who are not going to set up and run this script, an idea of what the script creates. Here are a couple of screen images that help give an idea of what is being discussed above on this page (3D projections, etc.). [vetter_Octabug_wiki3494_animatedOctahedron_screenshot_667x543.jpg] This image catches the octahedron as it is breaking apart in the animation mode. This static image cannot adequately convey how the octahedron splits apart almost completely, and then comes back together, with some corners staying attached to each other. Impressive. I have rearranged some of the packing of the widgets, and I have added an About button like Vetter has put on many of his other Tk GUI scripts. I have added some text explaining what the main procs are and what they do (based on comments in the script). [vetter_Octabug_wiki3494_About_screenshot_561x495.jpg] <> Application | Graphics | 3D Graphics