#!/usr/pkg/bin/perl
# gus_ue_rosette.pl

# http://www.vishay.com/brands/measurements_group/guide/tn/tn515/515drnj.htm

my $VERSION = '2006-08-01';

use strict;
use warnings;
use Cwd;
use Math::Trig;
use Text::CSV::Simple;
use GD::Graph::lines;

my $verbosity = 1;
my $test_flag = 1;
my ( $chan_keys, $chan_arefs );
my $LSB = 0x1;

# Confuses editor syntax highlighting.
my $ascii_pound = "\043";
my $ascii_squot = "\047";

########################
# BEGIN FAKE DATA SUBS #
########################

# PURPOSE: Generate arbitrary data to use for demo and/or troubleshooting.
# Simulates the output from a pair of strain gage rosettes, one rectangular
# and one delta.

# Simulate a data collection for a strain gage rectangular rosette
# by returning an array of N refs of pseudorandom 3-elem arrays.
sub fake_ue_array {
    my $i = shift;
    my @eu_3xN;
    my @keys = ( 'Time (s)', 'SG 1', 'SG 2', 'SG 3', 'SG 4', 'SG 5', 'SG 6' );
    for my $j ( 0 .. $i ) {
        my @data_row = fake_ue_scan_reading( 15, 0.33 );
        for my $k ( 0 .. $#keys ) {
            $eu_3xN[$k][$j] = shift @data_row;
        }
    }
    return ( \@keys, \@eu_3xN );
}

my $fake_seconds  = 0;    # Time domain
my $fake_ue_theta = 0;    # Degrees
my $fake_max_p_ue = 0;    # Microstrain

# Simulate one scan of time plus eu-readings from two unlike rosettes.
sub fake_ue_scan_reading {
    my @ue_scan = (
        $fake_seconds,
        retro_rosette( fake_ue_next(@_), 45, 90 ),    # Rectangular rosette.
        retro_rosette( fake_ue_next(@_), 60, 120 )    # Delta rosette.
    );
    $fake_seconds += 0.01;    # Linear progression of time.
    return @ue_scan;
}

# Generate the next artifical max principal strain and theta.
# Improbable (sometimes even impossible) strain values will result.
sub fake_ue_next {
    my ( $ue_inc, $theta_inc ) = @_;

    # Waver max principal strain up one way, down the other.
    if ( abs($fake_ue_theta) > 17.5 ) { $fake_max_p_ue += $ue_inc }
    else { $fake_max_p_ue -= $ue_inc }

    $fake_max_p_ue += sin( 1 / ( $fake_seconds + $LSB ) );

    # Wave the strain angle around in a circle.
    $fake_ue_theta += $theta_inc;

    return (
        int($fake_max_p_ue),
        int( $fake_max_p_ue * 0.233 ),
        int( $fake_ue_theta % 360 )
    );
}

######################
# END FAKE DATA SUBS #
################################
# BEGIN FILE INPUT/OUTPUT SUBS #
################################

# Winnow first N lines of input file.
# Return array of keys for future hash.
sub read_csv_keys {
    my ( $path_input, ) = @_;
    my @keys;
    if ( open CSV, $path_input ) {
        my $line_1 = <CSV>;
        chomp $line_1;
        close CSV;
        @keys = split /,\s*/, $line_1;
        for (@keys) { $_ = quote_neatly($_) }
        return @keys;
    }
    else { print "Oops! Problem at get_csv_keys: $! \n" }
}

# Join as comma- or tab-delimited according to file suffix.
sub join_data_row {
    my $path = shift;
    my $row;

    # Quote any alphanumerics not already quoted.
    for (@_) {

        # $_ = quote_neatly($_) if $_ !~ /^\s*(-|\+|[0-9])?\.?[0-9]+/
    }
    if    ( $path =~ /\.(csv|CSV)$/ ) { $row = join ',',  @_ }
    elsif ( $path =~ /\.(dat|DAT)$/ ) { $row = join '\t', @_ }
    return $row . "\n";
}

# Write out a data file.
sub eu_file_write {
    my $path_output = shift;

    # Which channels to output?
    my @chans_out = @_;
    @chans_out = ( 0 .. $#$chan_keys )
      unless @chans_out;    # Default to all chans.

    if ( open OUT, ">$path_output" ) {
        print OUT join_data_row( $path_output, @$chan_keys[@chans_out] );
        foreach my $i ( 0 .. $#{ $chan_arefs->[0] } ) {
            my @data;

            # Build a row of column cells from selected channel arrays.
            foreach my $j (@chans_out) {
                push @data, $chan_arefs->[$j][$i];
            }

            print OUT join_data_row( $path_output, @data );
        }
        close OUT;
        print "Okay, CSV file written to path '$path_output' \n";
    }
    else { print "Oops! Can't open $path_output for writing: $! \n" }
}

# Read in CSV file, return two arrays: one of keys one of column arefs.
sub eu_file_read {
    my $path_input = shift;
    my @keys       = read_csv_keys($path_input);
    my $parser     = Text::CSV::Simple->new;
    $parser->field_map(@keys);
    my @hrefs = $parser->read_file($path_input);    # Array, one href per record
    my @arefs;
    foreach my $i ( 0 .. $#keys ) {
        next if $i > 0 && $keys[$i] =~ /^$ascii_squot?(T|t)ime/;
        push @arefs, [];
        foreach my $href (@hrefs) {
            push @{ $arefs[-1] }, $href->{ $keys[$i] };
        }
    }
    foreach (@arefs) {
        shift @{$_};    # Lose the chan description text.
    }
    return \@keys, \@arefs;
}

##############################
# END FILE INPUT/OUTPUT SUBS #
##################################
# BEGIN REQUEST ABOUT GAGES SUBS #
##################################

# Where I need to write calls to GUI to get the info from user
# about the already read-in gage data.

# Info required to correct intrinsic small errors.
my $poisson = 0.285;    # Poisson's ratio for steel.
my @kt;
for ( 1 .. 6 ) { push @kt, 0.015 }
;                       # Transverse Sensitivity

################################
# END REQUEST ABOUT GAGES SUBS #
################################
# BEGIN ARRAY TRAVERSAL SUBS #
##############################

# Round off channel data in place.
sub chans_roundoff {
    my @fmts = @_;      # A digit value for each channel.
    for my $i ( 0 .. $#fmts ) {
        for my $j ( 0 .. $#{ $chan_arefs->[0] } ) {
            $chan_arefs->[$i][$j] =
              sprintf( "%.$fmts[$i]f", $chan_arefs->[$i][$j] );
        }
    }
}

# Pad column width of channel to align with column header.
sub column_justify {
    my @col_widths = @_;

    my @key_widths;
    for (@$chan_keys) {
        my $width = length $_;
        $width += 2 if $_ !~ /^'.*'$/;
        push @key_widths, $width + 1;
    }

    my @max_widths;    # Width of each column's widest data element.
    for ( 0 .. $#key_widths ) { push @max_widths, col_max_width($_) + 1 }

    for ( 0 .. $#key_widths ) {
        $col_widths[$_] = 0 unless $col_widths[$_];   # User-proof sanity check.
        $col_widths[$_] = $key_widths[$_] if $key_widths[$_] > $col_widths[$_];
        $col_widths[$_] = $max_widths[$_] if $max_widths[$_] > $col_widths[$_];
    }

    for my $i ( 0 .. $#key_widths ) {
        $chan_keys->[$i] = sprintf "%$col_widths[$i]s",
          quote_neatly( $chan_keys->[$i] );
        for my $j ( 0 .. $#{ $chan_arefs->[0] } ) {
            $chan_arefs->[$i][$j] = sprintf "%$col_widths[$i]s",
              $chan_arefs->[$i][$j];
        }
    }
}

# For a given column of data, get width of biggest element.
sub col_max_width {
    my $max = 0;
    for ( @{ $chan_arefs->[ $_[0] ] } ) {
        my $width = length $_;
        $max = $width if $width > $max;
    }
    return $max;
}

############################
# END ARRAY TRAVERSAL SUBS #
##################################
# BEGIN SUBARRAY CONVERSION SUBS #
##################################

# Append a subarray converted from 3 ue's to max/min ue & angle.
sub resolve_rosette_rect {
    my ( $eu_1, $eu_2, $eu_3, $poisson ) = @_;
    my ( $max_p_eu, $min_p_eu, $theta );    # All arefs
    my $id = 'RR ' . join '-', ( $eu_1, $eu_2, $eu_3 );
    die "Oops! Sub resolve_rosette_rect expects 3 channel (column) IDs "
      . "followed by and Poisson's ratio, not '"
      . join ( ', ', @_ ) . "'\n"
      unless scalar @_ == 4 && $_[3] < 1;
    for my $i ( 0 .. $#{ $chan_arefs->[0] } ) {
        ( $max_p_eu->[$i], $min_p_eu->[$i], $theta->[$i] ) = rect_calc(
            $chan_arefs->[$eu_1][$i],
            $chan_arefs->[$eu_2][$i],
            $chan_arefs->[$eu_3][$i],
            @kt[ $eu_1 - 1, $eu_2 - 1, $eu_3 - 1 ], $poisson
        );
    }
    for ( 'Max', 'Min', 'Deg' ) {
        push @$chan_keys, quote_neatly("$id $_");
    }
    push @$chan_arefs, ( \@$max_p_eu, \@$min_p_eu, \@$theta );
}

# Append a subarray converted from 3 ue's to max/min ue & angle.
sub resolve_rosette_delta {
    my ( $eu_1, $eu_2, $eu_3, $poisson ) = @_;
    my ( $max_p_eu, $min_p_eu, $theta );    # All arefs
    my $id = 'DR ' . join '-', ( $eu_1, $eu_2, $eu_3 );
    die "Oops! Sub resolve_rosette_rect expects 3 channel (column) IDs "
      . "followed by and Poisson's ratio, not '"
      . join ( ', ', @_ ) . "'\n"
      unless scalar @_ == 4 && $_[3] < 1;
    for my $i ( 0 .. $#{ $chan_arefs->[0] } ) {
        ( $max_p_eu->[$i], $min_p_eu->[$i], $theta->[$i] ) = delta_calc(
            $chan_arefs->[$eu_1][$i],
            $chan_arefs->[$eu_2][$i],
            $chan_arefs->[$eu_3][$i],
            @kt[ $eu_1 - 1, $eu_2 - 1, $eu_3 - 1 ], $poisson
        );
    }
    for ( 'Max', 'Min', 'Deg' ) {
        push @$chan_keys, quote_neatly("$id $_");
    }
    push @$chan_arefs, ( \@$max_p_eu, \@$min_p_eu, \@$theta );
}

################################
# END SUBARRAY CONVERSION SUBS #
################################
# BEGIN ROSETTE SUBS #
######################

# Calcuate any rosette's 3 ue values given the principal strains and angle.
# Use to generate simulated data for algorithm testing.
sub retro_rosette {
    my ( $max, $min, $theta, $g2_angle, $g3_angle ) = @_;

    ( $max, $min ) = retro_corr_k( $max, $min, $kt[1], $poisson );

    $theta    = deg2rad( -$theta );    # Undo the reversal
    $g2_angle = deg2rad($g2_angle);
    $g3_angle = deg2rad($g3_angle);

    # Formula per Measurments Group TN-515 Page 4 Formulae 2a, 2b, 2c.
    my $foo = ( $max + $min ) / 2;
    my $bar = ( $max - $min ) / 2;
    my @e123;
    push @e123, $foo + $bar * cos( 2 * $theta );
    push @e123, $foo + $bar * cos( 2 * ( $theta + $g2_angle ) );
    push @e123, $foo + $bar * cos( 2 * ( $theta + $g3_angle ) );
    return @e123;    # Give back ue values for grids 1, 2 and 3.
}

# Return max and min principal strains plus angle of max in degrees.
sub rect_calc {
    my ( $e1, $e2, $e3 ) =
      rect_corr_k(@_);    # Correct transverse sens error       .

    # Formula per Measurments Group TN-515 Page 4 Formula 3.
    my $foo = ( $e1 + $e3 ) / 2;
    my $bar = ( ( ( $e1 - $e2 )**2 + ( $e2 - $e3 )**2 ) )**0.5 / 2**0.5;

    # Formula per Measurments Group TN-515 Page 4 Formula 5 (not 4).
    # Angle expressed from Grid 1 to axis of principal strain!
    # Use of Least Significant Bit prevents zero-divide error.
    my $rad = atan( ( 2 * $e2 - $e1 - $e3 ) / ( ( $e1 - $e3 ) + $LSB ) ) / 2;
    return ( $foo + $bar, $foo - $bar, rad2deg($rad) );
}

# Return max/min principal strains and angle of max.
sub delta_calc {
    my ( $e1, $e2, $e3 ) = delta_corr_k(@_);    # Correct transverse sens error

    # Formula per Measurments Group TN-515 Page 5 Formula 6.
    my $foo = ( $e1 + $_[1] + $_[2] ) / 3;
    my $bar =
      2**0.5 / 3 * ( ( $e1 - $e2 )**2 + ( $e2 - $e3 )**2 + ( $e3 - $e1 )**2 )
      **0.5;

    # Formula per Measurments Group TN-515 Page 5 Formula 8 (not 7).
    # Angle expressed from Grid 1 to axis of principal strain!
    # Use of Least Significant Bit prevents zero-divide error.
    my $rad =
      atan( 3**0.5 * ( $e2 - $_[2] ) / ( ( 2 * $e1 - $e2 - $e3 ) + $LSB ) ) / 2;
    return ( $foo + $bar, $foo - $bar, rad2deg($rad) );
}

# Correct for transverse sensitivity ex-post-facto after resolving principal
# strains from uncorrected rosettes of any type.
# Formula per Vishay Micro-Measurements TN-509, page 6, formulae 16 & 17.
# Not used because more accurate with three K values versus one K value.
sub corr_k {
    my ( $ep, $eq, $k, $p ) = @_;
    my @cor;
    push @cor,
      ( 1 - $p * $k ) / ( 1 - $k**2 ) * ( $ep - $k * $eq );    # max prin ue
    push @cor,
      ( 1 - $p * $k ) / ( 1 - $k**2 ) * ( $eq - $k * $ep );    # min prin ue
    return @cor;
}

# Reverse correction for transverse sensitivity of any rosette.
# Use for generating correctable fake data.
sub retro_corr_k {
    my ( $ep, $eq, $k, $p ) = @_;
    my @uncor;
    my $x = ( 1 - $p * $k ) / ( 1 - $k**2 );

    # Reverse engineered by author using simultaneous linear equations.
    # Given P, Q, x and k, solve for p and q
    #   p - kq = P/x
    # -kp +  q = Q/x
    push @uncor, $ep / $x + $k * ( $eq + $k * $ep ) / $x / ( 1 - $k**2 );
    push @uncor, ( $eq + $k * $ep ) / $x / ( 1 - $k**2 );
    return @uncor;
}

# Correct for transverse sensitivity.
# Formula per Vishay Micro-Measurements TN-509, page 5, formulae 10-12.
sub rect_corr_k {
    my ( $e1, $e2, $e3, $k1, $k2, $k3, $p ) = @_;
    my @cor;
    push @cor, rect_corr_sub( $k1, $p ) * ( $e1 - $k1 * $e3 );
    push @cor, rect_corr_sub( $k2, $p ) * ( $e2 - $k2 * ( $e1 + $e3 - $e2 ) );
    push @cor, rect_corr_sub( $k3, $p ) * ( $e3 - $k3 * $e1 );
    return @cor;
}

# Correct for transverse sensitivity.
# Formula per Vishay Micro-Measurements TN-509, page 6, formulae 13-15.
sub delta_corr_k {
    my ( $e1, $e2, $e3, $k1, $k2, $k3, $p ) = @_;
    my @cor;
    push @cor, delta_corr_sub( $e1, $e2, $e3, $k1, $p );
    push @cor, delta_corr_sub( $e2, $e3, $e1, $k2, $p );
    push @cor, delta_corr_sub( $e3, $e1, $e2, $k3, $p );
    return @cor;
}

# Called by &rect_corr_k internally.
sub rect_corr_sub {
    my ( $k, $p ) = @_;
    return ( 1 - $p * $k ) / ( 1 - $k**2 );
}

# Called by &delta_corr_k internally.
sub delta_corr_sub {
    my ( $e1, $e2, $e3, $k, $p ) = @_;
    return ( 1 - $p * $k ) / ( 1 - $k**2 ) *
      ( ( 1 + $k / 3 ) * $e1 - 2 / 3 * $k * ( $e2 + $e3 ) );
}

####################
# END ROSETTE SUBS #
##########################
# BEGIN GD GRAPHING SUBS #
##########################

# Main sub to print a graph. Uses the GD::Graph module.
# Works for most cases but has problems with two_axes plots having more than
# two data sets (one LH, one RH).
sub graph_chans_gd {
    my ( $path_graph, $title, $y1_aref, $y2_aref ) = @_;

    my $ext = $path_graph;
    $ext =~ s/.*\.//;    # Retain only the extension.
    $ext = lc($ext);     # Dual service as 'png' or 'gif' in $gd->$ext() etc.

    # Assign channels to left or right axis.
    my @use_axis;
    for (@$y1_aref) { push @use_axis, 1 }
    for (@$y2_aref) { push @use_axis, 2 }

    my $graph = GD::Graph::lines->new( 1024, 512 )
      or print "Oops! Can't create graph at sub graph_chans_gd \n";

    $graph->set_legend( @$chan_keys[ @$y1_aref, @$y2_aref ] );
    $graph->set_legend_font("GD::gdFontTiny");

    graph_basic( $graph, $title )
      or print "Oops! At sub graph_basic: " . $graph->error . " \n";

    graph_2nd_y( $graph, \@use_axis, $y1_aref, $y2_aref )
      or print "Oops! At sub graph_angle: " . $graph->error . " \n"
      if @$y2_aref;

    # Graph the time, LH and RH channels.
    my $gd = $graph->plot( [ @$chan_arefs[ 0, @$y1_aref, @$y2_aref ] ] )
      or print "Oops! At op \$graph->plot: " . $graph->error . " \n";

    graph_write_gd( $gd, $path_graph, $ext );    # Write to file.
}

# Basic stuff done for all graphs.
sub graph_basic {
    $_[0]->set(
        title       => $_[1],
        r_margin    => 5,
        l_margin    => 2,
        t_margin    => 1,
        b_margin    => 1,
        long_ticks  => 1,
        transparent => 0,
        bgclr       => '#c5c5c5',  # See http://en.wikipedia.org/wiki/Web_colors
        y_label           => 'Strain (ue)',
        x_label           => 'Time (s)',
        x_labels_vertical => 1,
        y_number_format   => '%0.1f',
        x_tick_number     => 10,
        y_tick_number     => 10,
    );
}

# Extra stuff done for graphs with two Y axes, one left & one right.
# Any values set here will override those from sub graph_basic above.
sub graph_2nd_y {
    my ( $y1_min, $y1_max ) = snap( min_max( @{ $_[2] } ), 10 );
    my ( $y2_min, $y2_max ) = snap( min_max( @{ $_[3] } ), 5 );
    $_[0]->set(
        two_axes      => 1,
        use_axis      => $_[1],
        y1_label      => 'Strain (ue)',
        y2_label      => 'Strain Angle (deg)',
        y1_min_value  => $y1_min,
        y1_max_value  => $y1_max,
        y2_min_value  => $y2_min,
        y2_max_value  => $y2_max,
        y_tick_number => 20,
    );
}

# Given two vals, snap them outward to next multiple of given increment.
sub snap {
    my ( $min, $max, $incr ) = @_;

    # print "At sub snap: INPUT = ($min, $max, $incr) ";
    $min = int( ( $min - $incr ) / $incr ) * $incr;
    $max = int( ( $max + $incr ) / $incr ) * $incr;

    # print "OUTPUT = ($min, $max) \n";
    return $min, $max;
}

# Sort out the min and max from a list.
sub min_max {
    my @vals;
    for (@_) { push @vals, @{ $chan_arefs->[$_] } }
    @vals = sort { $a <=> $b } @vals;
    @vals = @vals[ 0, $#vals ];    # Keep min and max only.
    for (@vals) { $_ =~ s/\s//g }
    return @vals;
}

# Output the graph to a file.
sub graph_write_gd {
    my ( $gd, $path, $ext ) = @_;
    if ( open GRAPH, ">$path" ) {
        binmode(GRAPH);
        print GRAPH $gd->$ext;
        print "Okay, " . uc($ext) . " file written to path '$path' \n";
    }
    else { print "Oops! Couldn't write graphic to path '$path': $!" }
    close GRAPH;
}

########################
# END GD GRAPHING SUBS #
########################
# BEGIN GENERAL SUBS #
######################

# Unpad, unquote, requote given string.
sub quote_neatly {
    my $str = shift;
    while ( $str =~ /^('|\s)/ || $str =~ /('|\s)$/ ) {
        $str =~ s/^'//;
        $str =~ s/'$//;
        $str =~ s/^\s//;
        $str =~ s/\s$//;
    }
    $str = qq|'$str'|;
}

# Cause *.ps graph to pop up in GUI viewer.
sub graph_display {
    my $cmd;

    # Test OS: if not Windoze do as for UNIX-like.
    if ( $Config::Config{'osname'} =~ /Win/i ) {
        if ( $_[0] =~ /\.e?ps/ ) { $cmd = 'gsview32.exe' }
        else { $cmd = 'imdisplay.exe' }
        system( qq|start "$cmd" "$cmd"|, qq|"$_[0]"| );
    }
    else {
        if ( $_[0] =~ /\.e?ps/ ) { $cmd = 'gv' }
        else { $cmd = 'display' }
        `$cmd $_[0] &`;
    }
    print "\nCalling...\n'$cmd'\n...to show...\n'$_[0]'\n\n";
}

####################
# END GENERAL SUBS #
####################
# BEGIN DEMO USE #
##################

# TEST THE PROGRAM SO FAR...
sub command_line_example {
    my $file_name = shift;
    ( $chan_keys, $chan_arefs ) = fake_ue_array(99);    # Create fake scan data.
    chans_roundoff( 4, 6, 6, 6, 6, 6, 6 ); # Set significant digits per channel.
    column_justify();                      # Prettify column widths per channel.
    eu_file_write( cwd() . '/fake_data_6-SG.csv' );    # Save all channels.

    # Read in the fake data written above as if it were real.
    ( $chan_keys, $chan_arefs ) = eu_file_read( cwd() . '/fake_data_6-SG.csv' );

    # Solve 2 sets of 3-chan data as rosettes (added in as new channels).
    resolve_rosette_rect( 1, 2, 3, $poisson );         # A rectangular rosette.
    resolve_rosette_delta( 4, 5, 6, $poisson );        # A delta rosette.
    chans_roundoff( 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2 )
      ;                  # Significant digits per channel.
    column_justify();    # Prettify column widths per channel.

    # Save only time and the two solved-for rosettes.
    eu_file_write( cwd() . '/fake_data_2-Rst.csv', 0, 7 .. 12 );

    # Create a PNG graphic of the added-in rosette data o nly.
    my $top_string = 'Two Nearly Equal Rectangular & Delta Rosettes';
    my $btm_string = 'Max/Min Principal Strains & Angles';

    # Write a PostScript file of the graph.
    # Requires an interpreter such as GhostScript and GhostView.
    graph_chans_gd(
        cwd() . '/fake_data_2-Rst.png',   # Name of graphic file.
        $top_string,                      # Title to show at top of graph.
        [ 7, 8, 10, 11 ],    # Chans for LH Y-axis (max/min strains).
        [ 9, 12 ]            # Chans for RH y-axis (strain angle).
    );

    # Write a PostScript file of the graph.
    # Requires an interpreter such as Ghostscript and an associated viewer
    # such as GSView.

    my $eps = GUS::PSGraph->new(600, 600)
      or print "Oops! Can't create *.eps graph. \n";

	$eps->set(
		labelTop     => 'Two Nearly Equal Rosettes: Rectangular & Delta',
		labelLeft    => 'Microstrain (ue)',
		labelLeft2   => 'Max & Min Principal Strains',
		labelRight   => 'Angle (deg)',
		labelRight2  => 'Direction of Max Relative to Grid 1',
		labelBottom  => 'Time (secs)',
		labelBottom2 => 'Max/Min Principal Strains and Angles',
		
		# Deliberately hideous choices
		bgColor      => 'DarkOliveGreen',
		fgColor      => 'HotPink',
		webColors    => ['Crimson', 'Lime', 'Indigo', 'Gold', 'Snow', 'Aqua' ],
		fontName     => 'ZapfChancery-MediumItalic',
		fontSize     => 18,
		
		skip_over    => 1,
	);

    $eps->graph_lines_ps(
        cwd() . '/fake_data_2-Rst.eps',  # Name of graphic file.
        [ 7, 8, 10, 11 ],    # Chans for LH Y-axis (max/min strains).
        [ 9, 12 ],           # Chans for RH y-axis (strain angle).
    );

    # Display the graphic made by GD::Graph.
    graph_display( cwd() . "/$file_name" . '.png' );

    # Display the graph made by GUS::PSGraph.
    graph_display( cwd() . "/$file_name" . '.eps' );
}

command_line_example('fake_data_2-Rst');    # Comment out to forego demo.

################
# END DEMO USE #
###############################
# BEGIN GUS::PS::Graph MODULE #
###############################

package GUS::PSGraph;

#my $VERSION = '2006-08-01';

# Keep strict happy
use vars qw(
  $ps_header
  $ps_prolog_generic
  $ps_prolog_graphing
  $ps_prolog_data_arrays
  $ps_prolog_drawing
  $ps_tail
  $ps_web_colors_dict
  %ps_defaults
);

# NOTE: Usage of $self->{skip_over} to either "NOT SHOW" or "SKIP" various data channels.
#
# TELLING PostScript TO "NOT SHOW" CERTAIN CHANNELS MEANS...
# that Perl will send PostScript all the channels plus an instruction to not show some of them.
# Why do this? The PostScript program was originally written to run standalone. This feature made
# it easy to have one file and, with a minor hand edit, generate any number of subsets of all
# all possible graphs by simply changing the list inside the /noShowCurves array. It also allowed
# for the same channel to always have a given number and color no matter if other channels were
# not shown. So if you were only showing Channel 12, it would still be numbered "12" and still
# display with the color assigned to "12". This makes a lot of sense when you have a dozen graphs
# layed out on a table in a meeting for none-too-bright customers to argue over.
#
# TELLING Perl TO "SKIP" CERTAIN CHANNELS MEANS...
# that Perl will excise those channels from the list it sends to PostScript. Steps are built in to
# hide this fact from PostScript which would otherwise stumble over the gap in numerical channel
# sequence since it expects them to be named /columnArray-0, /columnArray-1, /columnArray-2, etc.

BEGIN {
# Provide defaults.
	%ps_defaults =  (
		'pgWidth'      => 640,
		'pgHeight'     => 480,
		'labelTop'     => 'Graph Main Title Goes Here',
		'labelBottom'  => 'X Axis Measure (Units) Goes Here',
		'labelBottom2' => 'Extra X Axis Info Goes Here',
		'labelLeft'    => 'Y1 Axis Measure & (Units) Goes Here',
		'labelLeft2'   => 'Extra Y1 Axis Info Goes Here',
		'labelRight'   => 'Y2 Axis Measure (Units) Goes Here',
		'labelRight2'  => 'Extra Y2 Axis Info Goes Here',
		'bgColor'      => 'Black',
		'fgColor'      => 'White',
		'webColors'    => ['Red', 'Green', 'Blue', 'Yellow', 'Magenta', 'Cyan'],
		'fontName'     => 'Helvetica',
		'fontSize'     => 10,
		'skip_over'    => 0,
	);
}

# Create new object.
sub new {
	my $class = shift;
    my $self = {};
    for (keys %ps_defaults){ $self->{$_} = $ps_defaults{$_} } # Copy in defaults.
    $self->{pgWidth}  = shift if $_[0];
    $self->{pgHeight} = shift if $_[0];
    $self->{ps_header} = $ps_header;
    $self->{ps_header} =~
    	s/BoundingBox:.*\n/BoundingBox: 0 0 $self->{pgWidth} $self->{pgHeight}\n/;
    bless $self;
    return $self;
}

# Allow user to change defaults.
sub set {
	my $self = shift;
	my %user_defs = @_;
	while ( my ($key, $value) = each %user_defs ) {
		if ( exists $self->{$key}) {$self->{$key} = $value }
		else { print "Oops! Key '$key' non-existant in hash '$self'.\n" }
	}
}

# Make custom adjustments to default Prolog defs.
sub ps_defs_insert {
    my ( $self, $lh_aref, $rh_aref ) = @_;
    my ( $shown, $not_shown_aref ) = $self->chans_elect( @$lh_aref, @$rh_aref );

    my $str = ();
    
    $str .= "/bgColor ($self->{bgColor}) def \n";
    $str .= "/fgColor ($self->{fgColor}) def \n";
    $str .= "/webColors [ ";
    for ( @{$self->{webColors}} ) { $str .= "/$_ " }
    $str .= "] def \n";
    
    $str .= "/fontName /$self->{fontName} def \n";
    $str .= "/fontSize $self->{fontSize} def \n";
    

    # Set not-to-be-shown labels as empty strings.
    $str .= "/labelTop ($self->{labelTop}) def \n";
    $str .= "/labelLeft ($self->{labelLeft}) def \n";
    $str .= "/labelLeft2 ($self->{labelLeft2}) def \n";
    $str .= "/labelRight ($self->{labelRight}) def \n";
    $str .= "/labelRight2 ($self->{labelRight2}) def \n";
    $str .= "/labelBottom ($self->{labelBottom}) def \n";
    $str .= "/labelBottom2 ($self->{labelBottom2}) def \n";

    $str .= "/flgFakeColZero false def \n";
    $str .= "/dataSets 1 def \n";

    # This is an ugly, ex-post-facto hack.
    # When chans skipped, patch up the bottom string to cover up remove gap in
    # channel ID's. In short, make legend ID match the gap-free curve ID.
    if ($self->{skip_over}) {
        my @chans_shown = ( @$lh_aref, @$rh_aref );
        my @gap_free = gap_free_skip( $not_shown_aref, \@chans_shown );
        for my $i ( 0 .. $#gap_free ) {
            $shown =~ s/ $chans_shown[$i]=/ $gap_free[$i]=/;
            $shown =~ s/ $chans_shown[$i] showColor/ $gap_free[$i] showColor/;
        }
    }

    $str .= $shown; # List of chans shown

    # An array of data chans embeded in PostScript but whose curves are not to be shown
    # and their colors skipped over by those curves which are shown.
    $str .= "/noShowCurves [ ";
    $str .= join ( ' ', @$not_shown_aref ) unless $self->{skip_over};
    $str .= " ] def \n";

    # Y2 axis (re-)numbered for PostScript.
    $str .= "/columnsRH [";
    if ($self->{skip_over}) {
        $str .= join ' ', gap_free_skip( $not_shown_aref, $rh_aref );
    }
    else {
        $str .= join ' ', @$rh_aref;
    }

    $str .= "] def \n";    # Y2 axis
    return $str, $not_shown_aref;
}

# Given two arrays retrun a copy of 2nd array after decrementing its elements
# for each lesser element of 1st array. Used to provide PostScript with /columnArrays
# named 0 thru N with no gaps when chans have been skipped over to graph.
sub gap_free_skip {
    my ( $not_shown_aref, $shown_aref ) = @_;
    my @gap_free = @$shown_aref;
    for my $i ( 0 .. $#gap_free ) {
        for my $j (@$not_shown_aref) {
            --$gap_free[$i]
              if $j <
              $shown_aref->[$i];    # Index decremented for each gap beneath it.
        }
    }
    return @gap_free;
}

# Build lable for chans shown, list of those not to show.
sub chans_elect {
	my $self = shift;
    my ( $chans_shown, @chans_not_shown );

    # Collect list of shown-channel keys
    # Prettify them into a graph legend good for B&W, not just color.
    for (@_) {
        $chans_shown .= " ( $_=$chan_keys->[$_] ) $_ showColor ";
    }

    # Determine list of channels not to show.
    for ( 1 .. $#$chan_keys ) {
        push @chans_not_shown, $_ unless $chans_shown =~ /$chan_keys->[$_]/;
    }

    $chans_shown =~ s/= '/='/g;    # Saves space, looks neater.
    $chans_shown = "/labelBottomProc { $chans_shown } def \n";
    return $chans_shown, \@chans_not_shown;
}

# Output data in PostScript file format.
sub graph_lines_ps {
    my ( $self, $path_out_ps, $lh_aref, $rh_aref ) = @_;
    $| = 1;

    my ( $ps_defs, $chans_hidden_aref ) =
      $self->ps_defs_insert( $lh_aref, $rh_aref );

    $self->graph_write( $path_out_ps, $ps_defs, $chans_hidden_aref );
}

# Write PostScript graph to file path.
sub graph_write {
    my ( $self, $path_out_ps, $ps_user_defs, $chans_hidden_aref ) = @_;
    if ( open GRAPH_PS, ">$path_out_ps" ) {
    
        # Embed filename sans path in PostScript header.
        $self->{ps_header} =~ s/%%Title:/%%Title: $path_out_ps)/;
        $self->{ps_header} =~ s/%%Title:.*\//%%Title: (/;
        
        # Embed document font resources.
        my $docRes = "font $self->{fontName} Symbol";
        $self->{ps_header} =~ s/%%DocumentResources:/%%DocumentResources: $docRes/;
        
        print GRAPH_PS $self->{ps_header};
        print GRAPH_PS "$ps_web_colors_dict \n";
        print GRAPH_PS "$ps_prolog_generic \n";
        print GRAPH_PS "$ps_prolog_graphing \n";
        print GRAPH_PS "$ps_prolog_data_arrays \n";
        print GRAPH_PS "$ps_prolog_drawing \n";
        print GRAPH_PS "$ps_user_defs \n";
        print GRAPH_PS "/pgWidth $self->{pgWidth} def \n";
        print GRAPH_PS "/pgHeight $self->{pgHeight} def \n";
        for ( @{ chans_pl2ps($self, $chans_hidden_aref ) } ) {
            print GRAPH_PS;
        }
        print GRAPH_PS "$ps_tail \n";
        close GRAPH_PS;
        print "Okay, PS file written to path '$path_out_ps' \n";
    }
    else { print qq|Oops! Cannot write to $path_out_ps: $!\n| }
}

# Convert kept Perl $chan_arefs to sequential PostScript /columnArrays.
sub chans_pl2ps {
    my ($self, $chans_hidden_aref ) = @_;
    my @graph_ps;
    my $k = 0;

    # Write data from all chans into PostScript arrays
    for my $i ( 0 .. $#$chan_arefs ) {
        my $array_ps = " [ ";
        for ( 0 .. $#{ $chan_arefs->[0] } ) {
            $array_ps .= sprintf "%.3e ", $chan_arefs->[$i][$_];
        }
        $array_ps .= " ] def \n\n";

        # If skipping chans, is this chan among those not shown?
        my $flg = 0;
        if ($self->{skip_over}) {
            for (@$chans_hidden_aref) {
                if ( $_ == $i ) { $flg = 1; last; }
            }
        }

        # Renumber chans so that PostScript progs /columnArray's will
        # be innumerated in sequence with no gaps.
        if ( $i == 0 || $flg == 0 ) {
            $array_ps = "/columnArray-$k $array_ps";
            push @graph_ps, $array_ps;
            ++$k;
        }
    }
    push @graph_ps, "\n true \n";
    return \@graph_ps;
}

BEGIN {

	$ps_web_colors_dict = <<'EOHD';
% Web safe colors defined by name
% Ref (http://en.wikipedia.org/wiki/Web_colors)
/webColorsDict 50 dict def
webColorsDict begin

% Red colors
/IndianRed   { 16#CD 16#5C 16#5C } def
/LightCoral  { 16#F0 16#80 16#80 } def
/Salmon      { 16#FA 16#80 16#72 } def
/DarkSalmon  { 16#E9 16#96 16#7A } def
/LightSalmon { 16#FF 16#A0 16#7A } def
/Crimson     { 16#DC 16#14 16#3C } def
/Red         { 16#FF 16#00 16#00 } def
/FireBrick   { 16#B2 16#22 16#22 } def
/DarkRed     { 16#8B 16#00 16#00 } def

% Pink colors
/Pink            { 16#FF 16#C0 16#CB } def
/LightPink       { 16#FF 16#B6 16#C1 } def
/HotPink         { 16#FF 16#69 16#B4 } def
/DeepPink        { 16#FF 16#14 16#93 } def
/MediumVioletRed { 16#C7 16#15 16#85 } def
/PaleVioletRed   { 16#DB 16#70 16#93 } def

% Orange colors
/LightSalmon     { 16#FF 16#A0 16#7A } def
/Coral           { 16#FF 16#7F 16#50 } def
/Tomato          { 16#FF 16#63 16#47 } def
/OrangeRed       { 16#FF 16#45 16#00 } def
/DarkOrange      { 16#FF 16#8C 16#00 } def
/Orange          { 16#FF 16#A5 16#00 } def

% Yellow colors
/Gold                 { 16#FF 16#D7 16#00 } def
/Yellow               { 16#FF 16#FF 16#00 } def
/LightYellow          { 16#FF 16#FF 16#E0 } def
/LemonChiffon         { 16#FF 16#FA 16#CD } def
/LightGoldenrodYellow { 16#FA 16#FA 16#D2 } def
/PapayaWhip           { 16#FF 16#EF 16#D5 } def
/Moccasin             { 16#FF 16#E4 16#B5 } def
/PeachPuff            { 16#FF 16#DA 16#B9 } def
/PaleGoldenrod        { 16#EE 16#E8 16#AA } def
/Khaki                { 16#F0 16#E6 16#8C } def
/DarkKhaki            { 16#BD 16#B7 16#6B } def

% Purple colors
/Lavender      { 16#E6 16#E6 16#FA } def
/Thistle       { 16#D8 16#BF 16#D8 } def
/Plum          { 16#DD 16#A0 16#DD } def
/Violet        { 16#EE 16#82 16#EE } def
/Orchid        { 16#DA 16#70 16#D6 } def
/Fuchsia       { 16#FF 16#00 16#FF } def
/Magenta       { 16#FF 16#00 16#FF } def
/MediumOrchid  { 16#BA 16#55 16#D3 } def
/MediumPurple  { 16#93 16#70 16#DB } def
/BlueViolet    { 16#8A 16#2B 16#E2 } def
/DarkViolet    { 16#94 16#00 16#D3 } def
/DarkOrchid    { 16#99 16#32 16#CC } def
/DarkMagenta   { 16#8B 16#00 16#8B } def
/Purple        { 16#80 16#00 16#80 } def
/Indigo        { 16#4B 16#00 16#82 } def
/SlateBlue     { 16#6A 16#5A 16#CD } def
/DarkSlateBlue {  16#48 16#3D 16#8B } def

% Green colors
/GreenYellow       { 16#AD 16#FF 16#2F } def
/Chartreuse        { 16#7F 16#FF 16#00 } def
/LawnGreen         { 16#7C 16#FC 16#00 } def
/Lime              { 16#00 16#FF 16#00 } def
/LimeGreen         { 16#32 16#CD 16#32 } def
/PaleGreen         { 16#98 16#FB 16#98 } def
/LightGreen        { 16#90 16#EE 16#90 } def
/MediumSpringGreen { 16#00 16#FA 16#9A } def
/SpringGreen       { 16#00 16#FF 16#7F } def
/MediumSeaGreen    { 16#3C 16#B3 16#71 } def
/SeaGreen          { 16#2E 16#8B 16#57 } def
/ForestGreen       { 16#22 16#8B 16#22 } def
/Green             { 16#00 16#80 16#00 } def
/DarkGreen         { 16#00 16#64 16#00 } def
/YellowGreen       { 16#9A 16#CD 16#32 } def
/OliveDrab         { 16#6B 16#8E 16#23 } def
/Olive             { 16#80 16#80 16#00 } def
/DarkOliveGreen    { 16#55 16#6B 16#2F } def
/MediumAquamarine  { 16#66 16#CD 16#AA } def
/DarkSeaGreen      { 16#8F 16#BC 16#8F } def
/LightSeaGreen     { 16#20 16#B2 16#AA } def
/DarkCyan          { 16#00 16#8B 16#8B } def
/Teal              { 16#00 16#80 16#80 } def

% Blue colors
/Aqua            { 16#00 16#FF 16#FF } def
/Cyan            { 16#00 16#FF 16#FF } def
/LightCyan       { 16#E0 16#FF 16#FF } def
/PaleTurquoise   { 16#AF 16#EE 16#EE } def
/Aquamarine      { 16#7F 16#FF 16#D4 } def
/Turquoise       { 16#40 16#E0 16#D0 } def
/MediumTurquoise { 16#48 16#D1 16#CC } def
/DarkTurquoise   { 16#00 16#CE 16#D1 } def
/CadetBlue       { 16#5F 16#9E 16#A0 } def
/SteelBlue       { 16#46 16#82 16#B4 } def
/LightSteelBlue  { 16#B0 16#C4 16#DE } def
/PowderBlue      { 16#B0 16#E0 16#E6 } def
/LightBlue       { 16#AD 16#D8 16#E6 } def
/SkyBlue         { 16#87 16#CE 16#EB } def
/LightSkyBlue    { 16#87 16#CE 16#FA } def
/DeepSkyBlue     { 16#00 16#BF 16#FF } def
/DodgerBlue      { 16#1E 16#90 16#FF } def
/CornflowerBlue  { 16#64 16#95 16#ED } def
/MediumSlateBlue { 16#7B 16#68 16#EE } def
/RoyalBlue       { 16#41 16#69 16#E1 } def
/Blue            { 16#00 16#00 16#FF } def
/MediumBlue      { 16#00 16#00 16#CD } def
/DarkBlue        { 16#00 16#00 16#8B } def
/Navy            { 16#00 16#00 16#80 } def
/MidnightBlue    { 16#19 16#19 16#70 } def

% Brown colors
/Cornsilk       { 16#FF 16#F8 16#DC } def
/BlanchedAlmond { 16#FF 16#EB 16#CD } def
/Bisque         { 16#FF 16#E4 16#C4 } def
/NavajoWhite    { 16#FF 16#DE 16#AD } def
/Wheat          { 16#F5 16#DE 16#B3 } def
/BurlyWood      { 16#DE 16#B8 16#87 } def
/Tan            { 16#D2 16#B4 16#8C } def
/RosyBrown      { 16#BC 16#8F 16#8F } def
/SandyBrown     { 16#F4 16#A4 16#60 } def
/Goldenrod      { 16#DA 16#A5 16#20 } def
/DarkGoldenrod  { 16#B8 16#86 16#0B } def
/Peru           { 16#CD 16#85 16#3F } def
/Chocolate      { 16#D2 16#69 16#1E } def
/SaddleBrown    { 16#8B 16#45 16#13 } def
/Sienna         { 16#A0 16#52 16#2D } def
/Brown          { 16#A5 16#2A 16#2A } def
/Maroon         { 16#80 16#00 16#00 } def

% White colors
/White         { 16#FF 16#FF 16#FF } def
/Snow          { 16#FF 16#FA 16#FA } def
/Honeydew      { 16#F0 16#FF 16#F0 } def
/MintCream     { 16#F5 16#FF 16#FA } def
/Azure         { 16#F0 16#FF 16#FF } def
/AliceBlue     { 16#F0 16#F8 16#FF } def
/GhostWhite    { 16#F8 16#F8 16#FF } def
/WhiteSmoke    { 16#F5 16#F5 16#F5 } def
/Seashell      { 16#FF 16#F5 16#EE } def
/Beige         { 16#F5 16#F5 16#DC } def
/OldLace       { 16#FD 16#F5 16#E6 } def
/FloralWhite   { 16#FF 16#FA 16#F0 } def
/Ivory         { 16#FF 16#FF 16#F0 } def
/AntiqueWhite  { 16#FA 16#EB 16#D7 } def
/Linen         { 16#FA 16#F0 16#E6 } def
/LavenderBlush { 16#FF 16#F0 16#F5 } def
/MistyRose     { 16#FF 16#E4 16#E1 } def

% Grey colors
/Gainsboro      { 16#DC 16#DC 16#DC } def
/LightGrey      { 16#D3 16#D3 16#D3 } def
/Silver         { 16#C0 16#C0 16#C0 } def
/DarkGray       { 16#A9 16#A9 16#A9 } def
/Gray           { 16#80 16#80 16#80 } def
/DimGray        { 16#69 16#69 16#69 } def
/LightSlateGray { 16#77 16#88 16#99 } def
/SlateGray      { 16#70 16#80 16#90 } def
/DarkSlateGray  { 16#2F 16#4F 16#4F } def
/Black          { 16#00 16#00 16#00 } def
% end

EOHD

    $ps_header = <<'EOHD';
%!PS-Adobe-2.0 EPSF-2.0
%%Title:
%%Version: (2006-08-01)
%%Copyright: (Gan Uesli Starling)
%%For: (Perl Module GUS::PSGraph)
%%BoundingBox:
%%DocumentResources:
%%EndComments
%%BeginProlog

EOHD

    $ps_prolog_generic = <<'EOHD';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%  BEGIN Generic PROLOG  %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/GraphDict 100 dict def
GraphDict begin

% Here I set an artificial points value for 1 inch. Do not change this
% if output is to be on paper. If, however, output is to be a video screen
% graphic of arbitrary size, then you can bloat or shink it overall by
% tinkering with this ratio. Don't change here. Send new value from Perl.
/ppi 72 def
%
/ppiAdj {
  /cnt exch def
  cnt { 72 ppi div mul cnt 1 roll } repeat
} def

% Common measurements inter-related.
/in { 72 mul } def
/mm { 25.399 div 72 mul } def
/in2pts { 72 div } def
/mm2pts { 72 div 25.399 mul } def

/bgColor (Black) def % Default black background.
/fgColor (White) def % Default white foreground.

% Display very finely by locking movents to exact pixel boundaries.
% Modified from "Don Lancaster's PostScript Secrets", page 2, item 3.
%
/movetoOld   /moveto   load def
/linetoOld   /lineto   load def
/curvetoOld  /curveto  load def
/rmovetoOld  /rmoveto  load def
/rlinetoOld  /rlineto  load def
%
/moveto  {
  transform round exch round exch itransform movetoOld
} bind def
%
/lineto  {
  transform round exch round exch itransform linetoOld
} bind def
%
/rmoveto {
  currentpoint 3 -1 roll add 3 1 roll add exch
  transform round exch round exch itransform movetoOld
} bind def
%
/rlineto {
  currentpoint 3 -1 roll add 3 1 roll add exch
  transform round exch round exch itransform linetoOld
} bind def
%
/curveto
{ transform round exch round exch itransform 6 2 roll
  transform round exch round exch itransform 6 2 roll
  transform round exch round exch itransform 6 2 roll curvetoOld
} bind def

% Divide by almost-zero when given zero.
/div { dup 0 eq {pop 1.0e-32} if div } bind def

/p   { print } def
/pf  { print flush } bind def
/xor { 1 index and not and } def
/fix { currentfile closefile clear erasepage } def

% BREAK POINT Loops for %stdin ( str --  )
/bp
{ (<<< ) p  p ( >>>\n\n) pf
  pstack flush
  { (%stdin)(r)file 32 string readline
    { pop
      exit
    } if
  }loop
}def

/showDot { (.) pf } bind def

% Modified from "Don Lancaster's PostScript Secrets", page 11, item 3.
/solveRealWidth  % ( str -- str r )
{
  gsave
    nulldevice 0 0 moveto
    dup dup type (stringtype) eq
    { show }{ cvx exec } ifelse
    currentpoint pop
  grestore
} def

/centerShow {
  solveRealWidth
  -2 div 0 rmoveto
  dup type
  (stringtype) eq { show }{ cvx exec } ifelse
} def

/centerShowResized % ( str/proc r -- )
{
  /maxWidth exch def
  solveRealWidth /realWidth exch def

  % If string too wide, show it shrunken to fit.
  realWidth maxWidth gt
  {
    fontName findfont
    maxWidth realWidth div fontSize mul scalefont
    setfont
    centerShow
    fontName findfont fontSize scalefont setfont
  }
  { centerShow
  } ifelse
} def

% OP BELOW PERFORMS X OFFSET ON moveto FOR CENTERING PROPORTIONAL FONTS.

/alignCenter
{ gsave
    nulldevice
    currentpoint pop
    exch show
    currentpoint pop sub
  grestore
  .5 mul 0 rmoveto
} def

/alignRight
{ gsave
    nulldevice
    currentpoint pop
    exch show
    currentpoint pop sub
  grestore
  0 rmoveto
} def

% OP BELOW ROUNDS OFF TO 3RD DIGIT BELOW 3 DIGITS, TO INT ABOVE THREE DIGITS.
% ABOVE AND BELOW ZERO SHOWS THE SAME LAST DIGIT... NOT +1.66 AND = 1.67.

/roundOff
{ dup ceiling cvi 32 string cvs
  length
  dup 3 ge { 0 exch } if
  dup 2 eq { 1 exch } if
  dup 1 eq { 2 exch } if
  pop
  dup 0 eq
  {  pop cvi
  }{ exch 1 index
     { 10 mul } repeat
     round
     exch
     { 10 div } repeat
   } ifelse
} def

/incValue
{ dup cvx exec
  1 add def
} def

/decValue
{ dup cvx exec
  1 sub def
} def

/spliceASN
{ exch
  /XXX
  2 { 2 index length } repeat
  add
  2 index type
  dup /arraytype eq
    {  pop array def false
    }{ /nametype eq
       {  string def
          32 string cvs exch
          32 string cvs exch
          true
       }{ string def false
        } ifelse
     } ifelse
  exch XXX
  1 index length
  5 -1 roll
  putinterval
  XXX 0
  3 -1 roll
  putinterval
  XXX exch
    { cvn /XXX 1 index def
    } if
} bind def

/spliceS
{ exch
  /XXX
  2 { 2 index length } repeat
  add string def
  XXX
  1 index length
  4 -1 roll
  putinterval
  XXX 0
  3 -1 roll
  putinterval
  XXX
} bind def

/spliceS&cvn
{ 1 index 32 string cvs
  spliceASN cvn
} def

/tackOntoArray
{ /TackOn 1 array def
  TackOn 0 3 -1 roll
  put
  TackOn spliceASN
} bind def

/shiftArray
{ dup cvx exec
  dup length dup 0 eq
  {
    pop pop pop false
  }{ 1 index 0 get
     4 1 roll
     dup 1 eq
     {
        pop pop [] def
     }{
        1 exch 1 sub
        getinterval def
      } ifelse
      true
   } ifelse
} bind def

% OPS TO INC & DEC ALL ELEMS OF A NUMERIC ARRAY

/incArrayElems
{ [ exch
  { 1 add
  } forall
  ]
} def

/decArrayElems
{ [ exch
  { 1 sub
  } forall
  ]
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%
%%  END Generic PROLOG  %%
%%%%%%%%%%%%%%%%%%%%%%%%%%

EOHD

    $ps_prolog_graphing = <<'EOHD';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%  BEGIN Graphing PROLOG  %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% INITIAL GRAPHING SET-UP OPERATORS

/hTicks 9 def
/hMaxValue 9 def
/hMinValue 0 def
/vTicks 10 def
/vTicksRH 10 def
/vMaxValue 2 def
/vMaxValueRH 2 def
/vMinValue 0 def
/vMinValueRH 0 def

/thin    { 0.35 setlinewidth } def
/thick   { 0.70 setlinewidth } def
/thicker { 0.95 setlinewidth } def

/bgLineEdge
{ gsave
    currentlinewidth 1.75 mul setlinewidth
    bgColor cvx exec setColorRGB exec
    [ ] 0 setdash
    stroke
  grestore
} def

/showCurveId
{ gsave
    fgColor cvx exec setColorRGB exec
    showX showY 4 sub moveto currentpoint
    fontName findfont fontSize .8 mul scalefont setfont
    idPointChar alignCenter
    idPointChar true charpath
    gsave
      bgColor cvx exec setColorRGB exec
      5 setlinewidth
      stroke
    grestore
    gsave
      lineColor exec fill
    grestore
    moveto 0 -5 rmoveto
    segregate?
    { /Symbol findfont 6 scalefont setfont
      columnRH? { ( \256)}{ ( \254)} ifelse
      dup alignCenter
      true charpath
      gsave
        bgColor cvx exec setColorRGB exec
        4 setlinewidth
        stroke
      grestore
      lineColor exec fill
    } if
  grestore
} def

% BELL & WHISTLE. USED TO DISPLAY DATA SET AND CURVE NUMBERS ON THE GRAPH.

/idPointSpc { hLength 3 div } def

% Show an ID char for reach curve.
/idPoint
{ /y exch def /x exch def
  x idPointSpc
  showY 0 eq { 2 div } if
  sub
  showX gt
  {
    showCurveIdX x
    tackOntoArray
    /showCurveIdX exch def
    showCurveIdY y
    tackOntoArray
    /showCurveIdY exch def
    /showX x def
    /showY y def
  } if
} bind def

/addTickRH
{ segregate?
  { 2 mm add
  } if
} def

/hLine1 { hLength 0 rlineto stroke } def

/hLine2
{ -2 mm 0 rmoveto
  hLength 2 mm add addTickRH 0 rlineto thick stroke thin
} def

/hLines
{ origin moveto
  thick hLine2 thin
  /i 1 def
  vTicks
  { origin vinc i mul add moveto hLine1
    origin vinc i 1 add mul add moveto hLine2
    /i i 2 add def
  } repeat
} def

/vLine1 { 0 vHeight rlineto stroke } def

/vLine2
{ 0 -2 mm rmoveto
  0 vHeight 2 mm add rlineto thick stroke thin
} def

/vLines
{ origin moveto thick vLine2 thin /i 1 def
  hTicks
  { origin exch hinc i mul add exch moveto vLine1
    origin exch hinc i 1 add mul add exch moveto vLine2
    /i i 2 add def
  } repeat
} def

% SCALING OPERATORS

/hTickValue { hMaxValue hMinValue sub hTicks div } def
/vTickValue { vMaxValue vMinValue sub vTicks div } def

/vTickValueRH { vMaxValueRH vMinValueRH sub vTicks div } def

/hinc { gridWidth  hTicks 2 mul div } def
/vinc { gridHeight vTicks 2 mul div } def

/hLength { hTicks 2 mul hinc mul } def
/vHeight { vTicks 2 mul vinc mul } def
/vUnits {  vTickValue div vinc mul 2 mul } def

/vUnitsRH { vTickValueRH  div vinc mul 2 mul} def

/hUnits {  hTickValue div hinc mul 2 mul } def

% SCALE DISPLAY OPERATORS

/marksLeft
{ /i 0 def
  vTicks -1 0
  { origin exch 10 sub exch vinc i mul add 3 sub moveto
    gsave
      vMaxValue vTickValue 2 index mul sub
      roundOff
      32 string cvs
      dup stringwidth pop neg 0 rmoveto show
    grestore
    /i i 2 add def
  } for
  pop
  gsave
    origin moveto
    90 rotate
    vHeight 2 div 40 rmoveto
    currentpoint
    labelLeft vHeight centerShowResized
    20 add moveto
    labelLeft2 vHeight centerShowResized
  grestore
} def

/marksRight
{ /i 0 def
  vTicks -1 0
  { origin
      exch hLength add 10 add exch
      vinc i mul add 3 sub
    moveto
    gsave
      vMaxValueRH vTickValueRH 2 index mul sub
      roundOff
      32 string cvs
      dup show
    grestore
    /i i 2 add def
  } for
  pop
  gsave
    origin moveto
    -90 rotate
    vHeight -2 div hLength 45 add rmoveto
    180 rotate
    currentpoint
    labelRight vHeight centerShowResized
    20 sub moveto
    labelRight2 vHeight centerShowResized
  grestore
} def

/marksTop
{ /i 0 def
  hTicks -1 0
  { origin exch hinc i mul add 3 sub exch 10 sub moveto
    gsave
      270 rotate
      hMaxValue hTickValue 2 index mul sub
      roundOff
      32 string cvs
      show
    grestore
    /i i 2 add def
  } for
  pop
  origin moveto hLength 2 div vHeight 20 add rmoveto
  labelTop hLength origin pop add centerShowResized
} def

/centerBottom {
  origin moveto hLength 2 div 0 rmoveto
} def

/maxWidthBottom { pgWidth 20 sub } def

/marksBottom
{ /i 0 def
  hTicks -1 0
  { origin exch hinc i mul add 3 sub exch 10 sub moveto
    gsave
      270 rotate
      hMaxValue hTickValue 2 index mul sub
      roundOff
      32 string cvs
      show
    grestore
    /i i 2 add def
  } for
  pop
  centerBottom 0 -50 rmoveto
  labelBottom maxWidthBottom centerShowResized
  centerBottom 0 -70 rmoveto
  /labelBottomProc maxWidthBottom centerShowResized
  labelBottom2 length 0 gt
  { centerBottom 0 -90 rmoveto
    labelBottom2 maxWidthBottom centerShowResized
  } if
} def

/xpnt { 3 index exch exp mul } def

/plotPairedArrays
{ /showCurveIdX [] def
  /showCurveIdY [] def

  0 1 pointsArray length 1 sub
  {
    pointsArray 1 index get
    columnArray-0 2 index get

    hMinValue sub exch

    vMinValue
    columnRH? { vRatioRH div } if
    sub exch

    hUnits exch

    columnRH?
    { vUnitsRH vMinValueRH vUnitsRH sub vMinValue vUnits add
    }{ vUnits
     } ifelse

    3 -1 roll 0 eq
    {  2 copy moveto
    }{ 2 copy lineto
     } ifelse

    idPoint

  } for
} bind def

/plotPairs
{ /showX
    curveId
    15 mul
    dataSetId 1 sub
    10 mul add
  def

  /showY 0 def

  gsave
    origin moveto
    currentpoint translate

    plotPairedArrays

    bgLineEdge
    stroke

    gsave
      0 1 showCurveIdX length 1 sub
      { showCurveId
        showCurveIdX 1 index get
        /showX exch def
        showCurveIdY exch get
        /showY exch def
      } for
    grestore

  grestore
} bind def

/plotLines
{ gsave
    origin moveto currentpoint translate
    0 5 x-fin
    { y.line exch mm exch mm
      dup 0 lt { pop 0 } if
      lineOp
    } for
    stroke
  grestore
} bind def

/formula
{ -194.77 250.75 2 index mul add
  .13976 2 index 2 exp mul sub
  2.2082e-2 3 xpnt sub
  1.5757e-4 4 xpnt add
  3.2312e-7 5 xpnt sub
} def

/doCurve
{ /x-fin 200 def /y.line { formula } def
  plotPairs stroke
} def

/graph
{ fontName findfont fontSize scalefont setfont
  origin moveto
  hTickValue vTickValue
  hLines vLines
  segregate? { marksRight } if
  marksLeft marksTop marksBottom
} def

/bgColorBBox
{ 0 0 moveto
  pgWidth 0 lineto
  pgWidth pgHeight lineto
  0 pgHeight lineto
  closepath
  bgColor cvx exec setColorRGB exec
  fill
} def

/doGraph
{ /origin { 80 110 } def
  /gridHeight { pgHeight origin exch pop 2 mul sub 60 add } def
  /gridWidth  { pgWidth origin pop 2 mul sub } def
  gsave fgColor cvx exec setColorRGB exec
  graph grestore
} def

/compensate { } def % {1 1.08133 div mul} def

/floorCeilDiv 10 def

/setCeiling
{ /lowCeiling false def
  allYColsMax
  dup 0 gt
  1 index 1 lt and
  { floorCeilDiv mul
    /lowCeiling true def
  } if
  ceiling
  lowCeiling { floorCeilDiv div } if
} def

/setFloor
{ allYColsMin
  lowCeiling { floorCeilDiv mul } if
  floor
  lowCeiling { floorCeilDiv div } if
} def

/initGraphParams
{ 1 setlinecap
  1 setlinejoin

  segregate?
  {   segregateYCoords

      /vMaxValue setCeiling def
      /vMinValue setFloor def

      % Must calcualte vTicks ahead of other functions, even if redundantly.

      exchYCoords
      /vMaxValueRH setCeiling def
      /vMinValueRH setFloor def
      exchYCoords

      /vTicks
        vMaxValue vMinValue sub
        vMaxValueRH vMinValueRH sub mul
        abs cvi
      def

      /vTicks 6 12 adjustTick

      /vRatioRH
        vMaxValue vMinValue sub
        vMaxValueRH vMinValueRH sub
        div
      def
  }{
     /vMaxValue setCeiling def
     /vMinValue setFloor def

     /vTicks vMaxValue vMinValue sub abs cvi def
     /vTicks 6 12 adjustTick

   } ifelse

  /hMaxValue
    maxMaxVals 0 get
    100 mul
    ceiling roundOff
    100 div
  def

  /hMinValue
    minMinVals 0 get
    100 mul
    floor roundOff
    100 div
  def

  /hTicks hMaxValue hMinValue sub 10 mul abs cvi def

  /hTicks 9 25 adjustTick

  segregate?
  {

  }{ /vRatioRH .9999 def
   } ifelse

} def

% Adjust hTick or vTick to fall between 6 and 20

/adjustTick  % ( /name i i -- )
{ dup
  /ticksMax exch def
  /ticksMin exch def
  % Min ticks are ticksMin.
  dup cvx exec
  { % loop
    dup ticksMin ge
    { cvi def exit
    } if
    2 mul
  } loop
  % Max ticks are ticksMax.
  dup cvx exec
  { % loop
    dup ticksMax le
    { cvi def exit
    } if
    2 div
  } loop
} def

% DRAW ONE CURVE FROM FILE DATA IN ARRAYS.

/drawOneCurve
{ /pointsArray
  (columnArray-)
  curveId 2 string cvs spliceASN
  cvx exec def
  pickDash&Color

  curveId showThisCurve?
  { doCurve
  } if

} def

% DASHED LINES FOR GRAPHING. EACH PATTERN IS A MORSE CODE ALPHABETIC.

/spc 2.5 def
/dit spc 1.5 mul def
/dah dit 3.5 mul def
/linio dah 2.5 mul def

/setDashProcs
[ {  }                                                          %  sans dash
  { [ dit spc dah spc linio spc ] 0 setdash }                   %  .-    a
  { [ dah spc dit spc dit spc dit spc linio spc ] 0 setdash }   %  -...  b
  { [ dah spc dit spc dah spc dit spc linio spc ] 0 setdash }   %  -.-.  c
  { [ dah spc dit spc dit spc linio spc ] 0 setdash }           %  -..   d
  { [ dit spc linio spc ] 0 setdash }                           %  .     e
  { [ dit spc dit spc dah spc dit spc linio spc ] 0 setdash }   %  ..-.  f
  { [ dah spc dah spc dit spc linio spc ] 0 setdash }           %  --.   g
  { [ dit spc dit spc dit spc dit spc linio spc ] 0 setdash }   %  ....  h
  { [ dit spc dit spc linio spc ] 0 setdash }                   %  ..    i
  { [ dit spc dah spc dah spc dah spc linio spc ] 0 setdash }   %  .---  j
  { [ dah spc dit spc dah spc linio spc ] 0 setdash }           %  -.-   k
  { [ dah spc dit spc dah spc dah spc linio spc ] 0 setdash }   %  -.--  l
  { [ dah spc dah spc linio spc ] 0 setdash }                   %  --    m
  { [ dah spc dit spc linio spc ] 0 setdash }                   %  -.    n
  { [ dah spc dah spc dah spc linio spc ] 0 setdash }           %  ---   o
  { [ dah spc dit spc dit spc dah spc linio spc ] 0 setdash }   %  -..-  p
  { [ dah spc dah spc dit spc dah spc linio spc ] 0 setdash }   %  --.-  q
  { [ dit spc dah spc dit spc linio spc ] 0 setdash }           %  .-.   r
  { [ dit spc dit spc dit spc linio spc ] 0 setdash }           %  ...   s
  { [ dah spc linio spc ] 0 setdash }                           %  -     t
  { [ dah spc dit spc dit spc linio spc ] 0 setdash }           %  ..-   u
  { [ dit spc dit spc dit spc dah spc linio spc ] 0 setdash }   %  ...-  v
  { [ dah spc dah spc dit spc linio spc ] 0 setdash }           %  --.   w
  { [ dah spc dit spc dit spc dah spc linio spc ] 0 setdash }   %  -..-  x
  { [ dah spc dit spc dah spc dah spc linio spc ] 0 setdash }   %  -.--  y
  { [ dah spc dah spc dit spc dit spc linio spc ] 0 setdash }   %  --..  z
] def

/setColorRGB
{ 3 { 16#ff div
      3 1 roll
    } repeat
  setrgbcolor
} def

% User can add more colors by redefining this array with another
% containing the any of the common browser web color names as per
% the separate dictionary herewith included.
/webColors [
	/Red    /Lime    /Blue
	/Yellow /Magenta /Cyan
] def

% Show a string in indexed color.
/showColor   % ( str i -- )
{
    currentrgbcolor 5 3 roll
    1 sub webColors length mod
    webColors exch
    get cvx exec
    setColorRGB
    show
    setrgbcolor
} def

% ASSIGN COLOR AND DASHLINE TO A CURVE.
/pickDash&Color
{
  setDashProcs dataSetId 1 sub
  setDashProcs length mod get
  cvx exec

  % Define a color for a line and its chars.
  /lineColor
    webColors
    curveId 1 sub webColors length mod
    get 32 string cvs
    ( setColorRGB ) spliceASN cvx
  def

  lineColor exec % Set color for the line.

  /idPointChar curveId 3 string cvs def

  dataSets 1 gt
  {  /idPointChar
       ( ) idPointChar spliceASN
     def

     idPointChar 0
     (A) 0 get dataSetId 1 sub add
     put
  }if

  /curveId incValue
} def


%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%  END Graphing PROLOG  %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%

EOHD

    $ps_prolog_data_arrays = <<'EOHD';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%  BEGIN Data Arrays PROLOG  %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/pointer 0 def

/keptComments () def

% MORE OPS                            \

/dataSetId 1 def

/appendDataSetId
{ (-)
  dataSetId 32 string cvs
  spliceASN
  spliceASN
} def

/pointer 0 def

% FETCH COLUMN ARRAYS FOR CURRENT dataSetId

/fetchColumnArrays
{ 0
  { (columnArray-) 1 index
    2 string cvs spliceASN
    appendDataSetId
    cvn
    currentdict 1 index known
    { dup cvx exec
      [] ne
      {  (columnArray-)
         2 index 3 string cvs spliceASN
         cvn 1 index cvx exec
         dup length array
         copy def
         pop
      }{ pop
       } ifelse
    }{ pop pop exit
     } ifelse
    1 add
  } loop
} bind def


% FOR FINDING THE MAX VALUE IN ANY COLUMN OF dataArray

/minMaxCnt 50 def

/initMinMaxVals
{ /maxMaxVals minMaxCnt array
  0 1 minMaxCnt 1 sub
  { 1 index exch 16#80000000 put
  } for
  def

  /maxMaxValsRH
  [ maxMaxVals aload pop
  ] def

  /minMinVals minMaxCnt array
  0 1 minMaxCnt 1 sub
  { 1 index exch 16#7fffffff put
  } for
  def

  /minMinValsRH
  [ minMinVals aload pop
  ] def

} def

initMinMaxVals

/columnRH?
{ curveId 1 sub false
  columnsRH

  flgFakeColZero
  { decArrayElems
  } if

  {
    2 index eq or
  } forall
  exch pop
} def

/segregateYCoords
{ columnsRH
  flgFakeColZero
  { decArrayElems
  } if
  { minMinVals 1 index get
    minMinValsRH 2 index get
    minMinVals exch
    3 index exch put
    minMinValsRH exch
    2 index exch put

    maxMaxVals 1 index get
    maxMaxValsRH 2 index get
    maxMaxVals exch
    3 index exch put
    maxMaxValsRH exch
    2 index exch put
    pop
  } forall
} def

% EXCHANGES DEFAULT Y COORD DATA WITH RH Y COORD DATA. DO AGAIN TO PUT BACK.
/exchYCoords
{ /maxMaxVals maxMaxValsRH
  /maxMaxValsRH maxMaxVals
  def def

  /minMinVals minMinValsRH
  /minMinValsRH minMinVals
  def def
} def

/allYColsMax
{ 16#80000000
  1 1 minMaxCnt 1 sub
  { % for
    maxMaxVals exch get
    dup 2 index gt
      {  exch pop
      }{ pop
       } ifelse
  } for
} def

/allYColsMin
{ 16#7fffffff
  1 1 minMaxCnt 1 sub
  { % for
    minMinVals exch get
    dup 2 index lt
      {  exch pop
      }{ pop
       } ifelse
  } for
} def

/maxMaxStore
{ maxMaxVals 3 index get
  1 index lt
    { maxMaxVals 3 index
      2 index put
    } if
} def

/minMinStore
{ minMinVals 3 index get
  1 index gt
    { minMinVals 3 index
      2 index put
    } if
} def

/maxColumnVal
{ 16#80000000
  0 1
  columnArray length 1 sub
  { % for
    columnArray exch get
    dup 2 index gt
      {  exch pop
      }{ pop
       } ifelse
  } for
  dup 0.0 eq
  { pop 1e-38
  } if
} def

/minColumnVal % ( -- real)
{ 16#7fffffff
  0 1
  columnArray length 1 sub
  { % for
    columnArray exch get
    dup 2 index lt
      {  exch pop
      }{ pop
       } ifelse
  } for
} def

/maxAllColumns
{ 0
  { % loop

    (columnArray-)
    1 index 32 string cvs spliceASN
    dup cvn
    (columnMax-) 3 index 32 string cvs
    spliceASN cvn

    % Exit loop when no more arrays.

    currentdict 2 index known
    { 1 index cvx exec length
      0 eq { pop pop pop exit} if
    }{ pop pop pop exit
     } ifelse

    3 -1 roll pop

    % ARRAY columnArray FILLED WITH CURRENT COLUMN
    /columnArray
    3 -1 roll cvx exec
    def

    maxColumnVal
    maxMaxStore def

    dup 32 string cvs
    (columnMin-) exch spliceASN cvn
    minColumnVal
    minMinStore def

    noShowCurves length
    { % repeat
      2 add
      showThisCurve? { 2 sub exit } if
      1 sub
    } repeat

    1 add

  } loop
  pop
} def

/addFakeColZero?
{ flgFakeColZero
  { rowsCnt fakeColZeroScl div
    roundOff
    32 string cvs
    (\t) spliceASN
    exch spliceASN
  } if
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%  END Data Arrays PROLOG  %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% BEGIN User Overwritable DEFAULTS %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Of chans provided, which not to show. Their colors will be skipped.
/noShowCurves [] def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% END User Overwritable DEFAULTS %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

EOHD

    $ps_prolog_drawing = <<'EOHD';
%%%%%%%%%%%%%%%%%%%%%%%%%%
%% BEGIN drawing PROLOG %%
%%%%%%%%%%%%%%%%%%%%%%%%%%

% RETURN false IF A CHANNEL IS AMONG THOSE EXCLUDED FROM DISPLAY BY USER.
/showThisCurve?
{ true
  noShowCurves
  { 1 add
    2 index ne
    and
  } forall
} def

% DRAW CURVES FOR ALL CHANNELS NOT EXCLUDED BY USER.
/drawAllCurves
{ /curveId 1 def
  initGraphParams
  doGraph
  thicker
  clear

  % Always set dataSetId before calling fetchColumnArrays.
  /dataSets dataSetId def

  1 1 dataSetId
  { /curveId 1 def
    /dataSetId 1 index def
    fetchColumnArrays
    (columnsCnt-) spliceS&cvn
    cvx exec 1 sub
    { drawOneCurve
    } repeat
    pop
  } for
} def

/externalControlConfig
{
  1
  { % loop
    (columnArray-) spliceS&cvn currentdict exch known not
    { /columnsCnt-1 exch def
      exit
    } if
    1 add
  } loop

  /rowsCnt-1 columnArray-1 length def

  flgFakeColZero
  { /columnArray-0
    [ 1 fakeColZeroScl div
      columnArray-1 length
      { % repeat
        dup 1 fakeColZeroScl div add
      } repeat
    ] def
    /columnsRH columnsRH incArrayElems def
  } if

  /segregate?
    columnsRH length 0 eq
    {  false
    }{ true
     } ifelse
  def

  maxAllColumns
} def

%%%%%%%%%%%%%%%%%%%%%%%%
%% END drawing PROLOG %%
%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% BEGIN User-Editable DEFAULTS %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Here are things the user can change by putting in different
% settings, preferably via the Perl interface, rather than here,
% although either way will work.
/flgFakeColZero false def         % For when channel 0 is not X axis
/dataSets 1 def                   % When used standalone (not with Perl).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% END User-Editable DEFAULTS %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% BEGIN Perl-inserted CODE %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

EOHD

    $ps_tail = <<'EOHD';

%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% END Perl-inserted CODE %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%

externalControlConfig
bgColorBBox
drawAllCurves
end % Lose the OminGraphDict
end % Lose the webColorsDict
clear
grestore
showpage

EOHD

}

END {
    return "Just another true value";
}

#############################
# END GUS::PS::Graph MODULE #
#############################

__END__

=head1 NAME

GUS ue Rosette

=head1 VERSION

Release date = 2006-08-01

=head1 STATUS

Default runtime behavior is as a standalone demo of this scipt's own usage.
This is for debugging purposes as I continue to develop new features. You can
still use it for your own data, if you want by hand editing the parameters fed
to the C<command_line_example()> subroutine, interchanging your file paths,
et cetera, for my own.

=head1 SYNOPSIS

Refer to C<command_line_example()> subroutine and the built-in demo. A GUI will
be forthcoming once feature set stabilizes.

=head1 DESCRIPTION

For use in calculating the maximum and minimum principal strains from delta and
rectangular strain gage rosettes. Graphs the output either of two ways, via a
GD::Graph or the embeded module GUS::PSGraph

=head1 FEATURES

Reads in uncorrected strain gage data from a C<*.csv> file. User designates
which of these belong to which kinds of rosettes. Script then calculates the
max and min principal strains along with their their angle.

These data can then be graphed by either of two separate ways. Generally,
one wants to see strain data graphed with two Y axes: max and min principle
strains (in microstrain) on the left, their angles on the on the
right. This can be problematic in Perl but is worked around neatly by handing
off the problem to PostScript.

Resolved data is then output either as another C<*.csv> file, or as graphical
data, or both.

=head2 DATA ERROR CORRECTION

=over 4

=item Transverse Sensitivity

Calculations made for strain gage rosettes include correction for transverse
sensitivity using formulae garnered from Vishay Micro-Measurements Tech Note
TN-509 as detailed by page and formula number within related subroutines.

Rectangular and delta rosettes are treated separately, each with its own unique
correction formula particular to that type with separate GF and Kt for each
gage. A generic retro-rosette subroutine generates uncorrected three-gage output
from corrected max/min principal strains (used in the demo and for debugging).

Columns of original strain gage channels are left uncorrected. If a correction
for single gages is required, an additional column for said corrected data needs
to be appended (just like for rosettes).

=item Wheatstone Bridge Nonlinearity

Not yet implementted. Will be per Vishay Micro-Measurments Tech Note
TN-507-1 when I get to it.

=back

=head1 SUPPORTED FILE FORMATS

=head2 TEXTUAL

Reads in and writes out as text in *.csv file format. Note that any *.csv input
not complying with the IETF recommendation for CSV may cause problems. Supporting
TAB-delimited is on my to-do list.

Run as standalone demo to obtain example *.csv input and output files.

=head2 GRAPHICAL as PNG

For most cases, best to output as *.png via the GD::Graph::lines module.
Unfortunately, however, the GD::Graph module has a bug when it comes to graphing
more than two data sets with dual Y axes for dissimilar ranges. So if you are
wanting to show angles together with strains and have more than a single
rosette, output your graph as PostScript instead as described in the following
heading.

=head2 GRAPHICAL as PostScript

In the one case where GD::Graph::lines routinely fails (as detailed above) use
this alternate module GUS::PSGraph instead to output instead as *.ps.

Via the GUS::PSGraph module, Perl merely defnies a few parameters and embeds
these along with the data into a standalone PostScript program which must then
be fed either to PostScript enabled printer, or to a PostScript interpreter such
as GhostScript.

Note that it is the PostScript program will then handle all aspects of the
graphing event. As such, you must be aware of PostScript's internal limitation
of 65,536 elements maximum per individual data array.

=head1 CAVEATS

This program is free software and a beta-release besides. It carries absolutely
no warranties or guarantees of any kind (expressed, implied, or even vaguely
hinted at).

=head1 DEPENDENCIES

=head2 Perl Modules

Install these into Perl via ActiveState PPM, NetBSD pkgsrc or CPAN as
appropriate for your OS: C<Text::CSV::Simple, GD, GD::Graph and Image::Magick>

My own module C<GUS::PSGraph> is embeded within the text of this Perl program
as I am too lazy, just at the moment, to package it CPAN.

=head2 For Unix

Nothing here presents itself as a difficulty. Required external dependencies
are available from the expected sources: C</usr/pkgsrc> for NetBSD and/or CPAN
for Perl. I can't say for Linux, since I have yet to try it. If any report a
problem for Linux, I'd very like to help work it out and document the solution
here.

=head2 For Win32

No especial problems here either, except that some things are not where most
folks expect to find them.

=over 8

=item ImageMagick for ActiveState Perl 5.8

The Perl Image::Magick module is not maintained by ActiveState. Instead it is
packaged together with the free external software ImageMagick downloadable
from http://imagemagick.org/www/download.html?

=item PPM commands for ActiveState Perl 5.8

The GD and GD::Graph modules are not maintained by ActiveState. They say it is
too difficult and complicated. Other kind folks have graciously ammended this
lack. Type like so into ActiveState's PPM...

ppm> help repository

ppm> repository add "Lincoln Stein" http://stein.cshl.org/ppm

ppm> repository add "Randy Kobes" http://theoryx5.uwinnipeg.ca/ppms

=back

=head1 REQUIRED 3RD-PARTY SOFTWARES

Chances are good you already have one or more of these. All of
them are available on-line for free.

=head2 ImageMagick

Required to generate C<*.png> graphs and to view C<*.ps> graphs.

F<http://www.imagemagick.org/script/index.php>

=head2 Ghostscript

Required to generate C<*.ps> graphs and to resize/convert same.

F<http://www.ghostscript.com/>

=head2 PostScript Viewer

Required to view PostScript on video screen. Obtain from same
source as Ghostscript (C<gv> for UNIX, C<GSView> for Win32).
Since the PostScript output is currently aimed at US Letter,
landscape mode, one of these viewers will be required to resize
output graphs. And besides, the Ghostscript default viewer does
not handle fonts very prettily at low (video screen) resolutions.

=head1 TO DO

This is a very early version, hence there are many things to do. Among these,
the foremost are...

=over 8

=item Plural Data Sets

Make work with plural data set groups as/per original OmniGraph.ps standalone
PostScript program. By this I don't mean in the same sense as GD::Graph uses
the term. They'd call two rosettes from the same file a pair of data sets. I
mean like where you have two or more channels all named "channel one" being as
they are from different files representing plural iterations of the same data
collection process.

So, for instance, each "channel one" from each data set (iteration) would appear
in the same color but differently dashed, according to the file from which each
"channel one" originated.

=item PostScript Clean Up

In my (circa 1991) PostScript code, replace ugly newbie hacks with more
elegant code. Particularly to do away with ever more those custom variables
created on-the-fly via "(Foo#) bar 3 string cvs splice_ASN exec" and replace
them with arrays-of-arrays. Some are done, more yet await.

I should also be able to circumvent PostScript's 65,536 element limitation by
storing channel data too in arrays-of-arrays.

=item Graphing Features

Transfer more of the graphing feature settings from PostScript defaults
to user control via Perl for X and Y sizes, etc.

=item Add a GUI

Cobble up some Perl/Tk to make it easier for non-Perl Mongers to use.

=back

=head1 SCRIPT HISTORY

The PostScript definitions herein embeded derive from a standalone PostScript
program named C<OmniGraph.ps> which I wrote sometime circa 1992 (if memory
serves). This I did in response to frustrations over an upgrade by Measurments
Group to the software in their System 5000 strain gage instrument versus the
graphing feature in their older System 4000.

I already gotten kind of handy in PostScript from wrangling with the PostScript
prolog files of I<Amiga 2000> programs like I<Excellence!> and I<Gold Disk> so
as to publish in Esperanto for which I could find no fonts. From there I went
kind of wild with PostScript using it in all manner of ways for which it was
probably not intended. This I could in no wise have done without the continuing
example of Don Lancaster, noted PostScript guru, for his many excellent articles
in I<Publish> magazine and elsewhere. Ref. F<http://www.tinaja.com>

Most of those ancient efforts have now lain fallow many a year. But once again,
this time in frustration over a (for most folks, trifling) lack in Perl's own
C<GD::Graph> module, I have resurrected my old, trusty C<OmniGraph.ps> and
grafted it piecemeal, with some changes, into C<gus_ue_rosette.pl> so as to work
around the specific issue with GD::Graph where it chokes on dual Y axes needing
multiple channels.

=head1 AUTHOR

Gan Uesli Starling <F<gan@starling.us>>

=head1 COPYRIGHT

Copyright (c) for C<gus_ue_rosette.pl> 2006 Gan Uesli Starling.

Copyright (c) for C<OmniGraph.ps> 1992 - 2006 Gan Uesli Starling.

All rights reserved.

Both C<gus_ue_rosette.pl> and C<OmniGraph.ps> are free software; you may
redistribute and/or edit them under the same terms as Perl itself.

=cut