#!/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 <[email protected]>

=cut

You are viewing proxied material from sdf.org. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.