Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
5
Task/Calendar---for-REAL-programmers/00-META.yaml
Normal file
5
Task/Calendar---for-REAL-programmers/00-META.yaml
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
---
|
||||
category:
|
||||
- Handicap
|
||||
from: http://rosettacode.org/wiki/Calendar_-_for_"REAL"_programmers
|
||||
note: Date and time
|
||||
31
Task/Calendar---for-REAL-programmers/00-TASK.txt
Normal file
31
Task/Calendar---for-REAL-programmers/00-TASK.txt
Normal file
|
|
@ -0,0 +1,31 @@
|
|||
;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 [[wp:line printer#Paper (forms) handling|line printer]]s - 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 [http://www.ee.ryerson.ca/~elf/hack/realmen.html 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 [[wp:ASCII|ASCII]], [[wp:UTF-8|UTF-8]], [[wp:UTF-16/UCS-2|UTF-16]], [[wp:UTF-32/UCS-4|UTF-32]], [[wp:UTF-7|UTF-7]] and [[wp:UTF-EBCDIC|UTF-EBCDIC]] encodings, in the 1960s having code in UPPERCASE was often mandatory as characters were often stuffed into [[wp:36-bit|36-bit]] words as 6 lots of [[wp:6-bit|6-bit]] characters. More extreme words sizes include [[wp:60-bit|60-bit]] words of the [[wp:CDC 6000 series|CDC 6000 series]] computers. The Soviets even had a national character set that was inclusive of all
|
||||
[[wp:GOST_10859#4-bit code: Binary coded decimal|4-bit]],
|
||||
[[wp:GOST_10859#5-bit code: with BCD & mathematical operators|5-bit]],
|
||||
[[wp:GOST_10859#6-bit code: with only Cyrillic upper case letters|6-bit]] &
|
||||
[[wp:GOST_10859#7-bit code: Cyrillic & Latin upper case letters|7-bit]] depending on how the file was opened... '''And''' one rogue Soviet university went further and built a [http://www.computer-museum.ru/english/setun.htm 1.5-bit] based computer.
|
||||
|
||||
Of course... as us [[wp:Baby-Boom Generation|Boomers]] have turned into [[wp:Geezer|Geezer]]s we have become [[wp:All_caps#Computing|HARD OF HEARING]],
|
||||
and suffer from chronic [[wp:Presbyopia|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 [http://www.textfiles.com/artscene/asciiart/cursepic.art 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.
|
||||
<br><br>
|
||||
|
|
@ -0,0 +1,181 @@
|
|||
* 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
|
||||
|
|
@ -0,0 +1,108 @@
|
|||
'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'
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
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;
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
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
|
||||
}
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,47 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,166 @@
|
|||
/* 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;
|
||||
}
|
||||
|
|
@ -0,0 +1,75 @@
|
|||
(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))))
|
||||
|
|
@ -0,0 +1 @@
|
|||
import std.string;mixin(import("CALENDAR").toLower);void main(){}
|
||||
|
|
@ -0,0 +1,161 @@
|
|||
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()
|
||||
}
|
||||
|
|
@ -0,0 +1,175 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,97 @@
|
|||
' 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
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
INCLUDE "NSLOG.INCL"
|
||||
|
||||
LOCAL FN RUNTERMINALCOMMAND( CMD AS CFSTRINGREF ) AS CFSTRINGREF
|
||||
CFSTRINGREF OUTPUTSTR = NULL
|
||||
|
||||
TASKREF TASK = FN TASKINIT
|
||||
TASKSETEXECUTABLEURL( TASK, FN URLFILEURLWITHPATH( FN STRINGLOWERCASESTRING( @"/BIN/ZSH" ) ) )
|
||||
CFSTRINGREF CMDSTR = FN STRINGWITHFORMAT( @"%@", FN STRINGLOWERCASESTRING( CMD ) )
|
||||
CFARRAYREF ARGS = FN ARRAYWITHOBJECTS( FN STRINGLOWERCASESTRING( @"-C" ), CMDSTR, NULL )
|
||||
TASKSETARGUMENTS( TASK, ARGS )
|
||||
|
||||
PIPEREF P = FN PIPEINIT
|
||||
TASKSETSTANDARDOUTPUT( TASK, P )
|
||||
TASKSETSTANDARDERROR( TASK, P )
|
||||
FILEHANDLEREF FH = FN PIPEFILEHANDLEFORREADING( P )
|
||||
|
||||
FN TASKLAUNCH( TASK, NULL )
|
||||
TASKWAITUNTILEXIT( TASK )
|
||||
|
||||
ERRORREF ERR
|
||||
CFDATAREF DTA = FN FILEHANDLEREADDATATOENDOFFILE( FH, @ERR )
|
||||
IF ERR THEN NSLOG( @"%@", FN ERRORLOCALIZEDDESCRIPTION( ERR ) ) : EXIT FN
|
||||
OUTPUTSTR = FN STRINGWITHDATA( DTA, NSUTF8STRINGENCODING )
|
||||
OUTPUTSTR = FN STRINGUPPERCASESTRING( OUTPUTSTR )
|
||||
END FN = OUTPUTSTR
|
||||
|
||||
VOID LOCAL FN BUILDSNOOPYCALENDAR
|
||||
CFSTRINGREF CALSTR = FN STRINGWITHFORMAT( FN STRINGLOWERCASESTRING( @"\n%37S\n\n%@" ), FN STRINGUTF8STRING( @"[SNOOPY HERE]" ), FN RUNTERMINALCOMMAND( FN STRINGLOWERCASESTRING( @"CAL 1969" ) ) )
|
||||
NSLOG( @"%@", CALSTR )
|
||||
END FN
|
||||
|
||||
FN BUILDSNOOPYCALENDAR
|
||||
|
||||
HANDLEEVENTS
|
||||
|
|
@ -0,0 +1 @@
|
|||
RIGHTCLICK:CLOCK,ADJUST DATE AND TIME,BUTTON:CANCEL
|
||||
|
|
@ -0,0 +1,71 @@
|
|||
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()
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
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())
|
||||
}
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
$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
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
$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
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
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 │ │
|
||||
└────────────────────┴────────────────────┴────────────────────┴────────────────────┴────────────────────┴────────────────────┘
|
||||
|
|
@ -0,0 +1,57 @@
|
|||
# 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)
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
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)
|
||||
}
|
||||
|
|
@ -0,0 +1,84 @@
|
|||
// 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())
|
||||
}
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
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)
|
||||
}
|
||||
|
|
@ -0,0 +1,63 @@
|
|||
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)
|
||||
|
|
@ -0,0 +1 @@
|
|||
do io.input( arg[ 1 ] ); local s = io.read( "*a" ):lower(); io.close(); assert( load( s ) )() end
|
||||
|
|
@ -0,0 +1,147 @@
|
|||
\\ Calendar - for "REAL" programmers
|
||||
\\ All statements in UPPERCASE
|
||||
\\ Output to 132 characters console - as a line printer
|
||||
\\ USE COURIER NEW (FONT "COURIER NEW")
|
||||
|
||||
\\ CHANGE THE VALUE OF PRINT_IT TO TRUE FOR PRINTING
|
||||
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+1), $(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
|
||||
IF PRINT_IT ELSE REFRESH 1000
|
||||
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
|
||||
IF PRINT_IT ELSE REFRESH 1000
|
||||
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
|
||||
IF PRINT_IT ELSE REFRESH 1000
|
||||
}
|
||||
}
|
||||
}
|
||||
WHILE INKEY$<>"" : END WHILE
|
||||
IF PRINT_IT THEN PRINTING ON ELSE REFRESH 1000
|
||||
FONT "COURIER NEW"
|
||||
PEN 0
|
||||
CLS 15, 0
|
||||
FORM 132,68
|
||||
CALENDAR 1966, 1032 ' GREEK
|
||||
GOSUB WAITKEY_OR_MOUSE
|
||||
FOR I=2020 TO 2026
|
||||
CALENDAR I, 1033 ' ENGLISH
|
||||
GOSUB WAITKEY_OR_MOUSE
|
||||
NEXT I
|
||||
IF PRINT_IT THEN PRINTING OFF ELSE REFRESH 50
|
||||
CLEAR ' CLEAR VARIABLES FROM THIS MODULE
|
||||
END
|
||||
WAITKEY_OR_MOUSE:
|
||||
IF PRINT_IT THEN RETURN
|
||||
WHILE INKEY$="" AND MOUSE=0
|
||||
END WHILE
|
||||
RETURN
|
||||
|
|
@ -0,0 +1,31 @@
|
|||
import strutils
|
||||
|
||||
const progUpper = staticRead("calendar_upper.txt")
|
||||
|
||||
proc transformed(s: string): string {.compileTime.} =
|
||||
## Return a transformed version (which can compile) of a program in uppercase.
|
||||
|
||||
let upper = s.toLower() # Convert all to lowercase.
|
||||
var inString = false # Text in string should be in uppercase…
|
||||
var inBraces = false # … except if this is in an expression to interpolate.
|
||||
for ch in upper:
|
||||
case ch
|
||||
of '"':
|
||||
inString = not inString
|
||||
of '{':
|
||||
if inString: inBraces = true
|
||||
of '}':
|
||||
if inString: inBraces = false
|
||||
of 'a'..'z':
|
||||
if inString and not inBraces:
|
||||
result.add(ch.toUpperAscii()) # Restore content of strings to uppercase.
|
||||
continue
|
||||
else:
|
||||
discard
|
||||
result.add(ch)
|
||||
|
||||
const prog = progUpper.transformed()
|
||||
|
||||
static: writeFile("calendar_transformed.nim", prog)
|
||||
|
||||
include "calendar_transformed.nim"
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
IMPORT TIMES
|
||||
IMPORT STRFORMAT
|
||||
|
||||
PROC PRINTCALENDAR(YEAR, NCOLS: INT) =
|
||||
VAR ROWS = 12 DIV NCOLS
|
||||
VAR DATE = INITDATETIME(1, MJAN, YEAR, 0, 0, 0, UTC())
|
||||
IF ROWS MOD NCOLS != 0:
|
||||
INC ROWS
|
||||
VAR OFFS = GETDAYOFWEEK(DATE.MONTHDAY, DATE.MONTH, DATE.YEAR).INT
|
||||
VAR MONS: ARRAY[12, ARRAY[8, STRING]]
|
||||
FOR M IN 0..11:
|
||||
MONS[M][0] = &"{$DATE.MONTH:^21}"
|
||||
MONS[M][1] = " SU MO TU WE TH FR SA"
|
||||
VAR DIM = GETDAYSINMONTH(DATE.MONTH, DATE.YEAR)
|
||||
FOR D IN 1..42:
|
||||
VAR DAY = D > OFFS AND D <= OFFS + DIM
|
||||
VAR STR = IF DAY: &" {D-OFFS:2}" ELSE: " "
|
||||
MONS[M][2 + (D - 1) DIV 7] &= STR
|
||||
OFFS = (OFFS + DIM) MOD 7
|
||||
DATE = DATE + MONTHS(1)
|
||||
VAR SNOOPYSTRING, YEARSTRING: STRING
|
||||
FORMATVALUE(SNOOPYSTRING, "[SNOOPY PICTURE]", "^" & $(NCOLS * 24 + 4))
|
||||
FORMATVALUE(YEARSTRING, $YEAR, "^" & $(NCOLS * 24 + 4))
|
||||
ECHO SNOOPYSTRING, "\N" , YEARSTRING, "\N"
|
||||
FOR R IN 0..<ROWS:
|
||||
VAR S: ARRAY[8, STRING]
|
||||
FOR C IN 0..<NCOLS:
|
||||
IF R * NCOLS + C > 11:
|
||||
BREAK
|
||||
FOR I, LINE IN MONS[R * NCOLS + C]:
|
||||
S[I] &= &" {LINE}"
|
||||
FOR LINE IN S:
|
||||
IF LINE == "":
|
||||
BREAK
|
||||
ECHO LINE
|
||||
ECHO ""
|
||||
|
||||
PRINTCALENDAR(1969, 5)
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
<?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
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
(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;
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
$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}`;
|
||||
|
|
@ -0,0 +1 @@
|
|||
$_=$ARGV[0]//1969;`\143\141\154 $_ >&2`
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #008080;">return</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">,</span><span style="color: #000000;">left</span><span style="color: #0000FF;">)&</span><span style="color: #000000;">s</span><span style="color: #0000FF;">&</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">,</span><span style="color: #000000;">right</span><span style="color: #0000FF;">)</span>
|
||||
<!--
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #008080;">return</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">,</span><span style="color: #000000;">left</span><span style="color: #0000FF;">)&</span><span style="color: #7060A8;">upper</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)&</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">' '</span><span style="color: #0000FF;">,</span><span style="color: #000000;">right</span><span style="color: #0000FF;">)</span>
|
||||
<!--
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #000000;">initialSymEntry</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"integer"</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">S_Type</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"TI"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">opInt</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">E_none</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- #01 / 0b0001 integer</span>
|
||||
<!--
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #000000;">Alias</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"INTEGER"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">symlimit</span><span style="color: #0000FF;">)</span>
|
||||
<!--
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #008080;">procedure</span> <span style="color: #000000;">tt_stringA</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">text</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">alias</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #000000;">tt_string</span><span style="color: #0000FF;">(</span><span style="color: #000000;">text</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #000000;">tt</span><span style="color: #0000FF;">[</span><span style="color: #000000;">pcurr</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">alias</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
|
||||
<!--
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #008080;">global</span> <span style="color: #008080;">constant</span> <span style="color: #000000;">T_include</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">596</span> <span style="color: #000000;">tt_stringF</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"include"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">T_include</span><span style="color: #0000FF;">)</span>
|
||||
<!--
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #000000;">tt_stringA</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"INCLUDE"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">T_include</span><span style="color: #0000FF;">)</span>
|
||||
<!--
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #000000;">Ch</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #000000;">Ch</span><span style="color: #0000FF;">,</span><span style="color: #000000;">escchar</span><span style="color: #0000FF;">)</span>
|
||||
<!--
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #000000;">Ch</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">find</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">lower</span><span style="color: #0000FF;">(</span><span style="color: #000000;">Ch</span><span style="color: #0000FF;">),</span><span style="color: #000000;">escchar</span><span style="color: #0000FF;">)</span>
|
||||
<!--
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
(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)
|
||||
|
|
@ -0,0 +1,173 @@
|
|||
/*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),,"│║─═┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣")
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
#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))
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
$_="\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]"()
|
||||
|
|
@ -0,0 +1,158 @@
|
|||
# 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
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
# 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)
|
||||
|
|
@ -0,0 +1,84 @@
|
|||
# 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)
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
$ 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;
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
-> 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")
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
\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
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
CAL=CAL
|
||||
TR=TR
|
||||
A=A
|
||||
Z=Z
|
||||
LANG=C ${CAL,,} 1969 | ${TR,,} ${A,}-${Z,} A-Z
|
||||
|
|
@ -0,0 +1,65 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,331 @@
|
|||
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
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
IMPORT "/DATE" FOR DATE
|
||||
IMPORT "/FMT" FOR FMT
|
||||
IMPORT "/SEQ" FOR LST
|
||||
|
||||
VAR CALENDAR = FN.NEW { |YEAR|
|
||||
VAR SNOOPY = "🐶"
|
||||
VAR DAYS = "SU MO TU WE TH FR SA"
|
||||
VAR MONTHS = [
|
||||
"JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE",
|
||||
"JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER"
|
||||
]
|
||||
FMT.PRINT("$70M", SNOOPY)
|
||||
VAR YEARSTR = "--- %(YEAR) ---"
|
||||
FMT.PRINT("$70M\N", YEARSTR)
|
||||
VAR FIRST = LIST.FILLED(3, 0)
|
||||
VAR MLEN = LIST.FILLED(3, 0)
|
||||
VAR C = 0
|
||||
FOR (CHUNK IN LST.CHUNKS(MONTHS, 3)) {
|
||||
FOR (I IN 0..2) FMT.WRITE("$20M ", CHUNK[I])
|
||||
SYSTEM.PRINT()
|
||||
FOR (I IN 0..2) SYSTEM.WRITE("%(DAYS) ")
|
||||
SYSTEM.PRINT()
|
||||
FIRST[0] = DATE.NEW(YEAR, C*3 + 1, 1).DAYOFWEEK % 7
|
||||
FIRST[1] = DATE.NEW(YEAR, C*3 + 2, 1).DAYOFWEEK % 7
|
||||
FIRST[2] = DATE.NEW(YEAR, C*3 + 3, 1).DAYOFWEEK % 7
|
||||
MLEN[0] = DATE.MONTHLENGTH(YEAR, C*3 + 1)
|
||||
MLEN[1] = DATE.MONTHLENGTH(YEAR, C*3 + 2)
|
||||
MLEN[2] = DATE.MONTHLENGTH(YEAR, C*3 + 3)
|
||||
FOR (I IN 0..5) {
|
||||
FOR (J IN 0..2) {
|
||||
VAR START = 1 + 7 * I - FIRST[J]
|
||||
FOR (K IN START..START+6) {
|
||||
IF (K >= 1 && K <= MLEN[J]) {
|
||||
FMT.WRITE("$2D ", K)
|
||||
} ELSE {
|
||||
SYSTEM.WRITE(" ")
|
||||
}
|
||||
}
|
||||
SYSTEM.WRITE(" ")
|
||||
}
|
||||
SYSTEM.PRINT()
|
||||
}
|
||||
SYSTEM.PRINT()
|
||||
C = C + 1
|
||||
}
|
||||
}
|
||||
|
||||
CALENDAR.CALL(1969)
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
import "io" for File
|
||||
import "/str" for Str
|
||||
import "meta" for Meta
|
||||
|
||||
var keywords = ["import", "for", "var", "in", "if", "else"]
|
||||
var modules = ["/date", "/fmt", "/seq"]
|
||||
var classes = ["Date", "Fmt", "Lst", "Fn", "List", "System"]
|
||||
var methods = ["print", "filled", "chunks", "write", "new", "dayOfWeek", "monthLength", "call"]
|
||||
var formats = ["$70m", "\\n", "$20m", "$2d"]
|
||||
|
||||
var text = File.read("calendar_real_uc.txt")
|
||||
for (keyword in keywords) text = text.replace(Str.upper(keyword) + " ", keyword + " ")
|
||||
for (module in modules) text = text.replace(Str.upper(module), module)
|
||||
for (clazz in classes) text = text.replace(Str.upper(clazz), clazz)
|
||||
for (method in methods) text = text.replace("." + Str.upper(method), "." + method)
|
||||
for (format in formats) text = text.replace(Str.upper(format), format)
|
||||
|
||||
Meta.compile(text).call()
|
||||
|
|
@ -0,0 +1,187 @@
|
|||
.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
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
(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))))
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
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));
|
||||
}
|
||||
...
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
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)();
|
||||
Loading…
Add table
Add a link
Reference in a new issue