Init from working directory of svn repository.
#!/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