annotation.tcl
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:6k
源码类别:

通讯编程

开发平台:

Visual C++

  1. #
  2. # Copyright (C) 1998 by USC/ISI
  3. # All rights reserved.                                            
  4. #                                                                
  5. # Redistribution and use in source and binary forms are permitted
  6. # provided that the above copyright notice and this paragraph are
  7. # duplicated in all such forms and that any documentation, advertising
  8. # materials, and other materials related to such distribution and use
  9. # acknowledge that the software was developed by the University of
  10. # Southern California, Information Sciences Institute.  The name of the
  11. # University may not be used to endorse or promote products derived from
  12. # this software without specific prior written permission.
  13. # THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
  14. # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
  15. # MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  16. # $Header: /cvsroot/nsnam/nam-1/tcl/annotation.tcl,v 1.4 1999/01/11 18:35:39 haoboy Exp $
  17. # popup an annotation command menu
  18. Animator instproc popup_annotation { w x y } {
  19. $self instvar annoBox running 
  20. $self stop 1
  21. catch {destroy $w.menuPopa}
  22. menu $w.menuPopa -relief groove -borderwidth 2
  23. $w.menuPopa add command -label "Command"
  24. $w.menuPopa add separator
  25. $w.menuPopa add command -label "Add" 
  26. -command "$self cmdAnnotationAdd $w $x $y"
  27. set index [$annoBox nearest $y]
  28. $w.menuPopa add command -label "Delete" 
  29. -command "$self cmdAnnotationDelete $index"
  30. $w.menuPopa add command -label "Info" 
  31. -command "$self cmdAnnotationInfo $w $index $x $y"
  32. set rx [winfo rootx $w]
  33. set ry [winfo rooty $w]
  34. set rx [expr $rx + $x]
  35. set ry [expr $ry + $y]
  36. tk_popup $w.menuPopa $rx $ry
  37. }
  38. # Insert a annotation *after* the annotation pointed to by the current click
  39. # Will prompt for an input string
  40. Animator instproc cmdAnnotationAdd { w x y } {
  41. $self instvar annoInputText now
  42. # Popup a frame to get input string
  43. catch { destroy .inputBox }
  44. set f [smallfont]
  45. toplevel .inputBox
  46. label .inputBox.title -text "New Annotation Text" -font $f
  47. set annoInputText ""
  48. entry .inputBox.input -width 40 -relief sunken 
  49. -textvariable annoInputText
  50. button .inputBox.done -text "Done" -borderwidth 2 -relief raised 
  51. -font $f 
  52. -command "add_annotation $now; catch {destroy .inputBox}"
  53. pack .inputBox.title -side top
  54. pack .inputBox.input -side top
  55. pack .inputBox.done -side top
  56. bind .inputBox.input <Return> 
  57. "add_annotation $now; catch { destroy .inputBox }"
  58. }
  59. Animator instproc cmdAnnotationDelete { index } {
  60. $self instvar annoBox annoTimeList
  61. $annoBox delete $index
  62. set annoTimeList [lreplace $annoTimeList $index $index]
  63. }
  64. Animator instproc cmdAnnotationInfo { w index x y } {
  65. $self instvar annoBox annoTimeList
  66. set str [$annoBox get $index]
  67. set lst [list "At time" [lindex $annoTimeList $index] ", $str"]
  68. set str [join $lst]
  69. # Since tk_messageBox is only available after 8.0, we make it
  70. # on our own.
  71. catch { destroy $w.mBox }
  72. set f [smallfont]
  73. frame $w.mBox -relief groove -borderwidth 2
  74. label $w.mBox.message -text $str -font $f
  75. button $w.mBox.done -text "Done" -borderwidth 2 -relief raised 
  76. -font $f 
  77. -command "catch { destroy $w.mBox }"
  78. pack $w.mBox.message
  79. pack $w.mBox.done
  80. place_frame $w $w.mBox $x $y
  81. }
  82. Animator instproc add_annotation { time } {
  83. $self instvar annoBox annoTimeList annoInputText
  84. #puts "Add annotation "$annoInputText" at time $time"
  85. set size [$annoBox size]
  86. for {set index 0} {$index < $size} {incr index} {
  87. if {[lindex $annoTimeList $index] > $time} {
  88. break
  89. }
  90. }
  91. if {$index == $size} {
  92. set index "end"
  93. }
  94. $annoBox insert $index "$annoInputText"
  95. if {$size == 0} {
  96. lappend annoTimeList $time
  97. } else {
  98. set annoTimeList [linsert $annoTimeList $index $time]
  99. }
  100. $annoBox see $index
  101. }
  102. # Can't use 'now'. Observed when sim_annotation gets executed, 'now' may not 
  103. # be exactly the desired time.
  104. Animator instproc sim_annotation { time seq args } {
  105. $self instvar annoBox annoTimeList annoBoxHeight regAnno
  106. # Only add annotation once and never delete them
  107. if ![info exists regAnno($seq)] {
  108. # insert when going forward
  109. $annoBox insert end "$args"
  110. set size [$annoBox size]
  111. set annoTimeList [lappend annoTimeList $time]
  112. set regAnno($seq) 1
  113. set d [expr $size-$annoBoxHeight]
  114. if {$d > 0} {
  115. $annoBox yview $d
  116. }
  117. # puts "At time $time, added $args"
  118. }
  119. }
  120. # Set center of annotation box to the current time
  121. Animator instproc update_annotations { time } {
  122. $self instvar annoBox annoTimeList annoBoxHeight direction annoJump
  123. set size [$annoBox size]
  124. if {($size == 0) || ($annoJump == 1)} {
  125. set annoJump 0
  126. return 
  127. }
  128. set i 0
  129. foreach l $annoTimeList {
  130. if {$l > $time} {
  131. break
  132. } else {
  133. incr i
  134. }
  135. }
  136. if {$direction != 1 && $i != 0} {
  137. incr i -1
  138. }
  139. if {$i < $annoBoxHeight/2} {
  140. set d 0
  141. } else {
  142. set d [expr $i - $annoBoxHeight / 2]
  143. }
  144. $annoBox yview $d
  145. $annoBox selection clear 0 $size
  146. $annoBox selection set $i $i
  147. }
  148. Animator instproc jump_to_annotation { anno } {
  149. $self instvar annoTimeList annoJump
  150. set idx [$anno index active]
  151. #puts "Jumping to time [lindex $annoTimeList $idx]"
  152. set annoJump 1
  153. $self settime [lindex $annoTimeList $idx]
  154. $self peer_cmd 1 "settime [lindex $annoTimeList $idx]"
  155. }
  156. #
  157. # The following functions are actually the functions used in the 'v' events 
  158. # in the nam traces
  159. # The 'v' events are generated by dynamic links (rtmodel). Whenever you have 
  160. # a nam trace which has dynamic link traces, you'll need to define the 
  161. # following functions.
  162. #
  163. Animator instproc link-up {now src dst} {
  164. $self sim_annotation $now link($src:$dst) up
  165. }
  166. Animator instproc link-down {now src dst} {
  167. $self sim_annotation $now link($src:$dst) down
  168. }
  169. Animator instproc node-up {now src} {
  170. $self sim_annotation $now $node $src up
  171. }
  172. Animator instproc node-down {now src} {
  173. $self sim_annotation $now $node $src down
  174. }