#!/usr/sww/bin/wish -f

#

# user interface code (tcl visuals) for OCR

# started 9/95, Archie Russell 

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 100

set display_height 700

# save a little room for scrollbars, etc.

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

# 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"

# 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

    init_menu_bar

    frame .main_window.button_bar -width $button_bar_width -height $button_bar_height -relief ridge -bd 5

    init_button_bar

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

    init_display

# 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 .main_window.button_bar .main_window.display -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?

    menubutton .main_window.menu_bar.file -text "File " -underline 0 -menu .main_window.menu_bar.file.menu -borderwidth 2

    init_file_menu

    menubutton  .main_window.menu_bar.edit -text "Edit " -underline 0 -menu .main_window.menu_bar.edit.menu  -borderwidth 2

    init_edit_menu

    menubutton  .main_window.menu_bar.options -text "Options " -underline 0 -menu .main_window.menu_bar.options.menu  -borderwidth 2

    init_options_menu

    pack .main_window.menu_bar.file .main_window.menu_bar.edit .main_window.menu_bar.options -side left -padx 1m -pady 1m -fill x

}

proc init_file_menu { } {

# this creates the menu associated with the file menubutton

    menu .main_window.menu_bar.file.menu

# 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 popup_close_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 "Save" -command default_save

    .main_window.menu_bar.file.menu add command -label "Save As..." -command default_save

    .main_window.menu_bar.file.menu add separator

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

}

proc init_edit_menu { } {

    global dummy

    menu .main_window.menu_bar.edit.menu

    .main_window.menu_bar.edit.menu add radiobutton -label "Nothing" -variable dummy -value 0

    .main_window.menu_bar.edit.menu add radiobutton -label "Yet" -variable dummy -value 1

    .main_window.menu_bar.edit.menu add radiobutton -label "Here" -variable dummy -value 2

}

set word_certainty_value normal

set screen_view_style facing_page

proc init_options_menu { } {

    global dummy word_certainty_value screen_view_style

    menu .main_window.menu_bar.options.menu

    .main_window.menu_bar.options.menu add cascade -label "Word Certainty" -menu .main_window.menu_bar.options.menu.word_certainty

    menu .main_window.menu_bar.options.menu.word_certainty

    .main_window.menu_bar.options.menu.word_certainty add radiobutton -label "Stringent" -variable word_certainty_value -value stringent

    .main_window.menu_bar.options.menu.word_certainty add radiobutton -label "Normal" -variable word_certainty_value -value normal

    .main_window.menu_bar.options.menu.word_certainty add radiobutton -label "Lenient" -variable word_certainty_value -value lenient

    .main_window.menu_bar.options.menu add cascade -label "Screen View" -menu .main_window.menu_bar.options.menu.screen_view

    menu .main_window.menu_bar.options.menu.screen_view

    .main_window.menu_bar.options.menu.screen_view add radiobutton -label "facing page" -variable screen_view_style -value facing_page

    .main_window.menu_bar.options.menu.screen_view add radiobutton -label "interleave lines" -variable screen_view_style -value interleave_lines

    .main_window.menu_bar.options.menu.screen_view add radiobutton -label "translation only" -variable screen_view_style -value translation_only

}

proc init_button_bar { } {

}

proc init_display { } {

    global display_height canvas_width

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

# two scrollbars

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

    scrollbar .main_window.display.yscroller -command ".main_window.display.work_space yview" 

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

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

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

    initialize_bindings

    test_canvas

}

set x_init 0

set y_init 0

set x_final 0

set y_final 0

set mouse_mode NONE

set started_region 0

set region_count 0

proc initialize_bindings { } {

    # facilitates the grabbing of a rectangle of the window

    # using mouse button 1

    # and apparently a lot of other junk!

    global region_data regions next_button_data next_buttons kill_button_data kill_buttons arrow_data arrows mouse_mode current_object

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

# 	if [expr ! [string compare $mouse_mode NONE]] {

# 	    set current_object [find withtag current]

# 	    if [expr ($current_object == "") || ((expr ! [lsearch $next_buttons $current_object]) && (expr ! [lsearch $kill_buttons $current_object]))] {

# 		set mouse_mode making_region

# 		# start creating the 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]

# 		set region_data($region_id,x_init) $x_init

# 		set region_data($region_id,y_init) $y_init

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

# 		lappend regions $region_id

# 	    } elseif {[lsearch $next_buttons $current_object] != -1} {

# 		set mouse_mode making_arrow

# 		grab set .main_window.display

# 		set arrow_id [.main_window.display.work_space create line 0 0 1 1]

# 		set arrow_data($arrow_id,x_init) $next_button_data($current_object,x_center)

# 		set arrow_data($arrow_id,y_init) $next_button_data($current_object,y_center)

# 		set arrow_data($arrow_id,start_region) $next_button_data($current_object,region_id)

# 		.main_window.display.work_space coords $arrow_id $arrow_data($arrow_id,x_init) $arrow_data($arrow_id,y_init) $arrow_data($arrow_id,x_init) $arrow_data($arrow_id,y_init)

# 		.main_window.display.work_space itemconfigure $arrow_id -arrow last -arrowshape {6.0m 8.0m 1.5m} -fill blue -tags arrow$arrow_id

# 		lappend arrows $arrow_id

# 	    } elseif {[lsearch $kill_buttons $current_object] != -1} {

# 		set mouse_mode killing_region 

# 	    } elseif {[search $prev_buttons $current_object] != -1} {

# 		set moude_mode moving_arrow

# 	    } else {

# 		puts stdout unknown-mode

# 	    }

# 	} else {

# 	    puts stdout "strange: looks like you are in some unknown state. Sorry"

#      }

#    }

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

	if [expr ! [string compare $mouse_mode making_region]] {

	    set region_id $current_object

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

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

	    set x_init $region_data($region_id,x_init)

	    set y_init $region_data($region_id,y_init)

	    .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) NONE

	    make_region_buttons $region_id	    

	    grab release .main_window.display

	    set mouse_mode NONE

	    set current_object NONE

	}

    }

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

	if [expr ! [string compare $mouse_mode making_region]]

	{

	    set region_id $current_object

	    set x_init $region_data($region_id,x_init)

	    set y_init $region_data($region_id,y_init)

	    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"

}

proc test_canvas { } {

# just display some junk on the canvas 

   .main_window.display.work_space create text 400 200 -text "Document and text will  be displayed here" -font *-times-*-*-*--24-*-*-*-*-*-*-* -fill black

    .main_window.display.work_space create text 400 250 -text "Can be displayed in multiple colors etc." -font *-times-*-r-normal--24-*-*-*-*-*-*-* -fill red

    .main_window.display.work_space create text 400 300 -text "Can grab rectangles of stuff here." -font *-times-*-r-normal--24-*-*-*-*-*-*-* -fill green

    .main_window.display.work_space create text 400 350 -text "other things semi-working: quit and open (under file)" -font *-times-*-*-*--24-*-*-*-*-*-*-* -fill blue

   .main_window.display.work_space create text 200 200 -font *-times-*-*-*--10-*-*-*-*-*-*-* -fill black -text "If I hit return

Will it make any difference

return

return"

}

set open_menu_geometry 600x300+300+400

set current_directory [pwd]

set open_menu_pattern *

proc popup_open_menu { } {

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

# bug: cannot exit menu without selecting a file

    global open_menu_geometry open_menu_pattern current_directory

    toplevel .open_menu

    wm geometry .open_menu $open_menu_geometry

    wm title .open_menu Open

    # force the user to interact with this box

    grab set .open_menu 

    # directory listing and scrollbar

    frame .open_menu.dirstuff

    scrollbar .open_menu.dirstuff.yscroll -command ".open_menu.dirstuff.directory yview"

    listbox .open_menu.dirstuff.directory -yscrollcommand ".open_menu.dirstuff.yscroll set" -geometry 25x12 -relief raised

    fill_in_directory_box $current_directory $open_menu_pattern

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

	set file_to_open [selection get]

	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

	} else {

	    puts stdout "Opening file $file_to_open"

	    destroy .open_menu

	}

    }

    # pattern for listings to match

    frame .open_menu.pattern_match

    label .open_menu.pattern_match.label -text "Match files of type:"

    entry .open_menu.pattern_match.entry -width 5 -relief sunken -bd 2 -textvariable open_menu_pattern

    # refresh the directory listing after user presses return

    bind .open_menu.pattern_match.entry <Return> {

	set current_directory [pwd]

	clear_directory_box

	fill_in_directory_box $current_directory $open_menu_pattern

    }

    pack .open_menu.pattern_match.label .open_menu.pattern_match.entry -side left

    pack .open_menu.dirstuff.directory .open_menu.dirstuff.yscroll -side left -fill y 

    pack .open_menu.pattern_match .open_menu.dirstuff -side top

    focus .open_menu.pattern_match.entry

}

proc clear_directory_box { } {

    	.open_menu.dirstuff.directory delete 0 end

}

proc fill_in_directory_box { dirname {pattern *} } {

    foreach i [exec ls -aF $dirname] {

	if [file isdirectory $i] {

	    .open_menu.dirstuff.directory insert end $i

	} elseif [string match $pattern $i] {

	    .open_menu.dirstuff.directory insert end $i

	}

    }

}

set quit_dialog_geometry 300x150+500+500

proc popup_quit_dialog_box { } {

    global quit_dialog_geometry 

    toplevel .quit_dialog

    wm geometry .quit_dialog $quit_dialog_geometry

    wm title .quit_dialog Quit

    grab set .quit_dialog

   message .quit_dialog.msg -text "You are about to quit OCR-orama.  All changes you have made will be lost."

    frame .quit_dialog.buttons

    button .quit_dialog.buttons.ok -text OK -command quit_ok

    button .quit_dialog.buttons.cancel -text Cancel -command quit_cancel

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

    pack .quit_dialog.msg .quit_dialog.buttons -side top -fill x

}

proc quit_ok { } {

    destroy .main_window

    destroy .quit_dialog

}

proc quit_cancel { } {

    global command_not_in_progress

    set command_not_in_progress 1

    destroy .quit_dialog

}

init_user_interface