2004-10-11 [VI]  This is a menu display using the [minimalist curses] package.  You might have to
change the first line to load wherever your shared lib is.

 load [file join $::tcl_platform(os) curses[info sharedlibextension]]

 # Order is nswe

 array set ldc [list nw j ne m se l sw k nswe n we  q nse t nsw u nwe v swe w ns x bullet ~ diamond `]

 proc box {row1 col1 row2 col2} {
     global ldc

     curses attr on alt
     curses move $row1 $col1
     curses puts $ldc(se)
     curses move $row2 $col1
     curses puts $ldc(ne)
     for {set i [expr $row1 + 1] } {$i < $row2} {incr i} {
        curses move $i $col1
        curses puts $ldc(ns)
        curses move $i $col2
        curses puts $ldc(ns)
     }
     for {set i [expr $col1 + 1] } {$i < $col2} {incr i} {
        curses move $row1 $i
        curses puts $ldc(we)
        curses move $row2 $i
        curses puts $ldc(we)
     }
     curses move $row1 $col2
     curses puts $ldc(sw)
     curses move $row2 $col2
     curses puts $ldc(nw)
     curses attr off alt
 }


 proc menu {row col items} {
     set maxlength 0
     foreach item $items {
        if {[string length $item] > $maxlength} {
            set maxlength [string length $item]
        }
     }
     box $row $col [expr $row + [llength $items] + 1] [expr $col + $maxlength + 2]
     set selected 0
     while {1} {
        if {$selected < 0} {
            set selected 0
        } elseif {$selected > [llength $items] - 1} {
            set selected [expr [llength $items] - 1]
        }
        set i 0
        foreach item $items {
            if {$i == $selected} {
                curses attr on reverse
                set prefix ">"
            } else {
                curses attr off reverse
                set prefix " "
            }
            curses move [expr $row + $i + 1] [expr $col + 1]
            curses puts [format "$prefix%-${maxlength}s" $item]
            incr i
        }
        curses refresh
        binary scan [read stdin 1] c k
        switch $k {
            16 {incr selected -1}
            14 {incr selected 1}
            13 - 10 {return $selected}
            default {
                if {$k >= 0x30 && $k < 0x3A} {
                    set selected [expr $k - 0x30]
                }
            }
        }
     }
 }

 fconfigure stdin -buffering none
 menu 10 10 {alpha beta gamma delta epsilon "A really long string"  "some more junk" "..."}

<<categories>>Text Screen