1 # ui-mbtools.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1997-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/mb/ui-mbtools.tcl,v 1.19 2002/02/03 04:27:17 lim Exp $
32
33
34 import MBWidget tips mb_utils
35
36 Class MBTool
37
38 #
39 # Import classes here after we defined MBTool
40 #
41 import MBImportTool MBFHTool MBTextTool MBShapeTool MBSelectTool MBEraseTool
42
43 #
44 # Contains routines that manipulates the screen
45 #
46
47 #
48 # Starts up netscape
49 #
50 proc StartNetscape {url} {
51
52 set tmp [eval {exec netscape -remote openURL($url) >& /dev/null} ]
53 if { $tmp == 0} {
54 set err [catch { eval {exec netscape $url &} }]
55 if { $err == 0} {
56 puts "Could not start netscape."
57 }
58 }
59 }
60
61 MBTool instproc init {toolbar mgr sender} {
62 $self set toolbar_ $toolbar
63 $self set sender_ $sender
64 $self set mgr_ $mgr
65 }
66
67 #
68 # returns the current property of a tool
69 #
70 MBTool instproc property {tool} {
71 $self instvar toolbar_
72 return [[$toolbar_ set mbui_] property $tool]
73 }
74
75 # virtual function called AFTER we switch modes or switch page
76 # NOTE when it is called, the modes/page must already have changed!
77 # FIXME: not there yet
78 MBTool instproc deactivate {} {
79 }
80
81 #
82 # Selection Tool: For Copy and Move
83 #
84 Class MBSelectTool -superclass MBTool
85
86 MBSelectTool instproc init {toolbar mgr sender} {
87 $self next $toolbar $mgr $sender
88 $self set selectedObj_ {}
89 }
90
91 #
92 # starts the <i>move</i> operation
93 #
94 MBSelectTool instproc activate_move { page_id } {
95 $self instvar canv_ page_id_ mgr_
96 set page_id_ $page_id
97 set canv_ [[$mgr_ page_manager] page2canv $page_id]
98 $canv_ resetBindings
99 $canv_ setHilit
100 $canv_ config -cursor arrow
101
102 set w [$canv_ get_win]
103 bind $w <Button-1> "$self start_move \[$canv_ canvasxy %x %y\]"
104 bind $w <B1-Motion> "$self move \[$canv_ canvasxy %x %y\]"
105 bind $w <ButtonRelease-1> "$self end_move \[$canv_ canvasxy %x %y\]"
106 }
107
108 #
109 # Duplicate an item, almost the same as moving, except the first step
110 # entails a <i>copy</i> operation
111 #
112 MBSelectTool instproc activate_copy { page_id } {
113 $self instvar canv_ page_id_ mgr_
114 set page_id_ $page_id
115 set canv_ [[$mgr_ page_manager] page2canv $page_id]
116 $canv_ resetBindings
117 $canv_ setHilit
118 $canv_ config -cursor arrow
119
120 set w [$canv_ get_win]
121 bind $w <Button-1> "$self start_copy \[$canv_ canvasxy %x %y\]"
122 bind $w <B1-Motion> "$self move \[$canv_ canvasxy %x %y\]"
123 bind $w <ButtonRelease-1> "$self end_move \[$canv_ canvasxy %x %y\]"
124 }
125
126 #
127 # copy the nearest object, if it is close enough
128 #
129 MBSelectTool instproc start_copy {pt} {
130 $self instvar selectedObj_ lastpt_ startpt_ sender_ canv_ mgr_ toolbar_
131 set nearbyObjs [eval $sender_ nearest $pt 2]
132 set pgId [[$mgr_ page_manager] current_page]
133
134 if { [llength $nearbyObjs] > 0 } {
135 set obj [lindex $nearbyObjs 0]
136 set selectedObj_ [$sender_ dup_item $obj]
137
138 $toolbar_ add_item $pgId $selectedObj_
139 set lastpt_ $pt
140 set startpt_ $pt
141 $canv_ config -cursor fleur
142 $sender_ interactive 1
143 }
144 }
145
146 #
147 # selects the nearest object
148 #
149 MBSelectTool instproc start_move {pt} {
150 $self instvar selectedObj_ lastpt_ startpt_ sender_ canv_
151 set nearbyObjs [eval $sender_ nearest $pt 2]
152
153 if { [llength $nearbyObjs] > 0 } {
154 set selectedObj_ [lindex $nearbyObjs 0]
155 set lastpt_ $pt
156 set startpt_ $pt
157 $canv_ config -cursor fleur
158 $sender_ interactive 1
159 }
160 }
161
162
163 #
164 # Moves selected object, if any
165 #
166 MBSelectTool instproc move {pt} {
167 $self instvar selectedObj_ lastpt_ sender_ canv_
168
169 if {$selectedObj_ != {}} {
170 set dx [expr {[lindex $pt 0] - [lindex $lastpt_ 0]}]
171 set dy [expr {[lindex $pt 1] - [lindex $lastpt_ 1]}]
172 $sender_ move $selectedObj_ $dx $dy
173 set lastpt_ $pt
174 $canv_ hilit
175 }
176 }
177
178 #
179 # End of one move operation
180 #
181 # - put current object on top of the display list
182 #
183 MBSelectTool instproc end_move {pt} {
184 $self instvar selectedObj_ lastpt_ startpt_ sender_ canv_ page_id_ \
185 toolbar_
186 if {$selectedObj_ == {}} {
187 return
188 } else {
189 $canv_ config -cursor arrow
190 # move object back
191 set dx [expr {[lindex $startpt_ 0] - [lindex $lastpt_ 0]}]
192 set dy [expr {[lindex $startpt_ 1] - [lindex $lastpt_ 1]}]
193 $sender_ move $selectedObj_ $dx $dy
194
195 $sender_ interactive 0
196 # do the real move
197 set newobj [$sender_ -page $page_id_ move $selectedObj_ \
198 [expr {[lindex $pt 0] - [lindex $startpt_ 0]}] \
199 [expr {[lindex $pt 1] - [lindex $startpt_ 1]}]]
200
201 # DbgOut "New obj=$newobj"
202 $toolbar_ replace_item $page_id_ $selectedObj_ $newobj
203 set selectedObj_ {}
204 }
205 $canv_ resetMarker
206 }
207
208 # use last pt tracked from motion, this could be a bit different
209 # that the current point, but is the best we can do
210 # FIXME: should use pointerx stuff to get more accurate positioning of last pt
211 MBSelectTool instproc deactivate {} {
212 $self instvar selectedObj_ lastpt_
213 if { [info exists selectedObj_] && [info exists lastpt_] } {
214 $self end_move $lastpt_
215 }
216 }
217
218 #
219 # MBTextTool
220 # - maintains one text tool on one group of canvas
221 #
222 Class MBTextTool -superclass MBTool
223
224 MBTextTool instproc init {toolbar mgr sender} {
225 $self next $toolbar $mgr $sender
226 $self set textLast_ {}
227 $self set currText_ {}
228 }
229
230 MBTextTool instproc activate { page_id } {
231 $self instvar page_id_ canv_ mgr_
232
233 set page_id_ $page_id
234 set canv_ [[$mgr_ page_manager] page2canv $page_id]
235 $canv_ resetBindings
236
237 $canv_ config -cursor xterm
238 $self set textLast_ {}
239 $self set currText_ {}
240
241 set w [$canv_ get_win]
242 bind $w <Button-1> "$self new_group $canv_ \[$canv_ canvasxy %x %y\]"
243 }
244
245 #
246 # select position to type a new group of text
247 #
248 MBTextTool instproc new_group {canv pt} {
249 $self instvar canv_ currText_ sender_
250 # end the previous group, if any
251 if [info exists canv_] {
252 $self end_group
253 }
254 set canv_ $canv
255
256 $self set textLast_ {}
257
258 # item created will have tag currtext
259 set currText_ [eval $sender_ create_item text $pt \
260 [$self property text]]
261
262 $canv focus currtext
263 $canv icursor currtext 1
264
265 set w [$canv get_win]
266
267 $canv bind currtext <Any-Key> "$self insert_char %A; break"
268 $canv bind currtext <Return> "$self insert_char \\n"
269 $canv bind currtext <Control-h> [list $self insert_char \b]
270 $canv bind currtext <Tab> "$self insert_char \\t; break"
271 $canv bind currtext <BackSpace> [$canv bind currtext <Control-h>]
272 $canv bind currtext <Delete> [$canv bind currtext <Control-h>]
273 # bind $w <<Paste>> [list $self paste $canv]
274 # don't insert control characters
275 $canv bind currtext <Control-v> {}
276 $canv bind currtext <Control-y> {}
277 # $canv bind currtext <Shift-Insert> [$canv bind currtext <Control-v>]
278 }
279
280 #
281 # Returns whether we are in the middle of defining a new group
282 # in the given canvas widget
283 #
284 MBTextTool instproc pending {canvWgt} {
285 $self instvar canv_ currText_
286 if {![info exist canv_]} {
287 return 0
288 }
289 return [expr { $canvWgt==[$canv_ get_win] && {} != $currText_ } ]
290 }
291
292 #
293 # insert one string of characters
294 #
295 MBTextTool instproc insert_string {str} {
296 #mtrace trcMB "inserting string {$str}"
297 # REVIEW: we should make MBSender take multiple characters
298 for {set i 0} {$i < [string length $str]} {incr i} {
299 #mtrace trcMB [string index $str $i]
300 $self insert_char [string index $str $i]
301 }
302 }
303
304 #
305 # Pastes the current selection into the pending text group, if there is one,
306 # otherwise creates a new group with the selection.
307 #
308 MBTextTool instproc paste {canv {pt {}}} {
309 # interrupt the current tool
310 $self instvar toolbar_
311 set currTool [$toolbar_ current_tool]
312 if {$currTool!="text"} {
313 $toolbar_ deactivate_tool $currTool
314 }
315
316 set canvWgt [$canv get_win]
317 set oldcursor [$canv show_busy 1]
318 # get selection from either PRIMARY or CLIPBOARD,
319 # ask using default type STRING
320 if [catch {selection get} sel] {
321 if [catch {selection get -selection CLIPBOARD} sel] {
322 $canv show_busy 0 $oldcursor
323 return
324 }
325 }
326 if {$sel == {}} {
327 $canv show_busy 0 $oldcursor
328 return
329 }
330
331 # if we are not in text mode or not working on a pending group,
332 # create the text item as a separate text item, otherwise insert
333 # the selection into the current text item
334 set newgroup 0
335 $self instvar toolbar_
336 if {[$toolbar_ current_tool] != "text" || \
337 ![$self pending $canvWgt]} {
338 set newgroup 1
339 }
340
341 if {$newgroup} {
342 if {$pt == {}} {
343 set pt [$canv canvasxy 0.0 0.0]
344 }
345 $self new_group $canv $pt
346 }
347 $self insert_string $sel
348 if {$newgroup} {
349 $self end_group
350 }
351 if {[$toolbar_ current_tool] != "text"} {
352 $canvWgt focus {}
353 }
354 $canv show_busy 0 $oldcursor
355 }
356
357 #
358 # Insert one character
359 #
360 MBTextTool instproc insert_char {char} {
361 if {$char=={}} { return }
362 $self instvar canv_ currText_ textLast_ sender_
363 # move cursor to the end (play safe)
364 $canv_ icursor currtext end
365 set i [$canv_ index currtext insert]
366 set textLast_ [$sender_ insert $currText_ $i $char]
367 # move cursor again
368 $canv_ icursor currtext end
369 }
370
371 #
372 # define the pending group
373 #
374 MBTextTool instproc end_group {} {
375 $self instvar canv_ textLast_ currText_ sender_ mgr_ toolbar_
376 if {![info exists canv_]} { return }
377 set tags [$canv_ gettags currtext]
378
379 # create the new text group if we are working on one
380 if {$tags!={}} {
381 set page_id [[$mgr_ page_manager] canv2page $canv_]
382 if {$textLast_!={} && $currText_!={} \
383 && $currText_ < $textLast_} {
384 set newobj [$sender_ -page $page_id \
385 create_item group text \
386 $currText_ $textLast_]
387 $toolbar_ add_item $page_id $newobj
388 }
389 set currText_ {}
390 set textLast_ {}
391 }
392 # set tags [$canv gettags currtext]
393 # DbgOut "tags for currtext after grouping: $tags"
394 $canv_ dtag currtext currtext
395 }
396
397 MBTextTool instproc deactivate {} {
398 $self end_group
399 }
400
401 #
402 # Class MBEraseTool --
403 # -- the Eraser
404 #
405 Class MBEraseTool -superclass MBTool
406
407 MBEraseTool instproc init {toolbar mgr sender} {
408 $self next $toolbar $mgr $sender
409 }
410
411 #
412 # Erase mode activated
413 #
414 MBEraseTool instproc activate { page_id } {
415 $self instvar mgr_
416 set canv [[$mgr_ page_manager] page2canv $page_id]
417 $canv resetBindings
418 $canv setHilit
419
420 $canv config -cursor pirate
421 set w [$canv get_win]
422
423 bind $w <Button-3> "$self erase_last $page_id"
424 bind $w <Button-1> "$self erase_here \[$canv canvasxy %x %y\]"
425 bind $w <B1-Motion> "$self erase_here \[$canv canvasxy %x %y\]"
426
427 }
428
429 #
430 # Erase last drawn item on the current page
431 #
432 MBEraseTool instproc erase_last {pageid} {
433 # interrupt the current tool
434 $self instvar toolbar_
435 $toolbar_ deactivate_tool [$toolbar_ current_tool]
436
437 $self instvar trashList_ sender_ mgr_ toolbar_
438
439 set lastItem [$toolbar_ get_item $pageid end]
440 if {$lastItem != {}} {
441 if ![info exists trashList_($pageid)] {
442 set trashList_($pageid) {}
443 }
444 set trashList_($pageid) \
445 [linsert $trashList_($pageid) 0 $lastItem]
446
447 $sender_ delete_item $lastItem
448 $toolbar_ replace_item $pageid $lastItem {}
449 }
450 [[$mgr_ page_manager] page2canv $pageid] unhilit
451 }
452
453 #
454 # Unerase last erased item
455 #
456 MBEraseTool instproc unerase { pageid } {
457 $self instvar trashList_ sender_ toolbar_
458
459 if {![info exists trashList_($pageid)] \
460 || $trashList_($pageid) == {}} {
461 return
462 }
463
464 set obj [lindex $trashList_($pageid) 0]
465 set trashList_($pageid) [lrange $trashList_($pageid) 1 end]
466
467 if [catch {$sender_ dup_item $obj} id] {
468 puts stderr "unerase failed!"
469 } else {
470 $toolbar_ add_item $pageid $id
471 }
472 }
473
474 #
475 # Erase the objects close to $pt
476 #
477 #
478 MBEraseTool instproc erase_here {pt} {
479 $self instvar trashList_ sender_ mgr_ toolbar_
480 set killObjs [eval $sender_ nearest $pt 2]
481
482 # DbgOut "KillObjs= ($killObjs)"
483 set pageid [[$mgr_ page_manager] current_page]
484 foreach killObj $killObjs {
485 if ![info exists trashList_($pageid)] {
486 set trashList_($pageid) {}
487 }
488 set trashList_($pageid) \
489 [linsert $trashList_($pageid) 0 $killObj]
490 $sender_ delete_item $killObj
491 $toolbar_ replace_item $pageid $killObj {}
492 [[$mgr_ page_manager] page2canv $pageid] unhilit
493 }
494 }
495
496 #---------------------------------------------------
497 # Class MBShapeTool --
498 #
499 # Shapes = (rect, oval, straight line)
500 #
501 # This group of items are specified by pressing on
502 # the starting point, dragging to the end-point,
503 # and release the button
504 #
505 #---------------------------------------------------
506
507 Class MBShapeTool -superclass MBTool
508
509 MBShapeTool instproc init {toolbar mgr sender} {
510 $self next $toolbar $mgr $sender
511 $self set fakeObj_ {}
512 }
513
514 #
515 # Change current shape to "type"
516 #
517 MBShapeTool instproc activate_shape { type page_id } {
518 $self instvar type_ canv_ page_id_ mgr_
519 set page_id_ $page_id
520 set canv_ [[$mgr_ page_manager] page2canv $page_id]
521 $canv_ resetBindings
522 $canv_ config -cursor tcross
523 set type_ $type
524
525 set w [$canv_ get_win]
526 bind $w <Button-1> "$self begin %x %y"
527 bind $w <B1-Motion> \
528 "$self motion \[$w canvasx %x\] \[$w canvasy %y\]"
529 bind $w <ButtonRelease-1> "$self end %x %y"
530 }
531
532 #
533 # Start of shape drawing mode
534 # create the shape
535 #
536 MBShapeTool instproc begin {rootx rooty} {
537 $self instvar fakestartpt_ startpt_ fakeObj_ canv_ type_
538 set startpt_ [$canv_ canvasxy $rootx $rooty]
539 set x [$canv_ canvasx $rootx]
540 set y [$canv_ canvasy $rooty]
541 set fakestartpt_ [list $x $y]
542 # Note: the created obj is an tkCanvas object and not recognized
543 # by MBCanvas!
544
545 set fakeObj_ [eval $canv_ create $type_ $x $y $x $y \
546 [$self property $type_]]
547 }
548
549 #
550 # Mouse is moving while in shape drawing mode
551 #
552 MBShapeTool instproc motion {x y} {
553 $self instvar fakestartpt_ fakeObj_ canv_
554 if {$fakeObj_ == {}} { return }
555
556 $canv_ config -cursor cross
557 eval $canv_ coords $fakeObj_ $fakestartpt_ $x $y
558 }
559
560 #
561 # Mouse released in shape drawing mode
562 #
563 MBShapeTool instproc end {rootX rootY} {
564 $self instvar startpt_ fakeObj_ sender_ canv_ type_ page_id_ toolbar_
565 if {$fakeObj_ == {}} { return }
566 $canv_ delete $fakeObj_
567 set endpt [$canv_ canvasxy $rootX $rootY]
568 set newobj [eval $sender_ -page $page_id_ \
569 create_item $type_ $startpt_ \
570 $endpt [$self property $type_]]
571 $toolbar_ add_item $page_id_ $newobj
572 set startpt_ {}
573 set fakeObj_ {}
574 $canv_ config -cursor tcross
575 }
576
577 MBShapeTool instproc deactivate {} {
578 mtrace trcExcessive "$class deactivate"
579 $self instvar canv_
580 set w [$canv_ get_win]
581 set rx [winfo rootx $w]
582 set wx [winfo pointerx $w]
583 set ry [winfo rooty $w]
584 set wy [winfo pointery $w]
585
586 $self end [expr {$wx - $rx}] [expr {$wy - $ry}]
587 }
588
589
590 #---------------------------------------------------
591 #
592 # Freehand sketching
593 #
594 # Press and hold down to sketch, release to stop
595 #
596 #---------------------------------------------------
597
598 #
599 # Free hand drawing Tool
600 #
601 Class MBFHTool -superclass MBTool
602
603 MBFHTool instproc init {toolbar mgr sender} {
604 $self next $toolbar $mgr $sender
605 }
606
607 #
608 # Change the mode to freehand
609 #
610 MBFHTool instproc activate { page_id } {
611 $self instvar canv_ page_id_ mgr_
612 set page_id_ $page_id
613 set canv_ [[$mgr_ page_manager] page2canv $page_id]
614 $canv_ config -cursor pencil
615 $canv_ resetBindings
616 set w [$canv_ get_win]
617 $self set firstpt_ {}
618 $self set start_ {}
619
620 bind $w <Button-1> "$self begin \[$canv_ canvasxy %x %y\]"
621 bind $w <B1-Motion> "$self motion %x %y"
622 bind $w <ButtonRelease-1> "$self end"
623 }
624
625 #
626 # create the line segment and start interactive mode
627 #
628 MBFHTool instproc begin {pt} {
629 $self instvar start_ last_ prop_ firstpt_ sender_
630
631 set firstpt_ $pt
632 set prop_ [$self property plainline]
633 set start_ [eval $sender_ create_item line $pt $pt $prop_]
634 set last_ $start_
635 }
636
637 #
638 # Mouse is moving while in freehand mode
639 #
640 MBFHTool instproc motion {x y} {
641 $self instvar start_ last_ prop_ firstpt_ sender_ canv_
642 if {$firstpt_ == {}} return
643 set pt [$canv_ canvasxy $x $y]
644 set last_ [eval $sender_ create_item line $firstpt_ $pt $prop_]
645 set firstpt_ $pt
646 }
647
648 #
649 # Bundle all the individual lines into one multi-line
650 # note that we assumed that from start_ to last_ they are all line
651 # segments, if this is not true, there will be an error.
652 #
653 MBFHTool instproc end {} {
654 $self instvar start_ last_ firstpt_ sender_ page_id_ toolbar_
655 if {$start_ == {}} return
656 set newObj [eval $sender_ -page $page_id_ \
657 create_item group mline $start_ $last_]
658 $toolbar_ add_item $page_id_ $newObj
659 set start_ {}
660 set last_ {}
661 set firstpt_ {}
662 }
663
664 MBFHTool instproc deactivate {} {
665 $self end
666 }
667
668 # ---------------------------
669 # Class MBScanTool --
670 # Tool for scan in canvas
671 # FIXME: this is not ready yet!
672 Class MBScanTool -superclass MBTool
673
674 MBScanTool instproc init {toolbar mgr sender} {
675 $self next $toolbar $mgr $sender
676 }
677
678 MBScanTool instproc activate { page_id } {
679 $self instvar mgr_
680 set canv [[$mgr_ page_manager] page2canv $page_id]
681 $canv resetBindings
682 $canv setHilit
683 set w [$canv get_win]
684 bind $w <Button-1> "$self start_scan $w %x %y"
685 bind $w <B1-Motion> "$self scan_to $w %x %y"
686 bind $w <ButtonRelease-1> "$self end_scan"
687 }
688
689 MBScanTool instproc start_scan { canvwgt x y } {
690 $canvwgt scan mark $x $y
691 }
692
693 MBScanTool instproc scan_to { canvwgt x y } {
694 $canvwgt scan dragto $x $y
695 $canvwgt scan mark $x $y
696 }
697
698 MBScanTool instproc end_scan { } {
699 }
700
701 Class MBWhoTool -superclass MBTool
702
703 # tool that shows the owner of each item
704 MBWhoTool instproc init {toolbar mgr sender} {
705 $self next $toolbar $mgr $sender
706 $self set canv_ {}
707 $self set font_ [$self get_option smallfont]
708 }
709
710 MBWhoTool instproc activate { page_id } {
711 $self instvar canv_ mgr_
712 set canv_ [[$mgr_ page_manager] page2canv $page_id]
713 set w [$canv_ get_win]
714 bind $w <B1-Motion> "$self show_owner %x %y"
715 }
716
717 MBWhoTool instproc show_owner { x y } {
718 $self instvar canv_ label_ font_ labelw_
719 set px [$canv_ canvasx $x]
720 set py [$canv_ canvasy $y]
721 set tag [$canv_ find closest $px $py]
722 set source [$canv_ owner $tag]
723 if {$source == {}} {
724 return
725 }
726 set cname [$source cname]
727 $canv_ hilit $tag
728 if {![info exists label_]} {
729 set label_ [label .l -text $cname -font $font_ -bg beige]
730 set labelw_ [$canv_ create window $px $py -window $label_]
731 } else {
732 $label_ configure -text $cname
733 $canv_ coord $labelw_ $px $py
734 }
735 $canv_ raise $labelw_
736 }
737
738 # ---------------------------
739 # Class MBToolbar --
740 # Displays all the tools
741 #
742 Class MBToolbar -superclass MBWidget
743
744 #
745 # Displays the toolbar panel with all the buttons
746 #
747 MBToolbar instproc init {ui fr mgr sender ops} {
748 $self instvar mbui_ mgr_
749 set mbui_ $ui
750 set mgr_ $mgr
751
752 $self set currTool_ {}
753 $self set lastTool_ {}
754 set p [eval frame $fr.toolbar $ops]
755 $self set path_ $p
756
757 # REVIEW:
758 # these tools really does more than just implement the buttons
759 # may be they should be part of the ui?
760 $self instvar tools_
761 set tools_(freehand) [new MBFHTool $self $mgr $sender]
762 set tools_(import) [new MBImportTool $self $mgr $sender]
763 set tools_(text) [new MBTextTool $self $mgr $sender]
764 set tools_(line) [new MBShapeTool $self $mgr $sender]
765 set tools_(rectangle) $tools_(line)
766 set tools_(oval) $tools_(line)
767 set tools_(copy) [new MBSelectTool $self $mgr $sender]
768 set tools_(move) $tools_(copy)
769 set tools_(erase) [new MBEraseTool $self $mgr $sender]
770 set tools_(unerase) $tools_(erase)
771
772 # set scan_ [new MBScanTool $self $sender]
773
774 $self tkvar currTool_
775 set currToolVarName [$self tkvarname currTool_]
776
777 set smallfont_ [$self get_option smallfont]
778
779 button $p.sep -text "" -bitmap "sep" -height 4 -relief flat -state disabled
780
781 # radiobutton $p.who -text who -command \
782 # "$tools_(who) activate \[$pageMgr current_page\]" \
783 # -justify center
784 # $self add_tip $p.who "Show Owner under cursor"
785
786 set pageMgr [$mgr page_manager]
787 button $p.unerase -bitmap unerase -command \
788 "$tools_(unerase) unerase \[$pageMgr current_page\]" \
789 -justify center
790 $self add_tip $p.unerase "Unerase Object"
791
792 radiobutton $p.erase -bitmap erase -command \
793 "$tools_(erase) activate \[$pageMgr current_page\]" \
794 -variable $currToolVarName \
795 -value erase -indicatoron false
796 $self add_tip $p.erase "Erase"
797
798 radiobutton $p.copy -bitmap copy -command \
799 "$tools_(copy) activate_copy \[$pageMgr current_page\]" \
800 -variable $currToolVarName -value copy \
801 -indicatoron false
802 $self add_tip $p.copy "Copy"
803
804 radiobutton $p.move -bitmap move -command \
805 "$tools_(move) activate_move \[$pageMgr current_page\]" \
806 -variable $currToolVarName -value move \
807 -indicatoron false
808 $self add_tip $p.move "Move"
809
810 radiobutton $p.freehand -bitmap freehand -command \
811 "$tools_(freehand) activate \[$pageMgr current_page\]" \
812 -variable $currToolVarName -value freehand \
813 -indicatoron false
814 $self add_tip $p.freehand "Freehand Sketch"
815
816 radiobutton $p.line -bitmap line -command \
817 "$tools_(line) activate_shape line \[$pageMgr current_page\]" \
818 -variable $currToolVarName -value line \
819 -indicatoron false
820 $self add_tip $p.line "Straight Line"
821
822 radiobutton $p.oval -bitmap oval -command \
823 "$tools_(oval) activate_shape oval \[$pageMgr current_page\]" \
824 -variable $currToolVarName -value oval \
825 -indicatoron false
826 $self add_tip $p.oval "Oval"
827
828 radiobutton $p.rectangle -bitmap rectangle -command \
829 "$tools_(rectangle) activate_shape rectangle \
830 \[$pageMgr current_page\]" \
831 -variable $currToolVarName -value rectangle \
832 -indicatoron false
833 $self add_tip $p.rectangle "Rectangle"
834
835 radiobutton $p.text -bitmap text -command \
836 "$tools_(text) activate \[$pageMgr current_page\]" \
837 -variable $currToolVarName -value text \
838 -indicatoron false
839 $self add_tip $p.text "Text"
840
841 # radiobutton $p.scan -text scan -variable $currToolVarName -value scan \
842 # -indicatoron false \
843 # -command "$scan_ activate \[$pageMgr current_page\]"
844 # $self add_tip $p.scan "Move View point"
845
846 set buttonList {unerase erase copy move sep \
847 oval rectangle line text freehand}
848
849 set omitTools [string trim [$self get_option omitTools]]
850 foreach elt $buttonList {
851 # display all buttons not in this list
852 if {-1==[lsearch -exact $omitTools $elt]} {
853 pack $p.$elt -side bottom -pady 1 -padx 1 -ipadx 0 -ipady 0
854 }
855 }
856 }
857
858 MBToolbar instproc pack {args} {
859 eval $self next $args
860 $self select_tool [$self current_tool]
861 }
862
863 MBToolbar instproc unpack {} {
864 $self deactivate_tool [$self current_tool]
865 $self instvar mgr_
866 [[$mgr_ page_manager] current_canvas] resetBindings
867 $self next
868 }
869
870 MBToolbar instproc add_tip {args} {
871 return [eval add_tip $args]
872 }
873
874 MBToolbar instproc current_tool {} {
875 $self tkvar currTool_
876 return $currTool_
877 }
878
879 MBToolbar instproc select_tool {toolname} {
880 $self instvar path_
881 if {$toolname != {}} {
882 $path_.$toolname invoke
883 }
884 }
885
886 #
887 # Add a callback to be triggered when a different tool has been selected
888 # the format of the callback will be:
889 # callback_cmd new_tool_name
890 #
891 MBToolbar instproc trace_tool {cmd} {
892 $self instvar tool_change_callbacks_ traced_
893 $self tkvar currTool_
894 if ![info exists traced_] {
895 trace variable currTool_ w \
896 "$self tool_changed"
897 set traced_ 1
898 }
899 lappend tool_change_callbacks_ $cmd
900 }
901
902 # allow the tool (defaults to last tool) to clean up
903 MBToolbar instproc deactivate_tool {{toolname {}}} {
904 $self instvar path_ lastTool_ tools_
905 # puts "in deactivate, lastTool_ is $lastTool_"
906 if {$toolname == {}} {
907 set toolname $lastTool_
908 }
909 if {$toolname != {}} {
910 $tools_($toolname) deactivate
911 }
912 }
913
914 MBToolbar instproc tool {toolname} {
915 $self instvar tools_
916 if [info exists tools_($toolname)] {
917 return $tools_($toolname)
918 }
919 }
920
921 #
922 # Our own callback who a tool changes, it calls all registered callbacks
923 #
924 MBToolbar instproc tool_changed {args} {
925 $self tkvar currTool_
926 $self instvar lastTool_
927 # allow the last tool to cleanup
928 $self deactivate_tool
929 set lastTool_ $currTool_
930 $self instvar tool_change_callbacks_
931 foreach cmd $tool_change_callbacks_ {
932 eval $cmd $currTool_
933 }
934 }
935
936 MBToolbar instproc destroy {} {
937 trace vdelete [$self tkvarname currTool_] w "$self tool_changed"
938 $self instvar tools_
939 delete $tools_(freehand)
940 delete $tools_(import)
941 delete $tools_(text)
942 delete $tools_(line)
943 delete $tools_(copy)
944 delete $tools_(erase)
945 delete $tools_(none)
946 }
947
948 MBToolbar instproc add_item {pageId id} {
949 $self instvar arItems_
950 lappend arItems_($pageId) $id
951 mtrace trcVerbose "adding $id to arItems_($pageId), new: $arItems_($pageId)"
952 }
953
954 MBToolbar instproc replace_item {pageId oldId newId} {
955 $self instvar arItems_
956 set arItems_($pageId) [lsubst $arItems_($pageId) $oldId $newId]
957 }
958
959 MBToolbar instproc get_item {pageId index} {
960 $self instvar arItems_
961 if [info exists arItems_($pageId)] {
962 mtrace trcVerbose "get_item $pageId $index: returning [lindex $arItems_($pageId) $index]"
963 return [lindex $arItems_($pageId) $index]
964 } else {
965 mtrace trcVerbose "cannot find arItems($pageId), returning null"
966 return {}
967 }
968 }
969
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.