reference/ocr-simple/tt.tcl
author viric@llimona
Thu, 18 May 2006 23:12:51 +0200
changeset 0 6b8091ca909a
permissions -rwxr-xr-x
Init from working directory of svn repository.

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