package Games::Baseball::Scorecard;

use warnings;
use strict;

require 5.006;

use File::Path;
use File::Temp 'tempdir';
use File::Spec::Functions;

our $VERSION = '0.01';

our($SCORECARD, $TEX, $TEXD);
our $MPOST   = 'mpost';
our $MPTOPDF = 'mptopdf';
our $PDFTEX  = 'pdftex';
our $OPEN    = 'open';

# default: black
our @COLOR = (0, 0, 0);
# others:
# light cyan
#@COLOR = (.10, 1, 1);
# dark cyan
#@COLOR = (.25, 1, 1);
# grey
#@COLOR = (.4, .4, .4);

our @FONTS = (
	# defaults that look very nice
	[ myriadrcrrl =>  9 ],
	[ myriadrcbrl => 14 ],
	[ myriadrcrrl => 14 ],
	[ myriadrcbrl => 22 ],
);

@FONTS = (
	# ones that should work everywhere:
	[ phvr8rn =>  8 ],
	[ phvb8rn => 12 ],
	[ phvr8rn => 12 ],
	[ phvb8rn => 18 ],
);

=head1 NAME

Games::Baseball::Scorecard


=head1 SYNOPSIS

	my $score = Games::Baseball::Scorecard->new($dir, $name, {
		color  => [ .4, .4, .4 ], # grey
		fonts  => [ # Myriad Condensed regular/bold
			[ myriadrcrrl =>  9 ],
			[ myriadrcbrl => 14 ],
			[ myriadrcrrl => 14 ],
			[ myriadrcbrl => 22 ],
		],
	});

	# fill initial scorecard out
	$s->init({
		scorer	=> 'Pudge',
		date	=> '2004-10-28, 20:05 ET',
		at	=> 'Busch Stadium, St. Louis',
		temp	=> '77',
		att	=> '55,234',
		away	=> {
			team	=> 'Boston Red Sox',
			starter	=> 12, # jersey number
			lineup	=> [
				# [ num, position ],
				[ 3, 6],
				# ...
			],
			roster	=> {
				# num => name
				23 => 'Cora, Alex',
				# ...
			},
		},
		home	=> {
			team	=> 'St. Louis Cardinals',
			# ...
		}
	});

	# draw the game
	$s->inn; # new inning / end of last inning

		$s->ab; # new at-bat
			# works to full count
			$s->pitches(qw(s b s b b f));
			# struck out looking
			$s->out('!K');

		$s->ab;
			# home run to left-center
			$s->hit(4, 'lc');

	# calculate/draw stats
	$self->totals;

	# finish the job
	$s->generate;

	# open final PDF
	$s->pdfopen;


=head1 DESCRIPTION

Games::Baseball::Scorecard is a frontend to a PDF scorecard written in Metapost by
Christopher Swingley (L<http://www.frontier.iarc.uaf.edu/~cswingle/baseball/scorecards.php>).
That scorecard is drawn out, and has a nice API for actually drawing out the
elements of the game: all the ball, strikes, outs, etc.

Being Metapost, it is laborious to do all this.  So this module provides a nice
frontend, that also keeps track of balls and strikes and hits and runs and outs
and more, making input of the game quite simple and efficient.

This module does not include the entire API, but most of it.  Patches and ideas
welcome.  Feel free to call C<output> directly if you want to generate Metapost
on your own, or to modify the C<$SCORECARD> variable (which contains the base
Metapost code), or the C<$TEX> (single page) and C<$TEXD> (duplex) TeX files.

I won't give a tutorial on scoring baseball games, or on Metapost, below.  Seek
other resources (Swingley's URL above has a nice tutorial on scoring baseball
games, using the scorecard he designed, which is what we're using here).


=head1 SYSTEM REQUIREMENTS

You will need TeX and Metapost installed.  F<mpost>, F<mptopdf>, and F<pdftex>
must be in your C<$ENV{PATH}>.  For opening the PDF with C<pdfopen>, you will
need C<open> (Mac OS X) in your path.  The names of these programs can be modified
with the variables C<$MPOST>, C<$MPTOPDF>, C<$PDFTEX>, and C<$OPEN>.

Also, the font by default (in the C<$SCORECARD> variable) is Helvetica Narrow.
Use whatever fonts you have installed for TeX.  The original used Myriad
Condensed, which I don't have (getting a decent-looking font and size, and
figuring out how to use it, was the hardest part of the project for me -- as
I don't know TeX -- so I picked a font everyone else could use, that should
be installed by default in most TeX installations).

See the distribution at
L<http://www.frontier.iarc.uaf.edu/~cswingle/baseball/scorecards.php> for
more information.


=head1 METHODS

The main methods are included below.  There are some other methods that are used,
but you shouldn't need to call them so I won't list them all here.

=head2 Basic Methods

=over 4

=item new([DIR, BASE, OPTS])

The C<new> method takes three optional arguments: a directory to build in,
and a base name for the scorecard file, and an options hashref.  Defaults are
the current directory, and "scorecard".  The base name is used to generate the
build files and the resulting PDFs, which will be F<${base}_away.pdf>,
F<${base}_home.pdf>, and F<$base.pdf> (both away and home together).

Options can be "color", an arrayref of RGB values (0 to 1), and "fonts",
an arrayref of four fonts (copyright notice font, basepath play labels,
balls/strikes/outs/other labels, and outs and other large label), with
the font name and size (see L<SYNOPSIS>).

Defaults are black, and Helvetica Narrow (phvr8rn/phvr8rn).

=cut

sub new {
	my($ref, $dir, $base, $opts) = @_;
	$opts ||= {};
	$dir  ||= tempdir();
	$base ||= 'scorecard';
	$base =~ s/\W+//g;

	mkpath($dir) unless -e $dir;
	unless (chdir $dir) {
		warn $!;
		return;
	}

	my $self = bless {
		debug	=> 0,
		dir	=> $dir,
		base	=> $base,
	}, __PACKAGE__;

	for my $which (qw(away home)) {
		my $fh;
		my $basewhich = "${base}_$which";
		unless (open $fh, '>', catfile($dir, "$basewhich.tex")) {
			warn $!;
			return;
		}

		(my $tex = $TEX) =~ s/__BASE__/$basewhich/;
		print $fh $tex;
		close $fh;


		unless (open $fh, '>', catfile($dir, "$basewhich.mp")) {
			warn $!;
			return;
		}

		$opts->{fonts}[0] ||= $FONTS[0];
		$opts->{fonts}[1] ||= $FONTS[1];
		$opts->{fonts}[2] ||= $FONTS[2];
		$opts->{fonts}[3] ||= $FONTS[3];

		$opts->{color}[0] = $COLOR[0] unless defined $opts->{color}[0];
		$opts->{color}[1] = $COLOR[1] unless defined $opts->{color}[1];
		$opts->{color}[2] = $COLOR[2] unless defined $opts->{color}[2];

		my $mp = $SCORECARD;
		$mp =~ s/__FONTFACE0__/$opts->{fonts}[0][0]/g;
		$mp =~ s/__FONTFACE1__/$opts->{fonts}[1][0]/g;
		$mp =~ s/__FONTFACE2__/$opts->{fonts}[2][0]/g;
		$mp =~ s/__FONTFACE3__/$opts->{fonts}[3][0]/g;

		$mp =~ s/__FONTSIZE0__/$opts->{fonts}[0][1]/g;
		$mp =~ s/__FONTSIZE1__/$opts->{fonts}[1][1]/g;
		$mp =~ s/__FONTSIZE2__/$opts->{fonts}[2][1]/g;
		$mp =~ s/__FONTSIZE3__/$opts->{fonts}[3][1]/g;

		$mp =~ s/__COLOR1__/$opts->{color}[0]/g;
		$mp =~ s/__COLOR2__/$opts->{color}[1]/g;
		$mp =~ s/__COLOR3__/$opts->{color}[2]/g;

		print $fh $mp;

		$self->{$which} = {
			which	=> $which,
			base	=> $basewhich,
			fh	=> $fh,
			ab	=> 0,
			inn	=> 0,
		};
	}

	my $fhd;
	unless (open $fhd, '>', catfile($dir, "$base.tex")) {
		warn $!;
		return;
	}

	my $texd = $TEXD;
	$texd =~ s/__BASE1__/$self->{away}{base}/;
	$texd =~ s/__BASE2__/$self->{home}{base}/;
	print $fhd $texd;
	close $fhd;

	for (qw(away home)) {
		$self->{curr} = $self->{$_};
		$self->begin;
		$self->top if /away/;
		$self->bottom if /home/;
	}

	$self->{curr} = $self->{away};

	return $self;
}


=item debug([LEVEL])

Set debug level.  0 is off, 1 shows the commands being executed, 2 shows all
output.

=cut

sub debug {
	my($self, $level) = @_;

	$self->{debug} = $level if defined $level;
	return $self->{debug};
}


=item init(DATA)

The <init> method accepts a single hashref that has all the data needed to
generate the initial scorecard.  You can some of the methods directly on your
own, but you really don't want to.

The hashref contains five root-level string keys: C<date>, C<temp>,
C<at>, C<att>, C<scorer>.  Each takes a simple string.

It also takes two hashref keys, C<away> and C<home>.  Each works the same way.
The C<team> key takes the team name, the C<starter> key takes the jersey number
of the starter, the C<roster> key takes a hashref of jersey number/name for
the entire active roster.

The C<lineup> key takes an arrayref -- in order -- of each starter, with each
element as an arrayref of [ jersey number, position ].

The position is standard baseball position numbering: 1 P, 2 C,
3 1B, 4 2B, 5 3B, 6 SS, 7 LF, 8 CF, 9 RF.  I use 0 for DH.

Players are thus referenced by their jersey number, when making them the starter,
putting them in the starting lineup, or when adding a new player or pitcher.

If not using this module to generate the entire game, but just the initial
scorecard, then the roster needs only include the players in the starting lineup.

=cut

sub init {
	my($self, $data) = @_;

	for my $which (qw(away home)) {
		$self->{curr} = $self->{$which};

		$self->team  ( $data->{$which}{team} );
		$self->date  ( $data->{date}         );
		$self->temp  ( $data->{temp}         );

		$self->at    ( $data->{at}           );
		$self->att   ( $data->{att}          );
		$self->scorer( $data->{scorer}       );

		my $roster = $self->{curr}{roster} = $data->{$which}{roster};

		my $order = 0;
		for (@{$data->{$which}{lineup}}) {
			$self->add_player(++$order, $_->[0], $_->[1]);
		}
	}

	$self->{curr} = $self->{away};
	$self->{other} = $self->{home};
	$self->add_pitcher($data->{home}{starter});

	$self->{curr} = $self->{home};
	$self->{other} = $self->{away};
	$self->add_pitcher($data->{away}{starter});
}


=item generate

The C<generate> method takes the Metapost code and generates the PDFs.
Call this last, after everything has been done to the scorecard.

Calls C<close> for you.

Returns the path to the PDF file.

=cut

sub generate {
	my($self) = @_;
	$self->close;

	for (qw(away home)) {
		my $base = $self->{$_}{base};

		$self->_run("$MPOST   $base.mp");
		$self->_run("$MPTOPDF $base.0");
		$self->_run("$PDFTEX  $base.tex");
	}

	$self->_run("$PDFTEX  $self->{base}.tex");

	return catfile($self->{dir}, "$self->{base}.pdf");
}

sub _run {
	my($self, $command) = @_;
	print "==> " if $self->{debug} > 1;
	print "$command\n" if $self->{debug};
	local $/;
	my $output = `$command`;

	if ($self->{debug} > 1) {
		print "<== $output" if $output;
		print "\n", ("-" x 73), "\n\n";
	}

	return $output;
}


=item close

The C<close> method finishes up the Metapost file, and closes it for you.

Do not call this method if you also call C<generate>, as that method calls
this one.  Only call this method if you do not wish to generate the PDF files,
but only want to write out the Metapost file.

=cut

sub close {
	my($self) = @_;

	for (qw(away home)) {
		$self->{curr} = $self->{$_};
		if ($self->{$_}{fh}) {
			$self->end;
			$self->output("\nend\n");

			close $self->{$_}{fh};
			delete $self->{$_}{fh};
		}
	}
}


=item pdfopen

Opens the PDF using the program specified in C<$OPEN> (default 'open',
used by Mac OS X to open the document in the default PDF viewer).

=cut

sub pdfopen {
	my($self) = @_;

	$self->_run("$OPEN $self->{base}.pdf") if $OPEN;
}


=back

=head2 Scoring Methods

These are the methods for scoring an actual game.

=head3 Setup Methods

=over 4

=item inn

Call C<inn> to start a new half-inning, and to finish the final inning.  It
generates the inning stats.

B<Note>: if you go to more than 11 innings, things will break.
See L<LIMITATIONS>.

=cut

sub inn {
	my($self) = @_;

	$self->output("\n\n    % inning end\n");

	my $stats = $self->{curr}{stats}{inning};
	if ($stats) {
		$self->output(_label(_btex($stats->{r}  ||= 0),   '1/2[(xstart,-150),(xstart+50u,-100+400)]'));
		$self->output(_label(_btex($stats->{h}  ||= 0),   '1/2[(xstart+50u,-150),(xstart+100u,-100+400)]'));
		$self->output(_label(_btex($stats->{e}  ||= 0),   '1/2[(xstart,-200),(xstart+50u,-150+400)]'));
		$self->output(_label(_btex($stats->{lb} ||= 0),   '1/2[(xstart+50u,-200),(xstart+100u,-150+400)]'));
		$self->output(_label(_btex($stats->{k}  ||= 0),   '1/2[(xstart,-250),(xstart+50u,-200+400)]'));
		$self->output(_label(_btex($stats->{bb} ||= 0),   '1/2[(xstart+50u,-250),(xstart+100u,-200+400)]'));
		$self->output(_label(_btex($stats->{strikes}||0), '1/2[(xstart,-300),(xstart+50u,-250+400)]'));
		$self->output(_label(_btex($stats->{pitches}||0), '1/2[(xstart+50u,-300),(xstart+100u,-250+400)]'));

		$self->output("    draw_inning_end(xstart,ystart,clr);\n\n");
	}

	$self->output("\n\n    % inning start\n");

	$self->{other} = $self->{curr};
	$self->{curr} = $self->{
		$self->{curr}{which} eq 'away' ? 'home' : 'away'
	};

	my $inn = $self->{curr}{inn} += 1;
	$self->{_inn_new} = 1 unless $self->{curr}{inn} == 1;
	$self->{out} = [];
	$self->{bases} = [];
	$self->{curr}{stats}{inning} = $self->{curr}{stats}{innings}{$inn} ||= {};

	my $xstart = $self->{curr}{inn} * 100;
	$self->{curr}{xstart} = $xstart;
	$self->output("    xstart := $xstart;\n");
}


=item ab

Call C<ab> to start a new at-bat.  B<Note>: call C<add_pitcher> and C<add_player>
I<before> calling C<ab>.

B<Note>: if you have more than 9 batters in an inning, things will break.
See L<LIMITATIONS>.

=cut

sub ab {
	my($self) = @_;

	$self->{curr}{ab} += 1;
	$self->{curr}{ab} = 1 if $self->{curr}{ab} > 9;
	$self->{pc} = 0;

	$self->{curr}{stats}{pitcher}{bf}++;

	$self->{curr}{stats}{batter} = $self->{curr}{stats}{batters}{
		$self->{curr}{lineup}[$self->{curr}{ab}][-1][0]
	} ||= {};

	my $ystart = 1000 - $self->{curr}{ab} * 100;

	$self->output("\n\n    % inning $self->{curr}{inn}, batter $self->{curr}{ab}\n");
	$self->output("    ystart := $ystart;\n");
	$self->output("    clr := (0,0,0);\n");
	$self->output("    set_vars(xstart,ystart);\n");
#	$self->output("    draw_square(xstart,ystart);\n");
	$self->output("    draw_inning_start(xstart,ystart,clr);\n")
		if delete $self->{_inn_new};

	if ($self->{curr}{lineupnew}[ $self->{curr}{ab} ]) {
		$self->{curr}{lineupnew}[ $self->{curr}{ab} ] = 0;
		$self->output("    draw(new_hitter) withcolor clr;\n");
	}

	if (delete $self->{curr}{pitchernew}) {
		$self->output("    draw(new_pitcher) withcolor clr;\n");
	}
}


=item add_player(ORDER, NUMBER, POS [, INN])

This adds a new player -- with the given jersey number and position -- in the
given place in the batting order.  If you are scoring an actual game, call
this only at the point the player enters the game.  The inning will be figured
out automatically then.

The player will be added to the lineup list on the left of the card, and
stats for that lineup position will be added to that player (instead of the
previous one) from that moment on, and a line will be drawn on the sheet for
where that player entered.

Call this before you call C<ab> (unless the player enters as a pinch runner).

B<Note>: if you add more than three batters for a given position, the module will die.
See L<LIMITATIONS>.

=cut

sub add_player {
	my($self, $order, $number, $pos, $inn) = @_;
	$inn ||= $self->{curr}{inn} || 1;

	my $lineup = $self->{curr}{lineup} ||= [];
	my $name = $self->{curr}{roster}{$number};

	my $rep = '';
	if ($lineup->[$order]) {
		my $rep2 = 1;
		$rep2 += @{$lineup->[$order]};
		if ($rep2 > 3) {
			die "fixme!";
		}
		$rep = "*$rep2";

		$self->{curr}{lineupnew}[$order] = 1;

		if ($self->{curr}{stats}{batter} &&
		    $self->{curr}{stats}{batter} eq
		    $self->{curr}{stats}{batters}{ $lineup->[$order][-1][0] }
		) {
			$self->{curr}{stats}{batter} =
				$self->{curr}{stats}{batters}{$number} ||= {};
		}
	}

	push @{$lineup->[$order]}, [ $number, $pos, $inn ];

	my $ystart = 1000 - $order * 100;
	my $x = '100-iposwidth';
	my $y = "$ystart+100u-100u/3$rep";
	my $dir = 'urt';

	$self->output(_label(_btex($name),   "$x*2-namewidth", $y, $dir));
	$self->output(_label(_btex($number), "$x*3-namewidth", $y, $dir));
	$self->output(_label(_btex($pos),    "$x*2",           $y, $dir));
	$self->output(_label(_btex($inn),     $x,              $y, $dir));
}

=item add_pitcher(NUMBER, [, INN])

This adds a new pitcher -- with the given jersey number -- to the scorecard.
If you are scoring an actual game, call this only at the point the pitcher
enters the game.  The inning will be figured out automatically then.

The pitcher will be added to the lineup list on the left of the card, and
stats for pitching will be added to that pitcher (instead of the
previous one) from that moment on, and a line will be drawn on the sheet for
where that pitcher entered.

Call this before you call C<ab>.

B<Note>: if you add more than six pitchers, the module will die.
See L<LIMITATIONS>.

=cut

sub add_pitcher {
	my($self, $number, $inn) = @_;
	$inn ||= $self->{curr}{inn} || 1;

	$self->{curr}{pitcher} = $number;
	$self->{curr}{stats}{pitcher} = $self->{other}{stats}{pitchers}{$number} ||= {};

	my $lineup = $self->{other}{plineup} ||= [];
	my $name = $self->{other}{roster}{$number};

	my $rep = '';
	my $xstart = 100;
	if (@$lineup) {
		my $rep2 = 1;
		$rep2 += @$lineup;
		if ($rep2 > 10) {
			die "fixme!";
		} elsif ($rep2 > 5) {
			$rep2 -= 5;
			$xstart = '905+100u*(2/3)';
		}
		$rep = "*$rep2";
		$self->{curr}{pitchernew} = 1;
	}

	push @$lineup, [ $number, $inn ];

#            draw_pitcher_row(100,ystart,clr,true);
#            draw_pitcher_row(900+100u*(2/3),ystart,clr,false);

	my $ystart = -200;
	my $x = "$xstart-iposwidth";
	my $y = "$ystart+100u-100u/3$rep-100u/3";
	my $dir = 'urt';

	$self->output(_label(_btex($name),   "$x*2-namewidth", $y, $dir));
	$self->output(_label(_btex($number), "$x*3-namewidth", $y, $dir));
# XXX not yet implemented
#	$self->output(_label(_btex($lr),     "$x*2",           $y, $dir));
	$self->output(_label(_btex($inn),     $x,              $y, $dir));
}

=back

=head3 At-Bat Methods

These methods will draw in the at-bat graphic for the current at-bat,
and will also keep track of stats for later drawing (per-inning stats,
per-batter stats, and game totals).

B<Note>: At-bats do not progress the way they would in a game.  You put in
all of the information for a given at-bat in that at-bat before moving on
to the next.  For example, if a runner reaches on a walk, and then is hit
home by a home run, you would mark the walk, then that the runner advanced home,
before moving on to the next at-bat.


=over 4

=item pitches(PITCHES)

C<pitches> records the individual pitches of the at-bat (except for the one
that generates an out or puts the ball in play).  It takes a list of strings,
each string representing a pitch.  Each pitch can be one of C<s>, C<b>, or C<f>.

This puts the pitch markers in the at-bat graphic, and also increments counts
for the stat drawing later.

=cut

sub pitches {
	my($self, @pitches) = @_;
	my($s, $b, $f) = (0, 0, 0);
	for (@pitches) {
		$self->strike(++$s) if (/s/i || (/f/i && $s > 2));
		$self->ball(++$b)   if /b/i;
		$self->foul(++$f)   if /f/i;
	}
}

sub ball {
	my($self, $num) = @_;
	my $pc = $self->pc;
	$self->output(_label(_btex($pc, 'sf'), 'ball'   . _num($num)));
}

sub strike {
	my($self, $num) = @_;
	my $pc = $self->pc(1);
	$self->output(_label(_btex($pc, 'sf'), 'strike' . _num($num)));
}

sub foul {
	my($self, $num) = @_;
	my $pc = $self->pc(1);
	$self->output(_label(_btex('x', 'sf'), 'foul'   . _num($num)));
}

sub pc {
	my($self, $strike) = @_;

	my $pitcher = $self->{curr}{stats}{pitcher} ||= {};
	my $inning  = $self->{curr}{stats}{inning}  ||= {};

	for ($pitcher, $inning) {
		$_->{pitches}++;
		$_->{strikes}++ if $strike;
	}

	return ++$self->{pc};
}

=item hit(BASES [, WHERE])

C<hit> denotes a hit of BASES bases, to WHERE.

WHERE is an optional string, for where the ball left the park or where the
fielder recovered it, with these options:

	infield:
		il	left
		ic	center
		ir	right

	outfield:
		l	left
		lc	left center
		cl	center left
		cr	center right
		rc	right center
		r	right

=cut

sub hit {
	my($self, $bases, $where) = @_;
	$where ||= '';

	$self->reach($bases, $bases);

	$self->{curr}{stats}{batter}{h}++;
	$self->{curr}{stats}{batter}{$bases}++;
	$self->{curr}{stats}{inning}{h}++;
	$self->{curr}{stats}{game}{$bases}++;
	$self->{curr}{stats}{pitcher}{h}++;
	$self->{curr}{stats}{pitcher}{$bases}++;

	$self->er, $self->rbi if $bases == 4;

	my $foo = $bases == 4 ? 'hr' : 'of';
	my $loc = lc $where eq 'il' ? 'ifleft' :
		  lc $where eq 'ic' ? 'ifcenter' :
		  lc $where eq 'ir' ? 'ifright' :

		  lc $where eq 'l'  ? "${foo}left" :
		  lc $where eq 'lc' ? "${foo}leftc" :
		  lc $where eq 'cl' ? "${foo}centerl" :
		  lc $where eq 'cr' ? "${foo}centerr" :
		  lc $where eq 'rc' ? "${foo}rightc" :
		  lc $where eq 'r'  ? "${foo}right" :
		                      '';

	$self->output("    draw($loc) withcolor clr;\n") if $loc;

}

=item reach(LABEL [, BASES])

C<reach> denotes reaching base by a method other than a hit.
LABEL is the method of reaching, and BASES is optional number
of bases reached (default is, of course, 1).

Special LABELs include 'bb', 'ibb', 'hp', 'K', 'SAC', and 'SF'.
'K' is special in that it is added to the stats totals; the others
are not included as at-bats; and 'bb', 'ibb', and 'hp' are counted as balls,
instead of strikes.

=cut

sub reach {
	my($self, $label, $bases) = @_;

	if ($label =~ /^i?bb$/i) {
		$self->{curr}{stats}{batter}{bb}++;
		$self->{curr}{stats}{inning}{bb}++;
		$self->{curr}{stats}{pitcher}{lc $label}++;
	} elsif ($label =~ /^hb?p/i) {
		$self->{curr}{stats}{game}{hp}++;
		$self->{curr}{stats}{pitcher}{hp}++;
	} elsif (uc $label eq 'K') {
		$self->{curr}{stats}{batter}{k}++;
		$self->{curr}{stats}{inning}{k}++;
		$self->{curr}{stats}{pitcher}{k}++;
	}

	$self->{curr}{stats}{inning}{lb}++;

	if ($label =~ /^(?:hb?p|i?bb)$/i) {
		$self->pc;
	} elsif ($label =~ /^(?:SAC|SF)/i) {
		$self->pc(1);
	} else {
		$self->{curr}{stats}{batter}{ab}++;
		$self->pc(1);
	}

	$bases ||= 1;
	$self->base($bases);
	$self->run if $bases == 4;

	$bases = $bases == 4 ? 'homerun' :
	         $bases == 3 ? 'triple' :
	         $bases == 2 ? 'double' :
	                       'single';

	my $circle = $label =~ /^i?bb$/i ? 'bb' :
	             $label =~ /^hb?p/i  ? 'hp' :
	                $label eq 4      ? 'hr' :
	                $label eq 3      ? 'threeb' :
	                $label eq 2      ? 'twob' :
	                $label eq 1      ? 'oneb' :
	                                   '';

	if (lc($label) eq 'ibb') {
		$self->output("    draw_ibb(bb, clr);\n");
	} elsif ($circle) {
		$self->output("    draw_circle($circle, clr);\n");
	} elsif ($label) {
		$self->output(_label(_btex($label, 'sf'), 'wayfirst', '', 'lrt'));
	}
	$self->output("    draw($bases) withcolor clr;\n");
}

sub base {
	my($self, $base) = @_;

	my $runner = $self->{curr}{ab};
	my $bases  = $self->{bases};

	if ($base) {
		$bases->[$runner] = $base;
	}
	return $bases->[$runner];

}


=item out(LABEL)

C<out> records that the at-bat resulted in an out.  LABEL is the way in
which the out was recorded, e.g., F8, 4-3, SF7, SAC4-3, DP6-4-3, K, and so on.

SF and SAC outs will not be recorded as official at-bats.  The string
'!K' is used to denote a strikeout looking.

If you use SF, SAC, DP, K, and !K, then the stats for those can be properly
tabulated at the end.

=cut

sub out {
	my($self, $label) = @_;

	if ($label =~ /^!?K/i) {
		$self->{curr}{stats}{pitcher}{k}++;
		$self->{curr}{stats}{batter}{k}++;
		$self->{curr}{stats}{inning}{k}++;
		$self->{curr}{stats}{batter}{ab}++;
	} elsif ($label =~ /^SAC/i) {
		$self->{curr}{stats}{game}{sac}++;
	} elsif ($label =~ /^SF/i) {
		$self->{curr}{stats}{game}{sf}++;
	} elsif ($label =~ /^DP/i) {
		$self->{curr}{stats}{game}{dp}++;
		$self->{curr}{stats}{batter}{ab}++;
	} else {
		$self->{curr}{stats}{batter}{ab}++;
	}

	if (uc $label eq '!K') {
		$self->output("    draw_strikeout_looking(outlabel, clr);\n");
	} elsif ($label) {
		$self->output(_label(_btex($label), 'outlabel'));
	}

	$self->pc(1);
	$self->_out;
}

sub _out {
	my($self, $num, $pitcher) = @_;
	unless ($num) {
		for (1..3) {
			$num = $_, last if !$self->{out}[$_];
		}
	}
	$self->{out}[$num] = 1;
	$self->{curr}{stats}{game}{outs}++;

	if ($pitcher) {
		$self->{other}{stats}{pitchers}{$pitcher}{outs}++;
	} else {
		$self->{curr}{stats}{pitcher}{outs}++;
	}

	my $out = _num($num);
	$self->output("    draw_out_$out(xstart,ystart,clr);\n");
}


=item tout(BASE, LABEL [, NUM, PITCHER])

C<tout> records that the runner was thrown out at BASE.
LABEL is the way in which the out was recorded, e.g., CS2-6, FC, DP.

PITCHER is the number of the pitcher who gets the out (for IP) if not the
one that pitched to that batter.

It is not necessary to include the base the runner is coming from; that is
remembered for you.

NUM is used in case the out is not in sequential order: e.g., if a batter
walks, then the next batter strikes out, then the first batter is caught stealing,
without NUM set to 2, the code would guess that it is the first out, since the
at-bat is earlier.  By setting NUM to 2 for the throwout, the strikeout will
be set to out 1, and the next out after that will be out 3.

If you use CS for LABEL, then the stats for that can be properly tabulated at
the end.

=cut

sub tout {
	my($self, $base2, $label, $num, $pitcher) = @_;

	my $base1 = $self->base || 0;

	$self->_out($num, $pitcher);
	$self->{curr}{stats}{inning}{lb}--;
	$self->{curr}{stats}{game}{cs}++ if $label =~ /^CS/i;

	$self->waybase($label, $base2);

	my $to = $base2 == 4 ? 'to_' : 'cs_';
	my $base = $base2 > $base1+1
		? _base($base1) . _base($base2)
		: _base($base2);

	$self->output("    draw($to$base);\n");
}


=item advance(BASE [, LABEL])

C<advance> advances a runner to BASE.  LABEL is the optional way in which
the runner advanced, e.g., SB.

If you advance home (4), a run is recorded for that runner, and is marked as
earned for the pitcher.  To advance home for an unearned run, use 'U' instead
of '4'.


and EARNED is true, the run is earned.

It is not necessary to include the base the runner is coming from; that is
remembered for you.

If you use SB, then the stats for that can be properly tabulated at the end.

=cut

sub advance {
	my($self, $base2, $label) = @_;

	my $unearned;
	if (uc $base2 eq 'U') {
		$unearned = 1;
		$base2 = 4;
	}

	my $base1 = $self->base;
	$self->waybase($label, $base1+1) if $label;
	$self->base($base2);
	$self->run if $base2 == 4;
	$self->er if $base2 == 4 && !$unearned;

	if ($label && $label =~ /^SB/i) {
		$self->{curr}{stats}{batter}{sb}++;
		$self->{curr}{stats}{game}{sb}++;
	}

	for ($base1, $base2) {
		$_ = _base($_);
	}

	$self->output("    draw($base1$base2);\n");
}


=back

=head3 At-Bat Stat Methods

These methods add additional stats (and in some cases, graphics) that are
not easily decipherable from the other at-bat events, so we need them
explicitly.

=over 4

=item rbi([RBIS])

Add RBI number of RBIs to current batter's totals (default is 1).
Don't include RBIs added by a hit(4), as that is added automatically.

=cut

sub rbi {
	my($self, $rbis) = @_;
	$rbis ||= 1;
	$self->{curr}{stats}{batter}{rbi} += $rbis;
	for (1 .. $rbis) {
		my $rbi = 'rbi' . _num($_);
		$self->output("    draw_dot($rbi, clr);\n");
	}
}

# called automatically when runner advances home

sub run {
	my($self) = @_;

	$self->{curr}{stats}{pitcher}{r}++;
	$self->{curr}{stats}{batter}{r}++;
	$self->{curr}{stats}{inning}{r}++;
	$self->{curr}{stats}{inning}{lb}--;

	$self->output("    draw_dot(rundot, clr);\n");
}

sub er {
	my($self) = @_;
	$self->{curr}{stats}{pitcher}{er}++;
	$self->{curr}{stats}{inning}{er}++;
}



=item error(POSITION)

Notes that an error was committed by the player at POSITION.
(Keeping track of error by POSITION not yet implemented, but feel free to
include it anyway, for when it is implemented.)

=cut

sub error {
	my($self, $pos) = @_;
# XXX not implemented
#	$self->{other}{stats}{$POSITION}{pb}++;
	$self->{curr}{stats}{inning}{e}++;
}


=item balk

Notes that there was a balk.

=cut

sub balk {
	my($self) = @_;
	$self->{curr}{stats}{pitcher}{bk}++;
}


=item wp

Notes that there was a wild pitch.

=cut

sub wp {
	my($self) = @_;
	$self->{curr}{stats}{pitcher}{wp}++;
	$self->{curr}{stats}{game}{wp}++;
}


=item pb

Notes that there was a passed ball.

=cut

sub pb {
	my($self) = @_;
# XXX not implemented
#	$self->{other}{stats}{2}{pb}++;
	$self->{curr}{stats}{game}{pb}++;
}


=item dp

Notes that a double play was executed.  Do not use if the batter was out by
double play, but only if there was a double play in which the batter was safe,
as calling C<out('DP6-4-3')> already records the double play for you.

=cut

sub dp {
	my($self) = @_;
	$self->{curr}{stats}{game}{dp}++;
}


=back

=head3 At-Bat Label Methods

These methods are simply for adding additional labels in the at-bat graphic,
for whatever you wish.

=over 4

=item waybase(LABEL [, BASE, BIG])

Add label LABEL on the way to BASE.  If BASE is excluded, notes it on way
to the next base after the one the runner is currently at.

=cut

sub waybase {
	my($self, $label, $base, $big) = @_;

	my $size = $big ? 'bigsf' : 'sf';
	$base ||= $self->base + 1;

	my $dir = $base == 4 ? 'lft' :
	          $base == 3 ? 'ulft' :
	          $base == 2 ? 'urt' :
	                       'lrt';

	$self->output(_label(_btex($label, $size), 'way' . _base($base), '', $dir));
}

=item atbase(LABEL [, BASE, BIG])

Add label LABEL at BASE.  If BASE is excluded, notes it
at the base the runner is currently at.

=cut

sub atbase {
	my($self, $label, $base, $big) = @_;

	my $size = $big ? 'bigsf' : 'sf';
	$base ||= $self->base;

	my $dir = $base == 4 ? 'bot' :
	          $base == 3 ? 'lft' :
	          $base == 2 ? 'top' :
	                       'rt';

	$self->output(_label(_btex($label, $size), _base($base), '', $dir));
}


=back

=head2 Stat Totals Methods

=over 4

=item win(NUMBER)

=item loss(NUMBER)

=item save(NUMBER)

=item blown_save(NUMBER)

NUMBER is the jersey number of the pitcher who got the (win, loss, save, blown save).
Call these methods while the pitcher's team is still on the field (while
the opposing team is still at bat), any time before the totals are calculated.

=cut

sub win {
	my($self, $number) = @_;
	$self->{other}{stats}{pitchers}{$number}{record}{w} = 1;
}

sub loss {
	my($self, $number) = @_;
	$self->{other}{stats}{pitchers}{$number}{record}{l} = 1;
}

sub hold {
	my($self, $number) = @_;
	$self->{other}{stats}{pitchers}{$number}{record}{h} = 1;
}

sub save {
	my($self, $number) = @_;
	$self->{other}{stats}{pitchers}{$number}{record}{'s'} = 1;
}

sub blown_save {
	my($self, $number) = @_;
	$self->{other}{stats}{pitchers}{$number}{record}{bs} = 1;
}



=item totals

This generates the stat totals for the game, batters, and pitchers.  Call it after the
finall C<inn> method call, if you wish to generate the stat totals.

=cut

sub totals {
	my($self) = @_;

	$self->{curr} = $self->{home};
	for (qw(away home)) {
		$self->{other} = $self->{curr};
		$self->{curr}  = $self->{$_};
		$self->_totals;
	}
}

sub _totals {
	my($self) = @_;

	my $game    = $self->{curr}{stats}{game};
	my $innings = $self->{curr}{stats}{innings};
	my(%tstats, %pstats);
	for my $n (qw(r h e lb k bb strikes pitches)) {
		$tstats{$n} += $innings->{$_}{$n} ||= 0 for keys %$innings;
	}

	$self->output("\n\n\n    %totals\n    nudge := 10u;\n");
	$self->output(_label(_btex($tstats{r}),       '1/2[(1200,-150+nudge),(1200+100u/3,-100+400)]'));
	$self->output(_label(_btex($tstats{h}),       '1/2[(1200+100u/3,-150),(1200+100u/3*2,-100+400-nudge)]'));
	$self->output(_label(_btex($tstats{e}),       '1/2[(1200,-200+nudge),(1200+100u/3,-150+400)]'));
	$self->output(_label(_btex($tstats{lb}),      '1/2[(1200+100u/3,-200),(1200+100u/3*2,-150+400-nudge)]'));
	$self->output(_label(_btex($tstats{k}),       '1/2[(1200,-250+nudge),(1200+100u/3,-200+400)]'));
	$self->output(_label(_btex($tstats{bb}),      '1/2[(1200+100u/3,-250),(1200+100u/3*2,-200+400-nudge)]'));
	$self->output(_label(_btex($tstats{strikes}), '1/2[(1200,-300+nudge),(1200+100u/3,-250+400)]'));
	$self->output(_label(_btex($tstats{pitches}), '1/2[(1200+100u/3,-300),(1200+100u/3*2,-250+400-nudge)]'));

	my $lineup = $self->{curr}{lineup};
	for my $i (0 .. $#$lineup) {
		next unless $lineup->[$i];

		for my $j (0 .. $#{$lineup->[$i]}) {
			my $bstats = $self->{curr}{stats}{batters}{$lineup->[$i][$j][0]};
			for (qw(ab r h rbi k bb)) {
				$pstats{$_} += $bstats->{$_} ||= 0;
			}

			my $rep = '';
			$rep = sprintf('*%d', 1+$j) if $j;

			my $ystart = 1000 - $i * 100;
			my $x = '1200+10';
			my $y = "$ystart+100u-100u/3$rep";
			my $dir = 'urt';

			$self->output(_label(_btex($bstats->{ab}),   $x,               $y, $dir));
			$self->output(_label(_btex($bstats->{r}),   "$x+(100u/3)",     $y, $dir));
			$self->output(_label(_btex($bstats->{h}),   "$x+((100u/3)*2)", $y, $dir));

			$self->output(_label(_btex($bstats->{rbi}), "$x+((100u/3)*3)", $y, $dir));
			$self->output(_label(_btex($bstats->{k}),   "$x+((100u/3)*4)", $y, $dir));
			$self->output(_label(_btex($bstats->{bb}),  "$x+((100u/3)*5)", $y, $dir));
		}
	}

	my $plineup = $self->{other}{plineup};
	for my $j (0 .. $#$plineup) {
		my $kstats = $self->{other}{stats}{pitchers}{$plineup->[$j][0]};

		my $rep = '';
		$rep = sprintf('*%d', ($j<5 ? $j+1 : $j-4)) if $j;

		my $ystart = -200;
		my $x = $j < 5 ? '100+5' : '900+5+100u*(2/3)';
		my $y = "$ystart+5+100u-100u/3$rep-100u/3";
		my $dir = 'urt';

		my $wls = uc join ',', grep $kstats->{record}{$_}, qw(w l h s bs);
		my $remainder  = ( ($kstats->{outs} ||= 0) % 3)  || 0;
		$kstats->{ip}  = ( ($kstats->{outs} - $remainder) / 3 ) . ".$remainder";

		$self->output(_label(_btex($wls),                   $x,                $y, $dir)) if $wls;
		$self->output(_label(_btex($kstats->{bf}||0),      "$x+(100u/3)",      $y, $dir));
		$self->output(_label(_btex($kstats->{ip}||0),      "$x+((100u/3)*2)",  $y, $dir));

		$self->output(_label(_btex($kstats->{h}||0),       "$x+((100u/3)*3)",  $y, $dir));
		$self->output(_label(_btex($kstats->{r}||0),       "$x+((100u/3)*4)",  $y, $dir));
		$self->output(_label(_btex($kstats->{er}||0),      "$x+((100u/3)*5)",  $y, $dir));

		$self->output(_label(_btex($kstats->{k}||0),       "$x+((100u/3)*6)",  $y, $dir));
		$self->output(_label(_btex($kstats->{bb}||0),      "$x+((100u/3)*7)",  $y, $dir));
		$self->output(_label(_btex($kstats->{ibb}||0),     "$x+((100u/3)*8)",  $y, $dir));

		$self->output(_label(_btex($kstats->{hp}||0),      "$x+((100u/3)*9)",  $y, $dir));
		$self->output(_label(_btex($kstats->{bk}||0),      "$x+((100u/3)*10)", $y, $dir));
		$self->output(_label(_btex($kstats->{wp}||0),      "$x+((100u/3)*11)", $y, $dir));

		$self->output(_label(_btex($kstats->{4}||0),       "$x+((100u/3)*12)", $y, $dir));
		$self->output(_label(_btex($kstats->{strikes}||0), "$x+((100u/3)*13)", $y, $dir));
		$self->output(_label(_btex($kstats->{pitches}||0), "$x+((100u/3)*14)", $y, $dir));
	}

	$self->output("    nudge := 5u;\n");

	my $xstart = '1200+100u/3*2+40u';
	my $ystart = '+25u+nudge';
	my $dir = 'urt';

	$self->output(_label(_btex($game->{1}||0, 'sf'),   $xstart, "-150+200$ystart", $dir));
	$self->output(_label(_btex($game->{2}||0, 'sf'),   $xstart, "-175+200$ystart", $dir));
	$self->output(_label(_btex($game->{3}||0, 'sf'),   $xstart, "-200+200$ystart", $dir));
	$self->output(_label(_btex($game->{4}||0, 'sf'),   $xstart, "-225+200$ystart", $dir));
	$self->output(_label(_btex($game->{sf}||0, 'sf'),  $xstart, "-250+200$ystart", $dir));
	$self->output(_label(_btex($game->{sac}||0, 'sf'), $xstart, "-275+200$ystart", $dir));

	$xstart = '1200+100u/3*2+150u';
	$self->output(_label(_btex($game->{dp}||0, 'sf'),  $xstart, "-150+200$ystart", $dir));
	$self->output(_label(_btex($game->{hp}||0, 'sf'),  $xstart, "-175+200$ystart", $dir));
	$self->output(_label(_btex($game->{wp}||0, 'sf'),  $xstart, "-200+200$ystart", $dir));
	$self->output(_label(_btex($game->{pb}||0, 'sf'),  $xstart, "-225+200$ystart", $dir));
	$self->output(_label(_btex($game->{sb}||0, 'sf'),  $xstart, "-250+200$ystart", $dir));
	$self->output(_label(_btex($game->{cs}||0, 'sf'),  $xstart, "-275+200$ystart", $dir));


	my @nums = map { $_ || 0 } ($pstats{ab}, $pstats{bb}, $game->{hp}, $game->{sac}, $game->{sf});
	my $numt = 0;
	$numt += $_ for @nums;
	my $nums = sprintf('%s~~=~~%s', join('+', @nums), $numt);
	$self->output(_label(_btex($nums, 'sf', 1), '1200+100u/3*2+110u', '-300+200+25u+nudge', $dir));

	@nums = map { $_ || 0 } ($tstats{r}, $tstats{lb}, $game->{outs});
	$numt = 0;
	$numt += $_ for @nums;
	$nums = sprintf('%s~~=~~%s', join('+', @nums), $numt);
	$self->output(_label(_btex($nums, 'sf', 1), '1200+100u/3*2+110u', '-300+200+nudge', $dir));
}



=back

=cut


#### misc output methods

sub output {
	my($self, @lines) = @_;
	my $fh = $self->{curr}{fh};
	print $fh @lines;
}

sub begin {
	my($self) = @_;
	$self->output("beginfig(0);\n");
	$self->output("    draw_full_scorecard;\n\n");
	$self->output("    clr:=scoring;\n\n");
}


sub end {
	my($self) = @_;
	$self->output("endfig;\n");
}

sub top {
	my($self) = @_;
	$self->output(_label(_btex('TOP'), 1431, 1020));
}

sub bottom {
	my($self) = @_;
	$self->output(_label(_btex('BOTTOM'), 1433, 1020));
}

#        label(btex {\bigsf Team}    etex rotated 90, (1416,130)) withcolor clr;
#        label(btex {\bigsf FP}      etex rotated 90, (1416,614)) withcolor clr;
#        label(btex {\bigsf Temp}    etex rotated 90, (1416,900)) withcolor clr;
#        label(btex {\bigsf At}      etex rotated 90, (1448,142)) withcolor clr;
#        label(btex {\bigsf Att}     etex rotated 90, (1448,450)) withcolor clr;
#        label(btex {\bigsf Scorer}  etex rotated 90, (1448,600)) withcolor clr;

#        label(btex {\bigsf Team:}   etex rotated 90, (1420,-50)) withcolor clr;
#        label(btex {\bigsf Date:}   etex rotated 90, (1420,600)) withcolor clr;
#        label(btex {\bigsf At:}     etex rotated 90, (1450,-50)) withcolor clr;
#        label(btex {\bigsf Scorer:} etex rotated 90, (1450,600)) withcolor clr;

sub team {
	my($self, $info) = @_;
	$self->output(_label(_btex($info), 1416+13, 280, 'lft', 'rotated 90'))
		if $info;
}

sub date {
	my($self, $info) = @_;
	$self->output(_label(_btex($info), 1416+13, 714, 'lft', 'rotated 90'))
		if $info;
}

sub temp {
	my($self, $info) = @_;
	$self->output(_label(_btex($info), 1416+13, 950, 'lft', 'rotated 90'))
		if $info;
}

sub at {
	my($self, $info) = @_;
	$self->output(_label(_btex($info), 1448+13, 292, 'lft', 'rotated 90'))
		if $info;
}

sub att {
	my($self, $info) = @_;
	$self->output(_label(_btex($info), 1448+13, 500, 'lft', 'rotated 90'))
		if $info;
}

sub scorer {
	my($self, $info) = @_;
	$self->output(_label(_btex($info), 1448+13, 700, 'lft', 'rotated 90'))
		if $info;
}


#### helper functions

sub _num {
	my($num) = @_;
	return $num == 4 ? 'four' :
	       $num == 3 ? 'three' :
	       $num == 2 ? 'two' :
	                   'one';
}

sub _base {
	my($num) = @_;
	return $num == 4 ? 'home' :
	       $num == 3 ? 'third' :
	       $num == 2 ? 'second' :
	                   'first';
}

sub _label {
	my($label, $x, $y, $direction, $extra) = @_;

	$direction ||= '';
	$direction &&= ".$direction";

	$extra ||= '';
	$extra &&= " $extra";

	my $xy = defined $y && length $y ? "($x,$y)" : $x;

	return "    label$direction($label$extra, $xy) withcolor clr;\n";
}

sub _btex {
	my($string, $font, $lit) = @_;
	$font ||= 'bigsf';
	if (!defined $string) {
#		print join "|", caller(0), "\n";
		return;
	}

	unless ($lit) {
		$string =~ s/\\/--BACKSLASH--/g;
		$string =~ s/{/--LBRACE--/g;
		$string =~ s/}/--RBRACE--/g;

		$string =~ s/( [\#\$\%\&\_\{\}] )/\\$1/gx;
		$string =~ s/( [\^~]       )/\\$1\{\}/gx;

		$string =~ s/--BACKSLASH--/\$\\backslash\$/g;
		$string =~ s/--LBRACE--/\$\\lbrace\$/g;
		$string =~ s/--RBRACE--/\$\\rbrace\$/g;
	}

	return "btex {\\$font $string} etex";
}


$SCORECARD = <<'EOT';
%prologues:=2;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Copyright (C) 2005, Christopher Swingley
%
% Licensed under the terms of the GNU General Public License, Version 2
% available from http://www.gnu.org/copyleft/gpl.html
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% The following Metapost program draws baseball scorecards as well as
% allows you to record plays on the same card.  It contains two figures.
% Figure 0 is a complete, unfilled scorecard that can be converted to PDF
% and printed.
%
% Figure 2 is an example, showing the Cardinals scoring from the game 
% where Mark McGwire broke Roger Maris' home run record.
%
% Figure 1 is the Cubs scoring from the same game
%
% A few variables can be set at the beginning of the card to adjust
% colors and line thicknesses and other parameters.  Also note that
% I am using Adobe's Myriad Condensed fonts for the scorecard, so
% you will need to modify the font names to suit your own preferences
% and fonts.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Manual for metapost:
%   $ texdoc mpman
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Locations for stuff:
%
%    ballone, balltwo, ballthree, strikeone, striketwo, foulone, foultwo,
%    foulthree, foulfour
%
%       These are the locations for writing in the pitch counts to each 
%       batter:
%           label(btex {\sf 1} etex, ballone) withcolor clr;
%           label(btex {\sf 2} etex, strikeone) withcolor clr;
%           
%    rbione, rbitwo, rbithree, rbifour, rundot, outlabel
%
%       These are the locations for RBI dots, run dots (in the middle 
%       of the diamond), and the out labels (which also go in the middle 
%       of the diamond):
%           draw_dot(rbione, clr);
%           draw_dot(rbitwo, clr);
%           draw_dot(rundot, clr);
%           label(btex {\bigsf 6-3} etex, outlabel) withcolor clr;
%
%    first, second, third, home
%
%       Locations of the bases.  Mostly used for building the paths, 
%       but also useful for pinch runners:
%           label.top(btex {\sf PR} etex, second) withcolor clr;
%
%    hr, threeb, twob, oneb, bb, hp
%
%       Locations for the hit / walk / HBP text on the right side of
%       the box.  Circled to indicate the result of the at bat:
%           draw_circle(twob, clr);
%
%    wayfirst, waysecond, waythird, wayhome
%
%       The half-way points between bases.  Used as part of the CS and 
%       TO paths, but also useful for labelling CS and TO plays:
%           label.lft(btex {\sf TO 7-2} etex, wayhome) withcolor clr;
%
% Paths available:
%    single, double, triple, homerun
%
%       Paths showing a runner's progress on the bases:
%           draw(double) withcolor clr;
%
%    firstsecond, firstthird, firsthome, secondthird, secondhome, 
%    thirdhome
%
%       Paths for runners along the bases:
%           draw(secondhome) withcolor clr;
%
%    ifleft, ifright, ifcenter, ofleft, ofleftc, ofcenterl, ofcenterr, 
%    ofrightc, ofright
%
%       Paths for various type of hits (infield, outfield):
%           draw(ofleftc) withcolor clr;
%
%    hrleft, hrleftc, hrcenterl, hrcenterr, hrrightc, hrright;
%
%       Paths for home runs:
%           draw(hrleftc) withcolor clr;
%
%    cs_second, cs_third, to_home,
%    cs_firstthird, to_firsthome, to_secondhome,
%
%       Paths for caught stealing and thrown out:
%           draw(cs_second) withcolor clr;
%
%    new_hitter, new_pitcher
%
%       Paths for new hitters (left side of box) and pitchers 
%       (top of box)
%           draw(new_hitter) withcolor clr;
%           draw(new_pitcher) withcolor clr;
%
% Fonts:
%
%   \tiny   - used for the Copyright line
%   \tnsf   - used for the basepath plays
%   \sf     - used for balls and strikes, outs, various labelling
%   \bigsf  - used for out labels
%
% Normal functions:
%
%   draw(path) withcolor clr;                       - stroke a path
%   label(btex {\sf 1} etex, pair) withcolor clr;   - label
%       directional suffixes: lft,rt,top,bot,ulft,urt,llft,lrt
%   label(btex {\sf (6 empty boxes)} etex,                  \
%       1/2[(xstart, ystart-25u),(xstart+100u,ystart-25u)]) \
%       withcolor clr;  - use this when the lineup turns over
%
% User functions:
%
%   
%   def set_vars(expr xstart, ystart) =
%
%       Used to initialize all the locations and paths for a new 
%       starting locations.  Needs to be called right after setting
%       xstart and ystart.  These should be multiples of 100u
%
%   def draw_square(expr xstart, ystart) =
%
%       Draws an at-bat box in cyan
%
%   def draw_out_[one|two|three](expr xstart, ystart, clr) =
%
%       Indicates the first (second or third) out with the out number
%       in a circle.
%
%   def draw_dot(expr loc, clr) =
%
%       Draws a 5pt dot at the location indicated.  Used for RBI's,
%       and runs scored
%
%   def draw_circle(expr centerpoint, clr) =
%
%       Draws a circle around a location.  Used to circle the plays
%       on the right of the at-bat box.
%
%   def draw_inning_end(expr xstart, ystart, clr) =
%
%       Draws the slash in the lower right that signals the end of
%       the inning.
%
%   def draw_inning_start(expr xstart, ystart, clr) =
%
%       Draws the slash in the upper left that signals the start of
%       the inning.
%
%   def draw_strikeout_looking(expr outlabel, clr) =
%
%       Draws a backwards K
%
%   def draw_ibb(expr bb, clr)=
%
%       Adds 'I' in front of BB and circles it for an intentional walk
%
% Consult the Makefile for the commands used to turn the code in  this 
% file into PDF, EPS or PNG files.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%   Wed Apr 20 07:58:23 AKDT 2005
%       * Reversed figures 1 and 2 so the scoring of the game is in
%           order
%       * Added more comments to the beginning of the file
%       * Christopher Swingley, cswingle@iarc.uaf.edu
%
%   Sat Apr 16 13:33:14 AKDT 2005
%       * scoring.mp Version 0.2
%       * Pulled out a bunch of variables
%       * Finished the full scorecard code
%       * Christopher Swingley, cswingle@iarc.uaf.edu
%
%   Thu Apr 14 14:37:29 AKDT 2005
%       * scoring.mp Version 0.1
%       * Initial release
%       * Christopher Swingley, cswingle@iarc.uaf.edu
%   
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% FONTS
verbatimtex \font\tiny  __FONTFACE0__ at __FONTSIZE0__pt etex
verbatimtex \font\sf    __FONTFACE1__ at __FONTSIZE1__pt etex
verbatimtex \font\tnsf  __FONTFACE2__ at __FONTSIZE2__pt etex
verbatimtex \font\bigsf __FONTFACE3__ at __FONTSIZE3__pt etex

% VARIABLES
color card;
color scoring;
% Cyan card - modify first number to control lightness 
% (0 - 1, dark - light):
% card:=(0.10,1,1);  % Darker
% card:=(0.25,1,1);  % Lighter
% Grey card:
% card:=(0.4,0.4,0.4);
% Black card:
% card:=(0.0,0.0,0.0);
card:=(__COLOR1__,__COLOR2__,__COLOR3__);
% Black scoring color
scoring:=(0,0,0);
% Diameter of circles (outs)
outcircle_d := 7;
% Size of dots (rbi, runs scored)
dotsize := 7pt;
% Diameter of play circles
playcircle_d := 9;
% Thickness of play lines
playline_t := 1.5pt;
% Thickness of thick card lines
thickline_t := 0.5pt;
% Thickness of thin card lines
thinline_t := 0.05pt;

def draw_square(expr xstart, ystart) =
    begingroup
        pickup pencircle scaled thickline_t;
        % Outer box
        draw (xstart,ystart)--(xstart,ystart+100u)--(xstart+100u,ystart+100u)--(xstart+100u,ystart)--cycle withcolor card;
        pickup pencircle scaled thinline_t;
        % Pitches
        pbsize := 15u;
        pbstart := 50u;
        draw (xstart+pbstart,ystart)--(xstart+pbstart,ystart+pbsize)--(xstart+pbstart+(1*pbsize),ystart+pbsize)--(xstart+pbstart+pbsize,ystart)--cycle withcolor card;
        pbstart := pbstart + pbsize;
        draw (xstart+pbstart,ystart)--(xstart+pbstart,ystart+pbsize)--(xstart+pbstart+(1*pbsize),ystart+pbsize)--(xstart+pbstart+pbsize,ystart)--cycle withcolor card;
        pbstart := pbstart + pbsize;
        draw (xstart+pbstart,ystart)--(xstart+pbstart,ystart+pbsize)--(xstart+pbstart+(1*pbsize),ystart+pbsize)--(xstart+pbstart+pbsize,ystart)--cycle withcolor card;
        pbstart := 50u;
        draw (xstart+pbstart,ystart+pbsize)--(xstart+pbstart,ystart+pbsize*2)--(xstart+pbstart+(1*pbsize),ystart+pbsize*2)--(xstart+pbstart+pbsize,ystart+pbsize)--cycle withcolor card;
        pbstart := pbstart + pbsize;
        draw (xstart+pbstart,ystart+pbsize)--(xstart+pbstart,ystart+pbsize*2)--(xstart+pbstart+(1*pbsize),ystart+pbsize*2)--(xstart+pbstart+pbsize,ystart+pbsize)--cycle withcolor card;
        % Diamond
        dsize := 24u;
        dxstart := xstart+40u;
        dystart := ystart+pbsize*1.7;
        ofactor := 1.5;
        draw (dxstart,dystart)--(dxstart+dsize,dystart+dsize)--(dxstart,dystart+dsize*2)--(dxstart-dsize,dystart+dsize)--cycle withcolor card;
        % Outfield
        draw (dxstart+dsize,dystart+dsize)--(dxstart+(dsize*ofactor),dystart+(dsize*ofactor))..(dxstart,dystart+(2*dsize*ofactor))..(dxstart-(dsize*ofactor),dystart+(dsize*ofactor))--(dxstart-dsize,dystart+dsize) withcolor card;
        % Labels
        lxstart := xstart+90u;
        lystart := ystart+92u;
        lsize := (lystart-ystart+(fsize/2)-pbsize)/6;
        label(btex {\tnsf HR} etex, (lxstart,lystart)) withcolor card;
        lystart := lystart - lsize;
        label(btex {\tnsf 3B} etex, (lxstart,lystart)) withcolor card;
        lystart := lystart - lsize;
        label(btex {\tnsf 2B} etex, (lxstart,lystart)) withcolor card;
        lystart := lystart - lsize;
        label(btex {\tnsf 1B} etex, (lxstart,lystart)) withcolor card;
        lystart := lystart - lsize;
        label(btex {\tnsf BB} etex, (lxstart,lystart)) withcolor card;
        lystart := lystart - lsize;
        label(btex {\tnsf HP} etex, (lxstart,lystart)) withcolor card;
        pickup pencircle scaled playline_t;
    endgroup
enddef;

def draw_out_one(expr xstart, ystart, clr) =
    begingroup
        pickup pencircle scaled playline_t;
        label(btex {\sf 1} etex, (xstart+25u, ystart+10u)) withcolor clr;
        draw (xstart+25u,ystart+10u-outcircle_d)..(xstart+25u+outcircle_d,ystart+10u)..
                (xstart+25u,ystart+10u+outcircle_d)..(xstart+25u-outcircle_d,ystart+10u)..cycle withcolor clr;
    endgroup
enddef;

def draw_out_two(expr xstart, ystart, clr) =
    begingroup
        pickup pencircle scaled playline_t;
        label(btex {\sf 2} etex, (xstart+25u, ystart+10u)) withcolor clr;
        draw (xstart+25u,ystart+10u-outcircle_d)..(xstart+25u+outcircle_d,ystart+10u)..
                (xstart+25u,ystart+10u+outcircle_d)..(xstart+25u-outcircle_d,ystart+10u)..cycle withcolor clr;
    endgroup
enddef;

def draw_out_three(expr xstart, ystart, clr) =
    begingroup
        pickup pencircle scaled playline_t;
        label(btex {\sf 3} etex, (xstart+25u, ystart+10u)) withcolor clr;
        draw (xstart+25u,ystart+10u-outcircle_d)..(xstart+25u+outcircle_d,ystart+10u)..
                (xstart+25u,ystart+10u+outcircle_d)..(xstart+25u-outcircle_d,ystart+10u)..cycle withcolor clr;
    endgroup
enddef;

def draw_dot(expr loc, clr) =
    begingroup
        pickup pencircle scaled dotsize;
        draw(loc) withcolor clr;
        pickup pencircle scaled playline_t;
    endgroup
enddef;

def draw_circle(expr centerpoint, clr) =
    begingroup
        pickup pencircle scaled playline_t;
        draw (centerpoint+(0,-playcircle_d))..(centerpoint+(playcircle_d,0))..(centerpoint+(0,playcircle_d))..
                (centerpoint+(-playcircle_d,0))..cycle withcolor clr;
    endgroup
enddef;

def draw_inning_end(expr xstart, ystart, clr) =
    begingroup
        pickup pencircle scaled playline_t;
        draw (xstart+95u,ystart-5u)--(xstart+105u,ystart+5u) withcolor clr;
    endgroup
enddef;

def draw_inning_start(expr xstart, ystart, clr) =
    begingroup
        pickup pencircle scaled playline_t;
        draw (xstart-5u,ystart+95u)--(xstart+5u,ystart+105u) withcolor (0,0,0);
    endgroup
enddef;

def draw_strikeout_looking(expr outlabel, clr) =
    begingroup
        label(btex {\bigsf K} etex, outlabel) reflectedabout (outlabel+(0,1u), outlabel+(0,-1u)) withcolor clr;
    endgroup
enddef;

def draw_ibb(expr bb, clr)=
    begingroup
        label(btex {\sf I} etex, bb+(-9u,0)) withcolor clr;
        draw (bb+(-3u,-playcircle_d))..(bb+(playcircle_d+3u,0))..(bb+(-3u,playcircle_d))..(bb+(-playcircle_d-6u,0))..cycle withcolor clr;
    endgroup
enddef;

def draw_player_box(expr xstart, ystart, clr, inncol) =
    % Intended to draw to the *left* of xstart, ystart
    begingroup
        iposwidth := 40u;
        namewidth := 250u;
        pickup pencircle scaled thickline_t;
        % Inning and Position box
        if inncol:
            draw (xstart,ystart)--(xstart-iposwidth*2u,ystart)--(xstart-iposwidth*2u,ystart+100u)--(xstart,ystart+100u)--cycle withcolor clr;
            draw (xstart-iposwidth,ystart)--(xstart-iposwidth,ystart+100u) withcolor clr;
        else:
            draw (xstart-iposwidth,ystart)--(xstart-iposwidth*2u,ystart)--(xstart-iposwidth*2u,ystart+100u)--(xstart-iposwidth,ystart+100u)--cycle withcolor clr;
        fi
        % Player name box
        draw (xstart-iposwidth*2,ystart)--(xstart-iposwidth*2-namewidth,ystart)--(xstart-iposwidth*2-namewidth,ystart+100u)--
                (xstart-iposwidth*2,ystart+100u)--cycle withcolor clr;
        % Number box
        draw (xstart-iposwidth*2-namewidth,ystart)--(xstart-iposwidth*3-namewidth,ystart)--(xstart-iposwidth*3-namewidth,ystart+100u)--
                (xstart-iposwidth*2-namewidth,ystart+100u)--cycle withcolor clr;
        pickup pencircle scaled thinline_t;
        % other player lines
        if inncol:
            draw (xstart,ystart+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3) withcolor clr;
            draw (xstart,ystart+100u/3+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3+100u/3) withcolor clr;
        else:
            draw (xstart-iposwidth,ystart+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3) withcolor clr;
            draw (xstart-iposwidth,ystart+100u/3+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3+100u/3) withcolor clr;
        fi
    endgroup
enddef;

def draw_pitcher_box(expr xstart, ystart, clr) =
    % Intended to draw to the *left* of xstart, ystart
    begingroup
        iposwidth := 40u;
        namewidth := 250u;
        pickup pencircle scaled thickline_t;
        % Inning and Position box
        draw (xstart,ystart)--(xstart-iposwidth*2u,ystart)--(xstart-iposwidth*2u,ystart+100u)--(xstart,ystart+100u)--cycle withcolor clr;
        draw (xstart-iposwidth,ystart)--(xstart-iposwidth,ystart+100u) withcolor clr;
        % Player name box
        draw (xstart-iposwidth*2,ystart)--(xstart-iposwidth*2-namewidth,ystart)--(xstart-iposwidth*2-namewidth,ystart+100u)--(xstart-iposwidth*2,ystart+100u)--cycle withcolor clr;
        % Number box
        draw (xstart-iposwidth*2-namewidth,ystart)--(xstart-iposwidth*3-namewidth,ystart)--(xstart-iposwidth*3-namewidth,ystart+100u)--(xstart-iposwidth*2-namewidth,ystart+100u)--cycle withcolor clr;
        pickup pencircle scaled thinline_t;
        % other player lines
        draw (xstart-iposwidth,ystart+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3) withcolor clr;
        draw (xstart-iposwidth,ystart+100u/3+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3+100u/3) withcolor clr;
    endgroup
enddef;

def draw_column_totals_key(expr xstart, ystart, clr) =
    begingroup
        pickup pencircle scaled thickline_t;
        draw (xstart,ystart)--(xstart,ystart+100u)--(xstart-iposwidth,ystart+100u)--(xstart-iposwidth,ystart)--cycle withcolor clr;
        draw (xstart,ystart+100u/2)--(xstart-iposwidth,ystart+100u/2)--(xstart,ystart+100u) withcolor clr;
        draw (xstart,ystart+100u/2)--(xstart-iposwidth,ystart) withcolor clr;
    endgroup
enddef;

def draw_totals_box(expr xstart, ystart, clr) =
    begingroup
        pickup pencircle scaled thickline_t;
        draw (xstart,ystart)--(xstart,ystart+50u)--(xstart+100u,ystart+50u)--(xstart+100u,ystart)--cycle withcolor clr;
        pickup pencircle scaled thinline_t;
        draw 1/3[(xstart,ystart),(xstart+100u,ystart)]-- 2/3[(xstart,ystart+50u),(xstart+100u,ystart+50u)] withcolor clr;
    endgroup
enddef;

def draw_row_summary_box(expr xstart,ystart,clr) =
    begingroup
        pickup pencircle scaled thickline_t;
        draw (xstart,ystart)--(xstart,ystart+100u)--(xstart+100u,ystart+100u)--(xstart+100u,ystart)--cycle withcolor clr;
        pickup pencircle scaled thinline_t;
        draw (xstart,ystart+100u/3)--(xstart+100u,ystart+100u/3) withcolor clr;
        draw (xstart,ystart+100u/3*2)--(xstart+100u,ystart+100u/3*2) withcolor clr;
        draw (xstart+100u/3,ystart)--(xstart+100u/3,ystart+100u) withcolor clr;
        draw (xstart+100u/3*2,ystart)--(xstart+100u/3*2,ystart+100u) withcolor clr;
    endgroup
enddef;

def draw_game_summary_box(expr xstart,ystart,clr) =
    begingroup
        pickup pencircle scaled thickline_t;
        draw (xstart,ystart)--(xstart,ystart+50u)--(xstart+100u/3*2,ystart+50u)--(xstart+100u/3*2,ystart)--cycle withcolor clr;
        pickup pencircle scaled thinline_t;
        draw (xstart,ystart)--(xstart+100u/3*2,ystart+50u) withcolor clr;
    endgroup
enddef;

def draw_play_total_box(expr xstart,ystart,clr) =
    begingroup
        pickup pencircle scaled thickline_t;
        draw (xstart+100u/3*2,ystart)--(xstart+100u/3*2,ystart+50u)--(xstart+100u/3*2+200.3u,ystart+50u)--(xstart+100u/3*2+200.3u,ystart)--cycle withcolor clr;
        draw (xstart+100u/3*2,ystart+25u)--(xstart+100u/3*2+200u,ystart+25u) withcolor clr;
    endgroup
enddef;

def draw_pitcher_row(expr xstart,ystart,clr,leftish) =
    begingroup
        if leftish:
            iposwidth := 40u;
            namewidth := 250u;
        else:
            iposwidth := 100u/3;
            namewidth := 200u+100u*(2/3)+1u;
        fi
        pickup pencircle scaled thickline_t;
        % Inning and Position box
        draw (xstart,ystart)--(xstart-iposwidth*2u,ystart)--(xstart-iposwidth*2u,ystart+100u)--(xstart,ystart+100u)--cycle withcolor clr;
        draw (xstart-iposwidth,ystart)--(xstart-iposwidth,ystart+100u) withcolor clr;
        % Player name box
        draw (xstart-iposwidth*2,ystart)--(xstart-iposwidth*2-namewidth,ystart)--(xstart-iposwidth*2-namewidth,ystart+100u)--
                (xstart-iposwidth*2,ystart+100u)--cycle withcolor clr;
        % Number box
        draw (xstart-iposwidth*2-namewidth,ystart)--(xstart-iposwidth*3-namewidth,ystart)--(xstart-iposwidth*3-namewidth,ystart+100u)--
                (xstart-iposwidth*2-namewidth,ystart+100u)--cycle withcolor clr;
        pickup pencircle scaled thinline_t;
        % other player lines
        draw (xstart,ystart+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3) withcolor clr;
        draw (xstart,ystart+100u/3+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3+100u/3) withcolor clr;
        % Now draw stats boxes
        for nxstart := xstart step 100 until xstart+400:
            draw_row_summary_box(nxstart,ystart,clr);
        endfor
    endgroup
enddef;

def draw_pitcher_labels(expr xstart,ystart,clr,leftish) =
    begingroup
        if leftish:
            iposwidth := 40u;
            namewidth := 250u;
        else:
            iposwidth := 100u/3;
            namewidth := 200u+100u*(2/3);
        fi
        statboxwidth := 100u/3;
        label(btex {\bigsf \#} etex, 1/2[(xstart-iposwidth*2-namewidth,ystart),(xstart-iposwidth*3-namewidth,ystart-(100u/3))]) withcolor clr;
        label(btex {\bigsf Pitcher} etex, 1/2[(xstart-iposwidth*2,ystart),(xstart-iposwidth*2-namewidth,ystart-100u/3)]) withcolor clr;
        label(btex {\bigsf L/R} etex, 1/2[(xstart-iposwidth,ystart),(xstart-iposwidth*2,ystart-100u/3)]) withcolor clr;
        label(btex {\bigsf Inn} etex, 1/2[(xstart,ystart),(xstart-iposwidth,ystart-100u/3)]) withcolor clr;
        %
        label(btex {\bigsf WLS} etex, 1/2[(xstart+statboxwidth,ystart),(xstart,ystart-100u/3)]) withcolor clr;
        label(btex {\bigsf BF} etex, 1/2[(xstart+statboxwidth*2,ystart),(xstart+statboxwidth,ystart-100u/3)]) withcolor clr;
        label(btex {\bigsf IP} etex, 1/2[(xstart+statboxwidth*3,ystart),(xstart+statboxwidth*2,ystart-100u/3)]) withcolor clr;
        %
        label(btex {\bigsf H} etex, 1/2[(xstart+statboxwidth*4,ystart),(xstart+statboxwidth*3,ystart-100u/3)]) withcolor clr;
        label(btex {\bigsf R} etex, 1/2[(xstart+statboxwidth*5,ystart),(xstart+statboxwidth*4,ystart-100u/3)]) withcolor clr;
        label(btex {\bigsf ER} etex, 1/2[(xstart+statboxwidth*6,ystart),(xstart+statboxwidth*5,ystart-100u/3)]) withcolor clr;
        %
        label(btex {\bigsf SO} etex, 1/2[(xstart+statboxwidth*7,ystart),(xstart+statboxwidth*6,ystart-100u/3)]) withcolor clr;
        label(btex {\bigsf BB} etex, 1/2[(xstart+statboxwidth*8,ystart),(xstart+statboxwidth*7,ystart-100u/3)]) withcolor clr;
        label(btex {\bigsf IBB} etex, 1/2[(xstart+statboxwidth*9,ystart),(xstart+statboxwidth*8,ystart-100u/3)]) withcolor clr;
        %
        label(btex {\bigsf HBP} etex, 1/2[(xstart+statboxwidth*10+1,ystart),(xstart+statboxwidth*9+1,ystart-100u/3)]) withcolor clr;
        label(btex {\bigsf BLK} etex, 1/2[(xstart+statboxwidth*11+1,ystart),(xstart+statboxwidth*10+1,ystart-100u/3)]) withcolor clr;
        label(btex {\bigsf WP} etex, 1/2[(xstart+statboxwidth*12+1,ystart),(xstart+statboxwidth*11+1,ystart-100u/3)]) withcolor clr;
        %
        label(btex {\bigsf HR} etex, 1/2[(xstart+statboxwidth*13,ystart),(xstart+statboxwidth*12,ystart-100u/3)]) withcolor clr;
        label(btex {\bigsf S} etex, 1/2[(xstart+statboxwidth*14,ystart),(xstart+statboxwidth*13,ystart-100u/3)]) withcolor clr;
        label(btex {\bigsf P} etex, 1/2[(xstart+statboxwidth*15,ystart),(xstart+statboxwidth*14,ystart-100u/3)]) withcolor clr;
    endgroup
enddef;

def set_vars(expr xstart, ystart) =
    begingroup
        % locations
        pair ballone, balltwo, ballthree, strikeone, striketwo, foulone, foultwo, foulthree, foulfour;
        ballone := (xstart+50u+(15u/2),ystart+(15u/2));
        balltwo := (xstart+50u+(15u/2)+15u,ystart+(15u/2));
        ballthree := (xstart+50u+(15u/2)+30u,ystart+(15u/2));
        strikeone := (xstart+50u+(15u/2),ystart+(15u/2)+15u);
        striketwo := (xstart+50u+(15u/2)+15u,ystart+(15u/2)+15u);
        foulone := (xstart+5u,ystart+9u);
        foultwo := (xstart+8u,ystart+5u);
        foulthree := (xstart+10u,ystart+11u);
        foulfour := (xstart+13u,ystart+7u);
        pair rbione, rbitwo, rbithree, rbifour, rundot, outlabel;
        rundot := (xstart+40u,ystart+49.5u);
        outlabel := (xstart+40u,ystart+49.5u);
        rbione := (xstart+5u,ystart+25u);
        rbitwo := (xstart+9u,ystart+20u);
        rbithree := (xstart+11u,ystart+28u);
        rbifour := (xstart+15u,ystart+23u);
        pair first, second, third, home;
        path single, double, triple, homerun;
        pbsize := 15u;
        dsize := 24u;
        dxstart := xstart+40u;
        dystart := ystart+pbsize*1.7;
        home := (dxstart,dystart);
        first := (dxstart+dsize,dystart+dsize);
        second := (dxstart,dystart+dsize*2);
        third := (dxstart-dsize,dystart+dsize);
        single := home--first--(first+(-7u,0));
        double := home--first--second--(second+(0,-7u));
        triple := home--first--second--third--(third+(7u,0));
        homerun := home--first--second--third--cycle;
        path firstsecond, firstthird, firsthome, secondthird, secondhome, thirdhome;
        firstsecond := first--second--(second+(0,-7u));
        firstthird := first--second--third--(third+(7u,0));
        firsthome := first--second--third--home;
        secondthird := second--third--(third+(7u,0));
        secondhome := second--third--home;
        thirdhome := third--home;
        path ifleft, ifright, ifcenter, ofleft, ofleftc, ofcenterl, ofcenterr, ofrightc, ofright;
        ifleft := home--(home+(-13u,18u));
        ifright := home--(home+(13u,18u));
        ifcenter := home--(home+(0,18u));
        ofleft := home--(home+(-32u, 36u));
        ofleftc := home--(home+(-20u, 60u));
        ofright := home--(home+(32u, 36u));
        ofrightc := home--(home+(20u, 60u));
        ofcenterl := home--(home+(-5u, 65u));
        ofcenterr := home--(home+(5u, 65u));
        path hrleft, hrleftc, hrcenterl, hrcenterr, hrrightc, hrright;
        hrleft := home--(home+(-37u, 41u));
        hrleftc := home--(home+(-27u, 67u));
        hrright := home--(home+(37u, 41u));
        hrrightc := home--(home+(27u, 67u));
        hrcenterl := home--(home+(-5u, 75u));
        hrcenterr := home--(home+(5u, 75u));
        lxstart := xstart+90u;
        lystart := ystart+92u;
        lsize := (lystart-ystart+(fsize/2)-pbsize)/6;
        pair hr, threeb, twob, oneb, bb, hp;
        hr := (lxstart,lystart);
        lystart := lystart - lsize;
        threeb := (lxstart,lystart);
        lystart := lystart - lsize;
        twob := (lxstart,lystart);
        lystart := lystart - lsize;
        oneb := (lxstart,lystart);
        lystart := lystart - lsize;
        bb := (lxstart,lystart);
        lystart := lystart - lsize;
        hp := (lxstart,lystart);
        pair wayfirst, waysecond, waythird, wayhome;
        path cs_second, cs_third, to_home;
        path cs_firstthird, to_firsthome, to_secondhome;
        wayfirst := 1/2[home,first];
        waysecond := 1/2[first,second];
        waythird := 1/2[second,third];
        wayhome := 1/2[third,home];
        cs_second := first--waysecond--(waysecond+(3u,3u))--(waysecond-(3u,3u));
        cs_third := second--waythird--(waythird+(-3u,3u))--(waythird-(-3u,3u));
        to_home := third--wayhome--(wayhome+(3u,3u))--(wayhome-(3u,3u));
        cs_firstthird := first--second--waythird--(waythird+(-3u,3u))--(waythird-(-3u,3u));
        to_firsthome := first--second--third--wayhome--(wayhome+(3u,3u))--(wayhome-(3u,3u));
        to_secondhome := second--third--wayhome--(wayhome+(3u,3u))--(wayhome-(3u,3u));
        path new_hitter, new_pitcher;
        new_hitter := (xstart-3u,ystart-3u)--(xstart+3u,ystart+3u)--(xstart,ystart)--(xstart+3u,ystart-3u)--(xstart-3u,ystart+3u)--(xstart,ystart)--(xstart,ystart+100u)--(xstart-3u,ystart+97u)--(xstart+3u,ystart+103u)--(xstart,ystart+100u)--(xstart+3u,ystart+97u)--(xstart-3u,ystart+103u);
        new_pitcher := (xstart-3u,ystart+97u)--(xstart+3u,ystart+103u)--(xstart,ystart+100u)--(xstart+3u,ystart+97u)--(xstart-3u,ystart+103u)--(xstart,ystart+100u)--(xstart+100u,ystart+100u)--(xstart+97u,ystart+97u)--(xstart+103u,ystart+103u)--(xstart+100u,ystart+100u)--(xstart+103u,ystart+97u)--(xstart+97u,ystart+103u);
    endgroup
enddef;

def draw_full_scorecard =
    begingroup
        % Draw the player boxes
        color clr;
        clr:=card;
        u := 1.0pt;
        size := 100u;
        fsize := 11u;
        xstart := 100;
        % Draw first nine position boxes
        for ystart := 100 step 100 until 900:
            draw_player_box(xstart,ystart,clr,true);
        endfor
        % Draw extra player boxes (without an inning column)
        for ystart := -100 step 100 until 0:
            draw_player_box(xstart,ystart,clr,false);
        endfor
        % Draw key for column totals
        for ystart := -100 step 100 until 0:
            draw_column_totals_key(xstart,ystart,clr);
        endfor
        % Draw all the at-bat boxes
        for ystart := 100 step 100 until 900:
            for xstart := 100 step 100 until 1100:
                draw_square(xstart, ystart);
            endfor
        endfor
        % Draw the totals boxes
        clr:=card;
        for ystart := -100 step 50 until 50:
            for xstart := 100 step 100 until 1100:
                draw_totals_box(xstart,ystart,clr);
            endfor
        endfor
        % Pitcher Rows
        for ystart := -300 step 100 until -200:
            draw_pitcher_row(100,ystart,clr,true);
            draw_pitcher_row(900+100u*(2/3),ystart,clr,false);
        endfor
        % Label pitcher rows (key on top line, numbers)
        draw_pitcher_labels(100,-100,clr,true);
        draw_pitcher_labels(900+100u*(2/3)-1,-100,clr,false);
        % Draw a thick line below the pitcher row label
        pickup pencircle scaled thickline_t;
        draw (100-iposwidth*3-namewidth,-100-100u/3)--(900+100u*2/3+400+100u,-100-100u/3) withcolor clr;
        pickup pencircle scaled thinline_t;
        % Put key into column totals
        iposwidth := 40u;
        namewidth := 250u;
        label(btex {\bigsf R} etex, 1/2[1/2[(100u,100u),(100u-iposwidth,50u)],(100u-iposwidth,100u)]) withcolor clr;
        label(btex {\bigsf H} etex, 1/2[1/2[(100u,100u),(100u-iposwidth,50u)],(100u,50u)]) withcolor clr;
        label(btex {\bigsf E} etex, 1/2[1/2[(100u,50u),(100u-iposwidth,0u)],(100u-iposwidth,50u)]) withcolor clr;
        label(btex {\bigsf LB} etex, 1/2[1/2[(100u,50u),(100u-iposwidth,0u)],(100u,0u)]) withcolor clr;
        label(btex {\bigsf K} etex, 1/2[1/2[(100u,0u),(100u-iposwidth,-50u)],(100u-iposwidth,0u)]) withcolor clr;
        label(btex {\bigsf BB} etex, 1/2[1/2[(100u,0u),(100u-iposwidth,-50u)],(100u,-50u)]) withcolor clr;
        label(btex {\bigsf S} etex, 1/2[1/2[(100u,-50u),(100u-iposwidth,-100u)],(100u-iposwidth,-50u)]) withcolor clr;
        label(btex {\bigsf P} etex, 1/2[1/2[(100u,-50u),(100u-iposwidth,-100u)],(100u,-100u)]) withcolor clr;
        % Draw all the row totals boxes
        for ystart := 100 step 100 until 900:
            for xstart := 1200 step 100 until 1300:
                draw_row_summary_box(xstart,ystart,clr);
            endfor
        endfor
        % Draw the game and play total boxes
        for ystart := -100 step 50 until 50:
            xstart := 1200;
            draw_game_summary_box(xstart,ystart,clr);
            draw_play_total_box(xstart,ystart,clr);
        endfor
        % Put the key on the play total boxes
        nudge := 5u;
        label.urt(btex {\sf 1B} etex, (1200+100u/3*2,50+25u+nudge)) withcolor clr;
        label.urt(btex {\sf 2B} etex, (1200+100u/3*2,50+nudge)) withcolor clr;
        label.urt(btex {\sf DP} etex, (1200+100u/3*2+100u,50+25u+nudge)) withcolor clr;
        label.urt(btex {\sf HBP} etex, (1200+100u/3*2+100u,50+nudge)) withcolor clr;
        label.urt(btex {\sf 3B} etex, (1200+100u/3*2,0+25u+nudge)) withcolor clr;
        label.urt(btex {\sf HR} etex, (1200+100u/3*2,0+nudge)) withcolor clr;
        label.urt(btex {\sf WP} etex, (1200+100u/3*2+100u,0+25u+nudge)) withcolor clr;
        label.urt(btex {\sf PB} etex, (1200+100u/3*2+100u,0+nudge)) withcolor clr;
        label.urt(btex {\sf SF} etex, (1200+100u/3*2,-50+25u+nudge)) withcolor clr;
        label.urt(btex {\sf SAC} etex, (1200+100u/3*2,-50+nudge)) withcolor clr;
        label.urt(btex {\sf SB} etex, (1200+100u/3*2+100u,-50+25u+nudge)) withcolor clr;
        label.urt(btex {\sf CS} etex, (1200+100u/3*2+100u,-50+nudge)) withcolor clr;
        % Proof
        label.urt(btex {\sf AB+BB+HBP+SAC+SF} etex, (1200+100u/3*2,-100+25u+nudge)) withcolor clr;
        label.urt(btex {\sf =\quad R+LOB+OPO} etex, (1200+100u/3*2+24u,-100+nudge)) withcolor clr;
        % Side information
        % pickup pencircle scaled thickline_t;
        pickup pencircle scaled thickline_t;
        draw (1400,100)--(1400,1000)--(1466,1000)--(1466,100)--cycle withcolor clr;
        draw (1399,1000)--(1399,1033.3)--(1466,1033.3)--(1466,1000)--cycle withcolor clr;
        pickup pencircle scaled thinline_t;;
        draw (1433.3,100)--(1433.3,1000) withcolor clr;
        label(btex {\bigsf Team} etex rotated 90, (1416,130)) withcolor clr;
        label(btex {\bigsf FP} etex rotated 90, (1416,614)) withcolor clr;
        label(btex {\bigsf Temp} etex rotated 90, (1416,900)) withcolor clr;
        label(btex {\bigsf At} etex rotated 90, (1448,142)) withcolor clr;
        label(btex {\bigsf Att} etex rotated 90, (1448,450)) withcolor clr;
        label(btex {\bigsf Scorer} etex rotated 90, (1448,600)) withcolor clr;
        label(btex {\tiny Copyright \char'251 2005, Christopher Swingley, cswingle@iarc.uaf.edu} etex rotated 90, (1472,-210)) withcolor clr;
        % Little numbers for first nine in batting order
        label(btex {\sf 1} etex, (-224u, 995u)) withcolor clr;
        label(btex {\sf 2} etex, (-224u, 895u)) withcolor clr;
        label(btex {\sf 3} etex, (-224u, 795u)) withcolor clr;
        label(btex {\sf 4} etex, (-224u, 694u)) withcolor clr;
        label(btex {\sf 5} etex, (-224u, 594u)) withcolor clr;
        label(btex {\sf 6} etex, (-224u, 494u)) withcolor clr;
        label(btex {\sf 7} etex, (-224u, 393u)) withcolor clr;
        label(btex {\sf 8} etex, (-224u, 293u)) withcolor clr;
        label(btex {\sf 9} etex, (-224u, 193u)) withcolor clr;
        % Numbers for pitchers
        label(btex {\sf 1} etex, (-224u, -141u)) withcolor clr;
        label(btex {\sf 2} etex, (-224u, -174u)) withcolor clr;
        label(btex {\sf 3} etex, (-224u, -208u)) withcolor clr;
        label(btex {\sf 4} etex, (-224u, -241u)) withcolor clr;
        label(btex {\sf 5} etex, (-224u, -274u)) withcolor clr;
        % second column of pitchers
        label(btex {\sf 6} etex, (640u, -141u)) withcolor clr;
        label(btex {\sf 7} etex, (640u, -174u)) withcolor clr;
        label(btex {\sf 8} etex, (640u, -208u)) withcolor clr;
        label(btex {\sf 9} etex, (640u, -241u)) withcolor clr;
        label(btex {\sf 10} etex, (643u, -274u)) withcolor clr;
        % Title boxes
            xstart:=100;
            ystart:=1000;
            pickup pencircle scaled thickline_t;
            % Inning and Position box
            draw (xstart,ystart)--(xstart-iposwidth*2u,ystart)--(xstart-iposwidth*2u,ystart+100u/3)--(xstart,ystart+100u/3)--cycle withcolor clr;
            draw (xstart-iposwidth,ystart)--(xstart-iposwidth,ystart+100u/3) withcolor clr;
            label(btex {\bigsf Pos} etex, 1/2[(xstart-iposwidth*2u,ystart),(xstart-iposwidth,ystart+100u/3)]) withcolor clr;
            label(btex {\bigsf Inn} etex, 1/2[(xstart-iposwidth,ystart),(xstart,ystart+100u/3)]) withcolor clr;
            % Player name box
            draw (xstart-iposwidth*2,ystart)--(xstart-iposwidth*2-namewidth,ystart)--(xstart-iposwidth*2-namewidth,ystart+100u/3)--
                    (xstart-iposwidth*2,ystart+100u/3)--cycle withcolor clr;
            label(btex {\bigsf Batter} etex, 1/2[(xstart-iposwidth*2-namewidth,ystart),(xstart-iposwidth*2,ystart+100u/3)]) withcolor clr;
            % Number box
            draw (xstart-iposwidth*2-namewidth,ystart)--(xstart-iposwidth*3-namewidth,ystart)--(xstart-iposwidth*3-namewidth,ystart+100u/3)--
                    (xstart-iposwidth*2-namewidth,ystart+100u/3)--cycle withcolor clr;
            label(btex {\bigsf \#} etex, 1/2[(xstart-iposwidth*2-namewidth,ystart),(xstart-iposwidth*3-namewidth,ystart+100u/3)]) withcolor clr;
            % Inning boxes
            ystart:=1000;
            for xstart := 100 step 100 until 1100:
                draw (xstart,ystart)--(xstart+100u,ystart)--(xstart+100u,ystart+100u/3)--(xstart,ystart+100u/3)--cycle withcolor clr;
            endfor
            label(btex {\bigsf 1} etex, 1/2[(100,ystart),(200,ystart+100u/3)]) withcolor clr;
            label(btex {\bigsf 2} etex, 1/2[(200,ystart),(300,ystart+100u/3)]) withcolor clr;
            label(btex {\bigsf 3} etex, 1/2[(300,ystart),(400,ystart+100u/3)]) withcolor clr;
            label(btex {\bigsf 4} etex, 1/2[(400,ystart),(500,ystart+100u/3)]) withcolor clr;
            label(btex {\bigsf 5} etex, 1/2[(500,ystart),(600,ystart+100u/3)]) withcolor clr;
            label(btex {\bigsf 6} etex, 1/2[(600,ystart),(700,ystart+100u/3)]) withcolor clr;
            label(btex {\bigsf 7} etex, 1/2[(700,ystart),(800,ystart+100u/3)]) withcolor clr;
            label(btex {\bigsf 8} etex, 1/2[(800,ystart),(900,ystart+100u/3)]) withcolor clr;
            label(btex {\bigsf 9} etex, 1/2[(900,ystart),(1000,ystart+100u/3)]) withcolor clr;
            label(btex {\bigsf 10} etex, 1/2[(1000,ystart),(1100,ystart+100u/3)]) withcolor clr;
            label(btex {\bigsf 11} etex, 1/2[(1100,ystart),(1200,ystart+100u/3)]) withcolor clr;
            % Player totals
            ystart:=1000;
            for xstart := 1200 step 100u/3 until 1300+100u/3*2:
                draw (xstart,ystart)--(xstart+100u/3,ystart)--(xstart+100u/3,ystart+100u/3)--(xstart,ystart+100u/3)--cycle withcolor clr;
            endfor
            % On the top
            label(btex {\bigsf AB} etex, 1/2[(1200,1000),(1200+100u/3,1000+100u/3)]) withcolor clr;
            label(btex {\bigsf R} etex, 1/2[(1200+100u/3,1000),(1200+100u/3*2,1000+100u/3)]) withcolor clr;
            label(btex {\bigsf H} etex, 1/2[(1200+100u/3*2,1000),(1300,1000+100u/3)]) withcolor clr;
            label(btex {\bigsf RBI} etex, 1/2[(1300,1000),(1300+100u/3,1000+100u/3)]) withcolor clr;
            label(btex {\bigsf SO} etex, 1/2[(1300+100u/3,1000),(1300+100u/3*2,1000+100u/3)]) withcolor clr;
            label(btex {\bigsf BB} etex, 1/2[(1300+100u/3*2,1000),(1400,1000+100u/3)]) withcolor clr;
        pickup pencircle scaled playline_t;
    endgroup
enddef;

EOT


$TEX = <<'EOT';
\pdfinfo
  { /Title          (scorecard.pdf)
    /Creator        (Metapost, TeX)
    /Author         (Christopher Swingley) }
\input miniltx
\input graphicx.sty
\input eplain
\resetatcatcode
\paperheight 11 true in
\paperwidth 8.5 true in
\topmargin 0.75cm
\bottommargin 0.75cm
\leftmargin 1.00cm
\rightmargin 0.75cm
\nopagenumbers
\parindent=0pt\parskip=8pt
\vfill
\includegraphics[height=\hsize,angle=90]{__BASE__-0.pdf}
\vfill\eject
\bye
EOT


$TEXD = <<'EOT';
\pdfinfo
  { /Title          (metapost_scorecard.pdf)
    /Creator        (Metapost, TeX)
    /Author         (Christopher Swingley) }
\input miniltx
\input graphicx.sty
\input eplain
\resetatcatcode
\paperheight 11 true in
\paperwidth 8.5 true in
\topmargin 0.85cm
\bottommargin 0.65cm
\leftmargin 1.00cm
\rightmargin 0.75cm
\nopagenumbers
\parindent=0pt\parskip=8pt
\vfill
\includegraphics[height=\hsize,angle=90]{__BASE1__-0.pdf}
\vfill\eject
\includegraphics[height=\hsize,angle=90]{__BASE2__-0.pdf}
\vfill\eject
\bye
EOT


=head1 LIMITATIONS

This module makes no attempt to try to work around the physical limitations
of the scorecard.  So if there are more than 11 innings, more than nine batters
in an inning, more than three players in the a lineup position, or more than
six pitchers, it will fail, either by dying, or just screwing up the output.

Also, no attempt is made to make sure you have the right number of outs in an
innings, balls/strikes in a walk/strikeout, and so on.  We don't even necessarily
check to make sure you've called inn() before you call your first ab(), or that
you don't use an incorrect base number, and so on.  Or that David Ortiz isn't
pitching, or playing all positions at once.  Just don't record something
illegal in a baseball game, and you likely won't run into problems here,
either.

There are also likely things that happen in the game that the API here does
not well-address.

Patches are welcome for all of this, if you want it.


=head1 TODO

Automatically handle six extra lineup lines over the three lines for
each existing lineup position.

Automatically, or otherwise, handle more than 9 batters per inning, or more
than 11 innings, perhaps by adding a new scorecard, or by re-using existing
innings for overflow.

Internal: a better curr/other method.


=head1 AUTHOR

Chris Nandor E<lt>projects@pudge.netE<gt>, http://projects.pudge.net/

Copyright (c) 2005 Chris Nandor.  Licensed under the terms of the GNU General
Public License, Version 2 available from http://www.gnu.org/copyleft/gpl.html.

Front end to mpost_scorecard by Christopher Swingley, also licensed under
the GPL.

=head1 SEE ALSO

http://www.frontier.iarc.uaf.edu/~cswingle/baseball/scorecards.php


=head1 VERSION

$Id: Scorecard.pm,v 1.3 2005/09/14 22:50:48 pudge Exp $

__END__
