--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/reference/ocr-simple/ocr-ui.tcl Thu May 18 23:12:51 2006 +0200
@@ -0,0 +1,404 @@
+#!/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" -cursor {crosshair black gray}
+### -scrollincrement 30
+# 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