--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/reference/ocr-new/tt.tcl	Thu May 18 23:12:51 2006 +0200
@@ -0,0 +1,63 @@
+#!/usr/sww/bin/wish4.0-b4
+set COLORED_WORDS {}
+text .t -background white -foreground black
+pack .t  
+set LOW_PRECISION_BACKGROUND green
+set MISPELLED_BACKGROUND blue
+set UNKNOWN_CHAR_BACKGROUND red
+.t tag configure LOW_PRECISION -background $LOW_PRECISION_BACKGROUND
+.t tag configure MISPELLED -background $MISPELLED_BACKGROUND
+.t tag configure UNKNOWN_CHAR -background $UNKNOWN_CHAR_BACKGROUND
+proc addword { w {xpos 0} {ypos 0} {status OK}} {
+    global COLORED_WORDS
+    puts $status
+    if { ![string compare $status OK] } {
+	.t insert end "$w " 
+	.t mark set insert end
+	.t mark set insert "end -2 char"
+	.t tag add $status "insert wordstart" "insert wordend"
+	.t tag add x$xpos "insert wordstart" "insert wordend"
+	.t tag add y$ypos "insert wordstart" "insert wordend"
+	.t mark set insert end
+    } elseif { ![string compare $status LOW_PRECISION] || ![string compare $status MISPELLED] || ![string compare $status UNKNOWN_CHAR] } {
+	.t insert end "$w "
+	.t mark set insert end
+	.t mark set insert "end -3 char"
+	.t tag add $status "insert wordstart" "insert wordend"
+	.t tag add x$xpos "insert wordstart" "insert wordend"
+	.t tag add y$ypos "insert wordstart" "insert wordend"
+	lappend COLORED_WORDS [.t index insert]
+	.t mark set insert end
+    } else {
+	puts stdout "Unknown word status for $w: $status"
+	.t insert end "$w UNKNOWNSTATUS? "
+    }
+}
+
+proc pop_colored_words { } {
+    global COLORED_WORDS
+    set x [lindex $COLORED_WORDS 0]
+    if {[llength $COLORED_WORDS] == 1} {
+	set COLORED_WORDS {}
+    } elseif {[llength $COLORED_WORDS] == 0} {
+	set COLORED_WORDS $COLORED_WORDS
+    } else {
+	set COLORED_WORDS [lrange $COLORED_WORDS 1 [llength $COLORED_WORDS]]
+    }
+    return $x
+}
+
+bind .t <Tab> {
+    if {[llength $COLORED_WORDS] == 0} {
+	puts stdout "No more words"
+    } else {
+	.t mark set insert [pop_colored_words]
+	.t mark set insert "insert wordstart"
+	set x [.t index insert]
+	puts "New index is $x"
+	.t see insert
+	set local_tags [.t tag names insert]
+	puts "Tags at this place: $local_tags"
+    }
+    break
+}
\ No newline at end of file