#!/afs/athena/contrib/perl/p -w
#
# schedule.pl
#
# Copyright (c) 1994-1996 Yonah Schmeidler
#   Permission is given to freely distribute and modify this program
# so long as it is done without charge and so long as this copyright
# text remains in place.
#					Yonah Schmeidler, 1996

%daynum = ('M', 1, 'T', 2, 'W', 3, 'R', 4, 'F', 5,
	   'm', 1, 't', 2, 'w', 3, 'r', 4, 'f', 5);

$minHour = 12;
$maxHour = 12;

# First line has title
# Rest of lines
#  <name of class>[LR] <room number> <date> <time>

$portrait = 0;
$height = 7;
$width = 9;

if ( $#ARGV >= 0 && $ARGV[0] eq '-i' )
{
    &do_interactive;
}
else
{
    &do_parse;
}

$minHour = 24;
for $_ ( @s_times )
{
    ($hour) = /^(\d+)/;
    $minHour = $hour if $hour < $minHour;
}

$maxHour = 0;
for $_ ( @e_times )
{
    $hour = $hour + 1 if ((($hour, $min) = /^(\d+)(\.\d+)?$/) == 2);
    $maxHour = $hour if $hour > $maxHour;
}

&do_print;

exit;

sub do_interactive
{
    open ( OUTPUT, '>schedule.auto.out' )
	|| die "Couldn't open schedule.auto.out: $!\n";

    &prompt ("Landscape or portrait mode (L/p) ");
    if ( /^p$/i )
    {
	$portrait = 1;
	$height = 9;
	$width = 7;
    }
    else
    {
	$portrait = 0;
	$height = 9;
	$width = 7;
    }

    &prompt ("Height (in inches) [$height] ");
    $height = $_ if ( /^\d+$/ && $_ > 0 );

    &prompt ("Width (in inches) [$width] ");
    $width = $_ if ( /^\d+$/ && $_ > 0 );

    &prompt ("Title: ");
    $title = $_;

    print OUTPUT "$title\n";

    outer: while (1)
    {
	&prompt ("Name of class (hit return to end): ");
	last if /^$/;
	$class = $_;

	&prompt ("  room: ");
	next if /^$/;
	$room = $_;

	while (1)
	{
	    &prompt ("  day(s) of week (ex: TRF): ");
	    next outer if /^$/;
	    last if /^[MTWRF]+$/i;
	}
	continue
	{
	    print STDERR "Bad day names (use one or more of MTWRF)\n";
	}
	$days = $_;

	while (1)
	{
	    &prompt ("  start time: ");
	    next outer if /^$/;
	    ($hour, $x, $min, $x, $ap)
		= /(\d+)([:.](\d+))?(\s*([APap])[Mm])?/;
	    if ($ap =~ /^[Aa]$/)
	    {
		next if ($hour < 1 || $hour > 12);
		$hour = 0 if $hour == 12;
	    }
	    elsif ($ap =~ /^[Pp]$/)
	    {
		next if ($hour < 1 || $hour > 12);
		$hour = $hour + 12 if $hour != 12;
	    }
	    else
	    {
		next if ($hour < 0 || $hour > 23);
		$hour = $hour + 12 if $hour < 8;
	    }
	    next if ($min < 0 || $min > 59);
	    last;
	}
	continue
	{
	    print STDERR "Bad time specification\n";
	}
	$s_time = "$hour";
	if ($min > 0)
	{
	    if ($min < 10)
	    {
		$s_time = "$hour.0$min";
	    }
	    else
	    {
		$s_time = "$hour.$min";
	    }
	}

	while (1)
	{
	    &prompt ("  end time: ");
	    next outer if /^$/;
	    ($hour, $x, $min, $x, $ap)
		= /(\d+)([:.](\d+))?(\s*([APap])[Mm])?/;
	    if ($ap =~ /^[Aa]$/)
	    {
		next if ($hour < 1 || $hour > 12);
		$hour = 0 if $hour == 12;
	    }
	    elsif ($ap =~ /^[Pp]$/)
	    {
		next if ($hour < 1 || $hour > 12);
		$hour = $hour + 12 if $hour != 12;
	    }
	    else
	    {
		next if ($hour < 0 || $hour > 23);
		$hour = $hour + 12 if $hour < 8;
	    }
	    next if ($min < 0 || $min > 59);
	    last;
	}
	continue
	{
	    print STDERR "Bad time specification\n";
	}
	$e_time = "$hour";
	if ($min > 0)
	{
	    if ($min < 10)
	    {
		$e_time = "$hour.0$min";
	    }
	    else
	    {
		$e_time = "$hour.$min";
	    }
	}

	while (1)
	{
	    &prompt ("  shading (L=.9, R=.95): ");
	    next outer if /^$/;
	    $_ = '.9' if /^[Ll]$/;
	    $_ = '.95' if /^[Rr]$/;
	    last if /^\.\d+$/;
	}
	continue
	{
	    print STDERR "Shading should be .## or L or R\n";
	}
	$shade = $_;

	for $day (split (//, $days))
	{
	    print OUTPUT "$day \"$class\" \"$room\" $s_time $e_time $shade\n";
	    push (@classes, $class);
	    push (@rooms, $room);
	    push (@days, $daynum{$day});
	    push (@s_times, $s_time);
	    push (@e_times, $e_time);
	    push (@shades, $shade);
	}

	next;
    }

    close OUTPUT;
}

sub prompt
{
    ($_) = @_;
    print;
    $_ = <STDIN>;
    chop;
}

sub do_parse
{
    $_ = <>;
    chop;
    $title = $_;

    while( <> )
    {
	chop;
	if ((($days, $class, $room, $s_time, $x, $e_time, $x, $shade) =
	     /^([MTWRF]+)\s+"([^"]+)"\s+"([^"]+)"\s+(\d+([:.]\d+)?)\s+(\d+([:.]\d+)?)\s+(\.\d+)$/i)
					 != 8)
	     {
		 warn "Error in line $.; skipping\n";
		 next;
	     }

	$s_time =~ s/:/./;
	$e_time =~ s/:/./;

	for $day (split (//, $days))
	{
	    push (@classes, $class);
	    push (@rooms, $room);
	    push (@days, $daynum{$day});
	    push (@s_times, $s_time);
	    push (@e_times, $e_time);
	    push (@shades, $shade);
	}
    }
}


sub do_print
{
    $hours = $maxHour - $minHour;

    print <<END;
%!PS-Adobe
%
% PS output from schedule
%
% Copyright (c) 1993-1995 Yonah Schmeidler
%   Permission is given to freely distribute and modify this product
% so long as it is done without charge and so long as this Copyright
% text remains in place.
%   Certain designs inherent may be copyrighted elsewhere.
%					Yonah Schmeidler, 1995

gsave

END

    if ( $portrait )
    {
	print "/yinch {72 mul} def\n";
    }
    else
    {
	print "90 rotate\n/yinch {height 2 add sub 72 mul} def\n";
    }

    print <<END;

%% size and margins for the table (not including the title)
/Bmargin	  1 def		% (inches)
/Lmargin	 .7 def
/height		  $height def
/width		  $width def
%% number of boxes in the table
/days		  5 def		% number of days
/hours		  $hours def		% number of hours
/fsthour	  $minHour def		% first hour
%% fonts for the various pieces of text
%% for a list of available fonts (HP), see /mit/postscript/Fonts/fontpage.hp.ps
/dayfont	/Helvetica-Narrow def
/timefont	/Helvetica-Narrow def
/labelfont	/Palatino-Bold def
/label2font	/Palatino-Roman def
/topfont	/Bookman-Demi def
%% sizes for the above fonts
/dayfsize	 19 def		% (points) (1 point = 1/72 inch)
/timefsize	 19 def
/labelfsize	 15 def
/label2fsize	 15 def
/topfsize	 35 def
%% offsets of labels
/text_lmarg	  8 def
/text_tmarg	  4 def
/text_rmarg	  5 def		% for single line
%% space between the two lines of text, or false to have them on 1 line
/text_space	 20 def		% default: 20
%% offset (up) of title from top of box
/title_margin	 20 def

/days days 1 add def
/hours hours 1 add def
/fsthour fsthour 1 sub def
/xinch {72 mul} def
/rinch {72 mul} def

/day_margin {1 hour xinch dayfsize 2 mul 3 div add 2 div} def
/time_margin {1 hour xinch timefsize 2 mul 3 div add 2 div} def
/day {width days div mul} def
/hour {height hours div mul} def
/mint {60 div hour} def
/timestr {2 string} def

%% main box procedure 
/bigbox
{gsave
2 setlinewidth
newpath
Lmargin xinch Bmargin yinch moveto
0 height rinch rlineto
width rinch 0 rlineto
0 height neg rinch rlineto 
closepath
stroke
grestore} def

%% day seperation line: day # (1-5) -> {}
/dline
{gsave
1 setlinewidth
newpath
day Lmargin add xinch Bmargin yinch moveto
0 height rinch rlineto
stroke
grestore} def

%% hour seperation line: hour # (1-9) -> {} 
/tline
{gsave
1 setlinewidth
newpath
Lmargin xinch exch hour Bmargin add yinch moveto
width rinch 0 rlineto
stroke
grestore} def

%% label days: dayname daynum (1-5) -> {}
/dlabel
{gsave
dayfont findfont dayfsize scalefont setfont
.5 add day Lmargin add xinch height Bmargin add yinch day_margin sub moveto
center
show
grestore} def

%% label times: timenum pos (1-9) -> {}
/tlabel
{gsave
timefont findfont timefsize scalefont setfont
Lmargin .5 day add xinch exch
hour height exch sub Bmargin add yinch time_margin sub moveto
lencstart
dup
dup
0 eq {12 add} if
timestr cvs lencadd exch
(:00 - ) lencadd 3 1 roll
1 add
dup
0 eq {12 add} if
timestr cvs lencadd 3 1 roll
(:00) lencadd 4 1 roll
lencgo show show show show
grestore} def

/lencstart {/lencnum 0 def} def
/lencadd {dup stringwidth pop lencnum add /lencnum exch def} def
/lencgo {lencnum 2 div neg 0 rmoveto} def

/frac {dup floor sub 100 mul} def

%% subtract two times, returns length in points time2 time1 -> points
/timesub
{dup floor 3 2 roll
dup floor exch 4 1 roll
exch sub hour rinch 3 1 roll
frac exch frac exch sub mint rinch add} def

%% label box: string boxheight -> {}
/label
{labelfont findfont labelfsize scalefont setfont
3.5 div text_tmarg sub 0 exch rmoveto
currentpoint
text_lmarg 0 rmoveto
4 3 roll
show
moveto
label2font findfont label2fsize scalefont setfont
text_space false eq
{dup stringwidth pop 1 day rinch exch sub text_rmarg sub 0 rmoveto}
{text_lmarg text_space neg rmoveto} ifelse
show
} def

%% draw appointment: etime stime (9.00-17.59) day (1-5)-> {}
/drap
{gsave
newpath
Lmargin xinch Bmargin yinch moveto
day rinch 0 rmoveto % move to correct day
dup dup
floor
fsthour sub
hour
height exch sub rinch 0 exch rmoveto % move to correct time (hours)
frac
mint rinch
-1 mul
0 exch rmoveto % move to correct time (minutes)
2 setlinewidth
1 day rinch 0 rlineto
timesub
-1 mul
dup
0 exch rlineto
1 day neg rinch 0 rlineto
closepath
gsave
exch setgray
fill
grestore
gsave
stroke
grestore
label
grestore} def

%% header label (centered): label -> {}
/biglabel
{gsave
topfont findfont topfsize scalefont setfont
Lmargin width 2 div add xinch height Bmargin add yinch title_margin add moveto
center
show
grestore} def

%% center text: center -> {}
/center
{dup stringwidth pop
2 div neg 0 rmoveto} def

bigbox
1 1 -1 days add {dline} for
1 1 -1 hours add {tline} for
(Monday) 1 dlabel
(Tuesday) 2 dlabel
(Wednesday) 3 dlabel
(Thursday) 4 dlabel
(Friday) 5 dlabel
1 1 -1 hours add {dup fsthour add 12 mod exch tlabel} for

% user stuff goes here
END

    print "($title) biglabel\n";
    for $i ( 0..(scalar(@classes)-1) )
    {
	print "($classes[$i]) ($rooms[$i]) $shades[$i] "
	    . "$e_times[$i] $s_times[$i] $days[$i] drap\n";
    }

    print <<END;

showpage
grestore
END

}