#!/usr/bin/perl -w
#
# $Id: plot.gif,v 1.4 2001/12/12 18:36:44 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/cgi-bin/plot.gif
#
# http://www.lon-capa.org/
#
###########################################################################
#
# CGI-BIN interface to GD, used for making mathematical plots.
#
# User specifies the following variables (given are defaults):
#    height   = "100"
#    width    = "100"
#    xmin     = "-10.0"
#    xmax     = " 10.0"
#    ymin     = "-10.0"
#    ymax     = " 10.0"
#    transparent   (doesn't work with gif?)
#    frame    
#    drawaxes 
#    drawtics 
#    vtic_every = "1.0"
#    htic_every = "1.0"
#    xseries1  = "x1,x2,x3,x4,x5,...,xn"
#    yseries1  = "y1,y2,y3,y4,y5,...,yn"
#    xseries2  = ..
#    yseries2  = ..
#    ...
#    label1 = "x,y,size,text"
#    label2 = "x,y,size,text"
#    label3 = "x,y,size,text"
#    ...
#
#    size of a labelN is one of :
#       giant, large, medium, small, tiny
#
###########################################################################
##
## Data structures & file description
## 
## The input file is taken to be comprised of "segments".  Each "segment"
## will hold data for the plot header, the coordinate axes, or (more likely)
## the curves, circles, and polygons that are to be plotted.
## 
## The global array @Segments holds references to hashes which contain the
## data needed for each structure.
##
use FileHandle;
use GD;

my ($image,$axis);
$filename = shift;
# GET FILENAME AND OPEN THE FILE, BAIL OUT IF UNABLE TO DO SO
$fh = new FileHandle("<$filename");
my @Segments = &read_file($fh);

foreach $segment (@Segments) {
    &set_defaults($segment);
}
&init_image(&get_specific_segment(\@Segments,'plotheader'),
	    &get_specific_segment(\@Segments,'axis'));

for (my $i =0; $i<=$#Segments; $i++) {
    grok_segment($Segments[$i]);
}
&write_image();

#---------------------------------------------------- convenience functions
sub write_image {
    # Tell the browser our mime-type
#    print <<END;
#Content-type: image/gif
#
#END
    my $BinaryData=$image->png;
    undef $image;
    binmode(STDOUT);
    open IMG,"|pngtopnm|ppmtogif 2>/dev/null"; # convert into a gif image
    print IMG $BinaryData; # output image
    $|=1;                  # be sure to flush before closing
    close IMG;
}

sub grok_segment {
    $_ = shift;
    my %Data = %$_;
    $type = $Data{'type'};
    if (!defined($type)) { 
	return undef; 
    } elsif ($type eq 'frame') {
	draw_frame(\%Data);
    } elsif ($type eq 'curve') {
	draw_curve(\%Data);
    } elsif ($type eq 'label') {
	draw_label(\%Data);
    } elsif ($type eq 'circle') {
	draw_circle(\%Data);
    } elsif ($type eq 'polygon') {
	draw_polygon(\%Data);
    } elsif ($type eq 'line') {
	draw_line(\%Data);
    }
}

sub get_specific_segment {
    $_ = shift;
    my @Segments = @$_;
    my $type = shift;
    for ($i = 0; $i<=$#Segments; $i++) {
	if ($Segments[$i]->{'type'} eq $type) {
	    return (splice @Segments, $i,1);
	}
    }
    return undef;
}

#---------------------------------------------------- plot description reading
sub read_file {
    my @Returned_Segments;
    my $fh = shift;
    ($ret,$ref) = read_segment($fh);
    while (defined($ret) && $ret !=0) {
	push @Returned_Segments,$ref;
	($ret,$ref) = read_segment($fh);
    }
    return @Returned_Segments;
}

sub newhash{
    my %H;
    return \%H;
}

sub read_segment{
    # Reads in a segment of a plotting file.  
    # Returns 1,\%Data on success (or parital success)
    # Returns 0, undef on failure;
    $fh = shift;
    my $Data = newhash();

    $_ = <$fh>;
    if (! /^NEW /) {
	return undef;
    }

    while($_=<$fh>) {
	last if (/^END /);
	# Lines are of the form "type::var=value", "NEW type", or "END type"
	chomp;
	return(0,undef) if (/^NEW /);
	if (/(\w+)::(\w+)[\s]*=\s*\"([\w\s,\-\+\.]+)\"/) {
	    $Data->{'type'} = $1 if (!exists ($Data->{'type'}));
	    return(0,$Data) if ($Data->{'type'} ne $1);
	    $Data->{$2} = $3;
	} else { 
	    # Something went wrong - bad input - what to do?
	}
    }
    return (1,$Data);
}    

#------------------------------------------------------- 
sub init_image {
    my $PlotHeader = shift;
    $axis = shift;
    # Take care of making the image
    my ($width,$height) = ($PlotHeader->{'width'},$PlotHeader->{'height'});

    $image = new GD::Image($width,$height);
    my $bgcolor = $image->colorAllocate(split/,/,$PlotHeader->{'bgcolor'});
    my $fgcolor = $image->colorAllocate(split/,/,$PlotHeader->{'fgcolor'});
    $image->transparent($bgcolor) if ($PlotHeader->{'transparent'} eq 'true');
    
    $axis->{'xlen'} = $axis->{'xmax'} - $axis->{'xmin'};
    $axis->{'ylen'} = $axis->{'ymax'} - $axis->{'ymin'};
    if ($axis->{'drawaxis'} eq 'true') {
	&draw_axes();
    }
    if ($axis->{'drawtics'} eq 'true') {
	&draw_tics();
    }
}

#-------------------------------------------------------- axis routines
sub draw_axes{
    my $color = $image->colorResolve(split /,/,$axis->{'color'});
    ($x1,$y1) = &transformPoint($axis->{"xmin"},0,$image,$axis);
    ($x2,$y2) = &transformPoint($axis->{"xmax"},0,$image,$axis);
    $image->line($x1,$y1,$x2,$y2,$color);
    ($x1,$y1) = &transformPoint(0,$axis->{"ymin"},$image,$axis);
    ($x2,$y2) = &transformPoint(0,$axis->{"ymax"},$image,$axis);
    $image->line($x1,$y1,$x2,$y2,$color);
}

sub draw_tics{
    my $color = $image->colorResolve(split /,/, $axis->{'color'});
    my ($htic_every,$vtic_every) = ($axis->{'htic_every'}, $axis->{'vtic_every'});
    my ($width,$height) = $image->getBounds();
    
    my $ticwidth  = ($width  > 99 ? 5 : int($width /20) + 1);
    my $ticheight = ($height > 99 ? 5 : int($height/20) + 1);

    # Do tics along y-axis
    for ($ntic = 0; $ntic <=int($axis->{"ylen"}/$vtic_every); $ntic++){
	my ($x1,$y1) = &transformPoint(0,$axis->{"ymin"}+$ntic*$vtic_every);
	my ($x2,$y2) = &transformPoint(0,$axis->{"ymin"}+$ntic*$vtic_every);
	$x1 -= $ticwidth;
	$x2 += $ticwidth;
	$image->line($x1,$y1,$x2,$y2,$color);
    }
    # Do tics along x-axis
    for ($ntic = 0; $ntic <=int($axis->{"xlen"}/$htic_every); $ntic++){
	my ($x1,$y1) = &transformPoint( $axis->{"xmin"}+$ntic*$htic_every,0);
	my ($x2,$y2) = &transformPoint( $axis->{"xmin"}+$ntic*$htic_every,0);
	$y1 -= $ticheight;
	$y2 += $ticheight;
	$image->line($x1,$y1,$x2,$y2,$color);
    }
}

#------------------------------------------------------- misc plotting routines
sub draw_frame {
    my $Frame = shift;
    my ($width,$height) = $image->getBounds();
    my $color = $image->colorResolve(split /,/,$Frame->{'color'} );
    # Draw a frame around the picture.
    my $offset = $Frame->{'offset'};
    for (my $i = 0; $i<=$Frame->{'thickness'}; $i++) {
	$image->rectangle(
			  $offset - 1,
			  $offset - 1,
			  $width-$offset,
			  $height-$offset,
			  $color);
    }
}

sub draw_line{
    my $Line = shift;
    my $color = $image->colorResolve(split/,/, $Line->{'color'});
    my ($x1,$y1) = &transformPoint($Line->{'x1'},$Line->{'y1'});
    my ($x2,$y2) = &transformPoint($Line->{'x2'},$Line->{'y2'});
    $image->line($x1,$y1,$x2,$y2,$color);
}

sub draw_curve{
    my $Curve = shift;
    my $color = $image->colorResolve(split /,/, $Curve->{'color'});
    @X = split /,/,$Curve->{'xdata'};
    @Y = split /,/,$Curve->{'ydata'};
    if ($#X != $#Y) {
	return 0;
    }
    for($i=0;$i< $#X ;$i++) {
	my ($x1,$y1) = &transformPoint($X[$i]  ,$Y[$i]);
	my ($x2,$y2) = &transformPoint($X[$i+1],$Y[$i+1]);
	$image->line($x1,$y1,$x2,$y2,$color);
    }
}

sub draw_label{
    my $Label = shift;
    my $color = $image->colorResolve(split /,/, $Label->{'color'});
    my $fontname = $Label->{'font'};
    my $font = gdGiantFont      if (lc($fontname) eq "giant" ||
				 lc($fontname) eq "huge"  );
    $font = gdLargeFont      if (lc($fontname) eq "large" );
    $font = gdMediumBoldFont if (lc($fontname) eq "medium");
    $font = gdSmallFont      if (lc($fontname) eq "small" );
    $font = gdTinyFont       if (lc($fontname) eq "tiny"  );
    my $text = $Label->{'text'};
    if (! defined($font)) {
	$font = gdGiantFont;
	$text = "Font size error!";
    }
    my ($x,$y) = &transformPoint($Label->{'x'},$Label->{'y'});
    $image->string($font,$x,$y,$text,$color);
}

sub draw_circle {
    my $Circle = shift;
    my ($width,$height) = $image->getBounds();
    my $color = $image->colorResolve(split /,/, $Circle->{'color'});
    my ($x,$y) = &transformPoint(split/,/,$Circle->{'center'});
    my $xradius = $Circle->{'radius'} * $width  / $axis->{'xlen'};
    my $yradius = $Circle->{'radius'} * $height / $axis->{'ylen'};
    # draw a semicircle centered at 100,100
    $image->arc($x,$y,$xradius,$yradius,0,360,$color);
    $image->fill($x,$y,$color) if ($Circle->{'filled'} eq 'true');
}

sub draw_polygon {
    my $Poly = shift;
    my $color = $image->colorResolve(split /,/, $Poly->{'color'});
    @X = split /,/,$Poly->{'xdata'};
    @Y = split /,/,$Poly->{'ydata'};
    if ($#X != $#Y) {
	return 0;
    }
    my $poly = new GD::Polygon;
    for ($i=0;$i<=$#X;$i++) {
	$poly->addPt(&transformPoint($X[$i],$Y[$i]));
    }
    if ($Poly->{'filled'} eq 'true') {
	$image->filledPolygon($poly,$color);
    } else {
	$image->polygon($poly,$color);
    }
}

#------------------------------------------ transform point (basic routine)
#
# transformPoint(x,y) where x,y are in the coordinates of axis will return
# the coordinates transformed to the image coordinate system.
sub transformPoint{
    my ($x,$y) = @_;
    my ($width,$height) = $image->getBounds();
    $x = ( $x - $axis->{"xmin"}) * $width / ( $axis->{"xlen"});
    $y = ( ( $axis->{"ylen"} ) - ($y - $axis->{"ymin"})) 
	* $height / ( $axis->{"ylen"} );
    return($x,$y);
}

#------------------------------------------ set defaults is a beast!

sub set_defaults {
    my $PlotHeader = { 	
	type        => "plotheader",
	name        => "plot",
	height      => "200",
	width       => "300", 
	bgcolor     => "255,255,255",
	fgcolor     => "  0,  0,  0", 
	transparent => "true"
	};

    my $Axis = {
	type       => "axis",
	name       => "axis",
	color      => "  0,  0,  0",
	drawtics   => "true",
	vtic_every => " 1.0",
	htic_every => " 1.0",
	xmin       => "-10.0",
	ymin       => " -5.0",
	xmax       => " 10.0",
	ymax       => "  5.0",
	drawaxis   => "true"
	};

    my $Frame = {
	type      => "frame",
	color     => "  0,  0,  0",
	offset    => "1.0",
	thickness => "1.0",
	drawframe => "true"
	};

    my $Curve= {
	type  => "curve",
	name  => "curve",
	color => "  0,  0,  0",
	xdata => " 1.0, 2.0, 3.0, 4.0, 5.0, 6.0",
	ydata => " 1.0, 2.0, 3.0, 4.0, 5.0, 6.0"
	};

    my $Label = {
	type  => "label",
	name  => "label",
	font  => "medium",
	text  => "default label text",
	color => "  0,  0,  0",
	x     => " -5.0",
	y     => "  5.0"
	};	

    my $Circle = {
	type      => "circle",
	name      => "circle",
	color     => "  0,  0,  0",
	filled    => "true",
	center    => "x,y",
	radius    => "12.0"
	};
    
    my $Polygon = {
	type      => "polygon",
	name      => "polygon",
	color     => "  0,  0,  0",
	filled    => "true",
	xdata     => "1.0, 0.5, 0.0, -0,5, -1.0, -0.5,  0.0,  0.5",
	ydata     => "0.0,-0.5,-1.0, -0.5,  0.0,  0.5,  1.0,  0.5"
	};    

    my $Line = { 
	type      => "line",
	name      => "line",
	color     => "  0,  0,  0",
	x1        => "1.0",
	y1        => "0.0",
	x2        => "2.0",
	y2        => "4.0"
	};

    my $typematch = {
	plotheader => $PlotHeader,
	axis       => $Axis,
	frame      => $Frame,
	label      => $Label,
	curve      => $Curve,
	circle     => $Circle,
	polygon    => $Polygon
	};

    my $seg = shift;
    if (exists($typematch->{$seg->{'type'}})) {
	my $H = $typematch->{$seg->{'type'}};
	foreach $key (keys %$H) {
	    if (! exists($seg->{$key})) {
		$seg->{$key} = $H->{$key};
	    }
	}
    }
}