Statistics
| Branch: | Revision:

root / src / tkenv / animate.tcl @ fbe00e73

History | View | Annotate | Download (12 KB)

1
#=================================================================
2
#  ANIMATE.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(animjobs) {}
17

    
18
#
19
# Called from C++ code. $mode="beg"/"thru"/"end".
20
#
21
proc graphmodwin_animate_on_conn {win msgptr gateptr mode} {
22
    global config tkenv
23
    # Note on $mode!="end" condition: "end" equals to delivery of msg to
24
    # the module. It is called *before* processing the event, so it must be
25
    # animated immediately, regardless of $config(concurrent-anim).
26
    if {$mode!="end" && $config(concurrent-anim)} {
27
        # if concurrent-anim is ON, we just store the params here, and will execute inside perform_animations.
28
        lappend tkenv(animjobs) [list on_conn $win $msgptr $gateptr $mode]
29
        return
30
    }
31

    
32
    set c $win.c
33

    
34
    # gate pointer string is the tag of the connection arrow
35
    set coords [$c coords $gateptr]
36

    
37
    if {$coords == ""} {
38
        # connection arrow not (no longer?) on canvas: forget animation
39
        $c delete $msgptr;  # this also works if msg is not (yet) on canvas
40
        return;
41
    }
42

    
43
    setvars {x1 y1 x2 y2} $coords
44
    graphmodwin_do_animate $win $x1 $y1 $x2 $y2 $msgptr $mode
45

    
46
    if {$mode!="beg"} {
47
       $c delete $msgptr
48
    }
49
}
50

    
51

    
52
#
53
# Called from C++ code. $mode="beg"/"thru"/"end".
54
#
55
proc graphmodwin_animate_senddirect_horiz {win msgptr mod1ptr mod2ptr mode} {
56
    global config tkenv
57
    if {$config(concurrent-anim)} {
58
        # if concurrent-anim is ON, we just store the params here, and will execute inside perform_animations.
59
        lappend tkenv(animjobs) [list senddirect_horiz $win $msgptr $mod1ptr $mod2ptr $mode]
60
        return
61
    }
62

    
63
    set c $win.c
64
    set src  [get_submod_coords $c $mod1ptr]
65
    set dest [get_submod_coords $c $mod2ptr]
66

    
67
    set x1 [expr ([lindex $src 0]+[lindex $src 2])/2]
68
    set y1 [expr ([lindex $src 1]+[lindex $src 3])/2]
69
    set x2 [expr ([lindex $dest 0]+[lindex $dest 2])/2]
70
    set y2 [expr ([lindex $dest 1]+[lindex $dest 3])/2]
71

    
72
    graphmodwin_do_animate_senddirect $win $x1 $y1 $x2 $y2 $msgptr $mode
73
}
74

    
75

    
76
#
77
# Called from C++ code. $mode="beg"/"thru"/"end".
78
#
79
proc graphmodwin_animate_senddirect_ascent {win msgptr parentmodptr modptr mode} {
80
    global config tkenv
81
    if {$config(concurrent-anim)} {
82
        # if concurrent-anim is ON, we just store the params here, and will execute inside perform_animations.
83
        lappend tkenv(animjobs) [list senddirect_ascent $win $msgptr $parentmodptr $modptr $mode]
84
        return
85
    }
86

    
87
    set c $win.c
88
    set src  [get_submod_coords $c $modptr]
89

    
90
    set x1 [expr ([lindex $src 0]+[lindex $src 2])/2]
91
    set y1 [expr ([lindex $src 1]+[lindex $src 3])/2]
92
    set x2 [expr $x1 + $y1/4]
93
    set y2 0
94

    
95
    graphmodwin_do_animate_senddirect $win $x1 $y1 $x2 $y2 $msgptr $mode
96
}
97

    
98

    
99
#
100
# Called from C++ code. $mode="beg"/"thru"/"end".
101
#
102
proc graphmodwin_animate_senddirect_descent {win msgptr parentmodptr modptr mode} {
103
    global config tkenv
104
    if {$config(concurrent-anim)} {
105
        # if concurrent-anim is ON, we just store the params here, and will execute inside perform_animations.
106
        lappend tkenv(animjobs) [list senddirect_descent $win $msgptr $parentmodptr $modptr $mode]
107
        return
108
    }
109

    
110
    set c $win.c
111
    set dest [get_submod_coords $c $modptr]
112

    
113
    set x2 [expr ([lindex $dest 0]+[lindex $dest 2])/2]
114
    set y2 [expr ([lindex $dest 1]+[lindex $dest 3])/2]
115
    set x1 [expr $x2 - $y2/4]
116
    set y1 0
117

    
118
    graphmodwin_do_animate_senddirect $win $x1 $y1 $x2 $y2 $msgptr $mode
119
}
120

    
121

    
122
#
123
# Called from C++ code.
124
#
125
proc graphmodwin_animate_senddirect_delivery {win msgptr modptr} {
126
    # Note: delivery is called *before* processing the event, so it must be
127
    # animated immediately, regardless of $config(concurrent-anim).
128

    
129
    set c $win.c
130
    set src  [get_submod_coords $c $modptr]
131

    
132
    # flash the message a few times before removing it
133
    # WM_DELETE_WINDOW stuff: if user wants to close window (during "update"), postpone it until updateInspectors()
134
    set old_close_handler [wm protocol $win WM_DELETE_WINDOW]
135
    wm protocol $win WM_DELETE_WINDOW [list opp_markinspectorfordeletion $win]
136
    for {set i 0} {$i<3} {incr i} {
137
       $c itemconfig $msgptr -state hidden
138
       update
139
       anim_flashing_delay $win 0.05
140
       $c itemconfig $msgptr -state normal
141
       update
142
       anim_flashing_delay $win 0.05
143
    }
144
    wm protocol $win WM_DELETE_WINDOW $old_close_handler
145

    
146
    $c delete $msgptr
147
}
148

    
149
proc anim_flashing_delay {win d} {
150
    global clicksPerSec
151
    if {![opp_simulationisstopping] && ![opp_inspmarkedfordeletion $win]} {
152
        set tbeg [clock clicks]
153
        set sp [opp_getsimoption animation_speed]
154
        if {$sp>3} {set $sp 3}
155
        if {$sp<0} {set $sp 0}
156
        set clicks [expr (3-$sp)*$clicksPerSec*$d]
157
        while {[expr abs([clock clicks]-$tbeg)] < $clicks} {}
158
    }
159
}
160

    
161
#
162
# Helper for senddirect animations
163
#
164
proc graphmodwin_do_animate_senddirect {win x1 y1 x2 y2 msgptr mode} {
165
    set c $win.c
166

    
167
    if [opp_getsimoption senddirect_arrows] {
168
        #$c create line $x1 $y1 $x2 $y2 -tags {senddirect} -arrow last -fill gray
169
        $c create line $x1 $y1 $x2 $y2 -tags {senddirect} -arrow last -fill blue -dash {.}
170
        graphmodwin_do_animate $win $x1 $y1 $x2 $y2 $msgptr "thru"
171
        #$c delete $arrow -- this will come in _cleanup
172
    } else {
173
        graphmodwin_do_animate $win $x1 $y1 $x2 $y2 $msgptr "thru"
174
    }
175
    if {$mode!="beg"} {
176
       $c delete $msgptr
177
    }
178
}
179

    
180

    
181
#
182
# Ultimate helper function which in fact performs the animation.
183
#
184
proc graphmodwin_do_animate {win x1 y1 x2 y2 msgptr {mode thru}} {
185
    global fonts clicksPerSec
186
    set c $win.c
187

    
188
    # remove "phantom messages" if any
189
    $c delete $msgptr
190

    
191
    # msg will travel at constant speed: $steps proportional to length
192
    set len [expr sqrt(($x2-$x1)*($x2-$x1)+($y2-$y1)*($y2-$y1))]
193
    set steps [expr int($len/2)]
194

    
195
    # max 100 steps (otherwise animation takes forever!)
196
    if {$steps>100} {set steps 100}
197
    if {$steps==0} {set steps 1}
198

    
199
    if {$mode=="beg"} {
200
        set endpos [graphmodwin_getmessageendpos $x1 $y1 $x2 $y2]
201
        setvars {x2 y2} $endpos
202
    }
203
    if {$mode=="end"} {
204
        set endpos [graphmodwin_getmessageendpos $x1 $y1 $x2 $y2]
205
        setvars {x1 y1} $endpos
206
        set steps 6
207
    }
208

    
209
    draw_message $c $msgptr $x1 $y1
210

    
211
    set dx [expr ($x2-$x1)/double($steps)]
212
    set dy [expr ($y2-$y1)/double($steps)]
213

    
214
    # WM_DELETE_WINDOW stuff: if user wants to close window (during "update"), postpone it until updateInspectors()
215
    set old_close_handler [wm protocol $win WM_DELETE_WINDOW]
216
    wm protocol $win WM_DELETE_WINDOW [list opp_markinspectorfordeletion $win]
217
    for {set i 0} {$i<$steps} {incr i} {
218
       set tbeg [clock clicks]
219
       update
220
       $c move $msgptr $dx $dy
221
       if {![opp_simulationisstopping] && ![opp_inspmarkedfordeletion $win]} {
222
           set sp [opp_getsimoption animation_speed]
223
           if {$sp>3} {set $sp 3}
224
           if {$sp<0} {set $sp 0}
225
           # delay has the form of f(x) = c/(x-a)+b, where f(3)=0, f(1)=~1, f(0)=~6
226
           set d [expr 2/($sp+0.3)-0.6]
227
           set clicks [expr $d*$clicksPerSec*0.04]
228
           while {[expr abs([clock clicks]-$tbeg)] < $clicks} {}
229
       }
230
    }
231
    wm protocol $win WM_DELETE_WINDOW $old_close_handler
232
}
233

    
234
#
235
# This function is invoked from the module inspector C++ code.
236
# Removes all dashed arrows at the end of a senddirect animation.
237
#
238
proc graphmodwin_animate_senddirect_cleanup {win} {
239
    global config tkenv
240
    if {$config(concurrent-anim)} {
241
        # if concurrent-anim is ON, we just store the params here, and will execute inside perform_animations.
242
        lappend tkenv(animjobs) [list senddirect_cleanup $win]
243
        return
244
    }
245

    
246
    set c $win.c
247
    $c delete senddirect
248
}
249

    
250

    
251
# graphmodwin_animate_methodcall_ascent --
252
#
253
# This function is invoked from the module inspector C++ code.
254
#
255
proc graphmodwin_animate_methodcall_ascent {win parentmodptr modptr methodlabel} {
256
    set c $win.c
257
    set src  [get_submod_coords $c $modptr]
258

    
259
    set x1 [expr ([lindex $src 0]+[lindex $src 2])/2]
260
    set y1 [expr ([lindex $src 1]+[lindex $src 3])/2]
261
    set x2 [expr $x1 + $y1/4]
262
    set y2 0
263
    graphmodwin_do_draw_methodcall $win $x1 $y1 $x2 $y2 $methodlabel
264
}
265

    
266
# graphmodwin_animate_methodcall_descent --
267
#
268
# This function is invoked from the module inspector C++ code.
269
#
270
proc graphmodwin_animate_methodcall_descent {win parentmodptr modptr methodlabel} {
271
    set c $win.c
272
    set dest [get_submod_coords $c $modptr]
273

    
274
    set x2 [expr ([lindex $dest 0]+[lindex $dest 2])/2]
275
    set y2 [expr ([lindex $dest 1]+[lindex $dest 3])/2]
276
    set x1 [expr $x2 - $y2/4]
277
    set y1 0
278
    graphmodwin_do_draw_methodcall $win $x1 $y1 $x2 $y2 $methodlabel
279
}
280

    
281
# graphmodwin_animate_methodcall_horiz --
282
#
283
# This function is invoked from the module inspector C++ code.
284
#
285
proc graphmodwin_animate_methodcall_horiz {win fromptr toptr methodlabel} {
286
    set c $win.c
287
    set src  [get_submod_coords $c $fromptr]
288
    set dest [get_submod_coords $c $toptr]
289

    
290
    set x1 [expr ([lindex $src 0]+[lindex $src 2])/2]
291
    set y1 [expr ([lindex $src 1]+[lindex $src 3])/2]
292
    set x2 [expr ([lindex $dest 0]+[lindex $dest 2])/2]
293
    set y2 [expr ([lindex $dest 1]+[lindex $dest 3])/2]
294
    graphmodwin_do_draw_methodcall $win $x1 $y1 $x2 $y2 $methodlabel
295
}
296

    
297
# graphmodwin_do_draw_methodcall --
298
#
299
# Helper.
300
#
301
proc graphmodwin_do_draw_methodcall {win x1 y1 x2 y2 methodlabel} {
302

    
303
    set c $win.c
304
    #set arrow [$c create line $x1 $y1 $x2 $y2 -tags {methodcall} -width 2 -arrow last -arrowshape {15 20 6} -fill #808080]
305
    set arrow [$c create line $x1 $y1 $x2 $y2 -tags {methodcall}  -dash {-} -arrow last -fill red]
306

    
307
    set x [expr ($x1+$x2)/2]
308
    set y [expr ($y1+$y2)/2]
309
    set txtid  [$c create text $x $y -tags {methodcall} -text " $methodlabel " -anchor c]
310
    set color #F0F0F0
311
    #set color #F0F0D0
312
    #catch {set color [$c itemcget mod -fill]}
313
    set rectid [$c create rect [$c bbox $txtid] -tags {methodcall} -outline "" -fill $color]
314
    $c lower $rectid $txtid
315

    
316
    # flash arrow a bit
317
    # WM_DELETE_WINDOW stuff: if user wants to close window (during "update"), postpone it until updateInspectors()
318
    set old_close_handler [wm protocol $win WM_DELETE_WINDOW]
319
    wm protocol $win WM_DELETE_WINDOW [list opp_markinspectorfordeletion $win]
320
    for {set i 0} {$i<2} {incr i} {
321
       $c itemconfig $arrow -state hidden
322
       update
323
       anim_flashing_delay $win 0.3
324
       $c itemconfig $arrow -state normal
325
       update
326
       anim_flashing_delay $win 0.3
327
    }
328
    wm protocol $win WM_DELETE_WINDOW $old_close_handler
329
}
330

    
331
# graphmodwin_animate_methodcall_wait --
332
#
333
# This function is invoked from the module inspector C++ code.
334
#
335
proc graphmodwin_animate_methodcall_wait {} {
336
    update idletasks
337
    set d [opp_getsimoption methodcalls_delay]
338
    after $d
339
}
340

    
341
# graphmodwin_animate_methodcall_cleanup --
342
#
343
# This function is invoked from the module inspector C++ code.
344
#
345
proc graphmodwin_animate_methodcall_cleanup {win} {
346
    set c $win.c
347
    $c delete methodcall
348
}
349

    
350
proc determine_clocks_per_sec {} {
351
    global clicksPerSec
352

    
353
    # if counter wraps during measurement, try it again
354
    while 1 {
355
        set tbeg [clock clicks]
356
        after 200
357
        set tend [clock clicks]
358
        if [expr $tend>$tbeg] break;
359
    }
360
    set clicksPerSec [expr 5*($tend-$tbeg)]
361
    #puts "Ticks per second: $clicksPerSec"
362
}
363

    
364
proc animate2:move {c ball dx dy i} {
365
    $c move $ball $dx $dy
366
    update idletasks
367
    incr i -1
368
    if {$i>0} {
369
       after 10 "animate2:move $c $ball $dx $dy $i"
370
    } else {
371
       $c delete $ball
372
       global done$c$ball
373
       set done$c$ball 1
374
    }
375
}
376

    
377
#
378
# Called from C++ code
379
#
380
proc perform_animations {} {
381
    global config tkenv
382
    if {$config(concurrent-anim)} {
383
        do_concurrent_animations $tkenv(animjobs)
384
        set tkenv(animjobs) {}
385
    }
386
}
387

    
388