#

# user interface code (tcl visuals) for OCR

# started 9/95, Archie Russell 

append OCRCHIE_ROOT [pwd] "/"

append face_image $OCRCHIE_ROOT face_happy.xbm

append eye_image $OCRCHIE_ROOT eye.xbm

append write_image $OCRCHIE_ROOT edit2.xbm

set xvprocess "0"

set main_window_width 800

set main_window_height 800

set dummy 0

# I'd like to be able to use the above parameters in here,

# but I think tcl might get a little angry if I try

# the size of the window, and the position of its upper left

set main_window_geometry 800x800+200+100

set menu_bar_width $main_window_width

set menu_bar_height 50

set button_bar_width $main_window_width

set button_bar_height 50

set display_height 400

set edit_window_height 300

set quit_dialog_geometry 300x135+500+500

set save_ascii_geometry 275x140+500+500

# save a little room for scrollbars, etc.

set BACKGROUND #CCCCCC

set FOREGROUND #000000

# set FONT -bitstream-*-medium-r-normal--26-171-110-110-p-150-iso8859-1

set FONT -bitstream-*-medium-r-normal--19-140-85-85-p-110-hp-roman8

set SMALLFONT -bitstream-*-medium-r-normal--19-140-85-85-p-110-hp-roman8

set EDIT_BACKGROUND #000000

set LOW_PRECISION_BACKGROUND blue

set MISPELLED_BACKGROUND SeaGreen

set UNKNOWN_CHAR_BACKGROUND red

set scroll_inc 30

set canvas_width [expr $main_window_width - 30]

proc init_user_interface {} {

# tcl requires declaration of global variables used in a fxn

    global main_window_geometry main_window_width main_window_height menu_bar_width menu_bar_height button_bar_width button_bar_height display_height BACKGROUND FOREGROUND EDIT_BACKGROUND edit_window_height

# toplevel windows are at the same level as 'xterms'    

    toplevel .main_window

# $ sign means 'get the value' (otherwise uses the string)

    wm geometry .main_window $main_window_geometry

    wm title .main_window "OCR user interface"

    .main_window configure -background $BACKGROUND

# frames are subwindows that are there mostly to 'hold' other windows

    frame .main_window.menu_bar -width $menu_bar_width -height $menu_bar_height -relief raised -bd 2 -background $BACKGROUND

    init_menu_bar

    frame .main_window.button_bar -width $button_bar_width -height $button_bar_height -background $BACKGROUND 

    init_button_bar

    init_display

    frame .main_window.edit_window -width $main_window_width -height $edit_window_height -relief ridge -bd 5 -bg $EDIT_BACKGROUND

    init_edit_window

# pack puts things together: this will put the menu_bar window just above the button_bar_window above the display

    pack .main_window.menu_bar -side top -fill x

    pack .main_window.button_bar .main_window.display .main_window.edit_window -side top -anchor w

    focus .main_window

}

proc init_menu_bar { } {

# this command initializes the main menu bar (stuff like file, etc)

# shortcuts not working! why?

    global BACKGROUND FOREGROUND FONT

    menubutton .main_window.menu_bar.file -text "File " -menu .main_window.menu_bar.file.menu -borderwidth 2 -background $BACKGROUND -foreground $FOREGROUND -font $FONT

    init_file_menu

    menubutton  .main_window.menu_bar.tools -text "Tools " -menu .main_window.menu_bar.tools.menu  -borderwidth 2 -background $BACKGROUND -foreground $FOREGROUND -font $FONT

    init_tools_menu

    menubutton  .main_window.menu_bar.options -text "Options " -menu .main_window.menu_bar.options.menu  -borderwidth 2 -background $BACKGROUND -foreground $FOREGROUND -font $FONT

    init_options_menu

    pack .main_window.menu_bar.file .main_window.menu_bar.tools .main_window.menu_bar.options -side left -padx 1m -pady 1m 

# if we ever put in the help junk...

#    menubutton  .main_window.menu_bar.help -text "Help" -menu .main_window.menu_bar.options.help  -borderwidth 2 -background $BACKGROUND -foreground $FOREGROUND -font $FONT

#    pack .main_window.menu_bar.help -side right

}

proc init_file_menu { } {

# this creates the menu associated with the file menubutton

    global FOREGROUND BACKGROUND FONT

    menu .main_window.menu_bar.file.menu -background $BACKGROUND -foreground $FOREGROUND -font $FONT

# and these initialize the entries in the menu (open is linked to the command popup_open_menu)

    .main_window.menu_bar.file.menu add command -label "Open..." -command popup_open_menu 

    .main_window.menu_bar.file.menu add command -label "Close" -command close_document 

    .main_window.menu_bar.file.menu add separator

#    .main_window.menu_bar.file.menu add command -label "Save TIFF" -command popup_save_tiff_menu 

    .main_window.menu_bar.file.menu add command -label "Save ASCII" -command popup_save_ascii_menu 

    .main_window.menu_bar.file.menu add command -label "Save WORD/POS" -command popup_save_word_pos_menu 

    .main_window.menu_bar.file.menu add command -label "Save Learned Characters" -command popup_save_learned_chars_menu 

    .main_window.menu_bar.file.menu add command -label "Read Learned Characters" -command popup_read_learned_chars_menu 

#    .main_window.menu_bar.file.menu add command -label "Save Setup" -command popup_save_setup_menu 

# a separator is just a horizontal line for show

    .main_window.menu_bar.file.menu add separator

    .main_window.menu_bar.file.menu add command -label "Quit" -command popup_quit_dialog_box 

}

proc close_document { } {

    .main_window.edit_window.text_part delete 1.0 end

    .main_window.display.work_space delete all

    set COLORED_WORDS {}

    DEALLOCATE_PAGE

}

proc init_tools_menu { } {

# this creates the menu associated with the tools menubutton

    global BACKGROUND FOREGROUND FONT

    menu .main_window.menu_bar.tools.menu -background $BACKGROUND -foreground $FOREGROUND -font $FONT

# and these initialize the entries in the menu (open is linked to the command popup_open_menu)

#    supposed to just find the angle and tell you what it is...

#    .main_window.menu_bar.tools.menu add command -label "Skew Angle" -command popup_skew_angle_menu 

#  supposed to let the user arbitrarily rotate the image

#    .main_window.menu_bar.tools.menu add command -label "Rotate" -command popup_rotate_menu

    .main_window.menu_bar.tools.menu add command -label "Recognize" -command popup_recognize_menu

    .main_window.menu_bar.tools.menu add separator

    .main_window.menu_bar.tools.menu add command -label "Zoom in" -command ZOOM_IN

    .main_window.menu_bar.tools.menu add command -label "Zoom out" -command ZOOM_OUT

    .main_window.menu_bar.tools.menu add separator

    .main_window.menu_bar.tools.menu add command -label "Refresh" -command DISPLAY_INTERVALS 

    .main_window.menu_bar.tools.menu add command -label "Deskew" -command popup_deskew_menu

# automated spell correction

#    .main_window.menu_bar.tools.menu add command -label "SpellCorrect" -command popup_correct_menu

# interactive learning

#    .main_window.menu_bar.tools.menu add command -label "Learn Mode" -command popup_learn_mode

}

set CURRENT_DEFAULT_FONT Helvetica

set CURRENT_DEFAULT_SIZE 9

proc popup_learn_mode { } {

    global BACKGROUND FOREGROUND SMALLFONT FONT

    toplevel .learn 

    frame .learn.c -width 100 -height 100

    canvas .learn.c.c -background $BACKGROUND -width 100 -height 100

    pack .learn.c.c

    frame .learn.s

    entry .learn.s.learned_string -width 5 -bg $BACKGROUND -fg $FOREGROUND -font $SMALLFONT

    label .learn.s.string_message -text "Ascii" -bg $BACKGROUND -fg $FOREGROUND -font $SMALLFONT

    pack .learn.s.learned_string .learn.s.string_message -side left -expand 1 

    tk_optionMenu .learn.font CURRENT_DEFAULT_FONT Helvetica Courier Times 

    .learn.font configure -bg $BACKGROUND -fg $FOREGROUND -font $SMALLFONT

    .learn.font.menu configure -bg $BACKGROUND -fg $FOREGROUND

    tk_optionMenu .learn.size CURRENT_DEFAULT_SIZE 9 10 12 18 

    .learn.size configure -bg $BACKGROUND -fg $FOREGROUND -font $SMALLFONT

    .learn.size.menu configure -bg $BACKGROUND -fg $FOREGROUND

    frame .learn.buttons

    button .learn.buttons.ok -text Learn -command learn_ok -fg $FOREGROUND -background $BACKGROUND -font $SMALLFONT -width 5

    button .learn.buttons.cancel -text Skip -command learn_skip -fg $FOREGROUND -background $BACKGROUND -font $SMALLFONT -width 5

    pack .learn.buttons.ok .learn.buttons.cancel -side left -expand 1 -fill x 	    

    pack .learn.c .learn.s .learn.font .learn.size .learn.buttons -side top -fill x 

}

proc popup_deskew_menu { } {

    puts stdout "Calling get_skew"

    DESKEW 

}

proc popup_recognize_menu { } {

    puts stdout "Calling recognize from Tcl"

    FIND_LINES_AND_RECOGNIZE

}

set XV 2

proc init_options_menu { } {

    global dummy word_certainty_value screen_view_style FOREGROUND BACKGROUND FONT XV

    menu .main_window.menu_bar.options.menu -foreground $FOREGROUND -background $BACKGROUND -font $FONT

    .main_window.menu_bar.options.menu add command -label "Warning Levels..." -command popup_confidence_menu

#    .main_window.menu_bar.options.menu add command -label "Zoom Ratio" -command popup_zoom_ratio_menu

    .main_window.menu_bar.options.menu add checkbutton -label "Display Line Boundaries" -variable DISPLAY_LINE_BOUNDARIES

    .main_window.menu_bar.options.menu add checkbutton -label "Display Bounding Boxes" -variable DISPLAY_BOUNDING_BOXES

    .main_window.menu_bar.options.menu add checkbutton -label "Spellcheck" -variable SPELLCHECK

    .main_window.menu_bar.options.menu add separator

    .main_window.menu_bar.options.menu add radiobutton -label "No Display" -variable DISPLAY_IMAGE -value 0

    .main_window.menu_bar.options.menu add radiobutton -label "OCRchie Display" -variable DISPLAY_IMAGE -value 1

    .main_window.menu_bar.options.menu add radiobutton -label "xv" -variable DISPLAY_IMAGE -value $XV

    .main_window.menu_bar.options.menu add separator

    .main_window.menu_bar.options.menu add radiobutton -label "No deskew" -variable DESKEW_METHOD -value -1

    .main_window.menu_bar.options.menu add radiobutton -label "RLE rotate" -variable DESKEW_METHOD -value 1

    .main_window.menu_bar.options.menu add radiobutton -label "Bitmap rotate" -variable DESKEW_METHOD -value 0

}

set GLOBAL_MESSAGE "<none>"

proc init_button_bar { } {

    global FONT BACKGROUND FOREGROUND GLOBAL_MESSAGE

    message .main_window.button_bar.msg -font $FONT -background $BACKGROUND -foreground $FOREGROUND -width 400

    pack .main_window.button_bar.msg

}

proc init_display { } {

    global display_height canvas_width FOREGROUND BACKGROUND IMAGE_DISPLAY_WIN main_window_width display_height scroll_inc 

    frame .main_window.display -width $main_window_width -height $display_height -relief ridge -bd 5 -bg $BACKGROUND

    canvas .main_window.display.work_space -bg white -xscrollcommand ".main_window.display.xscroller set" -yscrollcommand ".main_window.display.yscroller set" -xscrollincrement $scroll_inc -cursor {crosshair black gray} -width $canvas_width -height $display_height

# two scrollbars

    scrollbar .main_window.display.xscroller -command ".main_window.display.work_space xview" -orient horizontal -background $BACKGROUND

    scrollbar .main_window.display.yscroller -command ".main_window.display.work_space yview" -background $BACKGROUND

    pack .main_window.display.xscroller -side bottom -fill x

    pack .main_window.display.work_space .main_window.display.yscroller -side left -fill y

    set IMAGE_DISPLAY_WIN .main_window.display.work_space

    .main_window.display.work_space configure -scrollregion { 0 0 5000 5000 }

#    initialize_region_grab 

}

proc init_edit_window { } {

    global edit_window_height canvas_width EDIT_BACKGROUND COLORED_WORDS LOW_PRECISION_BACKGROUND MISPELLED_BACKGROUND UNKNOWN_CHAR_BACKGROUND SMALLFONT SCALE_FACTOR scroll_inc

    text .main_window.edit_window.text_part -bg $EDIT_BACKGROUND -height $edit_window_height -width $canvas_width -insertbackground yellow -insertwidth 8 -font $SMALLFONT -fg white -wrap word

    pack .main_window.edit_window.text_part -side bottom

    .main_window.edit_window.text_part tag configure LOW_PRECISION -background $LOW_PRECISION_BACKGROUND

    .main_window.edit_window.text_part tag configure MISPELLED -background $MISPELLED_BACKGROUND

    .main_window.edit_window.text_part tag configure UNKNOWN_CHAR -background $UNKNOWN_CHAR_BACKGROUND

# Tab binding for the window is supposed to advance the cursor to the

# next uncertain word and scroll the image display to show the image

# of that word

    bind .main_window.edit_window.text_part <Tab> {

	if {[llength $COLORED_WORDS] == 0} {

	    puts stdout "No more words"

	} else {

	    .main_window.edit_window.text_part mark set insert [pop_colored_words]

	    set xpos [pop_colored_words]

	    set ypos [pop_colored_words]

#	    puts "xpos and ypos for this word"

	    set ulx [expr $SCALE_FACTOR * ($xpos - 300)]

	    set uly [expr $SCALE_FACTOR * ($ypos - 100)]

	    set lrx [expr $SCALE_FACTOR * ($xpos + 300)]

	    set lry [expr $SCALE_FACTOR * ($ypos + 100)]

# I could never get this scrolling to work quite right, maybe

# someone will figure it out someday 	    

	    .main_window.display.work_space configure -scrollregion [list $ulx $uly $lrx $lry]

	    .main_window.display.work_space configure -scrollregion {0 0 5000 5000}

#	    .main_window.display.work_space xview moveto [expr (($SCALE_FACTOR * $xpos) / $scroll_inc)]

#	    .main_window.display.work_space yview moveto [expr (($SCALE_FACTOR * $ypos) / $scroll_inc)]

	    set x [.main_window.edit_window.text_part index insert]

#	    puts "New index is $x"

	    .main_window.edit_window.text_part see insert

	    set local_tags [.main_window.edit_window.text_part tag names insert]

#	    puts "Tags at this place: $local_tags"

	}

	break

    }

}

proc addword { w {xpos 0} {ypos 0} {status OK}} {

    global COLORED_WORDS LOW_PRECISION_BACKGROUND MISPELLED_BACKGROUND UNKNOWN_CHAR_BACKGROUND

#    puts stdout "Adding $w with status $status"

    if { ![string compare $status OK] } {

	.main_window.edit_window.text_part insert end "$w " 

	.main_window.edit_window.text_part mark set insert end

    } elseif { ![string compare $status LOW_PRECISION] || ![string compare $status MISPELLED] || ![string compare $status UNKNOWN_CHAR] } {

	.main_window.edit_window.text_part insert end "$w" $status

	.main_window.edit_window.text_part insert end " "

#       xpos and ypos can be tags too, but they really slow things down

#	.main_window.edit_window.text_part mark set insert end

#	.main_window.edit_window.text_part mark set insert "end -3 char"

#	.main_window.edit_window.text_part tag add $status "insert wordstart" "insert wordend"

#	.main_window.edit_window.text_part tag add x$xpos "insert wordstart" "insert wordend"

#	.main_window.edit_window.text_part tag add y$ypos "insert wordstart" "insert wordend"

	.main_window.edit_window.text_part mark set insert "end -3 char"

	.main_window.edit_window.text_part mark set insert "insert wordstart"

	lappend COLORED_WORDS [.main_window.edit_window.text_part index insert]

	lappend COLORED_WORDS $xpos

	lappend COLORED_WORDS $ypos

	.main_window.edit_window.text_part mark set insert end

    } else {

	puts stdout "Unknown word status for $w: $status"

	.main_window.edit_window.text_part 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

}

set x_init 0

set y_init 0

set x_final 0

set y_final 0

set started_region 0

set region_count 0

proc initialize_region_grab { } {

#

#  NONE OF THE REGION STUFF IS BEING USED CURRENTLY

#

# facilitates the grabbing of a rectangle of the window

# using mouse button 1

# and apparently a lot of other junk!

    global x_init y_init x_final y_final started_region region_data region_list region_id arrow_in_progress current_arrow

    bind .main_window.display.work_space <ButtonPress-1> {

	if [expr ! $started_region] {

	    grab set .main_window.display 

	    set x_init [.main_window.display.work_space canvasx %x]

	    set y_init [.main_window.display.work_space canvasy %y]

	    set region_id [.main_window.display.work_space create rectangle $x_init $y_init $x_init $y_init -outline black -width 3]

	    .main_window.display.work_space itemconfigure $region_id -tags region$region_id

	    set started_region 1

	}

    }

    bind .main_window.display.work_space <ButtonRelease-1> {

	set x_final [.main_window.display.work_space canvasx %x]

	set y_final [.main_window.display.work_space canvasy %y]

	.main_window.display.work_space coords region$region_id $x_init $y_init $x_final $y_final

	# if finishing a rectangle, initialize its stuff in the array

	if {$x_init <= $x_final} {

	    set region_data($region_id,x_init) $x_init

	    set region_data($region_id,x_final) $x_final

	} else {

	    set region_data($region_id,x_final) $x_init

	    set region_data($region_id,x_init) $x_final

	}

	if {$y_init <= $y_final} {

	    set region_data($region_id,y_init) $y_init

	    set region_data($region_id,y_final) $y_final

	} else {

	    set region_data($region_id,y_init) $y_final

	    set region_data($region_id,y_final) $y_init

	}

	set region_data($region_id,next_region_id) 0

	lappend region_list $region_id

	make_region_buttons $region_id	    

	set started_region 0

	grab release .main_window.display

    }

    bind .main_window.display.work_space <B2-Motion> {

	if $arrow_in_progress {

	    set curx [.main_window.display.work_space canvasx %x] 

	    set cury [.main_window.display.work_space canvasy %y]

	    .main_window.display.work_space coords $current_arrow 0 0 $curx $cury

	}

    }

    bind .main_window.display.work_space <B1-Motion> {

	if $started_region {

	    set curx [.main_window.display.work_space canvasx %x] 

	    set cury [.main_window.display.work_space canvasy %y]

	    .main_window.display.work_space coords region$region_id $x_init $y_init $curx $cury

	} 

    }

    bind .main_window.display <Leave> {

	# on leaving the display, release control of the mouse etc.

	# maybe make it scroll instead?

	if $started_region {

	    grab release .main_window.display

	    set started_region 0

	    .main_window.display.work_space coords region$region_id 0 0 0 0  

	}

    }

}

set arrow_in_progress 0

proc make_region_buttons { reg_id } {

    global region_data kill_button_data next_button_data arrow_in_progress current_arrow

    set x_init $region_data($reg_id,x_init)

    set y_init $region_data($reg_id,y_init)

    set next_num [.main_window.display.work_space create rectangle $x_init $y_init [expr $x_init + 20] [expr $y_init + 20] -fill blue -tags "region$reg_id next_button$reg_id"]

    set next_button_data($next_num,reg_id) $reg_id

    .main_window.display.work_space bind next_button$reg_id <Double-2> {

	set reg_id $next_button_data([.main_window.display.work_space find withtag current],reg_id)

	if { $arrow_in_progress } {

	    finish_arrow $reg_id

	} else {

	    set canvas_x [.main_window.display.work_space canvasx %x] 

	    set canvas_y [.main_window.display.work_space canvasy %y]

	    start_arrow $reg_id $canvas_x $canvas_y

	    puts stdout "Starting an arrow at $canvas_x $canvas_y"

	}

    }

    set kill_num [.main_window.display.work_space create rectangle [expr $x_init + 20] $y_init [expr $x_init + 40] [expr $y_init + 20] -fill red -tags "region$reg_id kill_button$reg_id"]

    set kill_button_data($kill_num,reg_id) $reg_id

    .main_window.display.work_space bind kill_button$reg_id <Double-2> {

	set reg_id $kill_button_data([.main_window.display.work_space find withtag current],reg_id)

	destroy_region $reg_id .main_window.display.work_space

    }

}

proc start_arrow { reg_id x_start y_start } {

    global arrow_in_progress next_button_data region_data current_arrow

    set path_name .main_window.display.work_space

# start an arrow in the middle of the little red button

    set arrow [.main_window.display.work_space create line $x_start $y_start $x_start $y_start -width 3 -arrow last -arrowshape {6.0m 8.0m 1.5m} -fill blue -tags arrow$reg_id]

    set region_data($reg_id,arrow) $arrow

    set arrow_in_progress 1

    set current_arrow $arrow

}

proc destroy_region { reg_id path_name } {

    $path_name delete region$reg_id

    puts stdout "Destroying $reg_id"

}

set open_menu_geometry 250x300+400+400

set current_directory [pwd]

set box_entry $current_directory

set open_menu_pattern *.tif

proc popup_open_menu { } {

#

# this procedure pops up an interactive box which can be used to open files

# what a horrible mess.  Writing it took forever

#

    global open_menu_geometry open_menu_pattern current_directory FONT FOREGROUND BACKGROUND SMALLFONT box_entry

    toplevel .open_menu

    wm geometry .open_menu $open_menu_geometry

    wm title .open_menu Open

    .open_menu configure -background $BACKGROUND

    # force the user to interact with this box

    # grab set .open_menu 

    # directory listing and scrollbar

    frame .open_menu.dirstuff

    frame .open_menu.cur_dir

    label .open_menu.cur_dir.l -fg $FOREGROUND -background $BACKGROUND -font $SMALLFONT -text "Dir: "

    entry .open_menu.cur_dir.e -relief sunken -bd 2 -textvariable box_entry -foreground $FOREGROUND -background $BACKGROUND -font $SMALLFONT

    .open_menu.cur_dir.e icursor end

    bind .open_menu.cur_dir.e <Return> {

	set file_to_open $box_entry

	if [file isdirectory $file_to_open] {

	    cd $file_to_open

	    set current_directory [pwd]

	    clear_directory_box

	    puts stdout "Changing to  $current_directory"

	    fill_in_directory_box $current_directory $open_menu_pattern

	} elseif [file exists $file_to_open] {

	    puts stdout "Opening file $file_to_open"

	    my_open $file_to_open

	    destroy .open_menu

	} else {

	    puts stdout "Cannot acccess that file"

	}

    }

    pack .open_menu.cur_dir.l .open_menu.cur_dir.e -side left

    scrollbar .open_menu.dirstuff.yscroll -command ".open_menu.dirstuff.directory yview" -background $BACKGROUND

    listbox .open_menu.dirstuff.directory -yscrollcommand ".open_menu.dirstuff.yscroll set" -width 22 -height 11 -relief raised -font $SMALLFONT -background $BACKGROUND -foreground $FOREGROUND

    fill_in_directory_box $current_directory $open_menu_pattern

    bind .open_menu.dirstuff.directory <Double-Button-1> {

	set file_to_open [selection get]

#        puts stdout "Bound button"	

	if [file isdirectory $file_to_open] {

	    cd $file_to_open

	    set current_directory [pwd]

	    clear_directory_box

#	    puts stdout "Changing to  $current_directory"

	    fill_in_directory_box $current_directory $open_menu_pattern

	} elseif [file exists $file_to_open] {

#	    puts stdout "Opening file $file_to_open"

	    my_open $file_to_open

	    destroy .open_menu.dirstuff.directory

	    destroy .open_menu

	} else {

	    puts stdout "Cannot access that file"

	}

    }

    # pattern for listings to match

    frame .open_menu.pattern_match -background $BACKGROUND 

    label .open_menu.pattern_match.label -text "Match files of type:" -font $SMALLFONT -background $BACKGROUND -fg $FOREGROUND

    entry .open_menu.pattern_match.entry -width 5 -relief sunken -bd 2 -textvariable open_menu_pattern -font $SMALLFONT -background $BACKGROUND -fg $FOREGROUND

    # refresh the directory listing after user presses return