109 lines
4.2 KiB
Text
109 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'
|