#!/bin/csh -f
#+
#
# NAME:
#	hpscal
#
# SYNOPSIS:
#	hpscal [[[day]month] year]
#
# DESCRIPTION:
#	`hpscal' is a PostScript program to generate a 17 week calendar.
#	There are multiple ways of invoking the program.
#	If no arguments are given, then the 17 weeks starting from
#	the current day are generated.
#	If one argument is given, then it is assumed to be a year,
#	and the 17 weeks starting from January 1st of that year are
#	generated.
#	If two arguments are given, then the first is taken to
#	be the month, and the second the year.  The 17 weeks starting
#	from that month are then generated.
#
#	The month may be in one of two formats: first, it can be
#	a number from 1 to 12.  The numbers correspond to the
#	obvious month.
#	The second format for the month is as a string of three
#	characters.  The format is the same one that the Unix 'date'
#	program uses: first three letters of the month, first
#	letter capitalized.
#
#	If invoked with the single argument '-man', pscal will
#	print this man page.
#
#
# AUTHOR:
#	Patrick Wood
#	Copyright (C) 1987 by Pipeline Associates, Inc.
#	Permission is granted to modify and distribute this free of charge.
# 
# HISTORY:
#	@Original From: patwood@unirot.UUCP (Patrick Wood)
#	@Changed to 17 week format by smann@june.cs.washington.edu
#
# BUGS:
#	`hpscal' doesn't work for months before 1753 (weird stuff happened
#	in September, 1752).
#
# END-OF-MAN

set dmon = (Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)
set flags
set date = (`date`)
set usage = "usage: $0 [-n num_weeks] [[[day] month] year]"
set nweeks=17
if ("$1" == "-n") then
	set nweeks=$2
	shift;shift
endif
switch ($#argv)
	case 0:
	    set day = $date[3]
	    set month = $date[2]
	    set i = 1
	    foreach m ($dmon)
		if ( $m == $month ) then
		    set month = $i
		    break
		endif
		@ i++
	    end
	    set year = $date[6]
	    breaksw
	case 1:
	    switch ($1)
		case -man:
		    cat $0 | awk '{if ($2 == "END-OF-MAN") exit;else print}' | more
		    exit
		case -*:
		    echo "$usage"
		    exit 1
	    endsw
	    set day = 1
	    set month = 1
	    set year = $argv[1]
	    breaksw
	case 2:
	    set day = 1
	    set month = $argv[1]
	    set i = 1
	    foreach m ($dmon)
		if ( $m == $month ) then
		    set month = $i
		    break
		endif
		@ i++
	    end
	    set year = $argv[2]
	    breaksw
	case 3:
	    set day = $argv[1]
	    set month = $argv[2]
	    set i = 1
	    foreach m ($dmon)
		if ( $m == $month ) then
		    set month = $i
		    break
		endif
		@ i++
	    end
	    set year = $argv[3]
	    breaksw
	default:
	    echo "$usage"
	    exit 1
	    breaksw
endsw
@ month--


cat <<END-OF-CALENDAR
%!

% some ugly font stuff.  This came from a 1984 PostScript manual.

/makeoutlinedict 5 dict def
/MakeOutlineFont
  { makeoutlinedict begin
    /strokeweight exch def
    /newfontname exch def
    /basefontname exch def

    /basefontdict basefontname findfont def

    /outfontdict basefontdict maxlength
     1 add dict def

    basefontdict
      { exch dup /FID ne
          { exch outfontdict 3 1 roll put}
          { pop pop }
          ifelse
      } forall
    outfontdict /FontName newfontname put
    outfontdict /PaintType 2 put
    outfontdict /StrokeWidth strokeweight
      put
    newfontname outfontdict definefont pop
    end
  } def


/Helvetica-Bold /Helvetica-Outline1 1000 36 div MakeOutlineFont





% string width center -
/center { % string width -
	/wdth exch def			% string -
	/str exch def wdth str		% width str -
	stringwidth pop sub 2 div 0 rmoveto str show
} def

/nweeks $nweeks def
/width 70 def
% height was 40 for 17 weeks
/height 680 nweeks div def
/height 700 nweeks div def

/drawgrid {
	newpath
	% draw vertical lines
	0 1 7 {	% n -
		width mul 0 moveto		% -
		0 height nweeks mul rlineto		% -
		stroke
	} for
	% draw horizonal lines
	0 1 nweeks { % n
		height mul 0 exch moveto	% -
		width 7 mul 0 rlineto		%
		stroke
	} for
} def

/drawweekdays {
	dayfont findfont 12 scalefont setfont
	newpath
	0 1 6 { % n -
		dup width mul height nweeks mul 4 add moveto	% n -
		[ (Sunday) (Monday) (Tuesday) (Wednesday) (Thursday) (Friday) (Saturday) ] exch get	% dayString -
		width center		% -
	} for
	stroke
} def


/drawyear { 					% year drawyear -
	gsave
	dayfont findfont 40 scalefont setfont	% year -
	0 height nweeks mul 25 add moveto		% year -
	/yearstring exch 5 string cvs def	% -
% there must be a better way...
	latestyear baseyear ne {
		/lystring latestyear 5 string cvs def
		/newstring 10 string def
		newstring 0 yearstring 0 get put
		newstring 1 yearstring 1 get put
		newstring 2 yearstring 2 get put
		newstring 3 yearstring 3 get put
		newstring 4 8#55 put
		newstring 5 lystring 0 get put
		newstring 6 lystring 1 get put
		newstring 7 lystring 2 get put
		newstring 8 lystring 3 get put
		newstring width 7 mul center	% -
	} 
	{
		yearstring width 7 mul center	
	} ifelse
	grestore
} def

/isleap {               % is this a leap year?
	year 4 mod 0 eq         % multiple of 4
	year 100 mod 0 ne       % not century
	year 400 mod 0 eq or and       % unless its a century divisible by 400
} def




/days_month [ 31 28 31 30 31 30 31 31 30 31 30 31 ] def

% number of days in this month
/ndays {		% month year -
	/year exch def
	/month exch def
	days_month month get
	month 1 eq	% Feb = 1
	isleap and
	{
		1 add
	} if
} def


% starting day-of-week for this month
/startday {		% month year -
	/year exch def
	/month exch def
	/off year 2000 sub def	% offset from start of "epoch"
	off
	off 4 idiv add		% number of leap years
	off 100 idiv sub	% number of centuries
	off 400 idiv add        % Gregorian correction
	6 add 7 mod 7 add 	% offset from Jan 1 2000
	/off exch def
	0 1 month 1 sub {
		/idx exch def
		days_month idx  get
		idx 1 eq
		isleap and
		{
			1 add
		} if
		/off exch off add def
	} for
	off 7 mod		% 0--Sunday, 1--monday, etc.
} def



/prtnum {
	gsave 
	dup 1 eq {
		0 setgray
		ofont findfont 15 scalefont setfont
	} if
	3 string cvs show
	grestore
} def



/monthname { % month monthname -
	dayfont findfont 12 scalefont setfont
	-1 width mul -1 height mul 2 div moveto
	[ (January) (February) (March) (April) (May) (June) (July) (August) (September) (October) (November) (December) ]
	exch  get
	show
} def

/firstokay { % day1 month year - boolean
	/year exch def
	/month exch def
	/day1 exch def
	month year startday day1 	% startday day1 -
	1 sub 7 mod add 7 mod		% day_of_week_of_day1 -
	month year ndays day1 sub add 
	6 gt
} def


/drawmonth { % day1 month year -
	/year exch def
	/month exch def
	/day1 exch def
	day1 month year firstokay
	{ month monthname } if

	dayfont findfont 12 scalefont setfont			% -
	/start month year startday def	% -
	/days month year ndays def				% -
	/leftmargin 2 def
	start day1 add 1 sub 7 mod width mul leftmargin add -15 moveto
	0 4 rmoveto
	day1 1 days {			% day -
	    weeknum nweeks lt {
		/day exch def		% -
		gsave

		% Sat and Sun as gray
		day start add 7 mod 0 eq
		{
			.7 setgray
		} if
		day start add 7 mod 1 eq
		{
			.7 setgray
		} if

		day prtnum
		grestore
		day start add 7 mod 0 eq
		{
			currentpoint exch pop height sub leftmargin exch moveto
			/latestyear year def
			/weeknum weeknum 1 add def
		}
		{
			width 0 rmoveto
		} ifelse
	    } if
	} for
	stroke
} def

%%Something:

90 20 translate
/dayfont /Helvetica-Bold def
/ofont /Helvetica-Outline1 def
/baseyear $year def
/basemonth $month def
/baseday $day def

drawgrid
drawweekdays

/weeknum 0 def
/latestyear baseyear def

% first month is a special case
gsave	% n -
% move so that the first week of the month is just below 0,0
0 height nweeks mul height weeknum mul sub translate	% n -
baseday basemonth baseyear drawmonth  % month -
grestore

% This loop puts in the days and month names
1 1 4 { 	% n -
	weeknum nweeks lt {
	    gsave		% n -
	    1 exch		% day1
	    % move so that the first week of the month is just below 0,0
	    0 height nweeks mul height weeknum mul sub translate	% day1 n -
	    basemonth add dup 12 mod exch 12 idiv baseyear add drawmonth  % 

	    grestore
	} if
} for

baseyear drawyear

showpage

END-OF-CALENDAR

exit