
######################################################################
######################################################################
######################################################################
###
###
### PGPLOT interface to PDL::Graphics::Simple.  
###
### See the PDL::Graphics::Simple docs for details
###
##
#

package PDL::Graphics::Simple::PGPLOT;

use File::Temp qw/tempfile/;
use PDL::Options q/iparse/;

use PDL;

our $mod = {
    shortname => 'pgplot',
    module=>'PDL::Graphics::Simple::PGPLOT',
    engine => 'PDL::Graphics::PGPLOT::Window',
    synopsis=> 'PGPLOT (venerable but trusted)',
    pgs_version=> '1.001'
};
PDL::Graphics::Simple::register( 'PDL::Graphics::Simple::PGPLOT' );

##########
# PDL::Graphics::Simple::PGPLOT::check
# Checker

sub check {
    my $force = shift;
    $force = 0 unless(defined($force));

    return $mod->{ok} unless( $force or !defined($mod->{ok}) );
    
    eval 'use PDL::Graphics::PGPLOT::Window;';
    if($@) {
	$mod->{ok} = 0;
	$mod->{msg} = $@;
	return 0;
    }
    
    # Module loaded OK, now try to extract valid devices from it
    my ($fh,$tf) = tempfile('pgg_pgplot_XXXX');
    close $fh;

    my $cmd = qq{|perl -e "use PGPLOT; open STDOUT,q[>$tf] || die; open STDERR,STDOUT || die; pgopen(q[?])"};
    open FOO,$cmd;
    print FOO "?\n";
    close FOO;
    open FOO,"<$tf";
    my @lines = grep /^\s+\//, (<FOO>) ;
    close FOO;
    unlink $tf;
    
    $mod->{devices} = { map { chomp; s/^\s*\///; s/\s.*//; ($_,1) } @lines };

    if( $mod->{devices}->{'XWINDOW'} ) {
	$mod->{disp_dev} = 'XWINDOW';
    } elsif($mod->{devices}->{'XSERVE'} ) {
	$mod->{disp_dev} = 'XSERVE';
    } else {
	$mod->{ok} = 0;
	return 0;
    }

    unless( $mod->{devices}->{'VCPS'} ) {
	$mod->{ok} = 0;
	return 0;
    }

    return 1;
}

##########
# PDL::Graphics::Simple::PGPLOT::new
our $new_defaults ={
    size => [8,6,'in'],
    type => '',
    output=>'',
    multi=>undef
};

our $filetypes = {
    png => 'PNG',
    ps  => 'VCPS'
};

sub new {
    my $pkg = shift;
    my $opt_in = shift;
    my $opt = { iparse( $new_defaults, $opt_in ) };
    
    my $pgw;
    
    # Force a recheck on failure, in case the user fixed PGPLOT.
    # Also loads PDL::Graphics::PGPLOT::Window.
    unless(check()) {
	die "$mod->{shortname} appears nonfunctional\n" unless(check(1));
    }

    # Figure the device name and size to feed to PGPLOT.
    # size has already been regularized.
    my $conv_tempfile;
    my $dev;

    if( $opt->{type} =~ m/^i/i) {
	$dev = ( defined($opt->{output}) ? $opt->{output} : "" ) . "/" . $mod->{disp_dev};
    } else {
	my $ext;

	if($PDL::VERSION < 3  and ($PDL::VERSION > 2.1  or  $PDL::VERSION < 2.005)) {
	    print STDERR "WARNING - file output shapes vary under PDL < 2.005 (early version: $PDL::VERSION)\n";
	}

	if( $opt->{output} =~ m/\.(\w{2,4})$/ ) {
	    $ext = $1;
	} else {
	    $ext = 'png';
	    $opt->{output} .= ".png";
	}

	our $mod;
	unless(  $filetypes->{$ext}  and  $mod->{devices}->{$filetypes->{$ext}} ) {
	    my($fh);
	    ($fh, $conv_tempfile) = tempfile('pgs_pgplot_XXXX');
	    close $fh;
	    unlink $conv_tempfile; # just to be sure...
	    $conv_tempfile .= ".ps";
	    $dev = "$conv_tempfile/VCPS";
	} else {
	    $dev = "$opt->{output}/$filetypes->{$ext}";
	}
    }

    ($ENV{'PGPLOT_PS_WIDTH'}) = $opt->{size}->[0] * 1000;
    ($ENV{'PGPLOT_PS_HEIGHT'}) = $opt->{size}->[1] * 1000;

    my @params = ( 'size => [$opt->{size}->[0], $opt->{size}->[1] ]' );
    if( defined($opt->{multi}) ) {
	push(@params, 'nx=>$opt->{multi}->[0]');
	push(@params, 'ny=>$opt->{multi}->[1]');
    }

    
    my $creator = 'pgwin( $dev, { '. join(",", @params) . '} );';
    $pgw = eval $creator;
    print STDERR $@ if($@);
    
    my $me = { opt=>$opt, conv_fn=>$conv_tempfile, obj=>$pgw };
    return bless($me, 'PDL::Graphics::Simple::PGPLOT');
}

our $pgplot_methods = {
    'lines'  => 'line',
    'bins'   => 'bin',
    'points' => 'points',
    'errorbars' => sub {
	my ($me, $ipo, $data, $ppo) = @_;
	$me->{obj}->points($data->[0],$data->[1],$ppo);
	$me->{obj}->errb($data->[0],$data->[1],$data->[2]);
    },
    'limitbars'=> sub {
	my ($me, $ipo, $data, $ppo) = @_;
	# use XY absolute error form, but with X errorbars right on the point
	$me->{obj}->points($data->[0],$data->[1],$ppo);
	my $z = zeroes($data->[0]);
	$me->{obj}->errb($data->[0],$data->[1], $z, $z, -($data->[2]-$data->[1]), $data->[3]-$data->[1], $ppo);
    },
    'image'  => 'imag',
    'circles'=> sub { 
	my ($me,$ipo,$data,$ppo) = @_;
	$ppo->{filltype}='outline';
	$me->{obj}->tcircle(@$data, $ppo);
    },
    'labels'=> sub {
	my ($me,$ipo,$data,$ppo) = @_;
	for my $i(0..$data->[0]->dim(0)-1) {
	    $s = $data->[2]->[$i];
	    my $j = 0.0;
	    if( $s =~ s/^([\<\|\>\ ])// ) {
		$j = 0.5 if($1 eq '|');
		$j = 1.0 if($1 eq '>');
	    }
	    $me->{obj}->text( $s, $data->[0]->at($i), $data->[1]->at($i), {JUSTIFICATION=>$j} );
	}
    }
	
};

##############################
# PDL::Graphics::Simple::PGPLOT::plot

sub plot {
    my $me = shift;
    my $ipo = shift;
    my $po = {};
    $po->{title} =  $ipo->{title}    if(defined($ipo->{title}));
    $po->{xtitle}=  $ipo->{xtitle}   if(defined($ipo->{xtitle}));
    $po->{ytitle}=  $ipo->{ytitle}   if(defined($ipo->{ytitle}));
    $po->{justify}= $ipo->{justify}  if(defined($ipo->{justify})); 
   
    my %color_opts = ();
    if(defined($ipo->{crange})) {
	$color_opts{'MIN'} = $ipo->{crange}->[0] if(defined($ipo->{crange}->[0]));
	$color_opts{'MAX'} = $ipo->{crange}->[0] if(defined($ipo->{crange}->[1]));
    }
    
    my $more = 0;

    if($ipo->{oplot}  and   $me->{opt}->{type} =~ m/^f/i) {
	die "The PGPLOT engine does not yet support oplot for files.  Instead, \nglom all your lines together into one call to plot.\n";
    }

    unless($ipo->{oplot}) {

	$me->{curvestyle} = 0;

	$me->{logaxis} = $ipo->{logaxis};

	$po->{axis} = 0;
	if($ipo->{logaxis} =~ m/x/i) {
	    $po->{axis} += 10;
	    $ipo->{xrange} = [ log10($ipo->{xrange}->[0]), log10($ipo->{xrange}->[1]) ];
	}
	if($ipo->{logaxis} =~ m/y/i) {
	    $po->{axis} += 20;
	    $ipo->{yrange} = [ log10($ipo->{yrange}->[0]), log10($ipo->{yrange}->[1]) ];
	}
	
	$me->{obj}->release;
	$me->{obj}->env(@{$ipo->{xrange}}, @{$ipo->{yrange}}, $po);
	$me->{obj}->hold;
    } else {
	# Force a hold if we are held.
	$me->{obj}->hold;
    }

    # ppo is "post-plot options", which are really a mix of plot and curve options.  
    # Currently we don't parse any plot options into it (they're handled by the "env"
    # call) but if we end up doing so, it should go here.  The linestyle and color
    # are curve options that are autoincremented each curve.
    my %ppo = ();
    my $ppo = \%ppo;
    
    while(@_) {
	my ($co, @data) = @{shift()};
	my @extra_opts = ();

	if( defined($co->{style}) and $co->{style} ) {
	    $me->{curvestyle} = int($co->{style});
	} else {
	    $me->{curvestyle}++;
	}

	$ppo->{ color } = ($me->{curvestyle}-1) % 7 + 1;
	$ppo->{ linestyle } = ($me->{curvestyle}-1) % 5 + 1;


	if( defined($co->{width}) and $co->{width} ) {
	    $ppo->{ linewidth } = int($co->{width});
	}

	our $pgplot_methods;
	my $pgpm = $pgplot_methods->{$co->{with}};
	die "Unknown curve option 'with $co->{with}'!" unless($pgpm);

	if($pgpm eq 'imag') {
	    for my $k(keys %color_opts) {
		$po->{$k} = $color_opts{$k};
	    }

	    $ppo->{ drawwedge } = ($ipo->{wedge} != 0);

	    # Extract transform parameters from the corners of the image...
	    my $xcoords = shift(@data);
	    my $ycoords = shift(@data);

	    my $datum_pix = [0,0];
	    my $datum_sci = [$xcoords->at(0,0), $ycoords->at(0,0)];
	    
	    my $t1 = ($xcoords->slice("(-1),(0)") - $xcoords->slice("(0),(0)")) / ($xcoords->dim(0)-1);
	    my $t2 = ($xcoords->slice("(0),(-1)") - $xcoords->slice("(0),(0)")) / ($xcoords->dim(1)-1);
	    
	    my $t4 = ($ycoords->slice("(-1),(0)") - $ycoords->slice("(0),(0)")) / ($ycoords->dim(0)-1);
	    my $t5 = ($ycoords->slice("(0),(-1)") - $ycoords->slice("(0),(0)")) / ($ycoords->dim(1)-1);
	    
	    my $transform = pdl(
		$datum_sci->[0] - $t1 * $datum_pix->[0] - $t2 * $datum_pix->[1],
		$t1, $t2,
		$datum_sci->[1] - $t4 * $datum_pix->[0] - $t5 * $datum_pix->[1],
		$t4, $t5
		)->flat;

	    {   # sepia color table
		my $r = (xvals(256)/255)->sqrt;
		my $g = (xvals(256)/255);
		my $b = (xvals(256)/255)**2;
		$me->{obj}->ctab($g, $r, $g, $b);
	    }
	}

	if($me->{logaxis} =~ m/x/i) {
	    $data[0] = $data[0]->log10;
	}
	if($me->{logaxis} =~ m/y/i) {
	    $data[1] = $data[1]->log10;
	}

	if(ref($pgpm) eq 'CODE') {
	    &$pgpm($me, $ipo, \@data, $ppo);
	} else {
	    my $str= sprintf('$me->{obj}->%s(@data,%s);%s',$pgpm,'$ppo',"\n");
	    eval $str;
	}

	unless($pgpm eq 'imag') {
	    $ppo->{linestyle}++;
	    $ppo->{color}++;
	}

	$me->{obj}->hold;
    }

    ##############################
    # End of curve plotting.
    # Now place the legend if necessary.
    if($ipo->{legend}) {
	my $xp;
	my $xrdiff = $ipo->{xrange}->[1] - $ipo->{xrange}->[0];
	if( $ipo->{legend}=~ m/l/i ) {
	    $xp  = 0.03 * $xrdiff + $ipo->{xrange}->[0];
	} elsif($ipo->{legend} =~ m/r/i) {
	    $xp = 0.8 * $xrdiff + $ipo->{xrange}->[0];
	} else {
	    $xp = 0.4 * $xrdiff + $ipo->{xrange}->[0];
	}

	my $yp;
	my $yrdiff = $ipo->{yrange}->[1] - $ipo->{yrange}->[0];
	if( $ipo->{legend}=~ m/t/i ) {
	    $yp  = 0.95 * $yrdiff + $ipo->{yrange}->[0];
	} elsif($ipo->{legend} =~ m/b/i) {
	    $yp = 0.2 * $yrdiff + $ipo->{yrange}->[0];
	} else {
	    $yp = 0.6 * $yrdiff + $ipo->{yrange}->[0];
	}

	print "keys is [".join(",",@{$me->{keys}})."]; xp is $xp; yp is $yp\n";
	$me->{obj}->legend( 
	    $me->{keys},
	    $xp, $yp,
	    { Color     => [ (xvals(0+@{$me->{keys}}) % 7 + 1)->list ],
	      LineStyle => [ (xvals(0+@{$me->{keys}}) % 5 + 1)->list ]
	    }
	    );
    }

    $me->{obj}->release;

}


sub DESTROY {
    my $me = shift;

    $me->{obj}->release;

    if($me->{type} =~ m/^f/i) {
	eval q{ $me->{obj}->close; };

	my $file = ( ($me->{conv_fn}) ? $me->{conv_fn} : $me->{output} );
	if($me->{conv_fn}) {
	    my $a;
	    $a = rim($me->{conv_fn}) ;
	    wim($a, $me->{opt}->{output}); 
	    unlink($me->{conv_fn});
	}
    }
}
