#!/usr/bin/perl -w

# "graph_grades.pl" 1.0 by Thomas Insel <tinsel@tinsel.org> 18 December 2004

# Copyright (c) 2004 Thomas Insel <tinsel@tinsel.org>
#
# Permission to use, copy, modify, and distribute this software for
# any purpose with or without fee is hereby granted, provided that
# the above copyright notice and this permission notice appear in all
# copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
# WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
# AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
# DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA
# OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
# TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
# PERFORMANCE OF THIS SOFTWARE.

use strict;
use GD;

#
# --- Configuration
#

# Margin on all four sides.

my $margin = 40;

# Height of the graph.

my $height = 200;

# Width of each graph segment

my $segmentwidth = 40;

# Draw a dot between segments?  Otherwise, we use a vertical tick.

my $drawdot = 0;

# Draw gray bars?

my $drawbars = 1;

# Keys are grade levels to project, non-blank values are labelled.

my %grades = (
	 1 => 'A+',
	.9 => '',
	.8 => 'B-',
	.7 => '',
	.6 => 'D-',
	 0 => 'Zero',
);

#
# --- Main Program
#

my @max;
my @weight;

for (<>) {
	next if /^#/;

	my ($n, @rest) = split /\s+/;

	if ($n =~ /(\w+)/) {
		# untaint student name
		$n = $1;
	} else {
		warn 'bad key';
		next;
	}

	# first line is possible scores

	if (! @max) {
		@max = @rest;
		next;
	}

	# second line is relative weights

	if (! @weight) {
		@weight = @rest;
		next;
	}

	# further lines are students scores

	open F, ">f-$n.png";
	binmode F;
	print F &DrawGraph(\@rest, \@max, \@weight, $n)->png;
	close F;
}

#
# --- DrawGraph
#

sub DrawGraph {
	my ($rp, $fp, $wp, $n) = @_;
	my @results = @$rp;
	my @fulls = @$fp;
	my @weights = @$wp;

	die 'number of full scores and weights are unequal' unless $#fulls == $#weights;
	die 'more results than full scores' unless $#fulls >= $#results;

	my $width = $segmentwidth * ($#fulls + 1);

	my $image = new GD::Image($width +  2 * $margin, $height + 2 * $margin);

	my $white = $image->colorAllocate(255,255,255);
	my $dkgray = $image->colorAllocate(200,200,200);
	my $black = $image->colorAllocate(0,0,0);
	my $gray2 = $image->colorAllocate(200,220,240);
	my $gray1 = $image->colorAllocate(230,230,230);
	my $blue = $image->colorAllocate(0,0,255);
	my $red = $image->colorAllocate(255,0,0);

	$image->transparent($white);
	$image->interlaced('true');

	my $cw = gdSmallFont->width;
	my $ch = gdSmallFont->height;

	# draw axes and labels

	for (0 .. 9) {
		my $l = $margin;
		my $t = $margin + $height * $_ / 10;
		$image->filledRectangle($l, $t, $l + $width, $t + $height /10, $_%2 ? $gray2 : $gray1) if $drawbars;
		$image->line($l, $t, $l + $width, $t, $dkgray);
		$image->line($l, $t, $l - $cw/2, $t, $black);
		$image->string(gdSmallFont, $l - $cw * 4 + ($_?$cw:0), $t - $ch / 2, 100 - $_ *10, $black);
	}

	for (0 .. $#fulls) {
		my $x = $margin + $segmentwidth * ($_ + 0.5);
		$image->line($x, $height+ $margin, $x, $height+$margin+$ch/2, $black);
		$image->string(gdSmallFont, $x - $cw/2, $height + $margin + $ch/2, $_+1, $black);
	}

	$image->line($margin, $margin, $margin, $height + $margin, $black);
	$image->line($margin, $margin + $height, $margin + $width, $margin + $height, $black);

	$image->string(gdSmallFont, $margin + ($width - $cw * length($n)) / 2, $margin - 1.5 * $ch, $n, $black);

	# graph grades to date

	my $lastx = 0;
	my $lasty = 0;
	my $pos = 0;
	my $act = 0;

	for (0 .. $#results) {
		$pos += $fulls[$_] * $weights[$_];
		$act += $results[$_] * $weights[$_];

		my $x = $margin + $segmentwidth * ($_ + 0.5);
		my $y = $margin + $height * (1 - $act/$pos);

		&Segment($image, $lastx, $lasty, $x, $y, $black);

		$lastx = $x;
		$lasty = $y;
	}

	# graph grade projections

	for my $grade (sort keys %grades) {
		# localize these variables.
		my ($act, $pos, $lasty, $lastx) = ($act, $pos, $lasty, $lastx);

		for ($#results+1 .. $#fulls) {
			$pos += $fulls[$_] * $weights[$_];
			$act += $grade * $fulls[$_] * $weights[$_];

			my $x = $margin + $segmentwidth * ($_ + 0.5);
			my $y =  $margin + $height * (1 - $act/$pos);

			&Segment($image, $lastx, $lasty, $x, $y, $grade ? $blue : $red);

			$lasty = $y;
			$lastx = $x;
		}

		# call out named projections

		if ($grades{$grade}) {
			$image->dashedLine($lastx, $lasty, $lastx + $segmentwidth * .75, $lasty, $black);
			$image->string(gdSmallFont, $lastx + $segmentwidth*.75, $lasty - $ch / 2, $grades{$grade}, $black);
		}
	}

	return $image;
}

#
# --- Segment
#

sub Segment {
	my ($image, $x1, $y1, $x2, $y2, $c) = @_;
	my $black = $image->colorClosest(0,0,0);

	if ($drawdot) {
		$image->arc($x2, $y2, 5, 5, 0, 360, $black);
	} else {
		$image->line($x2, $y2-2, $x2, $y2+2, $black);
	}

	$image->line($x1, $y1, $x2, $y2, $c) if $x1;
}