Statistics
| Branch: | Revision:

root / src / tkenv / timeline.tcl @ e1750c09

History | View | Annotate | Download (5.46 KB)

1
#=================================================================
2
#  TIMELINE.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
set tkenv(timeline-minexp) -1
17
set tkenv(timeline-maxexp) +1
18

    
19
proc redraw_timeline {} {
20
    global fonts tkenv config widgets
21

    
22
    # spare work if we're not displayed
23
    if {$config(display-timeline)==0} {return}
24

    
25
    set c $widgets(timeline)
26

    
27
    # sort the FES and adjust display range
28
    set minexp $tkenv(timeline-minexp)
29
    set maxexp $tkenv(timeline-maxexp)
30

    
31
    set fesrange [opp_sortfesandgetrange]
32
    set fesmin [lindex $fesrange 0]
33
    set fesmax [lindex $fesrange 1]
34
    if [expr $fesmin!=0 && $fesmax!=0] {
35
        set fesminexp [expr int(floor(log10($fesmin)))]
36
        set fesmaxexp [expr int(ceil(log10($fesmax)))]
37
        if {$fesminexp < $minexp && $fesminexp > -10} {set minexp $fesminexp}
38
        if {$fesmaxexp > $maxexp && $fesmaxexp < 10} {set maxexp $fesmaxexp}
39
    }
40
    set tkenv(timeline-minexp) $minexp
41
    set tkenv(timeline-maxexp) $maxexp
42

    
43
    # start drawing
44
    $c delete all
45

    
46
    # draw axis
47
    set w [winfo width $c]
48
    incr w -10
49
    $c create line 20 29 $w 29 -arrow last -fill black -width 1
50
    $c create text [expr $w+4] 30 -anchor ne -text "sec"
51

    
52
    # draw ticks
53
    set dx [expr $w/($maxexp-$minexp+1)]
54
    set x0 [expr int($dx/2)+15]
55
    set x $x0
56
    for {set i $minexp} {$i<=$maxexp} {incr i} {
57
        $c create line $x 26 $x 33 -fill black -width 1
58
        if {$i>=4} {
59
            set txt "1e$i"
60
        } elseif {$i>=0} {
61
           set txt "1[string repeat 0 $i]"
62
        } elseif {$i>=-3} {
63
           set txt "0.[string repeat 0 [expr -$i-1]]1"
64
        } else {
65
            set txt "1e$i"
66
        }
67
        $c create text $x 30 -anchor n -text "+$txt" -fill "#808080" -font $fonts(msgname)
68

    
69
        # minor ticks at 2, 4, 6, 8
70
        foreach tick {0.301 0.602 0.778 0.903} {
71
            set minorx [expr $x+int($tick*$dx)]
72
            $c create line $minorx 29 $minorx 32 -fill black -width 1
73
        }
74
        incr x $dx
75
    }
76

    
77
    # draw events
78
    set dtmin [expr 1e$minexp]
79
    set minlabelx -1000
80
    set minlabelx2 -1000
81
    set labelssuppressed 0
82
    set msgs [opp_fesmsgs $config(timeline-maxnumevents) \
83
                          $config(timeline-wantselfmsgs) \
84
                          $config(timeline-wantnonselfmsgs) \
85
                          $config(timeline-msgnamepattern) \
86
                          $config(timeline-msgclassnamepattern)]
87

    
88
    foreach msgptr $msgs {
89
        # calculate position
90
        set dt [opp_msgarrtimefromnow $msgptr]
91
        if {$dt < $dtmin} {
92
            set anchor "sw"
93
            set x 10
94
        } else {
95
            set anchor "s"
96
            set x [expr int($x0+(log10($dt)-$minexp)*$dx)]
97
        }
98

    
99
        # display ball
100
        if [opp_getsimoption animation_msgcolors] {
101
           set msgkind [opp_getobjectfield $msgptr kind]
102
           set color [lindex {red green blue white yellow cyan magenta black} [expr $msgkind % 8]]
103
        } else {
104
            set color red
105
        }
106
        set ball [$c create oval -2 -3 2 4 -fill $color -outline $color -tags "dx tooltip msg $msgptr"]
107
        $c move $ball $x 29
108

    
109
        # print msg name, if it's not too close to previous label
110
        # label for only those msgs past this label's right edge will be displayed
111
        set msglabel [opp_getobjectfullname $msgptr]
112
        if {$msglabel!=""} {
113
            set estlabelx [expr $x-3*[string length $msglabel]]
114
            if {$estlabelx>=$minlabelx} {
115
                set labelid [$c create text $x 27 -text $msglabel -anchor $anchor -font $fonts(msgname) -tags "dx tooltip msgname $msgptr"]
116
                set minlabelx [lindex [$c bbox $labelid] 2]
117
                set labelssuppressed 0
118
            } elseif {$estlabelx>=$minlabelx2} {
119
                set labelid [$c create text $x 17 -text $msglabel -anchor $anchor -font $fonts(msgname) -tags "dx tooltip msgname $msgptr"]
120
                $c create line $x 24 $x 14 -fill "#808080" -width 1 -tags "h"
121
                set minlabelx2 [lindex [$c bbox $labelid] 2]
122
                set labelssuppressed 0
123
            } else {
124
                incr labelssuppressed
125
                if {$labelssuppressed==1} {
126
                    $c insert $labelid end ",..."
127
                }
128
            }
129
        }
130
    }
131
    $c lower "h"
132
}
133

    
134

    
135
proc timeline_popup {cx cy x y} {
136
    global widgets
137
    set c $widgets(timeline)
138
    set ids [$c find overlapping $cx $cy $cx $cy]
139

    
140
    # only display popup menu if right-click was on an empty area
141
    if {$ids=={}} {
142
        catch {destroy .popup}
143
        menu .popup -tearoff 0
144
        .popup add command -label "Timeline options..." -command "options_dialog . t"
145
        tk_popup .popup $x $y
146
    }
147
}
148

    
149
proc timeline_dblclick c {
150
   set item [$c find withtag current]
151
   set tags [$c gettags $item]
152

    
153
   set ptr ""
154
   if {[lsearch $tags "ptr*"] != -1} {
155
      regexp "ptr.*" $tags ptr
156
   }
157

    
158
   if {$ptr!=""} {
159
      opp_inspect $ptr "(default)"
160
   }
161
}
162

    
163
proc timeline_rightclick {c X Y x y} {
164
   set ptrs [get_ptrs_under_mouse $c $x $y]
165
   if {$ptrs != {}} {
166
      set popup [create_inspector_contextmenu $ptrs]
167
      tk_popup $popup $X $Y
168
   }
169
}
170