Calendar - for "REAL" programmers: Difference between revisions
Merge omitted languages at bottom and add Processing |
|||
Line 1,047: | Line 1,047: | ||
=={{header|Elena}}== |
=={{header|Elena}}== |
||
ELENA |
ELENA 5.0 : |
||
<lang elena>import system'text; |
<lang elena>import system'text; |
||
import system'routines; |
import system'routines; |
||
Line 1,054: | Line 1,054: | ||
import extensions'routines; |
import extensions'routines; |
||
const MonthNames = new string[] |
const MonthNames = new string[]{"JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER", |
||
"NOVEMBER","DECEMBER"}; |
|||
const DayNames = new string[] |
const DayNames = new string[]{"MO", "TU", "WE", "TH", "FR", "SA", "SU"}; |
||
class CalendarMonthPrinter |
class CalendarMonthPrinter |
||
Line 1,087: | Line 1,088: | ||
if (theDate.Month == theMonth) |
if (theDate.Month == theMonth) |
||
{ |
{ |
||
var dw := theDate.DayOfWeek; |
|||
theLine.writeCopies(" ",theDate.DayOfWeek == 0 ? 6 : (theDate.DayOfWeek - 1)); |
|||
do |
do |
||
{ |
{ |
||
theLine.writePaddingLeft(theDate.Day. |
theLine.writePaddingLeft(theDate.Day.toPrintable(), $32, 3); |
||
theDate := theDate.addDays:1 |
theDate := theDate.addDays:1 |
||
} |
} |
||
until |
until(theDate.Month != theMonth || theDate.DayOfWeek == 1) |
||
}; |
}; |
||
Line 1,105: | Line 1,108: | ||
} |
} |
||
indexer() = new Indexer |
indexer() = new Indexer |
||
{ |
{ |
||
bool Available = theRow < 7; |
bool Available = theRow < 7; |
||
⚫ | |||
readIndexTo(ref int retVal) { theRow.readValueTo(ref retVal) } |
|||
⚫ | |||
{ |
{ |
||
get() = theRow.Value; |
|||
set(int index) |
|||
{ |
|||
if (index <= theRow) |
|||
{ self.writeTitle() }; |
|||
while (index > theRow) |
|||
{ self.writeLine() } |
|||
} |
|||
} |
} |
||
appendIndex(int index) |
appendIndex(int index) |
||
{ |
|||
this self.Index := theRow.Value + index |
|||
} |
|||
get int Length() { ^ 7 } |
|||
get() = self; |
get() = self; |
||
Line 1,156: | Line 1,164: | ||
output.writePadding("[SNOOPY]", $32, theRowLength * 25); |
output.writePadding("[SNOOPY]", $32, theRowLength * 25); |
||
output.writeLine(); |
output.writeLine(); |
||
output.writePadding(theYear. |
output.writePadding(theYear.toPrintable(), $32, theRowLength * 25); |
||
output.writeLine().writeLine(); |
output.writeLine().writeLine(); |
||
Revision as of 14:38, 6 March 2020
![Task](http://static.miraheze.org/rosettacodewiki/thumb/b/ba/Rcode-button-task-crushed.png/64px-Rcode-button-task-crushed.png)
You are encouraged to solve this task according to the task description, using any language you may know.
- Task
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.
Trivia: The terms uppercase and lowercase date back to the early days of the mechanical printing press. Individual metal alloy casts of each needed letter, or punctuation symbol, were meticulously added to a press block, by hand, before rolling out copies of a page. These metal casts were stored and organized in wooden cases. The more often needed minuscule letters were placed closer to hand, in the lower cases of the work bench. The less often needed, capitalized, majuscule letters, ended up in the harder to reach upper cases.
360 Assembly
This is for real programmers who code only in assembler :). The code could have been run in april 1964, punched on 80-column cards, read on a card reader, and printed with a 132-column line printer on fan-folded paper with perforated edges. <lang 360asm>* CALENDAR FOR REAL PROGRAMMERS 05/03/2017 CALENDAR CSECT
USING CALENDAR,R13 BASE REGISTER B 72(R15) SKIP MY SAVEAREA DC 17F'0' MY SAVEAREA STM R14,R12,12(R13) SAVE CALLER'S REGISTERS ST R13,4(R15) LINK BACKWARD ST R15,8(R13) LINK FORWARD LR R13,R15 SET ADDRESSABILITY L R4,YEAR YEAR SRDA R4,32 . D R4,=F'4' YEAR//4 LTR R4,R4 IF YEAR//4=0 BNZ LYNOT L R4,YEAR YEAR SRDA R4,32 . D R4,=F'100' YEAR//100 LTR R4,R4 IF YEAR//100=0 BNZ LY L R4,YEAR YEAR SRDA R4,32 . D R4,=F'400' IF YEAR//400 LTR R4,R4 IF YEAR//400=0 BNZ LYNOT
LY MVC ML+2,=H'29' ML(2)=29 LEAPYEAR LYNOT SR R10,R10 LTD1=0
LA R6,1 I=1
LOOPI1 C R6,=F'31' DO I=1 TO 31
BH ELOOPI1 XDECO R6,XDEC EDIT I LA R14,TD1 TD1 AR R14,R10 TD1+LTD1 MVC 0(3,R14),XDEC+9 SUB(TD1,LTD1+1,3)=PIC(I,3) LA R10,3(R10) LTD1+3 LA R6,1(R6) I=I+1 B LOOPI1
ELOOPI1 LA R6,1 I=1 LOOPI2 C R6,=F'12' DO I=1 TO 12
BH ELOOPI2 ST R6,M M=I MVC D,=F'1' D=1 MVC YY,YEAR YY=YEAR L R4,M M C R4,=F'3' IF M<3 BNL GE3 L R2,M M LA R2,12(R2) M+12 ST R2,M M=M+12 L R2,YY YY BCTR R2,0 YY-1 ST R2,YY YY=YY-1
GE3 L R2,YY YY
LR R1,R2 YY SRA R1,2 YY/4 AR R2,R1 YY+(YY/4) L R4,YY YY SRDA R4,32 . D R4,=F'100' YY/100 SR R2,R5 YY+(YY/4)-(YY/100) L R4,YY YY SRDA R4,32 . D R4,=F'400' YY/400 AR R2,R5 YY+(YY/4)-(YY/100)+(YY/400) A R2,D R2=YY+(YY/4)-(YY/100)+(YY/400)+D LA R5,153 153 M R4,M 153*M LA R5,8(R5) 153*M+8 D R4,=F'5' (153*M+8)/5 AR R5,R2 ((153*M+8)/5+R2 LA R4,0 . D R4,=F'7' R4=MOD(R5,7) 0=SUN 1=MON ... 6=SAT LTR R4,R4 IF J=0 BNZ JNE0 LA R4,7 J=7
JNE0 BCTR R4,0 J-1
MH R4,=H'3' J*3 LR R10,R4 J1=J*3 LR R1,R6 I SLA R1,1 *2 LH R11,ML-2(R1) ML(I) MH R11,=H'3' J2=ML(I)*3 MVC TD2,BLANK TD2=' ' LA R4,TD1 @TD1 LR R5,R11 J2 LA R2,TD2 @TD2 AR R2,R10 @TD2+J1 LR R3,R5 J2 MVCL R2,R4 SUB(TD2,J1+1,J2)=SUB(TD1,1,J2) LR R1,R6 I MH R1,=H'144' *144 LA R14,DA-144(R1) @DA(I) MVC 0(144,R14),TD2 DA(I)=TD2 LA R6,1(R6) I=I+1 B LOOPI2
ELOOPI2 XPRNT SNOOPY,132 PRINT SNOOPY
L R1,YEAR YEAR XDECO R1,PG+56 EDIT YEAR XPRNT PG,L'PG PRINT YEAR MVC WDLINE,BLANK WDLINE=' ' LA R10,1 LWDLINE=1 LA R8,1 K=1
LOOPK3 C R8,=F'6' DO K=1 TO 6
BH ELOOPK3 LA R4,WDLINE @WDLINE AR R4,R10 +LWDLINE MVC 0(20,R4),WDNA SUB(WDLINE,LWDLINE+1,20)=WDNA LA R10,20(R10) LWDLINE=LWDLINE+20 C R8,=F'6' IF K<6 BNL ITERK3 LA R10,2(R10) LWDLINE=LWDLINE+2
ITERK3 LA R8,1(R8) K=K+1
B LOOPK3
ELOOPK3 LA R6,1 I=1 LOOPI4 C R6,=F'12' DO I=1 TO 12 BY 6
BH ELOOPI4 MVC MOLINE,BLANK MOLINE=' ' LA R10,6 LMOLINE=6 LR R8,R6 K=I
LOOPK4 LA R2,5(R6) I+5
CR R8,R2 DO K=I TO I+5 BH ELOOPK4 LR R1,R8 K MH R1,=H'10' *10 LA R3,MO-10(R1) MO(K) LA R4,MOLINE @MOLINE AR R4,R10 +LMOLINE MVC 0(10,R4),0(R3) SUB(MOLINE,LMOLINE+1,10)=MO(K) LA R10,22(R10) LMOLINE=LMOLINE+22 LA R8,1(R8) K=K+1 B LOOPK4
ELOOPK4 XPRNT MOLINE,L'MOLINE PRINT MONTHS
XPRNT WDLINE,L'WDLINE PRINT DAYS OF WEEK LA R7,1 J=1
LOOPJ4 C R7,=F'106' DO J=1 TO 106 BY 21
BH ELOOPJ4 MVC PG,BLANK CLEAR BUFFER LA R9,PG PGI=0 LR R8,R6 K=I
LOOPK5 LA R2,5(R6) I+5
CR R8,R2 DO K=I TO I+5 BH ELOOPK5 LR R1,R8 K MH R1,=H'144' *144 LA R4,DA-144(R1) DA(K) BCTR R4,0 -1 AR R4,R7 +J MVC 0(21,R9),0(R4) SUBSTR(DA(K),J,21) LA R9,22(R9) PGI=PGI+22 LA R8,1(R8) K=K+1 B LOOPK5
ELOOPK5 XPRNT PG,L'PG PRINT BUFFER
LA R7,21(R7) J=J+21 B LOOPJ4
ELOOPJ4 LA R6,6(R6) I=I+6
B LOOPI4
ELOOPI4 L R13,4(0,R13) RESTORE PREVIOUS SAVEAREA POINTER
LM R14,R12,12(R13) RESTORE CALLER'S REGISTERS XR R15,R15 SET RETURN CODE TO 0 BR R14 RETURN TO CALLER
SNOOPY DC CL57' ',CL18'INSERT SNOOPY HERE',CL57' ' YEAR DC F'1969' <== 1969 MO DC CL10' JANUARY ',CL10' FEBRUARY ',CL10' MARCH '
DC CL10' APRIL ',CL10' MAY ',CL10' JUNE ' DC CL10' JULY ',CL10' AUGUST ',CL10'SEPTEMBER ' DC CL10' OCTOBER ',CL10' NOVEMBER ',CL10' DECEMBER '
ML DC H'31',H'28',H'31',H'30',H'31',H'30'
DC H'31',H'31',H'30',H'31',H'30',H'31'
WDNA DC CL20'MO TU WE TH FR SA SU' M DS F D DS F YY DS F TD1 DS CL93 TD2 DS CL144 MOLINE DS CL132 WDLINE DS CL132 PG DC CL132' ' BUFFER FOR THE LINE PRINTER XDEC DS CL12 BLANK DC CL144' ' DA DS 12CL144
YREGS END CALENDAR</lang>
- Output:
INSERT SNOOPY HERE 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
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
AutoHotkey
<lang AutoHotkey>CALENDAR(YR){ LASTDAY := [], DAY := [] TITLES = (LTRIM ______JANUARY_________________FEBRUARY_________________MARCH_______ _______APRIL____________________MAY____________________JUNE________ ________JULY___________________AUGUST_________________SEPTEMBER_____ ______OCTOBER_________________NOVEMBER________________DECEMBER______ ) STRINGSPLIT, TITLE, TITLES, % CHR(10) RES := "________________________________" YR CHR(13) CHR(10)
LOOP 4 { ; 4 VERTICAL SECTIONS DAY[1]:=YR SUBSTR("0" A_INDEX*3 -2, -1) 01 DAY[2]:=YR SUBSTR("0" A_INDEX*3 -1, -1) 01 DAY[3]:=YR SUBSTR("0" A_INDEX*3 , -1) 01 RES .= CHR(13) CHR(10) TITLE%A_INDEX% CHR(13) CHR(10) "SU MO TU WE TH FR SA SU MO TU WE TH FR SA SU MO TU WE TH FR SA" LOOP , 6 { ; 6 WEEKS MAX PER MONTH WEEK := A_INDEX, RES .= CHR(13) CHR(10) LOOP, 21 { ; 3 WEEKS TIMES 7 DAYS MON := CEIL(A_INDEX/7), THISWD := MOD(A_INDEX-1,7)+1 FORMATTIME, WD, % DAY[MON], WDAY ;~ MSGBOX % WD FORMATTIME, DD, % DAY[MON], % CHR(100) CHR(100) IF (WD>THISWD) { RES .= "__ " CONTINUE } DD := ((WEEK>3) && DD <10) ? "__" : DD, RES .= DD " ", LASTDAY[MON] := DAY[MON], DAY[MON] +=1, D RES .= ((WD=7) && A_INDEX < 21) ? "___" : "" FORMATTIME, DD, % DAY[MON], % CHR(100) CHR(100) } } RES .= CHR(13) CHR(10) } STRINGREPLACE, RES, RES,_,%A_SPACE%, ALL STRINGREPLACE, RES, RES,%A_SPACE%0,%A_SPACE%%A_SPACE%, ALL RETURN RES }</lang> Examples:<lang AutoHotkey>EXAMPLES: GUI, FONT,S8, COURIER GUI, ADD, EDIT, VYR W40 R1 LIMIT4 NUMBER, 1969 GUI, ADD, EDIT, VEDIT2 W580 R38 GUI, ADD, BUTTON, DEFAULT HIDDEN GSUBMIT GUI, SHOW
SUBMIT: GUI, SUBMIT, NOHIDE GUICONTROL,, EDIT2, % CALENDAR(YR) RETURN
GUIESCAPE: GUICLOSE: EXITAPP RETURN</lang>
- Output:
1969 JANUARY FEBRUARY MARCH 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 05 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 MAY JUNE 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 06 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 AUGUST SEPTEMBER 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 06 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 NOVEMBER DECEMBER 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 05 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
BaCon
Choosing 132 character output. Same as the "Calendar" from the calendar task but using all capitals: <lang freebasic>DECLARE MON$[] = { "JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE", "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER" } DECLARE MON[] = { 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 } Y$ = "1969" ' Leap year INCR MON[1], IIF(MOD(VAL(Y$), 4) = 0 OR MOD(VAL(Y$), 100) = 0 AND MOD(VAL(Y$), 400) <> 0, 1, 0) PRINT ALIGN$("[SNOOPY HERE]", 132, 2) PRINT ALIGN$(Y$, 132, 2) FOR NR = 0 TO 11
ROW = 3 GOTOXY 1+(NR %6)*22, ROW+(NR/6)*9 PRINT ALIGN$(MON$[NR], 21, 2); INCR ROW GOTOXY 1+(NR %6)*22, ROW+(NR/6)*9 PRINT ALIGN$("MO TU WE TH FR SA SU", 21, 2); INCR ROW ' Each day FOR D = 1 TO MON[NR] ' Zeller J = VAL(LEFT$(Y$, 2)) K = VAL(MID$(Y$, 3, 2)) M = NR+1 IF NR < 2 THEN INCR M, 12 DECR K END IF H = (D + ((M+1)*26)/10 + K + (K/4) + (J/4) + 5*J) DAYNR = MOD(H, 7) - 2 IF DAYNR < 0 THEN INCR DAYNR, 7 IF DAYNR = 0 AND D > 1 THEN INCR ROW GOTOXY 1+(NR %6)*22+DAYNR*3, ROW+(NR/6)*9 PRINT D; NEXT
NEXT</lang>
- Output:
[SNOOPY HERE] 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
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
C
Upper-case C version of the C Calendar task. Relies on the ability of most C compilers to specify #defines on the command line and declares the putchar function to avoid needing any #includes. E.g. for tcc:
tcc -DSTRUCT=struct -DCONST=const -DINT=int -DCHAR=char -DVOID=void -DMAIN=main -DIF=if -DELSE=else -DWHILE=while -DFOR=for -DDO=do -DBREAK=break -DRETURN=return -DPUTCHAR=putchar UCCALENDAR.c
<lang c>/* UPPER CASE ONLY VERSION OF THE ORIGINAL CALENDAR.C, CHANGES MOSTLY TO AVOID NEEDING #INCLUDES */ /* ERROR MESSAGES GO TO STDOUT TO SLIGHTLY SIMPLIFY THE I/O HANDLING */ /* WHEN COMPILING THIS, THE COMMAND LINE SHOULD SPECIFY -D OPTIONS FOR THE FOLLOWING WORDS: */ /* STRUCT, VOID, INT, CHAR, CONST, MAIN, IF, ELSE, WHILE, FOR, DO, BREAK, RETURN, PUTCHAR */ /* THE VALUE OF EACH MACRO SHOULD BE THE WORD IN LOWER-CASE */
INT PUTCHAR(INT);
INT WIDTH = 80, YEAR = 1969; INT COLS, LEAD, GAP;
CONST CHAR *WDAYS[] = { "SU", "MO", "TU", "WE", "TH", "FR", "SA" }; STRUCT MONTHS {
CONST CHAR *NAME; INT DAYS, START_WDAY, AT;
} MONTHS[12] = {
{ "JANUARY", 31, 0, 0 }, { "FEBRUARY", 28, 0, 0 }, { "MARCH", 31, 0, 0 }, { "APRIL", 30, 0, 0 }, { "MAY", 31, 0, 0 }, { "JUNE", 30, 0, 0 }, { "JULY", 31, 0, 0 }, { "AUGUST", 31, 0, 0 }, { "SEPTEMBER", 30, 0, 0 }, { "OCTOBER", 31, 0, 0 }, { "NOVEMBER", 30, 0, 0 }, { "DECEMBER", 31, 0, 0 }
};
VOID SPACE(INT N) { WHILE (N-- > 0) PUTCHAR(' '); } VOID PRINT(CONST CHAR * S){ WHILE (*S != '\0') { PUTCHAR(*S++); } } INT STRLEN(CONST CHAR * S) {
INT L = 0; WHILE (*S++ != '\0') { L ++; };
RETURN L; } INT ATOI(CONST CHAR * S) {
INT I = 0; INT SIGN = 1; CHAR C; WHILE ((C = *S++) != '\0') { IF (C == '-') SIGN *= -1; ELSE { I *= 10; I += (C - '0'); } }
RETURN I * SIGN; }
VOID INIT_MONTHS(VOID) {
INT I; IF ((!(YEAR % 4) && (YEAR % 100)) || !(YEAR % 400)) MONTHS[1].DAYS = 29; YEAR--; MONTHS[0].START_WDAY = (YEAR * 365 + YEAR/4 - YEAR/100 + YEAR/400 + 1) % 7; FOR (I = 1; I < 12; I++) MONTHS[I].START_WDAY = (MONTHS[I-1].START_WDAY + MONTHS[I-1].DAYS) % 7; COLS = (WIDTH + 2) / 22; WHILE (12 % COLS) COLS--; GAP = COLS - 1 ? (WIDTH - 20 * COLS) / (COLS - 1) : 0; IF (GAP > 4) GAP = 4; LEAD = (WIDTH - (20 + GAP) * COLS + GAP + 1) / 2; YEAR++;
}
VOID PRINT_ROW(INT ROW) {
INT C, I, FROM = ROW * COLS, TO = FROM + COLS; SPACE(LEAD); FOR (C = FROM; C < TO; C++) { I = STRLEN(MONTHS[C].NAME); SPACE((20 - I)/2); PRINT(MONTHS[C].NAME); SPACE(20 - I - (20 - I)/2 + ((C == TO - 1) ? 0 : GAP)); } PUTCHAR('\012'); SPACE(LEAD); FOR (C = FROM; C < TO; C++) { FOR (I = 0; I < 7; I++) { PRINT(WDAYS[I]); PRINT(I == 6 ? "" : " "); } IF (C < TO - 1) SPACE(GAP); ELSE PUTCHAR('\012'); } WHILE (1) { FOR (C = FROM; C < TO; C++) IF (MONTHS[C].AT < MONTHS[C].DAYS) BREAK; IF (C == TO) BREAK; SPACE(LEAD); FOR (C = FROM; C < TO; C++) { FOR (I = 0; I < MONTHS[C].START_WDAY; I++) SPACE(3); WHILE(I++ < 7 && MONTHS[C].AT < MONTHS[C].DAYS) { INT MM = ++MONTHS[C].AT; PUTCHAR((MM < 10) ? ' ' : '0' + (MM /10)); PUTCHAR('0' + (MM %10)); IF (I < 7 || C < TO - 1) PUTCHAR(' '); } WHILE (I++ <= 7 && C < TO - 1) SPACE(3); IF (C < TO - 1) SPACE(GAP - 1); MONTHS[C].START_WDAY = 0; } PUTCHAR('\012'); } PUTCHAR('\012');
}
VOID PRINT_YEAR(VOID) {
INT Y = YEAR; INT ROW; CHAR BUF[32]; CHAR * B = &(BUF[31]); *B-- = '\0'; DO { *B-- = '0' + (Y % 10); Y /= 10; } WHILE (Y > 0); B++; SPACE((WIDTH - STRLEN(B)) / 2); PRINT(B);PUTCHAR('\012');PUTCHAR('\012'); FOR (ROW = 0; ROW * COLS < 12; ROW++) PRINT_ROW(ROW);
}
INT MAIN(INT C, CHAR **V) {
INT I, YEAR_SET = 0, RESULT = 0; FOR (I = 1; I < C && RESULT == 0; I++) { IF (V[I][0] == '-' && V[I][1] == 'W' && V[I][2] == '\0') { IF (++I == C || (WIDTH = ATOI(V[I])) < 20) RESULT = 1; } ELSE IF (!YEAR_SET) { YEAR = ATOI(V[I]); IF (YEAR <= 0) YEAR = 1969; YEAR_SET = 1; } ELSE RESULT = 1; } IF (RESULT == 0) { INIT_MONTHS(); PRINT_YEAR(); } ELSE { PRINT("BAD ARGS\012USAGE: "); PRINT(V[0]); PRINT(" YEAR [-W WIDTH (>= 20)]\012"); }
RETURN RESULT; }</lang>
COBOL
Although it seems to be missing the pinup of Snoopy, see COBOL Calendar task entry where the code, and output, is already an example of a "REAL programmer" calendar; even down to the 6 character, all uppercase, program name CALEND.
Common Lisp
<lang lisp>(QL:QUICKLOAD '(DATE-CALC))
(DEFPARAMETER *DAY-ROW* "SU MO TU WE TH FR SA") (DEFPARAMETER *CALENDAR-MARGIN* 3)
(DEFUN MONTH-TO-WORD (MONTH)
"TRANSLATE A MONTH FROM 1 TO 12 INTO ITS WORD REPRESENTATION." (SVREF #("JANUARY" "FEBRUARY" "MARCH" "APRIL" "MAY" "JUNE" "JULY" "AUGUST" "SEPTEMBER" "OCTOBER" "NOVEMBER" "DECEMBER") (1- MONTH)))
(DEFUN MONTH-STRINGS (YEAR MONTH)
"COLLECT ALL OF THE STRINGS THAT MAKE UP A CALENDAR FOR A GIVEN
MONTH AND YEAR."
`(,(DATE-CALC:CENTER (MONTH-TO-WORD MONTH) (LENGTH *DAY-ROW*)) ,*DAY-ROW* ;; WE CAN ASSUME THAT A MONTH CALENDAR WILL ALWAYS FIT INTO A 7 BY 6 BLOCK ;; OF VALUES. THIS MAKES IT EASY TO FORMAT THE RESULTING STRINGS. ,@ (LET ((DAYS (MAKE-ARRAY (* 7 6) :INITIAL-ELEMENT NIL))) (LOOP :FOR I :FROM (DATE-CALC:DAY-OF-WEEK YEAR MONTH 1) :FOR DAY :FROM 1 :TO (DATE-CALC:DAYS-IN-MONTH YEAR MONTH) :DO (SETF (AREF DAYS I) DAY)) (LOOP :FOR I :FROM 0 :TO 5 :COLLECT (FORMAT NIL "~{~:[ ~;~2,D~]~^ ~}" (LOOP :FOR DAY :ACROSS (SUBSEQ DAYS (* I 7) (+ 7 (* I 7))) :APPEND (IF DAY (LIST DAY DAY) (LIST DAY))))))))
(DEFUN CALC-COLUMNS (CHARACTERS MARGIN-SIZE)
"CALCULATE THE NUMBER OF COLUMNS GIVEN THE NUMBER OF CHARACTERS PER
COLUMN AND THE MARGIN-SIZE BETWEEN THEM."
(MULTIPLE-VALUE-BIND (COLS EXCESS) (TRUNCATE CHARACTERS (+ MARGIN-SIZE (LENGTH *DAY-ROW*))) (INCF EXCESS MARGIN-SIZE) (IF (>= EXCESS (LENGTH *DAY-ROW*)) (1+ COLS) COLS)))
(DEFUN TAKE (N LIST)
"TAKE THE FIRST N ELEMENTS OF A LIST." (LOOP :REPEAT N :FOR X :IN LIST :COLLECT X))
(DEFUN DROP (N LIST)
"DROP THE FIRST N ELEMENTS OF A LIST." (COND ((OR (<= N 0) (NULL LIST)) LIST) (T (DROP (1- N) (CDR LIST)))))
(DEFUN CHUNKS-OF (N LIST)
"SPLIT THE LIST INTO CHUNKS OF SIZE N." (ASSERT (> N 0)) (LOOP :FOR X := LIST :THEN (DROP N X) :WHILE X :COLLECT (TAKE N X)))
(DEFUN PRINT-CALENDAR (YEAR &KEY (CHARACTERS 80) (MARGIN-SIZE 3))
"PRINT OUT THE CALENDAR FOR A GIVEN YEAR, OPTIONALLY SPECIFYING
A WIDTH LIMIT IN CHARACTERS AND MARGIN-SIZE BETWEEN MONTHS."
(ASSERT (>= CHARACTERS (LENGTH *DAY-ROW*))) (ASSERT (>= MARGIN-SIZE 0)) (LET* ((CALENDARS (LOOP :FOR MONTH :FROM 1 :TO 12 :COLLECT (MONTH-STRINGS YEAR MONTH))) (COLUMN-COUNT (CALC-COLUMNS CHARACTERS MARGIN-SIZE)) (TOTAL-SIZE (+ (* COLUMN-COUNT (LENGTH *DAY-ROW*)) (* (1- COLUMN-COUNT) MARGIN-SIZE))) (FORMAT-STRING (CONCATENATE 'STRING "~{~A~^~" (WRITE-TO-STRING MARGIN-SIZE) ",0@T~}~%"))) (FORMAT T "~A~%~A~%~%" (DATE-CALC:CENTER "[SNOOPY]" TOTAL-SIZE) (DATE-CALC:CENTER (WRITE-TO-STRING YEAR) TOTAL-SIZE)) (LOOP :FOR ROW :IN (CHUNKS-OF COLUMN-COUNT CALENDARS) :DO (APPLY 'MAPCAR (LAMBDA (&REST HEADS) (FORMAT T FORMAT-STRING HEADS)) ROW))))</lang>
- Output:
CL-USER> (PRINT-CALENDAR 1969) [SNOOPY] 1969 JANUARY FEBRUARY MARCH 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 MAY JUNE 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 6 7 8 9 10 11 12 4 5 6 7 8 9 10 1 2 3 4 5 6 7 13 14 15 16 17 18 19 11 12 13 14 15 16 17 8 9 10 11 12 13 14 20 21 22 23 24 25 26 18 19 20 21 22 23 24 15 16 17 18 19 20 21 27 28 29 30 25 26 27 28 29 30 31 22 23 24 25 26 27 28 29 30 JULY AUGUST SEPTEMBER 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 NOVEMBER DECEMBER 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 NIL
D
D keywords are lower case, so this silly solution uses the whole Calendar Task code, with small changes and all in upper case, in a text file named "CALENDAR":
IMPORT STD.STDIO, STD.DATETIME, STD.STRING, STD.CONV, STD.ALGORITHM, STD.ARRAY; VOID PRINT_CALENDAR(IN UINT YEAR, IN UINT COLS) IN { ASSERT(COLS > 0 && COLS <= 12); } BODY { STATIC ENUM CAMEL_CASE = (STRING[] PARTS) PURE => PARTS[0] ~ PARTS[1 .. $].MAP!CAPITALIZE.JOIN; IMMUTABLE ROWS = 12 / COLS + (12 % COLS != 0); MIXIN("AUTO DATE = " ~ "DATE(YEAR, 1, 1);".CAPITALIZE); ENUM STRING S1 = CAMEL_CASE("DAY OF WEEK".SPLIT); MIXIN(FORMAT("AUTO OFFS = CAST(INT)DATE.%S;", S1)); CONST MONTHS = "JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER" .SPLIT.MAP!CAPITALIZE.ARRAY; STRING[8][12] MONS; FOREACH (IMMUTABLE M; 0 .. 12) { MONS[M][0] = MONTHS[M].CENTER(21); MONS[M][1] = " " ~ "SU MO TU WE TH FR SA" .SPLIT.MAP!CAPITALIZE.JOIN(" "); ENUM STRING S2 = CAMEL_CASE("DAYS IN MONTH".SPLIT); MIXIN(FORMAT("IMMUTABLE DIM = DATE.%S;", S2)); FOREACH (IMMUTABLE D; 1 .. 43) { IMMUTABLE DAY = D > OFFS && D <= OFFS + DIM; IMMUTABLE STR = DAY ? FORMAT(" %2S", D-OFFS) : " "; MONS[M][2 + (D - 1) / 7] ~= STR; } OFFS = (OFFS + DIM) % 7; DATE.ADD!"MONTHS"(1); } FORMAT("[%S %S]", "SNOOPY".CAPITALIZE, "PICTURE".CAPITALIZE) .CENTER(COLS * 24 + 4).WRITELN; WRITELN(YEAR.TEXT.CENTER(COLS * 24 + 4), "\N"); FOREACH (IMMUTABLE R; 0 .. ROWS) { STRING[8] S; FOREACH (IMMUTABLE C; 0 .. COLS) { IF (R * COLS + C > 11) BREAK; FOREACH (IMMUTABLE I, LINE; MONS[R * COLS + C]) S[I] ~= FORMAT(" %S", LINE); } WRITEFLN("%-(%S\N%)\N", S); } } STATIC THIS() { PRINT_CALENDAR(1969, 3); }
Then in another source code file there is a little loader, that imports it and mixes-in it (for safety this program must be compiled with -Jsomepath
):
<lang d>import std.string;mixin(import("CALENDAR").toLower);void main(){}</lang>
- Output:
[Snoopy Picture] 1969 January February March 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 May June 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 August September 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 November December 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
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>
Elena
ELENA 5.0 : <lang elena>import system'text; import system'routines; import system'calendar; import extensions; import extensions'routines;
const MonthNames = new string[]{"JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER",
"NOVEMBER","DECEMBER"};
const DayNames = new string[]{"MO", "TU", "WE", "TH", "FR", "SA", "SU"};
class CalendarMonthPrinter {
Date theDate; TextBuilder theLine; int theMonth; int theYear; ref<int> theRow; constructor(year, month) { theMonth := month; theYear := year; theLine := new TextBuilder(); theRow := 0; }
writeTitle() { theRow.Value := 0; theDate := Date.new(theYear, theMonth, 1); DayNames.forEach:(name) { theLine.print(" ",name) } } writeLine() { theLine.clear(); if (theDate.Month == theMonth) { var dw := theDate.DayOfWeek; theLine.writeCopies(" ",theDate.DayOfWeek == 0 ? 6 : (theDate.DayOfWeek - 1)); do { theLine.writePaddingLeft(theDate.Day.toPrintable(), $32, 3); theDate := theDate.addDays:1 } until(theDate.Month != theMonth || theDate.DayOfWeek == 1) }; int length := theLine.Length; if (length < 21) { theLine.writeCopies(" ", 21 - length) }; theRow.append(1) } indexer() = new Indexer { bool Available = theRow < 7;
int Index { get() = theRow.Value; set(int index) { if (index <= theRow) { self.writeTitle() }; while (index > theRow) { self.writeLine() } } }
appendIndex(int index) { this self.Index := theRow.Value + index } get int Length() { ^ 7 }
get() = self; set(o) { NotSupportedException.raise() } }; printTitleTo(output) { output.writePadding(MonthNames[theMonth - 1], $32, 21) } printTo(output) { output.write(theLine.Value) }
}
class Calendar {
int theYear; int theRowLength; constructor new(int year) { theYear := year; theRowLength := 3 } printTo(output) { output.writePadding("[SNOOPY]", $32, theRowLength * 25); output.writeLine(); output.writePadding(theYear.toPrintable(), $32, theRowLength * 25); output.writeLine().writeLine(); var rowCount := 12 / theRowLength; var months := Array.allocate(rowCount).populate:(i => Array.allocate(theRowLength) .populate:(j => new CalendarMonthPrinter(theYear, i * theRowLength + j + 1))); months.forEach:(row) { var r := row; row.forEach:(month) { month.printTitleTo:output; output.write:" " }; output.writeLine(); ParallelEnumerator.new(row).forEach:(line) { line.forEach:(printer) { printer.printTo:output;
output.write:" " };
output.writeLine() } } }
}
public program() {
var calender := Calendar.new(console.write:"ENTER THE YEAR:".readLine().toInt()); calender.printTo:console; console.readChar()
}</lang>
- Output:
ENTER THE YEAR:1969 [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
Fortran
Alas, the header "FORTRAN" is not recognised - REAL programmers were absent that day? Even upon the apperance of lower case, I have preferred to use shouting for programme source, and normal upper/lower case for commentary. Aside from petty details such as 1 and l being nowhere as distinct as 1 and L, this allows the two sorts of blather to be identifiably different without ratiocination as the hours drag past. Further, the names of variables can easily be distinguished from the same word in discussion, as in ... the text in TEXT will be printed as the subtitle to the text in TITLE ... Anyway, in the spirit of old, herewith the source without tedious commentary: <lang FORTRAN>
MODULE DATEGNASH
TYPE DATEBAG INTEGER DAY,MONTH,YEAR END TYPE DATEBAG
CHARACTER*9 MONTHNAME(12),DAYNAME(0:6) PARAMETER (MONTHNAME = (/"JANUARY","FEBRUARY","MARCH","APRIL", 1 "MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER", 2 "DECEMBER"/)) PARAMETER (DAYNAME = (/"SUNDAY","MONDAY","TUESDAY","WEDNESDAY", 1 "THURSDAY","FRIDAY","SATURDAY"/))
INTEGER*4 JDAYSHIFT PARAMETER (JDAYSHIFT = 2415020) CONTAINS INTEGER FUNCTION LSTNB(TEXT) CHARACTER*(*),INTENT(IN):: TEXT INTEGER L L = LEN(TEXT) 1 IF (L.LE.0) GO TO 2 IF (ICHAR(TEXT(L:L)).GT.ICHAR(" ")) GO TO 2 L = L - 1 GO TO 1 2 LSTNB = L RETURN END FUNCTION LSTNB CHARACTER*2 FUNCTION I2FMT(N) INTEGER*4 N IF (N.LT.0) THEN IF (N.LT.-9) THEN I2FMT = "-!" ELSE I2FMT = "-"//CHAR(ICHAR("0") - N) END IF ELSE IF (N.LT.10) THEN I2FMT = " " //CHAR(ICHAR("0") + N) ELSE IF (N.LT.100) THEN I2FMT = CHAR(N/10 + ICHAR("0")) 1 //CHAR(MOD(N,10) + ICHAR("0")) ELSE I2FMT = "+!" END IF END FUNCTION I2FMT CHARACTER*8 FUNCTION I8FMT(N) INTEGER*4 N CHARACTER*8 HIC WRITE (HIC,1) N 1 FORMAT (I8) I8FMT = HIC END FUNCTION I8FMT
SUBROUTINE SAY(OUT,TEXT) INTEGER OUT CHARACTER*(*) TEXT WRITE (6,1) TEXT(1:LSTNB(TEXT)) 1 FORMAT (A) END SUBROUTINE SAY
INTEGER*4 FUNCTION DAYNUM(YY,M,D) INTEGER*4 JDAYN INTEGER YY,Y,M,MM,D Y = YY IF (Y.LT.1) Y = Y + 1 MM = (M - 14)/12 JDAYN = D - 32075 A + 1461*(Y + 4800 + MM)/4 B + 367*(M - 2 - MM*12)/12 C - 3*((Y + 4900 + MM)/100)/4 DAYNUM = JDAYN - JDAYSHIFT END FUNCTION DAYNUM
TYPE(DATEBAG) FUNCTION MUNYAD(DAYNUM) INTEGER*4 DAYNUM,JDAYN INTEGER Y,M,D,L,N JDAYN = DAYNUM + JDAYSHIFT L = JDAYN + 68569 N = 4*L/146097 L = L - (146097*N + 3)/4 Y = 4000*(L + 1)/1461001 L = L - 1461*Y/4 + 31 M = 80*L/2447 D = L - 2447*M/80 L = M/11 M = M + 2 - 12*L Y = 100*(N - 49) + Y + L IF (Y.LT.1) Y = Y - 1 MUNYAD%YEAR = Y MUNYAD%MONTH = M MUNYAD%DAY = D END FUNCTION MUNYAD
INTEGER FUNCTION PMOD(N,M) INTEGER N,M PMOD = MOD(MOD(N,M) + M,M) END FUNCTION PMOD
SUBROUTINE CALENDAR(Y1,Y2,COLUMNS)
INTEGER Y1,Y2,YEAR INTEGER M,M1,M2,MONTH INTEGER*4 DN1,DN2,DN,D INTEGER W,G INTEGER L,LINE INTEGER COL,COLUMNS,COLWIDTH CHARACTER*200 STRIPE(6),SPECIAL(6),MLINE,DLINE W = 3 G = 1 COLWIDTH = 7*W + G Y:DO YEAR = Y1,Y2 CALL SAY(MSG,"") IF (YEAR.EQ.0) THEN CALL SAY(MSG,"THERE IS NO YEAR ZERO.") CYCLE Y END IF MLINE = "" L = (COLUMNS*COLWIDTH - G - 8)/2 IF (YEAR.GT.0) THEN MLINE(L:) = I8FMT(YEAR) ELSE MLINE(L - 1:) = I8FMT(-YEAR)//"BC" END IF CALL SAY(MSG,MLINE) DO MONTH = 1,12,COLUMNS M1 = MONTH M2 = MIN(12,M1 + COLUMNS - 1) MLINE = "" DLINE = "" STRIPE = "" SPECIAL = "" L0 = 1 DO M = M1,M2 L = (COLWIDTH - G - LSTNB(MONTHNAME(M)))/2 - 1 MLINE(L0 + L:) = MONTHNAME(M) DO D = 0,6 L = L0 + (3 - W) + D*W DLINE(L:L + 2) = DAYNAME(D)(1:W - 1) END DO DN1 = DAYNUM(YEAR,M,1) DN2 = DAYNUM(YEAR,M + 1,0) COL = MOD(PMOD(DN1,7) + 7,7) LINE = 1 D = 1 DO DN = DN1,DN2 L = L0 + COL*W STRIPE(LINE)(L:L + 1) = I2FMT(D) D = D + 1 COL = COL + 1 IF (COL.GT.6) THEN LINE = LINE + 1 COL = 0 END IF END DO L0 = L0 + 7*W + G END DO CALL SAY(MSG,MLINE) CALL SAY(MSG,DLINE) DO LINE = 1,6 IF (STRIPE(LINE).NE."") THEN CALL SAY(MSG,STRIPE(LINE)) END IF END DO END DO END DO Y CALL SAY(MSG,"") END SUBROUTINE CALENDAR END MODULE DATEGNASH
PROGRAM SHOW1968 USE DATEGNASH INTEGER NCOL DO NCOL = 1,6 CALL CALENDAR(1969,1969,NCOL) END DO END
</lang>
And for output, the wide form:
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
Actual lineprinters offer the opportunity of overprinting lines so double (or triple) printing of the same text gave a bold effect if with some blurring due to wobble. Further decoration was possible: via underlines (and for overlines, an underline on the previous line) the appearance can be improved. Vertical bars can also be used, and more advanced lineprinters (IBM1403 etc. using the "TN" chain) or dot-matrix printers also supplied "corner" glyphs so that boxes would not have leaks.
FreeBASIC
<lang freebasic>' VERSION 16-03-2016 ' COMPILE WITH: FBC -S CONSOLE
' TRUE/FALSE ARE BUILT-IN CONSTANTS SINCE FREEBASIC 1.04 ' BUT WE HAVE TO DEFINE THEM FOR OLDER VERSIONS.
- IFNDEF TRUE
#DEFINE FALSE 0 #DEFINE TRUE NOT FALSE
- ENDIF
FUNCTION WD(M AS INTEGER, D AS INTEGER, Y AS INTEGER) AS INTEGER
' ZELLERISH ' 0 = SUNDAY, 1 = MONDAY, 2 = TUESDAY, 3 = WEDNESDAY ' 4 = THURSDAY, 5 = FRIDAY, 6 = SATURDAY
IF M < 3 THEN ' IF M = 1 OR M = 2 THEN M += 12 Y -= 1 END IF RETURN (Y + (Y \ 4) - (Y \ 100) + (Y \ 400) + D + ((153 * M + 8) \ 5)) MOD 7
END FUNCTION
FUNCTION LEAPYEAR(Y AS INTEGER) AS INTEGER
IF (Y MOD 4) <> 0 THEN RETURN FALSE IF (Y MOD 100) = 0 ANDALSO (Y MOD 400) <> 0 THEN RETURN FALSE RETURN TRUE
END FUNCTION
' ------=< MAIN >=------ ' HARD CODED FOR 132 CHARACTERS PER LINE
DIM AS STRING WDN = "MO TU WE TH FR SA SU" ' WEEKDAY NAMES DIM AS STRING MO(1 TO 12) => {"JANUARY", "FEBRUARY", "MARCH", "APRIL", _
"MAY", "JUNE", "JULY", "AUGUST", "SEPTEMBER", _ "OCTOBER", "NOVEMBER", "DECEMBER"}
DIM AS STRING TMP1, TMP2, D(1 TO 12)
DIM AS UINTEGER ML(1 TO 12) => {31,28,31,30,31,30,31,31,30,31,30,31} DIM AS UINTEGER I, I1, J, K, Y = 1969
'SCREENRES 1080,600,8
IF LEAPYEAR(Y) = TRUE THEN ML(2) = 29
TMP1 = "" FOR I = 1 TO 31
TMP1 = TMP1 + RIGHT((" " + STR(I)), 3)
NEXT I
FOR I = 1 TO 12
TMP2 = "" J = WD(I,1, Y) IF J = 0 THEN J = 7 J = J - 1 TMP2 = SPACE(J * 3) + LEFT(TMP1, ML(I) * 3) + SPACE(21) D(I) = TMP2
NEXT I
PRINT TMP1 = "INSERT YOUR SNOOPY PICTURE HERE" PRINT SPACE((132 - LEN(TMP1)) \ 2); TMP1 PRINT TMP1 = STR(Y) PRINT SPACE((132 - LEN(TMP1)) \ 2); TMP1 PRINT
' 6 MONTH ON A ROW TMP2 = " " FOR I = 1 TO 6
TMP2 = TMP2 + WDN IF I < 6 THEN TMP2 = TMP2 + " "
NEXT I
FOR I = 1 TO 12 STEP 6
TMP1 = "" FOR J = I TO I + 4 TMP1 = TMP1 + LEFT(SPACE((22 - LEN(MO(J))) \ 2) + MO(J) + SPACE(11), 22) NEXT J TMP1 = TMP1 + SPACE((22 - LEN(MO(I + 5))) \ 2) + MO(I + 5) PRINT TMP1 PRINT TMP2 FOR J = 1 TO 85 STEP 21 FOR K = I TO I + 4 PRINT MID(D(K), J ,21); " "; NEXT K PRINT MID(D(I + 5), J ,21) NEXT J PRINT
NEXT I
' EMPTY KEYBOARD BUFFER WHILE INKEY <> "" : WEND PRINT : PRINT "HIT ANY KEY TO END PROGRAM" SLEEP END</lang>
- Output:
INSERT YOUR SNOOPY PICTURE HERE 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 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
Go
Go is case-sensitive: all its keywords and certain other identifiers/verbs are lower case and imported functions etc. are title case. Consequently, it is impossible to run an upper case version of the Calendar task program as it stands. So what I've done instead is to follow the approach of the Kotlin entry:
1. Saved the Calendar program, after conversion to upper case to a text file called realcal_UC.txt.
2. Written another program called realcal.go which takes realcalc_UC.txt as input, outputs a runnable program called realcal_NC.go to disk, runs it and prints the output to the terminal (Ubuntu 16.04 being used). This program only makes the minimum changes to realcal_UC.txt to enable it to run. Everything else is left as upper case even though this is at odds with the usual Go naming conventions.
This is realcal_UC.txt: <lang go>PACKAGE MAIN
IMPORT (
"FMT" "TIME"
)
CONST PAGEWIDTH = 80
FUNC MAIN() {
PRINTCAL(1969)
}
FUNC PRINTCAL(YEAR INT) {
THISDATE := TIME.DATE(YEAR, 1, 1, 1, 1, 1, 1, TIME.UTC) VAR ( DAYARR [12][7][6]INT // MONTH, WEEKDAY, WEEK MONTH, LASTMONTH TIME.MONTH WEEKINMONTH, DAYINMONTH INT ) FOR THISDATE.YEAR() == YEAR { IF MONTH = THISDATE.MONTH(); MONTH != LASTMONTH { WEEKINMONTH = 0 DAYINMONTH = 1 } WEEKDAY := THISDATE.WEEKDAY() IF WEEKDAY == 0 && DAYINMONTH > 1 { WEEKINMONTH++ } DAYARR[INT(MONTH)-1][WEEKDAY][WEEKINMONTH] = THISDATE.DAY() LASTMONTH = MONTH DAYINMONTH++ THISDATE = THISDATE.ADD(TIME.HOUR * 24) } CENTRE := FMT.SPRINTF("%D", PAGEWIDTH/2) FMT.PRINTF("%"+CENTRE+"S\N\N", "[SNOOPY]") CENTRE = FMT.SPRINTF("%D", PAGEWIDTH/2-2) FMT.PRINTF("%"+CENTRE+"D\N\N", YEAR) MONTHS := [12]STRING{ " JANUARY ", " FEBRUARY", " MARCH ", " APRIL ", " MAY ", " JUNE ", " JULY ", " AUGUST ", "SEPTEMBER", " OCTOBER ", " NOVEMBER", " DECEMBER"} DAYS := [7]STRING{"SU", "MO", "TU", "WE", "TH", "FR", "SA"} FOR QTR := 0; QTR < 4; QTR++ { FOR MONTHINQTR := 0; MONTHINQTR < 3; MONTHINQTR++ { // MONTH NAMES FMT.PRINTF(" %S ", MONTHS[QTR*3+MONTHINQTR]) } FMT.PRINTLN() FOR MONTHINQTR := 0; MONTHINQTR < 3; MONTHINQTR++ { // DAY NAMES FOR DAY := 0; DAY < 7; DAY++ { FMT.PRINTF(" %S", DAYS[DAY]) } FMT.PRINTF(" ") } FMT.PRINTLN() FOR WEEKINMONTH = 0; WEEKINMONTH < 6; WEEKINMONTH++ { FOR MONTHINQTR := 0; MONTHINQTR < 3; MONTHINQTR++ { FOR DAY := 0; DAY < 7; DAY++ { IF DAYARR[QTR*3+MONTHINQTR][DAY][WEEKINMONTH] == 0 { FMT.PRINTF(" ") } ELSE { FMT.PRINTF("%3D", DAYARR[QTR*3+MONTHINQTR][DAY][WEEKINMONTH]) } } FMT.PRINTF(" ") } FMT.PRINTLN() } FMT.PRINTLN() }
}</lang>
and this is realcal.go: <lang go>package main
import (
"io/ioutil" "log" "os" "os/exec" "strings"
)
func check(err error) {
if err != nil { log.Fatal(err) }
}
func main() {
lower := []string{ "const ", "else ", "for ", "func ", "if ", "import ", "int ", "package ", "string ", "var ", " int", "int(", "string{", " main", "main(", "fmt", "time", "%d", "%s", "%3d", `d\n\n`, `s\n\n`, } title := []string{ ".add", ".date", ".day", ".hour", ".month", ".printf", ".println", ".sprintf", ".weekday", ".year", } code, err := ioutil.ReadFile("realcal_UC.txt") check(err) text := string(code) for _, lwr := range lower { text = strings.Replace(text, strings.ToUpper(lwr), lwr, -1) } for _, ttl := range title { text = strings.Replace(text, strings.ToUpper(ttl), "."+strings.Title(ttl[1:]), -1) } err = ioutil.WriteFile("realcal_NC.go", []byte(text), 0666) check(err) cmd := exec.Command("go", "run", "realcal_NC.go") cmd.Stdout = os.Stdout cmd.Stderr = os.Stderr check(cmd.Run())
}</lang>
which produces (as expected) this output:
[SNOOPY] 1969 JANUARY FEBRUARY MARCH 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 MAY JUNE 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 AUGUST SEPTEMBER 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 NOVEMBER DECEMBER 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
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(YEAR,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() $) $) RETURN
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 $define DATETIME datetime $define RETURN return</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 organized text but the months are not yet arranged).
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 width 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. We do a little extra work here to make sure that a 20 character wide calendar can be displayed. (In that case, we trim off the left and right borders. We use the same trimming code in all cases, but typically we trim empty space added specially for this purpose. That said, the 20 character wide thing seems to be gone from the task description so this definition should be simplified...)
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 of F will work fine with a left argument of 20 (why anyone felt that this was important to mention is perhaps best thought of as an issue lost in history).
Julia
Julia code is a valid data type in Julia. Executable code can be created from a String with Meta.parse() and run with eval. This example does require a small function with Julia's lowercase keywords, perhaps loaded on startup from a separate file. <lang julia>
- IF THIS SMALL FUNCTION IS PLACED IN THE STARTUP.JL
- FILE, IT WILL BE LOADED ON STARTUP. THE REST OF
- THIS EXAMPLE IS IN ALL UPPERCASE.
function RUNUPPERCASECODE(CO)
COD = replace(lowercase(CO), "date" => "Date") for E in Meta.parse(COD, 1) eval(E) end
end
CODE = """BEGIN
USING DATES; CENTEROBJECT(X, N) = BEGIN S = UPPERCASE(STRING(X)); RPAD(LPAD(S, DIV(N + LENGTH(S), 2)), N) END; FUNCTION FORMATMONTH(YR, MO)
DT = DATE(\"\$YR-\$MO-01\"); DAYOFWEEKFIRST = DAYOFWEEK(DT); NUMWEEKLINES = 1; STR = UPPERCASE(CENTEROBJECT(MONTHNAME(DT), 20) * \"\\NMO TU WE TH FR SA SU\\N\"); STR *= \" \" ^ (3 * (DAYOFWEEKFIRST - 1)) * LPAD(STRING(1), 2); FOR I = 2:DAYSINMONTH(DT) IF (I + DAYOFWEEKFIRST + 5) % 7 == 0 STR *= \"\\N\" * LPAD(I, 2); NUMWEEKLINES += 1; ELSE STR *= LPAD(STRING(I), 3); END; END; STR *= NUMWEEKLINES < 6 ? \"\\N\\N\\N\" : \"\\N\\N\"; ARR = []; FOR S IN SPLIT(STR, \"\\N\") PUSH!(ARR, RPAD(S, 20)[1:20]) END; JOIN(ARR, \"\\N\");
END;
FUNCTION FORMATYEAR(DISPLAYYEAR)
CALMONTHS = [FORMATMONTH(DISPLAYYEAR, MO) FOR MO IN 1:12]; MONTHSPERLINE = 6; JOINSPACES = 2; STR = \"\\N\" * CENTEROBJECT(DISPLAYYEAR, 132) * \"\\N\"; MONTHCAL = [SPLIT(FORMATMONTH(DISPLAYYEAR, I), \"\\N\") FOR I IN 1:12]; FOR I IN 1:MONTHSPERLINE:LENGTH(CALMONTHS) - 1 FOR J IN 1:LENGTH(MONTHCAL[1]) MONTHLINES = MAP(X->MONTHCAL[X][J], I:I + MONTHSPERLINE - 1); STR *= RPAD(JOIN(MONTHLINES, \" \" ^ JOINSPACES), 132) * \"\\N\"; END; STR *= \"\\N\"; END; STR;
END;
PRINTLN(FORMATYEAR(1969));
END; """
RUNUPPERCASECODE(CODE)
</lang>
- Output:
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
Kotlin
Kotlin is case-sensitive: all its keywords and packages are lower case, all its library classes are mixed case and its library functions are either lower case or mixed case. Consequently, it is impossible to run an upper case version of the Calendar task program as it stands. So what I've done instead (and similar to what several other languages in the same boat have done) is:
1. Saved the Calendar program, after conversion to upper case and a small marked alteration to give upper case output, to a text file called calendar_UC.txt.
2. Written another program called real_calendar.kt which takes calendar_UC.txt as input, outputs a runnable program called calendar_NC.kt to disk, compiles it to a .jar file, runs it, captures the output and prints it to the terminal (Ubuntu 14.04 being used). This program only makes the minimum changes to calendar_UC.txt to enable it to run. Everything else is left as upper case even though almost certainly no Kotlin programmer ("REAL" or not) would write such a program in practice.
This is calendar_UC.txt:
<lang scala>IMPORT JAVA.TEXT.* IMPORT JAVA.UTIL.* IMPORT JAVA.IO.PRINTSTREAM
INTERNAL FUN PRINTSTREAM.PRINTCALENDAR(YEAR: INT, NCOLS: BYTE, LOCALE: LOCALE?) {
IF (NCOLS < 1 || NCOLS > 12) THROW ILLEGALARGUMENTEXCEPTION("ILLEGAL COLUMN WIDTH.") VAL W = NCOLS * 24 VAL NROWS = MATH.CEIL(12.0 / NCOLS).TOINT() VAL DATE = GREGORIANCALENDAR(YEAR, 0, 1) VAR OFFS = DATE.GET(CALENDAR.DAY_OF_WEEK) - 1 VAL DAYS = DATEFORMATSYMBOLS(LOCALE).SHORTWEEKDAYS.SLICE(1..7).MAP { IT.SLICE(0..1) }.JOINTOSTRING(" ", " ") VAL MONS = ARRAY(12) { ARRAY(8) { "" } } DATEFORMATSYMBOLS(LOCALE).MONTHS.SLICE(0..11).FOREACHINDEXED { M, NAME -> VAL LEN = 11 + NAME.LENGTH / 2 VAL FORMAT = MESSAGEFORMAT.FORMAT("%{0}S%{1}S", LEN, 21 - LEN) MONS[M][0] = STRING.FORMAT(FORMAT, NAME, "") MONS[M][1] = DAYS VAL DIM = DATE.GETACTUALMAXIMUM(CALENDAR.DAY_OF_MONTH) FOR (D IN 1..42) { VAL ISDAY = D > OFFS && D <= OFFS + DIM VAL ENTRY = IF (ISDAY) STRING.FORMAT(" %2S", D - OFFS) ELSE " " IF (D % 7 == 1) MONS[M][2 + (D - 1) / 7] = ENTRY ELSE MONS[M][2 + (D - 1) / 7] += ENTRY } OFFS = (OFFS + DIM) % 7 DATE.ADD(CALENDAR.MONTH, 1) } PRINTF("%" + (W / 2 + 10) + "S%N", "[SNOOPY PICTURE]") PRINTF("%" + (W / 2 + 4) + "S%N%N", YEAR) FOR (R IN 0..NROWS - 1) { FOR (I IN 0..7) { VAR C = R * NCOLS WHILE (C < (R + 1) * NCOLS && C < 12) { PRINTF(" %S", MONS[C][I].TOUPPERCASE()) // ORIGINAL CHANGED TO PRINT IN UPPER CASE C++ } PRINTLN() } PRINTLN() }
}
FUN MAIN(ARGS: ARRAY<STRING>) {
SYSTEM.OUT.PRINTCALENDAR(1969, 3, LOCALE.US)
}</lang>
and this is real_calendar.kt:
<lang scala>// version 1.1.3
import java.io.File import java.io.BufferedReader import java.io.InputStreamReader
fun main(args: Array<String>) {
val keywords = listOf( "import", "internal", "fun", "if", "throw", "val", "var", "for", "in", "while" )
val singleCase = listOf( "java.text", "java.util", "java.io", "else", // really a keyword but doesn't have a following space here "ceil", "it", // really a keyword but doesn't have a following space here "get(", // also included in GETACTUALMAXIMUM "slice", "map", "months", "length", ".format", // also variable called FORMAT "add", "printf", "println", "out", "main", "args", "s%{1}s", "%2s", "s%n%n", "s%n", "%s" ) val mixedCase = listOf( "PRINTSTREAM" to "PrintStream", "INT," to "Int,", // also included in PRINTCALENDAR "BYTE" to "Byte", "LOCALE?" to "Locale?", // also variable called LOCALE "LOCALE." to "Locale.", "ILLEGALARGUMENTEXCEPTION" to "IllegalArgumentException", "MATH" to "Math", "GREGORIANCALENDAR" to "GregorianCalendar", "DATEFORMATSYMBOLS" to "DateFormatSymbols", "ARRAY" to "Array", "MESSAGEFORMAT" to "MessageFormat", "JOINTOSTRING" to "joinToString", "STRING" to "String", "CALENDAR." to "Calendar.", // also included in PRINTCALENDAR "SYSTEM" to "System", "TOINT" to "toInt", "SHORTWEEKDAYS" to "shortWeekdays", "FOREACHINDEXED" to "forEachIndexed", "GETACTUALMAXIMUM" to "getActualMaximum", "TOUPPERCASE" to "toUpperCase" ) var text = File("calendar_UC.txt").readText() for (k in keywords) text = text.replace("${k.toUpperCase()} ", "$k ") // add a following space to be on safe side for (s in singleCase) text = text.replace(s.toUpperCase(), s) for (m in mixedCase) text = text.replace(m.first, m.second) File("calendar_NC.kt").writeText(text) val commands = listOf("kotlinc", "calendar_NC.kt", "-include-runtime", "-d", "calendar_X.jar") val pb = ProcessBuilder(commands) pb.redirectErrorStream(true) val process = pb.start() process.waitFor() val commands2 = listOf("java", "-jar", "calendar_NC.jar") val pb2 = ProcessBuilder(commands2) pb2.redirectErrorStream(true) val process2 = pb2.start() val out = StringBuilder() val br = BufferedReader(InputStreamReader(process2.inputStream)) while (true) { val line = br.readLine() if (line == null) break out.append(line).append('\n') } br.close() println(out.toString())
}</lang>
which generates (on disk) calendar_NC.kt:
<lang scala>import java.text.* import java.util.* import java.io.PrintStream
internal fun PrintStream.PRINTCALENDAR(YEAR: Int, NCOLS: Byte, LOCALE: Locale?) {
if (NCOLS < 1 || NCOLS > 12) throw IllegalArgumentException("ILLEGAL COLUMN WIDTH.") val W = NCOLS * 24 val NROWS = Math.ceil(12.0 / NCOLS).toInt() val DATE = GregorianCalendar(YEAR, 0, 1) var OFFS = DATE.get(Calendar.DAY_OF_WEEK) - 1 val DAYS = DateFormatSymbols(LOCALE).shortWeekdays.slice(1..7).map { it.slice(0..1) }.joinToString(" ", " ") val MONS = Array(12) { Array(8) { "" } } DateFormatSymbols(LOCALE).months.slice(0..11).forEachIndexed { M, NAME -> val LEN = 11 + NAME.length / 2 val FORMAT = MessageFormat.format("%{0}s%{1}s", LEN, 21 - LEN) MONS[M][0] = String.format(FORMAT, NAME, "") MONS[M][1] = DAYS val DIM = DATE.getActualMaximum(Calendar.DAY_OF_MONTH) for (D in 1..42) { val ISDAY = D > OFFS && D <= OFFS + DIM val ENTRY = if (ISDAY) String.format(" %2s", D - OFFS) else " " if (D % 7 == 1) MONS[M][2 + (D - 1) / 7] = ENTRY else MONS[M][2 + (D - 1) / 7] += ENTRY } OFFS = (OFFS + DIM) % 7 DATE.add(Calendar.MONTH, 1) } printf("%" + (W / 2 + 10) + "s%n", "[SNOOPY PICTURE]") printf("%" + (W / 2 + 4) + "s%n%n", YEAR) for (R in 0..NROWS - 1) { for (I in 0..7) { var C = R * NCOLS while (C < (R + 1) * NCOLS && C < 12) { printf(" %s", MONS[C][I].toUpperCase()) // ORIGINAL CHANGED TO PRINT in UPPER CASE C++ } println() } println() }
}
fun main(args: Array<String>) {
System.out.PRINTCALENDAR(1969, 3, Locale.US)
}</lang>
which when compiled and run produces output of:
[SNOOPY PICTURE] 1969 JANUARY FEBRUARY MARCH 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 MAY JUNE 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 AUGUST SEPTEMBER 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 NOVEMBER DECEMBER 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
Lua
Tested with Lua 5.3.2
Lua is case sensitive and all the keywords and library routines are in lower case. As with the D sample, we use a simple pre-processor to execute the (slightly modified) upper-cased source of the Lua solution for the standard Calendar task.
The upper case Lua source - stored in a file called UCCALENDAR.LUU:
<lang lua>FUNCTION PRINT_CAL(YEAR)
LOCAL MONTHS={"JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE", "JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER"} LOCAL DAYSTITLE="MO TU WE TH FR SA SU" LOCAL DAYSPERMONTH={31,28,31,30,31,30,31,31,30,31,30,31} LOCAL STARTDAY=((YEAR-1)*365+MATH.FLOOR((YEAR-1)/4)-MATH.FLOOR((YEAR-1)/100)+MATH.FLOOR((YEAR-1)/400))%7 IF YEAR%4==0 AND YEAR%100~=0 OR YEAR%400==0 THEN DAYSPERMONTH[2]=29 END LOCAL SEP=5 LOCAL MONTHWIDTH=DAYSTITLE:LEN() LOCAL CALWIDTH=3*MONTHWIDTH+2*SEP FUNCTION CENTER(STR, WIDTH) LOCAL FILL1=MATH.FLOOR((WIDTH-STR:LEN())/2) LOCAL FILL2=WIDTH-STR:LEN()-FILL1 RETURN STRING.REP(" ",FILL1)..STR..STRING.REP(" ",FILL2) END FUNCTION MAKEMONTH(NAME, SKIP,DAYS) LOCAL CAL={ CENTER(NAME,MONTHWIDTH), DAYSTITLE } LOCAL CURDAY=1-SKIP WHILE #CAL<9 DO LINE={} FOR I=1,7 DO IF CURDAY<1 OR CURDAY>DAYS THEN LINE[I]=" " ELSE LINE[I]=STRING.FORMAT("%2D",CURDAY) END CURDAY=CURDAY+1 END CAL[#CAL+1]=TABLE.CONCAT(LINE," ") END RETURN CAL END LOCAL CALENDAR={} FOR I,MONTH IN IPAIRS(MONTHS) DO LOCAL DPM=DAYSPERMONTH[I] CALENDAR[I]=MAKEMONTH(MONTH, STARTDAY, DPM) STARTDAY=(STARTDAY+DPM)%7 END PRINT(CENTER("[SNOOPY]",CALWIDTH):UPPER(),"\N") PRINT(CENTER("--- "..YEAR.." ---",CALWIDTH):UPPER(),"\N") FOR Q=0,3 DO FOR L=1,9 DO LINE={} FOR M=1,3 DO LINE[M]=CALENDAR[Q*3+M][L] END PRINT(TABLE.CONCAT(LINE,STRING.REP(" ",SEP)):UPPER()) END END
END
PRINT_CAL(1969)
</lang>
The following "one-liner" standard Lua source will down-case and run the program in the source file specified as it's parameter (file luu.lua):
<lang lua>do io.input( arg[ 1 ] ); local s = io.read( "*a" ):lower(); io.close(); assert( load( s ) )() end
</lang>
The following command will execute the UCCALENDAR.LUU source (replace lua532 with the appropriate command for your system):
lua532 luu.lua UCCALENDAR.LUU
- 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
M2000 Interpreter
Console 132 characters by 43 lines. Six columns for months.
<lang M2000 Interpreter>
GLOBAL CONST PRINT_IT AS BOOLEAN=FALSE MODULE GLOBAL SNOOPY { IF NOT PRINT_IT THEN CURSOR 0,ROW ELSE IF ROW>0 THEN PAGE 1 PRINT $(,8) PRINT #-2, { XXXX X XX X *** X XXXXX X ***** X XXX XX XXXX ******* XXX XXXX XX XX X ****** XXXXXXXXX El@ XX XXX XX X **** X X** X X XX XX X X***X X //XXXX X XXXX X // X XX X // X XXXXXXXXXXXXXXXXXX/ X XXX// X X X X X X X X X X X X X X X X X XX X X X X X XXX XX X XXX X X X X X X X X X XX X XXXX X X XXXXXXXX\ XX XX X XX XX X X @X XX XX XXXX XXXXXX/ X XXXX XXX XX*** X X XXXXXXXXXXXXX * * X X *---* X X X *-* * XXX X X *- * XXX X *- *X XXX *- *X X XXX *- *X X XX *- *XX X X * *X* X X X * *X * X X X * * X** X XXXX X * * X** XX X X * ** X** X XX X * ** X* XXX X X * ** XX XXXX XXX * * * XXXX X X * * * X X X =======******* * * X X XXXXXXXX\ * * * /XXXXX XXXXXXXX\ ) =====********** * X ) \ ) ====* * X \ \ )XXXXX =========********** XXXXXXXXXXXXXXXXXXXXXX
} } MODULE CALENDAR (YEAR, LOCALEID) {
FUNCTION GETMAX(YEAR, MONTH) { A=DATE(STR$(YEAR)+"-"+STR$(MONTH)+"-1") MAX=32 DO { MAX-- M=VAL(STR$(CDATE(A,0,0,MAX), "M")) } UNTIL M=MONTH =MAX+1 } FUNCTION SKIPMO(YEAR, MONTH) { A=DATE(STR$(YEAR)+"-"+STR$(MONTH)+"-1") =(VAL(STR$(A, "W"))-8) MOD 7 +7 } FUNCTION TITLE$(A$) { =UCASE$(LEFT$(A$,1))+LCASE$(MID$(A$, 2)) } LOCALE LOCALEID IF NOT PRINT_IT THEN CURSOR 0,HEIGHT-1 ' LAST LINE, SO EACH NEW LINE SCROLL ALL LINES UP SNOOPY PRINT UNDER ' PRINT UNDERLINE PRINT OVER $(2), YEAR PRINT FOR J=0 TO 1 { PRINT FOR I=1 TO 6 { MONTH=I+J*6 PRINT PART @((I-1)*22), $(2,21), UCASE$(LOCALE$(55+MONTH)) } PRINT DIM SKIP(1 TO 6), COUNT(1 TO 6), D(1 TO 6)=1 FOR I=1 TO 6 { MONTH=I+J*6 IF I>1 THEN PRINT " "; FOR K=42 TO 48 :PRINT " ";UCASE$(LEFT$(LOCALE$(K),2));:NEXT K SKIP(I)=SKIPMO(YEAR, MONTH) COUNT(I)=GETMAX(YEAR, MONTH) } PRINT FOR I=1 TO 6 { IF I>1 THEN PRINT " "; FOR K=1 TO 7 { SKIP(I)-- IF SKIP(I)>0 THEN PRINT " "; :CONTINUE COUNT(I)-- PRINT FORMAT$(" {0::-2}", D(I)); D(I)++ } } PRINT PRINT @(0) FOR M=1 TO 5 { FOR I=1 TO 6 { IF I>1 THEN PRINT " "; FOR K=1 TO 7 { COUNT(I)-- IF COUNT(I)<0 THEN PRINT " "; : CONTINUE PRINT FORMAT$(" {0::-2}", D(I)); D(I)++ } } PRINT } }
} WHILE INKEY$<>"" : END WHILE IF PRINT_IT THEN PRINTING ON FONT "COURIER NEW" PEN 0 CLS 15, 0 FORM 132,68 CALENDAR 1966, 1032 ' GREEK GOSUB WAITKEY_OR_MOUSE FOR I=2019 TO 2025 CALENDAR I, 1033 ' ENGLISH GOSUB WAITKEY_OR_MOUSE NEXT I IF PRINT_IT THEN PRINTING OFF CLEAR ' CLEAR VARIABLES FROM THIS MODULE KEYBOARD "INFO"+CHR$(13) END WAITKEY_OR_MOUSE: IF PRINT_IT THEN RETURN WHILE INKEY$="" AND MOUSE=0 END WHILE RETURN
</lang>
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, and Unixish cal command.] <lang perl6>$_="\0".."~";< 115 97 121 32 34 91 73 78 83 69 82 84 32 83 78 79 79 80 89 32 72 69 82 69 93 34 59 114 117 110 32 60 99 97 108 62 44 64 42 65 82 71 83 91 48 93 47 47 49 57 54 57 >."$_[99]$_[104]$_[114]$_[115]"()."$_[69]$_[86]$_[65]$_[76]"()</lang>
Phix
OK, I'm not going to take this too seriously but this is as good an opportunity as I'll ever get to showcase how trivial it is to make some rather fundamental changes to the compiler.
So, the first task is to take a copy of Calendar and make it output uppercase. Change the line
<lang Phix>return repeat(' ',left)&s&repeat(' ',right)</lang>
in routine centre to:
<lang Phix>return repeat(' ',left)&upper(s)&repeat(' ',right)</lang>
(That's that done.) Now, Phix is case-sensitive, and many of the keywords and builtins are in lower case, which presents a bit of a challenge - but we can cope.
It is too tedious and not particularly helpful to present a completed solution, instead I shall outline the (relatively simple) steps this would require. I have limited my tests to INCLUDE and INTEGER.
In psym.e you can find the line <lang Phix>initialSymEntry("integer", S_Type,"TI",opInt, E_none) -- #01 / 0b0001 integer</lang> Immediately after that (it should now be there commented out) add: <lang Phix>Alias("INTEGER",symlimit)</lang>
Add similar lines for length, floor, repeat, upper, day_of_week, sequence, string, sprintf, append, printf, join, at the appropriate places.
Keywords are handled slightly differently: In pttree.e we need a new alias routine (you should find this one commented out, from when I was testing all this): <lang Phix>procedure tt_stringA(sequence text, integer alias)
tt_string(text,-2) tt[pcurr] = alias
end procedure</lang> and you can find the line <lang Phix>global constant T_include = 596 tt_stringF("include",T_include)</lang> Sometime after that, in fact after the very last use of tt_stringF, add (likewise you should find this one commented out): <lang Phix>tt_stringA("INCLUDE",T_include)</lang>
Add similar lines for function, end, iff, for, to, do, if, or, then, else, return, procedure, but this time all some ways away from the originals. Quickly run "p p" and make sure you get a normal prompt, without any "T_include should be 624(not 596)" or suchlike.
Currently ptok.e recognises \n
but not \N
. Search for all references to escchar
(there should be one definition and two references) and make sure the character being
checked is mapped to lower case, ie change (twice)
<lang Phix>Ch = find(Ch,escchar)</lang>
to
<lang Phix>Ch = find(lower(Ch),escchar)</lang>
Lastly, the calendar example includes builtins\timedate.e, which contains some lower-case definitions. So copy it to (say) TIMEDATEUPPER.E and change adjust_timedate, timedelta, days (the 2nd param to timedelta), and format_timedate to their uppercase equivalents, and of course change that include to INCLUDE BUILTINS\TIMEDATEUPPER.E
.
There is probably some change in ptok.e/pttree.e even simpler than the steps outlined above that makes everything case insensitive, but locating that is left as an exercise for the reader.
You don't actually have to repackage to test this, just run p p test.exw - percentagewise it might be ten times slower (as p.exw is much bigger than test.exw), but it'll still only be a fraction of a second.
Finally, you can take that copy of Calendar and make it all uppercase. In Edita (shipped with Phix) that is just <Ctrl A><Alt U>.
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>
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
PL/I
<lang PL/I>(SUBRG, SIZE, FOFL): CALENDAR: PROCEDURE (YEAR) OPTIONS (MAIN);
DECLARE YEAR CHARACTER (4) VARYING; DECLARE (A, B, C) (0:5,0:6) CHARACTER (3); DECLARE NAME_MONTH(12) STATIC CHARACTER (9) VARYING INITIAL ( 'JANUARY', 'FEBRUARY', 'MARCH', 'APRIL', 'MAY', 'JUNE', 'JULY', 'AUGUST', 'SEPTEMBER', 'OCTOBER', 'NOVEMBER', 'DECEMBER'); DECLARE I FIXED; DECLARE (MM, MMP1, MMP2) PIC '99';
PUT EDIT (CENTER('CALENDAR FOR ' || YEAR, 67)) (A); PUT SKIP (2);
DO MM = 1 TO 12 BY 3; MMP1 = MM + 1; MMP2 = MM + 2; CALL PREPARE_MONTH('01' || MM || YEAR, A); CALL PREPARE_MONTH('01' || MMP1 || YEAR, B); CALL PREPARE_MONTH('01' || MMP2 || YEAR, C);
PUT SKIP EDIT (CENTER(NAME_MONTH(MM), 23), CENTER(NAME_MONTH(MMP1), 23), CENTER(NAME_MONTH(MMP2), 23) ) (A); PUT SKIP EDIT ((3)' M T W T F S S ') (A); DO I = 0 TO 5; PUT SKIP EDIT (A(I,*), B(I,*), C(I,*)) (7 A, X(2)); END; END;
PREPARE_MONTH: PROCEDURE (START, MONTH);
DECLARE MONTH(0:5,0:6) CHARACTER (3); DECLARE START CHARACTER (8); DECLARE I PIC 'ZZ9'; DECLARE OFFSET FIXED; DECLARE (J, DAY) FIXED BINARY (31); DECLARE (THIS_MONTH, NEXT_MONTH, K) FIXED BINARY;
DAY = DAYS(START, 'DDMMYYYY'); OFFSET = WEEKDAY(DAY) - 1; IF OFFSET = 0 THEN OFFSET = 7; MONTH = ; DO J = DAY BY 1; THIS_MONTH = SUBSTR(DAYSTODATE(J, 'DDMMYYYY'), 3, 2); NEXT_MONTH = SUBSTR(DAYSTODATE(J+1, 'DDMMYYYY'), 3, 2); IF THIS_MONTH^= NEXT_MONTH THEN LEAVE; END; I = 1; DO K = OFFSET-1 TO OFFSET+J-DAY-1; MONTH(K/7, MOD(K,7)) = I; I = I + 1; END;
END PREPARE_MONTH;
END CALENDAR;</lang> See CALENDAR for result.
Racket
<lang racket>
- CI(MODULE NAME-OF-THIS-FILE RACKET
(REQUIRE RACKET/DATE) (DEFINE (CALENDAR YR)
(DEFINE (NSPLIT N L) (IF (NULL? L) L (CONS (TAKE L N) (NSPLIT N (DROP L N))))) (DEFINE MONTHS (FOR/LIST ([MN (IN-NATURALS 1)] [MNAME '(JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER)]) (DEFINE S (FIND-SECONDS 0 0 12 1 MN YR)) (DEFINE PFX (DATE-WEEK-DAY (SECONDS->DATE S))) (DEFINE DAYS (LET ([? (IF (= MN 12) (Λ(X Y) Y) (Λ(X Y) X))]) (ROUND (/ (- (FIND-SECONDS 0 0 12 1 (? (+ 1 MN) 1) (? YR (+ 1 YR))) S) 60 60 24)))) (LIST* (~A MNAME #:WIDTH 20 #:ALIGN 'CENTER) "SU MO TU WE TH FR SA" (MAP STRING-JOIN (NSPLIT 7 `(,@(MAKE-LIST PFX " ") ,@(FOR/LIST ([D DAYS]) (~A (+ D 1) #:WIDTH 2 #:ALIGN 'RIGHT)) ,@(MAKE-LIST (- 42 PFX DAYS) " "))))))) (LET* ([S '(" 11,-~4-._3. 41-4! 10/ ()=(2) 3\\ 40~A! 9( 3( 80 39-4! 10\\._\\" ", ,-4'! 5#2X3@7! 12/ 2-3'~2;! 11/ 4/~2|-! 9=( 3~4 2|! 3/~42\\! " "2/_23\\! /_25\\!/_27\\! 3|_20|! 3|_20|! 3|_20|! 3| 20|!!")] [S (REGEXP-REPLACE* "!" (STRING-APPEND* S) "~%")] [S (REGEXP-REPLACE* "@" S (STRING-FOLDCASE "X"))] [S (REGEXP-REPLACE* ".(?:[1-7][0-9]*|[1-9])" S (Λ(M) (MAKE-STRING (STRING->NUMBER (SUBSTRING M 1)) (STRING-REF M 0))))]) (PRINTF S YR)) (FOR-EACH (COMPOSE1 DISPLAYLN STRING-TITLECASE) (DROPF-RIGHT (FOR*/LIST ([3MS (NSPLIT 3 MONTHS)] [S (APPLY MAP LIST 3MS)]) (REGEXP-REPLACE " +$" (STRING-JOIN S " ") "")) (Λ(S) (EQUAL? "" S)))))
(CALENDAR 1969)) </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.]
This version automatically will use the depth and width of the terminal screen to determine which layout fits best.
However, the depth and width can be overridden with the depth and width keywords.
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=
PARSE VALUE SCRSIZE() WITH SD SW .
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 _=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\== ...*/
IF SD==0 THEN SD= 43; SD= SD-3 IF SW==0 THEN SW= 80; SW= SW-1 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); 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>
Programming note: This REXX program makes use of SCRSIZE REXX program (or
BIF) which is used to determine the screen
width and depth of the terminal (console). Some REXXes don't
have this BIF.
The SCRSIZE.REX REXX program is included here ───► SCRSIZE.REX.
- output when using the input of: 1/1/1969 (NOGRID SHORTER NARROWER)
(Shown at 2/3 size.)
«Snoopy "picture" here» January 1969 February 1969 March 1969 April 1969 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 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 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 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 26 27 28 29 30 31 23 24 25 26 27 28 23 24 25 26 27 28 29 27 28 29 30 30 31 May 1969 June 1969 July 1969 August 1969 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 1 2 3 4 5 6 7 1 2 3 4 5 1 2 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 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 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 25 26 27 28 29 30 31 29 30 27 28 29 30 31 24 25 26 27 28 29 30 31 September 1969 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 Su Mo Tu We Th Fr Sa 1 2 3 4 5 6 1 2 3 4 1 1 2 3 4 5 6 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 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 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 28 29 30 26 27 28 29 30 31 23 24 25 26 27 28 29 28 29 30 31 30
- output when using the input of: 1/1/1969 (SHORTER NARROWER)
(Shown at 2/3 size.)
«Snoopy "picture" here» ┌──────────────────────────────────┐ ┌──────────────────────────────────┐ ┌──────────────────────────────────┐ ┌──────────────────────────────────┐ │ │ │ │ │ │ │ │ │ January 1969 │ │ February 1969 │ │ March 1969 │ │ April 1969 │ │ │ │ │ │ │ │ │ │ Sun Mon Tue Wed Thu Fri Sat│ │ Sun Mon Tue Wed Thu Fri Sat│ │ Sun Mon Tue Wed Thu Fri Sat│ │ Sun Mon Tue Wed Thu Fri Sat│ ├────┬────┬────┬────┬────┬────┬────┤ ├────┬────┬────┬────┬────┬────┬────┤ ├────┬────┬────┬────┬────┬────┬────┤ ├────┬────┬────┬────┬────┬────┬────┤ │ │ │ │ 1 │ 2 │ 3 │ 4 │ │ │ │ │ │ │ │ 1 │ │ │ │ │ │ │ │ 1 │ │ │ │ 1 │ 2 │ 3 │ 4 │ 5 │ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ │ 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 │ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ │ 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 │ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ │ 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 │ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ │ 26 │ 27 │ 28 │ 29 │ 30 │ 31 │ │ │ 23 │ 24 │ 25 │ 26 │ 27 │ 28 │ │ │ 23 │ 24 │ 25 │ 26 │ 27 │ 28 │ 29 │ │ 27 │ 28 │ 29 │ 30 │ │ │ │ └────┴────┴────┴────┴────┴────┴────┘ └────┴────┴────┴────┴────┴────┴────┘ ├────┼────┼────┼────┼────┼────┼────┤ └────┴────┴────┴────┴────┴────┴────┘ │ 30 │ 31 │ │ │ │ │ │ └────┴────┴────┴────┴────┴────┴────┘ ┌──────────────────────────────────┐ ┌──────────────────────────────────┐ ┌──────────────────────────────────┐ ┌──────────────────────────────────┐ │ │ │ │ │ │ │ │ │ May 1969 │ │ June 1969 │ │ July 1969 │ │ August 1969 │ │ │ │ │ │ │ │ │ │ Sun Mon Tue Wed Thu Fri Sat│ │ Sun Mon Tue Wed Thu Fri Sat│ │ Sun Mon Tue Wed Thu Fri Sat│ │ Sun Mon Tue Wed Thu Fri Sat│ ├────┬────┬────┬────┬────┬────┬────┤ ├────┬────┬────┬────┬────┬────┬────┤ ├────┬────┬────┬────┬────┬────┬────┤ ├────┬────┬────┬────┬────┬────┬────┤ │ │ │ │ │ 1 │ 2 │ 3 │ │ 1 │ 2 │ 3 │ 4 │ 5 │ 6 │ 7 │ │ │ │ 1 │ 2 │ 3 │ 4 │ 5 │ │ │ │ │ │ │ 1 │ 2 │ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ │ 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 │ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ │ 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 │ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ │ 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 │ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ │ 25 │ 26 │ 27 │ 28 │ 29 │ 30 │ 31 │ │ 29 │ 30 │ │ │ │ │ │ │ 27 │ 28 │ 29 │ 30 │ 31 │ │ │ │ 24 │ 25 │ 26 │ 27 │ 28 │ 29 │ 30 │ └────┴────┴────┴────┴────┴────┴────┘ └────┴────┴────┴────┴────┴────┴────┘ └────┴────┴────┴────┴────┴────┴────┘ ├────┼────┼────┼────┼────┼────┼────┤ │ 31 │ │ │ │ │ │ │ └────┴────┴────┴────┴────┴────┴────┘ ┌──────────────────────────────────┐ ┌──────────────────────────────────┐ ┌──────────────────────────────────┐ ┌──────────────────────────────────┐ │ │ │ │ │ │ │ │ │ September 1969 │ │ October 1969 │ │ November 1969 │ │ December 1969 │ │ │ │ │ │ │ │ │ │ Sun Mon Tue Wed Thu Fri Sat│ │ Sun Mon Tue Wed Thu Fri Sat│ │ Sun Mon Tue Wed Thu Fri Sat│ │ Sun Mon Tue Wed Thu Fri Sat│ ├────┬────┬────┬────┬────┬────┬────┤ ├────┬────┬────┬────┬────┬────┬────┤ ├────┬────┬────┬────┬────┬────┬────┤ ├────┬────┬────┬────┬────┬────┬────┤ │ │ 1 │ 2 │ 3 │ 4 │ 5 │ 6 │ │ │ │ │ 1 │ 2 │ 3 │ 4 │ │ │ │ │ │ │ │ 1 │ │ │ 1 │ 2 │ 3 │ 4 │ 5 │ 6 │ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ │ 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 │ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ │ 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 │ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ │ 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 │ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ ├────┼────┼────┼────┼────┼────┼────┤ │ 28 │ 29 │ 30 │ │ │ │ │ │ 26 │ 27 │ 28 │ 29 │ 30 │ 31 │ │ │ 23 │ 24 │ 25 │ 26 │ 27 │ 28 │ 29 │ │ 28 │ 29 │ 30 │ 31 │ │ │ │ └────┴────┴────┴────┴────┴────┴────┘ └────┴────┴────┴────┴────┴────┴────┘ ├────┼────┼────┼────┼────┼────┼────┤ └────┴────┴────┴────┴────┴────┴────┘ │ 30 │ │ │ │ │ │ │ └────┴────┴────┴────┴────┴────┴────┘
Ring
<lang ring>
- PROJECT : CALENDAR - FOR "REAL" PROGRAMMERS
- DATE : 2018/06/28
- AUTHOR : GAL ZSOLT (~ CALMOSOFT ~)
- EMAIL : <CALMOSOFT@GMAIL.COM>
LOAD "GUILIB.RING" LOAD "STDLIB.RING"
NEW QAPP
{ WIN1 = NEW QWIDGET() { DAY = LIST(12) POS = NEWLIST(12,37) MONTH = LIST(12) WEEK = LIST(7) WEEKDAY = LIST(7) BUTTON = NEWLIST(7,6) MONTHSNAMES = LIST(12) WEEK = ["SU", "MO", "TU", "WE", "TH", "FR", "SA"] MONTHS = ["JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE", "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER"] DAYSNEW = [[5,1], [6,2], [7,3], [1,4], [2,5], [3,6], [4,7]] MO = [4,0,0,3,5,1,3,6,2,4,0,2] MON = [31,28,31,30,31,30,31,31,30,31,30,31] M2 = (((1969-1900)%7) + FLOOR((1969 - 1900)/4) % 7) % 7 FOR N = 1 TO 12 MONTH[N] = (MO[N] + M2) % 7 X = (MONTH[N] + 1) % 7 + 1 FOR M = 1 TO LEN(DAYSNEW) IF DAYSNEW[M][1] = X NR = M OK NEXT DAY[N] = DAYSNEW[NR][2] NEXT FOR M = 1 TO 12 FOR N = 1 TO DAY[M] - 1 POS[M][N] = " " NEXT NEXT FOR M = 1 TO 12 FOR N = DAY[M] TO 37 IF N < (MON[M] + DAY[M]) POS[M][N] = N - DAY[M] + 1 ELSE POS[M][N] = " " OK NEXT NEXT SETWINDOWTITLE("CALENDAR") SETGEOMETRY(100,100,650,800) LABEL1 = NEW QLABEL(WIN1) { SETGEOMETRY(10,10,800,600) SETTEXT("") } YEAR = NEW QPUSHBUTTON(WIN1) { SETGEOMETRY(280,20,63,20) YEAR.SETTEXT("1969") } FOR N = 1 TO 4 NR = (N-1)*3+1 SHOWMONTHS(NR) NEXT FOR N = 1 TO 12 SHOWWEEKS(N) NEXT FOR N = 1 TO 12 SHOWDAYS(N) NEXT SHOW() } EXEC() }
FUNC SHOWMONTHS(M)
FOR N = M TO M + 2 MONTHSNAMES[N] = NEW QPUSHBUTTON(WIN1) { IF N%3 = 1 COL = 120 ROWNR = FLOOR(N/3) IF ROWNR = 0 ROWNR = N/3 OK IF N = 1 ROW = 40 ELSE ROW = 40+ROWNR*180 OK ELSE COLNR = N%3 IF COLNR = 0 COLNR = 3 OK ROWNR = FLOOR(N/3) IF N%3 = 0 ROWNR = FLOOR(N/3)-1 OK COL = 120 + (COLNR-1)*160 ROW = 40 + ROWNR*180 OK SETGEOMETRY(COL,ROW,63,20) MONTHSNAMES[N].SETTEXT(MONTHS[N]) } NEXT
FUNC SHOWWEEKS(N)
FOR M = 1 TO 7 COL = M%7 IF COL = 0 COL = 7 OK WEEKDAY[M] = NEW QPUSHBUTTON(WIN1) { COLNR = N % 3 IF COLNR = 0 COLNR = 3 OK ROWNR = FLOOR(N/3) IF N%3 = 0 ROWNR = FLOOR(N/3)-1 OK COLBEGIN = 60 + (COLNR-1)*160 ROWBEGIN = 60 + (ROWNR)*180 SETGEOMETRY(COLBEGIN+COL*20,ROWBEGIN,25,20) WEEKDAY[M].SETTEXT(WEEK[M]) } NEXT
FUNC SHOWDAYS(IND)
ROWNR = FLOOR(IND/3) IF IND%3 = 0 ROWNR = FLOOR(IND/3)-1 OK ROWBEGIN = 60+ROWNR*180 FOR M = 1 TO 6 FOR N = 1 TO 7 COL = N%7 IF COL = 0 COL = 7 OK ROW = M BUTTON[N][M] = NEW QPUSHBUTTON(WIN1) { IF IND%3 = 1 COLBEGIN = 60 ELSEIF IND%3 = 2 COLBEGIN = 220 ELSE COLBEGIN = 380 OK SETGEOMETRY(COLBEGIN+COL*20,ROWBEGIN+ROW*20,25,20) NR = (M-1)*7+N IF NR <= 37 IF POS[IND][NR] != " " BUTTON[N][M].SETTEXT(STRING(POS[IND][NR])) OK OK } NEXT NEXT
</lang> Output:
CALENDAR - FOR "REAL" PROGRAMMERS
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.rb
is 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.RB
is 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.SUPERCLASS
finds the superclass of the class of the empty array; this is theObject
class! Class#CONST_GET finds some other classes.- Class#DEFINE_METHOD defines a new method, Object#CAL, without a
def
keyword. - Kernel#LOOP, Kernel#THROW, Kernel#CATCH and operator
||
act like a while loop without awhile
keyword.
$ 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
Seed7
Seed7 keywords are lower case, so this silly solution uses the whole Calendar Task code, with small changes and all in upper case, in a text file named "CALENDAR.TXT":
$ INCLUDE "SEED7_05.S7I"; INCLUDE "TIME.S7I"; CONST FUNC STRING: CENTER (IN STRING: STRI, IN INTEGER: LENGTH) IS RETURN ("" LPAD (LENGTH - LENGTH(STRI)) DIV 2 <& STRI) RPAD LENGTH; CONST PROC: PRINTCALENDAR (IN INTEGER: YEAR, IN INTEGER: COLS) IS FUNC LOCAL VAR TIME: DATE IS TIME.VALUE; VAR INTEGER: DAYOFWEEK IS 0; CONST ARRAY STRING: MONTHNAMES IS [] ("JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE", "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER"); VAR ARRAY ARRAY STRING: MONTHTABLE IS 12 TIMES 9 TIMES ""; VAR STRING: STR IS ""; VAR INTEGER: MONTH IS 0; VAR INTEGER: POSITION IS 0; VAR INTEGER: ROW IS 0; VAR INTEGER: COLUMN IS 0; VAR INTEGER: LINE IS 0; BEGIN FOR MONTH RANGE 1 TO 12 DO MONTHTABLE[MONTH][1] := " " & CENTER(UPPER(MONTHNAMES[MONTH]), 20); MONTHTABLE[MONTH][2] := UPPER(" MO TU WE TH FR SA SU"); DATE := DATE(YEAR, MONTH, 1); DAYOFWEEK := DAYOFWEEK(DATE); FOR POSITION RANGE 1 TO 43 DO IF POSITION >= DAYOFWEEK AND POSITION - DAYOFWEEK < DAYSINMONTH(DATE.YEAR, DATE.MONTH) THEN STR := SUCC(POSITION - DAYOFWEEK) LPAD 3; ELSE STR := "" LPAD 3; END IF; MONTHTABLE[MONTH][3 + PRED(POSITION) DIV 7] &:= STR; END FOR; END FOR; WRITELN(CENTER(UPPER("[SNOOPY PICTURE]"), COLS * 24 + 4)); WRITELN(CENTER(STR(YEAR),COLS * 24 + 4)); WRITELN; FOR ROW RANGE 1 TO SUCC(11 DIV COLS) DO FOR LINE RANGE 1 TO 9 DO FOR COLUMN RANGE 1 TO COLS DO IF PRED(ROW) * COLS + COLUMN <= 12 THEN WRITE(" " & MONTHTABLE[PRED(ROW) * COLS + COLUMN][LINE]); END IF; END FOR; WRITELN; END FOR; END FOR; END FUNC; CONST PROC: MAIN IS FUNC BEGIN PRINTCALENDAR(1969, 3); END FUNC;
Then in another program the file CALENDAR.TXT is read, converted, parsed and executed: <lang seed7>$ include "seed7_05.s7i";
include "getf.s7i"; include "progs.s7i";
const proc: main is func
local var string: source is ""; begin source := lower(getf("CALENDAR.TXT")); source := replace(source, "dayofweek", "dayOfWeek"); source := replace(source, "daysinmonth", "daysInMonth"); execute(parseStri(source)); end func;</lang>
- Output:
[SNOOPY PICTURE] 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
Sidef
<lang ruby>-> DT { ('DATE'.("\LWC") + 'TIME'.("\LWC")).("\LREQUIRE") }
-> MONTHS_PER_COL { 6 } -> WEEK_DAY_NAMES { <MO TU WE TH FR SA SU> } -> MONTH_NAMES { <JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC> }
-> FMT_MONTH (YEAR, MONTH, STR="", WEEK_DAY=0) {
STR = "%11\LS\E%9\LS\E\12".("\LSPRINTF")(MONTH_NAMES()[MONTH-1],) STR += (WEEK_DAY_NAMES().("\LJOIN")(' ') + "\12")
-> DATE { DT().("\LNEW")("\LYEAR" => YEAR, "\LMONTH" => MONTH) }
WEEK_DAY = DATE().("\LDAY_OF_WEEK") STR += ([" "] * WEEK_DAY-1 -> ("\LJOIN")(" "))
-> LAST_DAY { DT().("\LLAST_DAY_OF_MONTH")( "\LYEAR" => YEAR, "\LMONTH" => MONTH ).("\LDAY") }
(DATE().("\LDAY") .. LAST_DAY()).("\LEACH")({ |DAY| (WEEK_DAY ~~ (2..7)) && (STR += " ")
(WEEK_DAY == 8) && ( STR += "\12" WEEK_DAY = 1 ) STR += ("%2\LD" % DAY) ++WEEK_DAY }) (WEEK_DAY < 8) && (STR += " ") STR += ([" "] * 8-WEEK_DAY -> ("\LJOIN")(" ")) STR += "\12"
}
-> FMT_YEAR (YEAR, STR="", MONTH_STRS=[]) {
MONTH_STRS = 12.("\LOF")({|I| FMT_MONTH(YEAR, I+1).("\LLINES") })
STR += (' '*(MONTHS_PER_COL()*10 + 2) + YEAR + "\12") (0..11 -> ("\LBY")(MONTHS_PER_COL())).("\LEACH")({ |MONTH| MONTH_STRS[MONTH] && ->() { { |I| MONTH_STRS[MONTH + I] && ( STR += MONTH_STRS[MONTH + I].("\LSHIFT") STR += ' '*2 ) } * MONTHS_PER_COL()
STR += "\12" MONTH_STRS[MONTH] && __FUNC__() }() STR += "\12" })
STR
}
FMT_YEAR(ARGV ? ARGV[0].("\LTO_I") : 1969).("\LPRINT")</lang>
- Output:
1969 JAN FEB MAR APR MAY JUN 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 JUL AUG SEP OCT NOV DEC 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
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
UNIX Shell
<lang shell>CAL=CAL TR=TR A=A Z=Z LANG=C ${CAL,,} 1969 | ${TR,,} ${A,}-${Z,} A-Z</lang>
- Output:
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
- 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) FOR (#8 = 1; #8 <= #11; #8++) {
NI(#8, COUNT, 3) #5 = (#8+#10+5) % 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
Visual Basic .NET
Compiler: Roslyn Visual Basic (language version >= 15.8)
Copied from Calendar#Visual_Basic_.NET and converted to uppercase. See entry there for description.
<lang vbnet>OPTION COMPARE BINARY OPTION EXPLICIT ON OPTION INFER ON OPTION STRICT ON
IMPORTS SYSTEM.GLOBALIZATION IMPORTS SYSTEM.TEXT IMPORTS SYSTEM.RUNTIME.INTEROPSERVICES IMPORTS SYSTEM.RUNTIME.COMPILERSERVICES
MODULE ARGHELPER
READONLY _ARGDICT AS NEW DICTIONARY(OF STRING, STRING)()
DELEGATE FUNCTION TRYPARSE(OF T, TRESULT)(VALUE AS T, <OUT> BYREF RESULT AS TRESULT) AS BOOLEAN
SUB INITIALIZEARGUMENTS(ARGS AS STRING()) FOR EACH ITEM IN ARGS ITEM = ITEM.TOUPPERINVARIANT()
IF ITEM.LENGTH > 0 ANDALSO ITEM(0) <> """"C THEN DIM COLONPOS = ITEM.INDEXOF(":"C, STRINGCOMPARISON.ORDINAL)
IF COLONPOS <> -1 THEN ' SPLIT ARGUMENTS WITH COLUMNS INTO KEY(PART BEFORE COLON) / VALUE(PART AFTER COLON) PAIRS. _ARGDICT.ADD(ITEM.SUBSTRING(0, COLONPOS), ITEM.SUBSTRING(COLONPOS + 1, ITEM.LENGTH - COLONPOS - 1)) END IF END IF NEXT END SUB
SUB FROMARGUMENT(OF T)( KEY AS STRING, <OUT> BYREF VAR AS T, GETDEFAULT AS FUNC(OF T), TRYPARSE AS TRYPARSE(OF STRING, T), OPTIONAL VALIDATE AS PREDICATE(OF T) = NOTHING)
DIM VALUE AS STRING = NOTHING IF _ARGDICT.TRYGETVALUE(KEY.TOUPPERINVARIANT(), VALUE) THEN IF NOT (TRYPARSE(VALUE, VAR) ANDALSO (VALIDATE IS NOTHING ORELSE VALIDATE(VAR))) THEN CONSOLE.WRITELINE($"INVALID VALUE FOR {KEY}: {VALUE}") ENVIRONMENT.EXIT(-1) END IF ELSE VAR = GETDEFAULT() END IF END SUB
END MODULE
MODULE PROGRAM
SUB MAIN(ARGS AS STRING()) DIM DT AS DATE DIM COLUMNS, ROWS, MONTHSPERROW AS INTEGER DIM VERTSTRETCH, HORIZSTRETCH, RESIZEWINDOW AS BOOLEAN
INITIALIZEARGUMENTS(ARGS) FROMARGUMENT("DATE", DT, FUNCTION() NEW DATE(1969, 1, 1), ADDRESSOF DATE.TRYPARSE) FROMARGUMENT("COLS", COLUMNS, FUNCTION() 80, ADDRESSOF INTEGER.TRYPARSE, FUNCTION(V) V >= 20) FROMARGUMENT("ROWS", ROWS, FUNCTION() 43, ADDRESSOF INTEGER.TRYPARSE, FUNCTION(V) V >= 0) FROMARGUMENT("MS/ROW", MONTHSPERROW, FUNCTION() 0, ADDRESSOF INTEGER.TRYPARSE, FUNCTION(V) V <= 12 ANDALSO V <= COLUMNS \ 20) FROMARGUMENT("VSTRETCH", VERTSTRETCH, FUNCTION() TRUE, ADDRESSOF BOOLEAN.TRYPARSE) FROMARGUMENT("HSTRETCH", HORIZSTRETCH, FUNCTION() TRUE, ADDRESSOF BOOLEAN.TRYPARSE) FROMARGUMENT("WSIZE", RESIZEWINDOW, FUNCTION() TRUE, ADDRESSOF BOOLEAN.TRYPARSE)
' THE SCROLL BAR IN COMMAND PROMPT SEEMS TO TAKE UP PART OF THE LAST COLUMN. IF RESIZEWINDOW THEN CONSOLE.WINDOWWIDTH = COLUMNS + 1 CONSOLE.WINDOWHEIGHT = ROWS END IF
IF MONTHSPERROW < 1 THEN MONTHSPERROW = MATH.MAX(COLUMNS \ 22, 1)
FOR EACH ROW IN GETCALENDARROWS(DT:=DT, WIDTH:=COLUMNS, HEIGHT:=ROWS, MONTHSPERROW:=MONTHSPERROW, VERTSTRETCH:=VERTSTRETCH, HORIZSTRETCH:=HORIZSTRETCH) CONSOLE.WRITE(ROW) NEXT END SUB
ITERATOR FUNCTION GETCALENDARROWS( DT AS DATE, WIDTH AS INTEGER, HEIGHT AS INTEGER, MONTHSPERROW AS INTEGER, VERTSTRETCH AS BOOLEAN, HORIZSTRETCH AS BOOLEAN) AS IENUMERABLE(OF STRING)
DIM YEAR = DT.YEAR DIM CALENDARROWCOUNT AS INTEGER = CINT(MATH.CEILING(12 / MONTHSPERROW)) ' MAKE ROOM FOR THE THREE EMPTY LINES ON TOP. DIM MONTHGRIDHEIGHT AS INTEGER = HEIGHT - 3
YIELD "[SNOOPY]".PADCENTER(WIDTH) & ENVIRONMENT.NEWLINE YIELD YEAR.TOSTRING(CULTUREINFO.INVARIANTCULTURE).PADCENTER(WIDTH) & ENVIRONMENT.NEWLINE YIELD ENVIRONMENT.NEWLINE
DIM MONTH = 0 DO WHILE MONTH < 12 DIM ROWHIGHESTMONTH = MATH.MIN(MONTH + MONTHSPERROW, 12)
DIM CELLWIDTH = WIDTH \ MONTHSPERROW DIM CELLCONTENTWIDTH = IF(MONTHSPERROW = 1, CELLWIDTH, (CELLWIDTH * 19) \ 20)
DIM CELLHEIGHT = MONTHGRIDHEIGHT \ CALENDARROWCOUNT DIM CELLCONTENTHEIGHT = (CELLHEIGHT * 19) \ 20
' CREATES A MONTH CELL FOR THE SPECIFIED MONTH (1-12). DIM GETMONTHFROM = FUNCTION(M AS INTEGER) BUILDMONTH( DT:=NEW DATE(DT.YEAR, M, 1), WIDTH:=CELLCONTENTWIDTH, HEIGHT:=CELLCONTENTHEIGHT, VERTSTRETCH:=VERTSTRETCH, HORIZSTRETCH:=HORIZSTRETCH).SELECT(FUNCTION(X) X.PADCENTER(CELLWIDTH))
' THE MONTHS IN THIS ROW OF THE CALENDAR. DIM MONTHSTHISROW AS IENUMERABLE(OF IENUMERABLE(OF STRING)) = ENUMERABLE.SELECT(ENUMERABLE.RANGE(MONTH + 1, ROWHIGHESTMONTH - MONTH), GETMONTHFROM)
DIM CALENDARROW AS IENUMERABLE(OF STRING) = INTERLEAVED( MONTHSTHISROW, USEINNERSEPARATOR:=FALSE, USEOUTERSEPARATOR:=TRUE, OUTERSEPARATOR:=ENVIRONMENT.NEWLINE)
DIM EN = CALENDARROW.GETENUMERATOR() DIM HASNEXT = EN.MOVENEXT() DO WHILE HASNEXT
DIM CURRENT AS STRING = EN.CURRENT
' TO MAINTAIN THE (NOT STRICTLY NEEDED) CONTRACT OF YIELDING COMPLETE ROWS, KEEP THE NEWLINE AFTER ' THE CALENDAR ROW WITH THE LAST TERMINAL ROW OF THE ROW. HASNEXT = EN.MOVENEXT() YIELD IF(HASNEXT, CURRENT, CURRENT & ENVIRONMENT.NEWLINE) LOOP
MONTH += MONTHSPERROW LOOP END FUNCTION
<SUMMARY> INTERLEAVES THE ELEMENTS OF THE SPECIFIED SUB-SOURCES BY MAKING SUCCESSIVE PASSES THROUGH THE SOURCE ENUMERABLE, YIELDING A SINGLE ELEMENT FROM EACH SUB-SOURCE IN SEQUENCE IN EACH PASS, OPTIONALLY INSERTING A SEPARATOR BETWEEN ELEMENTS OF ADJACENT SUB-SOURCES AND OPTIONALLY A DIFFERENT SEPARATOR AT THE END OF EACH PASS THROUGH ALL THE SOURCES. (I.E., BETWEEN ELEMENTS OF THE LAST AND FIRST SOURCE) </SUMMARY> <TYPEPARAM NAME="T">THE TYPE OF THE ELEMENTS OF THE SUB-SOURCES.</TYPEPARAM> <PARAM NAME="SOURCES">A SEQUENCE OF THE SEQUENCES WHOSE ELEMENTS ARE TO BE INTERLEAVED.</PARAM> <PARAM NAME="USEINNERSEPARATOR">WHETHER TO INSERT <PARAMREF NAME="USEINNERSEPARATOR"/> BETWEEN THE ELEMENTS OFADJACENT SUB-SOURCES.</PARAM> <PARAM NAME="INNERSEPARATOR">THE SEPARATOR BETWEEN ELEMENTS OF ADJACENT SUB-SOURCES.</PARAM> <PARAM NAME="USEOUTERSEPARATOR">WHETHER TO INSERT <PARAMREF NAME="OUTERSEPARATOR"/> BETWEEN THE ELEMENTS OF THE LAST AND FIRST SUB-SOURCES.</PARAM> <PARAM NAME="OUTERSEPARATOR">THE SEPARATOR BETWEEN ELEMENTS OF THE LAST AND FIRST SUB-SOURCE.</PARAM> <PARAM NAME="WHILEANY">IF <SEE LANGWORD="TRUE"/>, THE ENUMERATION CONTINUES UNTIL EVERY GIVEN SUBSOURCE IS EMPTY; IF <SEE LANGWORD="FALSE"/>, THE ENUMERATION STOPS AS SOON AS ANY ENUMERABLE NO LONGER HAS AN ELEMENT TO SUPPLY FOR THE NEXT PASS.</PARAM> ITERATOR FUNCTION INTERLEAVED(OF T)( SOURCES AS IENUMERABLE(OF IENUMERABLE(OF T)), OPTIONAL USEINNERSEPARATOR AS BOOLEAN = FALSE, OPTIONAL INNERSEPARATOR AS T = NOTHING, OPTIONAL USEOUTERSEPARATOR AS BOOLEAN = FALSE, OPTIONAL OUTERSEPARATOR AS T = NOTHING, OPTIONAL WHILEANY AS BOOLEAN = TRUE) AS IENUMERABLE(OF T) DIM SOURCEENUMERATORS AS IENUMERATOR(OF T)() = NOTHING
TRY SOURCEENUMERATORS = SOURCES.SELECT(FUNCTION(X) X.GETENUMERATOR()).TOARRAY() DIM NUMSOURCES = SOURCEENUMERATORS.LENGTH DIM ENUMERATORSTATES(NUMSOURCES - 1) AS BOOLEAN
DIM ANYPREVITERS AS BOOLEAN = FALSE DO ' INDICES OF FIRST AND LAST SUB-SOURCES THAT HAVE ELEMENTS. DIM FIRSTACTIVE = -1, LASTACTIVE = -1
' DETERMINE WHETHER EACH SUB-SOURCE THAT STILL HAVE ELEMENTS. FOR I = 0 TO NUMSOURCES - 1 ENUMERATORSTATES(I) = SOURCEENUMERATORS(I).MOVENEXT() IF ENUMERATORSTATES(I) THEN IF FIRSTACTIVE = -1 THEN FIRSTACTIVE = I LASTACTIVE = I END IF NEXT
' DETERMINE WHETHER TO YIELD ANYTHING IN THIS ITERATION BASED ON WHETHER WHILEANY IS TRUE. ' NOT YIELDING ANYTHING THIS ITERATION IMPLIES THAT THE ENUMERATION HAS ENDED. DIM THISITERHASRESULTS AS BOOLEAN = IF(WHILEANY, FIRSTACTIVE <> -1, FIRSTACTIVE = 0 ANDALSO LASTACTIVE = NUMSOURCES - 1) IF NOT THISITERHASRESULTS THEN EXIT DO
' DON'T INSERT A SEPARATOR ON THE FIRST PASS. IF ANYPREVITERS THEN IF USEOUTERSEPARATOR THEN YIELD OUTERSEPARATOR ELSE ANYPREVITERS = TRUE END IF
' GO THROUGH AND YIELD FROM THE SUB-SOURCES THAT STILL HAVE ELEMENTS. FOR I = 0 TO NUMSOURCES - 1 IF ENUMERATORSTATES(I) THEN ' DON'T INSERT A SEPARATOR BEFORE THE FIRST ELEMENT. IF I > FIRSTACTIVE ANDALSO USEINNERSEPARATOR THEN YIELD INNERSEPARATOR YIELD SOURCEENUMERATORS(I).CURRENT END IF NEXT LOOP
FINALLY IF SOURCEENUMERATORS ISNOT NOTHING THEN FOR EACH EN IN SOURCEENUMERATORS EN.DISPOSE() NEXT END IF END TRY END FUNCTION
<SUMMARY> RETURNS THE ROWS REPRESENTING ONE MONTH CELL WITHOUT TRAILING NEWLINES. APPROPRIATE LEADING AND TRAILING WHITESPACE IS ADDED SO THAT EVERY ROW HAS THE LENGTH OF WIDTH. </SUMMARY> <PARAM NAME="DT">A DATE WITHIN THE MONTH TO REPRESENT.</PARAM> <PARAM NAME="WIDTH">THE WIDTH OF THE CELL.</PARAM> <PARAM NAME="HEIGHT">THE HEIGHT.</PARAM> <PARAM NAME="VERTSTRETCH">IF <SEE LANGWORD="TRUE" />, BLANK ROWS ARE INSERTED TO FIT THE AVAILABLE HEIGHT. OTHERWISE, THE CELL HAS A CONSTANT HEIGHT OF </PARAM> <PARAM NAME="HORIZSTRETCH">IF <SEE LANGWORD="TRUE" />, THE SPACING BETWEEN INDIVIDUAL DAYS IS INCREASED TO FIT THE AVAILABLE WIDTH. OTHERWISE, THE CELL HAS A CONSTANT WIDTH OF 20 CHARACTERS AND IS PADDED TO BE IN THE CENTER OF THE EXPECTED WIDTH.</PARAM> ITERATOR FUNCTION BUILDMONTH(DT AS DATE, WIDTH AS INTEGER, HEIGHT AS INTEGER, VERTSTRETCH AS BOOLEAN, HORIZSTRETCH AS BOOLEAN) AS IENUMERABLE(OF STRING) CONST DAY_WDT = 2 ' WIDTH OF A DAY. CONST ALLDAYS_WDT = DAY_WDT * 7 ' WIDTH OF AL LDAYS COMBINED.
' NORMALIZE THE DATE TO JANUARY 1. DT = NEW DATE(DT.YEAR, DT.MONTH, 1)
' HORIZONTAL WHITESPACE BETWEEN DAYS OF THE WEEK. CONSTANT OF 6 REPRESENTS 6 SEPARATORS PER LINE. DIM DAYSEP AS NEW STRING(" "C, MATH.MIN((WIDTH - ALLDAYS_WDT) \ 6, IF(HORIZSTRETCH, INTEGER.MAXVALUE, 1))) ' NUMBER OF BLANK LINES BETWEEN ROWS. DIM VERTBLANKCOUNT = IF(NOT VERTSTRETCH, 0, (HEIGHT - 8) \ 7)
' WIDTH OF EACH DAY * 7 DAYS IN ONE ROW + DAY SEPARATOR LENGTH * 6 SEPARATORS PER LINE. DIM BLOCKWIDTH = ALLDAYS_WDT + DAYSEP.LENGTH * 6
' THE WHITESPACE AT THE BEGINNING OF EACH LINE. DIM LEFTPAD AS NEW STRING(" "C, (WIDTH - BLOCKWIDTH) \ 2) ' THE WHITESPACE FOR BLANK LINES. DIM FULLPAD AS NEW STRING(" "C, WIDTH)
' LINES ARE "STAGED" IN THE STRINGBUILDER. DIM SB AS NEW STRINGBUILDER(LEFTPAD) DIM NUMLINES = 0
' GET THE CURRENT LINE SO FAR FORM THE STRINGBUILDER AND BEGIN A NEW LINE. ' RETURNS THE CURRENT LINE AND TRAILING BLANK LINES USED FOR VERTICAL PADDING (IF ANY). ' RETURNS EMPTY ENUMERABLE IF THE HEIGHT REQUIREMENT HAS BEEN REACHED. DIM ENDLINE = FUNCTION() AS IENUMERABLE(OF STRING) DIM FINISHEDLINE AS STRING = SB.TOSTRING().PADRIGHT(WIDTH) SB.CLEAR() SB.APPEND(LEFTPAD)
' USE AN INNER ITERATOR TO PREVENT LAZY EXECUTION OF SIDE EFFECTS OF OUTER FUNCTION. RETURN IF(NUMLINES >= HEIGHT, ENUMERABLE.EMPTY(OF STRING)(), ITERATOR FUNCTION() AS IENUMERABLE(OF STRING) YIELD FINISHEDLINE NUMLINES += 1
FOR I = 1 TO VERTBLANKCOUNT IF NUMLINES >= HEIGHT THEN RETURN YIELD FULLPAD NUMLINES += 1 NEXT END FUNCTION()) END FUNCTION
' YIELD THE MONTH NAME. SB.APPEND(PADCENTER(DT.TOSTRING("MMMM", CULTUREINFO.INVARIANTCULTURE), BLOCKWIDTH).TOUPPER()) FOR EACH L IN ENDLINE() YIELD L NEXT
' YIELD THE HEADER OF WEEKDAY NAMES. DIM WEEKNMABBREVS = [ENUM].GETNAMES(GETTYPE(DAYOFWEEK)).SELECT(FUNCTION(X) X.SUBSTRING(0, 2).TOUPPER()) SB.APPEND(STRING.JOIN(DAYSEP, WEEKNMABBREVS)) FOR EACH L IN ENDLINE() YIELD L NEXT
' DAY OF WEEK OF FIRST DAY OF MONTH. DIM STARTWKDY = CINT(DT.DAYOFWEEK)
' INITIALIZE WITH EMPTY SPACE FOR THE FIRST LINE. DIM FIRSTPAD AS NEW STRING(" "C, (DAY_WDT + DAYSEP.LENGTH) * STARTWKDY) SB.APPEND(FIRSTPAD)
DIM D = DT DO WHILE D.MONTH = DT.MONTH SB.APPENDFORMAT(CULTUREINFO.INVARIANTCULTURE, $"{{0,{DAY_WDT}}}", D.DAY)
' EACH ROW ENDS ON SATURDAY. IF D.DAYOFWEEK = DAYOFWEEK.SATURDAY THEN FOR EACH L IN ENDLINE() YIELD L NEXT ELSE SB.APPEND(DAYSEP) END IF
D = D.ADDDAYS(1) LOOP
' KEEP ADDING EMPTY LINES UNTIL THE HEIGHT QUOTA IS MET. DIM NEXTLINES AS IENUMERABLE(OF STRING) DO NEXTLINES = ENDLINE() FOR EACH L IN NEXTLINES YIELD L NEXT LOOP WHILE NEXTLINES.ANY() END FUNCTION
<SUMMARY> RETURNS A NEW STRING THAT CENTER-ALIGNS THE CHARACTERS IN THIS STRING BY PADDING TO THE LEFT AND RIGHT WITH THE SPECIFIED CHARACTER TO A SPECIFIED TOTAL LENGTH. </SUMMARY> <PARAM NAME="S">THE STRING TO CENTER-ALIGN.</PARAM> <PARAM NAME="TOTALWIDTH">THE NUMBER OF CHARACTERS IN THE RESULTING STRING.</PARAM> <PARAM NAME="PADDINGCHAR">THE PADDING CHARACTER.</PARAM> <EXTENSION()> PRIVATE FUNCTION PADCENTER(S AS STRING, TOTALWIDTH AS INTEGER, OPTIONAL PADDINGCHAR AS CHAR = " "C) AS STRING RETURN S.PADLEFT(((TOTALWIDTH - S.LENGTH) \ 2) + S.LENGTH, PADDINGCHAR).PADRIGHT(TOTALWIDTH, PADDINGCHAR) END FUNCTION
END MODULE</lang>
- Output — for input
COLS:132 ROWS:25 MS/ROW:6 HSTRETCH:FALSE VSTRETCH:FALSE
:
[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
XLISP
XLISP isn't case-sensitive, so in principle it would be possible just to reproduce the solution given in the "ordinary" Calendar task. But that program makes use of recursion, "fancy" data structures, long variable names, pretty-printy indentation, and a whole host of other features that I don't think REAL programmers like any better than they like lower case: so, instead, here is a version using only global variables and "DO loops like God meant them to be". <lang lisp>(SETQ YR 1969) (SETQ M #("JANUARY" "FEBRUARY" "MARCH" "APRIL" "MAY" "JUNE" "JULY" "AUGUST" "SEPTEMBER" "OCTOBER" "NOVEMBER" "DECEMBER")) (SETQ ML #(31 28 31 30 31 30 31 31 30 31 30 31)) (SETQ WD #("SU" "MO" "TU" "WE" "TH" "FR" "SA")) (IF (AND (= (REM YR 4) 0) (OR (/= (REM YR 100) 0) (= (REM YR 400) 0))) (VECTOR-SET! ML 1 29)) (SETQ D (REM (+ 1 (+ (* 5 (REM (- YR 1) 4)) (* 4 (REM (- YR 1) 100)) (* 6 (REM (- YR 1) 400)))) 7)) (TERPRI) (DO ((I 0 (+ I 1))) ((> I 60)) (PRINC " ")) (PRINC "SNOOPY CALENDAR ") (PRINC YR) (TERPRI) (DO ((I 0 (+ I 1))) ((> I 11)) (TERPRI) (DO ((J 0 (+ J 1))) ((> J 65)) (PRINC " ")) (PRINC (VECTOR-REF M I)) (TERPRI) (PRINC " ") (DO ((J 0 (+ J 1))) ((> J 6)) (DO ((K 0 (+ K 1))) ((> K 14)) (PRINC " ")) (PRINC (VECTOR-REF WD J)) (PRINC " ")) (TERPRI) (DO ((J 0 (+ J 1))) ((> J 6)) (IF (< J D) (DO ((K 0 (+ K 1))) ((> K 18)) (PRINC " ")))) (DO ((J 1 (+ J 1))) ((> J (VECTOR-REF ML I))) (PRINC " ") (IF (< J 10) (PRINC " ")) (DO ((K 0 (+ K 1))) ((> K 14)) (PRINC " ")) (PRINC J) (SETQ D (+ D 1)) (IF (> D 6) (TERPRI)) (IF (> D 6) (SETQ D 0))))</lang>
- Output:
SNOOPY CALENDAR 1969 JANUARY SU MO TU WE TH FR SA 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 FEBRUARY SU MO TU WE TH FR SA 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 MARCH SU MO TU WE TH FR SA 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 APRIL SU MO TU WE TH FR SA 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 MAY SU MO TU WE TH FR SA 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 JUNE SU MO TU WE TH FR SA 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 JULY SU MO TU WE TH FR SA 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 AUGUST SU MO TU WE TH FR SA 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 SEPTEMBER SU MO TU WE TH FR SA 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 OCTOBER SU MO TU WE TH FR SA 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 NOVEMBER SU MO TU WE TH FR SA 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 DECEMBER SU MO TU WE TH FR SA 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 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
zkl
Using a large helping of grease, in the form of a pre-processor.
The calendar code, file UPCAL.zkl (upper cased version of Calendar#zkl): <lang zkl>VAR [CONST] D=TIME.DATE, DAYS="SU MO TU WE TH FR SA";
FCN CENTER(TEXT,M) { STRING(" "*((M-TEXT.LEN())/2),TEXT) }
FCN ONEMONTH(YEAR,MONTH){
DAY1:=D.ZELLER(YEAR,MONTH,1); //1969-1-1 -->3 (WED, ISO 8601) DAYZ:=D.DAYSINMONTH(YEAR,MONTH); //1969-1 -->31 LIST(CENTER(D.MONTHNAMES[MONTH],DAYS.LEN()),DAYS).EXTEND( (1).PUMP(DAYZ,(0).PUMP(DAY1,LIST,T(VOID,""))).APPLY("%2S ".FMT) .PUMP(LIST,T(VOID.READ,DAYS.LEN()/3,FALSE),STRING.CREATE));
} ...</lang> And the pre-processor, hand rolled for the above code (file bbb.zkl): <lang zkl>code:=File(vm.arglist[0]).read(); code=Data(Void,code.text.toLower()); mixed:=T("string","String", "list","List", " t("," T(",",t(",",T(",
".tostring",".toString", "void.read","Void.Read", "time.date","Time.Date", "utils.","Utils.", "zipwith","zipWith", "daysinmonth","daysInMonth", "monthnames","monthNames", "void","Void", "false","False", "d.october","d.October",
); mixed.pump(Void,Void.Read,'wrap(up,down){ code.replace(up,down) }); Compiler.Compiler.compileText(code)();</lang>
- Output:
$ zkl bbb UPCAL.zkl 3 days of peace & music 1969 January February March 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 ...
- Programming Tasks
- Date and time
- 360 Assembly
- Ada
- ALGOL 68
- AutoHotkey
- BaCon
- BBC BASIC
- C
- COBOL
- Common Lisp
- D
- GUISS
- Elena
- Fortran
- FreeBASIC
- Go
- Icon
- Unicon
- Icon Programming Library
- J
- Julia
- Kotlin
- Lua
- M2000 Interpreter
- Perl
- Perl 6
- Phix
- PHP
- PicoLisp
- PL/I
- Racket
- REXX
- Ring
- Ruby
- Seed7
- Sidef
- Tcl
- UNIX Shell
- Vedit macro language
- Visual Basic .NET
- XLISP
- X86 Assembly
- Zkl
- C sharp/Omit
- Clojure/Omit
- D/Omit
- Factor/Omit
- Haskell/Omit
- Java/Omit
- Processing/Omit
- Mathematica/Omit
- Python/Omit
- Stata/Omit
- Zkl/Omit
- Handicap