#!/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*7
+2);
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 e
+q '-';
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 endT
+ime startTime sub hourHeight mul] dup
rectfill
0 0 0 setrgbcolor rectstroke
dup length lineHeight mul endTime startTime sub hourHeight mul exch s
+ub 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 exc
+h 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 s
+howing
one's weekly schedule, usually for classes or the like. Currently, on
+ly 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 descri
+bed under
L</"INPUT FILES"> below, and I<outfile> is where the resulting PostScr
+ipt
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 bei
+ng 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> (defaul
+t 10).
The names of the days of the week are typeset at I<size> * 1.2; the ti
+mes 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 th
+e 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 thi
+s 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 a
+nd is
terminated by one or more blank lines. Any text from a C<#> to the en
+d of a
line is ignored. The first line in each entry consists of a set of le
+tters
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 c
+lass is
held. Times are specified in 24-hour format, the minutes being option
+al (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 t
+he format
matters; if the line is not formed correctly, B<Schedule> prints an er
+ror
message and moves on to the next entry.
The remaining lines of the entry consist of user-defined text which wi
+ll 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 b
+e scaled
down until they do.
=head1 AUTHOR
John T. Wodder II <jwodder at the reversal of gro.ratsenol.fds>
=cut
|