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