upshot.in

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

#! #wishloc# -f
#
# upshot in tcl/tk
# Written by Ed Karrels, with some code borrowed from Mario Jorge Silva
#

set bitmapdir #BITMAP_DIR#
set bitmaplist {gray gray3 gray2 vlines3 dllines4 drlines4 hlines3 2x2 boxes \
      dimple3 black white}
set colorlist {red blue green cyan yellow magenta orange3 maroon \
       gray25 gray75 purple4 darkgreen white black}
set defaultFile ~/.upshot.defaults
#
# Get the version.  If you KNOW the version, you can just do, e.g., 
#    set tk_version 4.1
# Remove the patch info from the patchLevel
if { $tk_version == ""} {
    set tk_version [ string range $tk_patchLevel 0 2 ] }
#set err [ catch { expr { #TK_VERSION# + 0 } } tk_version ]
#if { $err != 0 } { set tk_version 3.6 } 

proc SetGlobalVars {} {
   global reqWidth procWidth incDraw numDHashMarks numSHashMarks
   global ndigitsPrecD ndigitsPrecS tcl_precision programName
   global pageWidth pageHeight pageUnits barWidth maxOverlap

   set programName "upshot.tcl"
   set reqWidth   [GetDefault initial_timeline_window_width 700]
     # incremental drawing of time bars--slower, but more interesting
   set incDraw    [GetDefault incremental_timeline_drawing 0]
   set pageWidth  [GetDefault printed_width 7.5]
   set pageHeight [GetDefault printed_height 10]
   set pageUnits i
   set procWidth 25
   # distance between timelines

   # with of state bars
   # for overlapping states, first 16 wide, then 10, then 4, and hold at 4
   set barWidth(0) 8
   set barWidth(1) 5
   set barWidth(2) 2
   set maxOverlap 2

     # number of hash marks on static and dynamic scales
   set numDHashMarks 7
   set numSHashMarks 7
     # number of digits precision for each scale line
     # (# of digits to the right of decimal pt.)
   set ndigitsPrecD 3
   set ndigitsPrecS 3
   set tcl_precision 17
}

proc SetColors {} {
   global blackWhite color programName fg bg timelinebg timelinefg
   global pctDonefg pctDonebg arrowfg activebg

   # if no one else cares, set #colors automatically
   if {![info exists blackWhite]} {set blackWhite [expr \
	 "[winfo depth .] < 4"]}

   if {$blackWhite} {
      set fg black
      set bg white
      set timelinebg white
      set timelinefg black
      set activebg black
      set pctDonefg white
      set pctDonebg white
      set arrowfg black

      option add *background white
      option add *foreground black
      option add *selectForeground white
      option add *selectBackground black
      option add *activeForeground white
      option add *activeBackground $activebg

   } else {
      set fg Snow
      set bg SteelBlue
      set activebg SteelBlue2
      set timelinebg gray60
      set timelinefg red
      set pctDonefg red
      set pctDonebg steelblue
      set arrowfg black

      # Why doesn't GhostView like 'White' ?

      option add *foreground Snow
      option add *background SteelBlue
      option add *activeForeground Snow
      option add *activeBackground $activebg
   }
}


proc ProcessCmdLineArgs {} {
   global argv blackWhite logFileName

   foreach parameter $argv {
      if {$parameter == "-bw" } {
	 #black and white screen
	 set blackWhite 1
      } elseif {$parameter == "-c" } {
	 #color screen
	 set blackWhite 0
      } else {
	 set logFileName $parameter
      }
   }
}

bind Entry <Control-Key-e> {
   %W icursor end
}
bind Entry <Control-Key-a> {
   %W icursor 0
}
bind Entry <Control-Key-k> {
   %W delete insert end
}
bind Entry <Key-Left> {
   %W icursor [expr [%W index insert]-1]
}
bind Entry <Key-Right> {
   %W icursor [expr [%W index insert]+1]
}
bind Entry <Control-Key-b> {
   %W icursor [expr [%W index insert]-1]
}
bind Entry <Control-Key-f> {
   %W icursor [expr [%W index insert]+1]
}
bind Entry <Control-Key-d> {
   %W delete insert
}
bind Entry <Control-Key-space> {
   %W select from insert
}



proc GetDefault {index default} {
   global defaults defaultFile

   if ![info exists defaults($index)] {
      if [file readable $defaultFile] {
	 set fileHandle [open $defaultFile r]
	 while {[gets $fileHandle str]>=0} {
	    scan $str "%s %\[^\n\]" readIndex readValue
	    set defaults($readIndex) $readValue
	 }
	 close $fileHandle
      } else {
	 # puts "Cannot read $defaultFile"
	 return $default
      }	
      if [info exists defaults($index)] {
	 return $defaults($index)
      } else {
	 return $default
      }
   } else {
      return $defaults($index)
   }
}



proc UpdateDefaults {{newValueList {}}} {
      # use this function to update the list of defaults and write them
      # out to the file

   global defaults defaultFile

   set numValues [expr [llength $newValueList]/2]
   for {set i 0} {$i<$numValues} {incr i} {
      set defaults([lindex $newValueList [expr $i*2]]) \
	    [lindex $newValueList [expr $i*2+1]]
   }

      # if we have read rights to the file, read it
   if [file readable $defaultFile] {
      set fileHandle [open $defaultFile r]
      while {[gets $fileHandle str]>=0} {
	 scan $str "%s %s" readIndex readValue
	 if ![info exists defaults($readIndex)] {
	    set defaults($readIndex) $readValue
	 }
      }
      close $fileHandle
   }

   if {[file exists $defaultFile] ? [file writable $defaultFile] : \
	 [file writable [file dirname $defaultFile]]} {
      set fileHandle [open $defaultFile w]
      foreach idx [array names defaults] {
	 puts $fileHandle "$idx $defaults($idx)"
      }
      close $fileHandle
   }
}



proc GetUniqueWindowID {} {
   global lastWindowID

   if ![info exists lastWindowID] {
      set lastWindowID 0
   } else {
      set lastWindowID [expr $lastWindowID+1]
   }

   return $lastWindowID
}


proc SigDigits {num start end ninterest {factor 1}} {
   # ninterest is the number of interesting digits to leave
   if {!($end-$start)} {
      set ndigits 0
   } else {
      set ndigits [expr int($ninterest-log10($end*$factor-$start*$factor))]
   }
   if {$ndigits<0} {set ndigits 0}
   return [format [format "%%.%df" $ndigits] [expr $num*$factor]]
}



proc LogFormatError {filename line lineNo} {
   puts "Logfile format error in line $lineNo of $filename:\n$line\n\n"
}


proc CheckForNeededInfo {id} {
   global setting

   set needed ""

   if {![info exists setting($id,numProcs)] || $setting($id,numProcs)<1} {
      set needed "${needed}\numProcs"
   }

   if {![info exists setting($id,firstTime)]} {
      set needed "${needed}\nfirstTime"
   } elseif {![info exists setting($id,lastTime)] || \
	 $setting($id,lastTime)<=$setting($id,firstTime) || \
	 $setting($id,lastTime)==0} {
      set needed "${needed}\nlastTime"
   }

   if {![info exists setting($id,rolloverPt)]} {
      set needed "${needed}\nlastTime"
   }

   if "[string length $needed]>0" {
      toplevel .infoneeded
      wm title .infoneeded "Logfile incomplete"
      text .infoneeded.text -wrap word
      .infoneeded.text insert 1.0 "The logfile does not contain, or contains\
	    invalid values for the\
	    needed information.  The following values are\
	    required:\n$needed"
      button .infoneeded.b -text "Cancel" -command "destroy .infoneeded"
      pack append .infoneeded .infoneeded.text {expand} .infoneeded.b {}
      return 1
   } else {
      return 0
   }
}


proc EraseArrayElements {array_name idx_header} {
   upvar $array_name a

   set pattern "^$idx_header,"
   foreach idx [array names a] {
      if [regexp $pattern $idx] {
	 unset a($idx)
      }
   }
}


proc RemoveState {id stateName} {
   global setting

   set start $setting($id,states,$stateName,start)
   set end   $setting($id,states,$stateName,end)

   unset setting($id,endEvents,$end)
   unset setting($id,startEvents,$start)

   set idx [lsearch $setting($id,states,list) $stateName]
   # puts "removing $idx ($stateName) from $setting($id,states,list)"
   set setting($id,states,list) \
	 [lreplace $setting($id,states,list) $idx $idx]

   set idx [lsearch $setting($id,startEvents,list) $start]
   # puts "removing $idx ($stateName) from $setting($id,startEvents,list)"
   set setting($id,startEvents,list) \
	 [lreplace $setting($id,startEvents,list) $idx $idx]

   set idx [lsearch $setting($id,endEvents,list) $end]
   # puts "removing $idx ($stateName) from $setting($id,endEvents,list)"
   set setting($id,endEvents,list) \
	 [lreplace $setting($id,endEvents,list) $idx $idx]
   
   EraseArrayElements setting "$id,states,$stateName"
}	 


proc GuessFormat {filename} {

   if [regexp {.log$} $filename] {
      return alog
   } elseif [regexp {.trf$} $filename] {
      return picl
   } else {
      return [GetDefault logfileformat alog]
   }
}


proc GetVisibleRegion {id firstTime_var lastTime_var firstProc_var \
      lastProc_var} {
   global setting procWidth

   upvar $firstTime_var firstTime
   upvar $lastTime_var  lastTime
   upvar $firstProc_var firstProc
   upvar $lastProc_var  lastProc

   set canvas $setting($id,tlc)

   set width [winfo width $canvas]
   set height [winfo height $canvas]
   set scrollInfo [lindex [$canvas config -scrollregion] 4]

   set canvasleft   [lindex $scrollInfo 0]
   set canvastop    [lindex $scrollInfo 1]
   set canvasright  [lindex $scrollInfo 2]
   set canvasbottom [lindex $scrollInfo 3]

#   puts "scroll $scrollInfo"

#   puts "set firstTime expr  \
#	 (([$canvas canvasx 0]-$canvasleft)/($canvasright-$canvasleft)*\
#	 ($setting($id,lastTime)-$setting($id,firstTime)))/1000000.0 "

   set firstTime [expr { \
	 (([$canvas canvasx 0]-$canvasleft)/($canvasright-$canvasleft)*\
	 ($setting($id,lastTime)-$setting($id,firstTime)))/1000000.0}]

#   puts "set lastTime expr  \
#	 (([$canvas canvasx $width]-$canvasleft)/($canvasright-$canvasleft)*\
#	 ($setting($id,lastTime)-$setting($id,firstTime)))/1000000.0"

   set lastTime [expr { \
	 (([$canvas canvasx $width]-$canvasleft)/($canvasright-$canvasleft)*\
	 ($setting($id,lastTime)-$setting($id,firstTime)))/1000000.0}]

   set firstProc [expr { \
	 int( ([$canvas canvasy 0]-$canvastop)/($canvasbottom-$canvastop) * \
	 $setting($id,numProcs) + .5 )}]

   set lastProc [expr { \
	 int( ([$canvas canvasy $height]-$canvastop)/\
	 ($canvasbottom-$canvastop) * \
	 $setting($id,numProcs) - .5 )}]

}


proc Time2Pixel {id time} {
   global setting

   set scrollInfo [lindex [$setting($id,tlc) config -scrollregion] 4]

   set canvasleft   [lindex $scrollInfo 0]
   set canvasright  [lindex $scrollInfo 2]
   
   set pixel [expr {(0.0+$time) / \
 	 ($setting($id,lastTime)-$setting($id,firstTime)) * 1000000.0 * \
 	 ($canvasright - $canvasleft) + $canvasleft}]

   # puts "Time $time = pixel $pixel"

   return $pixel
}


proc Pixel2Time {id coord} {
   global setting
   
   set scrollInfo [lindex [$setting($id,tlc) config -scrollregion] 4]
   
   set canvasleft   [lindex $scrollInfo 0]
   set canvasright  [lindex $scrollInfo 2]
   
   set time [expr {((0.0+$coord-$canvasleft) / \
 	 ($canvasright - $canvasleft) * \
 	 ($setting($id,lastTime)-$setting($id,firstTime)))/ 1000000.0}]
   
   #   puts "pixel = $coord, time = $time"
   
   return $time
}   




proc OpenWin(main) {} {
   global logFileName logFileFormat

   wm title . "Upshot"

   frame  .mainBtns -relief raised
   button .mainBtns.load     -text "Select Logfile" \
	 -command {fileselect SelectLogfile "Logfile:" .[GetUniqueWindowID]}
   entry  .mainBtns.logfile  -width 30 -relief sunken
   label .mainBtns.format -textvariable logFileFormat

   if [info exists logFileName] {
      .mainBtns.logfile insert 0 $logFileName
      set logFileFormat [GuessFormat $logFileName]
   } else {
      set logFileName [GetDefault logfile ""]
      .mainBtns.logfile insert 0 $logFileName
      set logFileFormat [GuessFormat $logFileName]
   }

   UpdateDefaults "logfile $logFileName logfileformat $logFileFormat"

   button .mainBtns.setup    -text "Setup"      -command {
      OpenWin(timeline) .[GetUniqueWindowID] [.mainBtns.logfile get] \
	    $logFileFormat
   }
   button .mainBtns.options  -text "Options"    -command \
	 {OpenWin(options) .[GetUniqueWindowID]}