Statistics
| Branch: | Revision:

root / src / tkenv / gateinsp.tcl @ e1750c09

History | View | Annotate | Download (7.28 KB)

1
#=================================================================
2
#  GATEINSP.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
#-----------------------------------------------------------------
18
#  gate inspector
19
#-----------------------------------------------------------------
20
#
21
#proc create_gateinspector {name geom} {
22
#    global fonts icons help_tips
23
#
24
#    set w $name
25
#    create_inspector_toplevel $w $geom
26
#
27
#    set nb [inspector_createnotebook $w]
28
#
29
#    notebook_addpage $nb info {General}
30
#
31
#    inspector_createfields2page $w
32
#
33
#    label-entry $nb.info.name {Name:}
34
#    label-sunkenlabel $nb.info.id {Id:}
35
#    label-button $nb.info.from {From:}
36
#    label-button $nb.info.to {To:}
37
#    label-entry $nb.info.dispstr {Display string:}
38
#    label-entry $nb.info.delay {Delay:}
39
#    label-entry $nb.info.error {Error:}
40
#    label-entry $nb.info.datarate {Data rate:}
41
#    label-sunkenlabel $nb.info.trfinish {Tx finishes:}
42
#
43
#    pack $nb.info.name -fill x -side top
44
#    pack $nb.info.id -fill x -side top
45
#    pack $nb.info.from -fill x -side top
46
#    pack $nb.info.to -fill x -side top
47
#    pack $nb.info.dispstr -fill x -side top
48
#    pack $nb.info.delay -fill x -side top
49
#    pack $nb.info.error -fill x -side top
50
#    pack $nb.info.datarate -fill x -side top
51
#    pack $nb.info.trfinish -fill x -side top
52
#}
53

    
54

    
55
#-----------------------------------------------------------------
56
#  Graphical gate/path window stuff
57
#-----------------------------------------------------------------
58

    
59
proc create_graphicalgatewindow {name geom} {
60
    global icons help_tips inspectordata
61
    global B2 B3
62

    
63
    set w $name
64
    create_inspector_toplevel $w $geom
65

    
66
    # create toolbar
67
    pack_iconbutton $w.toolbar.ascont -image $icons(asobject) -command "inspect_this $w {As Object}"
68
    pack_iconbutton $w.toolbar.sep1   -separator
69
    pack_iconbutton $w.toolbar.redraw -image $icons(redraw) -command "opp_inspectorcommand $w redraw"
70

    
71
    set help_tips($w.toolbar.ascont) {Inspect as object}
72
    set help_tips($w.toolbar.redraw) {Redraw}
73

    
74
    # create canvas
75
    set c $w.c
76

    
77
    # init some state vars (not all of them fully used, e.g. zoomfactor is only
78
    # needed by some modinsp2.tcl procs we call from here)
79
    set inspectordata($c:zoomfactor) 1
80
    set inspectordata($c:imagesizefactor) 1
81
    set inspectordata($c:showlabels) 1
82
    set inspectordata($c:showarrowheads) 1
83

    
84
    frame $w.grid
85
    scrollbar $w.hsb -orient horiz -command "$c xview"
86
    scrollbar $w.vsb -command "$c yview"
87
    canvas $c -background #a0e0a0 -relief raised \
88
        -xscrollcommand "$w.hsb set" \
89
        -yscrollcommand "$w.vsb set"
90
    pack $w.grid -expand yes -fill both -padx 1 -pady 1
91
    grid rowconfig    $w.grid 0 -weight 1 -minsize 0
92
    grid columnconfig $w.grid 0 -weight 1 -minsize 0
93

    
94
    grid $c -in $w.grid -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
95
    grid $w.vsb -in $w.grid -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
96
    grid $w.hsb -in $w.grid -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
97

    
98
    # mouse bindings
99
    $c bind mod <Double-1> "graphgatewin_dblclick $c"
100
    $c bind gate <Double-1> "graphgatewin_dblclick $c {As Object}"
101
    $c bind conn <Double-1> "graphgatewin_dblclick $c {As Object}"
102
    $c bind msg <Double-1> "graphgatewin_dblclick $c"
103
    $c bind msgname <Double-1> "graphgatewin_dblclick $c"
104

    
105
    $c bind mod <$B3> "graphgatewin_rightclick $c %X %Y"
106
    $c bind gate <$B3> "graphgatewin_rightclick $c %X %Y"
107
    $c bind conn <$B3> "graphgatewin_rightclick $c %X %Y"
108
    $c bind msg <$B3> "graphgatewin_rightclick $c %X %Y"
109
    $c bind msgname <$B3> "graphgatewin_rightclick $c %X %Y"
110

    
111
    opp_inspectorcommand $w redraw
112
}
113

    
114

    
115
proc draw_module_gate {c modptr gateptr modname gatename k xsiz dir highlight} {
116

    
117
    # puts "DEBUG: draw_module_gate /$c/ /$modptr/ /$gateptr/ "
118
    #      "/$modname/ /$gatename/ /$k/ /$xsiz/ /$dir/ /$highlight/"
119

    
120
    set y [expr 40+40*$k]
121

    
122
    if {$xsiz<-1} {set xsiz -1.5}
123
    if {$xsiz>3} {set xsiz 3}
124
    set dx [expr ($xsiz+2) * 20]
125
    # set dy [expr ($xsiz+2) * 10]
126
    set dy 20
127

    
128
    if {$highlight} {
129
        set color yellow
130
    } else {
131
        set color white
132
    }
133

    
134
    if {$dir=="O"} {set dy [expr -$dy]}
135
    set mod1 [$c create polygon -$dx $dy -$dx $dy -$dx 0 $dx 0 $dx $dy $dx $dy \
136
                     -smooth 0 -width 2 \
137
                     -fill #c0c0ff \
138
                     -tags "tooltip mod $modptr"]
139
    set mod2 [$c create line -$dx $dy -$dx $dy -$dx 0 $dx 0 $dx $dy $dx $dy \
140
                     -smooth 0 -width 2 \
141
                     -fill black \
142
                     -tags "tooltip mod $modptr"]
143
    set gate [$c create rect -6 -6 6 6 -fill $color \
144
                             -width 2 -tags "tooltip gate $gateptr" ]
145

    
146
    if {$dir=="O"} {set anch "s"} else {set anch "n"}
147
    $c create text 72 $y -text $gatename -anchor "$anch\e"
148
    $c create text [expr 88+$dx] $y -text $modname -anchor "$anch\w"
149

    
150
    $c move $mod1 80 $y
151
    $c move $mod2 80 $y
152
    $c move $gate 80 $y
153

    
154
    # config canvas size and scrolling
155
    set bbox [$c bbox all]
156
    set cwidth [expr [lindex $bbox 2]-[lindex $bbox 0]+20]
157
    set cheight [expr [lindex $bbox 3]-[lindex $bbox 1]+20]
158
    $c config -width [expr $cwidth<500 ? $cwidth : 500]
159
    $c config -height [expr $cheight<400 ? $cheight : 400]
160
    $c config -scrollregion [list 0 0 $cwidth $cheight]
161

    
162
}
163

    
164
proc draw_conn {c srcgateptr destgateptr chanptr chanstr dispstr} {
165

    
166
    opp_displaystring $dispstr parse tags $chanptr 0
167

    
168
    if {![info exists tags(s)]} {set tags(s) {auto}}
169
    if {![info exists tags(d)]} {set tags(d) {auto}}
170

    
171
    set srcrect  [$c coords $srcgateptr]
172
    set destrect [$c coords $destgateptr]
173
    set y0 [lindex $srcrect 3]
174
    set y1 [lindex $destrect 1]
175
    set x  [expr ([lindex $destrect 0]+ [lindex $destrect 2])/2]
176

    
177
    if [catch {
178
       if {![info exists tags(o)]} {set tags(o) {}}
179
       set fill [lindex $tags(o) 0]
180
       if {$fill == ""} {set fill black}
181
       set width [lindex $tags(o) 1]
182
       if {$width == ""} {set width 2}
183

    
184
       $c create line $x $y0 $x $y1 -arrow last \
185
           -fill $fill -width $width -tags "tooltip conn $srcgateptr"
186

    
187
       $c create text [expr $x+3] [expr ($y0+$y1)/2] -text $chanstr -anchor w
188

    
189
   } errmsg] {
190
       tk_messageBox -type ok -title Error -icon error -parent [winfo toplevel [focus]] \
191
                     -message "Error in display string of a connection: $errmsg"
192
   }
193
}
194

    
195
proc graphgatewin_dblclick {c {type (default)}} {
196

    
197
   set item [$c find withtag current]
198
   set tags [$c gettags $item]
199

    
200
   set ptr ""
201
   if {[lsearch $tags "ptr*"] != -1} {
202
      regexp "ptr.*" $tags ptr
203
   }
204

    
205
   if {$ptr!=""} {
206
      opp_inspect $ptr $type
207
   }
208
}
209

    
210
proc graphgatewin_rightclick {c X Y} {
211

    
212
   set item [$c find withtag current]
213
   set tags [$c gettags $item]
214

    
215
   set ptr ""
216
   if {[lsearch $tags "ptr*"] != -1} {
217
      regexp "ptr.*" $tags ptr
218
   }
219
   set ptr [lindex $ptr 0]
220

    
221
   if [opp_isnotnull $ptr] {
222
      set popup [create_inspector_contextmenu $ptr]
223
      tk_popup $popup $X $Y
224
   }
225
}
226