upshot.in

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

	    -text $setting($id,scaleLabel$i) -anchor n \
	    -tags {tempPrint label} -fill $fg
   }

   set labelBottom [lindex [$canvas bbox label] 3]

   # put a cover-up rectangle so stuff under the hash marks and labels \
	 doesn't show through
   $canvas create rectangle $left $bottom $right $labelBottom \
	 -fill $bg -outline $bg -tags {tempPrint coverUp}

   set legendTop [PrintLegend $id $left $top $right $bottom]
   set procNumLeft [PrintProcNums $id $left $top $right $bottom]

   # create coverup for proc nums
   $canvas create rectangle $procNumLeft $legendTop $left $labelBottom \
	 -fill $bg -outline $bg -tags {tempPrint coverUp}
   # create top margin
   $canvas create rectangle $procNumLeft [expr $legendTop-$topMargin] \
	 $right [expr $legendTop-0] -fill $bg -outline $bg\
	 -tags {tempPrint coverUp}
   # create right margin
   $canvas create rectangle $right [expr $legendTop-$topMargin] \
	 [expr $right+$rightMargin] [expr $labelBottom] -fill $bg \
	 -outline $bg -tags {tempPrint coverUp}

   # put the cover-up rectangles below anything else
   $canvas lower coverUp border

   return [list $procNumLeft [expr $legendTop-$topMargin] \
	 [expr $right+$rightMargin] $labelBottom]
}


proc TrimRectangles canvas {
   set left   [$canvas canvasx 0]
   set top    [$canvas canvasy 0]
   set right  [expr [winfo width  $canvas]+$left]
   set bottom [expr [winfo height $canvas]+$top]

   # get the IDs of anything that lays on the border
   set lside [$canvas find overlapping $left $top $left $bottom]
   set bside [$canvas find overlapping $left $bottom $right $bottom]
   set rside [$canvas find overlapping $right $top $right $bottom]
   set tside [$canvas find overlapping $left $top $right $top]
   set stateBars [$canvas find withtag state]
   #puts "lside: $lside\nbside: $bside\nrside: $rside\ntside: $tside\nstateBars: $stateBars\n"
   set ids [U $lside [U $bside [U $rside $tside]]]

   #puts "overflowing legend lines: $ids"
   set trimList {}
   set trimthis 0
   foreach id $ids {
      #puts "type: [$canvas type $id]"
      # if the object is a state rectangle...
      if {[$canvas type $id]=="rectangle" && \
	    [lsearch [$canvas gettags $id] state]>=0} {
	 # whether or not this rectangle was trimmed
	 set coords [$canvas coords $id]
	 #puts "coords = [$canvas coords $id]"
	 set rleft   [lindex $coords 0]
	 set rtop    [lindex $coords 1]
	 set rright  [lindex $coords 2]
	 set rbottom [lindex $coords 3]
	 if {($rleft<$left)||($rtop<$top)||($rright>$right)||($rbottom>$bottom)} {
	    lappend trimList [list $id $rleft $rtop $rright $rbottom]
	    #puts "Trimmed $id from ($rleft $rtop $rright $rbottom)"
	    if {$rleft<$left} {
	       set rleft $left
	    }
	    if {$rtop<$top} {
	       set rtop $top
	    }
	    if {$rright>$right} {
	       set rright $right
	    }
	    if {$rbottom>$bottom} {
	       set rbottom $bottom
	    }
	    #puts "     to ($rleft $rtop $rright $rbottom)"
	    $canvas coords $id $rleft $rtop $rright $rbottom
	 }
      }
   }
   #puts "trim list: $trimList"
   return $trimList
}


proc RestoreRectangles {canvas trimList} {
   foreach rect $trimList {
      eval $canvas coords $rect
   }
}



proc CreateGrayColormap {id} {
   global setting colormap

   set nstates [llength $setting($id,states,list)]
   set interval [expr {1.0 / ($nstates-1)}]
   set level 0.0

   foreach state $setting($id,states,list) {
      set colormap($setting($id,states,$state,color)) \
	    "$level $level $level setrgbcolor"
      # puts "set colormap($setting($id,states,$state,color)) \
      #    .$level $level $level setrgbcolor."
      set level [expr {$level + $interval}]
      if {$level > 1.0} {
	 set level 1.0
      }
   }
}




proc PrintTimeLines {id} {
   global prnToFile blackWhite pageHeight
   global pageWidth pageUnits printOpts setting nocolormap

   # if screen is B&W, output must be mono, otherwise set to grayscale
   # or color
   set colormode [expr {$blackWhite?{mono}:($printOpts($id,incolor)?\
	 {color}:{gray})}]

   set printBoundary [PrintTempObjects $id]

   # trim rectangle to the visible are to cut down PostScript printing
   # overhead
   set trimmedRect [TrimRectangles $setting($id,tlc)]

   set coords [$setting($id,tlc) bbox tempPrint]
   set left   [lindex $printBoundary 0]
   set top    [lindex $printBoundary 1]
   set width  [expr [lindex $printBoundary 2]-$left]
   set height [expr [lindex $printBoundary 3]-$top] 
   if {$width==0 || $height==0 || $pageWidth==0 || $pageHeight==0} {
      puts "Illegal size:\n  Canvas width: $width\n  Canvas height:\
	    $height\n  Page width: $pageWidth\n  Page height: $pageHeight"
   } else {
      
      # calculate the page size.  Make sure to abide by the most restrictive of
      # pageHeight and pageWidth.

      if {($height+0.0)/$width < $pageHeight/$pageWidth} {
	 # wide picture
	 set shortSide width
	 if $printOpts($id,isLandscape) {
	    set shortSize ${pageHeight}$pageUnits
	 } else {
	    set shortSize ${pageWidth}$pageUnits
	 }
      } else {
	 # tall picture
	 set shortSide height
	 if $printOpts($id,isLandscape) {
	    set shortSize ${pageWidth}$pageUnits
	 } else {
	    set shortSize ${pageHeight}$pageUnits
	 }
      }
      
      if {!$blackWhite && !$printOpts($id,incolor)} {
	 set colormap colormap
	 CreateGrayColormap $id
	 # set colormap() entries
      } else {
	 set colormap nocolormap
	 set nocolormap(0) 0
      }
	 
      if ($printOpts($id,tofile)) {
	 $setting($id,tlc) postscript -x $left -width $width -rotate \
	       $printOpts($id,isLandscape) -colormap $colormap \
	       -y $top -height $height -file $printOpts($id,filename) \
	       -colormode $colormode -page$shortSide $shortSize
      } else {
	 exec lpr -C Upshot -T $setting($id,logfilename) \
	       -P$printOpts(lprname) << [$setting($id,tlc) postscript -x \
	       $left \
	       -width $width -height $height  -rotate \
	       $printOpts($id,isLandscape) -colormap $colormap \
	       -y $top -colormode $colormode -page$shortSide $shortSize]
      }
   }
   # remove border, hash marks, labels, and cover-up rectangle
   $setting($id,tlc) delete tempPrint

   # restore rectangles that were trimmed to cut down PostScript printing
   # overhead

   if {!$blackWhite && !$printOpts($id,incolor)} {
      unset colormap
      # release colormap() entries
   }

   RestoreRectangles $setting($id,tlc) $trimmedRect

   # save into the defaults the setting just used
   PrintCancel $id
}



proc PrintCancel id {
   global printOpts
   UpdateDefaults "prnToFile $printOpts($id,tofile) timeLinePrintFile \
	 $printOpts($id,filename) printInColor $printOpts($id,incolor) \
	 lprname $printOpts(lprname) isLandscape \
	 $printOpts($id,isLandscape)"

   destroy $id.printOpt
}



proc PrintDialog {parentWin printCommand {title "Print Options"}} {
   global prnToFile env blackWhite printOpts
      # printOpts:
      #    $parentWin,tofile (boolean)
      #    $parentWin,filename
      #    $parentWin,incolor (boolean)
      #    lprname

   set printOpts($parentWin,tofile) [GetDefault prnToFile 0]
   set printOpts($parentWin,filename) [GetDefault timeLinePrintFile upshot.ps]
   set printOpts($parentWin,incolor) [GetDefault printInColor 1]
   set printOpts($parentWin,isLandscape) [GetDefault isLandscape 1]
   if ![info exists printOpts(lprname)] {
      if [info exists env(PRINTER)] {
	 set printOpts(lprname) $env(PRINTER)
      } else {
	 set printOpts(lprname) [GetDefault lprname ""]
      }
   }
      
   set w $parentWin.printOpt
   toplevel $w
   wm title $w "Print Options"
   wm iconname $w "PrintOpts"

   frame $w.printer
   frame $w.file
   frame $w.orientation
   frame $w.buttons

   radiobutton $w.printer.btn -text Printer: -variable \
	 printOpts($parentWin,tofile) -value 0
   entry $w.printer.entry -width 20 -relief sunken -textvariable \
	 printOpts(lprname)
   pack append $w.printer $w.printer.btn {left padx 10} \
	 $w.printer.entry {left fill expand padx 10 pady 10 frame w}
   
   radiobutton $w.file.btn    -text File:    -variable \
	 printOpts($parentWin,tofile) -value 1

   entry $w.file.entry -width 20 -relief sunken -textvariable \
	 printOpts($parentWin,filename)

   pack append $w.file    $w.file.btn    {left padx 10} \
	 $w.file.entry    {left fill expand padx 10 pady 10 frame w}

   label $w.orientation.lbl -text "Orientation:"
   radiobutton $w.orientation.portrait -text "portrait (tall)" \
	 -variable printOpts($parentWin,isLandscape) -value 0
   radiobutton $w.orientation.landscape -text "landscape (wide)" \
	 -variable printOpts($parentWin,isLandscape) -value 1
   pack append $w.orientation $w.orientation.lbl {left frame e} \
	 $w.orientation.portrait {top frame w} \
	 $w.orientation.landscape {top frame w}
   if $printOpts($parentWin,isLandscape) {
      $w.orientation.landscape select
   } else {
      $w.orientation.portrait select
   }

   button $w.buttons.print -text "Print" -command $printCommand
   button $w.buttons.cancel -text "Cancel" -command "PrintCancel $parentWin"
   pack append $w.buttons $w.buttons.print \
	 {left padx 10 pady 20 expand frame center} \
	 $w.buttons.cancel {left padx 10 pady 20 expand frame center}

   if ($blackWhite) {
      pack append $w $w.printer {top fillx} $w.file {top fillx} \
	    $w.orientation {top fillx} \
	    $w.buttons {top fillx}
   } else {
      frame $w.hues
      label $w.hues.label -text "Print in:"
      radiobutton $w.hues.bw    -text "b&w"   -variable \
	    printOpts($parentWin,incolor) -value 0
      radiobutton $w.hues.color -text "color" -variable \
	    printOpts($parentWin,incolor) -value 1
      if $printOpts($parentWin,incolor) {
	 $w.hues.color select
      } else {
	 $w.hues.bw select
      }
      pack append $w.hues $w.hues.label {left padx 20 frame e} \
	    $w.hues.bw    {top expand padx 10 pady 5 frame w} \
	    $w.hues.color {top expand padx 10 pady 5 frame w}
      pack append $w $w.printer {top fillx} $w.file {top fillx} \
	    $w.orientation {top fillx} $w.hues {top pady 20 fillx} \
	    $w.buttons {top fillx}
   }
   update
   set minwidth [expr {[winfo reqwidth $w.printer.btn]+\
	 [winfo reqwidth $w.printer.entry]}]
   set minheight [expr {[winfo reqheight $w.printer] + \
	 [winfo reqheight $w.file] + [winfo reqheight $w.buttons] + \
	 $blackWhite?0:[winfo reqheight $w.hues]}]
   wm minsize $w $minwidth $minheight
}


proc TimeLineScales {id scale1 scale2 \
      width scrollWidth processNumWidth} {
   global blackWhite numDHashMarks numSHashMarks ndigitsPrecS fg bg setting

   # one frame for the each scale, and within each scale, one frame for
   # all the hash marks, one frame for all the numeric labels
   frame $scale1
   frame $scale1.h
   frame $scale1.l
   frame $scale2
   frame $scale2.h
   frame $scale2.l

   for {set i 0} {$i<$numDHashMarks} {incr i} {
      # create canvas for each label
      canvas $scale1.h.c$i -height 15 -width 1 -bg $fg
      # create line in each canvas
#      $scale1.h.c$i create line 0 0 0 14
      # create dynamic labels 
      # their corresponding variables will be set later
      label $scale1.l.l$i -textvariable setting($id,scaleLabel$i)
      # add each hash mark and label to their respective frames
      pack append $scale1.h $scale1.h.c$i {left expand}
      pack append $scale1.l $scale1.l.l$i {left expand}
   }

   for {set i 1} {$i<=$numSHashMarks} {incr i} {
      # create canvas for each label
      canvas $scale2.h.c$i -height 15 -width 1 -bg $bg
      # create line in each canvas
      $scale2.h.c$i create line 0 0 0 14 -fill $fg

      set formatString [format "%%.%df" $ndigitsPrecS]
      label $scale2.l.l$i -text [SigDigits \
	    [expr {$i*($setting($id,lastTime)-$setting($id,firstTime))/ \
	    $numDHashMarks}] \
	    $setting($id,firstTime) $setting($id,lastTime) $ndigitsPrecS \
	    [expr .000001]]

      # add each hash mark and label to their respective frames
      pack append $scale2.h $scale2.h.c$i {left expand frame e}
      pack append $scale2.l $scale2.l.l$i {left expand frame e}
   }

   # soak space on either side of the dynamic scale
   canvas $scale1.s0 -height 1 -width 15 -bg $bg
   canvas $scale1.s1 -height 1 -width $processNumWidth -bg $bg

   # soak space on either side of the static scale
   canvas $scale2.s0 -height 1 -width 17 -bg $bg
   canvas $scale2.s1 -height 1 -width 14 -bg $bg

   pack append $scale1 $scale1.s0 {right} $scale1.s1 {left} \
	 $scale1.h {top fillx} $scale1.l {top fillx}
   pack append $scale2 $scale2.s0 {left} $scale2.s1 {right} \
	 $scale2.h {top fillx} $scale2.l {top fillx}
}


proc scaleLabelList n {
   for {set i 0} {$i<$n} {incr i} {
      lappend l scaleLabel$i
   }
   return $l
}

#
# tk4.0 provides ONLY two args to -xscrollcommand value: the first and last to 
# give to the scrollbar set command.
#
proc UpdateHScale3 {id scrollbar totalUnits \
      scrollUnits startUnit endUnit} {
   global numDHashMarks ndigitsPrecD setting

   set factor1 [expr ($scrollUnits+0.0)/$numDHashMarks]
   set factor2 [expr {($setting($id,lastTime)-$setting($id,firstTime)+0.0)/ \
	 ($totalUnits-2)/1000000}]

   # set the # of sig. digits
   set ndigits [expr {int($ndigitsPrecD-\
	 log10($numDHashMarks*$factor1*$factor2))}]
   if {$ndigits < 0} {set ndigits 0}

   # set the variables that the dynamic scale markings represent
   set formatString [format "%%.%df" $ndigits]
   for {set i 0} {$i<$numDHashMarks} {incr i} {
      set setting($id,scaleLabel$i) [format $formatString \
	    [expr ($factor1*($i+0.5)+$startUnit)*$factor2]]
   }
   $scrollbar set $totalUnits $scrollUnits $startUnit $endUnit
}

proc UpdateHScale4 {id scrollbar firstFrac lastFrac } {
   global numDHashMarks ndigitsPrecD setting

#
# Use the scrollbar information to recompute the scaling of the hashmarks
#
   set totalUnits [ $id.c cget -width ]
   # puts stdout $totalUnits
   set scrollUnits [ expr { ( $lastFrac - $firstFrac ) * $totalUnits } ]
   set startUnit [ expr { $firstFrac * $totalUnits } ]
   set endUnit [ expr { $lastFrac * $totalUnits } ]
   set factor1 [expr ($scrollUnits+0.0)/$numDHashMarks]
   set factor2 [expr {($setting($id,lastTime)-$setting($id,firstTime)+0.0)/ \
	 ($totalUnits-2)/1000000}]

   # set the # of sig. digits
   set ndigits [expr {int($ndigitsPrecD-\
	 log10($numDHashMarks*$factor1*$factor2))}]
   if {$ndigits < 0} {set ndigits 0}

   # set the variables that the dynamic scale markings represent
   set formatString [format "%%.%df" $ndigits]
   for {set i 0} {$i<$numDHashMarks} {incr i} {
      set setting($id,scaleLabel$i) [format $formatString \
	    [expr ($factor1*($i+0.5)+$startUnit)*$factor2]]
   }
   $scrollbar set $firstFrac $lastFrac
}

proc UpdateVScale3 {scrollbar procNumsCanvas totalUnits \
      scrollUnits startUnit endUnit} {
   $scrollbar set $totalUnits $scrol