#!/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
