1 # ui-tools.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1998-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 #
31 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/applications/mbv2/ui-tools.tcl,v 1.17 2002/02/03 04:21:59 lim Exp $
32
33
34 import ToolBar Observer MbIcons Dialog/MBv2Import TipManager
35
36 Class MBv2Tool
37
38
39 Class MBv2DrawTextTool -superclass MBv2Tool
40 Class MBv2ShapeTool -superclass MBv2Tool
41 Class MBv2ArrowTool -superclass MBv2ShapeTool
42 Class MBv2RectTool -superclass MBv2ShapeTool
43 Class MBv2OvalTool -superclass MBv2ShapeTool
44 Class MBv2ImportTool -superclass MBv2Tool
45 Class MBv2SelectTool -superclass MBv2Tool
46 #Class MBv2MoveTool -superclass MBv2SelectTool
47 #Class MBv2CopyTool -superclass MBv2SelectTool
48 Class MBv2UndoTool -superclass MBv2Tool
49 Class MBv2RedoTool -superclass MBv2Tool
50
51
52 MBv2Tool public init { path toolbar image tip {button 0} } {
53 $self next
54 $self set path_ $path
55 $self set toolbar_ $toolbar
56 if $button {
57 button $path -image $image -command \
58 "$toolbar activate [$self info class] 1"
59 } else {
60 radiobutton $path -image $image -indicatoron false \
61 -value [$self info class] \
62 -variable [$toolbar tkvarname curtool_] \
63 -command "$toolbar activate [$self info class]"
64 }
65 TipManager tip $path $tip
66 }
67
68
69 MBv2Tool public destroy { } {
70 $self instvar path_
71 destroy $path_
72 $self next
73 }
74
75
76 MBv2Tool public sender { s } {
77 $self set sender_ $s
78 }
79
80
81 MBv2Tool public properties { s } {
82 $self set props_ $s
83 }
84
85
86 MBv2Tool public invoke { } {
87 $self instvar path_
88 $path_ invoke
89 }
90
91
92 MBv2Tool public activate { canv } {
93 }
94
95
96 MBv2Tool public deactivate { } {
97 }
98
99
100 MBv2DrawTextTool public init { path toolbar } {
101 $self next $path $toolbar MbIcons(draw) "Freehand\n+ Text"
102
103 bind DrawTextTags <ButtonPress-1> "$self button_down %x %y"
104 bind DrawTextTags <B1-Motion> "$self button_move %x %y"
105 bind DrawTextTags <ButtonRelease-1> "$self button_release %x %y"
106 bind DrawTextTags <Escape> "$self escape"
107
108 bind DrawTextTags <KeyPress-Shift_L> "$self shift_press"
109 bind DrawTextTags <KeyPress-Shift_R> "$self shift_press"
110 }
111
112
113 MBv2DrawTextTool public activate { canv } {
114 $self instvar canv_ shift_
115 if [info exists shift_] {
116 # we're being reactivated
117 unset shift_
118 }
119 set canv_ $canv
120 $canv_ add_bindtag DrawTextTags
121
122 set path [$canv_ path]
123 $path bind current_text <Any-Key> "$self keypress %A; break"
124 $path bind current_text <Return> "$self keypress \\n"
125
126 # explicitly catch <Tab> so it doesn't go to the default Tk <Tab>
127 # handler
128 $path bind current_text <Tab> "$self keypress \\t; break"
129 $path bind current_text <Left> "$self keyleft; break"
130 $path bind current_text <Right> "$self keyright; break"
131 $path bind current_text <Up> "$self keyup; break"
132 $path bind current_text <Down> "$self keydown; break"
133
134 $path bind local <Enter> "$self enter_local"
135 $path bind local <Leave> "$self leave_local"
136
137 $path configure -cursor pencil
138 }
139
140
141 MBv2DrawTextTool public deactivate { } {
142 $self instvar canv_ shift_
143 if [info exists shift_] {
144 $self instvar toolbar_
145 [$toolbar_ tool MBv2SelectTool] deactivate
146 }
147
148 $self finish
149 $canv_ remove_bindtag DrawTextTags
150
151 $self leave_local
152 set path [$canv_ path]
153 $path bind local <Enter> ""
154 $path bind local <Leave> ""
155
156 $path configure -cursor {}
157 }
158
159
160 MBv2DrawTextTool private shift_press { } {
161 $self instvar canv_ toolbar_ mode_ shift_
162 if { [info exists mode_] } return
163 $self deactivate
164 [$toolbar_ tool MBv2SelectTool] activate $canv_ $self
165 set shift_ 1
166 }
167
168
169 MBv2DrawTextTool private enter_local { } {
170 $self instvar canv_ xterm_cursor_
171
172 set path [$canv_ path]
173 set t [$path find withtag current]
174 if { [$path type $t] != "text" } return
175
176 set xterm_cursor_ 1
177 $path configure -cursor xterm
178 }
179
180
181 MBv2DrawTextTool private leave_local { } {
182 $self instvar xterm_cursor_ canv_
183
184 if [info exists xterm_cursor_] {
185 [$canv_ path] configure -cursor pencil
186 unset xterm_cursor_
187 }
188 }
189
190
191 MBv2DrawTextTool private button_down { x y } {
192 $self instvar x_ y_ mode_ canv_ toolbar_
193 if { [info exists mode_] } {
194 # we are in the middle of a previous command
195 # finish it
196 $self finish
197 }
198
199 set path [$canv_ path]
200 set x_ [$path canvasx $x]
201 set y_ [$path canvasy $y]
202 set mode_ unknown
203 }
204
205
206 MBv2DrawTextTool private button_move { x y } {
207 $self instvar x_ y_ mode_ canv_ start_ end_ sender_ props_
208 if { ![info exists mode_] || $mode_ == "text" } return
209
210 set path [$canv_ path]
211 set x [$path canvasx $x]
212 set y [$path canvasy $y]
213
214 if { $mode_ != "freehand" } {
215 # give some leeway
216 set diff [expr abs($x - $x_) + abs($y - $y_)]
217 if { $diff < 2.0 } return
218 }
219
220 set mode_ freehand
221
222 set end_ [$sender_ create_item line $x_ $y_ $x $y \
223 -width [$props_ width] \
224 -fill [$sender_ sanitize_color [$props_ outline]] \
225 -arrow none]
226 if ![info exists start_] { set start_ $end_ }
227 #$path create line $x_ $y_ $x $y -width 2
228 set x_ $x
229 set y_ $y
230 }
231
232
233 MBv2DrawTextTool private flush_coords { } {
234 $self instvar afterId_ start_ end_ coords_ canv_
235 if [info exists afterId_] { unset afterId_ }
236 if ![info exists coords_] return
237
238 eval [$canv_ path] create line $coords_ -width 2
239 set end_ 0
240 if ![info exists start_] { set start_ $end_ }
241 }
242
243
244 MBv2DrawTextTool private button_release { x y } {
245 $self instvar mode_ canv_ current_text_ sender_ props_
246 if { ![info exists mode_] || $mode_ == "text" } return
247
248 set path [$canv_ path]
249 set x1 [$path canvasx $x]
250 set y1 [$path canvasy $y]
251 if { $mode_ == "unknown" } {
252 # check if we are inside a local text box
253 set t [$path find withtag current]
254 if { [$path type $t] == "text" && \
255 [lsearch [$path gettags $t] local] != -1 } {
256 # we should try to re-edit this text box
257 set cmdid [$sender_ get_cmdid $t]
258 if { $cmdid != {} } {
259 set current_text_(canvitem) $t
260 set current_text_(edit_text) $cmdid
261 $path addtag current_text withtag $t
262 set current_text_(index) [$self text_index $t \
263 [$path canvasx $x] \
264 [$path canvasy $y]]
265 set icursor $current_text_(index)
266 }
267 }
268 if ![info exists current_text_(edit_text)] {
269 set font [$canv_ interpret_font [$props_ font] \
270 [$canv_ get_scale]]
271 set current_text_(canvitem) \
272 [$path create text $x1 $y1 -font $font\
273 -tags {current_text local} \
274 -anchor nw -justify [$props_ justify] \
275 -fill [$sender_ sanitize_color \
276 [$props_ outline]]]
277 set icursor end
278 }
279
280 set mode_ text
281 $path focus current_text
282 $path icursor current_text $icursor
283 $path configure -cursor xterm
284 } else {
285 # we are done with the freehand
286 $self instvar x_ y_
287 if { $x_ != $x1 || $y_ != $y1 } { $self button_move $x $y }
288 $self finish
289 }
290 }
291
292
293 MBv2DrawTextTool private text_index { item x y } {
294 $self instvar canv_
295 set path [$canv_ path]
296 set sr [$path cget -scrollregion]
297 if { $sr != {} } {
298 foreach {sx1 sy1 sx2 sy2} $sr { }
299 set x [expr $x - $sx1]
300 set y [expr $y - $sy1]
301 }
302 set i [$path index $item @${x},${y}]
303 return $i
304 }
305
306
307 MBv2DrawTextTool private keyleft { } {
308 $self instvar current_text_ canv_
309 if { ![info exists current_text_(index)] || $current_text_(index)==0} {
310 return
311 }
312
313 incr current_text_(index) -1
314 [$canv_ path] icursor current_text $current_text_(index)
315 }
316
317
318 MBv2DrawTextTool private keyright { } {
319 $self instvar current_text_ canv_
320 if { ![info exists current_text_(index)] } return
321
322 set path [$canv_ path]
323 set len [string length [$path itemcget $current_text_(canvitem) -text]]
324 if [info exists current_text_(redundant)] { incr len -1 }
325
326 if { $current_text_(index) >= $len } return
327
328 incr current_text_(index)
329 [$canv_ path] icursor current_text $current_text_(index)
330 }
331
332
333 MBv2DrawTextTool private keyup { } {
334 $self instvar current_text_ canv_
335 if { ![info exists current_text_(index)] } return
336
337 set path [$canv_ path]
338 set text [$path itemcget $current_text_(canvitem) -text]
339
340 for { set i [expr $current_text_(index)-1] } { $i >= 0 } {incr i -1} {
341 if { [string index $text $i] == "\n" } break
342 }
343
344 # there was no \n found
345 if { $i < 0 } return
346
347 # find the \n before this one as well
348 set newline $i
349 for { incr i -1 } { $i >= 0 } {incr i -1} {
350 if { [string index $text $i] == "\n" } break
351 }
352
353 set prev_newline $i
354 set prev_numchars [expr $newline - $i - 1]
355 set numchars [expr $current_text_(index) - $newline]
356
357 if { $numchars > $prev_numchars } { set newindex $newline } \
358 else { set newindex [expr $prev_newline + $numchars] }
359
360 set current_text_(index) $newindex
361 [$canv_ path] icursor current_text $current_text_(index)
362 }
363
364
365 MBv2DrawTextTool private keydown { } {
366 $self instvar current_text_ canv_
367 if { ![info exists current_text_(index)] } return
368
369 set path [$canv_ path]
370 set text [$path itemcget $current_text_(canvitem) -text]
371 set len [string length $text]
372 if [info exists current_text_(redundant)] { incr len -1 }
373
374 # find the starting newline on this line
375 for { set i [expr $current_text_(index)-1] } { $i >= 0 } {incr i -1} {
376 if { [string index $text $i] == "\n" } break
377 }
378 set newline $i
379
380 # find the ending newline on this line
381 for { set i $current_text_(index) } { $i < $len } {incr i} {
382 if { [string index $text $i] == "\n" } break
383 }
384
385 # there was no \n found
386 if { $i >= $len } return
387 set next_newline $i
388
389 set numchars [expr $current_text_(index) - $newline]
390 set newindex [expr $next_newline + $numchars]
391 if { $newindex > $len } { set newindex $len }
392
393 set current_text_(index) $newindex
394 [$canv_ path] icursor current_text $current_text_(index)
395 }
396
397
398 # key may consist of multiple characters
399 # specifically if keypress is called from paste_text
400 MBv2DrawTextTool private keypress { key } {
401 if { $key == {} } return
402 set ascii 0
403 # this only checks the first character in $key
404 binary scan $key c ascii
405 if { $ascii < 32 && $key != "\b" && $key != "\t" && $key != "\n" } \
406 return
407
408 $self instvar current_text_ canv_ sender_ props_ x_ y_
409 set path [$canv_ path]
410 if ![info exists current_text_(cmd)] {
411 if [info exists current_text_(edit_text)] {
412 set current_text_(cmd) [$sender_ edit_text_item \
413 $current_text_(edit_text)]
414 } else {
415 # this is the first key stroke
416 if { $key == "\b" } return
417
418 # create a text item
419 $path delete $current_text_(canvitem)
420
421 set current_text_(cmd) [$sender_ create_item text \
422 $x_ $y_ -font [$props_ font] \
423 -justify [$props_ justify] \
424 -fill [$sender_ sanitize_color \
425 [$props_ outline]]]
426 set current_text_(index) 0
427 }
428 set current_text_(canvitem) [$sender_ get_canvas_item \
429 $current_text_(cmd)]
430
431 $path addtag current_text withtag $current_text_(canvitem)
432 $path focus current_text
433 $path icursor current_text $current_text_(index)
434 }
435
436 if { $key == "\b" && $current_text_(index)==0 } return
437
438 # check if we have a redundant character (if so, remove it)
439 if [info exists current_text_(redundant)] {
440 unset current_text_(redundant)
441 set text [$path itemcget $current_text_(canvitem) \
442 -text]
443 $path itemconfigure $current_text_(canvitem) \
444 -text [string range $text 0 \
445 [expr [string length $text] - 2]]
446 }
447
448 # send out the MBv2CmdChar
449 set current_text_(end) [$sender_ insert_chars $current_text_(cmd) \
450 $current_text_(index) $key]
451 if { $key == "\b" } {
452 incr current_text_(index) -1
453 set text [$path itemcget $current_text_(canvitem) \
454 -text]
455 set last [string index $text [expr [string length $text] - 1]]
456 } else {
457 set len [string length $key]
458 incr current_text_(index) $len
459 set last [string index $key [expr $len - 1]]
460 }
461
462 # check if we must add a redundant space character
463 if { $last == "\n" || $last == "\t" } {
464 set current_text_(redundant) 1
465 set text [$path itemcget $current_text_(canvitem) \
466 -text]
467 # use <Tab> as the redundant character coz if you use
468 # <Space>, it shows up in underline or overstrike mode
469 # whereas <Tab> doesn't
470 append text "\t"
471 $path itemconfigure $current_text_(canvitem) -text $text
472 }
473
474 $path icursor current_text $current_text_(index)
475 }
476
477
478 MBv2DrawTextTool public paste_text { x y text } {
479 $self instvar toolbar_ current_text_ canv_ sender_
480 set curtool [$toolbar_ current_tool]
481
482 if { $curtool == $self && [info exists current_text_(canvitem)] } {
483 set bbox [[$canv_ path] bbox $current_text_(canvitem)]
484 if { $bbox != {} } {
485 foreach {bx1 by1 bx2 by2} $bbox { }
486 if { $x >= $bx1 && $x <= $bx2 && $y >= $by1 && \
487 $y <= $by2 } {
488 set paste_in_current_text 1
489 }
490 }
491 }
492
493 if ![info exists paste_in_current_text] {
494 # check if we are inside some other local text box
495 set path [[$toolbar_ canvas] path]
496 set t [$path find withtag current]
497 if { [$path type $t] == "text" && \
498 [lsearch [$path gettags $t] local] != -1 } {
499 # we should try to re-edit this text box
500 set cmdid [$sender_ get_cmdid $t]
501 if { $cmdid != {} } {
502 set idx [$self text_index $t $x $y]
503 set paste_in_other_text [list $cmdid $idx]
504 }
505 }
506 }
507
508
509 if ![info exists paste_in_current_text] {
510 # stop what we were doing earlier
511 set canv [$toolbar_ canvas]
512 if { $curtool!={} && $canv!={} } {
513 $curtool deactivate
514 $curtool activate $canv
515 }
516
517 if [info exists paste_in_other_text] {
518 set cmd [eval [list $toolbar_] insert_text \
519 $paste_in_other_text [list $text] 1]
520 } else {
521 set cmd [$toolbar_ insert_text $x $y $text]
522 }
523
524 $toolbar_ reset_undo $cmd
525 } else {
526 set current_text_(index) [$self text_index \
527 $current_text_(canvitem) $x $y]
528 $self keypress $text
529 }
530 }
531
532
533 MBv2DrawTextTool private escape { } {
534 $self instvar mode_ sender_
535 if ![info exists mode_] return
536 if { $mode_ == "text" } {
537 $self finish
538 } elseif { $mode_ == "freehand" } {
539 set finished [$self finish]
540
541 # escape means we don't really want this object; so delete it
542 if { $finished != {} } {
543 $sender_ delete_item $finished
544 }
545 }
546 }
547
548
549 MBv2DrawTextTool public finish { } {
550 $self instvar mode_ start_ end_ x_ y_ sender_ current_text_ canv_ \
551 toolbar_
552 if ![info exists mode_] return ""
553
554 set finished_cmd ""
555 if { $mode_ == "freehand" } {
556 if { $start_ != $end_ } {
557 # we must group
558 set finished_cmd [$sender_ create_group line \
559 $start_ $end_]
560 $toolbar_ reset_undo $finished_cmd
561 }
562 } elseif { $mode_ == "text" } {
563 if [info exists current_text_(cmd)] {
564
565 # check if we have a redundant character
566 # (if so, remove it)
567 set path [$canv_ path]
568 if [info exists current_text_(redundant)] {
569 unset current_text_(redundant)
570 set text [$path itemcget \
571 $current_text_(canvitem) -text]
572 $path itemconfigure $current_text_(canvitem) \
573 -text [string range $text 0 \
574 [expr [string length $text]-1]]
575 }
576
577 # we must group
578 set finished_cmd [$sender_ create_group text \
579 $current_text_(cmd) \
580 $current_text_(end)]
581 $toolbar_ reset_undo $finished_cmd
582
583 # remove the current_text tag from the item
584 $path dtag $current_text_(canvitem) current_text
585
586 # forget the focus
587 $path focus {}
588 } elseif [info exists current_text_(canvitem)] {
589 if [info exists current_text_(edit_text)] {
590 # remove the current_text tag from the item
591 [$canv_ path] dtag $current_text_(canvitem) \
592 current_text
593 # forget the focus
594 [$canv_ path] focus {}
595 } else {
596 [$canv_ path] delete $current_text_(canvitem)
597 }
598 }
599 }
600
601 foreach var { mode_ start_ end_ x_ y_ } {
602 if [info exists $var] { unset $var }
603 }
604 foreach e [array names current_text_] {
605 unset current_text_($e)
606 }
607
608 $self instvar xterm_cursor_
609 if ![info exists xterm_cursor_] {
610 [$canv_ path] configure -cursor pencil
611 }
612 return $finished_cmd
613 }
614
615
616 MBv2ShapeTool public init { path toolbar icon tip } {
617 $self next $path $toolbar $icon $tip
618
619 set cls [$self info class]
620 bind ${cls}Tags <ButtonPress-1> "$self button_down %x %y"
621 bind ${cls}Tags <B1-Motion> "$self button_move %x %y"
622 bind ${cls}Tags <ButtonRelease-1> "$self button_release %x %y"
623 bind ${cls}Tags <Escape> "$self escape"
624
625 bind ${cls}Tags <KeyPress-Shift_L> "$self shift_press"
626 bind ${cls}Tags <KeyPress-Shift_R> "$self shift_press"
627 }
628
629
630 MBv2ShapeTool public activate { canv } {
631 $self instvar canv_ shift_
632 if [info exists shift_] {
633 # we're being reactivated
634 unset shift_
635 }
636
637 set canv_ $canv
638 $canv_ add_bindtag [$self info class]Tags
639 [$canv_ path] configure -cursor tcross
640 }
641
642
643 MBv2ShapeTool public deactivate { } {
644 $self instvar canv_ shift_
645 if [info exists shift_] {
646 $self instvar toolbar_
647 [$toolbar_ tool MBv2SelectTool] deactivate
648 }
649
650 $self finish
651 $canv_ remove_bindtag [$self info class]Tags
652 [$canv_ path] configure -cursor {}
653 }
654
655
656 MBv2ShapeTool private shift_press { } {
657 $self instvar canv_ toolbar_ shift_ canvitem_
658 if { [info exists canvitem_] } return
659 $self deactivate
660 [$toolbar_ tool MBv2SelectTool] activate $canv_ $self
661 set shift_ 1
662 }
663
664
665 MBv2ShapeTool public button_down { x y } {
666 $self instvar x1_ y1_ x2_ y2_ canv_ canvitem_ toolbar_
667 set path [$canv_ path]
668 set x1_ [$path canvasx $x]
669 set y1_ [$path canvasy $y]
670 set x2_ $x1_
671 set y2_ $y1_
672
673 set canvitem_ [eval [list $path] create [$self item_type] \
674 $x1_ $y1_ $x2_ $y2_ [$self get_properties]]
675 }
676
677
678 MBv2ShapeTool public button_move { x y } {
679 $self instvar x1_ y1_ x2_ y2_ canv_ canvitem_
680 if ![info exists canvitem_] return
681 set path [$canv_ path]
682 set x2_ [$path canvasx $x]
683 set y2_ [$path canvasy $y]
684 $path coords $canvitem_ $x1_ $y1_ $x2_ $y2_
685 }
686
687
688 MBv2ShapeTool public button_release { x y } {
689 $self instvar canvitem_
690 if ![info exists canvitem_] return
691 $self button_move $x $y
692 $self finish
693 }
694
695
696 MBv2ShapeTool public escape { } {
697 $self finish 0
698 }
699
700
701 MBv2ShapeTool public finish { {create 1} } {
702 $self instvar x1_ y1_ x2_ y2_ canv_ canvitem_ sender_ toolbar_
703 if ![info exists canvitem_] return
704 [$canv_ path] delete $canvitem_
705 if $create {
706 set cmdid [eval [list $sender_] create_item [$self item_type] \
707 $x1_ $y1_ $x2_ $y2_ [$self get_properties]]
708 $toolbar_ reset_undo $cmdid
709 }
710 foreach var { x1_ y1_ x2_ y2_ canvitem_ } {
711 if [info exists $var] { unset $var }
712 }
713 }
714
715
716 MBv2ArrowTool public init { path toolbar } {
717 $self next $path $toolbar MbIcons(arrow) "Arrow"
718 }
719
720
721 MBv2ArrowTool public item_type { } { return line }
722
723
724 MBv2ArrowTool public get_properties { } {
725 $self instvar props_ sender_
726 return [list -width [$props_ width] \
727 -fill [$sender_ sanitize_color [$props_ outline]] \
728 -arrow [$props_ arrow]]
729 }
730
731
732 MBv2RectTool public init { path toolbar } {
733 $self next $path $toolbar MbIcons(rect) "Rectangle"
734 }
735
736
737 MBv2RectTool public item_type { } { return rectangle }
738
739
740 MBv2RectTool public get_properties { } {
741 $self instvar props_ sender_
742 set fill [$sender_ sanitize_color [$props_ fill]]
743 if { $fill == "none" } {
744 return [list -width [$props_ width] -outline \
745 [$sender_ sanitize_color [$props_ outline]]]
746 } else {
747 return [list -width [$props_ width] -outline \
748 [$sender_ sanitize_color [$props_ outline]] \
749 -fill [$sender_ sanitize_color [$props_ fill]]]
750 }
751 }
752
753
754 MBv2OvalTool public init { path toolbar } {
755 $self next $path $toolbar MbIcons(oval) "Oval"
756 }
757
758
759 MBv2OvalTool public item_type { } { return oval }
760
761
762 MBv2OvalTool public get_properties { } {
763 $self instvar props_ sender_
764 set fill [$sender_ sanitize_color [$props_ fill]]
765 if { $fill == "none" } {
766 return [list -width [$props_ width] -outline \
767 [$sender_ sanitize_color [$props_ outline]]]
768 } else {
769 return [list -width [$props_ width] -outline \
770 [$sender_ sanitize_color [$props_ outline]] \
771 -fill [$sender_ sanitize_color [$props_ fill]]]
772 }
773 }
774
775
776 MBv2ImportTool public init { path toolbar } {
777 $self next $path $toolbar MbIcons(image) "Import" 1
778 }
779
780
781 MBv2ImportTool public activate { canv } {
782 $self instvar dlg_ sender_ toolbar_ next_import_as_
783
784 if { ![info exists dlg_] || ![winfo exists $dlg_] } {
785 # create the dialog box
786 set dlg_ [Dialog/MBv2Import .importdlg$self \
787 -title {Select file to import} \
788 -modal local]
789 }
790
791 if [info exists next_import_as_] {
792 $dlg_ import_as $next_import_as_
793 unset next_import_as_
794 } else {
795 $dlg_ import_as image
796 }
797
798 set result [$dlg_ invoke]
799 set import_as [lindex $result 0]
800 set files [lindex $result 1]
801 if { [llength $files] > 0 } {
802 set path [$canv path]
803 set cmdid [$self create_item $import_as [lindex $files 0] \
804 [$path canvasx 5] [$path canvasy 5]]
805 if { $cmdid != {} } { $toolbar_ reset_undo $cmdid }
806
807 foreach file [lrange $files 1 end] {
808 # create a new page per image and put the image on
809 # that page
810 set pageid [$sender_ new_page]
811 set cmdid [$self create_item $import_as $file 5 5]
812 }
813 }
814
815 ## switch to the select tool
816 #$toolbar_ do_activate MBv2SelectTool
817 }
818
819
820 MBv2ImportTool public create_item { what file x y } {
821 $self instvar sender_ toolbar_
822 switch -exact -- $what {
823 image {
824 return [$sender_ create_item image $x $y -file $file]
825 }
826 text {
827 if [catch {set f [open $file]}] {
828 set text "Error opening file: $file"
829 } else {
830 set text [read $f]
831 close $f
832 }
833 return [$toolbar_ insert_text $x $y $text]
834 }
835 }
836 return ""
837 }
838
839
840 MBv2ImportTool public next_import_as { what } {
841 $self set next_import_as_ $what
842 }
843
844
845 MBv2SelectTool public init { path toolbar } {
846 $self instvar frame_ menu_
847 set frame_ $path
848 frame $path -relief raised -class Selectbutton
849 $self next $path.radiobutton $toolbar MbIcons(pointer) "Select"
850 menubutton $path.menubutton -indicatoron 1 -font {Helvetica 6} \
851 -text "" -padx 0 -pady 0 -menu $path.menubutton.menu
852 pack $path.radiobutton $path.menubutton -fill both -expand 1 -side top
853 TipManager tip $path.radiobutton ""
854 TipManager tip $path "Select"
855
856 # create the menu
857 set menu_ [menu $path.menubutton.menu -tearoff 0 \
858 -font {Helvetica 10 bold}]
859 $menu_ add command -label "Cut" -accelerator <Ctl-X> \
860 -command "$self cut" -state disabled
861 $menu_ add command -label "Copy" -accelerator <Ctl-C> \
862 -command "$self copy" -state disabled
863 $menu_ add command -label "Paste" -accelerator <Ctl-V> \
864 -command "$self paste" -state disabled
865 $menu_ add command -label "Delete" -accelerator <Del> \
866 -command "$self delete" -state disabled
867 $menu_ add separator
868 $menu_ add cascade -label "Ordering" -menu $menu_.order -state disabled
869
870 menu $menu_.order -tearoff 0 -font {Helvetica 10 bold}
871 $menu_.order add command -label "Bring to front"
872 $menu_.order add command -label "Send to back"
873 $menu_.order add command -label "Bring forward"
874 $menu_.order add command -label "Send backward"
875
876 $self selection_available 0
877 $self clipboard_available 0
878
879 bind SelectTags <ButtonPress-1> "$self button_down %x %y"
880 bind SelectTags <B1-Motion> "$self button_move %x %y"
881 bind SelectTags <ButtonRelease-1> "$self button_release %x %y"
882 bind SelectTags <Escape> "$self escape"
883 bind SelectTags <Delete> "$self delete"
884 bind SelectTags <BackSpace> "$self delete"
885 bind SelectTags <Control-x> "$self cut"
886 bind SelectTags <Control-X> "$self cut"
887 bind SelectTags <Control-c> "$self copy"
888 bind SelectTags <Control-C> "$self copy"
889 # <Control-v> is bound to the canvas all the time when the
890 # canvas is created in MBv2CanvasMgr
891
892 bind SelectTags <KeyPress-Shift_L> "$self shift_press"
893 bind SelectTags <KeyPress-Shift_R> "$self shift_press"
894 bind SelectTags <KeyRelease-Shift_L> "$self shift_release"
895 bind SelectTags <KeyRelease-Shift_R> "$self shift_release"
896 }
897
898
899 MBv2SelectTool public destroy { } {
900 $self instvar frame_
901 destroy $frame_
902 catch {$self next}
903 }
904
905
906 MBv2SelectTool public clipboard_available { {state {}} } {
907 $self instvar menu_
908 if { $state == {} } {
909 set state [$menu_ entrycget "Paste*" -state]
910 if { $state == "disabled" } { return 0 } else { return 1 }
911 }
912 if $state { set state normal } else { set state disabled }
913 $menu_ entryconfigure "Paste*" -state $state
914 }
915
916
917 MBv2SelectTool public selection_available { {state {}} } {
918 $self instvar menu_
919 if { $state == {} } {
920 set state [$menu_ entrycget "Cut*" -state]
921 if { $state == "disabled" } { return 0 } else { return 1 }
922 }
923
924 if $state { set state normal } else { set state disabled }
925 $menu_ entryconfigure "Cut*" -state $state
926 $menu_ entryconfigure "Copy*" -state $state
927 $menu_ entryconfigure "Delete*" -state $state
928 $menu_ entryconfigure "Ordering*" -state $state
929 }
930
931
932 # temp_from is set to some other tool in case we are entering
933 # the select tool mode only temporarily (via pressing the Shift key)
934 MBv2SelectTool public activate { canv {temp_from {}} } {
935 $self instvar frame_ canv_ toolbar_ temp_from_ shift_
936 $frame_ configure -relief sunken
937
938 set canv_ $canv
939 set path [$canv_ path]
940 $path bind local <Enter> "$self enter"
941 $path bind all <Enter> "$self do_show_owner_under_cursor"
942 $canv_ add_bindtag SelectTags
943
944 set temp_from_ $temp_from
945 if { $temp_from!={} } {
946 set shift_ 1
947 } elseif [info exists shift_] { unset shift_ }
948
949 # do the <Enter> stuff if we are already inside a local item
950 set t [$path find withtag current]
951 if { $t != {} } {
952 # make sure it's a local item
953 if { [lsearch [$path gettags $t] local] != -1 } {
954 $self enter
955 }
956 }
957 }
958
959