#!/bin/sh
#
# CSE 4303: Lab 3
# Andy Goth <[email protected]>
# November 18, 2005
#
# The next line restarts this script with tclsh.\
exec tclsh "$0" ${1+"$@"}

package require Tcl 8.5
package require Tk

# Hide the full Tcl error information.
proc bgerror {msg args} {
    set log $::errorInfo
    set time [clock format [clock seconds]]
    puts stderr "### bgerror called: $time ###"
    puts stderr $log
    puts stderr "### end bgerror output: $time ###"
    if {[llength $args] == 0} {
        tk_messageBox -type ok -title Error -icon error -message $msg
    } else {
        tk_messageBox -type ok -title Error -icon error -message $msg\
                -detail [lindex $args 0]
    }
}

# Pops any number of elements from the beginning of $input, placing them into
# variables named in $args.  Each variable name is preceded by an argument
# giving its format, in the style of [scan].  Returns $input sans the popped
# elements.
proc fmt_pop {input args} {
    if {[llength $args] % 2 != 0} {
        error "wrong # args: should be \"pop input ?fmt varname? ?...?\""
    } elseif {[llength $input] < [llength $args] / 2} {
        error "no more input data"
    }
    foreach {fmt varname} $args {
        upvar 1 $varname var
        set input [lassign $input var]
        if {[scan $var $fmt var] == 0} {
            error "input \"$var\" does not match format \"$fmt\""
        }
    }
    return $input
}

# Returns true if $parent is an ancestor of $child.
proc gui_ancestor {parent child} {
    if {$child eq ""} {
        return false
    }
    set top [winfo toplevel $child]
    while {1} {
        if {$child eq $parent} {
            return true
        } elseif {$child eq $top} {
            return false
        }
        set child [winfo parent $child]
    }
}

# Returns a list of all $win's child/grandchild/etc. widgets.
proc gui_children {win} {
    set result [list]
    foreach child [winfo children $win] {
        lappend result $child {*}[gui_children $child]
    }
    return $result
}

# Kill the current animation.
proc anim_cancel {} {
    global scene

    if {[dict get $scene anim handle] ne ""} {
        catch {after cancel [dict get $scene anim handle]}
        dict set scene anim handle ""
        uplevel #0 [dict get $scene anim on_finish]
    }
}

# Start an animation.
proc anim_start {target steps matrix on_finish} {
    if {[catch {
        global scene

        if {[dict get $scene anim handle] ne ""} {
            error "Animation in progress"
        } elseif {$steps <= 0} {
            error "Nonpositive animation steps"
        }

        # Prepare the animation data structure.
        set handle dummy
        foreach var {target steps matrix handle on_finish} {
            dict set scene anim $var [set $var]
        }
    } result opts]} {
        # The finish handler must happen even in case of error.
        anim_cancel
        return -options $opts $result
    } else {
        # Actually start the animation.
        anim_callback
    }
}

# Play the next frame of animation.
proc anim_callback {} {
    global scene

    if {[catch {
        # Count down.
        set steps [expr {[dict get $scene anim steps] - 1}]
        dict set scene anim steps $steps

        set target [dict get $scene anim target]
        set matrix [dict get $scene anim matrix]
        switch -- [lindex $target 0] {
        object {
            # Transform all points.
            foreach obj [lindex $target 1] {
                set vertices [dict get $scene objects $obj vertices]
                for {set i 0} {$i < [llength $vertices]} {incr i} {
                    lset vertices $i [3d_apply $matrix [lindex $vertices $i]]
                }
                dict set scene objects $obj vertices $vertices
            }
            scene_dirty
        } persp {
            # Modify the appropriate vector(s).
            set diff [list]
            foreach vector [lindex $target 1] {
                lappend diff $vector [3d_apply $matrix\
                        [dict get $scene persp $vector]]
            }
            scene_persp_set {*}$diff
        }}
    } result opts]} {
        # The finish handler must happen even in case of error.
        anim_cancel
        return -options $opts $result
    } else {
        if {$steps == 0} {
            # Quit.
            anim_cancel
        } else {
            # Reschedule.
            set delay [dict get $scene options frame_delay]
            dict set scene anim handle [after $delay anim_callback]
        }
    }
}

# Empty the scene.
proc scene_reset {} {
    global scene

    if {[info exists scene] && [dict exists $scene anim]} {
        anim_cancel
    }
    dict set scene edittag  ""
    dict set scene prevsize [list 0 0]
    dict set scene prevdrag [list]
    dict set scene prevport [list 0 0]
    dict set scene objects  pot vertices [list]
    dict set scene objects  pot edges    [list]
    dict set scene objects  lid vertices [list]
    dict set scene objects  lid edges    [list]
    dict set scene anim     handle ""
    dict set scene dirty    false
    dict set scene persp    matrix [3d_ident]

    dict set scene loading true
    scene_viewport_set 0.05 0.05 0.95 0.95
    scene_viewvol_set -1 -1 -10 1 1 -0.01
    scene_persp_set vrp {0 0 0} vpn {0 0 -1} vup {0 1 0} prp {0 0 1}
    dict set scene loading false

    if {![dict exists $scene options]} {
        dict set scene loading true
        options_set frame_delay 100 hl_clip false
        dict set scene loading false
    }
}

# Initialize the canvas.
proc scene_init {} {
    global scene gui

    # Create placeholder objects.
    set cnv $gui(scene)
    $cnv configure -background steelblue
    $cnv create rectangle 0 0 0 0 -tags {viewport}
    $cnv create line 0 0 0 0 -tags {viewedge   view_n }
    $cnv create line 0 0 0 0 -tags {viewedge   view_w }
    $cnv create line 0 0 0 0 -tags {viewedge   view_e }
    $cnv create line 0 0 0 0 -tags {viewedge   view_s }
    $cnv create rect 0 0 0 0 -tags {viewcorner view_nw}
    $cnv create rect 0 0 0 0 -tags {viewcorner view_ne}
    $cnv create rect 0 0 0 0 -tags {viewcorner view_sw}
    $cnv create rect 0 0 0 0 -tags {viewcorner view_se}
    $cnv itemconfigure viewport   -outline "" -fill white
    $cnv itemconfigure viewedge   -width 2    -fill navy
    $cnv itemconfigure viewcorner -outline "" -fill ""

    # Create bindings.
    foreach tag {view_nw view_n   view_ne
                 view_w  viewport view_e
                 view_sw view_s   view_se} {
        $cnv bind $tag <1>               [list scene_viewport_down  $tag %x %y]
        $cnv bind $tag <ButtonRelease-1> [list scene_viewport_up    $tag %x %y]
        $cnv bind $tag <B1-Motion>       [list scene_viewport_drag  $tag %x %y]
        $cnv bind $tag <Any-Enter>       [list scene_viewport_enter $tag %x %y]
        $cnv bind $tag <Any-Leave>       [list scene_viewport_leave $tag %x %y]
    }
    $cnv configure -closeenough 5

    # Position the objects.
    scene_reset

    # On resize, update the canvas.
    bind $cnv <Configure> scene_configure
}

# Calculate the projection matrix.
proc scene_proj_calc {} {
    global scene

    # Don't bother calculating the projection matrix while loading models.
    if {[dict get $scene loading]} {
        return
    }

    # Extract some useful vectors.
    foreach {key val} [dict get $scene persp] {
        set $key $val
    }
    lassign [dict get $scene viewvol min] umin vmin near
    lassign [dict get $scene viewvol max] umax vmax far

    # Compute some vectors.
    set rx [3d_vnorm [3d_vcross $vup $vpn]]
    set rz [3d_vnorm $vpn]
    set ry [3d_vcross $rx $rz]
    set near [lindex [dict get $scene viewvol min] 2]
    set far  [lindex [dict get $scene viewvol max] 2]
    set nprp [lindex [dict get $scene persp   prp] 2]
    if {($nprp < $far && $far < $near) || ($near < $far && $far < $nprp)} {
        lassign [list $near $far] far near
    }
    set dop [list [expr {($umin + $umax) / 2.0 - [lindex $prp 0]}]\
                  [expr {($vmin + $vmax) / 2.0 - [lindex $prp 1]}]\
                  [expr {-$nprp}]]
    set scl [expr {-1.0 / ($far - $nprp)}]

    # Now make the big ol' matrix.
    dict set scene persp matrix [3d_compose                                \
            [3d_scale [expr {$scl * 2.0 * $nprp / ($umax - $umin)}]        \
                      [expr {$scl * 2.0 * $nprp / ($vmax - $vmin)}] $scl]  \
            [list [list 1 0 [expr {-[lindex $dop 0] / [lindex $dop 2]}] 0] \
                  [list 0 1 [expr {-[lindex $dop 1] / [lindex $dop 2]}] 0] \
                  [list 0 0                                           1 0]]\
            [3d_trans {*}[3d_vscale $prp -1]]                         \
            [list [concat $rx {0}] [concat $ry {0}] [concat $rz {0}]]      \
            [3d_trans {*}[3d_vscale $vrp -1]]]
}

# Handler for scene canvas configure events.
proc scene_configure {} {
    global scene gui

    # Only redraw if the canvas size has changed.
    if {[winfo width  $gui(scene)] != [lindex [dict get $scene prevsize] 0] ||
        [winfo height $gui(scene)] != [lindex [dict get $scene prevsize] 1]} {
        scene_dirty
    }
}

# Dirties the scene, scheduling a render.
proc scene_dirty {} {
    global scene

    if {![dict get $scene dirty]} {
        dict set scene dirty true
        after idle scene_render
    }
}

# Line clipping helper procedure.
proc clip_t {den num tmin_var tmax_var} {
    if {$den == 0.0} {
        if {$num > 0.0} {
            return false
        }
    } else {
        upvar 1 $tmin_var tmin $tmax_var tmax
        set t [expr {$num / double($den)}]
        if {$den > 0.0} {
            if {$t > $tmax} {
                return false
            } elseif {$t > $tmin} {
                set tmin $t
            }
        } else {
            if {$t < $tmin} {
                return false
            } elseif {$t < $tmax} {
                set tmax $t
            }
        }
    }
    return true
}

# Plot a line.
proc scene_plot {x1 y1 z1 x2 y2 z2 near xmin ymin xscl yscl} {
    set tags edge

    # Accept or reject using Cohen-Sutherland outcodes, but then use Liang-
    # Barsky to clip lines because it's faster than recursive subdivision.  The
    # Cohen-Sutherland trivial acceptance test is much faster than using the
    # general Liang-Barsky on every line.
    if {$z1  <= $x1 && $x1 <= -$z1  && $z2  <= $x2 && $x2 <= -$z2  &&
        $z1  <= $y1 && $y1 <= -$z1  && $z2  <= $y2 && $y2 <= -$z2  &&
        -1.0 <= $z1 && $z1 <= $near && -1.0 <= $z2 && $z2 <= $near} {
        # Accept due to zero OR of endpoint outcodes.  This line lies entirely
        # within the view volume.  Fall through to the bottom of this proc to
        # plot the line.
    } elseif {($z1  > $x1 && $z2  > $x2) || ($x1 > -$z1  && $x2 > -$z2 ) ||
              ($z1  > $y1 && $z2  > $y2) || ($y1 > -$z1  && $y2 > -$z2 ) ||
              (-1.0 > $z1 && -1.0 > $z2) || ($z1 > $near && $z2 > $near)} {
        # Reject due to nonzero AND of endpoint outcodes.  Both endpoints of
        # this line are located on the "outside" of the same clip plane;
        # therefore no part of the line passes through the view volume.
        return
    } else {
        # Clip.
        set tmin 0.0
        set tmax 1.0
        set dx [expr {double($x2 - $x1)}]
        set dy [expr {double($y2 - $y1)}]
        set dz [expr {double($z2 - $z1)}]
        if {[clip_t [expr {-$dx - $dz}] [expr { $x1 + $z1  }] tmin tmax] &&
            [clip_t [expr { $dx - $dz}] [expr {-$x1 + $z1  }] tmin tmax] &&
            [clip_t [expr { $dy - $dz}] [expr {-$y1 + $z1  }] tmin tmax] &&
            [clip_t [expr {-$dy - $dz}] [expr { $y1 + $z1  }] tmin tmax] &&
            [clip_t [expr {-$dz      }] [expr { $z1 - $near}] tmin tmax] &&
            [clip_t [expr { $dz      }] [expr {-$z1 - 1.0  }] tmin tmax]} {
            # Adjust endpoints using clipped T values.
            if {$tmax < 1.0} {
                set x2 [expr {$x1 + $tmax * $dx}]
                set y2 [expr {$y1 + $tmax * $dy}]
                set z2 [expr {$z1 + $tmax * $dz}]
            }
            if {$tmin > 0.0} {
                set x1 [expr {$x1 + $tmin * $dx}]
                set y1 [expr {$y1 + $tmin * $dy}]
                set z1 [expr {$z1 + $tmin * $dz}]
            }

            # If the user so desires, highlight this line segment.
            lappend tags clip

            # Fall through to the bottom of this proc to plot the line.
        } else {
            # Reject line.  Do not plot.
            return
        }
    }

    # Plot the line.
    $::gui(scene) create line                          \
            [expr {( $x1 / $z1 + 1.0) * $xscl + $xmin}]\
            [expr {(-$y1 / $z1 + 1.0) * $yscl + $ymin}]\
            [expr {( $x2 / $z2 + 1.0) * $xscl + $xmin}]\
            [expr {(-$y2 / $z2 + 1.0) * $yscl + $ymin}] -tags $tags
}

# Render the scene.
proc scene_render {} {
    global scene gui

    # I use this variable a lot, so make the name shorter.
    set cnv $gui(scene)

    # Update the edges?
    set doedges [expr {
            [dict get $scene edittag] ne "viewport"                      ||
            [winfo width  $cnv] != [lindex [dict get $scene prevsize] 0] ||
            [winfo height $cnv] != [lindex [dict get $scene prevsize] 1]}]

    # Update the dirty bits.
    dict set scene dirty false
    dict set scene prevsize [list [winfo width $cnv] [winfo height $cnv]]
    dict set scene prevsize [list [winfo width $cnv] [winfo height $cnv]]

    # Do the viewport stuff.
    foreach extent {min max} {
        lassign [dict get $scene viewport $extent] x y
        set x$extent [expr {$x * [winfo width  $cnv]}]
        set y$extent [expr {$y * [winfo height $cnv]}]
    }
    $cnv coords viewport $xmin $ymin $xmax $ymax
    $cnv coords view_n   $xmin $ymin $xmax $ymin
    $cnv coords view_s   $xmin $ymax $xmax $ymax
    $cnv coords view_w   $xmin $ymin $xmin $ymax
    $cnv coords view_e   $xmax $ymin $xmax $ymax
    $cnv coords view_nw  [expr {$xmin - 4}] [expr {$ymin - 4}]\
                         [expr {$xmin + 4}] [expr {$ymin + 4}]
    $cnv coords view_ne  [expr {$xmax - 4}] [expr {$ymin - 4}]\
                         [expr {$xmax + 4}] [expr {$ymin + 4}]
    $cnv coords view_sw  [expr {$xmin - 4}] [expr {$ymax - 4}]\
                         [expr {$xmin + 4}] [expr {$ymax + 4}]
    $cnv coords view_se  [expr {$xmax - 4}] [expr {$ymax - 4}]\
                         [expr {$xmax + 4}] [expr {$ymax + 4}]

    if {$doedges} {
        # Delete old edges.
        $cnv delete edge

        # Prepare for clipping.
        set near [lindex [dict get $scene viewvol min] 2]
        set far  [lindex [dict get $scene viewvol max] 2]
        set nprp [lindex [dict get $scene persp   prp] 2]
        if {($nprp < $far && $far < $near) || ($near < $far && $far < $nprp)} {
            lassign [list $near $far] far near
        }
        set near [expr {($nprp - $near) / double($far - $nprp)}]

        # Plot all edges.
        set xscl [expr {($xmax - $xmin) / 2.0}]
        set yscl [expr {($ymax - $ymin) / 2.0}]
        set i 0
        foreach data [dict values [dict get $scene objects]] {
            set projvtx [list]
            foreach vtx [dict get $data vertices] {
                lappend projvtx [3d_apply [dict get $scene persp matrix] $vtx]
            }
            foreach {vtx1 vtx2} [concat {*}[dict get $data edges]] {
                scene_plot {*}[lindex $projvtx $vtx1]\
                           {*}[lindex $projvtx $vtx2]\
                           $near $xmin $ymin $xscl $yscl
            }
        }

        $cnv itemconfigure edge -fill black -width 1
        if {[dict get $scene options hl_clip]} {
            $cnv itemconfigure clip -fill red -width 2
        }
        $cnv addtag viewport withtag edge
    } else {
        # Move the already-plotted edges.
        $cnv move edge\
                [expr {$xmin - [lindex [dict get $scene prevport] 0]}]\
                [expr {$ymin - [lindex [dict get $scene prevport] 1]}]
    }

    # Remember old viewport.
    dict set scene prevport [list $xmin $ymin]
}

# Handler for a mouse click in the canvas.
proc scene_viewport_down {tag x y} {
    global scene gui

    dict set scene edittag  $tag
    dict set scene prevdrag [list                           \
            [expr {$x / double([winfo width  $gui(scene)])}]\
            [expr {$y / double([winfo height $gui(scene)])}]]

    if {$tag eq "viewport"} {
        $gui(scene) configure -cursor fleur
    }
}

# Handler for a mouse button release in the canvas.
proc scene_viewport_up {tag x y} {
    global scene

    dict set scene edittag  ""

    if {$tag eq "viewport"} {
        $::gui(scene) configure -cursor ""
    }
}

# Handler for mouse button dragging in the canvas.
proc scene_viewport_drag {tag x y} {
    global scene commands gui

    # What is being modified?
    set tag [dict get $scene edittag]

    if {$tag ne ""} {
        # Useful variables.
        set nx [expr {$x / double([winfo width  $gui(scene)])}]
        set ny [expr {$y / double([winfo height $gui(scene)])}]
        if {$nx < 0.0} {set nx 0.0}; if {$ny < 0.0} {set ny 0.0}
        if {$nx > 1.0} {set nx 1.0}; if {$ny > 1.0} {set ny 1.0}

        # Get old viewport coordinates.
        lassign [dict get $scene viewport min] xmin ymin
        lassign [dict get $scene viewport max] xmax ymax

        # Calculate new viewport coordinates.
        switch -- $tag {
        view_nw {set xmin $nx; set ymin $ny}
        view_n  {              set ymin $ny}
        view_ne {set xmax $nx; set ymin $ny}
        view_w  {set xmin $nx              }
        view_e  {set xmax $nx              }
        view_sw {set xmin $nx; set ymax $ny}
        view_s  {              set ymax $ny}
        view_se {set xmax $nx; set ymax $ny}
        viewport {
            set dx   [expr {$nx - [lindex [dict get $scene prevdrag] 0]}]
            set dy   [expr {$ny - [lindex [dict get $scene prevdrag] 1]}]
            set xmin [expr {$xmin + $dx}]; set xmax [expr {$xmax + $dx}]
            set ymin [expr {$ymin + $dy}]; set ymax [expr {$ymax + $dy}]
        }}
        dict set scene prevdrag [list $nx $ny]

        # Prevent mirroring by enforcing min <= max.
        if {[string match view_n* $tag] && $ymin > $ymax} {set ymin $ymax}
        if {[string match view_*w $tag] && $xmin > $xmax} {set xmin $xmax}
        if {[string match view_*e $tag] && $xmax < $xmin} {set xmax $xmin}
        if {[string match view_s* $tag] && $ymax < $ymin} {set ymax $ymin}

        # Do it.
        scene_viewport_set $xmin $ymin $xmax $ymax
    }
}

# Handler for mouse button entering an object in the canvas.
proc scene_viewport_enter {tag x y} {
    global scene gui

    switch -- $tag {
    view_nw  {$gui(scene) configure -cursor top_left_corner    }
    view_n   {$gui(scene) configure -cursor top_side           }
    view_ne  {$gui(scene) configure -cursor top_right_corner   }
    view_w   {$gui(scene) configure -cursor left_side          }
    view_e   {$gui(scene) configure -cursor right_side         }
    view_sw  {$gui(scene) configure -cursor bottom_left_corner }
    view_s   {$gui(scene) configure -cursor bottom_side        }
    view_se  {$gui(scene) configure -cursor bottom_right_corner}
    viewport {
        if {[dict get $scene edittag] eq "viewport"} {
            $gui(scene) configure -cursor fleur
        }
    }}
}

# Handler for mouse button leaving an object in the canvas.
proc scene_viewport_leave {tag x y} {
    global scene

    if {[dict get $scene edittag] ne $tag} {
        $::gui(scene) configure -cursor ""
    }
}

# Sets the viewport.
proc scene_viewport_set {xmin ymin xmax ymax} {
    global scene commands

    # Ensure that min is less than max.  Swap as necessary.
    foreach dim {x y} {
        set min ${dim}min; set max ${dim}max
        if {[set $min] > [set $max]} {
            lassign [list [set $min] [set $max]] $max $min
        }
    }

    # Commit updated viewport.
    dict set scene viewport min [list $xmin $ymin]
    dict set scene viewport max [list $xmax $ymax]
    foreach var {xmin ymin xmax ymax} {
        set commands(vport,$var) [set $var]
    }

    # The scene has changed, so update when convenient.
    scene_dirty
}

# Sets the VRP, VPN, VUP, and/or PRP vectors.
proc scene_persp_set {args} {
    global scene commands

    # First: validate.
    if {[llength $args] % 2 != 0} {
        error "Wrong # args: should be\
               \"scene_persp_set ?vector_name vector_value? ?...?\""
    }
    scene_persp_check {*}$args

    # Next: commit.
    foreach {vec val} $args {
        dict set scene persp $vec $val
        foreach dim {x y z} index {0 1 2} {
            set commands(persp,$vec$dim) [lindex $val $index]
        }
    }

    # Update the projection and the displayed scene.
    scene_proj_calc
    scene_dirty
}

# Sets the view volume.
proc scene_viewvol_set {umin vmin nmin umax vmax nmax} {
    global scene commands

    # Ensure that min is less than max.  Also check for zero.
    foreach dim {u v n} {
        set min ${dim}min; set max ${dim}max
        if {[set $min] > [set $max]} {
            lassign [list [set $min] [set $max]] $max $min
        }
    }

    # Check for PRP between clip planes.         
    scene_persp_check min [list $umin $vmin $nmin] max [list $umax $vmax $nmax]

    # Commit updated view volume.
    dict set scene viewvol min [list $umin $vmin $nmin]
    dict set scene viewvol max [list $umax $vmax $nmax]
    foreach var {umin vmin nmin umax vmax nmax} {
        set commands(vvol,$var) [set $var]
    }

    # Update the projection and the displayed scene.
    scene_proj_calc
    scene_dirty
}

# Verify that the PRP is not between the back and front clip planes.
proc scene_persp_check {args} {
    global scene

    if {[llength $args] % 2 != 0} {
        error "wrong # args: should be\
               \"scene_persp_check ?vector_name vector_value? ?...?\""
    }

    # Perform no checks while loading model files.
    if {[dict get $scene loading]} {
        return
    }

    # Get current vectors.
    foreach {var path} {
        min {viewvol min}    max {viewvol max}
        vrp {persp   vrp}    vpn {persp   vpn}
        vup {persp   vup}    prp {persp   prp}
    } {
        set $var [dict get $scene {*}$path]
    }

    # Get changed vectors.
    foreach {var val} $args {
        if {$var ni {min max vrp vpn vup prp}} {
            error "unknown vector \"$var\""
        } else {
            set $var $val
        }
    }

    # Check that the PRP is outside the view volume.
    if {([lindex $min 2] <= [lindex $prp 2] &&
         [lindex $prp 2] <= [lindex $max 2]) ||
        ([lindex $max 2] <= [lindex $prp 2] &&
         [lindex $prp 2] <= [lindex $min 2])} {
        error "Cannot put PRP between back and front clip planes"
    }

    # Check for bad zero vectors.
    foreach vec {vpn vup} {
        if {[3d_vlen [set $vec]] == 0} {
            error "Cannot set [string toupper $vec] to zero vector"
        }
    }

    # Check for size of view volume
    if {[lindex $min 2] == [lindex $max 2]} {
        error "Cannot set zero width/height/depth view volume"
    }

    # Check that the VPN doesn't coincide with the VUP.
    if {[3d_vnorm $vpn] == [3d_vnorm $vup]} {
        error "VPN must not coincide with VUP"
    }
}

# Model file selector.
proc load_browse {name} {
    upvar 1 $name var 

    set file [tk_getOpenFile -defaultextension .txt -title "Load Model"\
                             -filetypes {{"Model Files" .txt}}]
    if {$file ne ""} {
        set var $file
    }
}

# Model file loader.
proc load_action {} {
    global commands scene

    # First, clear the secene.
    scene_reset

    # Try to load the file.
    dict set scene loading true
    if {[catch {
        foreach obj {pot lid} {
            set file $commands(load,$obj)
            if {$file ne ""} {
                # Check the file's superficial validity.
                set realfile $file
                while {1} {
                    if {![file exists $realfile]} {
                        error "File not found"
                    } elseif {[file type $realfile] ne "link"} {
                        # Check the ultimate file type.
                        switch -- [file type $realfile] {
                        directory        {error "File is a directory"}
                        characterSpecial -
                        blockSpecial     {error "File is a device"}
                        fifo             {error "File is a pipe"}
                        socket           {error "File is a socket"}
                        }

                        # And, of course, verify access.
                        if {![file readable $file]} {
                            error "Cannot read file"
                        }

                        # The file passes the first round of tests...
                        break
                    }
                    set path     [file dirname  [file normalize $realfile]]
                    set realfile [file readlink $realfile]
                    if {[file pathtype $realfile] ne "absolute"} {
                        set realfile [file join $path $realfile]
                    }
                }

                # Now try to read it!
                set chan [open $file r]
                while {[gets $chan line] != -1} {
                    # Remove leading and trailing whitespace, replace all
                    # strings of whitespace with a single space, convert to a
                    # list, store the first element in $type, and store all
                    # remaining elements in $data.
                    set data [fmt_pop [split [regsub -all {\s+}\
                            [string trim $line] " "]] %s type]
                    if {[catch {
                        switch -- $type {
                        v {
                            # Vertex.
                            if {[fmt_pop $data %f x %f y %f z] ne ""} {
                                break
                            }
                            dict set scene objects $obj vertices               \
                                [concat [dict get $scene objects $obj vertices]\
                                [list [list $x $y $z]]]
                        } f {
                            # Face.
                            if {[llength $data] < 2} {
                                break
                            }
                            set data [fmt_pop $data %d prev]
                            incr prev -1
                            set first $prev
                            set edges [list]
                            while {[llength $data] != 0} {
                                set data [fmt_pop $data %d vtx]
                                incr vtx -1
                                lappend edges [lsort -integer [list $prev $vtx]]
                                set prev $vtx
                            }
                            lappend edges [lsort -integer [list $prev $first]]
                            dict set scene objects $obj edges [concat\
                                    [dict get $scene objects $obj edges] $edges]
                        } r {
                            # VRP (WC).
                            if {[fmt_pop $data %f x %f y %f z] ne ""} {
                                break
                            }
                            scene_persp_set vrp [list $x $y $z]
                        } n {
                            # VPN (WC).
                            if {[fmt_pop $data %f x %f y %f z] ne ""} {
                                break
                            }
                            scene_persp_set vpn [list $x $y $z]
                        } u {
                            # VUP (WC).
                            if {[fmt_pop $data %f x %f y %f z] ne ""} {
                                break
                            }
                            scene_persp_set vup [list $x $y $z]
                        } p {
                            # PRP (WC).
                            if {[fmt_pop $data %f x %f y %f z] ne ""} {
                                break
                            }
                            scene_persp_set prp [list $x $y $z]
                        } w {
                            # View volume (VRC).
                            if {[fmt_pop $data %f u0 %f u1 %f v0 %f v1\
                                               %f n0 %f n1] ne ""} {
                                break
                            }
                            scene_viewvol_set $u0 $v0 $n0 $u1 $v1 $n1
                        } s {
                            # Viewport (NSC).
                            if {[fmt_pop $data %f u0 %f v0 %f u1 %f v1] ne ""} {
                                break
                            }
                            scene_viewport_set $u0 $v0 $u1 $v1
                        } default {
                            # I don't know, so bail.
                            break
                        }}
                    } result opts]} {
                        # Rather than say what's wrong, hide the error and just
                        # give a high-level statement.  Hopefully the error is
                        # due to a bad file and not my bad coding. :^)
                        return -options $opts -code error "Malformed input file"
                    }
                }
                close $chan

                # Kill duplicate edges.  With most meshes, there are two copies
                # of each edge.
                dict set scene objects $obj edges [lsort -unique\
                        [dict get $scene objects $obj edges]]

                # Last, check the object's consistency.  Specifically, verify
                # the existence of every vertex referenced by every edge.
                set numvtx [llength [dict get $scene objects $obj vertices]]
                foreach vtx [lsort -integer -unique [concat\
                        {*}[dict get $scene objects $obj edges]]] {
                    if {$vtx < 0 || $vtx >= $numvtx} {
                        error "Malformed input file" $::errorInfo
                    }
                }
            }
        }
    } error opts]} {
        # Hmm.  Something is wrong. :^/
        bgerror $error $file
        catch {close $chan}
        scene_reset
        scene_dirty
        return
    }
    dict set scene loading false

    # UGH!  DOUBLE UGH!  (UGH!)  Magic numbers... :^C
    if {[llength [dict get $scene objects pot vertices]] >= 1536 &&
            [llength [dict get $scene objects lid vertices]] >= 8} {
        lassign [lindex [dict get $scene objects pot vertices] 1535] px py pz
        lassign [lindex [dict get $scene objects lid vertices]    8] lx ly lz
        dict set scene teapot_height [expr\
                {sqrt(($lx - $px) ** 2 + ($ly - $py) ** 2 + ($lz - $pz) ** 2)}]
    } else {
        set scene [dict remove $scene teapot_height]
    }

    # The screen will need to be updated.
    scene_proj_calc
    scene_dirty

    # Force a PRP check.
    if {[catch {scene_persp_check} result opts]} {
        # Uh oh, failure.  Undo the load to avoid incorrect display.
        scene_reset
        return -options $opts $result
    }
}

# "Perspective" command implementation.
proc persp_action {} {
    global commands
    set args [list]
    foreach vector {vrp vpn vup prp} {
        set value [list]
        foreach dim {x y z} {
            lappend value $commands(persp,$vector$dim)
        }
        lappend args $vector $value
    }
    scene_persp_set {*}$args
}

# "View volume" command implementation.
proc vvol_action {} {
    global commands
    scene_viewvol_set\
            $commands(vvol,umin) $commands(vvol,vmin) $commands(vvol,nmin)\
            $commands(vvol,umax) $commands(vvol,vmax) $commands(vvol,nmax)
}

# "Viewport" command implementation.
proc vport_action {} {
    global commands
    scene_viewport_set $commands(vport,xmin) $commands(vport,ymin)\
                       $commands(vport,xmax) $commands(vport,ymax)
}

# "Translate VRP" command implementation.
proc tvrp_action {} {
    global commands

    # Grab some variables.
    set s $commands(tvrp,s)
    foreach var {x y z} {
        set $var [expr {$commands(tvrp,$var) / double($s)}]
    }

    # Schedule an animation.
    command_start
    anim_start {persp {vrp}} $s [3d_trans $x $y $z] command_finish
}

# "Translate PRP" command implementation.
proc tprp_action {} {
    global commands

    # Grab some variables.
    set s $commands(tprp,s)
    foreach var {x y z} {
        set $var [expr {$commands(tprp,$var) / double($s)}]
    }

    # Schedule an animation.
    command_start
    anim_start {persp {prp}} $s [3d_trans $x $y $z] command_finish
}

# "Rotate VPN" command implementation.
proc rvpn_action {} {
    global commands scene

    # Grab some variables.
    foreach var {ax ay az bx by bz d s} {
        set $var $commands(rvpn,$var)
    }
    foreach dim {x y z} {
        set v$dim [expr {[set b$dim] - [set a$dim]}]
    }
    set d [expr {$d * acos(-1) / 180 / $s}]

    # Which vectors should be rotated?
    set vectors [list vpn]
    if {$commands(rvpn,rvup)} {
        lappend vectors vup
    }

    # Schedule an animation.
    command_start
    anim_start [list persp $vectors] $s [3d_compose             \
            [3d_trans [expr {-$ax}] [expr {-$ay}] [expr {-$az}]]\
            [3d_rot   $vx $vy $vz $d] [3d_trans $ax $ay $az]]   \
            command_finish
}

# "Rotate" command implementation.
proc rot_action {} {
    global commands scene

    # Grab some variables.
    foreach var {ax ay az bx by bz d s} {
        set $var $commands(rot,$var)
    }
    foreach dim {x y z} {
        set v$dim [expr {[set b$dim] - [set a$dim]}]
    }
    set d [expr {$d * acos(-1) / 180 / $s}]

    # Schedule an animation.
    command_start
    anim_start [list object [dict keys [dict get $scene objects]]] $s       \
            [3d_compose [3d_trans [expr {-$ax}] [expr {-$ay}] [expr {-$az}]]\
                        [3d_rot   $vx $vy $vz $d] [3d_trans $ax $ay $az]]   \
            command_finish
}

# "Translate" command implementation.
proc trans_action {} {
    global commands scene

    # Grab some variables.
    set s $commands(trans,s)
    foreach var {x y z} {
        set $var [expr {$commands(trans,$var) / double($s)}]
    }

    # Schedule an animation.
    command_start
    anim_start [list object [dict keys [dict get $scene objects]]] $s\
            [3d_trans $x $y $z] command_finish
}

# "Scale" command implementation.
proc scale_action {} {
    global commands scene

    # Grab some variables.
    set s $commands(scale,s)
    foreach var {x y z} {
        set $var [expr {$commands(scale,$var) ** (1 / double($s))}]
    }

    # Schedule an animation.
    command_start
    anim_start [list object [dict keys [dict get $scene objects]]] $s\
            [3d_scale $x $y $z] command_finish
}

# "Animate" command implementation.
proc anim_action {} {
    global commands scene

    if {![dict exists $scene teapot_height]} {
        error "Teapot and lid models not loaded"
    }

    # Grab some variables.
    set s $commands(anim,s)
    set o [expr {$commands(anim,o) / double($s)}]

    # Calculate the offsets.
    lassign [lindex [dict get $scene objects pot vertices] 1535] px py pz
    lassign [lindex [dict get $scene objects lid vertices]    8] lx ly lz
    set l [expr {[dict get $scene teapot_height] / 
            sqrt(($lx - $px) ** 2 + ($ly - $py) ** 2 + ($lz - $pz) ** 2)}]
            
    # Schedule an animation.
    command_start
    anim_start {object {lid}} $s [3d_trans\
            [expr {($lx - $px) * $o * $l}]\
            [expr {($ly - $py) * $o * $l}]\
            [expr {($lz - $pz) * $o * $l}]] command_finish
}

# Set some miscellaneous options.
proc options_set {args} {
    global commands scene

    set options {frame_delay hl_clip}

    if {[llength $args] % 2 != 0} {
        error "wrong # args: should be\
               \"options_set ?option_name option_value? ?...?\""
    }

    # Only validate if not loading/initializing.
    if {![dict get $scene loading]} {
        foreach option $options {
            set $option [dict get $scene options $option]
        }
    }

    # Get changed options.
    foreach {option value} $args {
        if {$option ni $options} {
            error "unknown option \"$option\""
        } else {
            set $option $value
        }
    }

    # Part two...
    if {![dict get $scene loading]} {
        if {$frame_delay < 0} {
            error "Frame delay cannot be negative"
        }
    }

    # Commit.
    foreach option $options {
        dict set scene options $option [set $option]
        set commands(options,$option)  [set $option]
    }

    # Maybe the screen needs to be updated.
    scene_dirty
}

# "Options" command implementation.
proc options_action {} {
    global commands scene

    options_set frame_delay $commands(options,frame_delay)\
                hl_clip     $commands(options,hl_clip)
}

# Generic handler for animation start.
proc command_start {} {
    dict for {cmd btn} $::commands(buttons) {
        if {$cmd ne "load"} {
            $btn configure -state disabled 
        }
    }
}

# Generic handler for animation complete.
proc command_finish {} {
    dict for {cmd btn} $::commands(buttons) {
        $btn configure -state normal 
    }
}

# Create a command and its configuration pane.
proc command_create {cmd name description definition} {
    global commands gui

    if {![info exists commands(current)]} {
        # Select the initial command.
        set commands(current) $cmd
    }

    # Create the command selector.
    pack [radiobutton $gui(cmdsel_list).$cmd -variable commands(current)\
            -value $cmd -text $name -anchor w] -fill both -expand true

    # Create the command title button.
    set btn [button $gui(cmd_heading).$cmd -text $description\
            -command ${cmd}_action]
    dict set commands(buttons) $cmd $btn
    grid $btn -row 0 -column 0 -sticky ew

    # Create the command option frame.
    set frm [frame $gui(cmd_config).$cmd]
    dict set commands(frames) $cmd $frm
    grid $frm -row 0 -column 0 -sticky nsew

    # Fill in the frame.
    set r 0; set p 0
    foreach {type heading vars extra} $definition {
        switch -- $type {
        entry {
            # Row heading.
            grid [label $frm.$r-lab -text $heading] -row $r -column 0 -sticky w\
                    -pady 2

            # Variable(s).
            set varfrm [frame $frm.$r-var]
            set i 0; set c 0
            foreach {var def} $vars {
                # Set variable default.
                set commands($cmd,$var) $def

                if {$i != 0} {
                    # Make separator comma.
                    grid [label $varfrm.c$i -text ,] -row 0 -column $c -sticky w
                    incr c
                }

                # Variable entry widget.
                grid [entry $varfrm.$var -width 4 -textvariable\
                        commands($cmd,$var)] -row 0 -column $c -sticky ew
                grid columnconfigure $varfrm $c -weight 1

                incr i; incr c
            }
            grid $varfrm -row $r -column 1 -sticky ew
            grid columnconfigure $frm 1 -weight 1
        } check {
            lassign $vars var def
            set commands($cmd,$var) $def

            # Checkbutton.
            grid [checkbutton $frm.$r-cb -text $heading -variable\
                    commands($cmd,$var)] -row $r -column 0 -sticky w -pady 2\
                    -columnspan 2
        }}

        # Also an extra widget.
        switch -- [lindex $extra 0] {
        label {
            grid [label $frm.$r-ext -text [lindex $extra 1]] -row $r -column 2\
                    -sticky e -pady 2
        } button {
            grid [button $frm.$r-ext -text [lindex $extra 1] -command\
                    [lindex $extra 2]] -row $r -column 2 -sticky ew -pady 2
        }}

        incr r
    }
}

# Update the displayed command frame to match $::commands(current).
proc command_select {args} {
    global commands

    # Grab these values since they're used often.
    set btn [dict get $commands(buttons) $commands(current)]
    set frm [dict get $commands(frames)  $commands(current)]

    # Find the previously selected command.
    set oldbtn   [lindex [winfo children [winfo parent $btn]] end]
    set oldfrm   [lindex [winfo children [winfo parent $frm]] end]
    set previous [lindex [dict keys [dict filter $commands(buttons)\
            script {key val} {expr {$val eq $oldbtn}}]] end]

    if {$commands(current) ne $previous} {
        # Prevent the previous frame from being focused.
        foreach win [list $oldbtn $oldfrm] {
            foreach child [concat $win [gui_children $win]] {
                $child configure -takefocus 0
            }
            if {[gui_ancestor $win [focus]]} {
                focus $frm
            }
            if {[gui_ancestor $win [selection own]]} {
                selection clear -displayof $win
            }
        }

        # Display the newly-selected frame.
        foreach win [list $btn $frm] {
            raise $win
            foreach child [concat [list $win] [gui_children $win]] {
                $child configure -takefocus ""
            }
        }
    }
}

# Create fast matrix procs.
proc make_matrix_procs {} {
    # Assemble a fast matrix multiply procedure.  All matrices are 3x4 and are
    # treated as if they had a fourth row of [0 0 0 1].
    set code ""
    for {set y 0} {$y < 3} {incr y} {
        set row ""
        for {set x 0} {$x < 4} {incr x} {
            set cell ""
            for {set i 0} {$i < 3} {incr i} {
                if {$i != 0} {
                    append cell " + "
                }
                append cell "\[lindex \$m1 $y $i\] * \[lindex \$m2 $i $x\]"
            }
            if {$x == 3} {
                append cell " + \[lindex \$m1 $y $x\]"
            }
            if {$x != 0} {
                append row " "
            }
            append row "\[expr [list $cell]\]"
        }
        if {$y != 0} {
            append code " "
        }
        append code "\[list $row\]"
    }
    proc 3d_compose {m args} [string map [list %CODE% $code] {
        if {[llength $args] == 0} {
            return $m
        } else {
            set m2 [lindex $args end]
            set matrices [concat [list $m] [lrange $args 0 end-1]]
            for {set i 0} {$i < [llength $matrices]} {incr i} {
                set m1 [lindex $matrices end-$i]
                set m2 [list %CODE%]
            }
            return $m2
        }
    }]

    # Put together a fast matrix-vector multiply procedure.  The matrix is 3x4
    # and is combined with a fourth row of [0 0 0 1], and the vector is 1x3 and
    # is transposed and combined with a fourth row of [1].
    set code ""
    for {set y 0} {$y < 3} {incr y} {
        set cell ""
        for {set i 0} {$i < 3} {incr i} {
            if {$i != 0} {
                append cell " + "
            }
            append cell "\[lindex \$m $y $i\] * \[lindex \$v $i\]"
        }
        append cell " + \[lindex \$m $y $i\]"
        if {$y != 0} {
            append code " "
        }
        append code "\[expr [list $cell]\]"
    }
    proc 3d_apply {m v} "return \[list $code\]"
}

# Returns the identity matrix.
proc 3d_ident {} {
    return {{1 0 0 0}
            {0 1 0 0}
            {0 0 1 0}}
}

# Returns a matrix which translates by ($x,$y,$z).
proc 3d_trans {x y z} {
    return [list [list 1 0 0 $x]\
                 [list 0 1 0 $y]\
                 [list 0 0 1 $z]]
}

# Returns a matrix which rotates by $t radians about vector ($x,$y,$z).
proc 3d_rot {x y z t} {
    if {$x == 0 && $y == 0 && $z == 0} {
        error "Cannot rotate around zero vector"
    }
    set l [expr {sqrt($x ** 2 + $y ** 2 + $z ** 2)}]
    foreach dim {x y z} {
        set $dim [expr {[set $dim] / $l}]
    }

    set result [list]
    foreach row_expr {
        {{$x * $x + (1 - $x ** 2)      * cos($t)}
         {$x * $y * (1 - cos($t)) - $z * sin($t)}
         {$x * $z * (1 - cos($t)) + $y * sin($t)}}
        {{$y * $x * (1 - cos($t)) + $z * sin($t)}
         {$y * $y + (1 - $y ** 2)      * cos($t)}
         {$y * $z * (1 - cos($t)) - $x * sin($t)}}
        {{$z * $x * (1 - cos($t)) - $y * sin($t)}
         {$z * $y * (1 - cos($t)) + $x * sin($t)}
         {$z * $z + (1 - $z ** 2)      * cos($t)}}
    } {
        set row [list]
        foreach cell_expr [concat $row_expr [list 0]] {
            lappend row [expr $cell_expr]
        }
        lappend result $row
    }
    return $result
}

# Returns a matrix which scales by ($x,$y,$z).
proc 3d_scale {x y z} {
    return [list [list $x 0  0  0]\
                 [list 0  $y 0  0]\
                 [list 0  0  $z 0]]
}

# Returns a 3d vector multiplied by a scalar.
proc 3d_vscale {v s} {
    return [list [expr {[lindex $v 0] * $s}]\
                 [expr {[lindex $v 1] * $s}]\
                 [expr {[lindex $v 2] * $s}]]
}

# Returns the sum of two 3d vectors.
proc 3d_vsum {v1 v2} {
    return [list [expr {[lindex $v1 0] + [lindex $v2 0]}]
                 [expr {[lindex $v1 1] + [lindex $v2 1]}]
                 [expr {[lindex $v1 2] + [lindex $v2 2]}]]
}

# Returns the cross product of two 3d vectors.
proc 3d_vcross {v1 v2} {
    return [list [expr {[lindex $v1 1] * [lindex $v2 2] -
                        [lindex $v1 2] * [lindex $v2 1]}]\
                 [expr {[lindex $v2 0] * [lindex $v1 2] -
                        [lindex $v2 2] * [lindex $v1 0]}]\
                 [expr {[lindex $v1 0] * [lindex $v2 1] -
                        [lindex $v1 1] * [lindex $v2 0]}]]
}

# Returns the length of a 3d vector.
proc 3d_vlen {v} {
    return [expr {([lindex $v 0] ** 2 +
                   [lindex $v 1] ** 2 +
                   [lindex $v 2] ** 2) ** 0.5}]
}

# Returns a normalized 3d vector.  In case of zero vectors, returns {0 0 0}.
proc 3d_vnorm {v} {
    set len [3d_vlen $v]
    if {$len == 0} {
        return {0 0 0}
    } else {
        return [3d_vscale $v [expr {1.0 / $len}]]
    }
}

# Do stuff.
proc main {} {
    global commands gui

    # Make some procs. :^)
    make_matrix_procs

    # Set window parameters.
    wm title   . "Andy Goth: Lab 3D"
    wm minsize . 400 400

    # Create window names.
    array set gui {
        top             .
        scene           .scene
        cmdsel_canvas   .cmdsel_canvas
        cmdsel_list     .cmdsel_canvas.cmdsel_list
        cmdsel_scroll   .cmdsel_scroll
        cmd_pane        .cmd_pane
        cmd_heading     .cmd_pane.cmd_heading
        cmd_config      .cmd_pane.cmd_config
    }

    # Create the main widgets.
    canvas $gui(scene) -borderwidth 2 -relief sunken -highlightthickness 0
    canvas $gui(cmdsel_canvas) -yscrollcommand [list $gui(cmdsel_scroll) set]\
            -highlightthickness 0 -height 0 
    frame $gui(cmdsel_list)
    scrollbar $gui(cmdsel_scroll) -command [list $gui(cmdsel_canvas) yview]\
            -orient vertical
    frame $gui(cmd_pane)
    frame $gui(cmd_heading)
    frame $gui(cmd_config)

    # Place the command list in a scrollable canvas.
    bind $gui(cmdsel_list) <Configure> {
        [winfo parent %W] configure -width [winfo width %W]\
                -scrollregion [list 0 0 0 [expr {[winfo reqheight %W] + 2}]]
    }
    $gui(cmdsel_canvas) create window 0 0 -anchor nw -window $gui(cmdsel_list)

    # Create command panes.
    command_create load Load "Load Model" {
        entry Pot {pot ""} {button Browse... {load_browse commands(load,pot)}}
        entry Lid {lid ""} {button Browse... {load_browse commands(load,lid)}}}
    command_create persp Perspective "Adjust Perspective Parameters" {
        entry VRP {vrpx 0 vrpy 0 vrpz 0} {label WC }
        entry VPN {vpnx 0 vpny 0 vpnz 0} {label WC }
        entry VUP {vupx 0 vupy 0 vupz 0} {label WC }
        entry PRP {prpx 0 prpy 0 prpz 0} {label VRC}}
    command_create vvol "View Volume" "Adjust View Volume" {
        entry Min {umin 0 vmin 0} {label VRC}
        entry Max {umax 0 vmax 0} {label VRC}
        entry Back  {nmin 0     } {label VRC}
        entry Front {nmax 0     } {label VRC}}
    command_create vport Viewport "Adjust Viewport" {
        entry Min {xmin 0 ymin 0} {label NSC}
        entry Max {xmax 0 ymax 0} {label NSC}}
    command_create tvrp "Move VRP" "Translate VRP" {
        entry Offset {x 1 y 0 z 0} {label WC}
        entry Steps  {s 5        } {blank   }}
    command_create tprp "Move PRP" "Translate PRP" {
        entry Offset {x 1 y 0 z 0} {label VRC}
        entry Steps  {s 5        } {blank    }}
    command_create rvpn "Rotate VPN" "Rotate VPN About Line" {
        entry "Vertex A" {ax 0 ay 0 az 0} {label WC  }
        entry "Vertex B" {bx 1 by 0 bz 0} {label WC  }
        entry Angle      {d 90          } {label \ub0}
        entry Steps      {s 5           } {blank     }
        check "Synchronize VUP with VPN" {rvup false} {blank}}
    command_create rot Rotate "Rotate Object About Line" {
        entry "Vertex A" {ax 0 ay 0 az 0} {label WC  }
        entry "Vertex B" {bx 1 by 0 bz 0} {label WC  }
        entry Angle      {d 90          } {label \ub0}
        entry Steps      {s 5           } {blank     }}
    command_create trans Translate "Translate Object" {
        entry Offset {x 1 y 0 z 0} {label WC}
        entry Steps  {s 5        } {blank   }}
    command_create scale Scale "Scale Object" {
        entry Factor {x 1.1 y 1.1 z 1.1} {label WC}
        entry Steps  {s 5              } {blank   }}
    command_create anim Animate "Animate Lid" {
        entry Offset {o 0.5} {label WC}
        entry Steps  {s 5  } {blank   }}
    command_create options Options "Adjust Options" {
        entry "Frame delay"             {frame_delay 100  } {label ms}
        check "Highlight clip boundary" {hl_clip     false} {blank   }}

    # Initially disable focusing.
    foreach win [concat [dict values $commands(frames) ]\
                        [dict values $commands(buttons)]] {
        foreach child [concat [list $win] [gui_children $win]] {
            $child configure -takefocus 0
        }
    }

    # Display the command frames when they are selected.
    trace add variable commands(current) write command_select
    command_select

    # Initialize the scene.
    scene_init

    # Configure the command pane.
    pack $gui(cmd_heading) $gui(cmd_config) -side top -fill both -expand true
    grid columnconfigure $gui(cmd_heading) 0 -weight 1
    grid columnconfigure $gui(cmd_config)  0 -weight 1
    grid rowconfigure    $gui(cmd_config)  0 -weight 1

    # Grid together the widgets.
    grid $gui(scene) -sticky nsew -row 0 -column 0 -padx 4 -pady 4 -columnspan 3
    grid $gui(cmdsel_canvas) -sticky nsew -row 1 -column 0 -padx 4 -pady 4
    grid $gui(cmdsel_scroll) -sticky ns   -row 1 -column 1         -pady 4
    grid $gui(cmd_pane)      -sticky nsew -row 1 -column 2 -padx 4 -pady 4
    grid rowconfigure    $gui(top) 0 -weight 1
    grid columnconfigure $gui(top) 2 -weight 1
}

# Begin.
main

# vim: set ts=4 sts=4 sw=4 tw=80 et: