File Coverage

blib/lib/Games/Baseball/Scorecard.pm
Criterion Covered Total %
statement 164 625 26.2
branch 36 308 11.6
condition 22 176 12.5
subroutine 26 65 40.0
pod 31 52 59.6
total 279 1226 22.7


line stmt bran cond sub pod time code
1             package Games::Baseball::Scorecard;
2              
3 1     1   32098 use warnings;
  1         2  
  1         40  
4 1     1   5 use strict;
  1         3  
  1         55  
5              
6             require 5.006;
7              
8 1     1   6 use File::Path;
  1         2  
  1         106  
9 1     1   6210 use File::Temp 'tempdir';
  1         28006  
  1         63  
10 1     1   797 use File::Spec::Functions qw(:DEFAULT rel2abs);
  1         855  
  1         196  
11 1     1   785 use Text::ParseWords;
  1         1212  
  1         10308  
12              
13             our $VERSION = '0.03';
14              
15             our($SCORECARD, $TEX, $TEXD);
16             our $MPOST = 'mpost';
17             our $MPTOPDF = 'mptopdf';
18             our $PDFTEX = 'pdftex';
19             our $OPEN = 'open';
20              
21             # default: black
22             our @COLOR = (0, 0, 0);
23             # others:
24             # light cyan
25             #@COLOR = (.10, 1, 1);
26             # dark cyan
27             #@COLOR = (.25, 1, 1);
28             # grey
29             #@COLOR = (.4, .4, .4);
30              
31             our @FONTS = (
32             # defaults that look very nice
33             [ myriadrcrrl => 9 ],
34             [ myriadrcbrl => 14 ],
35             [ myriadrcrrl => 14 ],
36             [ myriadrcbrl => 22 ],
37             );
38              
39             # cmssdc10 is another nice one, i prefer this: it's darker and narrower
40             @FONTS = (
41             # ones that should work everywhere:
42             [ phvr8rn => 8 ],
43             [ phvb8rn => 12 ],
44             [ phvr8rn => 12 ],
45             [ phvb8rn => 18 ],
46             );
47              
48             =head1 NAME
49              
50             Games::Baseball::Scorecard
51              
52              
53             =head1 SYNOPSIS
54              
55             my $score = Games::Baseball::Scorecard->new($dir, $name, {
56             color => [ .4, .4, .4 ], # grey
57             fonts => [ # Myriad Condensed regular/bold
58             [ myriadrcrrl => 9 ],
59             [ myriadrcbrl => 14 ],
60             [ myriadrcrrl => 14 ],
61             [ myriadrcbrl => 22 ],
62             ],
63             });
64              
65             # fill initial scorecard out
66             $s->init({
67             scorer => 'Pudge',
68             date => '2004-10-24, 20:05-23:25',
69             at => 'Fenway Park, Boston',
70             temp => '48 clear',
71             wind => '7 to RF',
72             att => '35,001',
73             home => {
74             team => 'Boston Red Sox',
75             starter => 38, # jersey number
76             lineup => [
77             # [ num, position ],
78             [ 18, 8 ], # Damon, starting at CF
79             # ...
80             ],
81             roster => {
82             # num => name
83             18 => 'Damon, Johnny',
84             38 => 'Schilling, Curt',
85             # ...
86             },
87             },
88             away => {
89             team => 'St. Louis Cardinals',
90             # ...
91             }
92             });
93              
94             # draw the game
95             $s->inn; # new inning / end of last inning
96              
97             $s->ab; # new at-bat
98             # works to full count
99             $s->pitches(qw(s b s b b f));
100             # struck out looking
101             $s->out('!K');
102              
103             $s->ab;
104             # home run to left-center
105             $s->hit(4, 'lc');
106              
107             # calculate/draw stats
108             $self->totals;
109              
110             # finish the job
111             $s->generate;
112              
113             # open final PDF
114             $s->pdfopen;
115              
116              
117             =head1 DESCRIPTION
118              
119             Games::Baseball::Scorecard is a frontend to a PDF scorecard written in Metapost by
120             Christopher Swingley (L).
121             That scorecard is drawn out, and has a nice API for actually drawing out the
122             elements of the game: all the ball, strikes, outs, etc.
123              
124             Being Metapost, it is laborious to do all this. So this module provides a nice
125             frontend, that also keeps track of balls and strikes and hits and runs and outs
126             and more, making input of the game quite simple and efficient.
127              
128             This module does not include the entire API, but most of it. Patches and ideas
129             welcome. Feel free to call C directly if you want to generate Metapost
130             on your own, or to modify the C<$SCORECARD> variable (which contains the base
131             Metapost code), or the C<$TEX> (single page) and C<$TEXD> (duplex) TeX files.
132              
133             I won't give a tutorial on scoring baseball games, or on Metapost, below. Seek
134             other resources (Swingley's URL above has a nice tutorial on scoring baseball
135             games, using the scorecard he designed, which is what we're using here).
136              
137              
138             =head1 SYSTEM REQUIREMENTS
139              
140             You will need TeX and Metapost installed. F, F, and F
141             must be in your C<$ENV{PATH}>. For opening the PDF with C, you will
142             need C (Mac OS X) in your path. The names of these programs can be modified
143             with the variables C<$MPOST>, C<$MPTOPDF>, C<$PDFTEX>, and C<$OPEN>.
144              
145             Also, the font by default (in the C<$SCORECARD> variable) is Helvetica Narrow.
146             Use whatever fonts you have installed for TeX. The original used Myriad
147             Condensed, which I don't have (getting a decent-looking font and size, and
148             figuring out how to use it, was the hardest part of the project for me -- as
149             I don't know TeX -- so I picked a font everyone else could use, that should
150             be installed by default in most TeX installations).
151              
152             See the distribution at
153             L for
154             more information.
155              
156              
157             =head1 METHODS
158              
159             The main methods are included below. There are some other methods that are used,
160             but you shouldn't need to call them so I won't list them all here.
161              
162             =head2 Basic Methods
163              
164             =over 4
165              
166             =item new([DIR, BASE, OPTS])
167              
168             The C method takes three optional arguments: a directory to build in,
169             and a base name for the scorecard file, and an options hashref. Defaults are
170             the current directory, and "scorecard". The base name is used to generate the
171             build files and the resulting PDFs, which will be F<${base}_away.pdf>,
172             F<${base}_home.pdf>, and F<$base.pdf> (both away and home together).
173              
174             Options can be "color", an arrayref of RGB values (0 to 1), and "fonts",
175             an arrayref of four fonts (copyright notice font, basepath play labels,
176             balls/strikes/outs/other labels, and outs and other large label), with
177             the font name and size (see L).
178              
179             Defaults are black, and Helvetica Narrow (phvr8rn/phvr8rn).
180              
181             =cut
182              
183             sub new {
184 1     1 1 34 my($ref, $dir, $base, $opts) = @_;
185 1   50     9 $opts ||= {};
186 1   33     3 $dir ||= tempdir();
187 1   50     9 $base ||= 'scorecard';
188 1         4 $base =~ s/\W+//g;
189              
190 1 50       7 $dir = rel2abs($dir) unless file_name_is_absolute($dir);
191              
192 1 50       83 mkpath($dir) unless -e $dir;
193              
194 1         8 my $self = bless {
195             debug => 0,
196             dir => $dir,
197             base => $base,
198             }, __PACKAGE__;
199              
200 1         4 for my $which (qw(away home)) {
201 2         3 my $fh;
202 2         7 my $basewhich = "${base}_$which";
203 2 50       222 unless (open $fh, '>', catfile($dir, "$basewhich.tex")) {
204 0         0 warn $!;
205 0         0 return;
206             }
207              
208 2         15 (my $tex = $TEX) =~ s/__BASE__/$basewhich/;
209 2         34 print $fh $tex;
210 2         75 close $fh;
211              
212              
213 2 50       187 unless (open $fh, '>', catfile($dir, "$basewhich.mp")) {
214 0         0 warn $!;
215 0         0 return;
216             }
217              
218 2   66     14 $opts->{fonts}[0] ||= $FONTS[0];
219 2   66     10 $opts->{fonts}[1] ||= $FONTS[1];
220 2   66     7 $opts->{fonts}[2] ||= $FONTS[2];
221 2   66     9 $opts->{fonts}[3] ||= $FONTS[3];
222              
223 2 100       12 $opts->{color}[0] = $COLOR[0] unless defined $opts->{color}[0];
224 2 100       7 $opts->{color}[1] = $COLOR[1] unless defined $opts->{color}[1];
225 2 100       7 $opts->{color}[2] = $COLOR[2] unless defined $opts->{color}[2];
226              
227 2         4 my $mp = $SCORECARD;
228 2         130 $mp =~ s/__FONTFACE0__/$opts->{fonts}[0][0]/g;
229 2         131 $mp =~ s/__FONTFACE1__/$opts->{fonts}[1][0]/g;
230 2         141 $mp =~ s/__FONTFACE2__/$opts->{fonts}[2][0]/g;
231 2         131 $mp =~ s/__FONTFACE3__/$opts->{fonts}[3][0]/g;
232              
233 2         106 $mp =~ s/__FONTSIZE0__/$opts->{fonts}[0][1]/g;
234 2         100 $mp =~ s/__FONTSIZE1__/$opts->{fonts}[1][1]/g;
235 2         123 $mp =~ s/__FONTSIZE2__/$opts->{fonts}[2][1]/g;
236 2         99 $mp =~ s/__FONTSIZE3__/$opts->{fonts}[3][1]/g;
237              
238 2         110 $mp =~ s/__COLOR1__/$opts->{color}[0]/g;
239 2         116 $mp =~ s/__COLOR2__/$opts->{color}[1]/g;
240 2         121 $mp =~ s/__COLOR3__/$opts->{color}[2]/g;
241              
242 2         373 print $fh $mp;
243              
244 2         26 $self->{$which} = {
245             which => $which,
246             base => $basewhich,
247             fh => $fh,
248             ab => 0,
249             inn => 0,
250             };
251             }
252              
253 1         2 my $fhd;
254 1 50       90 unless (open $fhd, '>', catfile($dir, "$base.tex")) {
255 0         0 warn $!;
256 0         0 return;
257             }
258              
259 1         3 my $texd = $TEXD;
260 1         10 $texd =~ s/__BASE1__/$self->{away}{base}/;
261 1         7 $texd =~ s/__BASE2__/$self->{home}{base}/;
262 1         5 print $fhd $texd;
263 1         35 close $fhd;
264              
265 1         3 for (qw(home away)) {
266 2         9 $self->home_away($_);
267 2         7 $self->begin;
268 2 100       11 $self->top if /away/;
269 2 100       11 $self->bottom if /home/;
270             }
271              
272 1         8 return $self;
273             }
274              
275              
276             =item debug([LEVEL])
277              
278             Set debug level. 0 is off, 1 shows the commands being executed, 2 shows all
279             output.
280              
281             =cut
282              
283             sub debug {
284 0     0 1 0 my($self, $level) = @_;
285              
286 0 0       0 $self->{debug} = $level if defined $level;
287 0         0 return $self->{debug};
288             }
289              
290             sub death {
291 0     0 0 0 my($self, $err) = @_;
292 0         0 printf STDERR "die: $err\nInning: $self->{curr}{inn}, order: $self->{curr}{ab}\n";
293 0         0 exit;
294             }
295              
296              
297             =item init(DATA)
298              
299             The method accepts a single hashref that has all the data needed to
300             generate the initial scorecard. You can some of the methods directly on your
301             own, but you really don't want to.
302              
303             The hashref contains various root-level string keys: C, C, C,
304             C, C, C. Each takes a simple string.
305              
306             It also takes two hashref keys, C and C. Each works the same way.
307             The C key takes the team name, the C key takes the jersey number
308             of the starter, the C key takes a hashref of jersey number/name for
309             the entire active roster.
310              
311             The C key takes an arrayref -- in order -- of each starter, with each
312             element as an arrayref of [ jersey number, position ].
313              
314             The position is standard baseball position numbering: 1 P, 2 C,
315             3 1B, 4 2B, 5 3B, 6 SS, 7 LF, 8 CF, 9 RF. I use 0 for DH.
316              
317             Players are thus referenced by their jersey number, when making them the
318             starter, putting them in the starting lineup, or when adding a new player
319             or pitcher.
320              
321             The C key is optional; if present, it is used to determine which
322             pitchers are lefties. It takes a simple arrayref listing the jersey numbers
323             of the southpaws on the roster.
324              
325             If not using this module to generate the entire game, but just the initial
326             scorecard, then the roster needs only include the players in the starting lineup.
327              
328             =cut
329              
330             sub init {
331 1     1 1 18 my($self, $data) = @_;
332              
333 1         6 for my $which (qw(away home)) {
334 2         4 $self->home_away($which);
335              
336 2         7 $self->team ( $data->{$which}{team} );
337 2         6 $self->date ( $data->{date} );
338 2         7 $self->temp ( $data->{temp} );
339              
340 2         6 $self->at ( $data->{at} );
341 2         7 $self->att ( $data->{att} );
342 2         8 $self->scorer( $data->{scorer} );
343 2         6 $self->wind ( $data->{wind} );
344              
345 2         5 my $roster = $self->{curr}{roster} = $data->{$which}{roster};
346 2         6 $self->{curr}{lefties} = $data->{$which}{lefties};
347              
348 2         3 my $order = 0;
349 2         2 for (@{$data->{$which}{lineup}}) {
  2         10  
350 0         0 $self->add_player(++$order, $_->[0], $_->[1]);
351             }
352             }
353              
354 1         3 $self->home_away('away');
355 1 50       3 $self->add_pitcher($data->{home}{starter}) if $data->{home}{starter};
356              
357 1         4 $self->home_away('home');
358 1 50       4 $self->add_pitcher($data->{away}{starter}) if $data->{away}{starter};
359             }
360              
361              
362             =item generate
363              
364             The C method takes the Metapost code and generates the PDFs.
365             Call this last, after everything has been done to the scorecard.
366              
367             Calls C for you.
368              
369             Returns the path to the PDF file.
370              
371             =cut
372              
373             sub generate {
374 1     1 1 8 my($self) = @_;
375 1         5 $self->close;
376              
377 1         3 for (qw(away home)) {
378 2         15 my $base = $self->{$_}{base};
379              
380 2         25 $self->_run($MPOST, "$base.mp");
381 2         85 $self->_run($MPTOPDF, "$base.0");
382 2         81 $self->_run($PDFTEX, "$base.tex");
383             }
384              
385 1         36 $self->_run($PDFTEX, "$self->{base}.tex");
386              
387 1         51 return catfile($self->{dir}, "$self->{base}.pdf");
388             }
389              
390             sub _run {
391 7     7   38 my($self, $command, $file, $abs) = @_;
392              
393 7 50       232 unless (chdir $self->{dir}) {
394 0         0 die "Can't chdir $self->{dir}: $!";
395             }
396              
397 7 50       111 my $path = $abs ? $file : catfile($self->{dir}, $file);
398 7 50       30 print "==> " if $self->{debug} > 1;
399 7 50       19 print "$command $path\n" if $self->{debug};
400 7         28 local $/;
401 7         42204 my $output = `$command $path`;
402              
403 7 50       122 if ($self->{debug} > 1) {
404 0 0       0 print "<== $output" if $output;
405 0         0 print "\n", ("-" x 73), "\n\n";
406             }
407              
408 7         683 return $output;
409             }
410              
411              
412             =item close
413              
414             The C method finishes up the Metapost file, and closes it for you.
415              
416             Do not call this method if you also call C, as that method calls
417             this one. Only call this method if you do not wish to generate the PDF files,
418             but only want to write out the Metapost file.
419              
420             =cut
421              
422             sub close {
423 1     1 1 2 my($self) = @_;
424              
425 1         2 for (qw(away home)) {
426 2         5 $self->home_away($_);
427 2 50       6 if ($self->{curr}{fh}) {
428 2         5 $self->end;
429 2         4 $self->output("\nend\n");
430              
431 2         86 close $self->{curr}{fh};
432 2         10 delete $self->{curr}{fh};
433             }
434             }
435             }
436              
437              
438             =item pdfopen([FILE])
439              
440             Opens the PDF (or filename provided) using the program specified in
441             C<$OPEN> (default 'open', used by Mac OS X to open the document in the default
442             PDF viewer).
443              
444             =cut
445              
446             sub pdfopen {
447 0     0 1 0 my($self, $file) = @_;
448 0         0 my $abs = 1;
449 0 0       0 if (!$file) {
450 0         0 $abs = 0;
451 0         0 $file = "$self->{base}.pdf";
452             }
453              
454 0 0       0 $self->_run($OPEN, $file, $abs) if $OPEN;
455             }
456              
457              
458             =item home_away([WHICH])
459              
460             Switch which team is home, and which is away. If WHICH then set specifically.
461              
462             =cut
463              
464             sub home_away {
465 8     8 1 15 my($self, $which) = @_;
466              
467 8 50       15 if ($which) {
468 8         17 $self->{curr} = $self->{$which};
469             $self->{other} = $self->{
470 8 100       25 $which eq 'home' ? 'away' : 'home'
471             };
472             } else {
473 0         0 ($self->{curr}, $self->{other}) = ($self->{other}, $self->{curr});
474             }
475             }
476              
477              
478             =back
479              
480             =head2 Scoring Methods
481              
482             These are the methods for scoring an actual game.
483              
484             =head3 Setup Methods
485              
486             =over 4
487              
488             =item inn
489              
490             Call C to start a new half-inning, and to finish the final inning. It
491             generates the inning stats.
492              
493             B: if you go to more than 11 innings, things will break.
494             See L.
495              
496             =cut
497              
498             sub inn {
499 0     0 1 0 my($self) = @_;
500              
501 0         0 $self->output("\n\n % inning end\n");
502              
503 0         0 my $stats = $self->{curr}{stats}{inning};
504 0 0       0 if ($stats) {
505 0   0     0 $self->output(_label(_btex($stats->{r} ||= 0), '1/2[(xstart,-150),(xstart+50u,-100+400)]'));
506 0   0     0 $self->output(_label(_btex($stats->{h} ||= 0), '1/2[(xstart+50u,-150),(xstart+100u,-100+400)]'));
507 0   0     0 $self->output(_label(_btex($stats->{e} ||= 0), '1/2[(xstart,-200),(xstart+50u,-150+400)]'));
508 0   0     0 $self->output(_label(_btex($stats->{lb} ||= 0), '1/2[(xstart+50u,-200),(xstart+100u,-150+400)]'));
509 0   0     0 $self->output(_label(_btex($stats->{bb} ||= 0), '1/2[(xstart,-250),(xstart+50u,-200+400)]'));
510 0   0     0 $self->output(_label(_btex($stats->{k} ||= 0), '1/2[(xstart+50u,-250),(xstart+100u,-200+400)]'));
511 0   0     0 $self->output(_label(_btex($stats->{strikes}||0), '1/2[(xstart,-300),(xstart+50u,-250+400)]'));
512 0   0     0 $self->output(_label(_btex($stats->{pitches}||0), '1/2[(xstart+50u,-300),(xstart+100u,-250+400)]'));
513              
514 0         0 $self->output(" draw_inning_end(xstart,ystart,clr);\n\n");
515             }
516              
517 0         0 $self->output("\n\n % inning start\n");
518              
519 0         0 $self->home_away;
520              
521 0         0 my $inn = $self->{curr}{inn} += 1;
522 0 0       0 $self->{_inn_new} = 1 unless $self->{curr}{inn} == 1;
523 0         0 $self->{out} = [];
524 0         0 $self->{bases} = [];
525 0   0     0 $self->{curr}{stats}{inning} = $self->{curr}{stats}{innings}{$inn} ||= {};
526              
527 0         0 my $xstart = $self->{curr}{inn} * 100;
528 0         0 $self->{curr}{xstart} = $xstart;
529 0         0 $self->output(" xstart := $xstart;\n");
530             }
531              
532              
533             =item ab
534              
535             Call C to start a new at-bat. B: call C and C
536             I calling C.
537              
538             B: if you have more than 9 batters in an inning, things will break.
539             See L.
540              
541             =cut
542              
543             sub ab {
544 0     0 1 0 my($self) = @_;
545              
546 0         0 $self->{curr}{ab} += 1;
547 0 0       0 $self->{curr}{ab} = 1 if $self->{curr}{ab} > 9;
548 0         0 $self->{pc} = 0;
549              
550 0         0 $self->{curr}{stats}{pitcher}{bf}++;
551              
552             $self->{curr}{stats}{batter} = $self->{curr}{stats}{batters}{
553 0   0     0 $self->{curr}{lineup}[$self->{curr}{ab}][-1][0]
554             } ||= {};
555              
556 0         0 my $ystart = 1000 - $self->{curr}{ab} * 100;
557              
558 0         0 $self->output("\n\n % inning $self->{curr}{inn}, batter $self->{curr}{ab}\n");
559 0         0 $self->output(" ystart := $ystart;\n");
560 0         0 $self->output(" clr := (0,0,0);\n");
561 0         0 $self->output(" set_vars(xstart,ystart);\n");
562             # $self->output(" draw_square(xstart,ystart);\n");
563 0 0       0 $self->output(" draw_inning_start(xstart,ystart,clr);\n")
564             if delete $self->{_inn_new};
565              
566 0 0       0 if ($self->{curr}{lineupnew}[ $self->{curr}{ab} ]) {
567 0         0 $self->{curr}{lineupnew}[ $self->{curr}{ab} ] = 0;
568 0         0 $self->output(" draw(new_hitter) withcolor clr;\n");
569             }
570              
571 0 0       0 if (delete $self->{curr}{pitchernew}) {
572 0         0 $self->output(" draw(new_pitcher) withcolor clr;\n");
573             }
574             }
575              
576              
577             =item add_player(ORDER, NUMBER, POS [, INN])
578              
579             This adds a new player -- with the given jersey number and position -- in the
580             given place in the batting order. If you are scoring an actual game, call
581             this only at the point the player enters the game. The inning will be figured
582             out automatically then.
583              
584             The player will be added to the lineup list on the left of the card, and
585             stats for that lineup position will be added to that player (instead of the
586             previous one) from that moment on, and a line will be drawn on the sheet for
587             where that player entered.
588              
589             Call this before you call C (unless the player enters as a pinch runner).
590              
591             B: if you add more than three batters for a given position, the overflow
592             will go to one of the six spots below the nine lineup positions. No stats
593             will be printed for them. More than six of those, and the names will not be
594             printed either.
595              
596             =cut
597              
598             sub add_player {
599 0     0 1 0 my($self, $order, $number, $pos, $inn) = @_;
600 0   0     0 $inn ||= $self->{curr}{inn} || 1;
      0        
601              
602 0   0     0 my $lineup = $self->{curr}{lineup} ||= [];
603 0   0     0 my $lineupx = $self->{curr}{lineupx} ||= {};
604 0         0 my $name = $self->{curr}{roster}{$number};
605              
606 0         0 my $rep = '';
607 0         0 my $rep2;
608 0         0 my $xtra = 0;
609 0 0       0 if ($lineup->[$order]) {
610 0         0 $rep2 = 1 + @{$lineup->[$order]};
  0         0  
611 0 0       0 if ($rep2 > 3) {
612 0         0 $rep2 = 1 + keys %$lineupx;
613 0 0       0 if ($rep2 > 6) {
614 0         0 warn "Too many batters\n";
615             }
616 0         0 $xtra = 1;
617             }
618 0         0 $rep = "*$rep2";
619              
620 0         0 $self->{curr}{lineupnew}[$order] = 1;
621              
622             my $curr_batter = $self->{curr}{stats}{batters}{
623 0   0     0 $lineup->[$order][-1][0]
624             } ||= {};
625              
626 0 0 0     0 if ($self->{curr}{stats}{batter} &&
627             $self->{curr}{stats}{batter} eq $curr_batter
628             ) {
629 0   0     0 $self->{curr}{stats}{batter} =
630             $self->{curr}{stats}{batters}{$number} ||= {};
631             }
632             }
633              
634 0         0 push @{$lineup->[$order]}, [ $number, $pos, $inn ];
  0         0  
635 0 0       0 $lineupx->{$number} = $order if $xtra;
636              
637 0 0       0 my $ystart = 1000 - ($xtra ? 10 : $order) * 100;
638 0         0 my $x = '100-iposwidth';
639 0         0 my $y = "$ystart+100u-100u/3$rep";
640 0         0 my $dir = 'urt';
641              
642 0 0 0     0 if (!$rep2 || $rep2 <= 6) {
643 0 0       0 if ($xtra) {
644 0         0 my $name2 = "$name ($inn)";
645 0         0 $self->output(_label(_btex($order, 'sf'), '-224u', "92u-(($rep2-1)*100u/3)"));
646 0         0 $self->output(_label(_btex($name2), "$x*2-namewidth", $y, $dir));
647             } else {
648 0         0 $self->output(_label(_btex($name), "$x*2-namewidth", $y, $dir));
649 0         0 $self->output(_label(_btex($inn), $x, $y, $dir));
650             }
651 0         0 $self->output(_label(_btex($number), "$x*3-namewidth", $y, $dir));
652 0         0 $self->output(_label(_btex($pos), "$x*2", $y, $dir));
653             }
654             }
655              
656             =item add_pitcher(NUMBER, [, INN])
657              
658             This adds a new pitcher -- with the given jersey number -- to the scorecard.
659             If you are scoring an actual game, call this only at the point the pitcher
660             enters the game. The inning will be figured out automatically then.
661              
662             The pitcher will be added to the lineup list on the left of the card, and
663             stats for pitching will be added to that pitcher (instead of the
664             previous one) from that moment on, and a line will be drawn on the sheet for
665             where that pitcher entered.
666              
667             Call this before you call C.
668              
669             B: if you add more than six pitchers, the module will die.
670             See L.
671              
672             =cut
673              
674             sub add_pitcher {
675 0     0 1 0 my($self, $number, $inn) = @_;
676 0   0     0 $inn ||= $self->{curr}{inn} || 1;
      0        
677              
678 0         0 $self->{curr}{pitcher} = $number;
679 0   0     0 $self->{curr}{stats}{pitcher} = $self->{other}{stats}{pitchers}{$number} ||= {};
680              
681 0   0     0 my $lineup = $self->{other}{plineup} ||= [];
682 0         0 my $name = $self->{other}{roster}{$number};
683              
684 0         0 my $rep = '';
685 0         0 my $xstart = 100;
686 0 0       0 if (@$lineup) {
687 0         0 my $rep2 = 1 + @$lineup;
688 0 0       0 if ($rep2 > 10) {
    0          
689 0         0 die "fixme!";
690             } elsif ($rep2 > 5) {
691 0         0 $rep2 -= 5;
692 0         0 $xstart = '905+100u*(2/3)';
693             }
694 0         0 $rep = "*$rep2";
695 0         0 $self->{curr}{pitchernew} = 1;
696             }
697              
698 0         0 push @$lineup, [ $number, $inn ];
699              
700 0         0 my $lr;
701 0 0       0 if ($self->{other}{lefties}) {
702 0 0       0 $lr = (grep { $_ == $number } @{$self->{other}{lefties}})
  0         0  
  0         0  
703             ? 'L'
704             : 'R';
705             }
706              
707 0         0 my $ystart = -200;
708 0         0 my $x = "$xstart-iposwidth";
709 0         0 my $y = "$ystart+100u-100u/3$rep-100u/3";
710 0         0 my $dir = 'urt';
711              
712 0         0 $self->output(_label(_btex($name), "$x*2-namewidth", $y, $dir));
713 0         0 $self->output(_label(_btex($number), "$x*3-namewidth", $y, $dir));
714 0 0       0 $self->output(_label(_btex($lr), "$x*2+8", $y, $dir)) if $lr;
715 0         0 $self->output(_label(_btex($inn), $x, $y, $dir));
716             }
717              
718             =back
719              
720             =head3 At-Bat Methods
721              
722             These methods will draw in the at-bat graphic for the current at-bat,
723             and will also keep track of stats for later drawing (per-inning stats,
724             per-batter stats, and game totals).
725              
726             B: At-bats do not progress the way they would in a game. You put in
727             all of the information for a given at-bat in that at-bat before moving on
728             to the next. For example, if a runner reaches on a walk, and then is hit
729             home by a home run, you would mark the walk, then that the runner advanced home,
730             before moving on to the next at-bat.
731              
732              
733             =over 4
734              
735             =item play_ball(TEXT[, TEAMS])
736              
737             C is a convenience method for handling input as text instead of
738             method calls (internally, it converts the text to method calls).
739              
740             The first token on each line is the method call, and the rest are arguments
741             to the method call.
742              
743             Shorthands include 'p' for C, 'bb' 'ibb' and 'hp' for C
744             by BB/IBB/HBP, and '-E' for C. Any other tokens that are not
745             method names are C.
746              
747             Example:
748              
749             $s->inn;
750             $s->ab;
751             $s->pitches(qw(b s b s b));
752             $s->out('!K');
753             $s->ab;
754             $s->pitches(qw(b b b));
755             $s->reach('bb');
756             $s->advance(2);
757             $s->ab;
758             $s->hit(1, 'l');
759              
760             Is equivalent to:
761              
762             $s->play_ball(<<'EOT');
763             inn
764             ab
765             p b s b s b
766             !K
767             ab
768             p b b b
769             bb
770             -> 2
771             ab
772             hit 1 l
773            
774             EOT
775              
776             Prefixing a method name with 'ha' will call C for that method
777             (useful for adding new players, such as 'ha add_player 9 3 8' to add a
778             player #3 to center field in the ninth spot for the fielding team, as
779             doing it without 'ha' would make the change for the team at bat).
780              
781             You can also put data for C in the text, at the top. Include any
782             of the "root-level" strings, e.g.:
783              
784             scorer Pudge
785             date 2004-10-24, 20:05-23:25
786              
787             After those, add the string 'away' or 'home', with the team name following;
788             then 'starter' with the starer's number; then the string 'lineup' followed by
789             the lineup data:
790              
791             away Boston Red Sox
792             starter 32
793             lineup
794             18 8
795             44 6
796             24 7
797              
798             Then put the other string ('home'), followed by the data for that team. To
799             complete the data, pass in a hashref with the team name (exactly the same
800             as included following the string 'home' or 'away') as the key to a hashref,
801             and the 'roster' / 'lefties' keys filled out (just as in C).
802              
803             See the F script and F files for an example.
804              
805             =cut
806              
807             sub play_ball {
808 0     0 1 0 my($self, $game, $data) = @_;
809              
810 0         0 my @lines = grep { $_ }
  0         0  
811 0         0 map { s/^\s+//s; s/\s+$//s; $_ }
  0         0  
  0         0  
812 0         0 grep { !/^\s*#/ }
813             split /\n/, $game;
814              
815 0 0       0 if ($game =~ /\n__INIT__\n/) {
816 0         0 my %init;
817              
818 0         0 while (my $l = shift @lines) {
819 0 0       0 last if $l =~ /^__INIT__$/;
820              
821 0         0 my @w = split /\s+/, $l, 2;
822 0 0       0 if ($w[0] =~ /^(?:date|temp|at|att|scorer|wind)$/) {
    0          
823 0         0 $init{$w[0]} = $w[1];
824              
825             } elsif ($w[0] =~ /^(home|away)$/) {
826 0   0     0 my $team = $init{$1} ||= $data->{teams}{$w[1]};
827 0         0 $team->{team} = $w[1];
828              
829 0         0 TEAM: while (my $l2 = shift @lines) {
830 0         0 my @w2 = split /\t/, $l2;
831 0 0       0 if ($w2[0] eq 'starter') {
    0          
832 0         0 $team->{starter} = $w2[1];
833              
834             } elsif ($w2[0] eq 'lineup') {
835 0         0 while (my $l3 = shift @lines) {
836 0         0 my @w3 = split /\s+/, $l3;
837 0 0       0 if ($w3[0] !~ /^\d/) {
838 0         0 unshift @lines, $l3;
839 0         0 last TEAM;
840             }
841 0         0 push @{$team->{lineup}}, [$w3[0], $w3[1]];
  0         0  
842             }
843             }
844             }
845             }
846              
847             }
848              
849 0         0 $self->init(\%init);
850             }
851              
852 0         0 while (my $l = shift @lines) {
853 0 0       0 last if $l =~ /^__GAME__$/;
854 0         0 my @w = quotewords('\s+', 0, $l);
855 0         0 my $m = shift @w;
856              
857 0         0 my $ha;
858 0 0       0 if ($m eq 'ha') {
859 0         0 $ha = 1;
860 0         0 $m = shift @w;
861 0         0 $self->home_away;
862             }
863              
864 0 0       0 next unless $m;
865              
866 0 0       0 $m = 'tout' if $m eq 'to';
867 0 0       0 $m = 'reach' if $m eq 'r';
868 0 0       0 $m = 'advance' if $m eq '->';
869 0 0       0 $m = 'pitches' if $m eq 'p';
870 0 0       0 if ($m eq 'pitches') {
871 0         0 @w = map { split // } @w;
  0         0  
872             }
873              
874 0 0       0 if ($m =~ /^(i?bb|hp|fc)$/i) {
875 0         0 unshift @w, $m;
876 0         0 $m = 'reach';
877             }
878              
879 0 0       0 unless ($self->can($m)) {
880 0         0 $m =~ s/^(\D+)/\U$1/;
881 0         0 unshift @w, $m;
882 0         0 $m = 'out';
883             }
884              
885 0         0 $self->$m(@w);
886 0 0       0 $self->home_away if $ha;
887             }
888             }
889              
890              
891              
892             =item pitches(PITCHES)
893              
894             C records the individual pitches of the at-bat (except for the one
895             that generates an out or puts the ball in play). It takes a list of strings,
896             each string representing a pitch. Each pitch can be one of C, C, or C.
897              
898             This puts the pitch markers in the at-bat graphic, and also increments counts
899             for the stat drawing later.
900              
901             =cut
902              
903             sub pitches {
904 0     0 1 0 my($self, @pitches) = @_;
905 0         0 my($s, $b, $f) = (0, 0, 0);
906              
907 0         0 for (@pitches) {
908 0 0 0     0 if (/s/i || (/f/i && $s < 2)) {
    0 0        
    0          
909 0         0 $self->strike(++$s);
910             } elsif (/f/i) {
911 0         0 $self->foul(++$f);
912             } elsif (/b/i) {
913 0         0 $self->ball(++$b);
914             }
915             }
916             }
917              
918             sub ball {
919 0     0 0 0 my($self, $num) = @_;
920 0         0 my $pc = $self->pc;
921              
922 0 0       0 $self->death("Ball $num?") if $num > 3;
923              
924 0         0 $self->output(_label(_btex($pc, 'sf'), 'ball' . _num($num)));
925             }
926              
927             sub strike {
928 0     0 0 0 my($self, $num) = @_;
929 0         0 my $pc = $self->pc(1);
930              
931 0 0       0 $self->death("Strike $num?") if $num > 2;
932              
933 0         0 $self->output(_label(_btex($pc, 'sf'), 'strike' . _num($num)));
934             }
935              
936             sub foul {
937 0     0 0 0 my($self, $num) = @_;
938 0         0 my $pc = $self->pc(1);
939              
940 0 0       0 $self->output(_label(_btex('x', 'sf'), 'foul' . _num($num)))
941             unless $num > 4;
942             }
943              
944             sub pc {
945 0     0 0 0 my($self, $strike) = @_;
946              
947 0   0     0 my $pitcher = $self->{curr}{stats}{pitcher} ||= {};
948 0   0     0 my $inning = $self->{curr}{stats}{inning} ||= {};
949              
950 0         0 for ($pitcher, $inning) {
951 0         0 $_->{pitches}++;
952 0 0       0 $_->{strikes}++ if $strike;
953             }
954              
955 0         0 return ++$self->{pc};
956             }
957              
958             =item hit(BASES [, WHERE, LABEL])
959              
960             C denotes a hit of BASES bases, to WHERE.
961              
962             WHERE is an optional string, for where the ball left the park or where the
963             fielder recovered it, with these options:
964              
965             infield:
966             il left
967             ic center
968             ir right
969              
970             outfield:
971             l left
972             lc left center
973             cl center left
974             cr center right
975             rc right center
976             r right
977              
978             LABEL is an optional label to put on the way to first base.
979              
980             =cut
981              
982             sub hit {
983 0     0 1 0 my($self, $bases, $where, $label) = @_;
984 0   0     0 $where ||= '';
985              
986 0 0       0 if ($bases eq 'U') {
    0          
987 0         0 $self->rbi;
988 0         0 $bases = 4;
989             } elsif ($bases == 4) {
990 0         0 $self->rbi;
991 0         0 $self->er;
992             }
993              
994 0         0 $self->reach($bases, $bases);
995              
996 0         0 $self->{curr}{stats}{batter}{h}++;
997 0         0 $self->{curr}{stats}{batter}{$bases}++;
998 0         0 $self->{curr}{stats}{inning}{h}++;
999 0         0 $self->{curr}{stats}{game}{$bases}++;
1000 0         0 $self->{curr}{stats}{pitcher}{h}++;
1001 0         0 $self->{curr}{stats}{pitcher}{$bases}++;
1002              
1003 0 0       0 my $foo = $bases == 4 ? 'hr' : 'of';
1004 0 0       0 my $loc = lc $where eq 'il' ? 'ifleft' :
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1005             lc $where eq 'ic' ? 'ifcenter' :
1006             lc $where eq 'ir' ? 'ifright' :
1007              
1008             lc $where eq 'l' ? "${foo}left" :
1009             lc $where eq 'lc' ? "${foo}leftc" :
1010             lc $where eq 'cl' ? "${foo}centerl" :
1011             lc $where eq 'cr' ? "${foo}centerr" :
1012             lc $where eq 'rc' ? "${foo}rightc" :
1013             lc $where eq 'r' ? "${foo}right" :
1014             '';
1015              
1016 0 0       0 $self->output(" draw($loc) withcolor clr;\n") if $loc;
1017 0 0       0 $self->output(_label(_btex($label, 'sf'), 'wayfirst', '', 'lrt')) if $label;
1018              
1019             }
1020              
1021             =item reach(LABEL [, BASES])
1022              
1023             C denotes reaching base by a method other than a hit.
1024             LABEL is the method of reaching, and BASES is optional number
1025             of bases reached (default is, of course, 1).
1026              
1027             Special LABELs include 'bb', 'ibb', 'hp', 'K', 'SAC', and 'SF'.
1028             'K' is special in that it is added to the stats totals; the others
1029             are not included as at-bats; and 'bb', 'ibb', and 'hp' are counted as balls,
1030             instead of strikes.
1031              
1032             =cut
1033              
1034             sub reach {
1035 0     0 1 0 my($self, $label, $bases) = @_;
1036              
1037 0 0       0 if ($label =~ /^i?bb$/i) {
    0          
    0          
1038 0         0 $self->{curr}{stats}{batter}{bb}++;
1039 0         0 $self->{curr}{stats}{inning}{bb}++;
1040 0         0 $self->{curr}{stats}{pitcher}{lc $label}++;
1041             } elsif ($label =~ /^hb?p/i) {
1042 0         0 $self->{curr}{stats}{game}{hp}++;
1043 0         0 $self->{curr}{stats}{pitcher}{hp}++;
1044             } elsif (uc $label eq 'K') {
1045 0         0 $self->{curr}{stats}{batter}{k}++;
1046 0         0 $self->{curr}{stats}{inning}{k}++;
1047 0         0 $self->{curr}{stats}{pitcher}{k}++;
1048             }
1049              
1050 0         0 $self->{curr}{stats}{inning}{lb}++;
1051              
1052 0 0       0 if ($label =~ /^(?:hb?p|i?bb)$/i) {
    0          
1053 0         0 $self->pc;
1054             } elsif ($label =~ /^(?:SAC|SF)/i) {
1055 0         0 $self->pc(1);
1056             } else {
1057 0         0 $self->{curr}{stats}{batter}{ab}++;
1058 0         0 $self->pc(1);
1059             }
1060              
1061 0   0     0 $bases ||= 1;
1062 0         0 $self->base($bases);
1063 0 0       0 $self->run if $bases == 4;
1064              
1065 0 0       0 $bases = $bases == 4 ? 'homerun' :
    0          
    0          
1066             $bases == 3 ? 'triple' :
1067             $bases == 2 ? 'double' :
1068             'single';
1069              
1070 0 0       0 my $circle = $label =~ /^i?bb$/i ? 'bb' :
    0          
    0          
    0          
    0          
    0          
1071             $label =~ /^hb?p/i ? 'hp' :
1072             $label eq 4 ? 'hr' :
1073             $label eq 3 ? 'threeb' :
1074             $label eq 2 ? 'twob' :
1075             $label eq 1 ? 'oneb' :
1076             '';
1077              
1078 0 0       0 if (lc($label) eq 'ibb') {
    0          
    0          
1079 0         0 $self->output(" draw_ibb(bb, clr);\n");
1080             } elsif ($circle) {
1081 0         0 $self->output(" draw_circle($circle, clr);\n");
1082             } elsif ($label) {
1083 0         0 $self->output(_label(_btex($label, 'sf'), 'wayfirst', '', 'lrt'));
1084             }
1085 0         0 $self->output(" draw($bases) withcolor clr;\n");
1086             }
1087              
1088             sub base {
1089 0     0 0 0 my($self, $base) = @_;
1090              
1091 0         0 my $runner = $self->{curr}{ab};
1092 0         0 my $bases = $self->{bases};
1093              
1094 0 0       0 if ($base) {
1095 0         0 $bases->[$runner] = $base;
1096             }
1097 0         0 return $bases->[$runner];
1098              
1099             }
1100              
1101              
1102             =item out(LABEL)
1103              
1104             C records that the at-bat resulted in an out. LABEL is the way in
1105             which the out was recorded, e.g., F8, 4-3, SF7, SAC4-3, DP6-4-3, K, and so on.
1106              
1107             SF and SAC outs will not be recorded as official at-bats. The string
1108             '!K' is used to denote a strikeout looking.
1109              
1110             If you use SF, SAC, DP, K, and !K, then the stats for those can be properly
1111             tabulated at the end.
1112              
1113             =cut
1114              
1115             sub out {
1116 0     0 1 0 my($self, $label) = @_;
1117              
1118 0 0       0 if ($label =~ /^!?K/i) {
    0          
    0          
    0          
1119 0         0 $self->{curr}{stats}{pitcher}{k}++;
1120 0         0 $self->{curr}{stats}{batter}{k}++;
1121 0         0 $self->{curr}{stats}{inning}{k}++;
1122 0         0 $self->{curr}{stats}{batter}{ab}++;
1123             } elsif ($label =~ /^SAC/i) {
1124 0         0 $self->{curr}{stats}{game}{sac}++;
1125             } elsif ($label =~ /^SF/i) {
1126 0         0 $self->{curr}{stats}{game}{sf}++;
1127             } elsif ($label =~ /^DP/i) {
1128 0         0 $self->{curr}{stats}{game}{dp}++;
1129 0         0 $self->{curr}{stats}{batter}{ab}++;
1130             } else {
1131 0         0 $self->{curr}{stats}{batter}{ab}++;
1132             }
1133              
1134 0 0       0 if (uc $label eq '!K') {
    0          
1135 0         0 $self->output(" draw_strikeout_looking(outlabel, clr);\n");
1136             } elsif ($label) {
1137 0         0 $self->output(_label(_btex($label), 'outlabel'));
1138             }
1139              
1140 0         0 $self->pc(1);
1141 0         0 $self->_out;
1142             }
1143              
1144             sub _out {
1145 0     0   0 my($self, $num, $pitcher) = @_;
1146 0 0       0 unless ($num) {
1147 0         0 for (1..3) {
1148 0 0       0 $num = $_, last if !$self->{out}[$_];
1149             }
1150             }
1151              
1152 0 0       0 $self->death('No out number?') unless $num;
1153              
1154 0         0 $self->{out}[$num] = 1;
1155 0         0 $self->{curr}{stats}{game}{outs}++;
1156              
1157 0 0       0 if ($pitcher) {
1158 0         0 $self->{other}{stats}{pitchers}{$pitcher}{outs}++;
1159             } else {
1160 0         0 $self->{curr}{stats}{pitcher}{outs}++;
1161             }
1162              
1163 0         0 my $out = _num($num);
1164 0         0 $self->output(" draw_out_$out(xstart,ystart,clr);\n");
1165             }
1166              
1167              
1168             =item tout(BASE, LABEL [, NUM, PITCHER])
1169              
1170             C records that the runner was thrown out at BASE.
1171             LABEL is the way in which the out was recorded, e.g., CS2-6, FC, DP.
1172              
1173             PITCHER is the number of the pitcher who gets the out (for IP) if not the
1174             one that pitched to that batter.
1175              
1176             It is not necessary to include the base the runner is coming from; that is
1177             remembered for you.
1178              
1179             NUM is used in case the out is not in sequential order: e.g., if a batter
1180             walks, then the next batter strikes out, then the first batter is caught stealing,
1181             without NUM set to 2, the code would guess that it is the first out, since the
1182             at-bat is earlier. By setting NUM to 2 for the throwout, the strikeout will
1183             be set to out 1, and the next out after that will be out 3.
1184              
1185             If you use CS for LABEL, then the stats for that can be properly tabulated at
1186             the end.
1187              
1188             =cut
1189              
1190             sub tout {
1191 0     0 1 0 my($self, $base2, $label, $num, $pitcher) = @_;
1192              
1193 0   0     0 my $base1 = $self->base || 0;
1194              
1195 0         0 $self->_out($num, $pitcher);
1196 0         0 $self->{curr}{stats}{inning}{lb}--;
1197 0 0       0 $self->{curr}{stats}{game}{cs}++ if $label =~ /^CS/i;
1198              
1199 0         0 $self->waybase($label, $base2);
1200              
1201 0 0       0 my $to = $base2 == 4 ? 'to_' : 'cs_';
1202 0 0       0 my $base = $base2 > $base1+1
1203             ? _base($base1) . _base($base2)
1204             : _base($base2);
1205              
1206 0         0 $self->output(" draw($to$base);\n");
1207             }
1208              
1209              
1210             =item advance(BASE [, LABEL])
1211              
1212             C advances a runner to BASE. LABEL is the optional way in which
1213             the runner advanced, e.g., SB.
1214              
1215             If you advance home (4), a run is recorded for that runner, and is marked as
1216             earned for the pitcher. To advance home for an unearned run, use 'U' instead
1217             of '4'.
1218              
1219              
1220             and EARNED is true, the run is earned.
1221              
1222             It is not necessary to include the base the runner is coming from; that is
1223             remembered for you.
1224              
1225             If you use SB, then the stats for that can be properly tabulated at the end.
1226              
1227             =cut
1228              
1229             sub advance {
1230 0     0 1 0 my($self, $base2, $label) = @_;
1231              
1232 0         0 my $unearned;
1233 0 0       0 if (uc $base2 eq 'U') {
1234 0         0 $unearned = 1;
1235 0         0 $base2 = 4;
1236             }
1237              
1238 0         0 my $base1 = $self->base;
1239 0 0       0 $self->waybase($label, $base1+1) if $label;
1240 0         0 $self->base($base2);
1241 0 0       0 $self->run if $base2 == 4;
1242 0 0 0     0 $self->er if $base2 == 4 && !$unearned;
1243              
1244 0 0 0     0 if ($label && $label =~ /^SB/i) {
1245 0         0 $self->{curr}{stats}{batter}{sb}++;
1246 0         0 $self->{curr}{stats}{game}{sb}++;
1247             }
1248              
1249 0         0 for ($base1, $base2) {
1250 0         0 $_ = _base($_);
1251             }
1252              
1253 0         0 $self->output(" draw($base1$base2);\n");
1254             }
1255              
1256              
1257             =back
1258              
1259             =head3 At-Bat Stat Methods
1260              
1261             These methods add additional stats (and in some cases, graphics) that are
1262             not easily decipherable from the other at-bat events, so we need them
1263             explicitly.
1264              
1265             =over 4
1266              
1267             =item rbi([RBIS])
1268              
1269             Add RBI number of RBIs to current batter's totals (default is 1).
1270             Don't include RBIs added by a hit(4), as that is added automatically.
1271              
1272             =cut
1273              
1274             sub rbi {
1275 0     0 1 0 my($self, $rbis) = @_;
1276 0   0     0 $rbis ||= 1;
1277 0         0 $self->{curr}{stats}{batter}{rbi} += $rbis;
1278 0         0 for (1 .. $rbis) {
1279 0         0 my $rbi = 'rbi' . _num($_);
1280 0         0 $self->output(" draw_dot($rbi, clr);\n");
1281             }
1282             }
1283              
1284             # called automatically when runner advances home
1285              
1286             sub run {
1287 0     0 0 0 my($self) = @_;
1288              
1289 0         0 $self->{curr}{stats}{pitcher}{r}++;
1290 0         0 $self->{curr}{stats}{batter}{r}++;
1291 0         0 $self->{curr}{stats}{inning}{r}++;
1292 0         0 $self->{curr}{stats}{inning}{lb}--;
1293              
1294 0         0 $self->output(" draw_dot(rundot, clr);\n");
1295             }
1296              
1297             sub er {
1298 0     0 0 0 my($self) = @_;
1299 0         0 $self->{curr}{stats}{pitcher}{er}++;
1300 0         0 $self->{curr}{stats}{inning}{er}++;
1301             }
1302              
1303              
1304              
1305             =item error(POSITION)
1306              
1307             Notes that an error was committed by the player at POSITION.
1308             (Keeping track of error by POSITION not yet implemented, but feel free to
1309             include it anyway, for when it is implemented.)
1310              
1311             =cut
1312              
1313             sub error {
1314 0     0 1 0 my($self, $pos) = @_;
1315             # XXX not implemented
1316             # $self->{other}{stats}{$POSITION}{pb}++;
1317 0         0 $self->{curr}{stats}{inning}{e}++;
1318             }
1319              
1320              
1321             =item balk
1322              
1323             Notes that there was a balk.
1324              
1325             =cut
1326              
1327             sub balk {
1328 0     0 1 0 my($self) = @_;
1329 0         0 $self->{curr}{stats}{pitcher}{bk}++;
1330             }
1331              
1332              
1333             =item wp
1334              
1335             Notes that there was a wild pitch.
1336              
1337             =cut
1338              
1339             sub wp {
1340 0     0 1 0 my($self) = @_;
1341 0         0 $self->{curr}{stats}{pitcher}{wp}++;
1342 0         0 $self->{curr}{stats}{game}{wp}++;
1343             }
1344              
1345              
1346             =item pb
1347              
1348             Notes that there was a passed ball.
1349              
1350             =cut
1351              
1352             sub pb {
1353 0     0 1 0 my($self) = @_;
1354             # XXX not implemented
1355             # $self->{other}{stats}{2}{pb}++;
1356 0         0 $self->{curr}{stats}{game}{pb}++;
1357             }
1358              
1359              
1360             =item dp
1361              
1362             Notes that a double play was executed. Do not use if the batter was out by
1363             double play, but only if there was a double play in which the batter was safe,
1364             as calling C already records the double play for you.
1365              
1366             =cut
1367              
1368             sub dp {
1369 0     0 1 0 my($self) = @_;
1370 0         0 $self->{curr}{stats}{game}{dp}++;
1371             }
1372              
1373              
1374             =back
1375              
1376             =head3 At-Bat Label Methods
1377              
1378             These methods are simply for adding additional labels in the at-bat graphic,
1379             for whatever you wish.
1380              
1381             =over 4
1382              
1383             =item waybase(LABEL [, BASE, BIG])
1384              
1385             Add label LABEL on the way to BASE. If BASE is excluded, notes it on way
1386             to the next base after the one the runner is currently at.
1387              
1388             =cut
1389              
1390             sub waybase {
1391 0     0 1 0 my($self, $label, $base, $big) = @_;
1392              
1393 0 0       0 my $size = $big ? 'bigsf' : 'sf';
1394 0   0     0 $base ||= $self->base + 1;
1395              
1396 0 0       0 my $dir = $base == 4 ? 'lft' :
    0          
    0          
1397             $base == 3 ? 'ulft' :
1398             $base == 2 ? 'urt' :
1399             'lrt';
1400              
1401 0         0 $self->output(_label(_btex($label, $size), 'way' . _base($base), '', $dir));
1402             }
1403              
1404             =item atbase(LABEL [, BASE, BIG])
1405              
1406             Add label LABEL at BASE. If BASE is excluded, notes it
1407             at the base the runner is currently at.
1408              
1409             =cut
1410              
1411             sub atbase {
1412 0     0 1 0 my($self, $label, $base, $big) = @_;
1413              
1414 0 0       0 my $size = $big ? 'bigsf' : 'sf';
1415 0   0     0 $base ||= $self->base;
1416              
1417 0 0       0 my $dir = $base == 4 ? 'bot' :
    0          
    0          
1418             $base == 3 ? 'lft' :
1419             $base == 2 ? 'top' :
1420             'rt';
1421              
1422 0         0 $self->output(_label(_btex($label, $size), _base($base), '', $dir));
1423             }
1424              
1425              
1426             =back
1427              
1428             =head2 Stat Totals Methods
1429              
1430             =over 4
1431              
1432             =item win(NUMBER)
1433              
1434             =item loss(NUMBER)
1435              
1436             =item save(NUMBER)
1437              
1438             =item blown_save(NUMBER)
1439              
1440             NUMBER is the jersey number of the pitcher who got the (win, loss, save, blown save).
1441             Call these methods while the pitcher's team is still on the field (while
1442             the opposing team is still at bat), any time before the totals are calculated.
1443              
1444             =cut
1445              
1446             sub win {
1447 0     0 1 0 my($self, $number) = @_;
1448 0         0 $self->{other}{stats}{pitchers}{$number}{record}{w} = 1;
1449             }
1450              
1451             sub loss {
1452 0     0 1 0 my($self, $number) = @_;
1453 0         0 $self->{other}{stats}{pitchers}{$number}{record}{l} = 1;
1454             }
1455              
1456             sub hold {
1457 0     0 0 0 my($self, $number) = @_;
1458 0         0 $self->{other}{stats}{pitchers}{$number}{record}{h} = 1;
1459             }
1460              
1461             sub save {
1462 0     0 1 0 my($self, $number) = @_;
1463 0         0 $self->{other}{stats}{pitchers}{$number}{record}{'s'} = 1;
1464             }
1465              
1466             sub blown_save {
1467 0     0 1 0 my($self, $number) = @_;
1468 0         0 $self->{other}{stats}{pitchers}{$number}{record}{bs} = 1;
1469             }
1470              
1471              
1472              
1473             =item totals
1474              
1475             This generates the stat totals for the game, batters, and pitchers. Call it after the
1476             finall C method call, if you wish to generate the stat totals.
1477              
1478             =cut
1479              
1480             sub totals {
1481 0     0 1 0 my($self) = @_;
1482              
1483 0 0       0 return if $self->{_totals};
1484              
1485 0         0 for (qw(away home)) {
1486 0         0 $self->home_away($_);
1487 0         0 $self->_totals;
1488             }
1489              
1490 0         0 $self->{_totals} = 1;
1491             }
1492              
1493             sub _totals {
1494 0     0   0 my($self) = @_;
1495              
1496 0         0 my $game = $self->{curr}{stats}{game};
1497 0         0 my $innings = $self->{curr}{stats}{innings};
1498 0         0 my(%tstats, %pstats);
1499 0         0 for my $n (qw(r h e lb bb k strikes pitches)) {
1500 0   0     0 $tstats{$n} += $innings->{$_}{$n} ||= 0 for keys %$innings;
1501             }
1502              
1503 0         0 $self->output("\n\n\n %totals\n nudge := 10u;\n");
1504 0         0 $self->output(_label(_btex($tstats{r}), '1/2[(1200,-150+nudge),(1200+100u/3,-100+400)]'));
1505 0         0 $self->output(_label(_btex($tstats{h}), '1/2[(1200+100u/3,-150),(1200+100u/3*2,-100+400-nudge)]'));
1506 0         0 $self->output(_label(_btex($tstats{e}), '1/2[(1200,-200+nudge),(1200+100u/3,-150+400)]'));
1507 0         0 $self->output(_label(_btex($tstats{lb}), '1/2[(1200+100u/3,-200),(1200+100u/3*2,-150+400-nudge)]'));
1508 0         0 $self->output(_label(_btex($tstats{bb}), '1/2[(1200,-250+nudge),(1200+100u/3,-200+400)]'));
1509 0         0 $self->output(_label(_btex($tstats{k}), '1/2[(1200+100u/3,-250),(1200+100u/3*2,-200+400-nudge)]'));
1510 0         0 $self->output(_label(_btex($tstats{strikes}), '1/2[(1200,-300+nudge),(1200+100u/3,-250+400)]'));
1511 0         0 $self->output(_label(_btex($tstats{pitches}), '1/2[(1200+100u/3,-300),(1200+100u/3*2,-250+400-nudge)]'));
1512              
1513 0         0 my $lineup = $self->{curr}{lineup};
1514 0         0 for my $i (0 .. $#$lineup) {
1515 0 0       0 next unless $lineup->[$i];
1516              
1517 0         0 for my $j (0 .. $#{$lineup->[$i]}) {
  0         0  
1518 0         0 my $bstats = $self->{curr}{stats}{batters}{$lineup->[$i][$j][0]};
1519 0         0 for (qw(ab r h rbi bb k)) {
1520 0   0     0 $pstats{$_} += $bstats->{$_} ||= 0;
1521             }
1522 0 0       0 next if $j > 2;
1523              
1524 0         0 my $rep = '';
1525 0 0       0 $rep = sprintf('*%d', 1+$j) if $j;
1526              
1527 0         0 my $ystart = 1000 - $i * 100;
1528 0         0 my $x = '1200+10';
1529 0         0 my $y = "$ystart+100u-100u/3$rep";
1530 0         0 my $dir = 'urt';
1531              
1532 0         0 $self->output(_label(_btex($bstats->{ab}), $x, $y, $dir));
1533 0         0 $self->output(_label(_btex($bstats->{r}), "$x+(100u/3)", $y, $dir));
1534 0         0 $self->output(_label(_btex($bstats->{h}), "$x+((100u/3)*2)", $y, $dir));
1535              
1536 0         0 $self->output(_label(_btex($bstats->{rbi}), "$x+((100u/3)*3)", $y, $dir));
1537 0         0 $self->output(_label(_btex($bstats->{bb}), "$x+((100u/3)*4)", $y, $dir));
1538 0         0 $self->output(_label(_btex($bstats->{k}), "$x+((100u/3)*5)", $y, $dir));
1539             }
1540             }
1541              
1542 0         0 my $plineup = $self->{other}{plineup};
1543 0         0 for my $j (0 .. $#$plineup) {
1544 0         0 my $kstats = $self->{other}{stats}{pitchers}{$plineup->[$j][0]};
1545              
1546 0         0 my $rep = '';
1547 0 0       0 $rep = sprintf('*%d', ($j<5 ? $j+1 : $j-4)) if $j;
    0          
1548              
1549 0         0 my $ystart = -200;
1550 0 0       0 my $x = $j < 5 ? '100+5' : '900+5+100u*(2/3)';
1551 0         0 my $y = "$ystart+5+100u-100u/3$rep-100u/3";
1552 0         0 my $dir = 'urt';
1553              
1554 0         0 my $wls = uc join ',', grep $kstats->{record}{$_}, qw(w l h s bs);
1555 0   0     0 my $remainder = ( ($kstats->{outs} ||= 0) % 3) || 0;
1556 0         0 $kstats->{ip} = ( ($kstats->{outs} - $remainder) / 3 ) . ".$remainder";
1557              
1558 0 0       0 $self->output(_label(_btex($wls), $x, $y, $dir)) if $wls;
1559 0   0     0 $self->output(_label(_btex($kstats->{bf}||0), "$x+(100u/3)", $y, $dir));
1560 0   0     0 $self->output(_label(_btex($kstats->{ip}||0), "$x+((100u/3)*2)", $y, $dir));
1561              
1562 0   0     0 $self->output(_label(_btex($kstats->{h}||0), "$x+((100u/3)*3)", $y, $dir));
1563 0   0     0 $self->output(_label(_btex($kstats->{r}||0), "$x+((100u/3)*4)", $y, $dir));
1564 0   0     0 $self->output(_label(_btex($kstats->{er}||0), "$x+((100u/3)*5)", $y, $dir));
1565              
1566 0   0     0 $self->output(_label(_btex($kstats->{bb}||0), "$x+((100u/3)*6)", $y, $dir));
1567 0   0     0 $self->output(_label(_btex($kstats->{k}||0), "$x+((100u/3)*7)", $y, $dir));
1568 0   0     0 $self->output(_label(_btex($kstats->{ibb}||0), "$x+((100u/3)*8)", $y, $dir));
1569              
1570 0   0     0 $self->output(_label(_btex($kstats->{hp}||0), "$x+((100u/3)*9)", $y, $dir));
1571 0   0     0 $self->output(_label(_btex($kstats->{bk}||0), "$x+((100u/3)*10)", $y, $dir));
1572 0   0     0 $self->output(_label(_btex($kstats->{wp}||0), "$x+((100u/3)*11)", $y, $dir));
1573              
1574 0   0     0 $self->output(_label(_btex($kstats->{4}||0), "$x+((100u/3)*12)", $y, $dir));
1575 0   0     0 $self->output(_label(_btex($kstats->{strikes}||0), "$x+((100u/3)*13)", $y, $dir));
1576 0   0     0 $self->output(_label(_btex($kstats->{pitches}||0), "$x+((100u/3)*14)", $y, $dir));
1577             }
1578              
1579 0         0 $self->output(" nudge := 5u;\n");
1580              
1581 0         0 my $xstart = '1200+100u/3*2+40u';
1582 0         0 my $ystart = '+25u+nudge';
1583 0         0 my $dir = 'urt';
1584              
1585 0   0     0 $self->output(_label(_btex($game->{1}||0, 'sf'), $xstart, "-150+200$ystart", $dir));
1586 0   0     0 $self->output(_label(_btex($game->{2}||0, 'sf'), $xstart, "-175+200$ystart", $dir));
1587 0   0     0 $self->output(_label(_btex($game->{3}||0, 'sf'), $xstart, "-200+200$ystart", $dir));
1588 0   0     0 $self->output(_label(_btex($game->{4}||0, 'sf'), $xstart, "-225+200$ystart", $dir));
1589 0   0     0 $self->output(_label(_btex($game->{sf}||0, 'sf'), $xstart, "-250+200$ystart", $dir));
1590 0   0     0 $self->output(_label(_btex($game->{sac}||0, 'sf'), $xstart, "-275+200$ystart", $dir));
1591              
1592 0         0 $xstart = '1200+100u/3*2+150u';
1593 0   0     0 $self->output(_label(_btex($game->{dp}||0, 'sf'), $xstart, "-150+200$ystart", $dir));
1594 0   0     0 $self->output(_label(_btex($game->{hp}||0, 'sf'), $xstart, "-175+200$ystart", $dir));
1595 0   0     0 $self->output(_label(_btex($game->{wp}||0, 'sf'), $xstart, "-200+200$ystart", $dir));
1596 0   0     0 $self->output(_label(_btex($game->{pb}||0, 'sf'), $xstart, "-225+200$ystart", $dir));
1597 0   0     0 $self->output(_label(_btex($game->{sb}||0, 'sf'), $xstart, "-250+200$ystart", $dir));
1598 0   0     0 $self->output(_label(_btex($game->{cs}||0, 'sf'), $xstart, "-275+200$ystart", $dir));
1599              
1600              
1601 0 0       0 my @nums = map { $_ || 0 } ($pstats{ab}, $pstats{bb}, $game->{hp}, $game->{sac}, $game->{sf});
  0         0  
1602 0         0 my $numt = 0;
1603 0         0 $numt += $_ for @nums;
1604 0         0 my $nums = sprintf('%s~~=~~%s', join('+', @nums), $numt);
1605 0         0 $self->output(_label(_btex($nums, 'sf', 1), '1200+100u/3*2+110u', '-300+200+25u+nudge', $dir));
1606              
1607 0 0       0 @nums = map { $_ || 0 } ($tstats{r}, $tstats{lb}, $game->{outs});
  0         0  
1608 0         0 $numt = 0;
1609 0         0 $numt += $_ for @nums;
1610 0         0 $nums = sprintf('%s~~=~~%s', join('+', @nums), $numt);
1611 0         0 $self->output(_label(_btex($nums, 'sf', 1), '1200+100u/3*2+110u', '-300+200+nudge', $dir));
1612             }
1613              
1614              
1615              
1616             =back
1617              
1618             =cut
1619              
1620              
1621             #### misc output methods
1622              
1623             sub output {
1624 26     26 0 47 my($self, @lines) = @_;
1625 26         45 my $fh = $self->{curr}{fh};
1626 26         53 print $fh @lines;
1627             }
1628              
1629             sub begin {
1630 2     2 0 3 my($self) = @_;
1631 2         7 $self->output("beginfig(0);\n");
1632 2         4 $self->output(" draw_full_scorecard;\n\n");
1633 2         5 $self->output(" clr:=scoring;\n\n");
1634             }
1635              
1636              
1637             sub end {
1638 2     2 0 3 my($self) = @_;
1639 2         5 $self->output("endfig;\n");
1640             }
1641              
1642             sub top {
1643 1     1 0 3 my($self) = @_;
1644 1         3 $self->output(_label(_btex('TOP'), 1431, 1020));
1645             }
1646              
1647             sub bottom {
1648 1     1 0 2 my($self) = @_;
1649 1         6 $self->output(_label(_btex('BOTTOM'), 1433, 1020));
1650             }
1651              
1652             # label(btex {\bigsf Team} etex rotated 90, (1416,130)) withcolor clr;
1653             # label(btex {\bigsf FP} etex rotated 90, (1416,614)) withcolor clr;
1654             # label(btex {\bigsf Temp} etex rotated 90, (1416,900)) withcolor clr;
1655             # label(btex {\bigsf At} etex rotated 90, (1448,142)) withcolor clr;
1656             # label(btex {\bigsf Att} etex rotated 90, (1448,450)) withcolor clr;
1657             # label(btex {\bigsf Scorer} etex rotated 90, (1448,600)) withcolor clr;
1658              
1659             # label(btex {\bigsf Team:} etex rotated 90, (1420,-50)) withcolor clr;
1660             # label(btex {\bigsf Date:} etex rotated 90, (1420,600)) withcolor clr;
1661             # label(btex {\bigsf At:} etex rotated 90, (1450,-50)) withcolor clr;
1662             # label(btex {\bigsf Scorer:} etex rotated 90, (1450,600)) withcolor clr;
1663              
1664             sub team {
1665 2     2 0 4 my($self, $info) = @_;
1666 2 50       9 $self->output(_label(_btex($info), 1416+13, 280, 'lft', 'rotated 90'))
1667             if $info;
1668             }
1669              
1670             sub date {
1671 2     2 0 3 my($self, $info) = @_;
1672 2 50       9 $self->output(_label(_btex($info), 1416+13, 714, 'lft', 'rotated 90'))
1673             if $info;
1674             }
1675              
1676             sub temp {
1677 2     2 0 3 my($self, $info) = @_;
1678 2 50       7 $self->output(_label(_btex($info), 1416+13, 940, 'lft', 'rotated 90'))
1679             if $info;
1680             }
1681              
1682             sub at {
1683 2     2 0 3 my($self, $info) = @_;
1684 2 50       8 $self->output(_label(_btex($info), 1448+13, 292, 'lft', 'rotated 90'))
1685             if $info;
1686             }
1687              
1688             sub att {
1689 2     2 0 3 my($self, $info) = @_;
1690 2 50       7 $self->output(_label(_btex($info), 1448+13, 500, 'lft', 'rotated 90'))
1691             if $info;
1692             }
1693              
1694             sub scorer {
1695 2     2 0 3 my($self, $info) = @_;
1696 2 50       6 $self->output(_label(_btex($info), 1448+13, 700, 'lft', 'rotated 90'))
1697             if $info;
1698             }
1699              
1700             sub wind {
1701 2     2 0 3 my($self, $info) = @_;
1702 2 50       11 $self->output(_label(_btex($info), 1448+13, 940, 'lft', 'rotated 90'))
1703             if $info;
1704             }
1705              
1706              
1707             #### helper functions
1708              
1709             sub _num {
1710 0     0   0 my($num) = @_;
1711 0 0       0 return $num == 4 ? 'four' :
    0          
    0          
1712             $num == 3 ? 'three' :
1713             $num == 2 ? 'two' :
1714             'one';
1715             }
1716              
1717             sub _base {
1718 0     0   0 my($num) = @_;
1719 0 0       0 return $num == 4 ? 'home' :
    0          
    0          
1720             $num == 3 ? 'third' :
1721             $num == 2 ? 'second' :
1722             'first';
1723             }
1724              
1725             sub _label {
1726 16     16   25 my($label, $x, $y, $direction, $extra) = @_;
1727              
1728 16   100     37 $direction ||= '';
1729 16   66     52 $direction &&= ".$direction";
1730              
1731 16   100     32 $extra ||= '';
1732 16   66     50 $extra &&= " $extra";
1733              
1734 16 50 33     87 my $xy = defined $y && length $y ? "($x,$y)" : $x;
1735              
1736 16         63 return " label$direction($label$extra, $xy) withcolor clr;\n";
1737             }
1738              
1739             sub _btex {
1740 16     16   25 my($string, $font, $lit) = @_;
1741 16   50     52 $font ||= 'bigsf';
1742 16 50 33     56 if (!defined $string || !length $string) {
1743             # print join "|", caller(0), "\n";
1744 0         0 return;
1745             }
1746              
1747 16 50       35 unless ($lit) {
1748 16         24 $string =~ s/\\/--BACKSLASH--/g;
1749 16         16 $string =~ s/{/--LBRACE--/g;
1750 16         18 $string =~ s/}/--RBRACE--/g;
1751              
1752 16         23 $string =~ s/( [\#\$\%\&\_\{\}] )/\\$1/gx;
1753 16         20 $string =~ s/( [\^~] )/\\$1\{\}/gx;
1754              
1755 16         16 $string =~ s/--BACKSLASH--/\$\\backslash\$/g;
1756 16         17 $string =~ s/--LBRACE--/\$\\lbrace\$/g;
1757 16         20 $string =~ s/--RBRACE--/\$\\rbrace\$/g;
1758             }
1759              
1760 16         66 return "btex {\\$font $string} etex";
1761             }
1762              
1763              
1764             $SCORECARD = <<'EOT';
1765             %prologues:=2;
1766             %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1767             %
1768             % Copyright (C) 2005, Christopher Swingley
1769             %
1770             % Licensed under the terms of the GNU General Public License, Version 2
1771             % available from http://www.gnu.org/copyleft/gpl.html
1772             %
1773             %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1774             %
1775             % The following Metapost program draws baseball scorecards as well as
1776             % allows you to record plays on the same card. It contains two figures.
1777             % Figure 0 is a complete, unfilled scorecard that can be converted to PDF
1778             % and printed.
1779             %
1780             % Figure 2 is an example, showing the Cardinals scoring from the game
1781             % where Mark McGwire broke Roger Maris' home run record.
1782             %
1783             % Figure 1 is the Cubs scoring from the same game
1784             %
1785             % A few variables can be set at the beginning of the card to adjust
1786             % colors and line thicknesses and other parameters. Also note that
1787             % I am using Adobe's Myriad Condensed fonts for the scorecard, so
1788             % you will need to modify the font names to suit your own preferences
1789             % and fonts.
1790             %
1791             %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1792             %
1793             % Manual for metapost:
1794             % $ texdoc mpman
1795             %
1796             %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1797             %
1798             % Locations for stuff:
1799             %
1800             % ballone, balltwo, ballthree, strikeone, striketwo, foulone, foultwo,
1801             % foulthree, foulfour
1802             %
1803             % These are the locations for writing in the pitch counts to each
1804             % batter:
1805             % label(btex {\sf 1} etex, ballone) withcolor clr;
1806             % label(btex {\sf 2} etex, strikeone) withcolor clr;
1807             %
1808             % rbione, rbitwo, rbithree, rbifour, rundot, outlabel
1809             %
1810             % These are the locations for RBI dots, run dots (in the middle
1811             % of the diamond), and the out labels (which also go in the middle
1812             % of the diamond):
1813             % draw_dot(rbione, clr);
1814             % draw_dot(rbitwo, clr);
1815             % draw_dot(rundot, clr);
1816             % label(btex {\bigsf 6-3} etex, outlabel) withcolor clr;
1817             %
1818             % first, second, third, home
1819             %
1820             % Locations of the bases. Mostly used for building the paths,
1821             % but also useful for pinch runners:
1822             % label.top(btex {\sf PR} etex, second) withcolor clr;
1823             %
1824             % hr, threeb, twob, oneb, bb, hp
1825             %
1826             % Locations for the hit / walk / HBP text on the right side of
1827             % the box. Circled to indicate the result of the at bat:
1828             % draw_circle(twob, clr);
1829             %
1830             % wayfirst, waysecond, waythird, wayhome
1831             %
1832             % The half-way points between bases. Used as part of the CS and
1833             % TO paths, but also useful for labelling CS and TO plays:
1834             % label.lft(btex {\sf TO 7-2} etex, wayhome) withcolor clr;
1835             %
1836             % Paths available:
1837             % single, double, triple, homerun
1838             %
1839             % Paths showing a runner's progress on the bases:
1840             % draw(double) withcolor clr;
1841             %
1842             % firstsecond, firstthird, firsthome, secondthird, secondhome,
1843             % thirdhome
1844             %
1845             % Paths for runners along the bases:
1846             % draw(secondhome) withcolor clr;
1847             %
1848             % ifleft, ifright, ifcenter, ofleft, ofleftc, ofcenterl, ofcenterr,
1849             % ofrightc, ofright
1850             %
1851             % Paths for various type of hits (infield, outfield):
1852             % draw(ofleftc) withcolor clr;
1853             %
1854             % hrleft, hrleftc, hrcenterl, hrcenterr, hrrightc, hrright;
1855             %
1856             % Paths for home runs:
1857             % draw(hrleftc) withcolor clr;
1858             %
1859             % cs_second, cs_third, to_home,
1860             % cs_firstthird, to_firsthome, to_secondhome,
1861             %
1862             % Paths for caught stealing and thrown out:
1863             % draw(cs_second) withcolor clr;
1864             %
1865             % new_hitter, new_pitcher
1866             %
1867             % Paths for new hitters (left side of box) and pitchers
1868             % (top of box)
1869             % draw(new_hitter) withcolor clr;
1870             % draw(new_pitcher) withcolor clr;
1871             %
1872             % Fonts:
1873             %
1874             % \tiny - used for the Copyright line
1875             % \tnsf - used for the basepath plays
1876             % \sf - used for balls and strikes, outs, various labelling
1877             % \bigsf - used for out labels
1878             %
1879             % Normal functions:
1880             %
1881             % draw(path) withcolor clr; - stroke a path
1882             % label(btex {\sf 1} etex, pair) withcolor clr; - label
1883             % directional suffixes: lft,rt,top,bot,ulft,urt,llft,lrt
1884             % label(btex {\sf (6 empty boxes)} etex, \
1885             % 1/2[(xstart, ystart-25u),(xstart+100u,ystart-25u)]) \
1886             % withcolor clr; - use this when the lineup turns over
1887             %
1888             % User functions:
1889             %
1890             %
1891             % def set_vars(expr xstart, ystart) =
1892             %
1893             % Used to initialize all the locations and paths for a new
1894             % starting locations. Needs to be called right after setting
1895             % xstart and ystart. These should be multiples of 100u
1896             %
1897             % def draw_square(expr xstart, ystart) =
1898             %
1899             % Draws an at-bat box in cyan
1900             %
1901             % def draw_out_[one|two|three](expr xstart, ystart, clr) =
1902             %
1903             % Indicates the first (second or third) out with the out number
1904             % in a circle.
1905             %
1906             % def draw_dot(expr loc, clr) =
1907             %
1908             % Draws a 5pt dot at the location indicated. Used for RBI's,
1909             % and runs scored
1910             %
1911             % def draw_circle(expr centerpoint, clr) =
1912             %
1913             % Draws a circle around a location. Used to circle the plays
1914             % on the right of the at-bat box.
1915             %
1916             % def draw_inning_end(expr xstart, ystart, clr) =
1917             %
1918             % Draws the slash in the lower right that signals the end of
1919             % the inning.
1920             %
1921             % def draw_inning_start(expr xstart, ystart, clr) =
1922             %
1923             % Draws the slash in the upper left that signals the start of
1924             % the inning.
1925             %
1926             % def draw_strikeout_looking(expr outlabel, clr) =
1927             %
1928             % Draws a backwards K
1929             %
1930             % def draw_ibb(expr bb, clr)=
1931             %
1932             % Adds 'I' in front of BB and circles it for an intentional walk
1933             %
1934             % Consult the Makefile for the commands used to turn the code in this
1935             % file into PDF, EPS or PNG files.
1936             %
1937             %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1938             %
1939             % Wed Apr 20 07:58:23 AKDT 2005
1940             % * Reversed figures 1 and 2 so the scoring of the game is in
1941             % order
1942             % * Added more comments to the beginning of the file
1943             % * Christopher Swingley, cswingle@iarc.uaf.edu
1944             %
1945             % Sat Apr 16 13:33:14 AKDT 2005
1946             % * scoring.mp Version 0.2
1947             % * Pulled out a bunch of variables
1948             % * Finished the full scorecard code
1949             % * Christopher Swingley, cswingle@iarc.uaf.edu
1950             %
1951             % Thu Apr 14 14:37:29 AKDT 2005
1952             % * scoring.mp Version 0.1
1953             % * Initial release
1954             % * Christopher Swingley, cswingle@iarc.uaf.edu
1955             %
1956             %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1957              
1958             % FONTS
1959             verbatimtex \font\tiny __FONTFACE0__ at __FONTSIZE0__pt etex
1960             verbatimtex \font\sf __FONTFACE1__ at __FONTSIZE1__pt etex
1961             verbatimtex \font\tnsf __FONTFACE2__ at __FONTSIZE2__pt etex
1962             verbatimtex \font\bigsf __FONTFACE3__ at __FONTSIZE3__pt etex
1963              
1964             % VARIABLES
1965             color card;
1966             color scoring;
1967             % Cyan card - modify first number to control lightness
1968             % (0 - 1, dark - light):
1969             % card:=(0.10,1,1); % Darker
1970             % card:=(0.25,1,1); % Lighter
1971             % Grey card:
1972             % card:=(0.4,0.4,0.4);
1973             % Black card:
1974             % card:=(0.0,0.0,0.0);
1975             card:=(__COLOR1__,__COLOR2__,__COLOR3__);
1976             % Black scoring color
1977             scoring:=(0,0,0);
1978             % Diameter of circles (outs)
1979             outcircle_d := 7;
1980             % Size of dots (rbi, runs scored)
1981             dotsize := 7pt;
1982             % Diameter of play circles
1983             playcircle_d := 9;
1984             % Thickness of play lines
1985             playline_t := 1.5pt;
1986             % Thickness of thick card lines
1987             thickline_t := 0.5pt;
1988             % Thickness of thin card lines
1989             thinline_t := 0.05pt;
1990              
1991             def draw_square(expr xstart, ystart) =
1992             begingroup
1993             pickup pencircle scaled thickline_t;
1994             % Outer box
1995             draw (xstart,ystart)--(xstart,ystart+100u)--(xstart+100u,ystart+100u)--(xstart+100u,ystart)--cycle withcolor card;
1996             pickup pencircle scaled thinline_t;
1997             % Pitches
1998             pbsize := 15u;
1999             pbstart := 50u;
2000             draw (xstart+pbstart,ystart)--(xstart+pbstart,ystart+pbsize)--(xstart+pbstart+(1*pbsize),ystart+pbsize)--(xstart+pbstart+pbsize,ystart)--cycle withcolor card;
2001             pbstart := pbstart + pbsize;
2002             draw (xstart+pbstart,ystart)--(xstart+pbstart,ystart+pbsize)--(xstart+pbstart+(1*pbsize),ystart+pbsize)--(xstart+pbstart+pbsize,ystart)--cycle withcolor card;
2003             pbstart := pbstart + pbsize;
2004             draw (xstart+pbstart,ystart)--(xstart+pbstart,ystart+pbsize)--(xstart+pbstart+(1*pbsize),ystart+pbsize)--(xstart+pbstart+pbsize,ystart)--cycle withcolor card;
2005             pbstart := 50u;
2006             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;
2007             pbstart := pbstart + pbsize;
2008             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;
2009             % Diamond
2010             dsize := 24u;
2011             dxstart := xstart+40u;
2012             dystart := ystart+pbsize*1.7;
2013             ofactor := 1.5;
2014             draw (dxstart,dystart)--(dxstart+dsize,dystart+dsize)--(dxstart,dystart+dsize*2)--(dxstart-dsize,dystart+dsize)--cycle withcolor card;
2015             % Outfield
2016             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;
2017             % Labels
2018             lxstart := xstart+90u;
2019             lystart := ystart+92u;
2020             lsize := (lystart-ystart+(fsize/2)-pbsize)/6;
2021             label(btex {\tnsf HR} etex, (lxstart,lystart)) withcolor card;
2022             lystart := lystart - lsize;
2023             label(btex {\tnsf 3B} etex, (lxstart,lystart)) withcolor card;
2024             lystart := lystart - lsize;
2025             label(btex {\tnsf 2B} etex, (lxstart,lystart)) withcolor card;
2026             lystart := lystart - lsize;
2027             label(btex {\tnsf 1B} etex, (lxstart,lystart)) withcolor card;
2028             lystart := lystart - lsize;
2029             label(btex {\tnsf BB} etex, (lxstart,lystart)) withcolor card;
2030             lystart := lystart - lsize;
2031             label(btex {\tnsf HP} etex, (lxstart,lystart)) withcolor card;
2032             pickup pencircle scaled playline_t;
2033             endgroup
2034             enddef;
2035              
2036             def draw_out_one(expr xstart, ystart, clr) =
2037             begingroup
2038             pickup pencircle scaled playline_t;
2039             label(btex {\sf 1} etex, (xstart+25u, ystart+10u)) withcolor clr;
2040             draw (xstart+25u,ystart+10u-outcircle_d)..(xstart+25u+outcircle_d,ystart+10u)..
2041             (xstart+25u,ystart+10u+outcircle_d)..(xstart+25u-outcircle_d,ystart+10u)..cycle withcolor clr;
2042             endgroup
2043             enddef;
2044              
2045             def draw_out_two(expr xstart, ystart, clr) =
2046             begingroup
2047             pickup pencircle scaled playline_t;
2048             label(btex {\sf 2} etex, (xstart+25u, ystart+10u)) withcolor clr;
2049             draw (xstart+25u,ystart+10u-outcircle_d)..(xstart+25u+outcircle_d,ystart+10u)..
2050             (xstart+25u,ystart+10u+outcircle_d)..(xstart+25u-outcircle_d,ystart+10u)..cycle withcolor clr;
2051             endgroup
2052             enddef;
2053              
2054             def draw_out_three(expr xstart, ystart, clr) =
2055             begingroup
2056             pickup pencircle scaled playline_t;
2057             label(btex {\sf 3} etex, (xstart+25u, ystart+10u)) withcolor clr;
2058             draw (xstart+25u,ystart+10u-outcircle_d)..(xstart+25u+outcircle_d,ystart+10u)..
2059             (xstart+25u,ystart+10u+outcircle_d)..(xstart+25u-outcircle_d,ystart+10u)..cycle withcolor clr;
2060             endgroup
2061             enddef;
2062              
2063             def draw_dot(expr loc, clr) =
2064             begingroup
2065             pickup pencircle scaled dotsize;
2066             draw(loc) withcolor clr;
2067             pickup pencircle scaled playline_t;
2068             endgroup
2069             enddef;
2070              
2071             def draw_circle(expr centerpoint, clr) =
2072             begingroup
2073             pickup pencircle scaled playline_t;
2074             draw (centerpoint+(0,-playcircle_d))..(centerpoint+(playcircle_d,0))..(centerpoint+(0,playcircle_d))..
2075             (centerpoint+(-playcircle_d,0))..cycle withcolor clr;
2076             endgroup
2077             enddef;
2078              
2079             def draw_inning_end(expr xstart, ystart, clr) =
2080             begingroup
2081             pickup pencircle scaled playline_t;
2082             draw (xstart+95u,ystart-5u)--(xstart+105u,ystart+5u) withcolor clr;
2083             endgroup
2084             enddef;
2085              
2086             def draw_inning_start(expr xstart, ystart, clr) =
2087             begingroup
2088             pickup pencircle scaled playline_t;
2089             draw (xstart-5u,ystart+95u)--(xstart+5u,ystart+105u) withcolor (0,0,0);
2090             endgroup
2091             enddef;
2092              
2093             def draw_strikeout_looking(expr outlabel, clr) =
2094             begingroup
2095             label(btex {\bigsf K} etex, outlabel) reflectedabout (outlabel+(0,1u), outlabel+(0,-1u)) withcolor clr;
2096             endgroup
2097             enddef;
2098              
2099             def draw_ibb(expr bb, clr)=
2100             begingroup
2101             label(btex {\sf I} etex, bb+(-9u,0)) withcolor clr;
2102             draw (bb+(-3u,-playcircle_d))..(bb+(playcircle_d+3u,0))..(bb+(-3u,playcircle_d))..(bb+(-playcircle_d-6u,0))..cycle withcolor clr;
2103             endgroup
2104             enddef;
2105              
2106             def draw_player_box(expr xstart, ystart, clr, inncol) =
2107             % Intended to draw to the *left* of xstart, ystart
2108             begingroup
2109             iposwidth := 40u;
2110             namewidth := 250u;
2111             pickup pencircle scaled thickline_t;
2112             % Inning and Position box
2113             if inncol:
2114             draw (xstart,ystart)--(xstart-iposwidth*2u,ystart)--(xstart-iposwidth*2u,ystart+100u)--(xstart,ystart+100u)--cycle withcolor clr;
2115             draw (xstart-iposwidth,ystart)--(xstart-iposwidth,ystart+100u) withcolor clr;
2116             else:
2117             draw (xstart-iposwidth,ystart)--(xstart-iposwidth*2u,ystart)--(xstart-iposwidth*2u,ystart+100u)--(xstart-iposwidth,ystart+100u)--cycle withcolor clr;
2118             fi
2119             % Player name box
2120             draw (xstart-iposwidth*2,ystart)--(xstart-iposwidth*2-namewidth,ystart)--(xstart-iposwidth*2-namewidth,ystart+100u)--
2121             (xstart-iposwidth*2,ystart+100u)--cycle withcolor clr;
2122             % Number box
2123             draw (xstart-iposwidth*2-namewidth,ystart)--(xstart-iposwidth*3-namewidth,ystart)--(xstart-iposwidth*3-namewidth,ystart+100u)--
2124             (xstart-iposwidth*2-namewidth,ystart+100u)--cycle withcolor clr;
2125             pickup pencircle scaled thinline_t;
2126             % other player lines
2127             if inncol:
2128             draw (xstart,ystart+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3) withcolor clr;
2129             draw (xstart,ystart+100u/3+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3+100u/3) withcolor clr;
2130             else:
2131             draw (xstart-iposwidth,ystart+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3) withcolor clr;
2132             draw (xstart-iposwidth,ystart+100u/3+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3+100u/3) withcolor clr;
2133             fi
2134             endgroup
2135             enddef;
2136              
2137             def draw_pitcher_box(expr xstart, ystart, clr) =
2138             % Intended to draw to the *left* of xstart, ystart
2139             begingroup
2140             iposwidth := 40u;
2141             namewidth := 250u;
2142             pickup pencircle scaled thickline_t;
2143             % Inning and Position box
2144             draw (xstart,ystart)--(xstart-iposwidth*2u,ystart)--(xstart-iposwidth*2u,ystart+100u)--(xstart,ystart+100u)--cycle withcolor clr;
2145             draw (xstart-iposwidth,ystart)--(xstart-iposwidth,ystart+100u) withcolor clr;
2146             % Player name box
2147             draw (xstart-iposwidth*2,ystart)--(xstart-iposwidth*2-namewidth,ystart)--(xstart-iposwidth*2-namewidth,ystart+100u)--(xstart-iposwidth*2,ystart+100u)--cycle withcolor clr;
2148             % Number box
2149             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;
2150             pickup pencircle scaled thinline_t;
2151             % other player lines
2152             draw (xstart-iposwidth,ystart+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3) withcolor clr;
2153             draw (xstart-iposwidth,ystart+100u/3+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3+100u/3) withcolor clr;
2154             endgroup
2155             enddef;
2156              
2157             def draw_column_totals_key(expr xstart, ystart, clr) =
2158             begingroup
2159             pickup pencircle scaled thickline_t;
2160             draw (xstart,ystart)--(xstart,ystart+100u)--(xstart-iposwidth,ystart+100u)--(xstart-iposwidth,ystart)--cycle withcolor clr;
2161             draw (xstart,ystart+100u/2)--(xstart-iposwidth,ystart+100u/2)--(xstart,ystart+100u) withcolor clr;
2162             draw (xstart,ystart+100u/2)--(xstart-iposwidth,ystart) withcolor clr;
2163             endgroup
2164             enddef;
2165              
2166             def draw_totals_box(expr xstart, ystart, clr) =
2167             begingroup
2168             pickup pencircle scaled thickline_t;
2169             draw (xstart,ystart)--(xstart,ystart+50u)--(xstart+100u,ystart+50u)--(xstart+100u,ystart)--cycle withcolor clr;
2170             pickup pencircle scaled thinline_t;
2171             draw 1/3[(xstart,ystart),(xstart+100u,ystart)]-- 2/3[(xstart,ystart+50u),(xstart+100u,ystart+50u)] withcolor clr;
2172             endgroup
2173             enddef;
2174              
2175             def draw_row_summary_box(expr xstart,ystart,clr) =
2176             begingroup
2177             pickup pencircle scaled thickline_t;
2178             draw (xstart,ystart)--(xstart,ystart+100u)--(xstart+100u,ystart+100u)--(xstart+100u,ystart)--cycle withcolor clr;
2179             pickup pencircle scaled thinline_t;
2180             draw (xstart,ystart+100u/3)--(xstart+100u,ystart+100u/3) withcolor clr;
2181             draw (xstart,ystart+100u/3*2)--(xstart+100u,ystart+100u/3*2) withcolor clr;
2182             draw (xstart+100u/3,ystart)--(xstart+100u/3,ystart+100u) withcolor clr;
2183             draw (xstart+100u/3*2,ystart)--(xstart+100u/3*2,ystart+100u) withcolor clr;
2184             endgroup
2185             enddef;
2186              
2187             def draw_game_summary_box(expr xstart,ystart,clr) =
2188             begingroup
2189             pickup pencircle scaled thickline_t;
2190             draw (xstart,ystart)--(xstart,ystart+50u)--(xstart+100u/3*2,ystart+50u)--(xstart+100u/3*2,ystart)--cycle withcolor clr;
2191             pickup pencircle scaled thinline_t;
2192             draw (xstart,ystart)--(xstart+100u/3*2,ystart+50u) withcolor clr;
2193             endgroup
2194             enddef;
2195              
2196             def draw_play_total_box(expr xstart,ystart,clr) =
2197             begingroup
2198             pickup pencircle scaled thickline_t;
2199             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;
2200             draw (xstart+100u/3*2,ystart+25u)--(xstart+100u/3*2+200u,ystart+25u) withcolor clr;
2201             endgroup
2202             enddef;
2203              
2204             def draw_pitcher_row(expr xstart,ystart,clr,leftish) =
2205             begingroup
2206             if leftish:
2207             iposwidth := 40u;
2208             namewidth := 250u;
2209             else:
2210             iposwidth := 100u/3;
2211             namewidth := 200u+100u*(2/3)+1u;
2212             fi
2213             pickup pencircle scaled thickline_t;
2214             % Inning and Position box
2215             draw (xstart,ystart)--(xstart-iposwidth*2u,ystart)--(xstart-iposwidth*2u,ystart+100u)--(xstart,ystart+100u)--cycle withcolor clr;
2216             draw (xstart-iposwidth,ystart)--(xstart-iposwidth,ystart+100u) withcolor clr;
2217             % Player name box
2218             draw (xstart-iposwidth*2,ystart)--(xstart-iposwidth*2-namewidth,ystart)--(xstart-iposwidth*2-namewidth,ystart+100u)--
2219             (xstart-iposwidth*2,ystart+100u)--cycle withcolor clr;
2220             % Number box
2221             draw (xstart-iposwidth*2-namewidth,ystart)--(xstart-iposwidth*3-namewidth,ystart)--(xstart-iposwidth*3-namewidth,ystart+100u)--
2222             (xstart-iposwidth*2-namewidth,ystart+100u)--cycle withcolor clr;
2223             pickup pencircle scaled thinline_t;
2224             % other player lines
2225             draw (xstart,ystart+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3) withcolor clr;
2226             draw (xstart,ystart+100u/3+100u/3)--(xstart-iposwidth*3-namewidth,ystart+100u/3+100u/3) withcolor clr;
2227             % Now draw stats boxes
2228             for nxstart := xstart step 100 until xstart+400:
2229             draw_row_summary_box(nxstart,ystart,clr);
2230             endfor
2231             endgroup
2232             enddef;
2233              
2234             def draw_pitcher_labels(expr xstart,ystart,clr,leftish) =
2235             begingroup
2236             if leftish:
2237             iposwidth := 40u;
2238             namewidth := 250u;
2239             else:
2240             iposwidth := 100u/3;
2241             namewidth := 200u+100u*(2/3);
2242             fi
2243             statboxwidth := 100u/3;
2244             label(btex {\bigsf \#} etex, 1/2[(xstart-iposwidth*2-namewidth,ystart),(xstart-iposwidth*3-namewidth,ystart-(100u/3))]) withcolor clr;
2245             label(btex {\bigsf Pitcher} etex, 1/2[(xstart-iposwidth*2,ystart),(xstart-iposwidth*2-namewidth,ystart-100u/3)]) withcolor clr;
2246             label(btex {\bigsf L/R} etex, 1/2[(xstart-iposwidth,ystart),(xstart-iposwidth*2,ystart-100u/3)]) withcolor clr;
2247             label(btex {\bigsf Inn} etex, 1/2[(xstart,ystart),(xstart-iposwidth,ystart-100u/3)]) withcolor clr;
2248             %
2249             label(btex {\bigsf WLS} etex, 1/2[(xstart+statboxwidth,ystart),(xstart,ystart-100u/3)]) withcolor clr;
2250             label(btex {\bigsf BF} etex, 1/2[(xstart+statboxwidth*2,ystart),(xstart+statboxwidth,ystart-100u/3)]) withcolor clr;
2251             label(btex {\bigsf IP} etex, 1/2[(xstart+statboxwidth*3,ystart),(xstart+statboxwidth*2,ystart-100u/3)]) withcolor clr;
2252             %
2253             label(btex {\bigsf H} etex, 1/2[(xstart+statboxwidth*4,ystart),(xstart+statboxwidth*3,ystart-100u/3)]) withcolor clr;
2254             label(btex {\bigsf R} etex, 1/2[(xstart+statboxwidth*5,ystart),(xstart+statboxwidth*4,ystart-100u/3)]) withcolor clr;
2255             label(btex {\bigsf ER} etex, 1/2[(xstart+statboxwidth*6,ystart),(xstart+statboxwidth*5,ystart-100u/3)]) withcolor clr;
2256             %
2257             label(btex {\bigsf BB} etex, 1/2[(xstart+statboxwidth*7,ystart),(xstart+statboxwidth*6,ystart-100u/3)]) withcolor clr;
2258             label(btex {\bigsf SO} etex, 1/2[(xstart+statboxwidth*8,ystart),(xstart+statboxwidth*7,ystart-100u/3)]) withcolor clr;
2259             label(btex {\bigsf IBB} etex, 1/2[(xstart+statboxwidth*9,ystart),(xstart+statboxwidth*8,ystart-100u/3)]) withcolor clr;
2260             %
2261             label(btex {\bigsf HBP} etex, 1/2[(xstart+statboxwidth*10+1,ystart),(xstart+statboxwidth*9+1,ystart-100u/3)]) withcolor clr;
2262             label(btex {\bigsf BLK} etex, 1/2[(xstart+statboxwidth*11+1,ystart),(xstart+statboxwidth*10+1,ystart-100u/3)]) withcolor clr;
2263             label(btex {\bigsf WP} etex, 1/2[(xstart+statboxwidth*12+1,ystart),(xstart+statboxwidth*11+1,ystart-100u/3)]) withcolor clr;
2264             %
2265             label(btex {\bigsf HR} etex, 1/2[(xstart+statboxwidth*13,ystart),(xstart+statboxwidth*12,ystart-100u/3)]) withcolor clr;
2266             label(btex {\bigsf S} etex, 1/2[(xstart+statboxwidth*14,ystart),(xstart+statboxwidth*13,ystart-100u/3)]) withcolor clr;
2267             label(btex {\bigsf P} etex, 1/2[(xstart+statboxwidth*15,ystart),(xstart+statboxwidth*14,ystart-100u/3)]) withcolor clr;
2268             endgroup
2269             enddef;
2270              
2271             def set_vars(expr xstart, ystart) =
2272             begingroup
2273             % locations
2274             pair ballone, balltwo, ballthree, strikeone, striketwo, foulone, foultwo, foulthree, foulfour;
2275             ballone := (xstart+50u+(15u/2),ystart+(15u/2));
2276             balltwo := (xstart+50u+(15u/2)+15u,ystart+(15u/2));
2277             ballthree := (xstart+50u+(15u/2)+30u,ystart+(15u/2));
2278             strikeone := (xstart+50u+(15u/2),ystart+(15u/2)+15u);
2279             striketwo := (xstart+50u+(15u/2)+15u,ystart+(15u/2)+15u);
2280             foulone := (xstart+5u,ystart+9u);
2281             foultwo := (xstart+8u,ystart+5u);
2282             foulthree := (xstart+10u,ystart+11u);
2283             foulfour := (xstart+13u,ystart+7u);
2284             pair rbione, rbitwo, rbithree, rbifour, rundot, outlabel;
2285             rundot := (xstart+40u,ystart+49.5u);
2286             outlabel := (xstart+40u,ystart+49.5u);
2287             rbione := (xstart+5u,ystart+25u);
2288             rbitwo := (xstart+9u,ystart+20u);
2289             rbithree := (xstart+11u,ystart+28u);
2290             rbifour := (xstart+15u,ystart+23u);
2291             pair first, second, third, home;
2292             path single, double, triple, homerun;
2293             pbsize := 15u;
2294             dsize := 24u;
2295             dxstart := xstart+40u;
2296             dystart := ystart+pbsize*1.7;
2297             home := (dxstart,dystart);
2298             first := (dxstart+dsize,dystart+dsize);
2299             second := (dxstart,dystart+dsize*2);
2300             third := (dxstart-dsize,dystart+dsize);
2301             single := home--first--(first+(-7u,0));
2302             double := home--first--second--(second+(0,-7u));
2303             triple := home--first--second--third--(third+(7u,0));
2304             homerun := home--first--second--third--cycle;
2305             path firstsecond, firstthird, firsthome, secondthird, secondhome, thirdhome;
2306             firstsecond := first--second--(second+(0,-7u));
2307             firstthird := first--second--third--(third+(7u,0));
2308             firsthome := first--second--third--home;
2309             secondthird := second--third--(third+(7u,0));
2310             secondhome := second--third--home;
2311             thirdhome := third--home;
2312             path ifleft, ifright, ifcenter, ofleft, ofleftc, ofcenterl, ofcenterr, ofrightc, ofright;
2313             ifleft := home--(home+(-13u,18u));
2314             ifright := home--(home+(13u,18u));
2315             ifcenter := home--(home+(0,18u));
2316             ofleft := home--(home+(-32u, 36u));
2317             ofleftc := home--(home+(-20u, 60u));
2318             ofright := home--(home+(32u, 36u));
2319             ofrightc := home--(home+(20u, 60u));
2320             ofcenterl := home--(home+(-5u, 65u));
2321             ofcenterr := home--(home+(5u, 65u));
2322             path hrleft, hrleftc, hrcenterl, hrcenterr, hrrightc, hrright;
2323             hrleft := home--(home+(-37u, 41u));
2324             hrleftc := home--(home+(-27u, 67u));
2325             hrright := home--(home+(37u, 41u));
2326             hrrightc := home--(home+(27u, 67u));
2327             hrcenterl := home--(home+(-5u, 75u));
2328             hrcenterr := home--(home+(5u, 75u));
2329             lxstart := xstart+90u;
2330             lystart := ystart+92u;
2331             lsize := (lystart-ystart+(fsize/2)-pbsize)/6;
2332             pair hr, threeb, twob, oneb, bb, hp;
2333             hr := (lxstart,lystart);
2334             lystart := lystart - lsize;
2335             threeb := (lxstart,lystart);
2336             lystart := lystart - lsize;
2337             twob := (lxstart,lystart);
2338             lystart := lystart - lsize;
2339             oneb := (lxstart,lystart);
2340             lystart := lystart - lsize;
2341             bb := (lxstart,lystart);
2342             lystart := lystart - lsize;
2343             hp := (lxstart,lystart);
2344             pair wayfirst, waysecond, waythird, wayhome;
2345             path cs_second, cs_third, to_home;
2346             path cs_firstthird, to_firsthome, to_secondhome;
2347             wayfirst := 1/2[home,first];
2348             waysecond := 1/2[first,second];
2349             waythird := 1/2[second,third];
2350             wayhome := 1/2[third,home];
2351             cs_second := first--waysecond--(waysecond+(3u,3u))--(waysecond-(3u,3u));
2352             cs_third := second--waythird--(waythird+(-3u,3u))--(waythird-(-3u,3u));
2353             to_home := third--wayhome--(wayhome+(3u,3u))--(wayhome-(3u,3u));
2354             cs_firstthird := first--second--waythird--(waythird+(-3u,3u))--(waythird-(-3u,3u));
2355             to_firsthome := first--second--third--wayhome--(wayhome+(3u,3u))--(wayhome-(3u,3u));
2356             to_secondhome := second--third--wayhome--(wayhome+(3u,3u))--(wayhome-(3u,3u));
2357             path new_hitter, new_pitcher;
2358             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);
2359             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);
2360             endgroup
2361             enddef;
2362              
2363             def draw_full_scorecard =
2364             begingroup
2365             % Draw the player boxes
2366             color clr;
2367             clr:=card;
2368             u := 1.0pt;
2369             size := 100u;
2370             fsize := 11u;
2371             xstart := 100;
2372             % Draw first nine position boxes
2373             for ystart := 100 step 100 until 900:
2374             draw_player_box(xstart,ystart,clr,true);
2375             endfor
2376             % Draw extra player boxes (without an inning column)
2377             for ystart := -100 step 100 until 0:
2378             draw_player_box(xstart,ystart,clr,false);
2379             endfor
2380             % Draw key for column totals
2381             for ystart := -100 step 100 until 0:
2382             draw_column_totals_key(xstart,ystart,clr);
2383             endfor
2384             % Draw all the at-bat boxes
2385             for ystart := 100 step 100 until 900:
2386             for xstart := 100 step 100 until 1100:
2387             draw_square(xstart, ystart);
2388             endfor
2389             endfor
2390             % Draw the totals boxes
2391             clr:=card;
2392             for ystart := -100 step 50 until 50:
2393             for xstart := 100 step 100 until 1100:
2394             draw_totals_box(xstart,ystart,clr);
2395             endfor
2396             endfor
2397             % Pitcher Rows
2398             for ystart := -300 step 100 until -200:
2399             draw_pitcher_row(100,ystart,clr,true);
2400             draw_pitcher_row(900+100u*(2/3),ystart,clr,false);
2401             endfor
2402             % Label pitcher rows (key on top line, numbers)
2403             draw_pitcher_labels(100,-100,clr,true);
2404             draw_pitcher_labels(900+100u*(2/3)-1,-100,clr,false);
2405             % Draw a thick line below the pitcher row label
2406             pickup pencircle scaled thickline_t;
2407             draw (100-iposwidth*3-namewidth,-100-100u/3)--(900+100u*2/3+400+100u,-100-100u/3) withcolor clr;
2408             pickup pencircle scaled thinline_t;
2409             % Put key into column totals
2410             iposwidth := 40u;
2411             namewidth := 250u;
2412             label(btex {\bigsf R} etex, 1/2[1/2[(100u,100u),(100u-iposwidth,50u)],(100u-iposwidth,100u)]) withcolor clr;
2413             label(btex {\bigsf H} etex, 1/2[1/2[(100u,100u),(100u-iposwidth,50u)],(100u,50u)]) withcolor clr;
2414             label(btex {\bigsf E} etex, 1/2[1/2[(100u,50u),(100u-iposwidth,0u)],(100u-iposwidth,50u)]) withcolor clr;
2415             label(btex {\bigsf LB} etex, 1/2[1/2[(100u,50u),(100u-iposwidth,0u)],(100u,0u)]) withcolor clr;
2416             label(btex {\bigsf BB} etex, 1/2[1/2[(100u,0u),(100u-iposwidth,-50u)],(100u-iposwidth,0u)]) withcolor clr;
2417             label(btex {\bigsf K} etex, 1/2[1/2[(100u,0u),(100u-iposwidth,-50u)],(100u,-50u)]) withcolor clr;
2418             label(btex {\bigsf S} etex, 1/2[1/2[(100u,-50u),(100u-iposwidth,-100u)],(100u-iposwidth,-50u)]) withcolor clr;
2419             label(btex {\bigsf P} etex, 1/2[1/2[(100u,-50u),(100u-iposwidth,-100u)],(100u,-100u)]) withcolor clr;
2420             % Draw all the row totals boxes
2421             for ystart := 100 step 100 until 900:
2422             for xstart := 1200 step 100 until 1300:
2423             draw_row_summary_box(xstart,ystart,clr);
2424             endfor
2425             endfor
2426             % Draw the game and play total boxes
2427             for ystart := -100 step 50 until 50:
2428             xstart := 1200;
2429             draw_game_summary_box(xstart,ystart,clr);
2430             draw_play_total_box(xstart,ystart,clr);
2431             endfor
2432             % Put the key on the play total boxes
2433             nudge := 5u;
2434             label.urt(btex {\sf 1B} etex, (1200+100u/3*2,50+25u+nudge)) withcolor clr;
2435             label.urt(btex {\sf 2B} etex, (1200+100u/3*2,50+nudge)) withcolor clr;
2436             label.urt(btex {\sf DP} etex, (1200+100u/3*2+100u,50+25u+nudge)) withcolor clr;
2437             label.urt(btex {\sf HBP} etex, (1200+100u/3*2+100u,50+nudge)) withcolor clr;
2438             label.urt(btex {\sf 3B} etex, (1200+100u/3*2,0+25u+nudge)) withcolor clr;
2439             label.urt(btex {\sf HR} etex, (1200+100u/3*2,0+nudge)) withcolor clr;
2440             label.urt(btex {\sf WP} etex, (1200+100u/3*2+100u,0+25u+nudge)) withcolor clr;
2441             label.urt(btex {\sf PB} etex, (1200+100u/3*2+100u,0+nudge)) withcolor clr;
2442             label.urt(btex {\sf SF} etex, (1200+100u/3*2,-50+25u+nudge)) withcolor clr;
2443             label.urt(btex {\sf SAC} etex, (1200+100u/3*2,-50+nudge)) withcolor clr;
2444             label.urt(btex {\sf SB} etex, (1200+100u/3*2+100u,-50+25u+nudge)) withcolor clr;
2445             label.urt(btex {\sf CS} etex, (1200+100u/3*2+100u,-50+nudge)) withcolor clr;
2446             % Proof
2447             label.urt(btex {\sf AB+BB+HBP+SAC+SF} etex, (1200+100u/3*2,-100+25u+nudge)) withcolor clr;
2448             label.urt(btex {\sf =\quad R+LOB+OPO} etex, (1200+100u/3*2+24u,-100+nudge)) withcolor clr;
2449             % Side information
2450             % pickup pencircle scaled thickline_t;
2451             pickup pencircle scaled thickline_t;
2452             draw (1400,100)--(1400,1000)--(1466,1000)--(1466,100)--cycle withcolor clr;
2453             draw (1399,1000)--(1399,1033.3)--(1466,1033.3)--(1466,1000)--cycle withcolor clr;
2454             pickup pencircle scaled thinline_t;;
2455             draw (1433.3,100)--(1433.3,1000) withcolor clr;
2456             label(btex {\bigsf Team} etex rotated 90, (1416,130)) withcolor clr;
2457             label(btex {\bigsf FP} etex rotated 90, (1416,614)) withcolor clr;
2458             label(btex {\bigsf Temp} etex rotated 90, (1416,870)) withcolor clr;
2459             label(btex {\bigsf At} etex rotated 90, (1448,142)) withcolor clr;
2460             label(btex {\bigsf Att} etex rotated 90, (1448,450)) withcolor clr;
2461             label(btex {\bigsf Scorer} etex rotated 90, (1448,600)) withcolor clr;
2462             label(btex {\bigsf Wind} etex rotated 90, (1448,870)) withcolor clr;
2463             label(btex {\tiny Copyright \char'251 2005, Christopher Swingley, cswingle@iarc.uaf.edu} etex rotated 90, (1472,-210)) withcolor clr;
2464             % Little numbers for first nine in batting order
2465             label(btex {\sf 1} etex, (-224u, 995u)) withcolor clr;
2466             label(btex {\sf 2} etex, (-224u, 895u)) withcolor clr;
2467             label(btex {\sf 3} etex, (-224u, 795u)) withcolor clr;
2468             label(btex {\sf 4} etex, (-224u, 694u)) withcolor clr;
2469             label(btex {\sf 5} etex, (-224u, 594u)) withcolor clr;
2470             label(btex {\sf 6} etex, (-224u, 494u)) withcolor clr;
2471             label(btex {\sf 7} etex, (-224u, 393u)) withcolor clr;
2472             label(btex {\sf 8} etex, (-224u, 293u)) withcolor clr;
2473             label(btex {\sf 9} etex, (-224u, 193u)) withcolor clr;
2474             % Numbers for pitchers
2475             label(btex {\sf 1} etex, (-224u, -141u)) withcolor clr;
2476             label(btex {\sf 2} etex, (-224u, -174u)) withcolor clr;
2477             label(btex {\sf 3} etex, (-224u, -208u)) withcolor clr;
2478             label(btex {\sf 4} etex, (-224u, -241u)) withcolor clr;
2479             label(btex {\sf 5} etex, (-224u, -274u)) withcolor clr;
2480             % second column of pitchers
2481             label(btex {\sf 6} etex, (640u, -141u)) withcolor clr;
2482             label(btex {\sf 7} etex, (640u, -174u)) withcolor clr;
2483             label(btex {\sf 8} etex, (640u, -208u)) withcolor clr;
2484             label(btex {\sf 9} etex, (640u, -241u)) withcolor clr;
2485             label(btex {\sf 10} etex, (643u, -274u)) withcolor clr;
2486             % Title boxes
2487             xstart:=100;
2488             ystart:=1000;
2489             pickup pencircle scaled thickline_t;
2490             % Inning and Position box
2491             draw (xstart,ystart)--(xstart-iposwidth*2u,ystart)--(xstart-iposwidth*2u,ystart+100u/3)--(xstart,ystart+100u/3)--cycle withcolor clr;
2492             draw (xstart-iposwidth,ystart)--(xstart-iposwidth,ystart+100u/3) withcolor clr;
2493             label(btex {\bigsf Pos} etex, 1/2[(xstart-iposwidth*2u,ystart),(xstart-iposwidth,ystart+100u/3)]) withcolor clr;
2494             label(btex {\bigsf Inn} etex, 1/2[(xstart-iposwidth,ystart),(xstart,ystart+100u/3)]) withcolor clr;
2495             % Player name box
2496             draw (xstart-iposwidth*2,ystart)--(xstart-iposwidth*2-namewidth,ystart)--(xstart-iposwidth*2-namewidth,ystart+100u/3)--
2497             (xstart-iposwidth*2,ystart+100u/3)--cycle withcolor clr;
2498             label(btex {\bigsf Batter} etex, 1/2[(xstart-iposwidth*2-namewidth,ystart),(xstart-iposwidth*2,ystart+100u/3)]) withcolor clr;
2499             % Number box
2500             draw (xstart-iposwidth*2-namewidth,ystart)--(xstart-iposwidth*3-namewidth,ystart)--(xstart-iposwidth*3-namewidth,ystart+100u/3)--
2501             (xstart-iposwidth*2-namewidth,ystart+100u/3)--cycle withcolor clr;
2502             label(btex {\bigsf \#} etex, 1/2[(xstart-iposwidth*2-namewidth,ystart),(xstart-iposwidth*3-namewidth,ystart+100u/3)]) withcolor clr;
2503             % Inning boxes
2504             ystart:=1000;
2505             for xstart := 100 step 100 until 1100:
2506             draw (xstart,ystart)--(xstart+100u,ystart)--(xstart+100u,ystart+100u/3)--(xstart,ystart+100u/3)--cycle withcolor clr;
2507             endfor
2508             label(btex {\bigsf 1} etex, 1/2[(100,ystart),(200,ystart+100u/3)]) withcolor clr;
2509             label(btex {\bigsf 2} etex, 1/2[(200,ystart),(300,ystart+100u/3)]) withcolor clr;
2510             label(btex {\bigsf 3} etex, 1/2[(300,ystart),(400,ystart+100u/3)]) withcolor clr;
2511             label(btex {\bigsf 4} etex, 1/2[(400,ystart),(500,ystart+100u/3)]) withcolor clr;
2512             label(btex {\bigsf 5} etex, 1/2[(500,ystart),(600,ystart+100u/3)]) withcolor clr;
2513             label(btex {\bigsf 6} etex, 1/2[(600,ystart),(700,ystart+100u/3)]) withcolor clr;
2514             label(btex {\bigsf 7} etex, 1/2[(700,ystart),(800,ystart+100u/3)]) withcolor clr;
2515             label(btex {\bigsf 8} etex, 1/2[(800,ystart),(900,ystart+100u/3)]) withcolor clr;
2516             label(btex {\bigsf 9} etex, 1/2[(900,ystart),(1000,ystart+100u/3)]) withcolor clr;
2517             label(btex {\bigsf 10} etex, 1/2[(1000,ystart),(1100,ystart+100u/3)]) withcolor clr;
2518             label(btex {\bigsf 11} etex, 1/2[(1100,ystart),(1200,ystart+100u/3)]) withcolor clr;
2519             % Player totals
2520             ystart:=1000;
2521             for xstart := 1200 step 100u/3 until 1300+100u/3*2:
2522             draw (xstart,ystart)--(xstart+100u/3,ystart)--(xstart+100u/3,ystart+100u/3)--(xstart,ystart+100u/3)--cycle withcolor clr;
2523             endfor
2524             % On the top
2525             label(btex {\bigsf AB} etex, 1/2[(1200,1000),(1200+100u/3,1000+100u/3)]) withcolor clr;
2526             label(btex {\bigsf R} etex, 1/2[(1200+100u/3,1000),(1200+100u/3*2,1000+100u/3)]) withcolor clr;
2527             label(btex {\bigsf H} etex, 1/2[(1200+100u/3*2,1000),(1300,1000+100u/3)]) withcolor clr;
2528             label(btex {\bigsf RBI} etex, 1/2[(1300,1000),(1300+100u/3,1000+100u/3)]) withcolor clr;
2529             label(btex {\bigsf BB} etex, 1/2[(1300+100u/3,1000),(1300+100u/3*2,1000+100u/3)]) withcolor clr;
2530             label(btex {\bigsf SO} etex, 1/2[(1300+100u/3*2,1000),(1400,1000+100u/3)]) withcolor clr;
2531             pickup pencircle scaled playline_t;
2532             endgroup
2533             enddef;
2534              
2535             EOT
2536              
2537              
2538             $TEX = <<'EOT';
2539             \pdfinfo
2540             { /Title (scorecard.pdf)
2541             /Creator (Metapost, TeX)
2542             /Author (Christopher Swingley) }
2543             \input miniltx
2544             \input graphicx.sty
2545             \input eplain
2546             \resetatcatcode
2547             \paperheight 11 true in
2548             \paperwidth 8.5 true in
2549             \topmargin 0.75cm
2550             \bottommargin 0.75cm
2551             \leftmargin 1.00cm
2552             \rightmargin 0.75cm
2553             \nopagenumbers
2554             \parindent=0pt\parskip=8pt
2555             \vfill
2556             \includegraphics[height=\hsize,angle=90]{__BASE__-0.pdf}
2557             \vfill\eject
2558             \bye
2559             EOT
2560              
2561              
2562             $TEXD = <<'EOT';
2563             \pdfinfo
2564             { /Title (metapost_scorecard.pdf)
2565             /Creator (Metapost, TeX)
2566             /Author (Christopher Swingley) }
2567             \input miniltx
2568             \input graphicx.sty
2569             \input eplain
2570             \resetatcatcode
2571             \paperheight 11 true in
2572             \paperwidth 8.5 true in
2573             \topmargin 0.85cm
2574             \bottommargin 0.65cm
2575             \leftmargin 1.00cm
2576             \rightmargin 0.75cm
2577             \nopagenumbers
2578             \parindent=0pt\parskip=8pt
2579             \vfill
2580             \includegraphics[height=\hsize,angle=90]{__BASE1__-0.pdf}
2581             \vfill\eject
2582             \includegraphics[height=\hsize,angle=90]{__BASE2__-0.pdf}
2583             \vfill\eject
2584             \bye
2585             EOT
2586              
2587              
2588             =head1 LIMITATIONS
2589              
2590             This module makes no attempt to try to work around the physical limitations
2591             of the scorecard. So if there are more than 11 innings, more than nine batters
2592             in an inning, more than three players in a lineup position, or more than
2593             ten pitchers, it will fail, either by dying, or just screwing up the output.
2594              
2595             More than four foul balls will not be recorded for a given at-bat in the graphic
2596             (but the pitch counts will still be incremented appropriately).
2597              
2598             Also, no attempt is made to make sure you have the right number of outs in an
2599             innings, balls/strikes in a walk/strikeout, and so on. We don't even necessarily
2600             check to make sure you've called inn() before you call your first ab(), or that
2601             you don't use an incorrect base number, and so on. Or that David Ortiz isn't
2602             pitching, or playing all positions at once. Just don't record something
2603             illegal in a baseball game, and you likely won't run into problems here,
2604             either.
2605              
2606             There are also likely things that happen in the game that the API here does
2607             not well-address.
2608              
2609             Patches are welcome for all of this, if you want it.
2610              
2611              
2612             =head1 TODO
2613              
2614             Automatically, or otherwise, handle more than 9 batters per inning, or more
2615             than 11 innings, perhaps by adding a new scorecard, or by re-using existing
2616             innings for overflow.
2617              
2618              
2619             =head1 AUTHOR
2620              
2621             Chris Nandor Eprojects@pudge.netE, http://projects.pudge.net/
2622              
2623             Copyright (c) 2005 Chris Nandor. Licensed under the terms of the GNU General
2624             Public License, Version 2 available from http://www.gnu.org/copyleft/gpl.html.
2625              
2626             Front end to mpost_scorecard by Christopher Swingley, also licensed under
2627             the GPL.
2628              
2629             =head1 SEE ALSO
2630              
2631             http://www.frontier.iarc.uaf.edu/~cswingle/baseball/scorecards.php
2632              
2633              
2634             =head1 VERSION
2635              
2636             $Id: Scorecard.pm,v 1.5 2005/10/21 04:48:58 pudge Exp $
2637              
2638             __END__