no display name and no $DISPLAY environment variable
    while executing
"load /enadisk/commun/linux/local/ActiveTcl-8.6.11/lib/libtk8.6.so Tk"
    ("package ifneeded Tk 8.6.11" script)
    invoked from within
"package require Tk"
    (in namespace eval "::request" script line 17)
    invoked from within
"namespace eval ::request $script"
    ("::try" body line 12)
OUTPUT BUFFER:
# trislam.tcl
#
# Purpose: Determine performance curves for various methods of pushing
#          triangles and quads through the OpenGL pipeline
#
# Copyright (c) 2004-2006, Geoff Broadwell; this script is released
# as open source and may be distributed and modified under the terms
# of either the Artistic License or the GNU General Public License,
# in the same manner as Perl itself.  These licenses should have been
# distributed to you as part of your Perl distribution, and can be
# read using `perldoc perlartistic` and `perldoc perlgpl` respectively.
#
# Rewritten in Python by Bob Free
#
# Rewritten and extended for Tcl3D by Paul Obermeier, 2008

package require Tk
package require tcl3d 0.5.0

tcl3dConsoleCreate .tcl3dOutputConsole "# " "Console of TrislamTcl3D"

### USER CONFIG

# Primitive sizes (and therefore counts) are integer divisors of
# (A^i * B^j * C^k ...) where good A, B, C, ... are relatively prime;
# this number is used for the draw area height and width and defaults to:
#     2^4 * 3^2 * 5 = 720
# You may also want to get fewer data points across the same range by
# directly using higher powers; for example:
#     16  * 9   * 5 = 720
#
# max_powers = (16 => 1, 9 => 1, 5 => 1);
set max_powers [list 2 4 3 2 5 1]

# Maximum quads along each axis for known slow versus usually fast tests;
# chosen to be somewhat reasonable for most common settings of @max_powers
# my $max_count_slow = 60;
set max_count_slow 154
set max_count_fast 154

# Font to use to label graphs
set fontName {-family {Helvetica} -size 10}

### MISC GLOBALS

set VERSION "0.1.24"

set MIN_FRAMES  0
set MIN_SECONDS 0

set w 0
set h 0

set slow [list]
set fast [list]

set test  0
set run   0
set done  0
set ready 0

set showing_graph 0
set empty_time    0
set empty_frames  0

set optLineMode 1

# Create a stop watch for time measurement.
set stopwatch [tcl3dNewSwatch]
tcl3dStartSwatch $stopwatch 

### BENCHMARK TYPES

array set va_types {
    q  make_quads_va
    t  make_tris_va
    qs make_qs_va
    ts make_ts_va
}

array set dl_types {
    qs  draw_qs
    ts  draw_ts
    qsv draw_qs_va
    tsv draw_ts_va
}

    # Nick Draw Routine  Stats Calc  Type   Graph         Color
set testTemplates { \
    {empty draw_empty    stats_empty single {1.0 1.0 1.0} 0xFFFF} \
    {t     draw_tris     stats_tris  slow   {1.0 0.0 0.0} 0xAAAA} \
    {q     draw_quads    stats_quads slow   {1.0 0.5 0.0} 0xAAAA} \
    {ts    draw_ts       stats_ts    slow   {1.0 1.0 0.0} 0xAAAA} \
    {qs    draw_qs       stats_qs    slow   {0.0 1.0 0.0} 0xAAAA} \
    {tsd   draw_ts_dl    stats_ts    fast   {0.0 1.0 1.0} 0xAAAA} \
    {qsd   draw_qs_dl    stats_qs    fast   {0.0 0.0 1.0} 0xAAAA} \
    {tv    draw_tris_va  stats_tris  fast   {0.8 0.0 0.0} 0xFFFF} \
    {qv    draw_quads_va stats_quads fast   {0.8 0.4 0.0} 0xFFFF} \
    {tsv   draw_ts_va    stats_ts    fast   {0.8 0.8 0.0} 0xFFFF} \
    {qsv   draw_qs_va    stats_qs    fast   {0.0 0.8 0.0} 0xFFFF} \
    {tsvd  draw_ts_va_dl stats_ts    fast   {0.0 0.8 0.8} 0xFFFF} \
    {qsvd  draw_qs_va_dl stats_qs    fast   {0.0 0.0 0.8} 0xFFFF} \
}

# Utility procedures for output to console and text widget.

proc PrintTextMsg { msg newline } {
    append msg $newline
    puts -nonewline $msg ; flush stdout
}

proc OUTS { msg } {
    PrintTextMsg $msg "\n"
}

proc OUT { msg } {
    PrintTextMsg $msg "\n"
}

proc OUTN { msg } {
    PrintTextMsg $msg ""
}

# Show errors occuring in the Togl callbacks.
proc bgerror { msg } {
    tk_messageBox -icon error -type ok -message "Error: $msg"
    exit
}

# Print info message into widget at the bottom of the window.
proc PrintInfo { msg } {
    if { [winfo exists .fr.info] } {
        .fr.info configure -text $msg
    }
}

### BENCHMARK INITS

proc SelectionChanged {} {
    global labels

    set labels(selectionChanged) 1
}

proc Reset {} {
    global test run done ready
    global tests testTemplates stats
    global max total
    global labels

    set test  0
    set run   0
    set done  0
    set ready 0
    ClearTestLabels
    ClearCountLabels

    set stats [list]
    set total [list]
    set max   [list]

    # Fill the tests list with the tests as selected in the GUI.
    set tests [list]
    foreach t $testTemplates {
        set name [lindex $t 0]
        if { $labels(usetest,$name) } {
            lappend tests $t
        }
    }
    set labels(selectionChanged) 0
}

proc make_quads_va { count size } {
    for { set y 0 } { $y < $count } { incr y } {
        set y0 [expr {$y * $size}] 
        set ys [expr {$y0 + $size}] 
        for { set x 0 } { $x < $count } { incr x } {
            set x0 [expr {$x * $size}] 
            set xs [expr {$x0 + $size}] 
            lappend l $x0 $ys  $x0 $y0  $xs $y0  $xs $ys
        }
    }
    return [tcl3dVectorFromList GLfloat $l]
}

proc make_qs_va { count size } {
    for { set y 0 } { $y < $count } { incr y } {
        set y0 [expr {$y * $size}] 
        set ys [expr {$y0 + $size}] 
        for { set x 0 } { $x <= $count } { incr x } {
            set x0 [expr {$x * $size}] 
            lappend l $x0 $ys  $x0 $y0
        }
    }
    return [tcl3dVectorFromList GLfloat $l]
}

proc make_tris_va { count size } {
    for { set y 0 } { $y < $count } { incr y } {
        set y0 [expr {$y * $size}] 
        set ys [expr {$y0 + $size}] 
        for { set x 0 } { $x < $count } { incr x } {
            set x0 [expr {$x * $size}] 
            set xs [expr {$x0 + $size}] 
            lappend l $x0 $ys  $x0 $y0  $xs $ys
            lappend l $xs $ys  $x0 $y0  $xs $y0
        }
    }
    return [tcl3dVectorFromList GLfloat $l]
}

proc make_ts_va { count size } {
    for { set y 0 } { $y < $count } { incr y } {
        set y0 [expr {$y * $size}] 
        set ys [expr {$y0 + $size}] 
        for { set x 0 } { $x <= $count } { incr x } {
            set x0 [expr {$x * $size}] 
            lappend l $x0 $ys  $x0 $y0
        }
    }
    return [tcl3dVectorFromList GLfloat $l]
}

### BENCHMARK METHODS

proc draw_empty { count size } {
    return
}

proc stats_empty { count size } {
    return [list 0 0 0 0]
}

proc draw_quads { count size } {
    glBegin GL_QUADS
    for { set y 0 } { $y < $count } { incr y } {
        set y0 [expr {$y * $size}] 
        set ys [expr {$y0 + $size}] 
        for { set x 0 } { $x < $count } { incr x } {
            set x0 [expr {$x * $size}] 
            set xs [expr {$x0 + $size}] 
            glVertex2f $x0 $ys
            glVertex2f $x0 $y0
            glVertex2f $xs $y0
            glVertex2f $xs $ys
        }
    }
    glEnd
}

proc draw_quads_va { count size } {
    global vas

    set va $vas(q_$count)
    glVertexPointer 2 GL_FLOAT 0 $va
    glEnableClientState GL_VERTEX_ARRAY
    glDrawArrays GL_QUADS 0 [expr {4 * $count * $count}]
    glDisableClientState GL_VERTEX_ARRAY
}

proc stats_quads { count size } {
    set length  [expr {$size * $count}]
    set area    [expr {$length * $length}]
    set prims   [expr {$count * $count}]
    set tris    [expr {2 * $prims}]
    set verts   [expr {4 * $prims}]
    return [list $area $prims $tris $verts]
}

proc draw_qs { count size } {
    for { set y 0 } { $y < $count } { incr y } {
        set y0 [expr {$y * $size}] 
        set ys [expr {$y0 + $size}] 
        glBegin GL_QUAD_STRIP
        for { set x 0 } { $x <= $count } { incr x } {
            set x0 [expr {$x * $size}] 
            glVertex2f $x0 $ys
            glVertex2f $x0 $y0
        }
        glEnd
    }
}

proc draw_qs_va { count size } {
    global vas

    set va $vas(qs_$count)
    set row [expr {2 * ($count + 1)}]

    glVertexPointer 2 GL_FLOAT 0 $va

    glEnableClientState GL_VERTEX_ARRAY
    for { set y 0 } { $y < $count } { incr y } {
        glDrawArrays GL_QUAD_STRIP [expr {$y * $row}] $row
    }
    glDisableClientState GL_VERTEX_ARRAY
}

proc draw_qs_dl { count size } {
    global dls

    glCallList $dls(qs_$count)
}

proc draw_qs_va_dl { count size } {
    global vas dls

    set va $vas(qs_$count)

    glVertexPointer 2 GL_FLOAT 0 $va

    glEnableClientState GL_VERTEX_ARRAY
    glCallList $dls(qsv_$count)
    glDisableClientState GL_VERTEX_ARRAY
} 

proc stats_qs { count size } {
    set length [expr {$size * $count}]
    set area   [expr {$length * $length}]
    set prims  $count
    set tris   [expr {2 *  $count * $prims}]
    set verts  [expr {2 * ($count + 1) * $prims}]
    return [list $area $prims $tris $verts]
}

proc draw_tris { count size } {
    glBegin GL_TRIANGLES
    for { set y 0 } { $y < $count } { incr y } {
        set y0 [expr {$y * $size}] 
        set ys [expr {$y0 + $size}] 
        for { set x 0 } { $x < $count } { incr x } {
            set x0 [expr {$x * $size}] 
            set xs [expr {$x0 + $size}] 

            glVertex2f $x0 $ys
            glVertex2f $x0 $y0
            glVertex2f $xs $ys

            glVertex2f $xs $ys
            glVertex2f $x0 $y0
            glVertex2f $xs $y0
        }
    }
    glEnd
}

proc draw_tris_va { count size } {
    global vas

    set va $vas(t_$count)

    glVertexPointer 2 GL_FLOAT 0 $va

    glEnableClientState GL_VERTEX_ARRAY
    glDrawArrays GL_TRIANGLES 0 [expr {6 * $count * $count}]
    glDisableClientState GL_VERTEX_ARRAY
} 

proc stats_tris { count size } {
    set length [expr {$size * $count}]
    set area   [expr {$length * $length}]
    set prims  [expr {2 * $count * $count}]
    set tris   $prims
    set verts  [expr {3 * $prims}]
    return [list $area $prims $tris $verts]
}

proc draw_ts { count size } {
    for { set y 0 } { $y < $count } { incr y } {
        set y0 [expr {$y * $size}] 
        set ys [expr {$y0 + $size}] 
        glBegin GL_TRIANGLE_STRIP
        for { set x 0 } { $x <= $count } { incr x } {
            set x0 [expr {$x * $size}] 
            glVertex2f $x0 $ys
            glVertex2f $x0 $y0
        }
        glEnd
    }
} 

proc draw_ts_va { count size } {
    global vas

    set va $vas(ts_$count)
    set row [expr {2 * ($count + 1)}]

    glVertexPointer 2 GL_FLOAT 0 $va

    glEnableClientState GL_VERTEX_ARRAY
    for { set y 0 } { $y < $count } { incr y } {
        glDrawArrays GL_TRIANGLE_STRIP [expr {$y * $row}] $row
    }
    glDisableClientState GL_VERTEX_ARRAY
}

proc draw_ts_dl { count size } {
    global dls

    glCallList $dls(ts_$count)
} 

proc draw_ts_va_dl { count size } {
    global vas dls

    set va $vas(ts_$count)

    glVertexPointer 2 GL_FLOAT 0 $va

    glEnableClientState GL_VERTEX_ARRAY
    glCallList $dls(tsv_$count)
    glDisableClientState GL_VERTEX_ARRAY
}

proc stats_ts { count size } {
    set length [expr {$size * $count}]
    set area   [expr {$length * $length}]
    set prims  $count
    set tris   [expr {2 *  $count * $prims}]
    set verts  [expr {2 * ($count + 1) * $prims}]
    return [list $area $prims $tris $verts]
}

# STATISTICS

proc fixup_stats {} {
    global ready
    global stats total
    global max
    global empty_time empty_frames

    set stat [lindex $stats 0]
    if { [lindex $stat 0] eq "empty" } {
        set empty_time [lindex $stat 2]
        set empty_frames [lindex $stat 3]
        set empty_tpf [expr $empty_time / $empty_frames]
        #puts "Found empty stat: $empty_time $empty_frames $empty_tpf"
        while { [lindex $stat 0] eq "empty" } {
            set stats [lrange $stats 1 end]
            set stat [lindex $stats 0]
        }
    } else {
        set empty_time   0
        set empty_frames 0
        set empty_tpf    0
    }

    lappend total "totl,"
    lappend total 0
    for { set i 0 } { $i < 12 } { incr i } {
        lappend total 0.0
    }

    lappend max "max"
    lappend max 0
    for { set i 0 } { $i < 12 } { incr i } {
        lappend max 0.0
    }

    set newstats [list]
    foreach stat $stats {
        foreach {name count secs frames pixpf prmpf tpf vpf} $stat { break }

        # Subtract out empty loop time, and loop if negative result
        # $time -= $empty_tpf * $frames;
        if { $secs <= 0 } {
            for { set i 0 } { $i < 5 } { incr i } {
                lappend stat 0
            }
            continue
        }

        # Calc "work", the geometric mean of pixels and vertices
        set workpf [expr sqrt (double ($pixpf) * $vpf)]

        # Calc fps
        set fps [expr double($frames) / $secs]

        # Calc other perf stats
        set pixps [expr $pixpf * $fps]
        set prmps [expr $prmpf * $fps]
        set tps   [expr $tpf * $fps]
        set vps   [expr $vpf * $fps]
        set wps   [expr $workpf * $fps]
        
        # Add them to stat row
        lappend stat $fps $pixps $prmps $tps $vps $wps

        # Convert per frame counts to totals
        for { set i 4 } { $i < 8 } { incr i } {
            lset stat $i [expr [lindex $stat $i] * double($frames)]
        }

        # Update running totals
        for { set i 2 } { $i < 8 } { incr i } {
            lset total $i [expr [lindex $total $i] + [lindex $stat $i]]
        }

        # Update running maximums
        for { set i 2 } { $i < 14 } { incr i } {
            if { [lindex $max $i] < [lindex $stat $i] } {
                lset max $i [lindex $stat $i]
            }
        }
        lappend newstats $stat
    }
    set stats $newstats

    # Calc averages for totals line
    for { set i 8 } { $i < 14 } { incr i } {
        if { [lindex $total 2] == 0 } {
            lset total $i 0
        } else {
            lset total $i [expr [lindex $total [expr $i-5]] / [lindex $total 2]]
        }
    }
    lset total 1 "avg"

    incr ready
}

proc show_stats {} {
    global total stats
    global empty_time empty_frames

    set basic {Name Cnt Time}
    set raw   {Frms Mpix Kprim Ktri Kvert}
    set calc $raw
    set header [concat $basic $raw $calc]

    set mags {0 6 3 3 3 0 6 3 3 3}
    foreach i $mags {
        lappend scale [expr pow (10, $i)]
    }

    set g_form "%9s%-*s%s"
    set h_form "%-5s%3s %6s"
    append h_form [string repeat " %5s" [llength $raw]]
    append h_form [string repeat " %5s" [llength $calc]]
    set fmt "%-5s%3s %6.3f"
    append fmt [string repeat " %5d" [llength $raw]]
    append fmt [string repeat " %5d" [llength $calc]]

    OUT [format "Line mode %s" [expr $::optLineMode ? "ON" : "OFF"]]
    OUT [format $g_form "" [expr 6*[llength $raw] + 8] "MEASURED" "PER SECOND"]
    set cmd "format \"$h_form\" [join $header]"
    OUTS [eval $cmd]

    set empty_stat { \
        "empty" "1" $empty_time $empty_frames \
        0 0 0 0 0 0 0 0 0 \
    }
    set cmd "format \"$fmt\" [join $empty_stat]"
    OUTS [eval $cmd]

    lappend stats $total

    foreach stat $stats {
        set count 0
        foreach val $stat {
            set tstat($count) $val
            incr count
        }

        for { set i 0 } { $i < [llength $scale] } { incr i } {
            set tstat([expr $i+3]) [expr int ($tstat([expr $i+3]) / [lindex $scale $i])]
        }

        OUTS [format $fmt \
              $tstat(0) $tstat(1) $tstat(2) $tstat(3) $tstat(4)  $tstat(5) \
              $tstat(6) $tstat(7) $tstat(8) $tstat(9) $tstat(10) $tstat(11) \
              $tstat(12)]
    }
}

proc kilo_mag { num } {
    set mag [expr {int(log($num) / log(10))}]
    return [expr {int($mag / 3)}]
}

proc mag_char { num } {
    return [lindex {"" "K" "M" "G" "T" "P" "E" "Z" "Y"} [kilo_mag $num]]
}

proc mag_scale { num } {
    return [expr {pow (10, [expr 3*[kilo_mag $num]])}]
}

proc tick_inc { max { parts 5 } } {
    if { $max < 1 } {
        return [expr {$max / $parts}]
    }

    set mag [expr {int(log($max) / log(10))}]
    set scl [expr {pow (10, ($mag - 1))}]
    set inc [expr {$max / ($scl * $parts)}]

    if { $inc > 7.5 } {
        set inc 10
    } elseif { $inc > 3.5 } {
        set inc 5
    } elseif { $inc > 1.5 } {
        set inc 2
    } else {
        set inc 1
    }

    return [expr {$inc * $scl}]
}

proc draw_one_stat { x_loc y_loc y_off x_scale num } {
    global tests stats
    global max h

    set y_max [lindex $max $num]
    set y_scale [expr {($h - 4.0*$y_off) / (2.0*$y_max)}]

    foreach item $tests {
        set name [lindex $item 0]
        set colors($name)  [lindex $item end-1]
        set stipple($name) [lindex $item end]
    }
    set last ""

    glEnable GL_LINE_STIPPLE
    glBegin GL_LINE_STRIP
    for { set run 0 } { $run < [llength $stats] -1 } { incr run } {
        set stat [lindex $stats $run]
        set name  [lindex $stat 0]
        set count [lindex $stat 1]
        set value [lindex $stat $num]

        if { $name ne $last } {
            glEnd
            glLineStipple 3 $stipple($name)
            glBegin GL_LINE_STRIP
            set color $colors($name)
            glColor3f [lindex $color 0] [lindex $color 1] [lindex $color 2]
            set last $name
        }

        glVertex2f [expr {$count*$x_scale + $x_loc}] [expr {$value*$y_scale + $y_loc}]
    }
    glEnd

    glDisable GL_LINE_STIPPLE
}

proc draw_string { font str x y } {
    glRasterPos2f $x $y
    glListBase $font
    set len [string length $str]
    set sa [tcl3dVectorFromByteArray GLubyte $str]
    glCallLists $len GL_UNSIGNED_BYTE $sa
    $sa delete
}

proc draw_stats {} {
    global ready
    global w h
    global slow fast
    global tests
    global max
    global font_style

    if { ! $ready } {
        return
    }

    # Graph config
    set x_off 10
    set y_off 10
    set tick_size 3
    set val_space 50
    set key_size  20
    # OPA set x_count  len(fast) and fast[-1] or slow[-1]
    set x_count  [lindex $slow end]
    set x_scale   [expr {($w - 4.0 * $x_off) / (2.0 * $x_count)}]
    set key_scale [expr {($h - 4.0 * $y_off) / (2.0 * [llength $tests])}]

    # Get a fresh black frame for graphing
    glClearColor 0 0 0 1
    start_frame

    # Use antialiased lines
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    glEnable GL_LINE_SMOOTH
    glHint GL_LINE_SMOOTH_HINT GL_NICEST

    # Draw axis ticks
    glColor3f 1 1 1
    glBegin GL_LINES

    foreach count [concat 0 $slow $fast] {
        set x_tick [expr {$count * $x_scale + $x_off}]

        glVertex2f $x_tick $y_off
        glVertex2f $x_tick [expr {$y_off - $tick_size}]
        glVertex2f $x_tick [expr {$y_off + $h / 2.0}]
        glVertex2f $x_tick [expr {$y_off + $h / 2.0 - $tick_size}]
        glVertex2f [expr {$x_tick + $w / 2.0}] [expr {$y_off + $h / 2.0}]
        glVertex2f [expr {$x_tick + $w / 2.0}] [expr {$y_off + $h / 2.0 - $tick_size}]
    }
    glEnd

    set x_tick  [expr {$x_off + 3}]
    set val_max [expr {int(($h / 2.0 - 2.0 * $y_off) / $val_space)}]

    # Work
    for { set value 0 } { $value < $val_max } { incr value } {
        set y_tick [expr {$value * $val_space + $y_off}]

        glBegin GL_LINES
        glVertex2f $x_off $y_tick
        glVertex2f [expr {$x_off - $tick_size}] $y_tick
        glEnd
    }

    # Pixels
    set value 0
    set val_max [expr {[lindex $max 9] / [mag_scale [lindex $max 9]] }]
    set y_scale [expr {($h - 4.0 * $y_off) / (2.0 * $val_max)}]
    set val_inc [tick_inc $val_max 5]
    while { $value < $val_max } {
        set y_tick [expr {($value * $y_scale) + $y_off}]

        glBegin GL_LINES
        glVertex2f $x_off [expr {$y_tick + $h / 2.0}]
        glVertex2f [expr {$x_off - $tick_size}] [expr {$y_tick + $h / 2.0}]
        glEnd
        if { $value } {
            draw_string $font_style $value $x_tick [expr {$y_tick + $h / 2.0}]
        }
        set value [expr {$value + $val_inc}]
    }

    # Vertices
    set value 0
    set val_max [expr {[lindex $max 12] / [mag_scale [lindex $max 12]] }]
    set y_scale [expr {($h - 4.0 * $y_off) / (2.0 * $val_max)}]
    set val_inc [tick_inc $val_max 5]

    while { $value < $val_max } {
        set y_tick [expr {($value * $y_scale) + $y_off}]

        glBegin GL_LINES
        glVertex2f [expr {$x_off + $w / 2.0}] [expr {$y_tick + $h / 2.0}]
        glVertex2f [expr {$x_off + $w / 2.0 - $tick_size}] [expr {$y_tick + $h / 2.0}]
        glEnd
        if { $value } {
            draw_string $font_style $value [expr {$x_tick + $w/2.0}] [expr {$y_tick + $h/2.0}]
        }
        set value [expr {$value + $val_inc}]
    }

    # Draw axes
    glBegin GL_LINE_STRIP
    glVertex2f $x_off [expr {$h / 2.0 - $y_off}]
    glVertex2f $x_off $y_off
    glVertex2f [expr {$w / 2.0 - $x_off}] $y_off
    glEnd
    glBegin GL_LINE_STRIP
    glVertex2f $x_off [expr {$h - $y_off}]
    glVertex2f $x_off [expr {$h / 2.0 + $y_off}]
    glVertex2f [expr {$w / 2.0 - $x_off}] [expr {$h / 2.0 + $y_off}]
    glEnd
    glBegin GL_LINE_STRIP
    glVertex2f [expr {$w / 2.0 + $x_off}] [expr {$h - $y_off}]
    glVertex2f [expr {$w / 2.0 + $x_off}] [expr {$h / 2.0 + $y_off}]
    glVertex2f [expr {$w - $x_off}] [expr {$h / 2.0 + $y_off}]
    glEnd

    # Draw color key
    for { set num 0 } { $num < [llength $tests] } { incr num } {
        set test [lindex $tests $num]
        set name    [lindex $test 0]
        set color   [lindex $test end-1]
        set stipple [lindex $test end]

        glEnable GL_LINE_STIPPLE
        glLineStipple 3 $stipple

        glBegin GL_LINES
        glColor3f [lindex $color 0] [lindex $color 1] [lindex $color 2]
        glVertex2f [expr {$x_off + $w / 2.0}] [expr {$y_off + $num * $key_scale}]
        glVertex2f [expr {$x_off + $w / 2.0 + $key_size}] [expr {$y_off + $num * $key_scale}]
        glEnd

        glDisable GL_LINE_STIPPLE

        draw_string $font_style $name \
                    [expr {$x_off+$w/2.0+$key_size*2.0}] \
                    [expr {$y_off+$num*$key_scale}]
    }

    # Draw performance graph lines

    # Pixels per second
    draw_one_stat $x_off [expr {$y_off + $h / 2.0}] $y_off $x_scale 9
    glColor3f 1.0 1.0 1.0
    draw_string $font_style "[mag_char [lindex $max 9]] Pixels/Sec" \
                [expr {$w/4.0}] [expr {$h-2.0*$y_off}]

    # Vertices per second
    draw_one_stat [expr {$x_off + $w/2.0}] [expr {$y_off + $h/2.0}] $y_off $x_scale 12
    glColor3f 1.0 1.0 1.0
    draw_string $font_style "[mag_char [lindex $max 12]] Vertices/Sec" \
                [expr {3.0*$w/4.0}] [expr {$h-2.0*$y_off}]

    # "Work" per second, the geometric mean of pixels and vertices
    draw_one_stat $x_off $y_off $y_off $x_scale 13
    glColor3f 1.0 1.0 1.0
    draw_string $font_style "Work/Sec" [expr {$w/4.0}] [expr {$h/2.0 - 2.0*$y_off}]

    # Show our graph
    end_frame
    set showing_graph 1
}

proc RedrawStats {} {
    fixup_stats
    show_stats
    draw_stats
} 

proc display { toglwin } {
    global done ready
    global tests

    if { ! [info exists tests] || [llength $tests] == 0 } {
        start_frame
        end_frame
        return
    }

    if { ! $done && [info exists ::animateId] } {
        benchmark
    } elseif { ! $ready && [info exists ::animateId] } {
        RedrawStats
    } elseif { $done && $ready } {
        StopAnimation
        set ::startStop 0
        draw_stats
    }
}

proc Animate {} {
    .fr.toglwin postredisplay
    set ::animateId [tcl3dAfterIdle Animate]
}

# This procedure should not be named StartAnimation, as this a reserved
# name of the Tcl3D presentation framework for demos which should be
# automatically animated after startup, which we don't want for this demo.
proc StartAnimationTest {} {
    global labels

    if { ! [info exists ::animateId] } {
        if { $labels(selectionChanged) } {
            Reset
        }
        Animate
    }
}

proc StopAnimation {} {
    if { [info exists ::animateId] } {
        after cancel $::animateId
        unset ::animateId
    }
}

proc StartStopAnimation {} {
    if { [info exists ::animateId] } {
        StopAnimation
    } else {
        StartAnimationTest
    }
}

proc start_frame {} {
    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
}

proc end_frame {} {
    glFinish
}

proc fade_to_white { frac } {
    glColor4f $frac $frac $frac 1
    glClearColor $frac $frac $frac 1
    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
    glFinish
}

proc benchmark {} {
    global MIN_FRAMES MIN_SECONDS
    global w h
    global stats tests test
    global done run
    global slow fast
    global labels

    if { $test >= [llength $tests] } {
        if { ! $done } {
            OUT "."
        }
        incr done
        return
    }

    set currentTest [lindex $tests $test]
    foreach { name draw do_stats class } $currentTest { break }

    if { $class eq "single" } {
        set counts [list 1]
    } elseif { $class eq "slow" } {
        set counts $slow
    } else {
        set counts [concat $slow $fast]
    }
    $labels(test,$name) configure -background yellow

    if { ! $run } {
        OUTN " $name" ; flush stdout
    }

    set count [lindex $counts $run]
    set size  [expr $w / $count]
    $labels(count,$count) configure -background yellow

    fade_to_white [expr ($test + (double($run)/[llength $counts])) / \
                   [llength $tests]]

    # Set polygon mode.
    if { $::optLineMode } {
        glColor3f 0 1 0
        glPolygonMode GL_FRONT_AND_BACK GL_LINE
    } else {
        glPolygonMode GL_FRONT_AND_BACK GL_POLYGON
    }

    set run_done 0
    set frames 0
    tcl3dResetSwatch $::stopwatch

    while { ! $run_done } {
        start_frame
        $draw $count $size
        end_frame

        incr frames
        if { $MIN_FRAMES <= $frames && \
             $MIN_SECONDS <= [tcl3dLookupSwatch $::stopwatch] } {
            set run_done 1 
        }
    }

    glFinish
    set secs [tcl3dLookupSwatch $::stopwatch]

    lappend stats [join [list $name $count $secs $frames \
                        [$do_stats $count $size]]]

    incr run
    if { $run >= [llength $counts] } {
        $labels(test,$name) configure -background green
        ClearCountLabels
        incr test
        set run 0
    }
}

proc init_display_lists {} {
    global w h
    global dl_types dls
    global slow fast

    OUTN "Init display lists:"
    set l [concat $slow $fast]
    set num_lists [expr [array size dl_types] * [llength $l]]
    set current [glGenLists $num_lists]

    set types [lsort [array names dl_types]]
    tcl3dResetSwatch $::stopwatch
    foreach type $types {
        OUTN " $type" ; flush stdout
        foreach count $l {
            set dls(${type}_${count}) $current
            glNewList $current GL_COMPILE
            incr current
            set drawFunc $dl_types($type)
            $drawFunc $count [expr $w / $count]
            glEndList
        }
    }
    set secs [format " (%.2f secs)" [tcl3dLookupSwatch $::stopwatch]]
    OUT "$secs"
}

proc init_vertex_arrays {} {
    global w h
    global va_types vas
    global slow fast

    OUTN "Init vertex arrays:"
    set types [lsort [array names va_types]]
    tcl3dResetSwatch $::stopwatch
    foreach type $types {
        OUTN " $type" ; flush stdout
        set l [concat $slow $fast]
        foreach count $l {
            set dataFunc $va_types($type)
            set data [$dataFunc $count [expr $w / $count]]
            set vas(${type}_${count}) $data
        }
    }
    set secs [format " (%.2f secs)" [tcl3dLookupSwatch $::stopwatch]]
    OUT "$secs"
}

proc show_basic_config { version } {
    global conf

    OUT "$conf(title), version $version\n"

    OUT "Operating system: $::tcl_platform(os)"
    OUT "Tcl version:      [info patchlevel]"
    OUT "Graphic card:     [glGetString GL_RENDERER]"
    OUT "OpenGL version:   [glGetString GL_VERSION]"
    OUT ""

    OUT "window size:      $conf(width) x $conf(height)"
    OUT "min frames/test:  $conf(frames)"
    OUT "min seconds/test: $conf(seconds)"
}

proc show_user_message {} {
    global slow fast

    set msg {
TRISLAM benchmarks several methods of pushing OpenGL primitives,
testing each method with various primitive counts and sizes.
During the benchmark, the test window will start out black, slowly
brightening to white as testing progresses.  Once benchmarking is
complete, the collected data will be dumped in tabular form.

The configuration for this series of tests will be as follows:
}
    OUT $msg

    show_basic_config $::VERSION

    OUT "standard runs:   "
    foreach i $slow {
        OUTN " $i"
    }
    OUT ""
    OUT "extra fast runs: "
    foreach i $fast {
        OUTN " $i"
    }
    OUT ""
    OUT [string repeat "-" 80]
    OUT ""
}

proc recurse_combos { argList } {
    if { [llength $argList] == 0 } {
        return [list 1]
    }
    set base [lindex $argList 0]
    set max_power [lindex $argList 1]

    set combos [list]
    for { set power 0 } { $power <= $max_power } { incr power } {
        set multiplier [expr int (pow ($base, $power))]
        foreach item [recurse_combos [lrange $argList 2 end]] {
            lappend combos [expr {$item * $multiplier}]
        }
    }
    return $combos
}

proc ClearTestLabels {} {
    global labels

    foreach key [array names labels "test,*"] {
        $labels($key) configure -background white
    }
}

proc ClearCountLabels {} {
    global labels

    foreach key [array names labels "count,*"] {
        $labels($key) configure -background white
    }
}

proc SetAllTests { allTestsOn } {
    global labels

    foreach key [array names labels "usetest,*"] {
        set labels($key) $allTestsOn
    }
    SelectionChanged
}

proc AllTestsOn {} {
    SetAllTests 1
}

proc AllTestsOff {} {
    SetAllTests 0
}

proc SnapShot { fileName } {
    . configure -cursor watch
    update
    if { $fileName ne "" } {
        # Create a name on the file system, if running from within a Starpack.
        set fileName [tcl3dGenExtName $fileName]
        set imgName [file rootname $fileName]
        set imgExt ".png"
        set imgFmt "PNG"
        append imgName $imgExt
        tcl3dWidget2File . $imgName "*Console*" $imgFmt
        puts "Screenshot written to: $imgName"
    }
    . configure -cursor top_left_arrow
}

proc SaveSnapshot {} {
    global ready done run
    global test tests

    set fileName ""
    if { $done && $ready } {
        set fileName "trislam-stat"
    } elseif { ! $done } {
        set currentTest [lindex $tests $test]
        set testName [lindex $currentTest 0]
        set fileName "trislam-$testName-$run"
    }
    if { $fileName ne "" } {
        SnapShot $fileName
    }
}

proc init_opengl { title w h } {
    global testTemplates
    global slow fast
    global labels

    frame .fr
    pack .fr -expand 1 -fill both
    set toglwin .fr.toglwin
    togl $toglwin -width $w -height $h \
                  -double false -depth true \
                  -displayproc display
    frame .fr.btns
    label .fr.info
    grid $toglwin  -row 0 -column 0 -sticky news
    grid .fr.btns  -row 0 -column 1 -sticky new
    grid .fr.info  -row 1 -column 0 -sticky news -columnspan 2
    grid rowconfigure .fr 0 -weight 1
    grid columnconfigure .fr 0 -weight 1

    set actionFrame .fr.btns.actionFr
    labelframe $actionFrame -text "Actions"
    pack $actionFrame -side top -fill x -expand 1 -pady 5 -padx 2

    checkbutton $actionFrame.start -indicatoron false -text "Start" \
                -variable ::startStop -command StartStopAnimation
    pack $actionFrame.start -side top -fill x -expand 1
    button $actionFrame.reset -text "Reset" -command Reset
    pack $actionFrame.reset -side top -fill x -expand 1
    button $actionFrame.snap -text "Snapshot" -command SaveSnapshot
    pack $actionFrame.snap -side top -fill x -expand 1

    set optionFrame .fr.btns.optionFr
    labelframe $optionFrame -text "Options"
    pack $optionFrame -side top -fill x -expand 1 -pady 5 -padx 2

    checkbutton $optionFrame.line -text "Line Mode" -variable ::optLineMode
    pack $optionFrame.line -side top -fill x -expand 1


    set testFrame .fr.btns.testFr
    labelframe $testFrame -text "Test Selection"
    pack $testFrame -side top -fill x -expand 1 -pady 5 -padx 2

    set labels(selectionChanged) 0
    foreach t $testTemplates {
        set name [lindex $t 0]
        set labels(usetest,$name) 0
        set labels(test,$name) [checkbutton $testFrame.cb_$name \
                                            -text $name -bg white -anchor w \
                                            -command SelectionChanged \
                                            -variable labels(usetest,$name)]
        pack $testFrame.cb_$name -side top -fill x
    }
    button $testFrame.allOn -text "All On" -command AllTestsOn
    pack $testFrame.allOn -side top -fill x -expand 1
    button $testFrame.allOff -text "All Off" -command AllTestsOff
    pack $testFrame.allOff -side top -fill x -expand 1


    set infoFrame .fr.btns.infoFr
    labelframe $infoFrame -text "Count Info"
    pack $infoFrame -side top -fill x -expand 1 -pady 5 -padx 2

    frame $infoFrame.fr0
    frame $infoFrame.fr1
    frame $infoFrame.fr2
    pack $infoFrame.fr0 $infoFrame.fr1 $infoFrame.fr2 \
         -side left -fill both -expand 1

    set ind 0
    foreach c [concat $slow $fast] {
        set frInd [expr $ind % 3]
        set labels(count,$c) [label $infoFrame.fr$frInd.l_$c -text $c -bg white]
        pack $infoFrame.fr$frInd.l_$c -side top -fill x
        incr ind
    }

    wm title . $title
    return $toglwin
}

proc init {} {
    global MIN_FRAMES MIN_SECONDS
    global w h
    global conf
    global slow fast
    global max_powers max_count_slow max_count_fast
    global font_style

    # Figure out primitive counts for each run of each test type
    catch { unset ::combo_hash }

    foreach item [recurse_combos $max_powers] {
        set ::combo_hash($item) [list]
    }

    set combos [lsort -integer [array names ::combo_hash]]

    foreach item $combos {
        set i [expr int($item)]
        if { $i <= $max_count_slow } {
            lappend slow $i
        }
        if { $i > $max_count_slow && $i <= $max_count_fast } {
            lappend fast $i
        }
    }

    # Choose drawing area size to match counts
    set h [expr int([lindex $combos end])]
    set w $h

    # Do the standard init stuff, including command line processing,
    # window creation, and so on
    array set conf [list \
        "title" "Tcl3D demo: Triangle Slammer OpenGL Benchmark" \
        "width" $w \
        "height" $h \
        "geometry" "${w}x${h}" \
        "frames" 10 \
        "seconds" 1 \
    ]

    set toglwin [init_opengl $conf(title) $w $h]

    # Reduce indirections in inner loops
    set MIN_FRAMES  $conf(frames)
    set MIN_SECONDS $conf(seconds)

    # Let user know what's going on
    show_user_message

    # Change projection to integer-pixel ortho
    glMatrixMode GL_PROJECTION
    glOrtho 0 [expr $w +1] 0 [expr $h +1]  -1 1
    glMatrixMode GL_MODELVIEW

    # Load font for graph labels
    set font_style [$toglwin loadbitmapfont $::fontName]

    # Make sure GL state is consistent for VA and DL creation
    start_frame

    # Create vertex arrays and display lists outside timing loop
    init_vertex_arrays
    init_display_lists

    # Clean up GL state
    end_frame
}

# Cleanup procedure needed only, when this script is used from
# the presentation framework.
proc Cleanup {} {
    uplevel #0 unset max_powers
    uplevel #0 unset slow
    uplevel #0 unset fast
    uplevel #0 unset va_types
    uplevel #0 unset dl_types
    uplevel #0 unset testTemplates
    uplevel #0 unset labels
    uplevel #0 unset stats
    uplevel #0 unset total
    uplevel #0 unset max
    uplevel #0 unset tests
    uplevel #0 unset vas
    uplevel #0 unset dls
    uplevel #0 unset conf
    uplevel #0 unset combo_hash

    $::stopwatch -delete
}

proc ExitProg {} {
    exit
}

# Main app

init
Reset
OUTN "Benchmarks: "

wm protocol . WM_DELETE_WINDOW "ExitProg"
bind .  "ExitProg"

PrintInfo [format "Running on %s with a %s (OpenGL %s, Tcl %s)" \
           $tcl_platform(os) [glGetString GL_RENDERER] \
           [glGetString GL_VERSION] [info patchlevel]]