#!/usr/bin/perl
#! /usr/bin/perl
##############################################################################
# Time-stamp: <Wed Nov 22 2000 03:35:19 Stardate: [-30]5765.74 hwloidl>
#
# Usage: qp2ps [options] <max-x> <max-y> <prg> <date>
#
# Filter that transforms a quasi-parallel profile (a .qp file) at stdin to  
# a PostScript file at stdout, showing essentially the total number of running,
# runnable and blocked tasks.
#
# Options:
#  -o <file> ... write .ps file to <file>
#  -m        ... create mono PostScript file instead a color one.
#  -r        ... measure runtime in kcycles, megacycles rather than exactly
#  -O        ... compress i.e. try to minimize the size of the .ps file
#  -s <str>  ... print <str> in the top right corner of the generated graph
#  -X <int>  ... forces to use <int> as runtime (x-value)
#  -Y <int>  ... forces to use <int> as max task residency (y-value)
#  -i <int>  ... info level from 1 to 7; number of queues to display
#  -I <str>  ... queues to be displayed (in the given order) with the encoding
#                 'a' ... active (running)
#                 'r' ... runnable
#                 'b' ... blocked
#                 'f' ... fetching
#                 'm' ... migrating
#                 's' ... sparks
#                (e.g. -I "arb" shows active, runnable, blocked tasks)
#  -l <int>  ... length of a slice in the .ps file; (default: 100)
#                small value => less memory consumption of .ps file & script
#                but slower in generating the .ps file
#  -d        ... Print date instead of average parallelism
#  -v        ... be talkative. 
#  -h        ... print help message (this header).
#
##############################################################################

require "getopts.pl";

&Getopts('hvDCOmdrX:Y:l:s:i:I:H');  

do process_options();

if ( $opt_v ) {
    do print_verbose_message();
}

# ---------------------------------------------------------------------------
# Init
# ---------------------------------------------------------------------------

$y_scaling = 1.0;

$xmin = 100;
$xmax = 790;

$scalex = $xmin;
$labelx = $scalex - 45;
$markx =  $scalex - 30;
$major = $scalex - 5;
$majorticks = 10;

$mmax = 1;

$amax = 0;
$ymin = 50;
$ymax = 500;

$active = 0;
$runnable = 0;
$blocked = 0;
$fetching = 0;
$migrating = 0;
$sparks = 0;

$tottime = 0;
$tottime0 = 0;

#$lines_per_flush = 100;            # depends on the PS implementation you use

%color = ( "a", "green",	# active
	   "r", "amber",        # runnable
	   "b", "red",          # blocked
	   "f", "cyan",		# fetching
	   "m", "blue",         # migrating
	   "s", "crimson" );    # sparks

# ---------------------------------------------------------------------------

do print_prolog();

$otime = -1;
$time_of_second_event = 0;
$samples = 0; 

$T[0] = 0; 
$G[0] = 0; 
$A[0] = 0; 
$R[0] = 0; 
$B[0] = 0;
$Y[0] = 0;

while(<STDIN>) {
    next if /^[^0-9]/;   # ignore lines not beginning with a digit (esp. last)
    chop;
    ($time, $event, $tid, $addr, $tid2, $addr2) = split;
    $time_of_second_event = $time         if $time_of_second_event == 0;

    if($time != $otime) {
	$tottime += $G[$samples] * ($time-$T[$samples]);
	$tottime0 += ($G[$samples] + $A[$samples]) * ($time-$T[$samples]);
	$otime = $time;
    }

    if($active > $amax) {
	$amax = $active;
    }

    if ( $opt_D ) {
	if($G[$samples] < $amax && $A[$samples] > 0) {
	    printf(stderr "%% $otime: G $G[$samples], A $A[$samples], " . 
		   "R $R[$samples], B $B[$samples], " .
		   "Y $Y[$samples]\n");
	}
    }

    # Reality Check
    if($G[$samples] < 0 || $A[$samples] < 0 || 
       $R[$samples] < 0 || $B[$samples] < 0 ||
       $Y[$samples] < 0) {
	printf(stderr "Error: Impossible number of tasks at time " .
	       "$T[$samples] (G $G[$samples], A $A[$samples], ".
	       "R $R[$samples], B $B[$samples], Y $Y[$samples])\n") if $opt_v || $opt_D;
	if ( $opt_H ) {  # HACK
	    $G[$samples] = 0  if $G[$samples] < 0;
	    $A[$samples] = 0  if $A[$samples] < 0;
	    $R[$samples] = 0  if $R[$samples] < 0;
	    $B[$samples] = 0  if $B[$samples] < 0;
	    $Y[$samples] = 0  if $Y[$samples] < 0;
	}
    }
    $samples++;

    $eventfrom = substr($event,0,1);
    $eventto = substr($event,1,1);

    printf(stderr "$time $event $eventfrom $eventto\n")   if 0 && $opt_D;
    
    if ($eventfrom eq '*') {
    }

    elsif ($eventfrom eq 'G') {
	--$active;
    }

    elsif ($eventfrom eq 'A') {
	--$runnable;
    }

    elsif ($eventfrom eq 'R') {
	--$blocked;
    }

    elsif ($eventfrom eq 'B') {
	--$sparks;
    }

    elsif ($eventfrom eq 'C') {
	--$migrating;
    }

    elsif ($eventfrom eq 'Y') {
	--$fetching;
    }

    if ($eventto eq '*') {
    }

    elsif ($eventto eq 'G') {
	++$active;
    }

    elsif ($eventto eq 'A') {
	++$runnable;
	$somerunnable = 1;
    }

    elsif ($eventto eq 'R') {
	++$blocked;
	$someblocked = 1;
    }

    elsif ($eventto eq 'B') {
	++$sparks;
	$somesparks = 1;
    }

    elsif ($eventto eq 'C') {
	++$migrating;
	$somemigratory = 1;
    }

    elsif ($eventto eq 'Y') {
	++$fetching;
	$somefetching = 1;
    }


    #printf(stderr "%% $time: G $active, A $runnable, R $blocked, " .
    #	   "B $sparks, C $migrating\n")  if 1;

    printf(stderr "Error: Trying to write at index 0!\n")  if $samples == 0;
    $T[$samples] = $time;
    do set_values($samples,
		  $active,$runnable,$blocked,$fetching,$sparks,$migrating);

   #$G[$samples] = queue_on_a ? $active : 0;
   #$A[$samples] = queue_on_r ? $runnable : 0;
   #$R[$samples] = queue_on_b ? $blocked : 0;
   #$Y[$samples] = queue_on_f ? $fetching : 0;
   #$B[$samples] = queue_on_s ? $sparks : 0;
   #$C[$samples] = queue_on_m ? $migrating : 0;

    $all = $G[$samples] + $A[$samples] + $R[$samples] + $Y[$samples] +
    	   $B[$samples] + $C[$samples] ;

    if($all > $mmax) {
	$mmax = $all; 
    }

    if ( 0 ) {
	print STDERR "%% $time: (act,runnable,blocked,fetch,mig,sp) = " .
	    "($active, $runnable, $blocked, $fetching, $migrating, $sparks)".
		" max = $all\n" ;
    }

    #print STDERR "Sparks @ $time: $sparks \tAll: $all \tMMax: $mmax\n"  if $opt_D;

    if ( $samples >= $slice_width ) {
	do flush_queues();
	$samples = 0;
    }

} # <STDIN>

do flush_queues();
print "%% End\n"  if $opt_C;

# For debugging only
if ($opt_D) {
    printf(stderr "Queue values after last event: " .
	   "$T[$samples] (G $G[$samples], A $A[$samples], ".
	   "R $R[$samples], B $B[$samples], Y $Y[$samples])\n");
}

if($time != $tmax) {
    if ( $pedantic ) {
	die "Error: Calculated time ($time) does not agree with stated max. time ($tmax)\n";
    } else {			# 
	print STDERR "Warning: Calculated time ($time) does not agree with stated max. time ($tmax)\n" if $opt_v;
    }
}

# HACK warning: 
# The real max-y value ($mmax) might differ from the one that is the input 
# to this script ($pmax). If so, we post-process the generated ps-file 
# and place an appropriate scaling  fct into the header of the ps-file.
# This is done by yet another perl-script: 
#		  ps-scale-y <y-scaling-factor> <ps-file>

if($pmax != $mmax) {
    if ( $pedantic ) {
	die "Error: Calculated max no. of tasks ($mmax) does not agree with stated max. no. of tasks ($pmax)\n";
    } else {
	print STDERR  "Warning: Calculated max no. of tasks ($mmax) does not agree with stated max. no. of tasks ($pmax)\n" if $opt_v;
	$y_scaling = $pmax/$mmax; #((float) $pmax)/((float) $mmax);
    }
}

print "% " . ("-" x 75) . "\n";
print "black set-colour-or-gray\n";

# Print optional str
    if ( $opt_s ) {
	print("HB16 setfont ($opt_s) dup stringwidth pop 790 exch sub 500 moveto show\n");
    }

    print("unscale-y\n");

# Average Parallelism
if($time > 0) {
    if ( $opt_S ) {        #  HACK warning; is this *always* correct -- HWL
	$avg = ($tottime-$time_of_second_event)/($time-$time_of_second_event);
    } else {
	$avg = $tottime/$time;
	$avg0 = $tottime0/$time
    } 
    print("/date-str ($date) def\n");
    $avgs=sprintf("Average Parallelism = %0.1f",$avg);
    print("/avg-str ($avgs) def\n");
    # 	$avgs0=sprintf("Average Potential Parallelism = %0.1f\n",$avg0);
    # 	print("% HE14 setfont ($avgs0) dup stringwidth pop 790 exch sub 515 moveto show\n");
    # New version: uses PS fct to approximate runtime if desired by user
    print "HE14 setfont prt-exact-rt total-len prt-rt\n";
    $rt_str=sprintf("Runtime = %0.0f",$tmax);
    print("/rt-str ($rt_str) def\n"); # useful for some extraction tools
    #HE14 setfont ($rt_str) dup stringwidth pop 790 exch sub 20 moveto show\n");
    print("/select-str-to-show { show-date-str { date-str } { avg-str } ifelse } def\n");
    print("HE14 setfont select-str-to-show dup stringwidth pop show-len exch sub show-height 15 add moveto show\n");
}

# do print_y_axis();

# -----------------------------------------------------------------------------
# Draw axes lines etc
# -----------------------------------------------------------------------------

if ( ! $opt_S ) {

# Draw dashed line for orientation (startup time)   -- HWL

if ( $draw_lines ) {
    local($x, $y);
    $x = int((500000/$tmax) * ($xmax-$xmin) + $xmin);
    $y = int((0/$pmax) * ($ymax-$ymin) + $ymin);
    $h = ($ymax-$ymin);

    print "gsave\n" .
	  "[1 3] 1 setdash\n" .
	  "$x $y moveto 0 $h rlineto stroke\n" .
	  "grestore\n";
}

# and another one at the second event                        -- HWL

print STDERR "Time of second event is: $time_of_second_event"  if 0 && $opt_D;

if ( $draw_lines ) {
    local($x, $y);
    $x = int(($time_of_second_event/$tmax) * ($xmax-$xmin) + $xmin);
    $y = int((0/$pmax) * ($ymax-$ymin) + $ymin);
    $h = ($ymax-$ymin);

    print "gsave\n";
    if ( ! $opt_m ) {
	print "green setrgbcolor\n";
    }
    print "[3 5] 1 setdash\n" .
	  "$x $y moveto 0 $h rlineto stroke\n" .
	  "grestore\n";
}

}

# -----------------------------------------------------------------------------

# Logo
print("HE14 setfont\n");
print("x-margin show-height 20 add logo\n");

# Epilogue
print("showpage\n");

if ( $y_scaling != 1.0 ) {
    print "%% y_scaling: $y_scaling\t max: $mmax\n";
}

exit 0 ;

# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
# -----------------------------------------------------------------------------
# Draw the current slice of the overall graph. 
# This routine is called if a slice of data is full (i.e. $T[0..$samples],
# $G[0..$slice_width] etc with $samples==$slice_width contain data from the 
# input file) or if the end of the input has been reached (i.e. $samples<=
# $slice_width). Note that the last value of the current slice is stored as
# the first value for the next slice.
# -----------------------------------------------------------------------------

sub flush_queues { 
    local ($x_norm, $y_norm);
    local ($index);
    local ($last_x, $last_y, $in_seq) = (-1, -1, 0);
    local ($foo_x, $foo_y);

    if ( $samples == 0 ) { return ; }

    # print "% First sample: T $T[0] (G $G[0], A $A[0], ".
    #	" R $R[0], B $B[0], Y $Y[0])\n"   if $opt_C;

    $rshow = reverse($show);
    print STDERR "\nReversed info-mask is : $rshow"  if 0 && $opt_D;
    print STDERR "\nMaximal y value is $pmax"        if 0 && $opt_D;
    for ($j=0; $j<length($rshow); $j++) {
	$q = substr($rshow,$j,1);
	# print  "% Queue = $q i.e. " . ($color{$q}) . " counts at first sample: " . &count($q,0) ."\n"  if $opt_C;
	do init_psout($q, $T[0], &count($q,0));
	for($i=1; $i <= $samples; $i++) {
	    do psout($T[$i],&count($q,$i));
	}
	print $color{$q} . " F\n";
	($foo_x, $foo_y) = &normalize($T[$samples],&count($q,$samples));
	print "%% Last " . ($color{$q}) . " is " . &get_queue_val($q,$samples) ."  (" . $T[$samples] . ", " . &count($q,$samples) . ") -> ($foo_x,$foo_y)\n"  if $opt_C;
	# print($color{$q} . " flush-it\n");
	# print("$xmax $ymin L\n");
    }
    do wrap($samples);

    #print "% Last sample  T $T[$samples] (G $G[$samples], A $A[$samples], ".
    #      " R $R[$samples], B $B[$samples], Y $Y[$samples])\n"  if $opt_C;
}

# -----------------------------------------------------------------------------
# Scale the (x,y) point (x is time in cycles, y is no. of tasks) s.t. the 
# x-(time-) axis fits between $xmin and $xmax (range for .ps graph).
# In case of optimization ($opt_O):
#  If there is a sequence of (x,y) pairs with same x value, then just 
#  print the first and the last pair in the seqence. To do that, $last_x
#  always contains the scaled x-val of the last point. $last_y contains
#  the y-val of the last point in the current sequence (it is 0 outside a 
#  sequence!).
# -----------------------------------------------------------------------------

sub normalize {
    local($x, $y ) = @_;
    local($x_norm, $y_norm );

    if ( $opt_S ) {
	$x_norm = int(( ($x-$time_of_second_event)/($tmax-$time_of_second_event)) * ($xmax-$xmin) + $xmin);
    } else {
	$x_norm = int(($x/$tmax) * ($xmax-$xmin) + $xmin);
    }
    $y_norm = int(($y/$pmax) * ($ymax-$ymin) + $ymin);

    return (($x_norm, $y_norm));
}

# -----------------------------------------------------------------------------

sub init_psout {
    local ($q, $x, $y) = @_;
    local ($x_norm, $y_norm);

    ($last_x, $last_y, $in_seq) = (-1, -1, 0);
    ($x_norm, $y_norm) =  &normalize($T[0],&count($q,0));
    $last_x = $x_norm;
    $last_y = $y_norm;
    print "%% Begin " . ($color{$q}) . "  (" . $T[0] . ", " . &count($q,0) . ") -> ($x_norm,$y_norm)\n" if $opt_C;
    print $x_norm, " ", $y_norm, " M\n";

}

# ----------------------------------------------------------------------------

sub psout {
    local($x_in, $y_in ) = @_;
    local($x, $y );

    ($x, $y) = &normalize($x_in, $y_in);
    die "Error in psout: Neg x coordinate\n"  if ($x < 0) ;

    if ( $opt_O ) {
	if ( $last_x == $x ) {      # If seq before $x that then print last pt
	    if ( ! $in_seq ) {
		$in_seq = 1;
		$first_y = $last_y;
	    }
	} else {                    # If seq with same $x val then ignore pts
	    if ( $in_seq ) {        # Seq before that -> print last in seq
		print("$last_x $last_y L\n")  if ($first_y != $last_y);
		$in_seq = 0;
	    }
	    print("$x $y L\n");
	}
	$last_x = $x;
	$last_y = $y;
    } else {
	print("$x $y L\n");
    }
}

# -----------------------------------------------------------------------------

sub queue_on {
    local ($queue) = @_;

    return index($show,$queue)+1;
}

# -----------------------------------------------------------------------------

sub count {
    local ($queue,$index) = @_;
    local ($res);

    $where = &queue_on($queue);
    $res = (($queue_on_a && ($queue_on_a<=$where))  ? $G[$index] : 0) +
	   (($queue_on_r && ($queue_on_r<=$where))  ? $A[$index] : 0) +
	   (($queue_on_b && ($queue_on_b<=$where))  ? $R[$index] : 0) +
	   (($queue_on_f && ($queue_on_f<=$where))  ? $Y[$index] : 0) +
	   (($queue_on_m && ($queue_on_m<=$where))  ? $C[$index] : 0) +
           (($queue_on_s && ($queue_on_s<=$where))  ? $B[$index] : 0);

    return $res;
}
    
# -----------------------------------------------------------------------------

sub set_values {
    local ($samples,
	   $active,$runnable,$blocked,$fetching,$sparks,$migrating) = @_;

    $G[$samples] = $queue_on_a ? $active : 0;   
    $A[$samples] = $queue_on_r ? $runnable : 0; 
    $R[$samples] = $queue_on_b ? $blocked : 0;  
    $Y[$samples] = $queue_on_f ? $fetching : 0; 
    $B[$samples] = $queue_on_s ? $sparks : 0;   
    $C[$samples] = $queue_on_m ? $migrating : 0;
}

# -----------------------------------------------------------------------------

sub set_queue_val {
    local ($queue,$index,$val) = @_;

    if    ( $queue == "a" ) { $G[$index] = $val; }
    elsif ( $queue == "r" ) { $A[$index] = $val; }
    elsif ( $queue == "b" ) { $R[$index] = $val; }
    elsif ( $queue == "f" ) { $Y[$index] = $val; }
    elsif ( $queue == "m" ) { $C[$index] = $val; }
    elsif ( $queue == "s" ) { $B[$index] = $val; }
}

# -----------------------------------------------------------------------------

sub wrap {                # used in flush_queues at the end of a slice
    local ($index) = @_;

    $T[0] = $T[$index];

    $G[0] = $G[$index];
    $A[0] = $A[$index];
    $R[0] = $R[$index];
    $Y[0] = $Y[$index];
    $B[0] = $B[$index];
    $C[0] = $C[$index];
}

# -----------------------------------------------------------------------------

sub get_queue_val {
    local ($queue,$index) = @_;

    if ( $queue == "a" ) { return $G[$index]; }
    elsif ( $queue == "r" ) { return $A[$index]; }
    elsif ( $queue == "b" ) { return $R[$index]; }
    elsif ( $queue == "f" ) { return $Y[$index]; }
    elsif ( $queue == "m" ) { return $C[$index]; }
    elsif ( $queue == "s" ) { return $B[$index]; }
}

# -----------------------------------------------------------------------------

sub get_date {
    local ($date);

    chop($date = `date`);
    return ($date);
}

# -----------------------------------------------------------------------------

sub print_prolog {
    local ($now);

    $now = do get_date();
    `stardate >/dev/null 2>/dev/null`;
    if ( $? ) { 
      # no stardate available
      $stardate = "";
    } else {
      chop($stardate = `stardate`);
      $stardate = "%%Stardate:       " . $stardate . "\n";
    }

    print("%!PS-Adobe-2.0\n");
    print("%%Title:          Activity Profile\n");
    print("%%Creator:        qp2ps\n");
    print("%%StartTime:      $date\n");
    print("%%CreationDate:   $now\n");
    print($stardate);
    print("%%BoundingBox:    0 0 560 800\n");
    print("%%Orientation:    Seascape\n");
    print("%%Copyright:      1995, 1996 by Hans-Wolfgang Loidl, University of Glasgow\n");
    print("%%EndComments\n");
    #print ("/greenlineto {1.0 setlinewidth lineto} def\n");
    #print ("/amberlineto {0.5 setlinewidth lineto} def\n");
    #print ("/redlineto {1.5 setlinewidth lineto} def\n");
    #print ("/G {newpath moveto greenlineto stroke} def\n");
    #print ("/A {newpath moveto amberlineto stroke} def\n");
    #print ("/R {newpath moveto redlineto stroke} def\n");

    print "% " . "-"x75 . "\n";
    print "% Tunable parameters (can be true or false):\n";
    print "%  prt-exact-rt ... show exact or succinct runtime (bottom right)\n";
    print "%                   e.g. 51348 cycles or 51 kcycles\n";
    print "%  prt-exact-tics ... show exact or succinct runtime in tics\n";
    print "%  colour-graph ... colour or monochrome graph\n";
    print "%  show-date-str ... show date rather than average parallelism\n";
    print "%  show-max-tasks ... show max no. of tasks at the y-axis\n";
    print "% " . "-"x75 . "\n";
    if ( $opt_r ) {
      print "/prt-exact-rt false def\n";
    } else {
      print "/prt-exact-rt true def\n";
    }
    print "/prt-exact-tics false def\n";
    print "/prt-max-task-residency false def\n";
    if ( $opt_m ) {
      print "/colour-graph false def\n"
    } else {
      print "/colour-graph true def\n"
    }
    if ( $opt_d ) {
      print "/show-date-str true def\n";
    } else {
      print "/show-date-str false def\n";
    }
    print "/show-max-tasks false def\n";
    print "% " . "-"x75 . "\n";
    print "% End of tunable parameters\n";
    print "% Do not tinker with the rest of the file unless you know what you are doing\n";
    print "% " . "-"x75 . "\n";

    $tmax1 = $tmax;
    $pmax1 = $opt_X ? $opt_X : $tmax;
    if ( $opt_X ) {
      $pmax1 = $opt_X;
      $str_x = "(value provided as arg; computed value is $pmax)";
    } else {
      $pmax1 = $pmax;
      $str_x = "";
    }
    if ( $opt_Y ) {
      $tmax1 = $opt_Y;
      $str_y = "(value provided as arg; computed value is $tmax)";
    } else {
      $tmax1 = $tmax;
      $str_y = "";
    }

    print <<EOQ;
% ---------------------------------------------------------------------------
% Important constants
% Note: total-len must be the total runtime and
%       total-height the max number of tasks; 
%       the graph will be scaled to fit into a show-len by show-height space
% ---------------------------------------------------------------------------
/total-len $tmax1 def    % total runtime $str_y
/total-height $pmax1 def % max task residency $str_x
/show-len $xmax def      % x-size in pixels
/show-height $ymax def   % y-size in pixels
/x-offset $xmin def      % x-coor of origin of graph
/y-offset $ymin def      % y-coor of origin of graph
/x-margin $ymin def      % margin on x-coor for text
/y-margin $ymin def      % margin on y-coor for text
/box-x-len 10 def        % x-size of a box in the legend
/box-y-len 10 def        % y-size of a box in the legend
/box-y-offset 10 def     % line (i.e. y-val) where to print legend
/box-x-gap 15 def        % x-space between box and text
% ---------------------------------------------------------------------------
%  Currently normalize defines the following trafo on (x,y) values:
%  \$x_norm = int((\$x/$tmax) * ($xmax-$xmin) + $xmin);
%  \$y_norm = int((\$y/$pmax) * ($ymax-$ymin) + $ymin);
/normalize { total-len div show-len x-offset sub mul x-offset add floor } def
/y-normalize { total-height div show-height y-offset sub mul y-offset add floor } def
% ---------------------------------------------------------------------------
% Colour and grayscale definitions
% ---------------------------------------------------------------------------
/black-colour { 0 0 0 } def
/white-colour { 1 1 1 } def
/red-colour { 0.8 0 0 } def
/green-colour { 0 0.9 0.1 } def
/blue-colour { 0 0.1 0.9 } def
/crimson-colour { 0.7 0.5 0 } def
/amber-colour { 0.9 0.7 0.2 } def
/cyan-colour { 0 0.6 0.9 } def

/black-gray { 0 } def
/white-gray { 1 } def
/red-gray { 0 } def
/green-gray { 0.5 } def
/blue-gray { 0.7 } def
/crimson-gray { 0.8 } def
/amber-gray { 0.9 } def
/cyan-gray { 0.3 } def

/black { colour-graph { black-colour } { black-gray } ifelse } def
/red { colour-graph { red-colour } { red-gray } ifelse } def
/green { colour-graph { green-colour } { green-gray } ifelse } def
/blue { colour-graph { blue-colour } { blue-gray } ifelse } def
/crimson { colour-graph { crimson-colour } { crimson-gray } ifelse } def
/amber { colour-graph { amber-colour } { amber-gray } ifelse } def
/cyan { colour-graph { cyan-colour } { cyan-gray } ifelse } def

/set-colour-or-gray { 
  colour-graph { setrgbcolor } { setgray } ifelse 
} def
EOQ

#     if ( $opt_m ) {
# 	print  "/red { 0 } def\n";
# 	print  "/green { 0.5 } def\n";
# 	print  "/blue { 0.7 } def\n";
# 	print  "/crimson { 0.8 } def\n";
# 	print  "/amber { 0.9 } def\n";
# 	print  "/cyan { 0.3 } def\n";
#     } else {
# 	print  "/red { 0.8 0 0 } def\n";
# 	print  "/green { 0 0.9 0.1 } def\n";
# 	print  "/blue { 0 0.1 0.9 } def\n";
# 	print  "/crimson { 0.7 0.5 0 } def\n";
# 	print  "/amber { 0.9 0.7 0.2 } def\n";
# 	print  "/cyan { 0 0.6 0.9 } def\n";
#     }

    print <<EOQ;
% ---------------------------------------------------------------------------
% Logos etc
% ---------------------------------------------------------------------------
/printText { 0 0 moveto (GrAnSim) show } def

/ascii-logo { gsave
  translate 
  .95 -.05 0
    { setgray printText 1 -.5 translate } for
  black-gray setgray printText
  grestore 
} def 
/colour-logo { gsave
 translate
 .95 -.05 0
   { dup 1 exch sub 0 exch setrgbcolor printText 1 -.5 translate } for
 white-colour setrgbcolor printText
 grestore
} def
/asciilogo { 5 sub moveto HB16 setfont (GrAnSim) show } def
/logo { 
 colour-graph { colour-logo } { asciilogo } ifelse
} def 
% ---------------------------------------------------------------------------
/cmpx {pop exch pop eq} def             % compare x-coors of 2 points
/cmpy {exch pop 3 2 roll pop eq} def    % compare y-coors of 2 points
/cmp {2 index eq {exch pop eq}          % compare 2 points
                 {pop pop pop false} ifelse 
} def
% ---------------------------------------------------------------------------
/scale-y { } def
/unscale-y { } def
% ---------------------------------------------------------------------------
% Aux functions for printing integers
% ---------------------------------------------------------------------------
/str-len 12 def
/prt-n { % print top-of-stack integer centered at the current point
  cvi str-len string cvs 
  dup stringwidth pop 
  currentpoint pop 780 gt { 10 sub } { 2 div } ifelse 
  neg 0 rmoveto 
  show  
} def 
% -----------------------------------------------------------------------------
% draw a box in the legend
% -----------------------------------------------------------------------------
/draw-box { % stack: colour x-val |  
  box-y-offset moveto
  0 box-y-len rlineto
  box-x-len 0 rlineto
  0 box-y-len neg rlineto
  closepath
  % gsave
  % stack: colour x-val |
  set-colour-or-gray
  fill
  % grestore
  stroke
} def
% -----------------------------------------------------------------------------
% Aux fcts for constructing x/y-axes (placing tics; succinct total rt etc)
% -----------------------------------------------------------------------------
% From Dave Wakeling's Axes.c (part of hp2ps)
% static floatish
% One-Two-Five(y)
%   floatish y;
% {
%     if (y > 4.0) {
% 	return (5.0);
%     } else if (y > 1.0) {
% 	return (2.0);
%     } else {
% 	return (1.0);
%     }   
% }
/one-two-five { % y
  dup 4.0 gt  % ? y>4.0
  { pop 5.0 }
  { 1.0 gt    % ? y>1.0
    { 2.0 }
    { 1.0 } ifelse } ifelse
} def
% From Dave Wakeling's Axes.c (part of hp2ps)
% static floatish
% Round(y)
%   floatish y;
% {
%     int i;

%     if (y > 10.0) {
% 	for (i = 0; y > 10.0; y /= 10.0, i++) ;
% 	y = One-Two-Five(y);
% 	for ( ; i > 0; y = y * 10.0, i--) ;

%     } else if (y < 1.0) {
% 	for (i = 0; y < 1.0; y *= 10.0, i++) ;
%         y = One-Two-Five(y);
%         for ( ; i > 0; y = y / 10.0, i--) ;
 
%     } else {
% 	y = One-Two-Five(y);
%     }
% }

% % Print debugging info
% /prt-debug { % val str
%   currentpoint exch pop 15 add 100 exch moveto
%   show 20 0 rmoveto prt-n
% } def
% dumy def
/prt-debug { % val str
  pop pop 
} def

% ToDo: get rid of prt-debugs
/dw-round { % y ... the value to round to get nice tic marks
  100 200 moveto dup (Start of dw-round; y: ) prt-debug % debug 
  % special case (added to make the code terminate):
  % input 0 returns 0
  dup 0.0 eq not {                % ? y!=0 
     dup 10.0 gt                  % ? y>10.0 
     { dup 0 exch                 % i = 0
  	% stack: yin i y |
  	{ dup (div-loop; new y: ) prt-debug % debug 
  	  10.0 div                % y/=10.0
  	  exch 1 add exch         % i++
  	  dup 10.0 gt             % until !(y>10.0)
  	  not { exit } if
  	} loop 
  	% stack: yin i y |
  	dup (y after div-loop: ) prt-debug 
  	exch dup (i after div-loop: ) prt-debug exch
  	one-two-five  % y = one-two-five(y)
  	dup (y after div-loop and one-two-five: ) prt-debug 
  	exch
  	% stack: yin y i |
       dup 0.0 gt              % ? i>0
  	{ { exch 
  	    dup (mul-loop; new y: ) prt-debug % debug 
  	    10.0 mul           % y *= 10.0
  	    exch 1 sub         % i--
  	    dup 0.0 gt         % until !(i>0)
  	    not { exit } if
  	} loop } if
  	% stack: yin y i |
  	dup (i after div-loop: ) prt-debug 
  	pop
  	dup (y after div-loop: ) prt-debug 
  	exch pop
  	dup (result: ) prt-debug 
     } % then branch 
     { dup 1.0 lt                   % ? y<1.0
       { dup 0 exch                 % i = 0
  	 % stack: yin i y |
  	 { dup (mul2-loop; new y: ) prt-debug % debug 
	   10.0 mul                 % y*=10.0
	   exch 1 add exch          % i++
	   dup 1.0 lt               % until !(y<1.0)
	   not { exit } if
  	 } loop % until
  	dup (y after mul2-loop: ) prt-debug
  	exch dup (i after mul2-loop: ) prt-debug exch
  	one-two-five  % y = one-two-five(y)
  	dup (y after mul2-loop and one-two-five: ) prt-debug 
  	exch
  	% stack: yin y i |
  	dup 0 gt                    % ? i>0
  	{ { exch 
  	    dup (div2-loop; new y: ) prt-debug % debug 
  	    10.0 div                % y /= 10.0
  	    exch 1 sub              % i--
  	    dup 0 gt                % until !(i>0)
  	    not { exit } if
  	} loop } if
  	% stack: yin y i |
  	dup (i after div2-loop: ) prt-debug 
  	pop
  	dup (y after div2-loop: ) prt-debug 
  	exch pop 
  	} % then branch
  	{
  	one-two-five                % y = one-two-five(y)
  	dup (result: ) prt-debug 
  	} ifelse 
      } ifelse } if                 % ? y!=0.0
 % stack: y | 
  dup (Result: ) prt-debug 
} def
% ---------------------------------------------------------------------------
% Aux functions for approximating and printing runtime
% ---------------------------------------------------------------------------
/approx-rt { % exact-rt short-flag val
             % translate integer val into strings of val and unit
             % if short-flag is true then use M rather than Mcycles etc
 3 2 roll 
 { cvi 12 string cvs () exch } % prt-exact-rt is user tunable
  { dup 1000000 ge 
  { 100000 div floor 10 div 12 string cvs 
    exch { ( M) } { ( Mcycles) } ifelse exch } % val > 1Meg
  { dup 1000 ge 
    { 100 div floor 10 div 12 string cvs exch { ( k) } {( kcycles)} ifelse exch}
    { cvi 12 string cvs () exch } ifelse 
  } ifelse
 } ifelse
 % stack: <string with unit of time> <str with approx rt>
} def
/prt-rt { % exact-rt total-len
 790 20 moveto  % right end of bottom line; print right to left!
 prt-exact-rt exch true exch approx-rt exch ( cycles) (Runtime = ) 4 1 roll
 % (Runtime = ) val unit (cycles) |  % print top 4 strings from right to left
 4 { dup stringwidth pop neg dup 0 rmoveto exch show 0 rmoveto } repeat
} def
/prt-tic { % val |   print value with units center around current point
  % { prt-n } {
    prt-exact-tics exch false exch true exch approx-rt
    2 copy stringwidth pop exch stringwidth pop add 
    % stack: <str of unit> <str of val> <total string length>
    2 div currentpoint 3 1 roll exch sub exch moveto
    show show
  % } ifelse 
} def
% ---------------------------------------------------------------------------
% Main drawing functions
% ---------------------------------------------------------------------------
%/L { lineto } def
%/L {2 copy pop 1 sub currentpoint exch pop lineto lineto} def
/L { % x y |   connect current point with (x,y) if different coors
     %         connection is first horizontal until x then vertical until y
     %         this reflects that the change is exactly at (x,y), not before
  2 copy currentpoint cmpx not
  { 2 copy pop currentpoint exch pop lineto} if
    2 copy currentpoint cmpy 
     { pop pop } 
     { lineto } ifelse
} def
/F { % stack: color |    flush a segment of the overall area
  currentpoint pop y-offset lineto closepath
  set-colour-or-gray fill 
} def
/M {  % stack: x y |  Start drawing a slice (vert. line and moveto startpoint)
  newpath 1 index y-offset moveto lineto
} def
% --------------------------------------------------------------------------
% For debugging PS uncomment this line and add the file behandler.ps
% $brkpage begin printonly endprint 
% --------------------------------------------------------------------------
% Fonts
% --------------------------------------------------------------------------
/HE10 /Helvetica findfont 10 scalefont def
/HE12 /Helvetica findfont 12 scalefont def
/HE14 /Helvetica findfont 14 scalefont def
/HE16 /Helvetica findfont 16 scalefont def
/HB14 /Helvetica-Bold findfont 14 scalefont def
/HB16 /Helvetica-Bold findfont 16 scalefont def
% --------------------------------------------------------------------------
-90 rotate
-785 30 translate
% --------------------------------------------------------------------------
% Creating box around the whole graph
% --------------------------------------------------------------------------
newpath
0 8 moveto
0 525 760 525 8 arcto
4 {pop} repeat
760 525 760 0 8 arcto
4 {pop} repeat
760 0 0 0 8 arcto
4 {pop} repeat
0 0 0 525 8 arcto
4 {pop} repeat
0.500000 setlinewidth
stroke
newpath
4 505 moveto
4 521 752 521 4 arcto
4 {pop} repeat
752 521 752 501 4 arcto
4 {pop} repeat
752 501 4 501 4 arcto
4 {pop} repeat
4 501 4 521 4 arcto
4 {pop} repeat
0.500000 setlinewidth
stroke
    
HE14 setfont
x-margin 50 add show-height 5 add moveto
($pname ) show
    
4 8 moveto
4 24 756 24 4 arcto
4 {pop} repeat
756 24 756 4 4 arcto
4 {pop} repeat
756 4 4 4 4 arcto
4 {pop} repeat
4 4 4 24 4 arcto
4 {pop} repeat
0.500000 setlinewidth
stroke
% ---------------------------------------------------------------------------
EOQ

# Labels

# x-range: 100 - 600
# y-value: 

    $x_begin = 50;
    $x_end = 550; 
    $y_label = 10;

    $no_of_labels = length($show);  # $info_level;

    $step = ($x_end-$x_begin)/($no_of_labels);

    $x_now = $x_begin;

    if ( $queue_on_a ) {
	do print_box_and_label($x_now,$y_label,"green","running");
    }

    if ( $queue_on_r  ) {
	$x_now += $step;
	do print_box_and_label($x_now,$y_label,"amber","runnable");
    }

    if ( $queue_on_f ) {
	$x_now += $step;
	do print_box_and_label($x_now,$y_label,"cyan","fetching");
    }

    if ( $queue_on_b ) {
	$x_now += $step;
	do print_box_and_label($x_now,$y_label,"red","blocked");
    }

    if ( $queue_on_m ) {
	$x_now += $step;
	do print_box_and_label($x_now,$y_label,"blue","migrating");
    }

    if ( $queue_on_s ) {
	$x_now += $step;
	do print_box_and_label($x_now,$y_label,"crimson","sparked");
    }
    
    # Print runtime of prg; this is just a crude HACK; better: x-axis!  -- HWL
    #print("HE10 setfont\n");
    #print("680 10 moveto\n");
    #print("(RT: $tmax) show\n");

    print("-40 -10 translate\n");
    
    do print_x_axis();

    print("x-offset y-offset moveto\n");
    print("black set-colour-or-gray\n");

    do print_y_axis();

    print("scale-y\n");
}

# -----------------------------------------------------------------------------

sub print_box_and_label {
    local ($x,$y,$color,$label) = @_;
    local ($z);

    # $z = $x+15;

    print <<EOQ;
$color $x draw-box
HE14 setfont
$x box-x-gap add box-y-offset moveto
black set-colour-or-gray
($label) show
% --------------------------------------------------
EOQ
}

# -----------------------------------------------------------------------------

sub print_x_axis {

  print <<EOQ;
% ---------------------------------------------------------------------------
% X-Axis:
0.5 setlinewidth
% horizontal line
x-offset y-offset moveto total-len normalize x-offset sub 0 rlineto stroke
% start increment end
% NB: total-len is rounded to get nice increment for tics
0 total-len dw-round 10 div total-len
 { dup normalize dup y-offset moveto 0 -2 rlineto stroke  % tic
   y-offset 13 sub moveto HE10 setfont prt-tic            % prt-tic may cut rt 
 } for 
1 setlinewidth
% End X-Axis.
% ---------------------------------------------------------------------------
EOQ
}

# -----------------------------------------------------------------------------

sub print_y_axis {
    local ($i);
    local ($y, $smax,$majormax, $majorint);

    # Y-axis label
    print <<EOQ;
% Y-Axis:
0.5 setlinewidth
x-offset y-offset moveto
black set-colour-or-gray
gsave
HE12 setfont
(tasks)
dup stringwidth pop
show-height
exch sub
y-offset 5 add exch
translate
90 rotate
0 0 moveto
show
grestore
% vertical line
x-offset y-offset moveto show-height y-offset sub 0 exch rlineto stroke
% start increment end
% NB: total-len is rounded to get nice increment for tics
0 total-height dw-round 10 div total-height
 { dup y-normalize dup x-offset exch moveto -5 0 rlineto stroke  % tic
   x-offset 20 sub exch moveto HE10 setfont prt-n                % print label 
 } for 
% print max task residency
prt-max-task-residency
{ total-height 
  dup y-normalize dup x-offset exch moveto -5 0 rlineto stroke
  x-offset 20 sub exch moveto HE12 setfont prt-n } if
1 setlinewidth
% End Y-Axis.
% ---------------------------------------------------------------------------
EOQ

#     print "% " . ("-" x 75) . "\n";
#     print "% Y-Axis:\n";
#     print "% " . ("-" x 75) . "\n";

#     print("%scale-y  % y-axis outside scaled area if ps-scale-y rebuilds it!\n");

#     print("gsave\n");
#     print("HE12 setfont\n");
#     print("(tasks)\n");
#     print("dup stringwidth pop\n");
#     print("$ymax\n");
#     print("exch sub\n");
#     print("$labelx exch\n");
#     print("translate\n");
#     print("90 rotate\n");
#     print("0 0 moveto\n");
#     print("show\n");
#     print("grestore\n");

#     # Scale

#     if ($pmax < $majorticks) {
# 	$majorticks = $pmax;
#     }

#     print("HE12 setfont\n$scalex $ymin moveto\n$scalex $ymax lineto\n");
#     print("% Max number of tasks: $pmax\n");
#     print("% Number of ticks: $majorticks\n");

#     print "0.5 setlinewidth\n";

#     $y = $ymax; # (($pmax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
#     print("$scalex $y moveto\n$major $y lineto\n");
#     print("$markx $y moveto\n($pmax) show\n");

#     $majormax = int($pmax/$majorticks)*$majorticks;
#     $smax = $majormax*(($ymax-$ymin)/$pmax)+$ymin;
#     $majorint = $majormax/$majorticks;

#     for($i=1; $i <= $majorticks; ++$i) {
# 	$y = (($smax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
# 	$majorval = int($majorint * ($majormax/$majorint-$i));
# 	print("$scalex $y moveto\n$major $y lineto\n");
# 	print("$markx $y moveto\n($majorval) show\n");
#     }

#     # print("$xmin $ymax moveto\n10 0 rlineto\n10 0 rmoveto\n($pmax) show\n");
#     print " stroke\n";
#     print "1 setlinewidth\n";
#     print "%unscale-y\n";
#     print "% End Y-Axis.\n";
#     print "% " . ("-" x 75) . "\n";
}

# -----------------------------------------------------------------------------

sub print_verbose_message {

    print STDERR "Prg Name: $pname  \nDate: $date  \nInfo-str: $show\n";
    print STDERR "Input: stdin  Output: stdout\n";
    print STDERR "The following queues are turned on: " .
	  ( $queue_on_a ? "active, " : "") .   
	  ( $queue_on_r ? "runnable, " : "") . 
	  ( $queue_on_b ? "blocked, " : "") .  
          ( $queue_on_f ? "fetching, " : "") . 
          ( $queue_on_m ? "migrating, " : "") .
	  ( $queue_on_s ? "sparks" : "") .
          "\n";
    if ( $opt_C ) {
	print STDERR "Inserting check code into .ps file (for check-ps3 script)\n";
    }
    if ( $opt_D )  {
	print STDERR "Debugging is turned ON!\n";
    }
}

# ----------------------------------------------------------------------------

sub process_options {

    if ( $opt_h ) {                      
	open(ME,$0) || die "Can't open myself ($0): $!\n";
	$n = 0;
	while (<ME>) {
	    last if $_ =~ /^$/;
	    print $_;
	    $n++;
	}
	close(ME);
	exit ;
    }
    
    if ( $#ARGV != 3 ) {
	print "Usage: $0 [options] <max x value> <max y value> <prg name> <date> \n";
	print "Use -h option to get details\n";
	exit 1;
    }

    $tmax = $ARGV[0];
    $pmax = $ARGV[1];
    # GUM uses the absolute path (with '=' instead of '/') of the executed file
    # (for PVM reasons); if you want to have the full path in the generated
    # graph, too, eliminate the substitution below
    ($pname = $ARGV[2]) =~ s/.*=//;
    ($date = $ARGV[3]) =~ s/Start-Time: //;
    

    $show = "armfb";
    $draw_lines = 0;

    if ( $opt_i ) { 
	$show = "a"		if info_level == 1;
	$show = "ar"		if info_level == 2;
	$show = "arb"		if info_level == 3;
	$show = "arfb"		if info_level == 4;
	$show = "armfb"		if info_level == 5;
	$show = "armfbs"	if info_level == 6;
    }

    if ( $opt_I ) {
	$show = $opt_I;
    }

    if ( $opt_v ){ 
	$verbose = 1;
    }    

    if ( $opt_l ) {
	$slice_width = $opt_l;
    } else {
	$slice_width = 500;
    }

    $queue_on_a = &queue_on("a");
    $queue_on_r = &queue_on("r"); 
    $queue_on_b = &queue_on("b"); 
    $queue_on_f = &queue_on("f"); 
    $queue_on_s = &queue_on("s"); 
    $queue_on_m = &queue_on("m"); 

# if ($#ARGV == 0) {
#     printf(stderr "usage: qp2ps.pl runtime [prog [date]]\n");
#     exit 1;
# }
}

