1 # ui-mbv2.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-mbv2.tcl,v 1.15 2002/02/03 04:21:59 lim Exp $
32
33
34 import MBv2Tools_ToolBar ImageTextButton MbIcons MBv2Properties DropDown \
35 MBv2CanvasMgr Icons
36
37
38 Class MBv2UI
39
40 MBv2UI public init { path } {
41 $self next
42 $self init_default
43 frame $path -class MBv2UI -width 600 -height 500
44 pack propagate $path false
45
46 $self instvar props_ canvmgr_ tools_toolbar_
47
48 frame $path.props
49 set props_ [new MBv2Properties $path.props]
50 pack $path.props -fill x -side top
51
52 set tools_toolbar_ [MBv2Tools_ToolBar $path.toolbar]
53 pack $path.toolbar -side right -fill y
54
55 set canvmgr_ [MBv2CanvasMgr $path.canvmgr -scrollbar both]
56 $canvmgr_ build_toolbar $path.props
57 #$canvmgr_ sender $FIXME
58 pack $canvmgr_ -side left -fill both -expand 1
59
60 # attach observers
61 $canvmgr_ attach_observer $tools_toolbar_
62 # notify the tools of the original canvas
63 $tools_toolbar_ switch_canvas [$canvmgr_ get_canvas none] none
64
65 $self set recv_only_ 0
66 $self enable_session 0
67 }
68
69
70 MBv2UI public init_default { } {
71 set cl MBv2UI
72 option add *${cl}*Button*borderWidth 1
73 option add *${cl}*Menubutton*borderWidth 1
74 option add *${cl}*DropDown/Text*borderWidth 1
75
76 option add *${cl}*Button*highlightThickness 1
77 option add *${cl}*Menubutton*highlightThickness 1
78 option add *${cl}*DropDown/Text.highlightThickness 1
79
80 option add *${cl}*ImageTextButton*borderWidth 1
81 option add *${cl}*ImageTextButton*Button*borderWidth 0
82 option add *${cl}*ImageTextButton*highlightThickness 1
83 option add *${cl}*ImageTextButton*Button*highlightThickness 0
84
85 option add *Menu*font {Helvetica 10 bold}
86 option add *Menu*borderWidth 1
87 option add *Menu*activeBorderWidth 1
88 option add *Menu*tearOff 0
89 option add *Menu*padY 0
90 option add *Menu*pady 0
91
92 # the image in the About messagebox has been tuned for the
93 # default Tk background of d9d9d9; so we must ensure that
94 # the message box does pop up in that background
95 option add *MessageBox*background \#d9d9d9
96 }
97
98
99 MBv2UI public recv_only { flag } {
100 $self instvar recv_only_ canvmgr_
101 if { $recv_only_ == $flag } return
102
103 set recv_only_ $flag
104 $canvmgr_ recv_only $flag
105 }
106
107
108 MBv2UI public enable_session { f } {
109 $self instvar props_ canvmgr_ tools_toolbar_
110 $props_ enable_session $f
111 $canvmgr_ enable_session $f
112 $tools_toolbar_ enable_session $f
113 }
114
115
116 MBv2UI public session { s } {
117 $self instvar session_ sender_ canvmgr_ props_ tools_toolbar_ menu_
118 set session_ $s
119 set sender_ [$s sender]
120 $canvmgr_ sender $sender_
121 $tools_toolbar_ sender $sender_
122 $tools_toolbar_ properties $props_
123
124 $session_ canvasmgr $canvmgr_
125 $session_ attach_observer $canvmgr_
126
127 $self enable_session 1
128
129 $session_ drop_probability 0.0
130 if [info exists menu_] { $self enable_menu $menu_ }
131 }
132
133
134 MBv2UI public exit { } {
135 exit
136 }
137
138
139 MBv2UI public create_menu { path } {
140 $self instvar menu_
141
142 # in mplug mode, if the toplevel is . we will have problems making
143 # $path.menu the menu of the toplevel, so let's just make a menu
144 # button for it
145 global mash
146 if { [info exists mash(environ)] && $mash(environ)=="mplug" && \
147 [winfo toplevel $path]=="." } {
148 set parent [winfo parent $path]
149 menu $parent.menu -type menubar
150 $self build_menu $parent.menu
151 pack $parent.menu -side top -fill x
152 set menu_ $parent.menu
153 } else {
154 set top [winfo toplevel $path]
155 if { $top == "." } { set menu .menu } else {set menu $top.menu}
156 menu $menu -type menubar
157 $self build_menu $menu
158 $top configure -menu $menu
159 set menu_ $menu
160 }
161 }
162
163
164 MBv2UI public build_menu { menu } {
165 $self instvar tools_toolbar_ canvmgr_
166 set select [$tools_toolbar_ tool MBv2SelectTool]
167
168 $menu add cascade -label "File" -menu $menu.file
169 menu $menu.file
170 $menu.file add command -label "Save..." -state disabled
171 $menu.file add command -label "Save as postscript..." -command \
172 "$canvmgr_ save_as_postscript"
173 $menu.file add separator
174 $menu.file add command -label "Quit" -command "$self exit"
175
176
177 $menu add cascade -label "Edit" -menu $menu.edit -state disabled
178 menu $menu.edit -postcommand "$self configure_edit_menu $menu.edit"
179 $menu.edit add command -label "Undo" -accelerator <Ctl-Z> \
180 -command "$tools_toolbar_ undo" -state disabled
181 $menu.edit add command -label "Redo" -accelerator <Shift-Ctl-Z> \
182 -command "$tools_toolbar_ redo" -state disabled
183 $menu.edit add separator
184 $menu.edit add command -label "Cut" -accelerator <Ctl-X> \
185 -command "$select cut" -state disabled
186 $menu.edit add command -label "Copy" -accelerator <Ctl-C> \
187 -command "$select copy" -state disabled
188 $menu.edit add command -label "Paste" -accelerator <Ctl-V> \
189 -command "$select paste" -state disabled
190 $menu.edit add command -label "Delete" -accelerator <Del> \
191 -command "$select delete" -state disabled
192 $menu.edit add separator
193 $menu.edit add cascade -label "Ordering" -menu $menu.edit.order \
194 -state disabled
195
196 menu $menu.edit.order
197 $menu.edit.order add command -label "Bring to front"
198 $menu.edit.order add command -label "Send to back"
199 $menu.edit.order add command -label "Bring forward"
200 $menu.edit.order add command -label "Send backward"
201
202
203 $menu add cascade -label "Tools" -menu $menu.tools -state disabled
204 menu $menu.tools
205 $menu.tools add command -label "Freehand/Text" -command \
206 "$tools_toolbar_ invoke MBv2DrawTextTool"
207 $menu.tools add command -label "Arrow" -command \
208 "$tools_toolbar_ invoke MBv2ArrowTool"
209 $menu.tools add command -label "Rectangle" -command \
210 "$tools_toolbar_ invoke MBv2RectTool"
211 $menu.tools add command -label "Oval" -command \
212 "$tools_toolbar_ invoke MBv2OvalTool"
213 $menu.tools add command -label "Select" -command \
214 "$tools_toolbar_ invoke MBv2SelectTool"
215 $menu.tools add cascade -label "Insert..." -menu $menu.tools.insert
216
217 menu $menu.tools.insert
218 $menu.tools.insert add command -label "Image..." -command \
219 "$self import image"
220 $menu.tools.insert add command -label "Text..." -command \
221 "$self import text"
222
223
224 $menu add cascade -label "Options" -menu $menu.options -state disabled
225 menu $menu.options -postcommand \
226 "$self configure_options_menu $menu.options"
227 $self tkvar show_lists_
228 set show_lists_ 0
229 $menu.options add checkbutton -label "Show member/page lists" \
230 -variable [$self tkvarname show_lists_] -command\
231 "$canvmgr_ show_lists \[set [$self tkvarname \
232 show_lists_]\]"
233 $self tkvar show_tips_dummy_
234 set show_tips_ 1
235 $menu.options add checkbutton -label "Show balloon help" \
236 -variable [$self tkvarname show_tips_] \
237 -command "TipManager enable \[set [$self tkvarname \
238 show_tips_]\]"
239 $menu.options add cascade -label "Show owner of item..." \
240 -menu $menu.options.tips
241 menu $menu.options.tips
242 $self tkvar tips_when_drawn_ tips_under_cursor_
243 $menu.options.tips add checkbutton -label "when drawn" \
244 -variable [$self tkvarname tips_when_drawn_] -command \
245 "$self show_owner_when_drawn \
246 \[set [$self tkvarname tips_when_drawn_]\]"
247 $menu.options.tips add checkbutton -label "under cursor (Select mode)"\
248 -variable [$self tkvarname tips_under_cursor_] \
249 -command "$self show_owner_under_cursor \
250 \[set [$self tkvarname tips_under_cursor_]\]"
251 set tips_when_drawn_ 1; $self show_owner_when_drawn 1
252 set tips_under_cursor_ 1; $self show_owner_under_cursor 1
253
254 $menu.options add command -label "Simulate packet drop..." -command \
255 "$self simulate_packet_drop"
256
257 $menu add cascade -label "Help" -menu $menu.help
258 menu $menu.help
259 $menu.help add command -label "About..." -command "$self about"
260 }
261
262
263 MBv2UI public enable_menu { menu } {
264 $self instvar session_
265 $menu entryconfigure "Edit" -state normal
266 $menu entryconfigure "Tools" -state normal
267 $menu entryconfigure "Options" -state normal
268
269 # check if we are in debug mode or not by trying to set the drop
270 # probability; if the drop probability remains at 0.0, that means
271 # the srm_set_drop_probability function is a nop (i.e. non-debug mode)
272 set orig_drop [$session_ drop_probability 1.0]
273 if { [$session_ drop_probability] == 0.0 } {
274 # disable the "simulate packet drop" method
275 $menu.options entryconfigure "Simulate packet drop*" \
276 -state disabled
277 }
278 $session_ drop_probability $orig_drop
279 }
280
281
282 MBv2UI public simulate_packet_drop { } {
283 $self instvar drop_dlg_ session_
284
285 if ![info exists drop_dlg_] {
286 set drop_dlg_ [Dialog/PacketDrop .dropdlg]
287 }
288
289 set drop [$session_ drop_probability]
290 $drop_dlg_ drop $drop
291 set drop [$drop_dlg_ invoke]
292 if { $drop != {} } {
293 $session_ drop_probability $drop
294 }
295 }
296
297
298 #FIXME
299 MBv2UI public tools_toolbar { } {
300 $self instvar tools_toolbar_
301 return $tools_toolbar_
302 }
303
304
305 #FIXME
306 MBv2UI public canvmgr { } {
307 $self instvar canvmgr_
308 return $canvmgr_
309 }
310
311
312 MBv2UI public show_owner_when_drawn {f} {
313 $self instvar canvmgr_
314 $canvmgr_ show_owner_when_drawn $f
315 }
316
317
318 MBv2UI public show_owner_under_cursor {f} {
319 $self instvar tools_toolbar_
320 [$tools_toolbar_ tool MBv2SelectTool] show_owner_under_cursor $f
321 }
322
323
324 MBv2UI public configure_edit_menu { menu } {
325 $self instvar tools_toolbar_
326
327 set ur [$tools_toolbar_ get_undo_state]
328 if [lindex $ur 0] { set state normal } else { set state disabled }
329 $menu entryconfigure "Undo*" -state $state
330 if [lindex $ur 1] { set state normal } else { set state disabled }
331 $menu entryconfigure "Redo*" -state $state
332
333 set t [$tools_toolbar_ tool MBv2SelectTool]
334 set state [$t selection_available]
335 if $state { set state normal } else { set state disabled }
336 $menu entryconfigure "Cut*" -state $state
337 $menu entryconfigure "Copy*" -state $state
338 $menu entryconfigure "Delete*" -state $state
339 $menu entryconfigure "Ordering*" -state $state
340
341 set state [$t clipboard_available]
342 if $state { set state normal } else { set state disabled }
343 $menu entryconfigure "Paste*" -state $state
344 }
345
346
347 MBv2UI public configure_options_menu { menu } {
348 $self instvar canvmgr_ tools_toolbar_
349
350 $self tkvar show_lists_ show_tips_ tips_when_drawn_ tips_under_cursor_
351 set show_lists_ [$canvmgr_ show_lists]
352 set show_tips_ [TipManager is_enabled]
353 set tips_when_drawn_ [$canvmgr_ show_owner_when_drawn]
354 set tips_under_cursor_ [[$tools_toolbar_ tool MBv2SelectTool] \
355 show_owner_under_cursor]
356 }
357
358
359 MBv2UI public import { what } {
360 $self instvar tools_toolbar_
361 set t [$tools_toolbar_ tool MBv2ImportTool]
362 $t next_import_as $what
363 $t invoke
364 }
365
366
367 MBv2UI public about { } {
368 global mash
369 if [info exists mash(version)] {
370 set v $mash(version)
371 } else {
372 set v ?
373 }
374 set text "The Mash MediaBoard v2.0\
375 \nMash Version $v\
376 \nOpen Mash Consortium\
377 \n\n<http://www.openmash.org/>"
378 set cnt 0
379 while [winfo exists .about$cnt] { incr cnt }
380 set about .about$cnt
381 MessageBox $about -image MbIcons(logo) -text $text \
382 -options { {text.wraplength 0 } } \
383 -title "About MediaBoard..."
384 pack configure [$about subwidget image] -padx 10 -pady 10
385 pack configure [$about subwidget text ] -padx 10 -pady 10
386 pack configure [$about subwidget ok ] -pady 10
387 $about invoke
388 destroy $about
389 }
390
391
392
393 WidgetClass Dialog/PacketDrop -superclass Dialog -default {
394 { .title "Simulate packet drop" }
395 { *ImageTextButton.borderWidth 1 }
396 { *Entry.borderWidth 1 }
397 }
398
399
400 Dialog/PacketDrop public build_widget { path } {
401 frame $path.f1
402 frame $path.f2
403 frame $path.sep -bd 2 -height 2 -relief ridge
404 label $path.label -text "Drop probability\n(0.0 - 1.0)" -justify left \
405 -anchor w
406 entry $path.entry -width 6 -textvariable [$self tkvarname drop_]
407 ImageTextButton $path.ok -text "Ok" -image Icons(check) \
408 -command "$self ok"
409 ImageTextButton $path.cancel -text "Cancel" -image Icons(cross) \
410 -command "$self cancel"
411 pack $path.label -in $path.f1 -anchor n -side left -padx 3
412 pack $path.entry -in $path.f1 -anchor n -side left -fill x -expand 1 \
413 -padx 3
414 pack $path.ok $path.cancel -padx 3 -in $path.f2 -side left
415
416 pack $path.f1 -fill both -expand 1 -padx 10 -pady 10
417 pack propagate $path.sep false
418 pack $path.sep -fill x -padx 2
419 pack $path.f2 -anchor e -padx 5 -pady 10
420
421 bind $path <Key-Return> "$self ok"
422 bind $path <Key-Escape> "$self cancel"
423 }
424
425
426 Dialog/PacketDrop public drop { d } {
427 $self tkvar drop_
428 set drop_ $d
429 }
430
431
432 Dialog/PacketDrop public ok { } {
433 $self tkvar drop_
434 if { [regexp {^[0-9]+$} $drop_] || ([regexp {^[0-9]*.[0-9]*$} $drop_] \
435 && $drop_ != ".") } {
436 if { $drop_ > 1.0 } {
437 set drop_ 1.0
438 }
439
440 $self configure -result $drop_
441 } else {
442 set drop_ 0.0
443 }
444 }
445
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.