PostScript::Graph::XY - graph lines and points

    use PostScript::Graph::XY;

    my $xy = new PostScript::Graph::XY();
    $xy->build_chart("results.csv");
    $xy->output("results");

    use PostScript::Graph::XY;
    use PostScript::Graph::Style;

    my $seq = PostScript::Graph::Sequence;
    $seq->setup('color',
	[ [ 1, 1, 0 ],	    # yellow
	  [ 0, 1, 0 ],	    # green
	  [ 0, 1, 1 ], ],   # cyan
      );

    my $xy = new PostScript::Graph::XY(
	    file  => {
		errors    => 1,
		eps       => 0,
		landscape => 1,
		paper     => 'Letter',
	    },

	    layout => {
		dots_per_inch => 72,
		heading       => "Example",
		background    => [ 0.9, 0.9, 1 ],
		heavy_color   => [ 0, 0.2, 0.8 ],
		mid_color     => [ 0, 0.5, 1 ],
		light_color   => [ 0.7, 0.8, 1 ],
	    },

	    x_axis => {
		smallest => 4,
		title    => "Control variable",
		font     => "Courier",
	    },
	    y_axis => {
		smallest => 3,
		title    => "Dependent variable",
		font     => "Courier",
	    },

	    style  => {
		auto  => [qw(color dashes)],
		color => 0,
		line  => {
		    inner_width  => 2,
		    outer_width  => 2.5,
		    outer_dashes => [],
		},
		point => {
		    shape => "circle",
		    size  => 8,
		    color => [ 1, 0, 0 ],
		},
	    },

	    key    => {
		    background => 0.9,
	    },
	);

    $xy->line_from_array(
	[ [ qw(Control First Second Third Fourth),
	    qw(Fifth Sixth Seventh Eighth Nineth)],
	  [ 1, 0, 1, 2, 3, 4, 5, 6, 7, 8 ],
	  [ 2, 1, 2, 3, 4, 5, 6, 7, 8, 9 ],
	  [ 3, 2, 3, 4, 5, 6, 7, 8, 9,10 ],
	  [ 4, 3, 4, 5, 6, 7, 8, 9,10,11 ], ]
	);
    $xy->build_chart();
    $xy->output("controlled");

    $xy = new PostScript::Graph::XY(
	file    => {
	    # see PostScript::File
	},
	layout  => {
	    # see PostScript::Graph::Paper
	},
	x_axis  => {
	    # see PostScript::Graph::Paper
	},
	y_axis  => {
	    # see PostScript::Graph::Paper
	},
	style   => {
	    # see PostScript::Graph::Style
	},
	key     => {
	    # see PostScript::Graph::Key
	},
	chart   => {
	    # see 'new' below 
	},
    );

    Hash Key	Module
    ========	======
    file	PostScript::File
    layout	PostScript::Graph::Paper
    x_axis	PostScript::Graph::Paper
    y_axis	PostScript::Graph::Paper
    style	PostScript::Graph::Style
    key		PostScript::Graph::Key
    chart	this one, see below 

    [ [ 2, 49.7 ],
      [ 3, 53.4 ],
      [ 4. 56.1 ], ]

    [ ["X", "Y", "Yb", "Yc"],
      [x0, y0, yb0, yc0],
      [x1, y1, yb1, yc1],
      [x2, y2, yb2, yc2],
      [x3, y3, yb3, yc3],
      [x4, y4, yb4, yc4],
      [x5, y5, yb5, yc5], ]

    x0, y0
    x1, y1
    x2, y2

    Volts, R1k2, R1k8, R2k2
    4.0,   3.33, 2.22, 1.81
    4.5,   3.75, 2.50, 2.04
    5.0,   4.16, 2.78, 2.27
    5.5,   4.58, 3.05, 2.50

package PostScript::Graph::XY;
our $VERSION = 0.04;
use strict;
use warnings;
use Text::CSV_XS;
use PostScript::File	     1.00 qw(check_file array_as_string);
use PostScript::Graph::Key   1.00;
use PostScript::Graph::Paper 1.00;
use PostScript::Graph::Style 1.00;

sub new {
    my $class = shift;
    my $opt = {};
    if (@_ == 1) { $opt = $_[0]; } else { %$opt = @_; }
   
    my $o = {};
    bless( $o, $class );
    $o->{opt} = $opt;
    
    $o->{opt}{file}   = {} unless (defined $o->{opt}{file});
    $o->{opt}{layout} = {} unless (defined $o->{opt}{layout});
    $o->{opt}{x_axis} = {} unless (defined $o->{opt}{x_axis});
    $o->{opt}{y_axis} = {} unless (defined $o->{opt}{y_axis});
    $o->{opt}{style}  = {} unless (defined $o->{opt}{style});
    $o->{opt}{key}    = {} unless (defined $o->{opt}{key});
    $o->{opt}{chart}  = {} unless (defined $o->{opt}{chart});

    my $ch = $opt->{chart};
    $o->{points} = defined($ch->{show_points})      ? $ch->{show_points}        : 1;
    $o->{lines}  = defined($ch->{show_lines})       ? $ch->{show_lines}         : 1;
    $o->{key}    = defined($ch->{show_key})         ? $ch->{show_key}           : 1;
    $o->{data}   = defined($ch->{data})             ? $ch->{data}               : undef;

    $o->{opt}{style}{sequence} = new PostScript::Graph::Sequence() unless (defined $o->{opt}{style}{sequence});
    $o->build_chart($o->{data}, $opt->{style}) if ($o->{data});

    return $o;
}

sub line_from_array {
    my $o = shift;
    my ($data, $style, $opts, $label);
    foreach my $arg (@_) {
	$_ = ref($arg);
	CASE: {
	    if (/ARRAY/)                    { $data  = $arg; last CASE; }
	    if (/HASH/)                     { $opts  = $arg; last CASE; }
	    if (/PostScript::Graph::Style/) { $style = $arg; last CASE; }
	    $label = $arg;
	}
    }
    die "add_line() requires an array\nStopped"  unless (defined $data);
    $o->{ylabel} = $label                        unless (defined $o->{ylabel});
    
    ## create style object
    $opts = $o->{opt}{style}                     unless (defined $opts);
    $opts->{line} = {}				 unless (defined $opts->{line});
    $opts->{point} = {}				 unless (defined $opts->{point});
    $style = new PostScript::Graph::Style($opts) unless (defined $style); 
    
    ## split multi-columns into seperate lines
    my $name = $o->{default}++;
    my ($first, @rest) = split_data($data);
    foreach my $column (@rest) {
	$o->line_from_array($column, $opts);
    }
    
    ## identify axis titles
    $o->{line}{$name}{xtitle} = "";
    my $line = $o->{line}{$name};
    $line->{ytitle} = $label || "";
    $line->{style} = $style;
   
    my $number = qr/^\s*[-+]?[0-9.]+(?:[Ee][-+]?[0-9.]+)?\s*$/;
    unless ($first->[0][1] =~ $number) {
	my $row = shift(@$first);
	$line->{xtitle} = $$row[0];
	$line->{ytitle} = $$row[1];
    }
    $o->{ylabel} = $line->{ytitle} unless (defined $o->{ylabel});
    
    ## find min and max for each axis
    my @coords;
    my ($xmin, $ymin, $xmax, $ymax);
    foreach my $row (@$first) {
	my ($x, $y) = @$row;
	if ($x =~ $number) {
	    $xmin = $x if (not defined($xmin) or $x < $xmin);
	    $xmax = $x if (not defined($xmax) or $x > $xmax);
	}
	if ($y =~ $number) {
	    $ymin = $y if (not defined($ymin) or $y < $ymin);
	    $ymax = $y if (not defined($ymax) or $y > $ymax);
	}
    }
    $line->{data} = $first;
    $line->{last} = 2 * ($#$first + 1) - 1;
    $line->{xmin} = $xmin;
    $line->{xmax} = $xmax;
    $line->{ymin} = $ymin;
    $line->{ymax} = $ymax;
}

sub line_from_file {
    my ($o, $file, $style) = @_;
    my $filename = check_file($file);
    my @data;
    my $csv = new Text::CSV_XS;
    open(INFILE, "<", $filename) or die "Unable to open \'$filename\': $!\nStopped";
    while (<INFILE>) {
	chomp;
	my $ok = $csv->parse($_);
	if ($ok) {
	    my @row = $csv->fields();
	    push @data, [ @row ] if (@row);
	}
    }
    close INFILE;

    $o->line_from_array( \@data, $style );
}

sub split_data {
    my $data = shift;
    return ([[0, 0]]) unless (ref($data) eq "ARRAY");
    my @res;
    foreach my $row (@$data) {
	if (ref($row) eq "ARRAY") {
	    my ($x, @rest) = @$row;
	    for (my $i = 0; $i <= $#rest; $i++) {
		$res[$i] = [] unless (defined $res[$i]);
		push @{$res[$i]}, [ $x, $rest[$i] ];
	    }
	}
    }
    return @res;
}
# Internal function
# Splits array data of the form 
# [ [x1, a1, b1, c1],
#   [x2, a2, b2, c2], ]
# to an array holding several arrays of (x,y) points
# [ [ [x1, a1], [x2, a2] ],
#   [ [x1, b1], [x2, b2] ],
#   [ [x1, c1], [x2, c2] ], ]

sub build_chart {
    my $o = shift;
    if (@_) {
	if(ref($_[0]) eq "ARRAY") {
	    $o->line_from_array(@_);
	} else {
	    $o->line_from_file(@_);
	}
    }

    ## Define {opt} hash refs
    my ($first, @rest) = sort keys( %{$o->{line}} );
    my $oo  = $o->{opt};
    $oo->{x_axis} = {} unless (defined $oo->{x_axis});
    my $ox        = $o->{opt}{x_axis};
    $oo->{y_axis} = {} unless (defined $oo->{y_axis});
    my $oy        = $o->{opt}{y_axis};
    
    ## Examine all lines for extent of x & y axes and label lengths
    my ($xmin, $ymin, $xmax, $ymax, $xtitle, $ytitle);
    my $maxlen  = 0;
    my $lines   = 0;
    my $lwidth  = 3;
    my $maxsize = 0;
    foreach my $name ($first, @rest) {
	my $line     = $o->{line}{$name};
	my $style    = $line->{style};
	my $lw       = $style->line_outer_width();
	my $size     = $style->point_size() + $lwidth;
	$maxsize     = $size if ($size > $maxsize);
	$lwidth      = $lw/2 if ($lw/2 > $lwidth);
	$xmin        = $line->{xmin} if (not defined($xmin) or $line->{xmin} < $xmin);
	$xmax        = $line->{xmax} if (not defined($xmax) or $line->{xmax} > $xmax);
	$ymin        = $line->{ymin} if (not defined($ymin) or $line->{ymin} < $ymin);
	$ymax        = $line->{ymax} if (not defined($ymax) or $line->{ymax} > $ymax);
	$ox->{title} = $line->{xtitle} unless (defined $ox->{title});
	$oy->{title} = $o->{ylabel} unless (defined $oy->{title});
	my $len      = length($line->{ytitle});
	$maxlen      = $len if ($len > $maxlen);
	$lines++;
    }
    $ox->{low}  = $xmin;
    $ox->{high} = $xmax;
    $oy->{low}  = $ymin;
    $oy->{high} = $ymax;
   
    ## Ensure PostScript::File exists
    $oo->{file}   = {} unless (defined $oo->{file});
    my $of        = $o->{opt}{file};
    $of->{left}   = 36 unless (defined $of->{left});
    $of->{right}  = 36 unless (defined $of->{right});
    $of->{top}    = 36 unless (defined $of->{top});
    $of->{bottom} = 36 unless (defined $of->{bottom});
    $of->{errors} = 1 unless (defined $of->{errors});
    $o->{ps}      = (ref($of) eq "PostScript::File") ? $of : new PostScript::File( $of );

    ## Calculate height of GraphPaper y axis
    # used as max_height for GraphKey
    $oo->{layout} = {} unless (defined $oo->{layout});
    my $oc       = $o->{opt}{layout};
    my @bbox     = $o->{ps}->get_page_bounding_box();
    my $bottom   = defined($oc->{bottom_edge})  ? $oc->{bottom_edge}  : $bbox[1]+1;
    my $top      = defined($oc->{top_edge})     ? $oc->{top_edge}     : $bbox[3]-1;
    my $spc      = defined($oc->{spacing})      ? $oc->{spacing}      : 0;
    my $height   = $top - $bottom - 2 * $spc;

    ## Ensure max_height and num_lines are set for GraphKey
    if ($o->{key}) {
	$oo->{key} = {} unless (defined $oo->{key});
	my $ok     = $o->{opt}{key};
	if (defined $ok->{max_height}) {
	    $ok->{max_height} = $height if ($ok->{max_height} > $height);
	} else {
	    $ok->{max_height} = $height; 
	}
	$ok->{num_items}   = $lines;
	my $tsize          = defined($ok->{text_size}) ? $ok->{text_size} : 10;
	$ok->{text_width}  = $maxlen * $tsize * 0.7;
	$ok->{icon_width}  = $maxsize * 3;
	$ok->{icon_height} = $maxsize * 1.5;
	$ok->{spacing}     = $lwidth;
	$o->{gk}           = new PostScript::Graph::Key( $ok );
    }
	
    ## Create GraphPaper now key width is known
    $oo->{file}      = $o->{ps};
    $oc->{key_width} = $o->{key} ? $o->{gk}->width() : 0;
    $o->{gp}         = new PostScript::Graph::Paper( $oo );

    ## Add in lines and key details
    PostScript::Graph::XY->ps_functions( $o->{ps} );
    $o->{gk}->build_key( $o->{gp} ) if ($o->{key});
    $o->{ps}->add_to_page( <<END_INTRO );
	gpaperdict begin 
	gstyledict begin 
	xychartdict begin
END_INTRO
    my $linenum = 1;
    foreach my $name ($first, @rest) {

	## construct point data
	my $line = $o->{line}{$name};
	my $points = "";
	foreach my $row (@{$line->{data}}) {
	    my ($x, $y) = @$row;
	    my $px = $o->{gp}->px($x);
	    my $py = $o->{gp}->py($y);
	    $points = "$px $py " . $points;
	}
	# set style
	my $style = $line->{style};
	$style->background( $o->{gp}->layout_background() );
	$style->write( $o->{ps} );
	
	## prepare code for points and lines
	my ($cmd, $keylines, $keyouter, $keyinner);
	CASE: {
	    if (    $o->{points} and     $o->{lines}) {
		$cmd = "xyboth";
		$keyouter = "point_outer kpx kpy draw1point";
		$keylines = "[ kix0 kiy0 kix1 kiy1 ] 3 2 copy line_outer drawxyline line_inner drawxyline";
		$keyinner = "point_inner kpx kpy draw1point";
	    }
	    if (    $o->{points} and not $o->{lines}) {
		$cmd = "xypoints";
		$keyouter = "point_outer kpx kpy draw1point";
		$keylines = "";
		$keyinner = "point_inner kpx kpy draw1point";
	    }
	    if (not $o->{points} and     $o->{lines}) {
		$cmd = "xyline";
		$keyouter = "";
		$keylines = "[ kix0 kiy0 kix1 kiy1 ] 3 2 copy line_outer drawxyline line_inner drawxyline";
		$keyinner = "";
	    }
	    if (not $o->{points} and not $o->{lines}) {
		$cmd = "";
		$keyouter = "";
		$keylines = "";
		$keyinner = "";
	    }
	}
	
	## write graph and key code
	if ($cmd) {
	    $o->{ps}->add_to_page( "[ $points ] $line->{last} $cmd\n" );
	    $o->{gk}->add_key_item( $line->{ytitle}, <<END_KEY_ITEM ) if ($o->{key});
		2 dict begin
		    /kpx kix0 kix1 add 2 div def
		    /kpy kiy0 kiy1 add 2 div def
		    $keyouter
		    $keylines
		    $keyinner
		end
END_KEY_ITEM
	}
    }
    $o->{ps}->add_to_page( "end end end\n" );
}

sub file { 
    return shift()->{ps}; 
}

sub graph_key { 
    return shift()->{gk}; 
}

sub graph_paper { 
    return shift()->{gp}; 
}

sub sequence { 
    return shift()->{opt}{style}{sequence}; 
}

sub output { 
    shift()->{ps}->output(@_);
}

sub newpage { 
    shift()->{ps}->newpage(@_);
}

sub add_function {
    shift()->{ps}->add_function(@_); 
}

sub add_to_page {
    shift()->{ps}->add_to_page(@_);
}

sub ps_functions {
    my ($class, $ps) = @_;
    my $name = "XYChart";
    # dict entries: style fns=7, style code=19, here=6
    $ps->add_function( $name, <<END_FUNCTIONS ) unless ($ps->has_function($name));
	/xychartdict 35 dict def
	xychartdict begin
	    % _ coords_array last => _
	    /drawxyline {
		xychartdict begin
		    /idx exch def
		    /linearray exch def
		    /y linearray idx get def
		    /idx idx 1 sub def
		    /x linearray idx get def
		    /idx idx 1 sub def
		    newpath
		    x y moveto
		    {
			idx 0 le { exit } if
			/y linearray idx get def
			/idx idx 1 sub def
			/x linearray idx get def
			/idx idx 1 sub def
			x y lineto
		    } loop
		    stroke
		end
	    } bind def
	    
	    % x y => 0
	    % ppshape should be one of the make_ Style functions
	    /draw1point {
		xychartdict begin
		    gsave
			ppshape
			gsave stroke grestore
			eofill
		    grestore
		end
	    } bind def
	    
	    % _ coords_array last => _
	    /drawxypoints {
		xychartdict begin
		    /idx exch def
		    /linearray exch def
		    /y linearray idx get def
		    /idx idx 1 sub def
		    /x linearray idx get def
		    /idx idx 1 sub def
		    x y draw1point
		    {
			idx 0 le { exit } if
			/y linearray idx get def
			/idx idx 1 sub def
			/x linearray idx get def
			/idx idx 1 sub def
			x y draw1point
		    } loop
		end
	    } bind def
	    
	    % _ coords_array last => _
	    /xyboth {
		xychartdict begin
		    2 copy point_outer drawxypoints
		    2 copy line_outer drawxyline
		    2 copy line_inner drawxyline
		    point_inner drawxypoints
		end
	    } bind def
		
	    % _ coords_array last => _
	    /xyline {
		xychartdict begin
		    2 copy line_outer drawxyline
		    line_inner drawxyline
		end
	    } bind def
		    
	    % _ coords_array last => _
	    /xypoints {
		xychartdict begin
		    2 copy point_outer drawxypoints
		    point_inner drawxypoints
		end
	    } bind def
	    
	end
END_FUNCTIONS
}

1;