1 # ui-canvas.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-canvas.tcl,v 1.19 2002/02/03 04:21:59 lim Exp $
32
33
34 import WidgetClass DropDown Observer ScrolledWidget ScrolledListbox PaneManager
35
36
37 WidgetClass DropDown/CanvasList -superclass {DropDown Observer}
38
39
40 DropDown/CanvasList public build_widget { path } {
41 $self next $path
42 $self insert end none
43 }
44
45
46 DropDown/CanvasList public have_canvases { } {
47 $self instvar list_
48 if { [info exists list_] && [llength $list_] > 0 } { return 1 } \
49 else { return 0 }
50 }
51
52
53 DropDown/CanvasList public insert_item { index value } {
54 $self instvar list_ text_ index_
55
56 set pageid [lindex $value 0]
57 if { $pageid == "none" } {
58 set string none
59 } else {
60 set string [lindex $value 1]
61 if ![info exists list_] {
62 # we must delete the "none" entry
63 $self delete end
64 $self configure -state normal
65 unset text_(none)
66 }
67 lappend list_ $pageid
68 }
69
70 set text_($pageid) $string
71 $self subwidget menu insert $index command -label $string \
72 -command "[list $self] set_var [list $pageid]"
73
74 # FIXME: assuming that we always insert at the end into this list
75 # and never delete
76 if { $pageid != "none" } {
77 if [info exists index_(cnt)] {
78 set index_($pageid) $index_(cnt)
79 incr index_(cnt)
80 } else {
81 set index_($pageid) 0
82 set index_(cnt) 1
83 }
84 }
85 }
86
87
88 DropDown/CanvasList public var_trace { args } {
89 upvar #0 [$self set var_] global_var
90 if { $global_var=="" } return
91
92 $self instvar text_
93 $self subwidget button configure -text $text_($global_var)
94 }
95
96
97 DropDown/CanvasList public prev_canvas { pageid } {
98 $self instvar list_
99 if { ![info exists list_] || $pageid == "none" } return
100 upvar #0 [$self set var_] global_var
101
102 set idx [lsearch $list_ $pageid]
103 if { $idx==-1 } return
104 if { $idx==0 } { set idx end } else { incr idx -1 }
105 set global_var [lindex $list_ $idx]
106 }
107
108
109 DropDown/CanvasList public next_canvas { pageid } {
110 $self instvar list_
111 if { ![info exists list_] || $pageid == "none" } return
112 upvar #0 [$self set var_] global_var
113
114 set idx [lsearch $list_ $pageid]
115 if { $idx==-1 } return
116 incr idx
117 if { $idx >= [llength $list_] } { set idx 0 }
118 set global_var [lindex $list_ $idx]
119 }
120
121
122 DropDown/CanvasList public update_pageid { pageid text } {
123 $self instvar text_ index_
124 if [info exists index_($pageid)] {
125 $self subwidget menu entryconfigure $index_($pageid) \
126 -label $text
127
128 set text_($pageid) $text
129 upvar #0 [$self set var_] global_var
130 if { $global_var==$pageid } {
131 $self subwidget button configure -text $text
132 }
133 }
134 }
135
136
137 WidgetClass ScrolledListbox/CanvasList -superclass {ScrolledListbox Observer} \
138 -default {
139 { .scrollbar both }
140 { .Scrollbar.width 10 }
141 { .Scrollbar.borderWidth 1 }
142 { .Scrollbar.highlightThickness 1 }
143 { *Label.borderWidth 1 }
144 { *Canvas.width 200 }
145 { *Canvas.height 125 }
146 }
147
148
149 ScrolledListbox/CanvasList public update_pageid { pageid text } {
150 set w [$self info widget -id $pageid]
151 if { $w != {} } {
152 $w configure -value $text
153 }
154 }
155
156
157 WidgetClass ScrolledListbox/MemberList -superclass ScrolledListbox \
158 -default {
159 { .scrollbar both }
160 { .Scrollbar.width 10 }
161 { .Scrollbar.borderWidth 1 }
162 { .Scrollbar.highlightThickness 1 }
163 { *Radiobutton.borderWidth 1 }
164 { *Canvas.width 200 }
165 { *Canvas.height 125 }
166 { .itemClass MemberListItem }
167 }
168
169
170 WidgetClass MemberListItem -superclass ListLabelItem
171
172 MemberListItem instproc create_root_widget { path } {
173 radiobutton $path -anchor w
174 if { [option get $path padX Label]=="" } {
175 $path configure -padx 1
176 }
177 if { [option get $path padY Label]=="" } {
178 $path configure -pady 0
179 }
180 }
181
182
183 WidgetClass MBv2CanvasMgr -superclass {ScrolledWidget Observable Observer} \
184 -default {
185 { *Scrollbar.borderWidth 1 }
186 { *Scrollbar.width 10 }
187 { *Canvas.background white }
188 { *ScrolledListbox/CanvasList*Canvas*background WidgetDefault }
189 { *ScrolledListbox/MemberList*Canvas*background WidgetDefault }
190 { *Canvas.borderWidth 1 }
191 { *Canvas.highlightThickness 0 }
192 { *Canvas.relief sunken }
193 { *Canvas*Label*background LemonChiffon }
194 { *Canvas*Label*foreground Black }
195 { *Canvas*Label*relief raised }
196 { *Canvas*Label*borderWidth 1 }
197 { *Canvas*Label*justify center }
198 { *Canvas*Label*font {Helvetica 10} }
199 }
200
201
202 MBv2CanvasMgr public destroy { } {
203 $self instvar activity_
204 foreach t [array names activity_ timers,*] {
205 after cancel $activity_($t)
206 }
207 $self next
208 }
209
210
211 MBv2CanvasMgr public build_widget { path } {
212 $self next $path
213
214 frame $path.hscroll_frame
215 frame $path.vscroll_frame
216
217 lower $path.hscroll_frame
218 lower $path.vscroll_frame
219
220 button $path.left -image MbIcons(ff-left) -bd 0 \
221 -relief raised -highlightthickness 0 -activebackground\
222 [WidgetClass widget_default -background] \
223 -command "$self grow_scrollregion -1 0"
224 button $path.right -image MbIcons(ff-right) -bd 0 \
225 -relief raised -highlightthickness 0 -activebackground\
226 [WidgetClass widget_default -background] \
227 -command "$self grow_scrollregion 1 0"
228 button $path.up -image MbIcons(ff-up) -bd 0 \
229 -relief raised -highlightthickness 0 -activebackground\
230 [WidgetClass widget_default -background] \
231 -command "$self grow_scrollregion 0 -1"
232 button $path.down -image MbIcons(ff-down) -bd 0 \
233 -relief raised -highlightthickness 0 -activebackground\
234 [WidgetClass widget_default -background] \
235 -command "$self grow_scrollregion 0 1"
236
237 pack $path.left -in $path.hscroll_frame -side left -fill y
238 pack $path.hscroll -in $path.hscroll_frame -side left -fill both \
239 -expand 1
240 pack $path.right -in $path.hscroll_frame -side left -fill y
241
242 pack $path.up -in $path.vscroll_frame -side top -fill x
243 pack $path.vscroll -in $path.vscroll_frame -side top -fill both \
244 -expand 1
245 pack $path.down -in $path.vscroll_frame -side top -fill x
246
247 pack $path.hscroll_frame -side bottom -fill x -before $path.dummy
248 pack $path.vscroll_frame -side right -fill y -in $path.dummy
249
250 $self show_lists 0
251 }
252
253
254 # override the base class' config_scroll
255 MBv2CanvasMgr public config_scroll { option scroll } {
256 }
257
258
259 MBv2CanvasMgr public set_show_canvas_list { f } {
260 $self set show_canvas_list_ $f
261 }
262
263
264 MBv2CanvasMgr public show_lists { {f {}} } {
265 $self instvar canvas_list_ member_list_ list_pane_mgr_
266
267 if { $f == {} } {
268 set path [$self info path]
269 if { [winfo exists $path.lists] && \
270 [winfo ismapped $path.lists] } {
271 return 1
272 } else {
273 return 0
274 }
275 }
276
277 $self set_show_canvas_list $f
278 $self set_show_member_list $f
279 if $f {
280 set path [$self info path]
281 if ![winfo exists $path.lists] {
282 set t [toplevel $path.lists]
283 wm title $t "[wm title [winfo toplevel $path]]"
284 wm geometry $t 230x370
285
286 frame $t.frame
287 $self create_member_list $t.memberlist
288 $self create_canvas_list $t.canvaslist
289
290 set list_pane_mgr_ [new PaneManager $t.memberlist \
291 $t.canvaslist -orient vertical \
292 -in $t.frame -percent 0.6]
293 button $t.dismiss -text "Dismiss" -bd 1 -pady 1 \
294 -font {Helvetica 10 bold} \
295 -command "$self show_lists 0"
296 pack $t.frame -fill both -expand 1
297 pack $t.dismiss -anchor e
298 }
299 wm deiconify $path.lists
300 } elseif [info exists canvas_list_] {
301 wm withdraw [$self info path].lists
302 }
303 }
304
305
306 MBv2CanvasMgr public create_canvas_list { widget } {
307 $self instvar canvas_list_ canvas_
308 frame $widget
309 label $widget.label -text "Page list:" -anchor w
310 set canvas_list_ [ScrolledListbox/CanvasList $widget.list]
311 pack $widget.label -fill x
312 pack $widget.list -fill both -expand 1
313
314 # add all existing canvases to the list
315 foreach pageid [array names canvas_] {
316 if { $pageid != "none" } {
317 $canvas_list_ insert end [concat -id $pageid \
318 [$self pageid2text $pageid]]
319 }
320 }
321
322 # highlight the current canvas
323 $self tkvar currentPageId_
324 if { [info exists currentPageId_] && $currentPageId_ != "none" } {
325 $canvas_list_ selection set -id $currentPageId_
326 }
327
328 # set up the bindings
329 $canvas_list_ configure -browsecmd "$self select_canvas_list_item"
330 $self attach_observer $canvas_list_
331
332 bind $canvas_list_ <Destroy> "$self destroy_canvas_list"
333 }
334
335
336 MBv2CanvasMgr private destroy_canvas_list { } {
337 $self instvar canvas_list_ list_pane_mgr_ activity_
338 $self detach_observer $canvas_list_
339 unset canvas_list_
340 if [info exists list_pane_mgr_] {
341 delete $list_pane_mgr_
342 }
343
344 foreach t [array names activity_ timers,pageid*] {
345 after cancel $activity_($t)
346 unset activity_($t)
347 }
348 }
349
350
351 MBv2CanvasMgr private select_canvas_list_item { pageid } {
352 $self instvar canvas_list_
353 if { [llength [$canvas_list_ selection get]] == 0 } {
354 # we are selecting the same guy again
355 # i.e. deselecting it; don't allow that
356 $canvas_list_ selection set -id $pageid
357 } else {
358 $self switch_canvas $pageid
359 }
360 }
361
362
363 MBv2CanvasMgr public set_show_member_list { f } {
364 $self set show_member_list_ $f
365 }
366
367
368 MBv2CanvasMgr public create_member_list { widget } {
369 $self instvar member_list_ canvas_ srcnames_
370 frame $widget
371 label $widget.label -text "Member list:" -anchor w -pady 0
372 frame $widget.title
373 label $widget.title.f -text "Follow" -anchor w -font {Helvetica 10} \
374 -pady 0
375 label $widget.title.n -text " Name" -anchor w -pady 0 \
376 -font {Helvetica 10}
377 set member_list_ [ScrolledListbox/MemberList $widget.list \
378 -browsecmd "$self select_member_list_item"]
379 radiobutton $widget.follow_any -value any -variable [$self tkvarname \
380 source_to_follow_] -anchor w -bd 1 \
381 -text "Follow active source" \
382 -font {Helvetica 10}
383 radiobutton $widget.follow_none -value {} -variable [$self tkvarname \
384 source_to_follow_] -anchor w -bd 1 \
385 -text "Don't follow anyone" \
386 -font {Helvetica 10}
387
388 pack $widget.label -fill x
389 pack $widget.follow_any $widget.follow_none -fill x
390 pack $widget.title.f -side left -fill y
391 pack $widget.title.n -side left -fill both -expand 1
392 pack $widget.title -fill x
393 pack $widget.list -fill both -expand 1
394
395 # add all existing sources to the list
396 foreach srcid [array names srcnames_] {
397 $member_list_ insert end [concat -id $srcid $srcnames_($srcid)]
398 set w [$member_list_ info widget -id $srcid]
399 $w widget_proc configure -variable [$self tkvarname \
400 source_to_follow_] -value $srcid
401 }
402
403 bind $member_list_ <Destroy> "$self destroy_member_list"
404 }
405
406
407 MBv2CanvasMgr private destroy_member_list { } {
408 $self instvar member_list_ activity_
409 unset member_list_
410
411 foreach t [array names activity_ timers,srcid*] {
412 after cancel $activity_($t)
413 unset activity_($t)
414 }
415 }
416
417
418 MBv2CanvasMgr private select_member_list_item { srcid } {
419 $self instvar member_list_
420 $member_list_ selection clear
421 }
422
423
424 MBv2CanvasMgr public sender { s } {
425 $self set sender_ $s
426 }
427
428
429 MBv2CanvasMgr public recv_only { f } {
430 $self instvar recv_only_ tb_path_
431 set recv_only_ $f
432 if $f { set state normal } else { set state disabled }
433 $tb_path_.new configure -state $state
434 }
435
436
437 MBv2CanvasMgr public create_main_widget { path } {
438 $self instvar canv_cnt_ recv_only_ canvas_
439 set recv_only_ 0
440 set canv_cnt_ 0
441 $self source_to_follow any
442 #$self fix_to_view 0
443
444 $self show_owner_when_drawn 1
445
446 set c [$self create_widget $path.canvas$canv_cnt_]
447 set canvas_(none) [new MBv2TkCanvas $c]
448 return $c
449 }
450
451
452 MBv2CanvasMgr public get_canvas { pageid } {
453 $self instvar canv_cnt_ canvas_
454 if ![info exists canvas_($pageid)] {
455 # we need to create an MBv2Canvas object
456
457 set path [$self info path]
458 if [info exists canvas_(none)] {
459 # we already have the default canvas
460 set canvas_($pageid) $canvas_(none)
461 unset canvas_(none)
462
463 # this is the first canvas
464 # we should notify everyone of its creation and
465 # switch to it
466 $self new_canvas $pageid
467 $self switch_canvas $pageid
468 } else {
469 incr canv_cnt_
470 set canvpath [$self create_widget \
471 $path.canvas$canv_cnt_]
472 set canvas_($pageid) [new MBv2TkCanvas $canvpath]
473 $self new_canvas $pageid
474
475 # if we are following this source, we ought to
476 # switch the canvas now
477 set follow [$self source_to_follow]
478 set srcid [lindex [split $pageid :] 0]
479 if { $follow == "any" || $follow == "$srcid" } {
480 $self switch_canvas $pageid
481 }
482 }
483 }
484
485 return $canvas_($pageid)
486 }
487
488
489 MBv2CanvasMgr private create_widget { path } {
490 canvas $path
491 bind $path <Enter> "focus $path"
492 bind $path <Tab> "break"
493
494 bind $path <Control-v> "$self notify_observers control_v"
495 bind $path <Control-V> "$self notify_observers control_v"
496
497 bind $path <Control-z> "$self notify_observers undo"
498 bind $path <Control-Z> "$self notify_observers redo"
499
500 bind $path <ButtonPress-2> \
501 "$self notify_observers buttonpress_2 $path %x %y"
502 bind $path <ButtonPress-3> "$self notify_observers buttonpress_3"
503
504 #bind $path <Configure> "$self canvas_size_changed %W %w %h"
505 return $path
506 }
507
508
509 MBv2CanvasMgr private new_canvas { pageid } {
510 $self instvar canvas_
511
512 # notify any observers
513 $self add_to_canvaslist $pageid
514 $self notify_observers new_canvas $canvas_($pageid) $pageid
515 }
516
517
518 MBv2CanvasMgr public switch_canvas { pageid } {
519 $self instvar canvas_ tb_path_ sender_ canvas_list_
520 $self tkvar scale_
521
522 if [info exists canvas_($pageid)] {
523 # change the scale factor on this canvas if necessary
524 set scale [string trimright $scale_ %]
525 $canvas_($pageid) rescale [expr $scale / 100.0]
526
527 $self replace_main_widget [$canvas_($pageid) path]
528
529 if { $pageid != "none" } {
530 # notify the sender object
531 $sender_ switch_page -page $pageid
532
533 # update the toolbar
534 $self tkvar currentPageId_
535 set currentPageId_ $pageid
536
537 # if a canvas list exists, update it
538 if [info exists canvas_list_] {
539 $canvas_list_ selection set -id $pageid
540 }
541 }
542
543 # notify any observers
544 $self notify_observers switch_canvas $canvas_($pageid) \
545 $pageid
546 }
547 }
548
549
550 MBv2CanvasMgr private try_to_switch_canvas { args } {
551 $self tkvar currentPageId_
552 if { $currentPageId_ == "none" } return
553
554 $self switch_canvas $currentPageId_
555 }
556
557
558 MBv2CanvasMgr private create_new_canvas { } {
559 $self instvar sender_ recv_only_
560 if $recv_only_ return
561
562 # this will end up calling get_canvas which'll create the
563 # actual canvas
564 set pageid [$sender_ new_page]
565 $self tkvar currentPageId_
566 if { $currentPageId_ != $pageid } {
567 $self switch_canvas $pageid
568 }
569 }
570
571
572 MBv2CanvasMgr private add_to_canvaslist { pageid } {
573 $self instvar tb_path_ canv_cnt_ canvas_list_
574 $tb_path_.canvaslist insert end [list $pageid \
575 [$self pageid2text $pageid]]
576 if { [info exists canvas_list_] && [winfo exists $canvas_list_] } {
577 $canvas_list_ insert end [concat -id $pageid \
578 [$self pageid2text $pageid]]
579 }
580
581 # if we have more than 1 canvas
582 # we should enable the prev/next buttons
583 if { $canv_cnt_==1 } {
584 # i.e. we have at least 2 canvases
585 $tb_path_.prev configure -state normal
586 $tb_path_.next configure -state normal
587 }
588 }
589
590
591 MBv2CanvasMgr public source_name { srcid } {
592 $self instvar srcnames_
593 if [info exists srcnames_($srcid)] {
594 set name $srcnames_($srcid)
595 } else {
596 set name unknown
597 }
598 return $name
599 }
600
601
602 MBv2CanvasMgr public pageid2text { pageid } {
603 $self instvar srcnames_
604 set split [split $pageid :]
605 set srcid [lindex $split 0]
606 if [info exists srcnames_($srcid)] {
607 set name $srcnames_($srcid)
608 } else {
609 set name unknown
610 }
611
612 return "$name: [lindex $split 1]"
613 }
614
615
616 MBv2CanvasMgr public source_update { src name cname } {
617 $self instvar srcnames_ canvas_ member_list_
618
619 if { $name=={} } {
620 if { $cname=={} } { set name unknown } else { set name $cname }
621 }
622 set srcid [$src source_id]
623 set srcnames_($srcid) $name
624
625 # update the member list if necessary
626 if [info exists member_list_] {
627 if [catch {set w [$member_list_ info widget -id $srcid]}] {
628 $member_list_ insert end [concat -id $srcid $name]
629 set w [$member_list_ info widget -id $srcid]
630 $w widget_proc configure -variable [$self tkvarname \
631 source_to_follow_] -value $srcid
632 } else {
633 $w configure -value $name
634 }
635 }
636
637 # loop thru all the page id's and update the necessary ones
638 foreach pageid [array names canvas_] {
639 set split [split $pageid :]
640 set sid [lindex $split 0]
641 if { $sid == $srcid } {
642 $self notify_observers update_pageid $pageid \
643 "$name: [lindex $split 1]"
644 }
645 }
646 }
647
648
649 MBv2CanvasMgr public activity { srcid pageid cmdid canvid islocal } {
650 $self instvar activity_ canvas_ srcnames_ show_owner_ canvas_list_ \
651 show_canvas_list_ member_list_ show_member_list_ \
652 list_pane_mgr_
653
654 if [info exists canvas_($pageid)] {
655 $self resize_scrollregion_later $canvas_($pageid)
656 }
657
658 # display the owner of the item that was just drawn
659 $self tkvar currentPageId_
660 if { $show_owner_ && !$islocal && \
661 $currentPageId_ == $pageid && \
662 [info exists canvas_($pageid)] } {
663 if [info exists srcnames_($srcid)] {
664 set name $srcnames_($srcid)
665 } else { set name unknown }
666 $canvas_($pageid) show_owner $srcid $name $canvid
667 }
668
669 # highlight the member list
670 if { [info exists member_list_] && $show_member_list_ && \
671 (![info exists list_pane_mgr_] || \
672 [$list_pane_mgr_ percent] > 0.0) } {
673 set w [$member_list_ info widget -id $srcid]
674 if ![info exists activity_(timers,srcid:$srcid)] {
675 $w configure -normalbackground white \
676 -selectbackground white
677 } else {
678 after cancel $activity_(timers,srcid:$srcid)
679 }
680
681 set activity_(timers,srcid:$srcid) [after 500 \
682 "$self unhilit_member_list_item $srcid $w"]
683 }
684
685 # highlight the canvas
686 if { [info exists canvas_list_] && $show_canvas_list_ && \
687 (![info exists list_pane_mgr_] || \
688 [$list_pane_mgr_ percent] < 1.0) } {
689 set w [$canvas_list_ info widget -id $pageid]
690 if ![info exists activity_(timers,pageid:$pageid)] {
691 $w configure -normalbackground white \
692 -selectbackground white
693 } else {
694 after cancel $activity_(timers,pageid:$pageid)
695 }
696
697 set activity_(timers,pageid:$pageid) [after 500 \
698 "$self unhilit_canvas_list_item $pageid $w"]
699 }
700
701 # if we are in followActive/followSrc mode, try switching to the
702 # appropriate page
703 set follow [$self source_to_follow]
704 if { $pageid != {} && $pageid != $currentPageId_ && \
705 ($follow == "any" || $follow == $srcid) } {
706 $self switch_canvas $pageid
707 }
708 }
709
710
711 MBv2CanvasMgr private unhilit_canvas_list_item { pageid w } {
712 $self instvar activity_
713 unset activity_(timers,pageid:$pageid)
714 $w configure -normalbackground [WidgetClass widget_default \
715 -background] -selectbackground [WidgetClass \
716 widget_default -selectbackground]
717 }
718
719
720 MBv2CanvasMgr private unhilit_member_list_item { srcid w } {
721 $self instvar activity_
722 unset activity_(timers,srcid:$srcid)
723 $w configure -normalbackground [WidgetClass widget_default \
724 -background] -selectbackground [WidgetClass \
725 widget_default -selectbackground]
726 }
727
728
729 MBv2CanvasMgr public source_to_follow { args } {
730 $self tkvar source_to_follow_
731 if { [llength $args] == 0 } { return $source_to_follow_ }
732 set source_to_follow_ [lindex $args 0]
733 }
734
735
736 MBv2CanvasMgr public resize_scrollregion_later { canv } {
737 $self instvar activity_
738 if [info exists activity_(timers,resize:$canv)] {
739 after cancel $activity_(timers,resize:$canv)
740 }
741
742 set activity_(timers,resize:$canv) \
743 [after 300 "$canv resize_scrollregion"]
744 }
745
746
747 MBv2CanvasMgr private grow_scrollregion { x y } {
748 $self tkvar currentPageId_
749 $self instvar canvas_
750 if [info exists canvas_($currentPageId_)] {
751 $canvas_($currentPageId_) grow_scrollregion $x $y
752 }
753 }
754
755
756 MBv2CanvasMgr public build_toolbar { tb_path } {
757 $self instvar tb_path_
758 set tb_path_ $tb_path
759
760 label $tb_path.separator -text " "
761 label $tb_path.canvaslist_label -text "Pages:"
762 DropDown/CanvasList $tb_path.canvaslist -state disabled -variable \
763 [$self tkvarname currentPageId_]
764 TipManager tip $tb_path.canvaslist "Page list"
765 $self attach_observer $tb_path.canvaslist
766 $tb_path.canvaslist subwidget menu configure -tearoff 0
767 $self tkvar currentPageId_
768 trace variable currentPageId_ w "$self try_to_switch_canvas"
769
770 button $tb_path.prev -image MbIcons(prev) -padx 1 -state disabled \
771 -command "$tb_path.canvaslist prev_canvas \
772 \[set [$self tkvarname currentPageId_]\]"
773 TipManager tip $tb_path.prev "Previous\npage"
774 button $tb_path.next -image MbIcons(next) -padx 1 -state disabled \
775 -command "$tb_path.canvaslist next_canvas \
776 \[set [$self tkvarname currentPageId_]\]"
777 TipManager tip $tb_path.next "Next\npage"
778 button $tb_path.new -image MbIcons(new) \
779 -command "$self create_new_canvas"
780 TipManager tip $tb_path.new "New\npage"
781 DropDown/Text $tb_path.scale -options { {entry.width 5} } \
782 -variable [$self tkvarname scale_]
783 TipManager tip $tb_path.scale "Change\nzoom"
784 $self tkvar scale_
785 set scale_ 100%
786 trace variable scale_ w "$self switch_scale"
787
788 $tb_path.scale insert end 50% 75% 100% 125% 150% 175% 200% \
789 "fit width" "fit height" \
790 "fit all"
791 pack $tb_path.scale $tb_path.new $tb_path.next $tb_path.prev \
792 $tb_path.canvaslist $tb_path.canvaslist_label \
793 $tb_path.separator -side right -padx 1
794 }
795
796
797 # this isn't ready for prime time yet
798 # I'm not sure I wan't to bother...
799 MBv2CanvasMgr public fix_to_view { s } {
800 $self set fix_to_view_ $s
801 set t [winfo toplevel [$self info path]]
802 if $s {
803 if [winfo ismapped $t] {
804 set tw [winfo width $t]
805 set th [winfo height $t]
806 # FIXME
807 if { [wm frame $t] != [winfo id $t] } {
808 # there is an enclosing decorative window
809 # FIXME:let's assume it adds 10 pixels to the
810 # height
811 incr th 10
812 }
813 wm aspect $t $tw $th $tw $th
814 }
815 } else {
816 wm aspect $t {} {} {} {}
817 }
818 }
819
820
821 MBv2CanvasMgr public toggle_fix_to_view { } {
822 $self instvar fix_to_view_
823 $self fix_to_view [expr !$fix_to_view_]
824 }
825
826
827 MBv2CanvasMgr public canvas_size_changed { path w h } {
828 $self instvar fix_to_view_ last_widget_ last_widget_w_ last_widget_h_
829 if { $fix_to_view_ && [info exists last_widget_] && \
830 $last_widget_ == $path } {
831 $self tkvar scale_
832 if { $last_widget_w_ <= 0 } { set last_widget_w_ 1 }
833 if { $last_widget_h_ <= 0 } { set last_widget_h_ 1 }
834 if { $w <= 0 } { set w 1 }
835 if { $h <= 0 } { set h 1 }
836
837 set sw [expr double($w)/double($last_widget_w_)]
838 set sh [expr double($h)/double($last_widget_h_)]
839 set s [string trimright $scale_ %]
840 if { $sw < $sh } {
841 set scale_ [expr int((double($s) * $sw) + 0.5)]
842 } else {
843 set scale_ [expr int((double($s) * $sh) + 0.5)]
844 }
845 } elseif $fix_to_view_ {
846 # we must ensure that the aspect ratio remains fixed
847 set t [winfo toplevel $path]
848 set tw [winfo width $t]
849 set th [winfo height $t]
850 # FIXME
851 if { [wm frame $t] != [winfo id $t] } {
852 # there is an enclosing decorative window
853 # FIXME:let's assume it adds 10 pixels to the height
854 incr th 10
855 }
856 wm aspect $t $tw $th $tw $th
857 }
858
859 set last_widget_ $path
860 set last_widget_w_ $w
861 set last_widget_h_ $h
862 }
863
864
865 MBv2CanvasMgr public switch_scale { args } {
866 $self instvar canvas_
867 $self tkvar currentPageId_ scale_
868
869 if ![info exists canvas_($currentPageId_)] return
870 set canv $canvas_($currentPageId_)
871
872 set scale [string trim $scale_]
873 set scale [string trimright $scale %]
874 set scale [string trimright $scale]
875
876 switch -exact -- $scale {
877 "fit width" {
878 set path [$canv path]
879 set bbox [$path bbox all]
880 if {$bbox == {}} {
881 $canv rescale 1.0
882 set scale 100
883 } else {
884 set width [expr [lindex $bbox 2] - \
885 [lindex $bbox 0]]
886 if {$width > 0} {
887 # leave room for 10 pix of margin
888 set scale [$canv rescale_to_fit \
889 $width 0 \
890 [expr [winfo width \
891 $path]-10] 0]
892 } else {
893 $canv rescale 1.0
894 set scale 100
895 }
896 }
897 }
898
899 "fit height" {
900 set path [$canv path]
901 set bbox [$path bbox all]
902 if {$bbox == {}} {
903 $canv rescale 1.0
904 set scale 100
905 } else {
906 set height [expr [lindex $bbox 3] - \
907 [lindex $bbox 1]]
908 if {$height > 0} {
909 # leave room for 10 pix of margin
910 set scale [$canv rescale_to_fit \
911 0 $height \
912 0 [expr [winfo height \
913 $path]-10]]
914 } else {
915 $canv rescale 1.0
916 set scale 100
917 }
918 }
919 }
920
921 "fit all" {
922 set path [$canv path]
923 set bbox [$path bbox all]
924 if {$bbox == {}} {
925 $canv rescale 1.0
926 set scale 100
927 } else {
928 set width [expr [lindex $bbox 2] - \
929 [lindex $bbox 0]]
930 set height [expr [lindex $bbox 3] - \
931 [lindex $bbox 1]]
932 if {$width > 0 || $height > 0} {
933 # leave room for 10 pix of margin
934 set scale [$canv rescale_to_fit \
935 $width $height \
936 [expr [winfo width \
937 $path]-10] \
938 [expr [winfo height \
939 $path]-10]]
940 } else {
941 $canv rescale 1.0
942 set scale 100
943 }
944 }
945 }
946
947 default {
948 if { ![regexp {^[0-9]+$} $scale] } { set scale 100 }
949 $canv rescale [expr $scale / 100.0]
950 }
951 }
952
953 set scale_ "${scale}%"
954 $self notify_observers switch_scale $scale
955 }
956