Calendar - for "REAL" programmers: Difference between revisions
(Added X86 Assembly) |
(Added Vedit macro language) |
||
| Line 1,030: | Line 1,030: | ||
20 21 22 23 24 25 26 17 18 19 20 21 22 23 22 23 24 25 26 27 28 |
20 21 22 23 24 25 26 17 18 19 20 21 22 23 22 23 24 25 26 27 28 |
||
27 28 29 30 31 24 25 26 27 28 29 30 29 30 31 |
27 28 29 30 31 24 25 26 27 28 29 30 29 30 31 |
||
</pre> |
|||
=={{header|Vedit macro language}}== |
|||
In [[Calendar]] task, standard calendar.vdm macro was called to draw one month calendar. |
|||
The version here is stand-alone and contains subroutine DRAW_CALENDAR to draw one month calendar. |
|||
In addition, short commands are used here. (Normally, long versions of command words are used in RC tasks for readability.) |
|||
Vedit macro language is case insensitive, but it is normal practice to write short commands in upper case. |
|||
<lang vedit>BS(BF) |
|||
CFT(22) |
|||
#3 = 6 // NUMBER OF MONTHS PER LINE |
|||
#2 = 1969 // YEAR |
|||
#1 = 1 // STARTING MONTH |
|||
IC(' ', COUNT, #3*9) IT("[SNOOPY]") IN(2) |
|||
IC(' ', COUNT, #3*9+1) NI(#2) IN |
|||
REPEAT(12/#3) { |
|||
REPEAT (#3) { |
|||
BS(BF) |
|||
CALL("DRAW_CALENDAR") |
|||
RCB(10, 1, EOB_POS, COLSET, 1, 21) |
|||
BQ(OK) |
|||
#5 = CP |
|||
RI(10) |
|||
GP(#5) |
|||
EOL IC(9) |
|||
#1++ |
|||
} |
|||
EOF IN(2) |
|||
} |
|||
RETURN |
|||
:DRAW_CALENDAR: |
|||
NUM_PUSH(4,20) |
|||
#20 = RF |
|||
BOF DC(ALL) |
|||
NI(#1, LEFT+NOCR) IT("/1/") NI(#2, LEFT+NOCR) |
|||
RCB(#20, BOL_POS, EOL_POS, DELETE) |
|||
#10 = JDATE(@(#20)) |
|||
#4 = #2+(#1==12) |
|||
NI(#1%12+1, LEFT+NOCR) IT("/1/") NI(#4, LEFT+NOCR) |
|||
RCB(#20, BOL_POS, CP, DELETE) |
|||
#11 = JDATE(@(#20)) - #10 |
|||
#12 = JDATE() |
|||
#7 = (#10-1) % 7 |
|||
IF (#1==1) { RS(#20," JANUARY ") } |
|||
IF (#1==2) { RS(#20," FEBRUARY") } |
|||
IF (#1==3) { RS(#20," MARCH ") } |
|||
IF (#1==4) { RS(#20," APRIL ") } |
|||
IF (#1==5) { RS(#20," MAY ") } |
|||
IF (#1==6) { RS(#20," JUNE ") } |
|||
IF (#1==7) { RS(#20," JULY ") } |
|||
IF (#1==8) { RS(#20," AUGUST ") } |
|||
IF (#1==9) { RS(#20,"SEPTEMBER") } |
|||
IF (#1==10) { RS(#20," OCTOBER ") } |
|||
IF (#1==11) { RS(#20," NOVEMBER") } |
|||
IF (#1==12) { RS(#20," DECEMBER") } |
|||
IT(" ") RI(#20) IN |
|||
IT(" MO TU WE TH FR SA SU") IN |
|||
IT(" --------------------") IN |
|||
IC(' ', COUNT, #7*3) |
|||
#6 = 0 |
|||
FOR (#8 = 1; #8 <= #11; #8++) { |
|||
NI(#8, COUNT, 3) |
|||
IF (#8+#10-1 == #12) { #6 = CP } |
|||
#5 = (#8+#10+6-1) % 7 |
|||
IF (#5 == 6) { IN } |
|||
} |
|||
IT(" ") |
|||
REG_EMPTY(#20) |
|||
NUM_POP(4,20) |
|||
RETURN </lang> |
|||
<pre> |
|||
[SNOOPY] |
|||
1969 |
|||
JANUARY FEBRUARY MARCH APRIL MAY JUNE |
|||
MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU |
|||
-------------------- -------------------- -------------------- -------------------- -------------------- -------------------- |
|||
1 2 3 4 5 1 2 1 2 1 2 3 4 5 6 1 2 3 4 1 |
|||
6 7 8 9 10 11 12 3 4 5 6 7 8 9 3 4 5 6 7 8 9 7 8 9 10 11 12 13 5 6 7 8 9 10 11 2 3 4 5 6 7 8 |
|||
13 14 15 16 17 18 19 10 11 12 13 14 15 16 10 11 12 13 14 15 16 14 15 16 17 18 19 20 12 13 14 15 16 17 18 9 10 11 12 13 14 15 |
|||
20 21 22 23 24 25 26 17 18 19 20 21 22 23 17 18 19 20 21 22 23 21 22 23 24 25 26 27 19 20 21 22 23 24 25 16 17 18 19 20 21 22 |
|||
27 28 29 30 31 24 25 26 27 28 24 25 26 27 28 29 30 28 29 30 26 27 28 29 30 31 23 24 25 26 27 28 29 |
|||
31 30 |
|||
JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER |
|||
MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU |
|||
-------------------- -------------------- -------------------- -------------------- -------------------- -------------------- |
|||
1 2 3 4 5 6 1 2 3 1 2 3 4 5 6 7 1 2 3 4 5 1 2 1 2 3 4 5 6 7 |
|||
7 8 9 10 11 12 13 4 5 6 7 8 9 10 8 9 10 11 12 13 14 6 7 8 9 10 11 12 3 4 5 6 7 8 9 8 9 10 11 12 13 14 |
|||
14 15 16 17 18 19 20 11 12 13 14 15 16 17 15 16 17 18 19 20 21 13 14 15 16 17 18 19 10 11 12 13 14 15 16 15 16 17 18 19 20 21 |
|||
21 22 23 24 25 26 27 18 19 20 21 22 23 24 22 23 24 25 26 27 28 20 21 22 23 24 25 26 17 18 19 20 21 22 23 22 23 24 25 26 27 28 |
|||
28 29 30 31 25 26 27 28 29 30 31 29 30 27 28 29 30 31 24 25 26 27 28 29 30 29 30 31 |
|||
</pre> |
</pre> |
||
Revision as of 09:42, 22 February 2013
You are encouraged to solve this task according to the task description, using any language you may know.
Provide an algorithm as per the Calendar task, except the entire code for the algorithm must be presented entirely without lowercase. Also - as per many 1969 era line printers - format the calendar to nicely fill a page that is 132 characters wide.
(Hint: manually convert the code from the Calendar task to all UPPERCASE)
This task also is inspired by Real Programmers Don't Use PASCAL by Ed Post, Datamation, volume 29 number 7, July 1983.
THE REAL PROGRAMMER'S NATURAL HABITAT "Taped to the wall is a line-printer Snoopy calender for the year 1969."
Moreover this task is further inspired by the long lost corollary article titled:
"Real programmers think in UPPERCASE"!
Note: Whereas today we only need to worry about ASCII, UTF-8, UTF-16, UTF-32, UTF-7 and UTF-EBCDIC encodings, in the 1960s having code in UPPERCASE was often mandatory as characters were often stuffed into 36-bit words as 6 lots of 6-bit characters. More extreme words sizes include 60-bit words of the CDC 6000 series computers. The Soviets even had a national character set that was inclusive of all 4-bit, 5-bit, 6-bit & 7-bit depending on how the file was opened... And one rogue Soviet university went further and built a 1.5-bit based computer.
Of course... as us Boomers have turned into Geezers we have become HARD OF HEARING, and suffer from chronic Presbyopia, hence programming in UPPERCASE is less to do with computer architecture and more to do with practically. :-)
For economy of size, do not actually include Snoopy generation in either the code or the output, instead just output a place-holder.
FYI: a nice ASCII art file of Snoopy can be found at textfiles.com. Save with a .txt extension.
Ada
In Ada, the task is really easy, because Ada is case insensitive. I.e., one could simply replicate the code from Ada solution of the calendar task and convert every lowercase character to uppercase. Instead of doing that, the implementation below reuses the package "PRINTABLE_CALENDAR" (same as "Printable_Calendar" or "printable_calendar") from the calendar task:
<lang Ada>WITH PRINTABLE_CALENDAR;
PROCEDURE REAL_CAL IS
C: PRINTABLE_CALENDAR.CALENDAR := PRINTABLE_CALENDAR.INIT_132
((WEEKDAY_REP =>
"MO TU WE TH FR SA SO",
MONTH_REP =>
(" JANUARY ", " FEBRUARY ",
" MARCH ", " APRIL ",
" MAY ", " JUNE ",
" JULY ", " AUGUST ",
" SEPTEMBER ", " OCTOBER ",
" NOVEMBER ", " DECEMBER ")
));
BEGIN
C.PRINT_LINE_CENTERED("[SNOOPY]");
C.NEW_LINE;
C.PRINT(1969, "NINETEEN-SIXTY-NINE");
END REAL_CAL;</lang>
Output:
[SNOOPY]
NINETEEN-SIXTY-NINE
JANUARY FEBRUARY MARCH APRIL MAY JUNE
MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO
1 2 3 4 5 1 2 1 2 1 2 3 4 5 6 1 2 3 4 1
6 7 8 9 10 11 12 3 4 5 6 7 8 9 3 4 5 6 7 8 9 7 8 9 10 11 12 13 5 6 7 8 9 10 11 2 3 4 5 6 7 8
13 14 15 16 17 18 19 10 11 12 13 14 15 16 10 11 12 13 14 15 16 14 15 16 17 18 19 20 12 13 14 15 16 17 18 9 10 11 12 13 14 15
20 21 22 23 24 25 26 17 18 19 20 21 22 23 17 18 19 20 21 22 23 21 22 23 24 25 26 27 19 20 21 22 23 24 25 16 17 18 19 20 21 22
27 28 29 30 31 24 25 26 27 28 24 25 26 27 28 29 30 28 29 30 26 27 28 29 30 31 23 24 25 26 27 28 29
31 30
JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER
MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO
1 2 3 4 5 6 1 2 3 1 2 3 4 5 6 7 1 2 3 4 5 1 2 1 2 3 4 5 6 7
7 8 9 10 11 12 13 4 5 6 7 8 9 10 8 9 10 11 12 13 14 6 7 8 9 10 11 12 3 4 5 6 7 8 9 8 9 10 11 12 13 14
14 15 16 17 18 19 20 11 12 13 14 15 16 17 15 16 17 18 19 20 21 13 14 15 16 17 18 19 10 11 12 13 14 15 16 15 16 17 18 19 20 21
21 22 23 24 25 26 27 18 19 20 21 22 23 24 22 23 24 25 26 27 28 20 21 22 23 24 25 26 17 18 19 20 21 22 23 22 23 24 25 26 27 28
28 29 30 31 25 26 27 28 29 30 31 29 30 27 28 29 30 31 24 25 26 27 28 29 30 29 30 31
To change the output to 80-character devices, replace "INIT_132" by "INIT_80".
ALGOL 68
This code uses 'quote stropping' to mark reserved words, it is a very early form of wikitext and makes syntax highlighting of source code for publication relatively easy.
Note: to run this code with ALGOL 68G you need to use the --quote-stropping option. <lang algol68>'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'</lang> Output:
(INSERT SNOOPY HERE)
1969
JANUARY FEBRUARY MARCH APRIL MAY JUNE
SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA
1 2 3 4 1 1 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7
5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14
12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21
19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28
26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 27 28 29 30 25 26 27 28 29 30 31 29 30
30 31
JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER
SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA
1 2 3 4 5 1 2 1 2 3 4 5 6 1 2 3 4 1 1 2 3 4 5 6
6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13
13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20
20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27
27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31
31 30
BBC BASIC
<lang bbcbasic> VDU 23,22,1056;336;8,16,16,128
YEAR = 1969
PRINT TAB(62) "[SNOOPY]" TAB(64); YEAR
DIM DOM(5), MJD(5), DM(5), MONTH$(11)
DAYS$ = "SU MO TU WE TH FR SA"
MONTH$() = "JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE", \
\ "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER"
FOR MONTH = 1 TO 7 STEP 6
PRINT
FOR COL = 0 TO 5
MJD(COL) = FNMJD(1, MONTH + COL, YEAR)
MONTH$ = MONTH$(MONTH + COL - 1)
PRINT TAB(COL*22 + 11 - LEN(MONTH$)/2) MONTH$;
NEXT
FOR COL = 0 TO 5
PRINT TAB(COL*22 + 1) DAYS$;
DM(COL) = FNDIM(MONTH + COL, YEAR)
NEXT
DOM() = 1
COL = 0
REPEAT
DOW = FNDOW(MJD(COL))
IF DOM(COL)<=DM(COL) THEN
PRINT TAB(COL*22 + DOW*3 + 1); DOM(COL);
DOM(COL) += 1
MJD(COL) += 1
ENDIF
IF DOW=6 OR DOM(COL)>DM(COL) COL = (COL + 1) MOD 6
UNTIL DOM(0)>DM(0) AND DOM(1)>DM(1) AND DOM(2)>DM(2) AND \
\ DOM(3)>DM(3) AND DOM(4)>DM(4) AND DOM(5)>DM(5)
PRINT
NEXT
END
DEF FNMJD(D%,M%,Y%) : M% -= 3 : IF M% < 0 M% += 12 : Y% -= 1
= D% + (153*M%+2)DIV5 + Y%*365 + Y%DIV4 - Y%DIV100 + Y%DIV400 - 678882
DEF FNDOW(J%) = (J%+2400002) MOD 7
DEF FNDIM(M%,Y%)
CASE M% OF
WHEN 2: = 28 - (Y%MOD4=0) + (Y%MOD100=0) - (Y%MOD400=0)
WHEN 4,6,9,11: = 30
OTHERWISE = 31
ENDCASE</lang>
Output:
[SNOOPY]
1969
JANUARY FEBRUARY MARCH APRIL MAY JUNE
SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA
1 2 3 4 1 1 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7
5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14
12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21
19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28
26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 27 28 29 30 25 26 27 28 29 30 31 29 30
30 31
JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER
SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA
1 2 3 4 5 1 2 1 2 3 4 5 6 1 2 3 4 1 1 2 3 4 5 6
6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13
13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20
20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27
27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31
31 30
GUISS
In Graphical User Interface Support Script, we utilize applications that are already written. So for this task, we shall just display the calendar that sets the system clock.
<lang guiss>RIGHTCLICK:CLOCK,ADJUST DATE AND TIME,BUTTON:CANCEL</lang>
Icon and Unicon
Icon and Unicon don't lend themselves to REAL programming in the sense of this task easily. And initially this task was marked omit because the primary declarations, reserved words, and the name of the main procedure are all in lowercase. However, getting in the spirit of the task real programmers do not give up and a number of solutions are possible:
- A real programmer could write a preprocessor to eliminate lower case or insert before translation the one unreal line needed to realize this solution
- An uber-real programmer would rewrite the entire translator
- Or, a real programmer could do what's presented below on a coffee break with the preprocessor
In the example,
- we must concede lowercase letters for the preprocessor directive $include (although as noted a preprocessor could handle this)
- we temporarily concede the lowercase letters needed to realize the IPL procedures IsLeapYear and julian; however, a real programmer could easily rewrite these in a more real format (or an uber-real programmer would just rewrite the IPL
- the character set usage has been reduced from 69 unique characters to 51 (within 6 bit character representations) by the following tactics:
- elimination of # and all comments as real programmers don't need them
- use of preprocessor definitions to eliminate the need for {[]}
- use of char (excuse me CHAR) to generate characters such as "\n"
- elimination of tabs for blanks
Now clearly all of these measures will make the storage, interpretation, and comprehension of this program more real and efficient for real programmers like us.
Oh, dear. It seems I have written documentation to explain what I have done. Tisk. Tisk. Someone come take my real programmer epaulettes away. And, you! Since you've read this you must surrender your stripes too.
Also it makes me go all nostalgic for my old WATFIVE compiler. And an IBM 129 keypunch. And 5 hole paper tape.
<lang Unicon>$include "REALIZE.ICN"
LINK DATETIME $define ISLEAPYEAR IsLeapYear $define JULIAN julian
PROCEDURE MAIN(A) PRINTCALENDAR(\A$<1$>|1969) END
PROCEDURE PRINTCALENDAR(YEAR)
COLS := 3
MONS := $<$>
"JANUARY FEBRUARY MARCH APRIL MAY JUNE " ||
"JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER " ?
WHILE PUT(MONS, TAB(FIND(" "))) DO MOVE(1)
WRITE(CENTER("$<SNOOPY PICTURE$>",COLS * 24 + 4))
WRITE(CENTER(YEAR,COLS * 24 + 4), CHAR(10))
M := LIST(COLS)
EVERY MON := 0 TO 9 BY COLS DO $(
WRITES(" ")
EVERY I := 1 TO COLS DO {
WRITES(CENTER(MONS$<MON+I$>,24))
M$<I$> := CREATE CALENDARFORMATWEEK(1969,MON + I)
$)
WRITE()
EVERY 1 TO 7 DO $(
EVERY C := 1 TO COLS DO $(
WRITES(" ")
EVERY 1 TO 7 DO WRITES(RIGHT(@M$<C$>,3))
$)
WRITE()
$)
$)
END
PROCEDURE CALENDARFORMATWEEK(YEAR,M) STATIC D INITIAL D := $<31,28,31,30,31,30,31,31,30,31,30,31$>
EVERY SUSPEND "SU"|"MO"|"TU"|"WE"|"TH"|"FR"|"SA" EVERY 1 TO (DAY := (JULIAN(M,1,YEAR)+1)%7) DO SUSPEND "" EVERY SUSPEND 1 TO D$<M$> DO DAY +:= 1 IF M = 2 & ISLEAPYEAR(YEAR) THEN SUSPEND (DAY +:= 1, 29) EVERY DAY TO (6*7) DO SUSPEND "" END</lang>
Where REALIZE.ICN would be something like this (this example is incomplete but sufficient for this program):
<lang Icon>$define PROCEDURE procedure $define END end $define WRITE write $define WRITES writes $define SUSPEND suspend $define DO do $define TO to $define EVERY every $define LIST list $define WHILE while $define MAIN main $define PUT put $define TAB tab $define MOVE move $define CHAR move $define CENTER center $define RIGHT right $define FIND find $define STATIC static $define INITIAL initial $define CREATE create $define LINK link $define IF if $define THEN then $define BY by</lang>
DATETIME.ICN provides IsLeapYear and julian
J
For added "real"ness, we also only use 1 character names:
<lang J>B=: + 4 100 400 -/@:<.@:%~ <: M=: 28+ 3, (10$5$3 2),~ 0 ~:/@:= 4 100 400 | ] R=: (7 -@| B+ 0, +/\@}:@M) |."0 1 (0,#\#~41) (]&:>: *"1 >/)~ M H=. _3(_11&{.)\'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC' H=. 'SU MO TU WE TH FR SA',:"1~H C=: H <@,"(2) 12 6 21 }."1@($,) (' ',3 ":,.#\#~31) {~ R D=: 0 ": -@<.@%&21@+&1@[ ]\ C@] L=: |."0 1~ +/ .(*./\@:=)"1&' ' E=: (|."0 1~ _2 <.@%~ +/ .(*./\.@:=)"1&' ')@:({."1) L F=: 0 _1 }. 0 1 }. (2+[) E '[INSERT SNOOPY HERE]', ":@], D</lang>
B: given a year returns a number which when added to numeric values indexing days that year, mod 7, index the proper day names within a week. (In other words 7 | 0 + B 1969 gives the day of week index for the first day of 1969.)
M: given a year return a list of 12 numbers representing the number of days in each month
R: given a year, return 12 rows of 42 numbers, each row representing days of the month framed in a six week period which will be used to display that month (0 for days that are not part of that month)
H: text that will be the header for each month's block of days
C: A calendar of 12 months (in a flat list, each month is structured text but there's no higher level formatting)
D: given a number of characters (at least 20) and a year, gives the calendar arranged in rows that will best fill that character width without exceeding it.
L: given a textual table (fixed with character columns), left justify it
E: given a textual table and a width, center the text within that width (assuming it fits)
F: width F year gives us our formatted calendar
Here's an example calendar (the first line 132 F 1969 being the command that build this calendar):
<lang> 132 F 1969
[INSERT SNOOPY HERE]
1969
┌────────────────────┬────────────────────┬────────────────────┬────────────────────┬────────────────────┬────────────────────┐
│ JAN │ FEB │ MAR │ APR │ MAY │ JUN │
│SU MO TU WE TH FR SA│SU MO TU WE TH FR SA│SU MO TU WE TH FR SA│SU MO TU WE TH FR SA│SU MO TU WE TH FR SA│SU MO TU WE TH FR SA│
│ 1 2 3 4│ 1│ 1│ 1 2 3 4 5│ 1 2 3│ 1 2 3 4 5 6 7│
│ 5 6 7 8 9 10 11│ 2 3 4 5 6 7 8│ 2 3 4 5 6 7 8│ 6 7 8 9 10 11 12│ 4 5 6 7 8 9 10│ 8 9 10 11 12 13 14│
│12 13 14 15 16 17 18│ 9 10 11 12 13 14 15│ 9 10 11 12 13 14 15│13 14 15 16 17 18 19│11 12 13 14 15 16 17│15 16 17 18 19 20 21│
│19 20 21 22 23 24 25│16 17 18 19 20 21 22│16 17 18 19 20 21 22│20 21 22 23 24 25 26│18 19 20 21 22 23 24│22 23 24 25 26 27 28│
│26 27 28 29 30 31 │23 24 25 26 27 28 │23 24 25 26 27 28 29│27 28 29 30 │25 26 27 28 29 30 31│29 30 │
│ │ │30 31 │ │ │ │
├────────────────────┼────────────────────┼────────────────────┼────────────────────┼────────────────────┼────────────────────┤
│ JUL │ AUG │ SEP │ OCT │ NOV │ DEC │
│SU MO TU WE TH FR SA│SU MO TU WE TH FR SA│SU MO TU WE TH FR SA│SU MO TU WE TH FR SA│SU MO TU WE TH FR SA│SU MO TU WE TH FR SA│
│ 1 2 3 4 5│ 1 2│ 1 2 3 4 5 6│ 1 2 3 4│ 1│ 1 2 3 4 5 6│
│ 6 7 8 9 10 11 12│ 3 4 5 6 7 8 9│ 7 8 9 10 11 12 13│ 5 6 7 8 9 10 11│ 2 3 4 5 6 7 8│ 7 8 9 10 11 12 13│
│13 14 15 16 17 18 19│10 11 12 13 14 15 16│14 15 16 17 18 19 20│12 13 14 15 16 17 18│ 9 10 11 12 13 14 15│14 15 16 17 18 19 20│
│20 21 22 23 24 25 26│17 18 19 20 21 22 23│21 22 23 24 25 26 27│19 20 21 22 23 24 25│16 17 18 19 20 21 22│21 22 23 24 25 26 27│
│27 28 29 30 31 │24 25 26 27 28 29 30│28 29 30 │26 27 28 29 30 31 │23 24 25 26 27 28 29│28 29 30 31 │
│ │31 │ │ │30 │ │
└────────────────────┴────────────────────┴────────────────────┴────────────────────┴────────────────────┴────────────────────┘
</lang>
Note that this version will display properly in a width of 20.
Perl
Since we can't use eval or print (or any other keywords) at the top level, we need to abuse backticks in order to print anything, as in the infamous JAPH with no letters or numbers. Consequently, the calendar is printed to standard error instead of standard output.
<lang perl>$PROGRAM = '\'
MY @START_DOW = (3, 6, 6, 2, 4, 0,
2, 5, 1, 3, 6, 1);
MY @DAYS = (31, 28, 31, 30, 31, 30,
31, 31, 30, 31, 30, 31);
MY @MONTHS; FOREACH MY $M (0 .. 11) {
FOREACH MY $R (0 .. 5) {
$MONTHS[$M][$R] = JOIN " ",
MAP { $_ < 1 || $_ > $DAYS[$M] ? " " : SPRINTF "%2D", $_ }
MAP { $_ - $START_DOW[$M] + 1 }
$R * 7 .. $R * 7 + 6;
}
}
SUB P { WARN $_[0], "\\N" } P UC " [INSERT SNOOPY HERE]"; P " 1969"; P ""; FOREACH (UC(" JANUARY FEBRUARY MARCH APRIL MAY JUNE"),
UC(" JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER")) {
P $_;
MY @MS = SPLICE @MONTHS, 0, 6;
P JOIN " ", ((UC "SU MO TU WE TH FR SA") X 6);
P JOIN " ", MAP { SHIFT @$_ } @MS FOREACH 0 .. 5;
}
\;
- LOWERCASE LETTERS
$E = '%' | '@'; $C = '#' | '@'; $H = '(' | '@'; $O = '/' | '@'; $T = '4' | '@'; $R = '2' | '@'; $A = '!' | '@'; $Z = ':' | '@'; $P = '0' | '@'; $L = ',' | '@';
`${E}${C}${H}${O} $PROGRAM | ${T}${R} A-Z ${A}-${Z} | ${P}${E}${R}${L}`;</lang> Although, if we are abusing the backticks and other innocent programs, why not just: <lang Perl>$_=$ARGV[0]//1969;`\143\141\154 $_ >&2`</lang>
Perl 6
Uppercase is no challenge, who needs letters at all?
[Requires the year to be supplied as a command-line argument, Snoopy to be available in snoopy.txt, and Unixish cat and cal commands.] <lang perl6>$_=["\0"..."~"];< 114 117 110 32 34 99 97 116 32 115 110 111 111 112 121 46 116 120 116 59 99 97 108 32 64 42 65 82 71 83 91 48 93 34 >."$_[99]$_[104]$_[114]$_[115]"()."$_[101]$_[118]$_[97]$_[108]"()</lang>
PicoLisp
The "CALENDAR.L" source file: <lang PicoLisp>(DE CAL (YEAR)
(PRINL "====== " YEAR " ======")
(FOR DAT (RANGE (DATE YEAR 1 1) (DATE YEAR 12 31))
(LET D (DATE DAT)
(TAB (3 3 4 8)
(WHEN (= 1 (CADDR D))
(GET `(INTERN (PACK (MAPCAR CHAR (42 77 111 110)))) (CADR D)) )
(CADDR D)
(DAY DAT `(INTERN (PACK (MAPCAR CHAR (42 68 97 121)))))
(WHEN (=0 (% (INC DAT) 7))
(PACK (CHAR 87) "EEk " (WEEK DAT)) ) ) ) ) )
(CAL 1969) (BYE)</lang> Then it can be executed with this command line:
$ pil -'load (list "awk" "{print tolower($0)}" "CALENDAR.L")'
Output:
====== 1969 ======
Jan 1 Wed
2 Thu
3 Fri
4 Sat
5 Sun
6 Mon Week 2
7 Tue
....
28 Sat
29 Sun
30 Mon Week 27
Jul 1 Tue
2 Wed
3 Thu
4 Fri
....
25 Thu
26 Fri
27 Sat
28 Sun
29 Mon Week 53
30 Tue
31 Wed
PHP
While PHP functions are case-sensitive (aside of _()), this isn't the case for language constructs.
<lang php><?PHP ECHO <<<REALPROGRAMMERSTHINKINUPPERCASEANDCHEATBYUSINGPRINT
JANUARY FEBRUARY MARCH APRIL MAY JUNE
MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO
1 2 3 4 5 1 2 1 2 1 2 3 4 5 6 1 2 3 4 1
6 7 8 9 10 11 12 3 4 5 6 7 8 9 3 4 5 6 7 8 9 7 8 9 10 11 12 13 5 6 7 8 9 10 11 2 3 4 5 6 7 8
13 14 15 16 17 18 19 10 11 12 13 14 15 16 10 11 12 13 14 15 16 14 15 16 17 18 19 20 12 13 14 15 16 17 18 9 10 11 12 13 14 15
20 21 22 23 24 25 26 17 18 19 20 21 22 23 17 18 19 20 21 22 23 21 22 23 24 25 26 27 19 20 21 22 23 24 25 16 17 18 19 20 21 22
27 28 29 30 31 24 25 26 27 28 24 25 26 27 28 29 30 28 29 30 26 27 28 29 30 31 23 24 25 26 27 28 29
31 30
JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER
MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO MO TU WE TH FR SA SO
1 2 3 4 5 6 1 2 3 1 2 3 4 5 6 7 1 2 3 4 5 1 2 1 2 3 4 5 6 7
7 8 9 10 11 12 13 4 5 6 7 8 9 10 8 9 10 11 12 13 14 6 7 8 9 10 11 12 3 4 5 6 7 8 9 8 9 10 11 12 13 14
14 15 16 17 18 19 20 11 12 13 14 15 16 17 15 16 17 18 19 20 21 13 14 15 16 17 18 19 10 11 12 13 14 15 16 15 16 17 18 19 20 21
21 22 23 24 25 26 27 18 19 20 21 22 23 24 22 23 24 25 26 27 28 20 21 22 23 24 25 26 17 18 19 20 21 22 23 22 23 24 25 26 27 28
28 29 30 31 25 26 27 28 29 30 31 29 30 27 28 29 30 31 24 25 26 27 28 29 30 29 30 31
REALPROGRAMMERSTHINKINUPPERCASEANDCHEATBYUSINGPRINT
; // MAGICAL SEMICOLON</lang>
REXX
This is essentially the same REXX program as for the CALENDAR task, but written entirely in uppercase. Indeed,
it could be written without any Latin (or any language) letters of any kind for the REXX program's variables.
From the task's description, I took it to mean the program was to be in all uppercase, but the output was
still supposed to look pretty (that is, partly in lowercase). Even so, on the (line) printers that were used
long ago, the printers (if not supporting lowercase), would print lowercase as uppercase (with the FOLD option).
The other REXX program made use of lowercase letters for determining the minimum length of any of the options
(from the command line), and a few simple tricks were used to accomplish this.
[Note: the command line may also be all uppercase.]
In any case, both versions of the programs' output are identical (but the second REXX version sure as heck looks
like it was beat with a big ole ugly stick ─── and pardon the strong language).
<lang rexx>/*REXX PROGRAM TO SHOW ANY YEAR'S (MONTHLY) CALENDAR (WITH/WITHOUT GRID)*/
@ABC=
DO J=0 TO 255;_=D2C(J);IF DATATYPE(_,'L') THEN @ABC=@ABC||_;END
@ABCU=@ABC; UPPER @ABCU
DAYS_='SUNDAY MONDAY TUESDAY WEDNESDAY THURSDAY FRIDAY SATURDAY'
MONTHS_='JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER'
DAYS=; MONTHS=
DO J=1 FOR 7
_=LOWER(WORD(DAYS_,J))
DAYS=DAYS TRANSLATE(LEFT(_,1))SUBSTR(_,2)
END
DO J=1 FOR 12
_=LOWER(WORD(MONTHS_,J))
MONTHS=MONTHS TRANSLATE(LEFT(_,1))SUBSTR(_,2)
END
CALFILL=' '; MC=12; _='1 3 1234567890' "FB"X PARSE VAR _ GRID CALSPACES # CHK . CV_ DAYS.1 DAYS.2 DAYS.3 DAYSN SD SW _=0; PARSE VAR _ COLS 1 JD 1 LOWERCASE 1 MAXKALPUTS 1 NARROW 1,
NARROWER 1 NARROWEST 1 SHORT 1 SHORTER 1 SHORTEST 1,
SMALL 1 SMALLER 1 SMALLEST 1 UPPERCASE
PARSE ARG MM '/' DD "/" YYYY _ '(' OPS; UOPS=OPS IF _\== | \IS#(MM) | \IS#(DD) | \IS#(YYYY) THEN CALL ERX 86
@CALMONTHS ='CALMON' || LOWER('THS') @CALSPACES ='CALSP' || LOWER('ACES') @DEPTH ='DEP' || LOWER('TH') @GRIDS ='GRID' || LOWER('S') @LOWERCASE ='LOW' || LOWER('ERCASE') @NARROW ='NAR' || LOWER('ROW') @NARROWER ='NARROWER' @NARROWEST ='NARROWES' || LOWER('T') @SHORT ='SHOR' || LOWER('T') @SHORTER ='SHORTER' @SHORTEST ='SHORTES' || LOWER('T') @UPPERCASE ='UPP' || LOWER('ERCASE') @WIDTH ='WID' || LOWER('TH')
DO WHILE OPS\==; OPS=STRIP(OPS,'L'); PARSE VAR OPS _1 2 1 _ . 1 _O OPS
UPPER _
SELECT
WHEN ABB(@CALMONTHS) THEN MC=NAI()
WHEN ABB(@CALSPACES) THEN CALSPACES=NAI()
WHEN ABB(@DEPTH) THEN SD=NAI()
WHEN ABBN(@GRIDS) THEN GRID=NO()
WHEN ABBN(@LOWERCASE) THEN LOWERCASE=NO()
WHEN ABBN(@NARROW) THEN NARROW=NO()
WHEN ABBN(@NARROWER) THEN NARROWER=NO()
WHEN ABBN(@NARROWEST) THEN NARROWEST=NO()
WHEN ABBN(@SHORT) THEN SHORT=NO()
WHEN ABBN(@SHORTER) THEN SHORTER=NO()
WHEN ABBN(@SHORTEST) THEN SHORTEST=NO()
WHEN ABBN(@SMALL) THEN SMALL=NO()
WHEN ABBN(@SMALLER) THEN SMALLER=NO()
WHEN ABBN(@SMALLEST) THEN SMALLEST=NO()
WHEN ABBN(@UPPERCASE) THEN UPPERCASE=NO()
WHEN ABB(@WIDTH) THEN SW=NAI()
OTHERWISE NOP
END /*SELECT*/
END /*DO WHILE OPTS\== ...*/
MC=INT(MC,'MONTHSCALENDER'); IF MC>0 THEN CAL=1 DAYS=' 'DAYS; MONTHS=' 'MONTHS CYYYY=RIGHT(DATE(),4); HYY=LEFT(CYYYY,2); LYY=RIGHT(CYYYY,2) DY.=31; _=30; PARSE VAR _ DY.4 1 DY.6 1 DY.9 1 DY.11; DY.2=28+LY(YYYY) YY=RIGHT(YYYY,2); SD=P(SD 43); SW=P(SW 80); CW=10; CINDENT=1; CALWIDTH=76 IF SMALL THEN DO; NARROW=1 ; SHORT=1 ; END IF SMALLER THEN DO; NARROWER=1 ; SHORTER=1 ; END IF SMALLEST THEN DO; NARROWEST=1; SHORTEST=1; END IF SHORTEST THEN SHORTER=1 IF SHORTER THEN SHORT =1 IF NARROW THEN DO; CW=9; CINDENT=3; CALWIDTH=69; END IF NARROWER THEN DO; CW=4; CINDENT=1; CALWIDTH=34; END IF NARROWEST THEN DO; CW=2; CINDENT=1; CALWIDTH=20; END CV_=CALWIDTH+CALSPACES+2 CALFILL=LEFT(COPIES(CALFILL,CW),CW)
DO J=1 FOR 7; _=WORD(DAYS,J)
DO JW=1 FOR 3; _D=STRIP(SUBSTR(_,CW*JW-CW+1,CW))
IF JW=1 THEN _D=CENTRE(_D,CW+1)
ELSE _D=LEFT(_D,CW+1)
DAYS.JW=DAYS.JW||_D
END /*JW*/
__=DAYSN
IF NARROWER THEN DAYSN=__||CENTRE(LEFT(_,3),5)
IF NARROWEST THEN DAYSN=__||CENTER(LEFT(_,2),3)
END /*J*/
_YYYY=YYYY; CALPUTS=0; CV=1; _MM=MM+0; MONTH=WORD(MONTHS,MM) DY.2=28+LY(_YYYY); DIM=DY._MM; _DD=01; DOW=DOW(_MM,_DD,_YYYY); $DD=DD+0
/*─────────────────────────────NOW: THE BUSINESS OF THE BUILDING THE CAL*/ CALL CALGEN
DO _J=2 TO MC
IF CV_\== THEN DO
CV=CV+CV_
IF CV+CV_>=SW THEN DO; CV=1; CALL CALPUT
CALL FCALPUTS;CALL CALPB
END
ELSE CALPUTS=0
END
ELSE DO;CALL CALPB;CALL CALPUT;CALL FCALPUTS;END
_MM=_MM+1; IF _MM==13 THEN DO; _MM=1; _YYYY=_YYYY+1; END
MONTH=WORD(MONTHS,_MM); DY.2=28+LY(_YYYY); DIM=DY._MM
DOW=DOW(_MM,_DD,_YYYY); $DD=0; CALL CALGEN
END /*_J*/
CALL FCALPUTS RETURN _
/*─────────────────────────────CALGEN SUBROUTINE────────────────────────*/ CALGEN: CELLX=;CELLJ=;CELLM=;CALCELLS=0;CALLINE=0 CALL CALPUT CALL CALPUTL COPIES('─',CALWIDTH),"┌┐"; CALL CALHD CALL CALPUTL MONTH ' ' _YYYY ; CALL CALHD IF NARROWEST | NARROWER THEN CALL CALPUTL DAYSN
ELSE DO JW=1 FOR 3
IF SPACE(DAYS.JW)\== THEN CALL CALPUTL DAYS.JW
END
CALFT=1; CALFB=0
DO JF=1 FOR DOW-1; CALL CELLDRAW CALFILL,CALFILL; END DO JY=1 FOR DIM; CALL CELLDRAW JY; END
CALFB=1
DO 7; CALL CELLDRAW CALFILL,CALFILL; END
IF SD>32 & \SHORTER THEN CALL CALPUT RETURN
/*─────────────────────────────CELLDRAW SUBROUTINE──────────────────────*/ CELLDRAW: PARSE ARG ZZ,CDDOY;ZZ=RIGHT(ZZ,2);CALCELLS=CALCELLS+1 IF CALCELLS>7 THEN DO
CALLINE=CALLINE+1
CELLX=SUBSTR(CELLX,2)
CELLJ=SUBSTR(CELLJ,2)
CELLM=SUBSTR(CELLM,2)
CELLB=TRANSLATE(CELLX,,")(─-"#)
IF CALLINE==1 THEN CALL CX
CALL CALCSM; CALL CALPUTL CELLX; CALL CALCSJ; CALL CX
CELLX=; CELLJ=; CELLM=; CALCELLS=1
END
CDDOY=RIGHT(CDDOY,CW); CELLM=CELLM'│'CENTER(,CW) CELLX=CELLX'│'CENTRE(ZZ,CW); CELLJ=CELLJ'│'CENTER(,CW) RETURN
/*═════════════════════════════GENERAL 1-LINE SUBS══════════════════════*/ ABB:ARG ABBU;PARSE ARG ABB;RETURN ABBREV(ABBU,_,ABBL(ABB)) ABBL:RETURN VERIFY(ARG(1)LEFT(@ABC,1),@ABC,'M')-1 ABBN:PARSE ARG ABBN;RETURN ABB(ABBN)|ABB('NO'ABBN) CALCSJ:IF SD>49&\SHORTER THEN CALL CALPUTL CELLB;IF SD>24&\SHORT THEN CALL CALPUTL CELLJ; RETURN CALCSM:IF SD>24&\SHORT THEN CALL CALPUTL CELLM;IF SD>49&\SHORTER THEN CALL CALPUTL CELLB;RETURN CALHD:IF SD>24&\SHORTER THEN CALL CALPUTL;IF SD>32&\SHORTEST THEN CALL CALPUTL;RETURN CALPB:IF \GRID&SHORTEST THEN CALL PUT CHK;RETURN CALPUT:CALPUTS=CALPUTS+1;MAXKALPUTS=MAX(MAXKALPUTS,CALPUTS);IF SYMBOL('CT.'CALPUTS)\=='VAR' THEN CT.CALPUTS=;CT.CALPUTS=OVERLAY(ARG(1),CT.CALPUTS,CV);RETURN CALPUTL:CALL CALPUT COPIES(' ',CINDENT)LEFT(ARG(2)"│",1)CENTER(ARG(1),CALWIDTH)||RIGHT('│'ARG(2),1);RETURN CX:CX_='├┤';CX=COPIES(COPIES('─',CW)'┼',7);IF CALFT THEN DO;CX=TRANSLATE(CX,'┬',"┼");CALFT=0;END;IF CALFB THEN DO;CX=TRANSLATE(CX,'┴',"┼");CX_='└┘';CALFB=0;END;CALL CALPUTL CX,CX_;RETURN DOW:PROCEDURE;ARG M,D,Y;IF M<3 THEN DO;M=M+12;Y=Y-1;END;YL=LEFT(Y,2);YR=RIGHT(Y,2);W=(D+(M+1)*26%10+YR+YR%4+YL%4+5*YL)//7;IF W==0 THEN W=7;RETURN W ER:PARSE ARG _1,_2;CALL '$ERR' "14"P(_1) P(WORD(_1,2) !FID(1)) _2;IF _1<0 THEN RETURN _1;EXIT RESULT ERR:CALL ER '-'ARG(1),ARG(2);RETURN ERX:CALL ER '-'ARG(1),ARG(2);EXIT FCALPUTS: DO J=1 FOR MAXKALPUTS;CALL PUT CT.J;END;CT.=;MAXKALPUTS=0;CALPUTS=0;RETURN INT:INT=NUMX(ARG(1),ARG(2));IF \ISINT(INT) THEN CALL ERX 92,ARG(1) ARG(2);RETURN INT/1 IS#:RETURN VERIFY(ARG(1),#)==0 ISINT:RETURN DATATYPE(ARG(1),'W') LOWER:RETURN TRANSLATE(ARG(1),@ABC,@ABCU) LY:ARG _;IF LENGTH(_)==2 THEN _=HYY||_;LY=_//4==0;IF LY==0 THEN RETURN 0;LY=((_//100\==0)|_//400==0);RETURN LY NA:IF ARG(1)\== THEN CALL ERX 01,ARG(2);PARSE VAR OPS NA OPS;IF NA== THEN CALL ERX 35,_O;RETURN NA NAI:RETURN INT(NA(),_O) NAN:RETURN NUMX(NA(),_O) NO:IF ARG(1)\== THEN CALL ERX 01,ARG(2);RETURN LEFT(_,2)\=='NO' NUM:PROCEDURE;PARSE ARG X .,F,Q;IF X== THEN RETURN X;IF DATATYPE(X,'N') THEN RETURN X/1;X=SPACE(TRANSLATE(X,,','),0);IF DATATYPE(X,'N') THEN RETURN X/1;RETURN NUMNOT() NUMNOT:IF Q==1 THEN RETURN X;IF Q== THEN CALL ER 53,X F;CALL ERX 53,X F NUMX:RETURN NUM(ARG(1),ARG(2),1) P:RETURN WORD(ARG(1),1) PUT:_=ARG(1);_=TRANSLATE(_,,'_'CHK);IF \GRID THEN _=UNGRID(_);IF LOWERCASE THEN _=LOWER(_);IF UPPERCASE THEN UPPER _;IF SHORTEST&_=' ' THEN RETURN;CALL TELL _;RETURN TELL:SAY ARG(1);RETURN UNGRID:RETURN TRANSLATE(ARG(1),,"│║─═┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣")</lang> output when using the input of: 1/1/1969 (noGrid shortest narrowest)
«Snoopy "picture" here»
January 1969 February 1969 March 1969
Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa
1 2 3 4 1 1
5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8
12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15
19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22
26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29
30 31
April 1969 May 1969 June 1969
Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa
1 2 3 4 5 1 2 3 1 2 3 4 5 6 7
6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14
13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21
20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28
27 28 29 30 25 26 27 28 29 30 31 29 30
July 1969 August 1969 September 1969
Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa
1 2 3 4 5 1 2 1 2 3 4 5 6
6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13
13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20
20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27
27 28 29 30 31 24 25 26 27 28 29 30 28 29 30
31
October 1969 November 1969 December 1969
Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa
1 2 3 4 1 1 2 3 4 5 6
5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13
12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20
19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27
26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31
30
Ruby
UPPERCASE RUBY is normally impossible, because Ruby is sensitive to case, and most methods and keywords have lowercase letters. To solve this task, we wrote a new program loader for UPPERCASE RUBY programs.
Our program loader responds to unknown method calls by calling their lowercase equivalents, so Kernel#PUTS acts like Kernel#puts. Our program loader also defines Object#RESCUE to replace the 'rescue' keyword. We can now write UPPERCASE RUBY programs that call uppercase methods and use no lowercase keywords.
loadup.rbis the program loader.
<lang ruby># loadup.rb - run UPPERCASE RUBY program
class Object
alias lowercase_method_missing method_missing
# Allow UPPERCASE method calls.
def method_missing(sym, *args, &block)
str = sym.to_s
if str == (down = str.downcase)
lowercase_method_missing sym, *args, &block
else
send down, *args, &block
end
end
# RESCUE an exception without the 'rescue' keyword.
def RESCUE(_BEGIN, _CLASS, _RESCUE)
begin _BEGIN.CALL
rescue _CLASS
_RESCUE.CALL; end
end
end
_PROGRAM = ARGV.SHIFT _PROGRAM || ABORT("USAGE: #{$0} PROGRAM.RB ARGS...") LOAD($0 = _PROGRAM)</lang>
CAL.RBis an UPPERCASE RUBY translation of Calendar#Ruby.
<lang ruby># CAL.RB - CALENDAR REQUIRE 'DATE'.DOWNCASE
- FIND CLASSES.
OBJECT = [].CLASS.SUPERCLASS DATE = OBJECT.CONST_GET('DATE'.DOWNCASE.CAPITALIZE)
- CREATES A CALENDAR OF _YEAR_. RETURNS THIS CALENDAR AS A MULTI-LINE
- STRING FIT TO _COLUMNS_.
OBJECT.SEND(:DEFINE_METHOD, :CAL) {|_YEAR, _COLUMNS|
# START AT JANUARY 1. # # DATE::ENGLAND MARKS THE SWITCH FROM JULIAN CALENDAR TO GREGORIAN # CALENDAR AT 1752 SEPTEMBER 14. THIS REMOVES SEPTEMBER 3 TO 13 FROM # YEAR 1752. (BY FORTUNE, IT KEEPS JANUARY 1.) # _DATE = DATE.NEW(_YEAR, 1, 1, DATE::ENGLAND)
# COLLECT CALENDARS OF ALL 12 MONTHS.
_MONTHS = (1..12).COLLECT {|_MONTH|
_ROWS = [DATE::MONTHNAMES[_MONTH].UPCASE.CENTER(20),
"SU MO TU WE TH FR SA"]
# MAKE ARRAY OF 42 DAYS, STARTING WITH SUNDAY.
_DAYS = []
_DATE.WDAY.TIMES { _DAYS.PUSH " " }
CATCH(:BREAK) {
LOOP {
(_DATE.MONTH == _MONTH) || THROW(:BREAK)
_DAYS.PUSH("%2D".DOWNCASE % _DATE.MDAY)
_DATE += 1 }}
(42 - _DAYS.LENGTH).TIMES { _DAYS.PUSH " " }
_DAYS.EACH_SLICE(7) {|_WEEK| _ROWS.PUSH(_WEEK.JOIN " ") }
_ROWS }
# CALCULATE MONTHS PER ROW (MPR). # 1. DIVIDE COLUMNS BY 22 COLUMNS PER MONTH, ROUNDED DOWN. (PRETEND # TO HAVE 2 EXTRA COLUMNS; LAST MONTH USES ONLY 20 COLUMNS.) # 2. DECREASE MPR IF 12 MONTHS WOULD FIT IN THE SAME MONTHS PER # COLUMN (MPC). FOR EXAMPLE, IF WE CAN FIT 5 MPR AND 3 MPC, THEN # WE USE 4 MPR AND 3 MPC. _MPR = (_COLUMNS + 2).DIV 22 _MPR = 12.DIV((12 + _MPR - 1).DIV _MPR)
# USE 20 COLUMNS PER MONTH + 2 SPACES BETWEEN MONTHS. _WIDTH = _MPR * 22 - 2
# JOIN MONTHS INTO CALENDAR.
_ROWS = ["[SNOOPY]".CENTER(_WIDTH), "#{_YEAR}".CENTER(_WIDTH)]
_MONTHS.EACH_SLICE(_MPR) {|_SLICE|
_SLICE[0].EACH_INDEX {|_I|
_ROWS.PUSH(_SLICE.MAP {|_A| _A[_I]}.JOIN " ") }}
_ROWS.JOIN("\012") }
(ARGV.LENGTH == 1) || ABORT("USAGE: #{$0} YEAR")
- GUESS WIDTH OF TERMINAL.
- 1. OBEY ENVIRONMENT VARIABLE COLUMNS.
- 2. TRY TO REQUIRE 'IO/CONSOLE' FROM RUBY 1.9.3.
- 3. TRY TO RUN `TPUT CO`.
- 4. ASSUME 80 COLUMNS.
LOADERROR = OBJECT.CONST_GET('LOAD'.DOWNCASE.CAPITALIZE +
'ERROR'.DOWNCASE.CAPITALIZE)
STANDARDERROR = OBJECT.CONST_GET('STANDARD'.DOWNCASE.CAPITALIZE +
'ERROR'.DOWNCASE.CAPITALIZE)
_INTEGER = 'INTEGER'.DOWNCASE.CAPITALIZE _TPUT_CO = 'TPUT CO'.DOWNCASE _COLUMNS = RESCUE(PROC {SEND(_INTEGER, ENV["COLUMNS"] || "")},
STANDARDERROR,
PROC {
RESCUE(PROC {
REQUIRE 'IO/CONSOLE'.DOWNCASE
IO.CONSOLE.WINSIZE[1]
}, LOADERROR,
PROC {
RESCUE(PROC {
SEND(_INTEGER, `#{_TPUT_CO}`)
}, STANDARDERROR,
PROC {80}) }) })
PUTS CAL(ARGV[0].TO_I, _COLUMNS)</lang>
- A local variable must start with a lowercase letter or an underscore, so we have many leading underscores (_YEAR, _COLUMN, _DATE and so on).
- We form blocks with curly braces
{ ... }, never with lowercase keywordsdo ... end. OBJECT = [].CLASS.SUPERCLASSfinds the superclass of the class of the empty array; this is theObjectclass! Class#CONST_GET finds some other classes.- Class#DEFINE_METHOD defines a new method, Object#CAL, without a
defkeyword. - Kernel#LOOP, Kernel#THROW, Kernel#CATCH and operator
||act like a while loop without awhilekeyword.
$ ruby loadup.rb CAL.RB 1969
[SNOOPY]
1969
JANUARY FEBRUARY MARCH APRIL MAY JUNE
SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA
1 2 3 4 1 1 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7
5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14
12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21
19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28
26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 27 28 29 30 25 26 27 28 29 30 31 29 30
30 31
JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER
SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA
1 2 3 4 5 1 2 1 2 3 4 5 6 1 2 3 4 1 1 2 3 4 5 6
6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13
13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20
20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27
27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31
31 30 Tcl
The program starts implementing aliases for all built-in commands. This is done without using any letters at all ;). CALENDER takes arguments of year and optional terminal width to use. <lang tcl> \146\157\162\145\141\143\150 42 [\151\156\146\157 \143\157\155\155\141\156\144\163] { \145\166\141\154 " \160\162\157\143 [\163\164\162\151\156\147 \164\157\165\160\160\145\162 $42] {\141\162\147\163} \{ \163\145\164 \151 1 \146\157\162\145\141\143\150 \141 \$\141\162\147\163 \{ \151\146 \[\163\164\162\151\156\147 \155\141\164\143\150 _ \$\141\] \{\151\156\143\162 \151; \143\157\156\164\151\156\165\145\} \151\146 \$\151%2 \{\154\141\160\160\145\156\144 \156\141\162\147\163 \[\163\164\162\151\156\147 \164\157\154\157\167\145\162 \$\141\]\} \{\154\141\160\160\145\156\144 \156\141\162\147\163 \$\141\} \} \165\160\154\145\166\145\154 \"$42 \$\156\141\162\147\163\" \} " }
PROC _ CPUTS {L S} { UPVAR _ CAL CAL APPEND _ CAL($L) $S } PROC _ CENTER {S LN} { SET _ C [STRING LENGTH $S] SET _ L [EXPR _ ($LN-$C)/2]; SET _ R [EXPR _ $LN-$L-$C] FORMAT "%${L}S%${C}S%${R}S" _ "" $S "" } PROC _ CALENDAR {{YEAR 1969} {WIDTH 80}} { ARRAY SET CAL "" SET _ YRS [EXPR $YEAR-1584] SET _ SDAY [EXPR (6+$YRS+(($YRS+3)/4)-(($YRS-17)/100+1)+(($YRS+383)/400))%7] CPUTS 0 [CENTER "(SNOOPY)" [EXPR $WIDTH/25*25]]; CPUTS 1 "" CPUTS 2 [CENTER "--- $YEAR ---" [EXPR $WIDTH/25*25]]; CPUTS 3 "" FOR _ {SET _ NR 0} {$NR<=11} {INCR _ NR} { SET _ LINE [EXPR ($NR/($WIDTH/25))*8+4] SET _ NAME [LINDEX _ "JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER" $NR] SET _ DAYS [EXPR 31-((($NR)%7)%2)-($NR==1)*(2-((($YEAR%4==0)&&($YEAR%100>0))||($YEAR%400==0)))] CPUTS $LINE "[CENTER $NAME 20] " CPUTS [INCR _ LINE] "MO TU WE TH FR SA SU "; INCR _ LINE SET _ DAY [EXPR 1-$SDAY] FOR _ {SET _ X 0} {$X<42} {INCR _ X} { IF _ ($DAY>0)&&($DAY<=$DAYS) {CPUTS $LINE [FORMAT "%2d " $DAY]} {CPUTS $LINE " "} IF _ (($X+1)%7)==0 {CPUTS $LINE " "; INCR _ LINE} INCR _ DAY } SET _ SDAY [EXPR ($SDAY+($DAYS%7))%7] } FOR _ {SET _ X 0} {$X<[ARRAY SIZE _ CAL]} {INCR _ X} { PUTS _ $CAL($X) } }
CALENDAR </lang> Output:
(SNOOPY)
--- 1969 ---
JANUARY FEBRUARY MARCH
MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU
1 2 3 4 5 1 2 1 2
6 7 8 9 10 11 12 3 4 5 6 7 8 9 3 4 5 6 7 8 9
13 14 15 16 17 18 19 10 11 12 13 14 15 16 10 11 12 13 14 15 16
20 21 22 23 24 25 26 17 18 19 20 21 22 23 17 18 19 20 21 22 23
27 28 29 30 31 24 25 26 27 28 24 25 26 27 28 29 30
31
APRIL MAY JUNE
MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU
1 2 3 4 5 6 1 2 3 4 1
7 8 9 10 11 12 13 5 6 7 8 9 10 11 2 3 4 5 6 7 8
14 15 16 17 18 19 20 12 13 14 15 16 17 18 9 10 11 12 13 14 15
21 22 23 24 25 26 27 19 20 21 22 23 24 25 16 17 18 19 20 21 22
28 29 30 26 27 28 29 30 31 23 24 25 26 27 28 29
30
JULY AUGUST SEPTEMBER
MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU
1 2 3 4 5 6 1 2 3 1 2 3 4 5 6 7
7 8 9 10 11 12 13 4 5 6 7 8 9 10 8 9 10 11 12 13 14
14 15 16 17 18 19 20 11 12 13 14 15 16 17 15 16 17 18 19 20 21
21 22 23 24 25 26 27 18 19 20 21 22 23 24 22 23 24 25 26 27 28
28 29 30 31 25 26 27 28 29 30 31 29 30
OCTOBER NOVEMBER DECEMBER
MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU
1 2 3 4 5 1 2 1 2 3 4 5 6 7
6 7 8 9 10 11 12 3 4 5 6 7 8 9 8 9 10 11 12 13 14
13 14 15 16 17 18 19 10 11 12 13 14 15 16 15 16 17 18 19 20 21
20 21 22 23 24 25 26 17 18 19 20 21 22 23 22 23 24 25 26 27 28
27 28 29 30 31 24 25 26 27 28 29 30 29 30 31
Vedit macro language
In Calendar task, standard calendar.vdm macro was called to draw one month calendar. The version here is stand-alone and contains subroutine DRAW_CALENDAR to draw one month calendar.
In addition, short commands are used here. (Normally, long versions of command words are used in RC tasks for readability.) Vedit macro language is case insensitive, but it is normal practice to write short commands in upper case.
<lang vedit>BS(BF) CFT(22)
- 3 = 6 // NUMBER OF MONTHS PER LINE
- 2 = 1969 // YEAR
- 1 = 1 // STARTING MONTH
IC(' ', COUNT, #3*9) IT("[SNOOPY]") IN(2) IC(' ', COUNT, #3*9+1) NI(#2) IN REPEAT(12/#3) {
REPEAT (#3) {
BS(BF)
CALL("DRAW_CALENDAR") RCB(10, 1, EOB_POS, COLSET, 1, 21) BQ(OK) #5 = CP RI(10) GP(#5) EOL IC(9) #1++
} EOF IN(2)
} RETURN
- DRAW_CALENDAR:
NUM_PUSH(4,20)
- 20 = RF
BOF DC(ALL)
NI(#1, LEFT+NOCR) IT("/1/") NI(#2, LEFT+NOCR) RCB(#20, BOL_POS, EOL_POS, DELETE)
- 10 = JDATE(@(#20))
- 4 = #2+(#1==12)
NI(#1%12+1, LEFT+NOCR) IT("/1/") NI(#4, LEFT+NOCR) RCB(#20, BOL_POS, CP, DELETE)
- 11 = JDATE(@(#20)) - #10
- 12 = JDATE()
- 7 = (#10-1) % 7
IF (#1==1) { RS(#20," JANUARY ") } IF (#1==2) { RS(#20," FEBRUARY") } IF (#1==3) { RS(#20," MARCH ") } IF (#1==4) { RS(#20," APRIL ") } IF (#1==5) { RS(#20," MAY ") } IF (#1==6) { RS(#20," JUNE ") } IF (#1==7) { RS(#20," JULY ") } IF (#1==8) { RS(#20," AUGUST ") } IF (#1==9) { RS(#20,"SEPTEMBER") } IF (#1==10) { RS(#20," OCTOBER ") } IF (#1==11) { RS(#20," NOVEMBER") } IF (#1==12) { RS(#20," DECEMBER") }
IT(" ") RI(#20) IN IT(" MO TU WE TH FR SA SU") IN IT(" --------------------") IN IC(' ', COUNT, #7*3)
- 6 = 0
FOR (#8 = 1; #8 <= #11; #8++) {
NI(#8, COUNT, 3)
IF (#8+#10-1 == #12) { #6 = CP }
#5 = (#8+#10+6-1) % 7
IF (#5 == 6) { IN }
} IT(" ")
REG_EMPTY(#20) NUM_POP(4,20) RETURN </lang>
[SNOOPY]
1969
JANUARY FEBRUARY MARCH APRIL MAY JUNE
MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU
-------------------- -------------------- -------------------- -------------------- -------------------- --------------------
1 2 3 4 5 1 2 1 2 1 2 3 4 5 6 1 2 3 4 1
6 7 8 9 10 11 12 3 4 5 6 7 8 9 3 4 5 6 7 8 9 7 8 9 10 11 12 13 5 6 7 8 9 10 11 2 3 4 5 6 7 8
13 14 15 16 17 18 19 10 11 12 13 14 15 16 10 11 12 13 14 15 16 14 15 16 17 18 19 20 12 13 14 15 16 17 18 9 10 11 12 13 14 15
20 21 22 23 24 25 26 17 18 19 20 21 22 23 17 18 19 20 21 22 23 21 22 23 24 25 26 27 19 20 21 22 23 24 25 16 17 18 19 20 21 22
27 28 29 30 31 24 25 26 27 28 24 25 26 27 28 29 30 28 29 30 26 27 28 29 30 31 23 24 25 26 27 28 29
31 30
JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER
MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU
-------------------- -------------------- -------------------- -------------------- -------------------- --------------------
1 2 3 4 5 6 1 2 3 1 2 3 4 5 6 7 1 2 3 4 5 1 2 1 2 3 4 5 6 7
7 8 9 10 11 12 13 4 5 6 7 8 9 10 8 9 10 11 12 13 14 6 7 8 9 10 11 12 3 4 5 6 7 8 9 8 9 10 11 12 13 14
14 15 16 17 18 19 20 11 12 13 14 15 16 17 15 16 17 18 19 20 21 13 14 15 16 17 18 19 10 11 12 13 14 15 16 15 16 17 18 19 20 21
21 22 23 24 25 26 27 18 19 20 21 22 23 24 22 23 24 25 26 27 28 20 21 22 23 24 25 26 17 18 19 20 21 22 23 22 23 24 25 26 27 28
28 29 30 31 25 26 27 28 29 30 31 29 30 27 28 29 30 31 24 25 26 27 28 29 30 29 30 31
X86 Assembly
ASSEMBLE WITH: TASM CALENDAR; TLINK /t CALENDAR
<lang asm> .MODEL TINY
.CODE
.486
ORG 100H ;.COM FILES START HERE
YEAR EQU 1969 ;DISPLAY CALENDAR FOR SPECIFIED YEAR START: MOV CX, 61 ;SPACE(61); TEXT(0, "[SNOOPY]"); CRLF(0)
CALL SPACE
MOV DX, OFFSET SNOOPY
CALL TEXT
MOV CL, 63 ;SPACE(63); INTOUT(0, YEAR); CRLF(0); CRLF(0)
CALL SPACE
MOV AX, YEAR
CALL INTOUT
CALL CRLF
CALL CRLF
MOV DI, 1 ;FOR MONTH:= 1 TO 12 DO DI=MONTH
L22: XOR SI, SI ; FOR COL:= 0 TO 6-1 DO SI=COL L23: MOV CL, 5 ; SPACE(5)
CALL SPACE
MOV DX, DI ; TEXT(0, MONAME(MONTH+COL-1)); SPACE(7);
DEC DX ; DX:= (MONTH+COL-1)*10+MONAME
ADD DX, SI
IMUL DX, 10
ADD DX, OFFSET MONAME
CALL TEXT
MOV CL, 7
CALL SPACE
CMP SI, 5 ; IF COL<5 THEN SPACE(1);
JGE L24
MOV CL, 1
CALL SPACE
INC SI
JMP L23
L24: CALL CRLF
MOV SI, 6 ; FOR COL:= 0 TO 6-1 DO
L25: MOV DX, OFFSET SUMO ; TEXT(0, "SU MO TU WE TH FR SA");
CALL TEXT
DEC SI ; IF COL<5 THEN SPACE(2);
JE L27
MOV CL, 2
CALL SPACE
JMP L25
L27: CALL CRLF
XOR SI, SI ;FOR COL:= 0 TO 6-1 DO
L28: MOV BX, DI ;DAY OF FIRST SUNDAY OF MONTH (CAN BE NEGATIVE)
ADD BX, SI ;DAY(COL):= 1 - WEEKDAY(YEAR, MONTH+COL, 1);
MOV BP, YEAR
- DAY OF WEEK FOR FIRST DAY OF THE MONTH (0=SUN 1=MON..6=SAT)
CMP BL, 2 ;IF MONTH<=2 THEN
JG L3
ADD BL, 12 ; MONTH:= MONTH+12;
DEC BP ; YEAR:= YEAR-1;
L3:
- REM((1-1 + (MONTH+1)*26/10 + YEAR + YEAR/4 + YEAR/100*6 + YEAR/400)/7)
INC BX ;MONTH
IMUL AX, BX, 26
MOV CL, 10
CWD
IDIV CX
MOV BX, AX
MOV AX, BP ;YEAR
ADD BX, AX
SHR AX, 2
ADD BX, AX
MOV CL, 25
CWD
IDIV CX
IMUL DX, AX, 6 ;YEAR/100*6
ADD BX, DX
SHR AX, 2 ;YEAR/400
ADD AX, BX
MOV CL, 7
CWD
IDIV CX
NEG DX
INC DX
MOV [SI+DAY], DL ;COL+DAY
INC SI
CMP SI, 5
JLE L28
MOV BP, 6 ;FOR LINE:= 0 TO 6-1 DO BP=LINE
L29: XOR SI, SI ; FOR COL:= 0 TO 6-1 DO SI=COL L30: MOV BX, DI ; DAYMAX:= DAYS(MONTH+COL);
MOV BL, [BX+SI+DAYS]
- IF MONTH+COL=2 & (REM(YEAR/4)=0 & REM(YEAR/100)#0 ! REM(YEAR/400)=0) THEN
MOV AX, DI ;MONTH
ADD AX, SI
CMP AL, 2
JNE L32
MOV AX, YEAR
TEST AL, 03H
JNE L32
MOV CL,100
CWD
IDIV CX
TEST DX, DX
JNE L31
TEST AL, 03H
JNE L32
L31: INC BX ;IF FEBRUARY AND LEAP YEAR THEN ADD A DAY L32:
MOV DX, 7 ;FOR WEEKDAY:= 0 TO 7-1 DO
L33: MOVZX AX, [SI+DAY] ; IF DAY(COL)>=1 & DAY(COL)<=DAYMAX THEN
CMP AL, 1
JL L34
CMP AL, BL
JG L34
CALL INTOUT ; INTOUT(0, DAY(COL));
CMP AL, 10 ; IF DAY(COL)<10 THEN SPACE(1); LEFT JUSTIFY
JGE L36
MOV CL, 1
CALL SPACE
JMP L36
L34: MOV CL, 2 ; ELSE SPACE(2);
CALL SPACE ; SUPPRESS OUT OF RANGE DAYS
L36: MOV CL, 1 ; SPACE(1);
CALL SPACE
INC BYTE PTR [SI+DAY] ; DAY(COL):= DAY(COL)+1;
DEC DX ;NEXT WEEKDAY
JNE L33
CMP SI, 5 ;IF COL<5 THEN SPACE(1);
JGE L37
MOV CL, 1
CALL SPACE
INC SI
JMP L30
L37: CALL CRLF
DEC BP ;NEXT LINE DOWN
JNE L29
CALL CRLF
ADD DI, 6 ;NEXT 6 MONTHS
CMP DI, 12
JLE L22
RET
- DISPLAY POSITIVE INTEGER IN AX
INTOUT: PUSHA
MOV BX, 10
XOR CX, CX
NO10: CWD
IDIV BX
PUSH DX
INC CX
TEST AX, AX
JNE NO10
NO20: MOV AH, 02H
POP DX
ADD DL, '0'
INT 21H
LOOP NO20
POPA
RET
- DISPLAY CX SPACE CHARACTERS
SPACE: PUSHA SP10: MOV AH, 02H
MOV DL, 20H
INT 21H
LOOP SP10
POPA
RET
- START A NEW LINE
CRLF: MOV DX, OFFSET LCRLF
- DISPLAY STRING AT DX
TEXT: MOV AH, 09H
INT 21H
RET
SNOOPY DB "[SNOOPY]" LCRLF DB 0DH, 0AH, '$' MONAME DB " JANUARY $ FEBRUARY$ MARCH $ APRIL $ MAY $ JUNE $"
DB " JULY $ AUGUST $SEPTEMBER$ OCTOBER$ NOVEMBER$ DECEMBER$"
SUMO DB "SU MO TU WE TH FR SA$" DAYS DB 0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 DAY DB ?, ?, ?, ?, ?, ?
END START</lang>
- Output:
[SNOOPY]
1969
JANUARY FEBRUARY MARCH APRIL MAY JUNE
SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA
1 2 3 4 1 1 1 2 3 4 5 1 2 3 1 2 3 4 5 6 7
5 6 7 8 9 10 11 2 3 4 5 6 7 8 2 3 4 5 6 7 8 6 7 8 9 10 11 12 4 5 6 7 8 9 10 8 9 10 11 12 13 14
12 13 14 15 16 17 18 9 10 11 12 13 14 15 9 10 11 12 13 14 15 13 14 15 16 17 18 19 11 12 13 14 15 16 17 15 16 17 18 19 20 21
19 20 21 22 23 24 25 16 17 18 19 20 21 22 16 17 18 19 20 21 22 20 21 22 23 24 25 26 18 19 20 21 22 23 24 22 23 24 25 26 27 28
26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 27 28 29 30 25 26 27 28 29 30 31 29 30
30 31
JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER
SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA
1 2 3 4 5 1 2 1 2 3 4 5 6 1 2 3 4 1 1 2 3 4 5 6
6 7 8 9 10 11 12 3 4 5 6 7 8 9 7 8 9 10 11 12 13 5 6 7 8 9 10 11 2 3 4 5 6 7 8 7 8 9 10 11 12 13
13 14 15 16 17 18 19 10 11 12 13 14 15 16 14 15 16 17 18 19 20 12 13 14 15 16 17 18 9 10 11 12 13 14 15 14 15 16 17 18 19 20
20 21 22 23 24 25 26 17 18 19 20 21 22 23 21 22 23 24 25 26 27 19 20 21 22 23 24 25 16 17 18 19 20 21 22 21 22 23 24 25 26 27
27 28 29 30 31 24 25 26 27 28 29 30 28 29 30 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31
31 30