Version 2 of Octabug

Updated 2002-06-07 21:05:39

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 <Double-Button-1> 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 <ButtonRelease-1> "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