108 lines
4.2 KiB
Text
108 lines
4.2 KiB
Text
'PR' QUOTE 'PR'
|
||
|
||
'PROC' PRINT CALENDAR = ('INT' YEAR, PAGE WIDTH)'VOID': 'BEGIN'
|
||
|
||
()'STRING' MONTH NAMES = (
|
||
"JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE",
|
||
"JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER"),
|
||
WEEKDAY NAMES = ("SU","MO","TU","WE","TH","FR","SA");
|
||
'FORMAT' WEEKDAY FMT = $G,N('UPB' WEEKDAY NAMES - 'LWB' WEEKDAY NAMES)(" "G)$;
|
||
|
||
# 'JUGGLE' THE CALENDAR FORMAT TO FIT THE PRINTER/SCREEN WIDTH #
|
||
'INT' DAY WIDTH = 'UPB' WEEKDAY NAMES(1), DAY GAP=1;
|
||
'INT' MONTH WIDTH = (DAY WIDTH+DAY GAP) * 'UPB' WEEKDAY NAMES-1;
|
||
'INT' MONTH HEADING LINES = 2;
|
||
'INT' MONTH LINES = (31 'OVER' 'UPB' WEEKDAY NAMES+MONTH HEADING LINES+2); # +2 FOR HEAD/TAIL WEEKS #
|
||
'INT' YEAR COLS = (PAGE WIDTH+1) 'OVER' (MONTH WIDTH+1);
|
||
'INT' YEAR ROWS = ('UPB' MONTH NAMES-1)'OVER' YEAR COLS + 1;
|
||
'INT' MONTH GAP = (PAGE WIDTH - YEAR COLS*MONTH WIDTH + 1)'OVER' YEAR COLS;
|
||
'INT' YEAR WIDTH = YEAR COLS*(MONTH WIDTH+MONTH GAP)-MONTH GAP;
|
||
'INT' YEAR LINES = YEAR ROWS*MONTH LINES;
|
||
|
||
'MODE' 'MONTHBOX' = (MONTH LINES, MONTH WIDTH)'CHAR';
|
||
'MODE' 'YEARBOX' = (YEAR LINES, YEAR WIDTH)'CHAR';
|
||
|
||
'INT' WEEK START = 1; # 'SUNDAY' #
|
||
|
||
'PROC' DAYS IN MONTH = ('INT' YEAR, MONTH)'INT':
|
||
'CASE' MONTH 'IN' 31,
|
||
'IF' YEAR 'MOD' 4 'EQ' 0 'AND' YEAR 'MOD' 100 'NE' 0 'OR' YEAR 'MOD' 400 'EQ' 0 'THEN' 29 'ELSE' 28 'FI',
|
||
31, 30, 31, 30, 31, 31, 30, 31, 30, 31
|
||
'ESAC';
|
||
|
||
'PROC' DAY OF WEEK = ('INT' YEAR, MONTH, DAY)'INT': 'BEGIN'
|
||
# 'DAY' OF THE WEEK BY 'ZELLER'’S 'CONGRUENCE' ALGORITHM FROM 1887 #
|
||
'INT' Y := YEAR, M := MONTH, D := DAY, C;
|
||
'IF' M <= 2 'THEN' M +:= 12; Y -:= 1 'FI';
|
||
C := Y 'OVER' 100;
|
||
Y 'MODAB' 100;
|
||
(D - 1 + ((M + 1) * 26) 'OVER' 10 + Y + Y 'OVER' 4 + C 'OVER' 4 - 2 * C) 'MOD' 7
|
||
'END';
|
||
|
||
'MODE' 'SIMPLEOUT' = 'UNION'('STRING', ()'STRING', 'INT');
|
||
|
||
'PROC' CPUTF = ('REF'()'CHAR' OUT, 'FORMAT' FMT, 'SIMPLEOUT' ARGV)'VOID':'BEGIN'
|
||
'FILE' F; 'STRING' S; ASSOCIATE(F,S);
|
||
PUTF(F, (FMT, ARGV));
|
||
OUT(:'UPB' S):=S;
|
||
CLOSE(F)
|
||
'END';
|
||
|
||
'PROC' MONTH REPR = ('INT' YEAR, MONTH)'MONTHBOX':'BEGIN'
|
||
'MONTHBOX' MONTH BOX; 'FOR' LINE 'TO' 'UPB' MONTH BOX 'DO' MONTH BOX(LINE,):=" "* 2 'UPB' MONTH BOX 'OD';
|
||
'STRING' MONTH NAME = MONTH NAMES(MONTH);
|
||
|
||
# CENTER THE TITLE #
|
||
CPUTF(MONTH BOX(1,(MONTH WIDTH - 'UPB' MONTH NAME ) 'OVER' 2+1:), $G$, MONTH NAME);
|
||
CPUTF(MONTH BOX(2,), WEEKDAY FMT, WEEKDAY NAMES);
|
||
|
||
'INT' FIRST DAY := DAY OF WEEK(YEAR, MONTH, 1);
|
||
'FOR' DAY 'TO' DAYS IN MONTH(YEAR, MONTH) 'DO'
|
||
'INT' LINE = (DAY+FIRST DAY-WEEK START) 'OVER' 'UPB' WEEKDAY NAMES + MONTH HEADING LINES + 1;
|
||
'INT' CHAR =((DAY+FIRST DAY-WEEK START) 'MOD' 'UPB' WEEKDAY NAMES)*(DAY WIDTH+DAY GAP) + 1;
|
||
CPUTF(MONTH BOX(LINE,CHAR:CHAR+DAY WIDTH-1),$G(-DAY WIDTH)$, DAY)
|
||
'OD';
|
||
MONTH BOX
|
||
'END';
|
||
|
||
'PROC' YEAR REPR = ('INT' YEAR)'YEARBOX':'BEGIN'
|
||
'YEARBOX' YEAR BOX;
|
||
'FOR' LINE 'TO' 'UPB' YEAR BOX 'DO' YEAR BOX(LINE,):=" "* 2 'UPB' YEAR BOX 'OD';
|
||
'FOR' MONTH ROW 'FROM' 0 'TO' YEAR ROWS-1 'DO'
|
||
'FOR' MONTH COL 'FROM' 0 'TO' YEAR COLS-1 'DO'
|
||
'INT' MONTH = MONTH ROW * YEAR COLS + MONTH COL + 1;
|
||
'IF' MONTH > 'UPB' MONTH NAMES 'THEN'
|
||
DONE
|
||
'ELSE'
|
||
'INT' MONTH COL WIDTH = MONTH WIDTH+MONTH GAP;
|
||
YEAR BOX(
|
||
MONTH ROW*MONTH LINES+1 : (MONTH ROW+1)*MONTH LINES,
|
||
MONTH COL*MONTH COL WIDTH+1 : (MONTH COL+1)*MONTH COL WIDTH-MONTH GAP
|
||
) := MONTH REPR(YEAR, MONTH)
|
||
'FI'
|
||
'OD'
|
||
'OD';
|
||
DONE: YEAR BOX
|
||
'END';
|
||
|
||
'INT' CENTER = (YEAR COLS*(MONTH WIDTH+MONTH GAP) - MONTH GAP - 1) 'OVER' 2;
|
||
'INT' INDENT = (PAGE WIDTH - YEAR WIDTH) 'OVER' 2;
|
||
|
||
PRINTF((
|
||
$N(INDENT + CENTER - 9)K G L$, "(INSERT SNOOPY HERE)",
|
||
$N(INDENT + CENTER - 1)K 4D L$, YEAR, $L$,
|
||
$N(INDENT)K N(YEAR WIDTH)(G) L$, YEAR REPR(YEAR)
|
||
))
|
||
'END';
|
||
|
||
MAIN: 'BEGIN'
|
||
'CO' INSPIRED BY HTTP://WWW.EE.RYERSON.CA/~ELF/hack/realmen.html
|
||
REAL PROGRAMMERS DONT USE PASCAL - ED POST
|
||
DATAMATION, VOLUME 29 NUMBER 7, JULY 1983
|
||
THE REAL PROGRAMMERS NATURAL HABITAT
|
||
"TAPED TO THE WALL IS A LINE-PRINTER SNOOPY CALENDER FOR THE YEAR 1969"
|
||
'CO'
|
||
'INT' MANKIND STEPPED ON THE MOON = 1969,
|
||
LINE PRINTER WIDTH = 132; # AS AT 1969! #
|
||
PRINT CALENDAR(MANKIND STEPPED ON THE MOON, LINE PRINTER WIDTH)
|
||
'END'
|