Welcome, guest | Sign In | My Account | Store | Cart
#!/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

History