WC

World Coordinates. This is X, Y, Z stuff relative to the center of the universe.

VRC

View Reference Coordinates. This is U, V, N, relative to the VRP, the thing you're looking at.

NSC

Normalized Screen Coordinates. Onscreen coordinates, where (0,0) is upper left and (1,1) is lower right.

VRP

View Reference Point (WC). The thing you're looking at.

VPN

View Plane Normal (WC). The N axis points along this direction.

VUP

View Up (WC). The V axis points this way.

PRP

Perspective Reference Point (VRC). Basically this is where your eyeball is relative to the thing you're looking at.

View Volume

Frustum. This defines the region you can see in the viewport.

Viewport

Window. This defines the onscreen coordinates to which the view volume is mapped.

Load

Load a model file (or files, as the case may be). If you want to load something other than a teapot, just put its filename in the Pot entry.

Perspective

Adjust perspective parameters.

View Volume

Adjust view volume.

Viewport

Adjust viewport. You can also do this inside the canvas by dragging the white box or its border.

Move VRP

Translate the VRP. This is like moving your head around while looking in the same direction.

Move PRP

Translate the PRP. This is like moving your head but continuing to look at the same point in space.

Rotate VPN

Rotate the VPN. This is like moving your head around while looking at the same point. Specify two vertices on the axis about which you want to rotate, and give an angle in degrees. For instance, to rotate about X, say (0,0,0)-(1,0,0). If the step count isn't 1, the rotation is animated. Remember that the coordinates are WC, so if VRP's not at (0,0,0) you'll want to translate your rotation axis to accomodate. Maybe I should change this...? Also, you will want to enable Synchronize otherwise weird things will happen. (The lab instructor required that it be off by default.)

Rotate

Rotate the object. Visually this is like Rotate VPN except the direction is reversed. Rather than move your eyepoint, the world is moved.

Translate

Translate the object. Like Move VRP except you stay put while the world moves.

Scale

Scale the object. Stretch and shrink the object by X, Y, and Z factors. To keep the object the same size, use a factor of 1 not 0!

Animate

Animate the "lid" of the teapot. The implementation really bites; it only works with the official teapot and lid models. So stipulateth the assignment. This option is worth removing, but I won't do so until I have a better model file format to work with. And I don't think I want to bother, not for this sort of demonstrate-the-concept program.

Options

Adjust... stuff. You can change the animation speed here. Also you can highlight clipped lines in red. Later I might add options for rendering polygons instead of lines, performing lighting, backface culling, overlaying the window with axes, etc. Or I might just redo the whole thing.

 RESPONDENT   LANGUAGE      LENGTH   COMMENT
         #1   Tcl/Tk 8.5      1500   0 lines autogenerated by IDE
         #2   VB.NET 2003     3250   800 lines autogenerated by IDE
         #3   VB.NET 2003     2000
         #4   Java            4550   0 lines autogen by IDE, 17 files, 35 classes, 58 hours work

                   AVERAGE   -----RANK-----
 LANGUAGE   COUNT   LENGTH   COUNT   LENGTH   RESULT
 VB.NET         2     2625      #1       #2   Most popular, relatively few lines of code
 Java           1     4550      #2       #1   Most lines of code
 Tcl/Tk         1     1500      #2       #3   Fewest lines of code
 (any)          4     2825

http://www.openscenegraph.org

         #-1  C++              1   all lines already in the project. Run osgteapot from command line.
         #-2  C++            377   the sourcecode osgteapot.cpp of which about 100 lines are comments or blank.

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

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References