displays.tcl

MPICH是MPI的重要研究,提供了一系列的接口函数,为并行计算的实现提供了编程环境.

#
# Generic display-handling stuff for Upshot
#
# Ed Karrels
# Argonne National Laboratory
#

# display() structure:
#  static members:
#  _list - list of display types, like {Timelines {Mountain Ranges}}
#  <name> - the command for creating displays of this name.  For example,
#           set {display(Mountain Ranges)} mtn
#
#  nonstatic members:
#  mainwin - name of the main window this is in
#  list - list of current displays, in order top to bottom
#  log - command for the logfile to which these displays are attached
#  timevar - global variable to set to show what time the cursor is over
#  setzoomptcmd - command to which a new zoom point can be appended to
#                 set the point at which all displays will zoom
#  maxheight - maximum height for each display
#  scan - command to which a new left edge time (xleft) will be appended
#         so any display can order the other displays to scroll (scanning)
#  spclist - list of spacer bars that are packed after their corresponding
#            display.  The last display will not have a corresponding spacer.
#
#
# display widget required commands:
#   name - descriptive name for the widget
#          i.e. "Timelines", "Mountain Range"
#

source $progdir/common.tcl
source $progdir/args.tcl


#
# Initialize the display database
#
proc Display_Init {} {
   global display

   set display(_list) {}
}


#
# Add a display type to the display database
#

   # Each display registration must provide:
   #   1. A formal name for the diplay type, i.e. "Timelines".
   #      The formal name should not start with an underscore.
   #   2. A widget creation command.  The creation command must
   #      recognize the following options:
   #
   #         -width <width>
   #            width to request
   #         -maxheight <height>
   #            maximum height to request
   #         -timevar <varname>
   #            global variable to set representing what point in time
   #            the cursor is over
   #         -setzoomptcmd <cmd>
   #            command to execute if a new horizontal zoom point is
   #            selected.  Append the new zoom point to the command,
   #            in seconds.
   #         -scan <cmd>
   #            command to execute if this widget is personally dragged
   #            (change of view, but not by the scrollbar).  It sends
   #            the 'setleft' command to the scrollbars and every display
   #            including this one.
   #
   #      Oh, and the first two arguments to any display widget creation
   #      command will be the window to create and the logfile widget to
   #      attach to.
   #

proc Display_Register {name command} {
   global display

   if ![info exists display(_list)] {
      error "Displays not initialized (call Display_Init)"
   }

   set i [lsearch -exact $display(_list) $name]
   if {$i == -1} {
      lappend display(_list) $name
      set display(_list) [lsort $display(_list)]
      set display($name) $command
   }
}


#
# Get an alphabetized list of the display types in the display database
#
proc Display_Types {} {
   global display

   if ![info exists display(_list)] {
      error "Displays not initialized.  Call Display_Init and\
	    register some display types with Display_Register first."
   }

   return $display(_list)
}


#
# Get the command for creating the given display type
#
proc Display_Cmd {type} {
   global display

   if ![info exists display(_list)] {
      error "Displays not initialized.  Call Display_Init and\
	    register some display types with Display_Register first."
   }

   if {[lsearch -exact $display(_list) $type] == -1} {
      error "$type -- unrecognized display type"
   } else {
      return $display($type)
   }
}


#
# Create a new display widget
#
# win - window to create
# log - command for the logfile that all the displays within this widget
#       will be accessing
proc display {win mainwin log args} {
   global display

   frame $win
   display_config $win $args

   set display($win,mainwin) $mainwin
   set display($win,list) {}
   set display($win,spclist) {}
   set display($win,log) $log

      # rename the command that the frame I usurped created
   rename $win $win.frame_cmd
   proc $win {cmd args} "return \[eval display_cmd $win \$cmd \$args]"

      # the frame will destroy my command, I might as well return the favor
   bind $win <Destroy> "rename $win.frame_cmd {}"
}



#
# grab the command line options and store them
#
proc display_config {win arg_list} {
   global display

   # if the option is not found, ArgOpt will not touch the variable

   set display($win,timevar) ""
   ArgOpt arg_list -timevar display($win,timevar)

   set display($win,setzoomptcmd) ""
   ArgOpt arg_list -setzoomptcmd display($win,setzoomptcmd)

   set display($win,maxheight) ""
   ArgOpt arg_list -maxheight display($win,maxheight)

   set display($win,scan) ""
   ArgOpt arg_list -scan display($win,scan)
}



proc display_cmd {win cmd args} {
   global display

   switch $cmd {
      add {
	 return [eval display_add $win $args]
      }
      list {
	 return $display($win,list)
      }
      config {
	 return [eval $win.frame_cmd config $args]
      }
      default {
	 error "unrecognized command \"$cmd\" sent to display widget"
      }
   }
}



#
# Add a new display to a main window
#
# win - prefix for this display widget
# type - type of display, i.e. "Timelines", "Mountain Range"
# idx - where to insert this display.  $idx<=0 inserts at the top,
#       'end' adds to the end
# opts - a string of options to be sent to the new display
#
proc display_add {win type idx opts} {
   global display

   if ![info exists display($win,list)] {
      error "$win is not a display widget. :-("
   }

   if {$idx != "end" && ![is_int $idx]} {
      error "$idx is not an integer.  I want an integer.  Gimme an integer."
   }

   if {$display($win,timevar) != ""} {
      lappend opts -timevar $display($win,timevar)
   }
   if {$display($win,setzoomptcmd) != ""} {
      lappend opts -setzoomptcmd $display($win,setzoomptcmd)
   }
   if {$display($win,maxheight) != ""} {
      lappend opts -maxheight $display($win,maxheight)
   }
   if {$display($win,scan) != ""} {
      lappend opts -scan $display($win,scan)
   }

   set new_win $win.[GetUniqueWindowID]

      # if this is the first display to be added, it doesn't need
      # a spacer
   if {$display($win,list) == ""} {
      set spc_win ""
   } else {
      set spc_win $win.[GetUniqueWindowID]
         # create a spacer bar
      display_spacer $win $spc_win
   }

      # create the new display
   # puts "eval [Display_Cmd $type] $new_win $display($win,log) $opts"
   eval [Display_Cmd $type] $new_win $display($win,log) $opts

      # give the new display an initial scroll position
   set w $display($win,mainwin)
   global mainwin
   $new_win setview $mainwin($w,left) $mainwin($w,span)
   
   if {$idx < 0} {
      set idx 0
   } elseif {$idx >= [llength $display($win,list)]} {
      set idx end
   }

   if {$display($win,list) == ""} {
         # first display to be added, just stick it in
      pack $new_win -expand 1 -fill both
   } elseif {$idx == "end"} {
         # simply added to the end, packing the spacer first 
      pack $spc_win -fill x
      pack $new_win -expand 1 -fill both
   } else {
         # pack this window and spacer before a certain other display
      set before [lindex $display($win,list) $idx]
      pack $new_win -expand 1 -fill both -before $before
      pack $spc_win -fill x -before $before
   }
      
   # the spclist will always one shorter than 'list'; it is a list
   # of the window names of the spacer after the corresponding
   # window named in 'list'.

   if {$idx == "end"} {
      if {$spc_win != ""} {
	 lappend display($win,spclist) $spc_win
      }
      lappend display($win,list) $new_win
   } else {
      if {$spc_win != ""} {
	 set display($win,spclist) [linsert $display($win,spclist) \
	       $idx $spc_win]
      }
      set display($win,list) [linsert $display($win,list) $idx $new_win]
   }

   return $new_win
}



#
# Move (by changing the packing order) a display
#
proc display_move {win fromidx toidx} {
   global display

   if {[llength $display($win,list)] < 2} {
         # well, geez, there is only one or no displays, trying to move
         # it would be silly
      return
   }
   
   if {$toidx != "end" && ![is_int $toidx]} {
      error "$toidx is not an integer.  I want an integer.  Gimme an integer."
   }

   if {$toidx < 0} {
      set idx 0
   }

   set ndisplays [llength $display($win,list)]
   if {$toidx >= $ndisplays} {
      set toidx end
   }

   if {![is_int $fromidx] || $fromidx < 0 || $fromidx >= $ndisplays} {
      error "invalid 'from' index -- $fromidx"
   }

      # save the window name of the display before which the mobile
      # one will be packed
   if {$toidx != "end"} {
      set todisp [lindex $display($win,list) $toidx]
   }

      # save the window name of the display to be moved
   set fromdisp [lindex $display($win,list) $fromidx]
      # remove it from the main list of displays
   set display($win,list) [lreplace $display($win,list) $fromidx $fromidx]

      # remove the spacer from the mail spacer list
   if {$fromidx == $ndisplays - 1} {
      set spcidx [expr $fromidx - 1]
         # if this is the last display, grab the preceding spacer
      set fromspc [lindex $display($win,spclist) $spcidx]
      set display($win,spclist) [lreplace $display($win,spclist) \
	    $spcidx $spcidx]
   } else {
         # for any other display, grab the following spacer
      set fromspc [lindex $display($win,spclist) $fromidx]
      set display($win,spclist) [lreplace $display($win,spclist) \
	    $fromidx $fromidx]
   }

      # suck out the display and spacer to be removed
   pack forget $fromdisp $fromspc

      # repack the display and spacer where they belong
   if {$toidx == "end"} {
         # tack it onto the end
      pack $fromspc -fill x
      pack $fromdisp -expand 1 -fill both
      lappend display($win,list) $fromdisp
      lappend display($win,spclist) $fromspc

   } else {
      pack $fromdisp -expand 1 -fill both -before $todisp
      pack $fromspc -fill x -before $todisp
      set display($win,list) [linsert $display($win,list) $toidx $fromdisp]
      set display($win,spclist) [linsert $display($win,spclist) \
	    $toidx $fromspc]
   }
}


#
# Remove a display from a main window
#
#  win - win display window
#  idx - index of display to remove
#
proc display_remove {win idx} {
   global display

   set displist $display($win,list)
   if {$idx < 0 || $idx >= [llength $displist]} {
      error "invalid index"
   }

      # get the window name for the display to be removed
   set win_name [lindex $displist $idx]
      # destroy the window
   destroy $win_name

      # close the neighboring spacer if necessary

      # if this is the only display, don't worry about the spacer
   if {[llength $displist] != 1}  {
      if {$idx == [llength $displist]-1} {
            # if this is the last display, remove the preceding spacer
	 set spcidx [expr $idx-1]
      } else {
	    # for any other display, remove the following spacer
	 set spcidx $idx
      }