#!/usr/bin/perl -w
# To do:
# - Improve the color palette
# - Add support for weekend events
# - Fix "squeezing" of overly long text so that the last line doesn't touch the
#   bottom of the box
# - Add support for 12-hour times?
# - Rewrite `drawClass' so that it takes the font size as an argument and sets
#   it & the line height, thereby simplifying "squeezing" a bit
# - Handle textless entries
# - Allow literal hash marks to appear in text lines
use strict;
use Getopt::Std;
use POSIX qw(floor ceil);

my @colors = (
 '0.8 0.8 0.8',  # grey
 '1 0 0',  # red
 '0 1 0',  # blue
 '0 0 1',  # green
 '0 1 1',  # cyan
 '1 1 0',  # yellow
 '0.5 0 0.5',  # purple
 '1 1 1',  # white
 '1 0.5 0',  # orange
 '1 0 1',  # magenta
);

my $em = 0.6;
# $em = the em value to font size ratio.  In PostScript (for Monaco & Courier,
# at least), this appears to be approximately 0.6.

my %opts;
getopts('f:glts:', \%opts);
@colors = ('0.8 0.8 0.8') if $opts{g};

my($pageWidth, $pageHeight) = $opts{l} ? (9*72, 6.5*72) : (6.5*72, 9*72);
my $dayWidth = $pageWidth / 5;

my $fontSize = $opts{f} || 10;
my $lineHeight = $fontSize * 1.2;
my $dayHeight = $lineHeight * 1.2;

my $lineWidth = floor($dayWidth / ($fontSize * $em));

my $infile = shift || '-';
my $outfile = shift;
if (!defined $outfile) {
 $outfile = $infile;
 $outfile eq '-' or $outfile =~ s/\.txt/.ps/i or $outfile .= '.ps';
}
my($in, $out) = (*STDIN, *STDOUT);
open $in, '<', $infile or die "$0: $infile: $!\n" unless $infile eq '-';
open $out, '>', $outfile or die "$0: $outfile: $!\n" unless $outfile eq '-';
select $out;

my @classes;
my($dayStart, $dayEnd);

$/ = '';
while (<$in>) {
 chomp;
 s/^\#.*$ \n//gmx;
 s/#.*$//gm;
 next if /^\s*$/;
 my($days, $time, @text) = split /\n/;
 @text = map { wrapLine($_, $lineWidth) } @text;
 $time =~ /^\s*(\d{1,2})(?:[:.]?(\d{2}))?\s*-\s*(\d{1,2})(?:[:.]?(\d{2}))?\s*$/
  or do {print STDERR "$0: item $.: invalid time format\n"; next; };
 my $start = $1;
 $start += $2/60 if $2;
 $dayStart = $start if !defined($dayStart) || $start < $dayStart;
 my $end = $3;
 $end += $4/60 if $4;
 $dayEnd = $end if !defined($dayEnd) || $end > $dayEnd;
 push @classes, [ $days, $start, $end, $colors[$. % @colors], @text ];
}
$dayStart = floor($dayStart) - 1;
$dayEnd = ceil($dayEnd) + 1;
my $hourHeight = $pageHeight / ($dayEnd - $dayStart);

print "%!PS-Adobe-3.0\n";
print "0 792 translate -90 rotate\n" if $opts{l};
if ($opts{s}) {
 print "/factor 1 $opts{s} div def ";
 printf "1 factor sub %g mul 2 div 1 factor sub %g mul 2 div translate ",
  $opts{l} ? (11*72, 8.5*72) : (8.5*72, 11*72);
 print "factor dup scale\n" if $opts{s};
}
print <<EOT;
/baseFont /Monaco findfont def

/dayWidth $dayWidth def
/hourHeight $hourHeight def
/lineHeight $lineHeight def
/dayHeight $dayHeight def

/margin 72 def
/headerOffset $pageHeight margin add dayHeight sub def

/dayStart $dayStart def
/dayEnd $dayEnd def

/drawClass { % arguments: array of strings, start time, end time, R G B
 setrgbcolor
 /endTime exch def
 /startTime exch def
 [x headerOffset endTime dayStart sub hourHeight mul sub dayWidth endTime startTime sub hourHeight mul] dup
 rectfill
 0 0 0 setrgbcolor rectstroke
 dup length lineHeight mul endTime startTime sub hourHeight mul exch sub 2 div headerOffset startTime dayStart sub hourHeight mul sub exch sub /y exch def
 {
  /y y lineHeight sub def
  dup stringwidth pop dayWidth exch sub 2 div x add y moveto show
 } forall
} def

/x margin def
x $pageHeight margin add dayWidth 5 mul dayEnd dayStart sub hourHeight mul dayHeight add neg rectstroke

baseFont lineHeight scalefont setfont
[(Monday) (Tuesday) (Wednesday) (Thursday) (Friday)] {
 dup stringwidth pop dayWidth exch sub 2 div x add $pageHeight margin add lineHeight sub moveto show
 /x x dayWidth add def
} forall

/x margin def
x $pageHeight margin add dayHeight sub moveto dayWidth 5 mul 0 rlineto stroke
[2] 0 setdash
dayStart 1 add floor 1 dayEnd 1 sub ceiling {
 x exch dayStart sub hourHeight mul headerOffset exch sub moveto
 dayWidth 5 mul 0 rlineto
 stroke
} for
[] 0 setdash
1 1 4 {
 dayWidth mul x add $pageHeight margin add moveto
 0 dayHeight dayEnd dayStart sub hourHeight mul add neg rlineto
 stroke
} for
EOT

print <<EOTIMES if $opts{t};
baseFont $fontSize 1.2 div scalefont setfont
/str 3 string def
dayStart ceiling 1 add 1 dayEnd floor 1 sub {
 dup x exch dayStart sub hourHeight mul headerOffset exch sub moveto
 (:00) dup stringwidth pop dup -1.2 mul $fontSize -2.4 div rmoveto exch show
 neg 0 rmoveto
 str cvs dup stringwidth pop neg 0 rmoveto show
} for
EOTIMES

print "baseFont $fontSize scalefont setfont\n";

foreach my $regex (qw< M T W [HR] F >) {
 foreach (grep { $_->[0] =~ /$regex/i } @classes) {
  my @text = @$_[4..$#$_];
  my $tmpSize;
  if (@text * $lineHeight > ($_->[2] - $_->[1]) * $hourHeight) {
   $tmpSize = ($_->[2] - $_->[1]) * $hourHeight / @text / 1.2;
   print "baseFont $tmpSize scalefont setfont\n";
   print "/lineHeight $tmpSize 1.2 mul def\n";
  }
  print '[(', join(') (', @text), ')] ', $_->[1], ' ', $_->[2], ' ', $_->[3],
   " drawClass\n";
  if (defined $tmpSize) {
   print "baseFont $fontSize scalefont setfont\n";
   print "/lineHeight $lineHeight def\n";
  }
 }
 print "/x x dayWidth add def\n";
}

print "showpage\n";

sub wrapLine {
 my $str = shift;
 my $len = shift || 80;
 $str =~ s/\s+$//;
 my @lines = ();
 while (length $str > $len) {
  if (reverse(substr $str, 0, $len) =~ /\s+/) {
   push @lines, substr $str, 0, $len - $+[0], ''
  } else { push @lines, substr $str, 0, $len, '' }
  $str =~ s/^\s+//;
 }
 s/([()\\])/\\$1/g foreach @lines, $str;
 return (@lines, $str);
}

__END__

=pod

=head1 NAME

B<schedule> - format class schedules

=head1 SYNOPSIS

B<schedule> [B<-glt>] [B<-f> I<size>] [B<-s> I<factor>] [I<infile> [I<outfile>]]

=head1 DESCRIPTION

B<Schedule> is a L<perl(1)> script for creating charts in PostScript showing
one's weekly schedule, usually for classes or the like.  Currently, only events
that take place on Monday, Tuesday, Wednesday, Thursday, and/or Friday are
recognized.

I<infile> (or stdin if no file is given) is a file formatted as described under
L</"INPUT FILES"> below, and I<outfile> is where the resulting PostScript
output will be written.  If I<outfile> is not given, its name will be derived
from that of I<infile> by replacing the C<.txt> extension with C<.ps> or, if
there is no such extension, appending C<.ps>; however, if input is being read
from stdin, then output will be written to stdout instead.

=head1 OPTIONS

=over

=item B<-f> I<size>

Set the size of the font used for class information to I<size> (default 10).
The names of the days of the week are typeset at I<size> * 1.2; the times of
day (if printed) are at I<size> / 1.2.

=item B<-g>

Color the class boxes grey rather than various colors.

=item B<-l>

Orient the table in "landscape mode," i.e., with the longer side of the paper
as the width.  The default is to typeset it in "portrait mode."

=item B<-s> I<factor>

Divide the length of each side of the table by I<factor>.  Without this option,
the table fills the whole page, except for a 1 in. margin on each side.

=item B<-t>

Give the time that each hour line represents in the left margin of the page.

=back

=head1 INPUT FILES

Each entry in the input file consists of three or more lines of text and is
terminated by one or more blank lines.  Any text from a C<#> to the end of a
line is ignored.  The first line in each entry consists of a set of letters
which indicate on which days the class is held:

    M - Monday
    T - Tuesday
    W - Wednesday
    R or H - Thursday
    F - Friday

These letters may be in any order & case.  Any characters outside this set are
ignored.

The second line of each entry specifies the time of day at which the class is
held.  Times are specified in 24-hour format, the minutes being optional (and
optionally preceded by a colon or period), and the beginning & ending times are
separated by a hyphen.  This is the only part of the entry for which the format
matters; if the line is not formed correctly, B<Schedule> prints an error
message and moves on to the next entry.

The remaining lines of the entry consist of user-defined text which will be
printed in the class's box on the schedule table.  Long lines will be broken at
whitespace, and if a box contains more lines than can fit, they will be scaled
down until they do.

=head1 AUTHOR

John T. Wodder II <jwodder at the reversal of gro.ratsenol.fds>

=cut