1 files changed, 82 insertions, 0 deletions
diff --git a/demos/buttons.tcl b/demos/buttons.tcl
new file mode 100755
index 0000000..29ffddf
--- /dev/null
+++ b/demos/buttons.tcl
@@ -0,0 +1,82 @@
+#!/bin/sh
+# next line is a comment in tcl \
+exec wish "$0" ${1+"$@"}
+
+## buttons.tcl
+##
+## demonstrates the simulation of a button array
+##
+## ellson@lucent.com
+## modifications made by jeff at hobbs org
+
+source [file join [file dirname [info script]] loadtable.tcl]
+
+array set table {
+    rows	20
+    cols	20
+    table	.table
+}
+
+# create the table
+set t $table(table)
+table $t -rows [expr {$table(rows)+1}] -cols [expr {$table(cols)+1}] \
+	-titlerows  1 -titlecols  1 \
+	-roworigin -1 -colorigin -1 \
+	-colwidth 4 \
+	-width 8 -height 8 \
+	-variable tab \
+	-flashmode off \
+	-cursor top_left_arrow \
+	-borderwidth 2 \
+	-state disabled \
+	-xscrollcommand ".sx set" -yscrollcommand ".sy set"
+
+scrollbar .sx -orient h -command "$t xview"
+scrollbar .sy -orient v -command "$t yview"
+
+grid $t .sy -sticky nsew
+grid .sx -sticky ew
+grid columnconfig . 0 -weight 1
+grid rowconfig . 0 -weight 1
+
+# set up tags for the various states of the buttons
+$t tag configure OFF -bg red -relief raised
+$t tag configure ON  -bg green -relief sunken
+$t tag configure sel -bg gray75 -relief flat
+
+# clean up if mouse leaves the widget
+bind $t <Leave> {
+    %W selection clear all
+}
+
+# highlight the cell under the mouse
+bind $t <Motion> {
+    if {[%W selection includes @%x,%y]} break
+    %W selection clear all
+    %W selection set @%x,%y
+    break
+    ## "break" prevents the call to tkTableCheckBorder
+}
+
+# mousebutton 1 toggles the value of the cell
+# use of "selection includes" would work here
+bind $t <1> {
+    set rc [%W cursel]
+    if {[string match ON $tab($rc)]} {
+	set tab($rc) OFF
+        %W tag celltag OFF $rc
+    } {
+	set tab($rc) ON
+        %W tag celltag ON $rc
+    }
+}
+
+# inititialize the array, titles, and celltags
+for {set i 0} {$i < $table(rows)} {incr i} {
+    set tab($i,-1) $i
+    for {set j 0} {$j < $table(cols)} {incr j} {
+        if {! $i} {set tab(-1,$j) $j}
+	set tab($i,$j) "OFF"
+        $t tag celltag OFF $i,$j
+    }
+}