|
1 #!/usr/sww/bin/wish -f |
|
2 # |
|
3 # user interface code (tcl visuals) for OCR |
|
4 # started 9/95, Archie Russell |
|
5 |
|
6 |
|
7 set main_window_width 800 |
|
8 set main_window_height 800 |
|
9 set dummy 0 |
|
10 # I'd like to be able to use the above parameters in here, |
|
11 # but I think tcl might get a little angry if I try |
|
12 # the size of the window, and the position of its upper left |
|
13 set main_window_geometry 800x800+200+100 |
|
14 |
|
15 set menu_bar_width $main_window_width |
|
16 set menu_bar_height 50 |
|
17 set button_bar_width $main_window_width |
|
18 set button_bar_height 100 |
|
19 set display_height 700 |
|
20 # save a little room for scrollbars, etc. |
|
21 |
|
22 set canvas_width [expr $main_window_width - 30] |
|
23 proc init_user_interface {} { |
|
24 |
|
25 # tcl requires declaration of global variables used in a fxn |
|
26 |
|
27 global main_window_geometry main_window_width main_window_height menu_bar_width menu_bar_height button_bar_width button_bar_height display_height |
|
28 |
|
29 # toplevel windows are at the same level as 'xterms' |
|
30 toplevel .main_window |
|
31 |
|
32 # $ sign means 'get the value' (otherwise uses the string) |
|
33 wm geometry .main_window $main_window_geometry |
|
34 wm title .main_window "OCR user interface" |
|
35 |
|
36 # frames are subwindows that are there mostly to 'hold' other windows |
|
37 frame .main_window.menu_bar -width $menu_bar_width -height $menu_bar_height -relief raised -bd 2 |
|
38 init_menu_bar |
|
39 |
|
40 frame .main_window.button_bar -width $button_bar_width -height $button_bar_height -relief ridge -bd 5 |
|
41 init_button_bar |
|
42 |
|
43 frame .main_window.display -width $main_window_width -height $display_height -relief ridge -bd 5 |
|
44 init_display |
|
45 |
|
46 # pack puts things together: this will put the menu_bar window just above the button_bar_window above the display |
|
47 |
|
48 pack .main_window.menu_bar .main_window.button_bar .main_window.display -side top -anchor w |
|
49 focus .main_window |
|
50 } |
|
51 |
|
52 proc init_menu_bar { } { |
|
53 # this command initializes the main menu bar (stuff like file, etc) |
|
54 # shortcuts not working! why? |
|
55 |
|
56 menubutton .main_window.menu_bar.file -text "File " -underline 0 -menu .main_window.menu_bar.file.menu -borderwidth 2 |
|
57 init_file_menu |
|
58 |
|
59 menubutton .main_window.menu_bar.edit -text "Edit " -underline 0 -menu .main_window.menu_bar.edit.menu -borderwidth 2 |
|
60 init_edit_menu |
|
61 |
|
62 menubutton .main_window.menu_bar.options -text "Options " -underline 0 -menu .main_window.menu_bar.options.menu -borderwidth 2 |
|
63 init_options_menu |
|
64 |
|
65 pack .main_window.menu_bar.file .main_window.menu_bar.edit .main_window.menu_bar.options -side left -padx 1m -pady 1m -fill x |
|
66 |
|
67 } |
|
68 |
|
69 proc init_file_menu { } { |
|
70 # this creates the menu associated with the file menubutton |
|
71 menu .main_window.menu_bar.file.menu |
|
72 # and these initialize the entries in the menu (open is linked to the command popup_open_menu) |
|
73 .main_window.menu_bar.file.menu add command -label "Open..." -command popup_open_menu |
|
74 .main_window.menu_bar.file.menu add command -label "Close" -command popup_close_menu |
|
75 # a separator is just a horizontal line for show |
|
76 .main_window.menu_bar.file.menu add separator |
|
77 .main_window.menu_bar.file.menu add command -label "Save" -command default_save |
|
78 .main_window.menu_bar.file.menu add command -label "Save As..." -command default_save |
|
79 .main_window.menu_bar.file.menu add separator |
|
80 .main_window.menu_bar.file.menu add command -label "Quit" -command popup_quit_dialog_box |
|
81 } |
|
82 |
|
83 proc init_edit_menu { } { |
|
84 global dummy |
|
85 menu .main_window.menu_bar.edit.menu |
|
86 .main_window.menu_bar.edit.menu add radiobutton -label "Nothing" -variable dummy -value 0 |
|
87 .main_window.menu_bar.edit.menu add radiobutton -label "Yet" -variable dummy -value 1 |
|
88 .main_window.menu_bar.edit.menu add radiobutton -label "Here" -variable dummy -value 2 |
|
89 } |
|
90 |
|
91 set word_certainty_value normal |
|
92 set screen_view_style facing_page |
|
93 proc init_options_menu { } { |
|
94 global dummy word_certainty_value screen_view_style |
|
95 menu .main_window.menu_bar.options.menu |
|
96 .main_window.menu_bar.options.menu add cascade -label "Word Certainty" -menu .main_window.menu_bar.options.menu.word_certainty |
|
97 |
|
98 menu .main_window.menu_bar.options.menu.word_certainty |
|
99 .main_window.menu_bar.options.menu.word_certainty add radiobutton -label "Stringent" -variable word_certainty_value -value stringent |
|
100 .main_window.menu_bar.options.menu.word_certainty add radiobutton -label "Normal" -variable word_certainty_value -value normal |
|
101 .main_window.menu_bar.options.menu.word_certainty add radiobutton -label "Lenient" -variable word_certainty_value -value lenient |
|
102 |
|
103 .main_window.menu_bar.options.menu add cascade -label "Screen View" -menu .main_window.menu_bar.options.menu.screen_view |
|
104 menu .main_window.menu_bar.options.menu.screen_view |
|
105 .main_window.menu_bar.options.menu.screen_view add radiobutton -label "facing page" -variable screen_view_style -value facing_page |
|
106 .main_window.menu_bar.options.menu.screen_view add radiobutton -label "interleave lines" -variable screen_view_style -value interleave_lines |
|
107 .main_window.menu_bar.options.menu.screen_view add radiobutton -label "translation only" -variable screen_view_style -value translation_only |
|
108 |
|
109 |
|
110 } |
|
111 |
|
112 proc init_button_bar { } { |
|
113 } |
|
114 |
|
115 proc init_display { } { |
|
116 global display_height canvas_width |
|
117 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} |
|
118 # two scrollbars |
|
119 scrollbar .main_window.display.xscroller -command ".main_window.display.work_space xview" -orient horizontal |
|
120 scrollbar .main_window.display.yscroller -command ".main_window.display.work_space yview" |
|
121 |
|
122 pack .main_window.display.xscroller -side bottom -fill x |
|
123 pack .main_window.display.work_space .main_window.display.yscroller -side left -fill y |
|
124 .main_window.display.work_space configure -scrollregion { -5000 -5000 5000 5000 } |
|
125 initialize_bindings |
|
126 test_canvas |
|
127 } |
|
128 |
|
129 set x_init 0 |
|
130 set y_init 0 |
|
131 set x_final 0 |
|
132 set y_final 0 |
|
133 set mouse_mode NONE |
|
134 set started_region 0 |
|
135 set region_count 0 |
|
136 proc initialize_bindings { } { |
|
137 # facilitates the grabbing of a rectangle of the window |
|
138 # using mouse button 1 |
|
139 # and apparently a lot of other junk! |
|
140 |
|
141 global region_data regions next_button_data next_buttons kill_button_data kill_buttons arrow_data arrows mouse_mode current_object |
|
142 |
|
143 # bind .main_window.display.work_space <ButtonPress-1> { |
|
144 # if [expr ! [string compare $mouse_mode NONE]] { |
|
145 # set current_object [find withtag current] |
|
146 # if [expr ($current_object == "") || ((expr ! [lsearch $next_buttons $current_object]) && (expr ! [lsearch $kill_buttons $current_object]))] { |
|
147 # set mouse_mode making_region |
|
148 # # start creating the region |
|
149 # grab set .main_window.display |
|
150 # set x_init [.main_window.display.work_space canvasx %x] |
|
151 # set y_init [.main_window.display.work_space canvasy %y] |
|
152 # set region_id [.main_window.display.work_space create rectangle $x_init $y_init $x_init $y_init -outline black -width 3] |
|
153 # set region_data($region_id,x_init) $x_init |
|
154 # set region_data($region_id,y_init) $y_init |
|
155 # .main_window.display.work_space itemconfigure $region_id -tags region$region_id |
|
156 # lappend regions $region_id |
|
157 |
|
158 # } elseif {[lsearch $next_buttons $current_object] != -1} { |
|
159 # set mouse_mode making_arrow |
|
160 # grab set .main_window.display |
|
161 # set arrow_id [.main_window.display.work_space create line 0 0 1 1] |
|
162 # set arrow_data($arrow_id,x_init) $next_button_data($current_object,x_center) |
|
163 # set arrow_data($arrow_id,y_init) $next_button_data($current_object,y_center) |
|
164 # set arrow_data($arrow_id,start_region) $next_button_data($current_object,region_id) |
|
165 # .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) |
|
166 # .main_window.display.work_space itemconfigure $arrow_id -arrow last -arrowshape {6.0m 8.0m 1.5m} -fill blue -tags arrow$arrow_id |
|
167 |
|
168 # lappend arrows $arrow_id |
|
169 # } elseif {[lsearch $kill_buttons $current_object] != -1} { |
|
170 # set mouse_mode killing_region |
|
171 # } elseif {[search $prev_buttons $current_object] != -1} { |
|
172 # set moude_mode moving_arrow |
|
173 # } else { |
|
174 # puts stdout unknown-mode |
|
175 # } |
|
176 # } else { |
|
177 # puts stdout "strange: looks like you are in some unknown state. Sorry" |
|
178 # } |
|
179 # } |
|
180 bind .main_window.display.work_space <ButtonRelease-1> { |
|
181 if [expr ! [string compare $mouse_mode making_region]] { |
|
182 set region_id $current_object |
|
183 set x_final [.main_window.display.work_space canvasx %x] |
|
184 set y_final [.main_window.display.work_space canvasy %y] |
|
185 set x_init $region_data($region_id,x_init) |
|
186 set y_init $region_data($region_id,y_init) |
|
187 .main_window.display.work_space coords region$region_id $x_init $y_init $x_final $y_final |
|
188 # if finishing a rectangle, initialize its stuff in the array |
|
189 if {$x_init <= $x_final} { |
|
190 set region_data($region_id,x_init) $x_init |
|
191 set region_data($region_id,x_final) $x_final |
|
192 } else { |
|
193 set region_data($region_id,x_final) $x_init |
|
194 set region_data($region_id,x_init) $x_final |
|
195 } |
|
196 if {$y_init <= $y_final} { |
|
197 set region_data($region_id,y_init) $y_init |
|
198 set region_data($region_id,y_final) $y_final |
|
199 } else { |
|
200 set region_data($region_id,y_init) $y_final |
|
201 set region_data($region_id,y_final) $y_init |
|
202 } |
|
203 |
|
204 set region_data($region_id,next_region_id) NONE |
|
205 |
|
206 make_region_buttons $region_id |
|
207 grab release .main_window.display |
|
208 set mouse_mode NONE |
|
209 set current_object NONE |
|
210 } |
|
211 } |
|
212 |
|
213 |
|
214 |
|
215 |
|
216 |
|
217 bind .main_window.display.work_space <B1-Motion> { |
|
218 if [expr ! [string compare $mouse_mode making_region]] |
|
219 { |
|
220 set region_id $current_object |
|
221 set x_init $region_data($region_id,x_init) |
|
222 set y_init $region_data($region_id,y_init) |
|
223 set curx [.main_window.display.work_space canvasx %x] |
|
224 set cury [.main_window.display.work_space canvasy %y] |
|
225 .main_window.display.work_space coords region$region_id $x_init $y_init $curx $cury |
|
226 } |
|
227 |
|
228 } |
|
229 bind .main_window.display <Leave> { |
|
230 # on leaving the display, release control of the mouse etc. |
|
231 # maybe make it scroll instead? |
|
232 if $started_region { |
|
233 grab release .main_window.display |
|
234 set started_region 0 |
|
235 .main_window.display.work_space coords region$region_id 0 0 0 0 |
|
236 } |
|
237 } |
|
238 } |
|
239 |
|
240 set arrow_in_progress 0 |
|
241 proc make_region_buttons { reg_id } { |
|
242 global region_data kill_button_data next_button_data arrow_in_progress current_arrow |
|
243 |
|
244 set x_init $region_data($reg_id,x_init) |
|
245 set y_init $region_data($reg_id,y_init) |
|
246 |
|
247 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"] |
|
248 set next_button_data($next_num,reg_id) $reg_id |
|
249 .main_window.display.work_space bind next_button$reg_id <Double-2> { |
|
250 set reg_id $next_button_data([.main_window.display.work_space find withtag current],reg_id) |
|
251 if { $arrow_in_progress } { |
|
252 finish_arrow $reg_id |
|
253 } else { |
|
254 set canvas_x [.main_window.display.work_space canvasx %x] |
|
255 set canvas_y [.main_window.display.work_space canvasy %y] |
|
256 start_arrow $reg_id $canvas_x $canvas_y |
|
257 puts stdout "Starting an arrow at $canvas_x $canvas_y" |
|
258 } |
|
259 } |
|
260 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"] |
|
261 |
|
262 set kill_button_data($kill_num,reg_id) $reg_id |
|
263 |
|
264 .main_window.display.work_space bind kill_button$reg_id <Double-2> { |
|
265 set reg_id $kill_button_data([.main_window.display.work_space find withtag current],reg_id) |
|
266 destroy_region $reg_id .main_window.display.work_space |
|
267 } |
|
268 } |
|
269 |
|
270 proc start_arrow { reg_id x_start y_start } { |
|
271 global arrow_in_progress next_button_data region_data current_arrow |
|
272 set path_name .main_window.display.work_space |
|
273 # start an arrow in the middle of the little red button |
|
274 |
|
275 |
|
276 |
|
277 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] |
|
278 |
|
279 set region_data($reg_id,arrow) $arrow |
|
280 set arrow_in_progress 1 |
|
281 set current_arrow $arrow |
|
282 } |
|
283 |
|
284 proc destroy_region { reg_id path_name } { |
|
285 $path_name delete region$reg_id |
|
286 puts stdout "Destroying $reg_id" |
|
287 } |
|
288 |
|
289 proc test_canvas { } { |
|
290 # just display some junk on the canvas |
|
291 .main_window.display.work_space create text 400 200 -text "Document and text will be displayed here" -font *-times-*-*-*--24-*-*-*-*-*-*-* -fill black |
|
292 .main_window.display.work_space create text 400 250 -text "Can be displayed in multiple colors etc." -font *-times-*-r-normal--24-*-*-*-*-*-*-* -fill red |
|
293 .main_window.display.work_space create text 400 300 -text "Can grab rectangles of stuff here." -font *-times-*-r-normal--24-*-*-*-*-*-*-* -fill green |
|
294 .main_window.display.work_space create text 400 350 -text "other things semi-working: quit and open (under file)" -font *-times-*-*-*--24-*-*-*-*-*-*-* -fill blue |
|
295 .main_window.display.work_space create text 200 200 -font *-times-*-*-*--10-*-*-*-*-*-*-* -fill black -text "If I hit return |
|
296 Will it make any difference |
|
297 return |
|
298 return" |
|
299 } |
|
300 |
|
301 set open_menu_geometry 600x300+300+400 |
|
302 set current_directory [pwd] |
|
303 set open_menu_pattern * |
|
304 |
|
305 proc popup_open_menu { } { |
|
306 # this procedure pops up an interactive box which can be used to open files |
|
307 # bug: cannot exit menu without selecting a file |
|
308 global open_menu_geometry open_menu_pattern current_directory |
|
309 |
|
310 toplevel .open_menu |
|
311 wm geometry .open_menu $open_menu_geometry |
|
312 wm title .open_menu Open |
|
313 |
|
314 # force the user to interact with this box |
|
315 grab set .open_menu |
|
316 |
|
317 # directory listing and scrollbar |
|
318 frame .open_menu.dirstuff |
|
319 scrollbar .open_menu.dirstuff.yscroll -command ".open_menu.dirstuff.directory yview" |
|
320 listbox .open_menu.dirstuff.directory -yscrollcommand ".open_menu.dirstuff.yscroll set" -geometry 25x12 -relief raised |
|
321 fill_in_directory_box $current_directory $open_menu_pattern |
|
322 |
|
323 bind .open_menu.dirstuff.directory <Double-Button-1> { |
|
324 set file_to_open [selection get] |
|
325 if [file isdirectory $file_to_open] { |
|
326 cd $file_to_open |
|
327 set current_directory [pwd] |
|
328 clear_directory_box |
|
329 puts stdout "Changing to $current_directory" |
|
330 fill_in_directory_box $current_directory $open_menu_pattern |
|
331 } else { |
|
332 puts stdout "Opening file $file_to_open" |
|
333 destroy .open_menu |
|
334 } |
|
335 } |
|
336 # pattern for listings to match |
|
337 frame .open_menu.pattern_match |
|
338 label .open_menu.pattern_match.label -text "Match files of type:" |
|
339 entry .open_menu.pattern_match.entry -width 5 -relief sunken -bd 2 -textvariable open_menu_pattern |
|
340 # refresh the directory listing after user presses return |
|
341 bind .open_menu.pattern_match.entry <Return> { |
|
342 set current_directory [pwd] |
|
343 clear_directory_box |
|
344 fill_in_directory_box $current_directory $open_menu_pattern |
|
345 } |
|
346 |
|
347 pack .open_menu.pattern_match.label .open_menu.pattern_match.entry -side left |
|
348 pack .open_menu.dirstuff.directory .open_menu.dirstuff.yscroll -side left -fill y |
|
349 pack .open_menu.pattern_match .open_menu.dirstuff -side top |
|
350 focus .open_menu.pattern_match.entry |
|
351 } |
|
352 |
|
353 |
|
354 |
|
355 |
|
356 |
|
357 |
|
358 |
|
359 proc clear_directory_box { } { |
|
360 .open_menu.dirstuff.directory delete 0 end |
|
361 } |
|
362 |
|
363 proc fill_in_directory_box { dirname {pattern *} } { |
|
364 foreach i [exec ls -aF $dirname] { |
|
365 if [file isdirectory $i] { |
|
366 .open_menu.dirstuff.directory insert end $i |
|
367 } elseif [string match $pattern $i] { |
|
368 .open_menu.dirstuff.directory insert end $i |
|
369 } |
|
370 } |
|
371 } |
|
372 |
|
373 set quit_dialog_geometry 300x150+500+500 |
|
374 proc popup_quit_dialog_box { } { |
|
375 global quit_dialog_geometry |
|
376 |
|
377 toplevel .quit_dialog |
|
378 wm geometry .quit_dialog $quit_dialog_geometry |
|
379 wm title .quit_dialog Quit |
|
380 grab set .quit_dialog |
|
381 |
|
382 message .quit_dialog.msg -text "You are about to quit OCR-orama. All changes you have made will be lost." |
|
383 frame .quit_dialog.buttons |
|
384 button .quit_dialog.buttons.ok -text OK -command quit_ok |
|
385 button .quit_dialog.buttons.cancel -text Cancel -command quit_cancel |
|
386 pack .quit_dialog.buttons.ok .quit_dialog.buttons.cancel -side left -expand 1 -fill x |
|
387 pack .quit_dialog.msg .quit_dialog.buttons -side top -fill x |
|
388 |
|
389 |
|
390 } |
|
391 |
|
392 proc quit_ok { } { |
|
393 destroy .main_window |
|
394 destroy .quit_dialog |
|
395 } |
|
396 |
|
397 proc quit_cancel { } { |
|
398 global command_not_in_progress |
|
399 set command_not_in_progress 1 |
|
400 destroy .quit_dialog |
|
401 } |
|
402 |
|
403 init_user_interface |