Attached Files | bcast-anim.patch [^] (4,802 bytes) 2010-07-29 17:14 [Show Content] [Hide Content]diff --git a/src/tkenv/animate.tcl b/src/tkenv/animate.tcl
index a5707e0..830e04a 100644
--- a/src/tkenv/animate.tcl
+++ b/src/tkenv/animate.tcl
@@ -25,6 +25,7 @@ proc graphmodwin_animate_on_conn {win msgptr gateptr mode} {
# animated immediately, regardless of $config(concurrent-anim).
if {$mode!="end" && $config(concurrent-anim)} {
# if concurrent-anim is ON, we just store the params here, and will execute inside perform_animations.
+ anim_remember_msg $msgptr
lappend tkenv(animjobs) [list on_conn $win $msgptr $gateptr $mode]
return
}
@@ -56,6 +57,7 @@ proc graphmodwin_animate_senddirect_horiz {win msgptr mod1ptr mod2ptr mode} {
global config tkenv
if {$config(concurrent-anim)} {
# if concurrent-anim is ON, we just store the params here, and will execute inside perform_animations.
+ anim_remember_msg $msgptr
lappend tkenv(animjobs) [list senddirect_horiz $win $msgptr $mod1ptr $mod2ptr $mode]
return
}
@@ -80,6 +82,7 @@ proc graphmodwin_animate_senddirect_ascent {win msgptr parentmodptr modptr mode}
global config tkenv
if {$config(concurrent-anim)} {
# if concurrent-anim is ON, we just store the params here, and will execute inside perform_animations.
+ anim_remember_msg $msgptr
lappend tkenv(animjobs) [list senddirect_ascent $win $msgptr $parentmodptr $modptr $mode]
return
}
@@ -103,6 +106,7 @@ proc graphmodwin_animate_senddirect_descent {win msgptr parentmodptr modptr mode
global config tkenv
if {$config(concurrent-anim)} {
# if concurrent-anim is ON, we just store the params here, and will execute inside perform_animations.
+ anim_remember_msg $msgptr
lappend tkenv(animjobs) [list senddirect_descent $win $msgptr $parentmodptr $modptr $mode]
return
}
@@ -118,6 +122,20 @@ proc graphmodwin_animate_senddirect_descent {win msgptr parentmodptr modptr mode
graphmodwin_do_animate_senddirect $win $x1 $y1 $x2 $y2 $msgptr $mode
}
+#
+# Remember properties of the message so we can perform the "send" animation
+# even if the message object has been deleted by then
+#
+proc anim_remember_msg {msgptr} {
+ global anim_msg
+
+ if {![info exists anim_msg($msgptr:name)]} {
+ set anim_msg($msgptr:name) [opp_getobjectfullname $msgptr]
+ set anim_msg($msgptr:type) [opp_getobjectshorttypename $msgptr]
+ set anim_msg($msgptr:kind) [opp_getobjectfield $msgptr kind]
+ set anim_msg($msgptr:disp) [opp_getobjectfield $msgptr displayString]
+ }
+}
#
# Called from C++ code.
@@ -378,10 +396,11 @@ proc animate2:move {c ball dx dy i} {
# Called from C++ code
#
proc perform_animations {} {
- global config tkenv
+ global config tkenv anim_msg
if {$config(concurrent-anim)} {
do_concurrent_animations $tkenv(animjobs)
set tkenv(animjobs) {}
+ array unset anim_msg
}
}
diff --git a/src/tkenv/modinsp2.tcl b/src/tkenv/modinsp2.tcl
index fc72470..c458a9d 100644
--- a/src/tkenv/modinsp2.tcl
+++ b/src/tkenv/modinsp2.tcl
@@ -690,13 +690,22 @@ proc draw_connection {c gateptr dispstr srcptr destptr chanptr src_i src_n dest_
# This function is invoked from the message animation code.
#
proc draw_message {c msgptr x y} {
- global fonts inspectordata
+ global fonts inspectordata anim_msg
set zoomfactor $inspectordata($c:zoomfactor)
set imagesizefactor $inspectordata($c:imagesizefactor)
- set dispstr [opp_getobjectfield $msgptr displayString]
- set msgkind [opp_getobjectfield $msgptr kind]
+ if {[info exists anim_msg($msgptr:name)]} {
+ set msgname $anim_msg($msgptr:name)
+ set msgtype $anim_msg($msgptr:type)
+ set msgkind $anim_msg($msgptr:kind)
+ set dispstr $anim_msg($msgptr:disp)
+ } else {
+ set msgname [opp_getobjectfullname $msgptr]
+ set msgtype [opp_getobjectshorttypename $msgptr]
+ set msgkind [opp_getobjectfield $msgptr kind]
+ set dispstr [opp_getobjectfield $msgptr displayString]
+ }
if {$dispstr=="" && [opp_getsimoption penguin_mode]} {
# following lines were used for testing only...
@@ -795,10 +804,10 @@ proc draw_message {c msgptr x y} {
# display message label: "(classname)name"
set msglabel ""
if [opp_getsimoption animation_msgclassnames] {
- set msglabel "([opp_getobjectshorttypename $msgptr])"
+ set msglabel "($msgtype)"
}
if [opp_getsimoption animation_msgnames] {
- append msglabel "[opp_getobjectfullname $msgptr]"
+ append msglabel $msgname
}
if {$msglabel!=""} {
$c create text $labelx $labely -text $msglabel -anchor n -font $fonts(msgname) -tags "dx tooltip msgname $msgptr"
|