Project

General

Profile

Statistics
| Branch: | Revision:

root / src / tkenv / main.tcl @ 3e29b8a0

History | View | Annotate | Download (27.6 KB)

1 01873262 Georg Kunz
#=================================================================
2
#  MAIN.TCL - part of
3
#
4
#                     OMNeT++/OMNEST
5
#            Discrete System Simulation in C++
6
#
7
#=================================================================
8
9
#----------------------------------------------------------------#
10
#  Copyright (C) 1992-2008 Andras Varga
11
#
12
#  This file is distributed WITHOUT ANY WARRANTY. See the file
13
#  `license' for details on this and other legal matters.
14
#----------------------------------------------------------------#
15
16
#------
17
# Parts of this file were created using Stewart Allen's Visual Tcl (vtcl)
18
#------
19
20
#===================================================================
21
#    GLOBAL VARIABLES
22
#===================================================================
23
24
# default config settings
25
set config(editor-findstring) ""
26
set config(editor-case-sensitive) 0
27
set config(editor-whole-words) 0
28
set config(editor-regexp) 0
29
set config(editor-backwards) 1
30
set config(editor-wrap) none
31
set config(display-treeview) 1
32
set config(filtobjlist-class)  ""
33
set config(filtobjlist-name)   ""
34
set config(filtobjlist-order)  "Class"
35
set config(filtobjlist-maxcount) 100000
36
set config(filtobjlist-category) "mqsgvo"
37
set config(last-nedfile) ""
38
set config(confirm-exit) 1
39
set config(rununtil-mode) "Express (tracing off)"
40
set config(rununtil-time) ""
41
set config(rununtil-event) ""
42
set config(rununtil-msg) ""
43
set config(display-timeline) 1
44
set config(timeline-maxnumevents) 1000
45
#set config(timeline-includemsgkinds) {*}
46
#set config(timeline-excludemsgkinds) {}
47
set config(timeline-wantselfmsgs) 1
48
set config(timeline-wantnonselfmsgs) 1
49
set config(timeline-msgnamepattern) "*"
50
set config(timeline-msgclassnamepattern) "*"
51
set config(log-save-filename) "omnetpp.out"
52
set config(mainwin-state) "normal"
53
set config(mainwin-geom) ""
54
set config(concurrent-anim) 1
55
set config(logwindow-scrollbacklines) 100000
56
set config(zoomby-factor) 1.1
57
set config(layout-may-resize-window) 0
58
set config(layout-may-change-zoom) 1
59
60
set pluginlist {}
61
62
set contextmenurules(keys) {}
63
64
65
#
66
# simple debug-print procedure
67
#
68
proc debug {str} {
69
   # uncomment the next line if you want debug messages
70
   #puts "dbg: $str"
71
}
72
73
#===================================================================
74
#    MAIN OMNET++ WINDOW
75
#===================================================================
76
77
proc create_omnetpp_window {} {
78
79
    global tcl_version tk_version tk_patchLevel tcl_platform
80
    global icons fonts help_tips widgets config priv
81
    global B2 B3
82
83
    wm focusmodel . passive
84
    wm geometry . 640x350
85
    #wm maxsize . 1009 738
86
    wm minsize . 1 1
87
    wm overrideredirect . 0
88
    wm resizable . 1 1
89
    wm deiconify .
90
    wm title . "OMNeT++/Tkenv"
91
    wm protocol . WM_DELETE_WINDOW {exit_omnetpp}
92
93
    # set the application icon
94
    set iconphoto_main $icons(logo128m)
95
    set iconphoto_other $icons(logo128w)
96
    if {$tcl_platform(platform) == "windows"} {
97
        if {[string compare $tk_patchLevel "8.5.6"] < 0} {
98
            # Tk bug #2504402: "On Windows the wm iconphoto command only works with
99
            # 32-bit color displays. Other display settings produce a black icon."
100
            # This bug appears to have been fixed in Tk 8.5.6. For earlier versions,
101
            # only turn on icon for 32-bit displays.
102
            if {[winfo screendepth .] == 32} {
103
                # Bug #1467997: "the displayed icons have red and blue colors transposed."
104
                # This bug was was fixed in 8.4.16. For earlier versions, we manually swap
105
                # the R and B channels.
106
                if {[string compare $tk_patchLevel "8.4.16"] < 0} {
107
                    opp_swapredandblue $iconphoto_other
108
                    opp_swapredandblue $iconphoto_main
109
                }
110
                # note: on win7, without the "after" command wm iconphoto causes startup glitches (empty window+delay)
111
                after 200 "wm iconphoto . -default $iconphoto_other; wm iconphoto . $iconphoto_main"
112
            }
113
        } else {
114
            # note: on win7, without the "after" command wm iconphoto causes startup glitches (empty window+delay)
115
            after 200 "wm iconphoto . -default $iconphoto_other; wm iconphoto . $iconphoto_main"
116
        }
117
    } elseif {[string equal [tk windowingsystem] aqua]}  {
118
        # do nothing: on Mac OS X 10.5, wm iconphoto is not implemented (results in error);
119
        # on 10.6, it does not cause an error but simply has no apparent effect
120
    } else {
121
        # On linux, 8.4.19 was tested and known to be working.
122
        if {[string compare $tk_patchLevel "8.4.19"] >= 0} {
123
            wm iconphoto . -default $iconphoto_other
124
            wm iconphoto . $iconphoto_main
125
        }
126
    }
127
128
    #################################
129
    # Menu bar
130
    #################################
131
132
    menu .menubar
133
    . config -menu .menubar
134
135
    # Create menus
136
    foreach i {
137
       {filemenu     -$label_opt File -underline 0}
138
       {editmenu     -$label_opt Edit -underline 0}
139
       {simulatemenu -$label_opt Simulate -underline 0}
140
       {tracemenu    -$label_opt Trace -underline 0}
141
       {inspectmenu  -$label_opt Inspect -underline 0}
142
       {viewmenu     -$label_opt View -underline 0}
143
       {optionsmenu  -$label_opt Options -underline 0}
144
       {helpmenu     -$label_opt Help -underline 0}
145
    } {
146
       if {$tcl_version < 8.0} {
147
           set label_opt "text"; set m ".m"
148
           set mb [eval menubutton .menubar.$i -padx 4 -pady 3]
149
           menu $mb.m -tearoff 0
150
           $mb config -menu $mb.m
151
       } else {
152
           set label_opt "label"; set m ""
153
           eval .menubar add cascade -menu .menubar.$i
154
           menu ".menubar.[lindex $i 0]" -tearoff 0
155
       }
156
    }
157
158
    # File menu
159
    foreach i {
160
      {command -command new_run -label {Set up a configuration...} -underline 7}
161
      {separator}
162
      {command -command load_nedfile -label {Load NED file...} -underline 0}
163
      {command -command new_network -label {Set up an unconfigured network...} -underline 7}
164
      {separator}
165
      {command -command create_snapshot -label {Create snapshot...} -underline 7}
166
      {separator}
167
      {command -command exit_omnetpp -label Exit -underline 1}
168
    } {
169
      eval .menubar.filemenu$m add $i
170
    }
171
172
    # Edit menu
173
    foreach i {
174
      {command -command edit_copy -label {Copy} -accel {Ctrl+C} -underline 0}
175
      {separator}
176
      {command -command edit_find -label {Find...} -accel {Ctrl+F} -underline 0}
177
      {command -command edit_findnext -label {Find next} -accel {Ctrl+N,F3} -underline 5}
178
      {separator}
179
      {command -command edit_filterwindowcontents -label {Filter window contents...} -accel {Ctrl+H} -underline 0}
180
    } {
181
      eval .menubar.editmenu$m add $i
182
    }
183
184
    # Simulate menu
185
    #  {command -command init_step -label {First real event} -underline 1}
186
    #  {separator}
187
    foreach i {
188
      {command -command one_step -label {One step} -accel {F4} -underline 4}
189
      {command -command run_slow -label {Slow execution} -underline 1}
190
      {separator}
191
      {command -command run_normal -label {Run}  -accel {F5} -underline 0}
192
      {command -command run_fast -label {Fast run (rare display updates)} -accel {F6} -underline 0}
193
      {command -command run_express -label {Express run (tracing off)} -accel {F7} -underline 1}
194
      {command -command run_until -label {Run until...} -underline 4}
195
      {separator}
196
      {command -command stop_simulation -label {Stop execution} -accel {F8} -underline 0}
197
      {separator}
198
      {command -command call_finish -label {Call finish() for all modules} -underline 0}
199
      {command -command rebuild -label {Rebuild network} -underline 1}
200
    } {
201
      eval .menubar.simulatemenu$m add $i
202
    }
203
204
    # Trace menu
205
    foreach i {
206
      {command -command message_windows -label {Message sending...} -underline 8}
207
      {separator}
208
      {command -command clear_windows -label {Clear main window} -underline 0}
209
    } {
210
      eval .menubar.tracemenu$m add $i
211
    }
212
213
    # Inspect menu
214
    # The following two items have been replaced by the new Find/inspect objects... dialog:
215
    #  {command -command inspect_anyobject -label {From list of all objects...} -underline 0}
216
    #  {command -command inspect_matching -label {By pattern matching...} -underline 3}
217
    foreach i {
218
      {command -command inspect_systemmodule -label {Network} -underline 0}
219
      {command -command inspect_messagequeue -label {Scheduled events (FES)} -underline 0}
220
      {command -command inspect_simulation   -label {Simulation} -underline 1}
221
      {separator}
222
      {cascade -label {Available components} -underline 10 -menu .menubar.inspectmenu$m.components}
223
      {separator}
224
      {command -command inspect_filteredobjectlist -label {Show 'Find/inspect objects' window} -accel {Ctrl+S} -underline 0}
225
      {command -command inspect_bypointer -label {Inspect by pointer...} -underline 4}
226
      {separator}
227
      {command -command opp_updateinspectors -label {Refresh inspectors} -underline 0}
228
    } {
229
      eval .menubar.inspectmenu$m add $i
230
    }
231
232
    # Inspect|Components menu
233
    menu .menubar.inspectmenu$m.components -tearoff 0
234
    foreach i {
235
      {command -command inspect_componenttypes -label {NED component types} -underline 0}
236
      {command -command inspect_classes        -label {Registered classes} -underline 0}
237
      {command -command inspect_functions      -label {NED functions} -underline 4}
238
      {command -command inspect_enums          -label {Registered Enums} -underline 11}
239
      {command -command inspect_configentries  -label {Supported configuration options} -underline 0}
240
    } {
241
      eval .menubar.inspectmenu$m.components add $i
242
    }
243
244
    # View menu
245
    foreach i {
246
      {command -label {Ini file} -underline 0 -command view_inifile}
247
      {command -label {README} -underline 0 -command {view_file README}}
248
      {separator}
249
      {command -label {Output vector file} -underline 7 -command view_outputvectorfile}
250
      {command -label {Output scalar file} -underline 7 -command view_outputscalarfile}
251
      {command -label {Snapshot file} -underline 0 -command view_snapshotfile}
252
      {separator}
253
      {command -label {View text file...} -underline 0 -command {edit_textfile}}
254
    } {
255
      eval .menubar.viewmenu$m add $i
256
    }
257
258
    # Options menu
259
    foreach i {
260
      {command -command simulation_options -label {Simulation options...} -underline 0}
261
      {command -command toggle_timeline -label {Show/hide timeline} -underline 10}
262
      {command -command toggle_treeview -label {Show/hide object tree} -underline 1}
263
      {command -command toggle_record_eventlog -label {Eventlog recording} -underline 10}
264
      {separator}
265
      {command -label {Load config...} -underline 0 -command load_tkenv_config}
266
      {command -label {Save config...} -underline 1 -command save_tkenv_config}
267
    } {
268
      eval .menubar.optionsmenu$m add $i
269
    }
270
271
    # Help menu
272
    foreach i {
273
      {command -command about -label {About OMNeT++/Tkenv} -underline 0}
274
    } {
275
      eval .menubar.helpmenu$m add $i
276
    }
277
278
    #################################
279
    # Create toolbar
280
    #################################
281
282
    frame .toolbar -relief raised -borderwidth 1
283
284
    #TODO  {rebuild  -image $icons(rebuild) -command {rebuild}}
285
286
    foreach i {
287
      {sep00    -separator}
288
      {newrun   -image $icons(newrun)  -command {new_run}}
289
      {loadned  -image $icons(loadned) -command {load_nedfile}}
290
      {sep5     -separator}
291
      {copy     -image $icons(copy)    -command {edit_copy}}
292
      {find     -image $icons(find)    -command {edit_find}}
293
      {save     -image $icons(save)    -command {savefile "."}}
294
      {sep0     -separator}
295
      {step     -image $icons(step)    -command {one_step}}
296
      {run      -image $icons(run)     -command {run_normal}}
297
      {fastrun  -image $icons(fast)    -command {run_fast}}
298
      {exprrun  -image $icons(express) -command {run_express}}
299
      {until    -image $icons(until)   -command {run_until}}
300
      {stop     -image $icons(stop)    -command {stop_simulation}}
301
      {sep4     -separator}
302
      {eventlog -image $icons(recordeventlog) -command {toggle_record_eventlog}}
303
      {finish   -image $icons(finish)  -command {call_finish}}
304
      {sep02     -separator}
305
      {network  -image $icons(network) -command {inspect_systemmodule}}
306
      {objs     -image $icons(findobj) -command {inspect_filteredobjectlist}}
307
      {filter   -image $icons(filter)  -command {edit_filterwindowcontents}}
308
      {sep6     -separator}
309
      {tline    -image $icons(fes)     -command {toggle_timeline}}
310
      {tree     -image $icons(tree)    -command {toggle_treeview}}
311
      {sep9     -separator}
312
      {options  -image $icons(config)  -command {simulation_options}}
313
    } {
314
      set b [eval iconbutton .toolbar.$i]
315
      pack $b -anchor n -expand 0 -fill none -side left -padx 0 -pady 2
316
    }
317
318
    set help_tips(.toolbar.loadned) {Load NED file for compound module definitions}
319
    set help_tips(.toolbar.newrun)  {Set up an inifile configuration}
320
    set help_tips(.toolbar.copy)    {Copy selected text to clipboard (Ctrl+C)}
321
    set help_tips(.toolbar.find)    {Find string in main window (Ctrl+F)}
322
    set help_tips(.toolbar.save)    {Save main window contents to file}
323
    set help_tips(.toolbar.filter)  {Filter main window contents (Ctrl+H)}
324
    set help_tips(.toolbar.newnet)  {Set up a network}
325
    set help_tips(.toolbar.step)    {Execute one event (F4)}
326
    set help_tips(.toolbar.run)     {Run with full animation (F5)}
327
    set help_tips(.toolbar.fastrun) {Run faster: no animation and rare inspector updates (F6)}
328
    set help_tips(.toolbar.exprrun) {Run at full speed: no text output, animation or inspector updates (F7)}
329
    set help_tips(.toolbar.until)   {Run until time or event number}
330
    set help_tips(.toolbar.stop)    {Stop running simulation (F8)}
331
    set help_tips(.toolbar.restart) {Rebuild network}
332
    set help_tips(.toolbar.eventlog) {Eventlog recording on/off}
333
    set help_tips(.toolbar.finish)  {Call finish()}
334
    set help_tips(.toolbar.network) {Inspect network}
335
    set help_tips(.toolbar.objs)    {Find and inspect modules, messages, queues and other objects (Ctrl+S)}
336
    set help_tips(.toolbar.tline)   {Show/hide timeline}
337
    set help_tips(.toolbar.tree)    {Show/hide object tree}
338
    set help_tips(.toolbar.options) {Simulation options}
339
340
    #################################
341
    # Create status bars
342
    #################################
343
344
    frame .statusbar
345
    frame .statusbar2
346
    frame .statusbar3
347
348
    canvas .timeline -borderwidth 2 -relief groove -height 40
349
    bind .timeline <Configure> "redraw_timeline"
350
    .timeline bind msg <Double-1> "timeline_dblclick .timeline"
351
    .timeline bind msgname <Double-1> "timeline_dblclick .timeline"
352
    .timeline bind msg <$B3> "timeline_rightclick .timeline %X %Y %x %y"
353
    .timeline bind msgname <$B3> "timeline_rightclick .timeline %X %Y %x %y"
354
    bind .timeline <Button-$B3> {timeline_popup %x %y %X %Y}
355
356
    set widgets(timeline) .timeline
357
358
    label .statusbar.networklabel \
359
        -relief groove -text {(no network set up)} -width 18 -anchor w -font $fonts(normal)
360
    label .statusbar.eventlabel \
361
        -relief groove -text {Event #0} -width 15  -anchor w -font $fonts(normal)
362
    label .statusbar.timelabel \
363
        -relief groove -text {T=0.0000000 (0.00s)} -width 20 -anchor w -font $fonts(normal)
364
    label .statusbar.nextlabel \
365
        -relief groove -text {Next:} -width 23 -anchor w -font $fonts(normal)
366
367
    label .statusbar2.feslength \
368
        -relief groove -text {Msgs scheduled: 0} -width 20 -anchor w -font $fonts(normal)
369
    label .statusbar2.totalmsgs \
370
        -relief groove -text {Msgs created: 0} -width 20 -anchor w -font $fonts(normal)
371
    label .statusbar2.livemsgs \
372
        -relief groove -text {Msgs present: 0} -width 20 -anchor w -font $fonts(normal)
373
374
    label .statusbar3.eventspersec \
375
        -relief groove -text {Ev/sec: n/a} -width 15 -anchor w -font $fonts(normal)
376
    label .statusbar3.simsecpersec \
377
        -relief groove -text {Simsec/sec: n/a} -width 22 -anchor w -font $fonts(normal)
378
    label .statusbar3.eventspersimsec \
379
        -relief groove -text {Ev/simsec: n/a} -width 18 -anchor w -font $fonts(normal)
380
381
    pack .statusbar.networklabel -anchor n -expand 1 -fill x -side left
382
    pack .statusbar.eventlabel -anchor n -expand 1 -fill x -side left
383
    pack .statusbar.timelabel -anchor n -expand 1 -fill x -side left
384
    pack .statusbar.nextlabel -anchor n -expand 1 -fill x -side right
385
386
    pack .statusbar2.feslength -anchor n -expand 1 -fill x -side left
387
    pack .statusbar2.totalmsgs -anchor n -expand 1 -fill x -side left
388
    pack .statusbar2.livemsgs -anchor n -expand 1 -fill x -side left
389
390
    pack .statusbar3.eventspersec -anchor n -expand 1 -fill x -side left
391
    pack .statusbar3.simsecpersec -anchor n -expand 1 -fill x -side left
392
    pack .statusbar3.eventspersimsec -anchor n -expand 1 -fill x -side left
393
394
    set help_tips(.statusbar.networklabel)  {Network currently set up for execution}
395
    set help_tips(.statusbar.eventlabel)    {Sequence number of next event}
396
    set help_tips(.statusbar.timelabel)     {Simulation time of next event)}
397
    set help_tips(.statusbar.nextlabel)     {Module where next event will occur}
398
399
    set help_tips(.statusbar2.feslength)    {Number of events (messages) currently scheduled}
400
    set help_tips(.statusbar2.totalmsgs)    {Total number of messages created since start of the simulation}
401
    set help_tips(.statusbar2.livemsgs)     {Number of existing message objects, including scheduled ones}
402
403
    set help_tips(.statusbar3.eventspersec)    {Performance: events processed per second}
404
    set help_tips(.statusbar3.simsecpersec)    {Relative speed: simulated seconds processed per second}
405
    set help_tips(.statusbar3.eventspersimsec) {Event density: events per simulated second}
406
407
408
    #################################
409
    # Create main display area
410
    #################################
411
    frame .main -borderwidth 1 -height 30 -relief sunken -width 30
412
413
    #
414
    # Create manager (vert. tree view)
415
    #
416
    frame .main.mgr -relief flat -borderwidth 1
417
418
    vertResizeBar .main.mgr.resize .main.mgr.tree
419
420
    canvas .main.mgr.tree -width 140 -bg #ffffe0 -bd 0 -yscrollcommand ".main.mgr.sb set"
421
    scrollbar .main.mgr.sb -command ".main.mgr.tree yview"
422
    pack .main.mgr.resize -side right -fill y
423
    pack .main.mgr.sb -side right -fill y
424
    pack .main.mgr.tree -side left -fill y -padx 0 -pady 0 -ipadx 0 -ipady 0
425
426
    set widgets(manager) .main.mgr
427
    initTreeManager
428
    pack .main.mgr -anchor center -expand 0 -fill y  -side left
429
430
    if {$config(display-treeview)==0} {
431
        .toolbar.tree config -relief flat
432
    } else {
433
        .toolbar.tree config -relief sunken
434
    }
435
436
    if {$config(display-timeline)==0} {
437
        .toolbar.tline config -relief flat
438
    } else {
439
        .toolbar.tline config -relief sunken
440
    }
441
442
    #
443
    # Create main text window
444
    #
445
    text .main.text -yscrollcommand ".main.sb set" -font $fonts(text)
446
    scrollbar .main.sb -command ".main.text yview"
447
    logtextwidget_configuretags .main.text
448
449
    pack .main.sb -anchor center -expand 0 -fill y  -side right
450
    pack .main.text -anchor center -expand 1 -fill both -side right
451
452
    #################################
453
    # Pack everything
454
    #################################
455
    pack .toolbar    -anchor center -expand 0 -fill x -side top
456
    pack .statusbar  -anchor center -expand 0 -fill x -side top
457
    pack .statusbar2 -anchor center -expand 0 -fill x -side top
458
    pack .statusbar3 -anchor center -expand 0 -fill x -side top
459
    pack .timeline   -anchor center -expand 0 -fill x -side top
460
    pack .main       -anchor center -expand 1 -fill both -side top
461
462
    focus .main.text
463
464
    ###############################
465
    # Hotkeys
466
    ###############################
467
    bind_commands_to_textwidget .main.text mainwindow
468
    bind_runcommands .
469
    bind_othercommands .
470
}
471
472
proc bind_runcommands {w} {
473
    bind $w <F4> {one_step}
474
    bind $w <F5> {run_normal}
475
    bind $w <F6> {run_fast}
476
    bind $w <F7> {run_express}
477
    bind $w <F8> {stop_simulation}
478
}
479
480
proc bind_othercommands {w} {
481
    bind $w <Control-s> [list inspect_filteredobjectlist $w]
482
    bind $w <Control-S> [list inspect_filteredobjectlist $w]
483
}
484
485
# note: modptr may be "systemmodule" or a pointer; "" means no module
486
proc bind_commands_to_textwidget {txt {wintype ""}} {
487
    global config B2 B3
488
489
    # bindings for find
490
    #   'break' is needed below because
491
    #      ^F is originally bound to 1 char right
492
    #      ^N is originally bound to 1 line down
493
    bind $txt <Key> {%W tag remove SELECT 0.0 end}
494
    bind $txt <Control-f> {findDialog %W; break}
495
    bind $txt <Control-F> {findDialog %W; break}
496
    bind $txt <Control-n> {findNext %W; break}
497
    bind $txt <Control-N> {findNext %W; break}
498
    bind $txt <F3> {findNext %W}
499
    if {$wintype=="modulewindow"} {
500
        # bind Ctrl+H ('break' is needed because originally ^H is bound to DEL)
501
        set w [winfo toplevel $txt]
502
        bind $txt <Control-h> "modulewindow_filterdialog %W; break"
503
        bind $txt <Control-H> "modulewindow_filterdialog %W; break"
504
    }
505
    if {$wintype=="mainwindow"} {
506
        # bind Ctrl+H ('break' is needed because originally ^H is bound to DEL)
507
        bind $txt <Control-h> "mainlogwindow_filterdialog; break"
508
        bind $txt <Control-H> "mainlogwindow_filterdialog; break"
509
    }
510
511
    # bind Ctrl+A "Select all" ('break' is needed below because ^A=Home)
512
    bind $txt <Control-a> {%W tag add sel 1.0 end; break}
513
514
    # bind a context menu as well
515
    catch {$txt config -wrap $config(editor-wrap)}
516
    bind $txt <Button-$B3> [list textwidget_contextmenu %W $wintype %X %Y]
517
}
518
519
#===================================================================
520
#    LOAD BITMAPS
521
#===================================================================
522
523
set bitmap_ctr 0
524
525
proc load_bitmaps {path} {
526
   global tcl_platform bitmaps bitmap_ctr
527
528
   # On Windows, we use ";" to separate directories in $path. Using ":" (the
529
   # Unix separator) would cause trouble with dirs containing drive letter
530
   # (like "c:\bitmaps"). Using a space is also not an option (think of
531
   # "C:\Program Files\...").
532
533
   if {$tcl_platform(platform) == "unix"} {
534
       set sep {:;}
535
   } else {
536
       set sep {;}
537
   }
538
539
   foreach dir [split $path $sep] {
540
       if {$dir!=""} {
541
           puts -nonewline "Loading images from $dir: "
542
           do_load_bitmaps $dir ""
543
           puts ""
544
       }
545
   }
546
547
   if {$bitmap_ctr==0} {
548
       puts "*** no images (gif) in $path"
549
   }
550
551
   puts ""
552
}
553
554
proc do_load_bitmaps {dir prefix} {
555
   global bitmaps bitmap_ctr
556
557
   #debug "entering $dir"
558
   set files [concat [glob -nocomplain -- [file join $dir {*.gif}]] \
559
                     [glob -nocomplain -- [file join $dir {*.png}]]]
560
561
   # load bitmaps from this directory
562
   set n 0
563
   foreach f $files {
564
      set name [file tail [file rootname $f]]
565
      set img "i[incr bitmap_ctr]$name"
566
      if [catch {
567
         image create photo $img -file $f
568
         set size "n" ;#default
569
         regexp -- {^(.*)_(vl|xl|l|n|s|vs|xs)$} $name dummy name size
570
         do_add_bitmap $img $prefix $name $size
571
         incr n
572
      } err] {
573
         puts -nonewline "(*** cannot load $f: $err ***) "
574
      }
575
   }
576
   puts -nonewline "$prefix*: $n  "
577
578
   # recurse into subdirs
579
   foreach f [glob -nocomplain -- [file join $dir {*}]] {
580
      if {[file isdirectory $f] && [file tail $f]!="CVS"} {
581
         do_load_bitmaps "$f" "$prefix[file tail $f]/"
582
      }
583
   }
584
}
585
586
587
# register loaded image
588
proc do_add_bitmap {img prefix name size} {
589
   global bitmaps
590
591
   # access via the s= display string option
592
   set bitmaps($prefix$name,$size) $img
593
594
   # access by the legacy way
595
   if {$size=="n"} {
596
       set bitmaps($prefix$name) $img
597
   } else {
598
       set bitmaps($prefix${name}_$size) $img
599
   }
600
}
601
602
603
#===================================================================
604
#    LOAD PLUGINS
605
#===================================================================
606
607
proc load_plugins {path} {
608
   global tcl_platform
609
610
   # On Windows, we use ";" to separate directories in $path. Using ":" (the
611
   # Unix separator) would cause trouble with dirs containing drive letter
612
   # (like "c:\bitmaps"). Using a space is also not an option (think of
613
   # "C:\Program Files\...").
614
   #
615
   # We'd ever wanted to read plugins relative to the executable,
616
   # its path is available via [info nameofexecutable].
617
618
   if {$tcl_platform(platform) == "unix"} {
619
       set dllpattern "*.so*"
620
       set sep {:;}
621
   } else {
622
       set dllpattern "*.dll"
623
       set sep {;}
624
   }
625
626
   puts "Plugin path: $path"
627
628
   set tclfiles 0
629
   set dllfiles 0
630
   foreach dir [split $path $sep] {
631
632
      # load tcl files
633
      set files [lsort [glob -nocomplain -- [file join $dir {*.tcl}]]]
634
      incr tclfiles [llength $files]
635
      if {[llength $files]!=0} {
636
          puts -nonewline "Loading tcl files from $dir: "
637
          foreach file $files {
638
             if [catch {source $file} errmsg] {
639
                 puts ""
640
                 puts "*** error sourcing $file: $errmsg"
641
             } else {
642
                 set name [file tail $file]
643
                 puts -nonewline "$name "
644
             }
645
          }
646
         puts ""
647
      }
648
649
      # load dynamic libraries
650
      set files [lsort [glob -nocomplain -- [file join $dir $dllpattern]]]
651
      incr dllfiles [llength $files]
652
      if {[llength $files]!=0} {
653
          puts -nonewline "Loading so/dll files from $dir: "
654
          foreach file $files {
655
             if [catch {opp_loadlib $file} errmsg] {
656
                 puts ""
657
                 puts "*** error loading shared library $file: $errmsg"
658
             } else {
659
                 set name [file tail $file]
660
                 puts -nonewline "$name "
661
             }
662
          }
663
          puts ""
664
      }
665
   }
666
}
667
668
#===================================================================
669
#    GENERIC BINDINGS
670
#===================================================================
671
672
proc generic_bindings {} {
673
    global help_tips
674
    set help_tips(helptip_proc) get_help_tip
675
    set help_tips(width) 500
676
677
    bind Button <Return> {%W invoke}
678
}
679
680
proc startup_commands {} {
681
    set configname [opp_getsimoption default_config]
682
    set runnumber [opp_getsimoption default_run]
683
684
    # if no configname is specified but there's only one ("General"),
685
    # and it also contains a network, use that without a question.
686
    if {$configname==""} {
687
        set confignames [opp_getconfignames]
688
        set cfgnetworkname [opp_getvaluefromconfig "network"]  ;# CFGID_NETWORK
689
        if {($confignames=={General} && $cfgnetworkname!="")} {
690
            set configname "General"
691
        }
692
    }
693
694
    if {$configname != ""} {
695
        # set up the selected config and run number
696
        opp_newrun $configname $runnumber
697
        reflect_record_eventlog
698
        if [opp_isnotnull [opp_object_systemmodule]] {
699
            opp_inspect [opp_object_systemmodule] "(default)"
700
            notifyPlugins newNetwork
701
        }
702
    } else {
703
        # ask the user to select a network or a config
704
        if {$confignames=={} || $confignames=={General}} {
705
            new_network
706
        } else {
707
            new_run
708
        }
709
    }
710
}
711
712
#===================================================================
713
#  Utility functions
714
#===================================================================
715
proc busy {{msg {}}} {
716
    if {$msg != ""} {
717
        #$statusbar.mode config -text $msg
718
        # note: next 2 lines are useless (on Windows at least)
719
        . config -cursor watch
720
        update idletasks
721
    } else {
722
        #$statusbar.mode config -text "Ready"
723
        . config -cursor ""
724
        update idletasks
725
    }
726
}
727
728
#===================================================================
729
#
730
# Plugin "API":
731
#
732
#===================================================================
733
proc registerPlugin {pluginname} {
734
    global pluginlist
735
    lappend pluginlist $pluginname
736
    #debug "registered plugin \"$pluginname\""
737
}
738
739
proc notifyPlugins {command args} {
740
    global pluginlist
741
    foreach pluginname $pluginlist {
742
        #debug "invoking plugin callback $pluginname:$command"
743
        eval $pluginname:$command $args
744
    }
745
}