Update all new Tasks
This commit is contained in:
Ingy döt Net
parent
00a190b0a6
commit
91df62d461
5697 changed files with 93386 additions and 804 deletions
26
Task/Calendar---for-REAL-programmers/00DESCRIPTION
Normal file
26
Task/Calendar---for-REAL-programmers/00DESCRIPTION
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
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.
|
||||
2
Task/Calendar---for-REAL-programmers/00META.yaml
Normal file
2
Task/Calendar---for-REAL-programmers/00META.yaml
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
---
|
||||
note: Date and time
|
||||
|
|
@ -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 @@
|
|||
import std.string;mixin(import("CALENDAR").toLower);void main(){}
|
||||
|
|
@ -0,0 +1,139 @@
|
|||
#define system.
|
||||
#define system'text.
|
||||
#define system'routines.
|
||||
#define system'calendar.
|
||||
#define extensions.
|
||||
#define extensions'math.
|
||||
#define extensions'routines.
|
||||
|
||||
// --- calendar ---
|
||||
|
||||
#symbol MonthNames = ("JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER").
|
||||
#symbol DayNames = ("MO", "TU", "WE", "TH", "FR", "SA", "SU").
|
||||
|
||||
#class CalendarMonthPrinter
|
||||
{
|
||||
#field theDate.
|
||||
#field theLine.
|
||||
#field theMonth.
|
||||
#field theYear.
|
||||
#field theRow.
|
||||
|
||||
#constructor new &Year:aYear &Month:aMonth
|
||||
[
|
||||
theMonth := aMonth.
|
||||
theYear := aYear.
|
||||
theLine := TextBuffer new.
|
||||
theRow := Integer new.
|
||||
]
|
||||
|
||||
#method firstLine : aDay
|
||||
[
|
||||
theRow << 0.
|
||||
theDate := Date new &Year:theYear &Month:theMonth &Day:aDay.
|
||||
control foreach:DayNames &do: aName
|
||||
[ theLine write:" " write:aName ].
|
||||
]
|
||||
|
||||
#method nextLine
|
||||
[
|
||||
theLine clear.
|
||||
|
||||
(theDate Month == theMonth)
|
||||
? [
|
||||
theLine~stringOp write:" " &length:(((theDate DayOfWeek) => 0 ? [ 7 ] ! [ theDate DayOfWeek ]) subtract:1 int).
|
||||
|
||||
control do:
|
||||
[
|
||||
theLine~stringOp write:(theDate Day) &paddingLeft:3 &with:" ".
|
||||
|
||||
theDate := theDate add &Days:1.
|
||||
]
|
||||
&until:[(theDate Month != theMonth)or:[theDate DayOfWeek == 1]].
|
||||
].
|
||||
|
||||
#var(type:int) aLength := theLine length.
|
||||
(aLength < 21)
|
||||
? [ theLine~stringOp write:" " &length:(21 - aLength). ].
|
||||
|
||||
theRow += 1.
|
||||
|
||||
^ theRow < 7.
|
||||
]
|
||||
|
||||
#method enumerator =
|
||||
{
|
||||
set &index:anIndex [ self firstLine:(anIndex + 1) ]
|
||||
|
||||
next [ ^ self nextLine. ]
|
||||
|
||||
get = self.
|
||||
}.
|
||||
|
||||
#method printTitleTo : anOutput
|
||||
[
|
||||
anOutput~stringOp write:(MonthNames @(theMonth - 1)) &padding:21 &with:" ".
|
||||
]
|
||||
|
||||
#method printTo : anOutput
|
||||
[
|
||||
anOutput write:(theLine literal).
|
||||
]
|
||||
}
|
||||
|
||||
#class Calendar
|
||||
{
|
||||
#field theYear.
|
||||
#field theRowLength.
|
||||
|
||||
#constructor new : aYear
|
||||
[
|
||||
theYear := aYear int.
|
||||
theRowLength := 3.
|
||||
]
|
||||
|
||||
#method printTo:anOutput
|
||||
[
|
||||
anOutput~stringOp write:"[SNOOPY]" &padding:(theRowLength * 25) &with:" " writeLine.
|
||||
anOutput~stringOp write:theYear &padding:(theRowLength * 25) &with:" " writeLine writeLine.
|
||||
|
||||
#var aRowCount := 12 / theRowLength.
|
||||
#var Months := matrixControl new &m:aRowCount &n:theRowLength &each: (:i:j) [ CalendarMonthPrinter new &Year:theYear &Month:(i * theRowLength + j + 1) ].
|
||||
|
||||
control foreach:Months &do: aRow
|
||||
[
|
||||
control foreach:aRow &do: aMonth
|
||||
[
|
||||
aMonth printTitleTo:anOutput.
|
||||
|
||||
anOutput write:" ".
|
||||
].
|
||||
|
||||
anOutput writeLine.
|
||||
|
||||
control for:(ParallelEnumerator new:aRow) &do: aLine
|
||||
[
|
||||
control foreach:aLine &do: aPrinter
|
||||
[
|
||||
aPrinter printTo:anOutput.
|
||||
|
||||
anOutput write:" ".
|
||||
].
|
||||
|
||||
anOutput writeLine.
|
||||
].
|
||||
].
|
||||
|
||||
]
|
||||
}
|
||||
|
||||
// --- program ---
|
||||
|
||||
#symbol program =
|
||||
[
|
||||
#var aCalender := Calendar new:(consoleEx write:"Enter the year:" readLine:(Integer new)).
|
||||
|
||||
aCalender printTo:consoleEx.
|
||||
|
||||
consoleEx readChar.
|
||||
].
|
||||
|
|
@ -0,0 +1 @@
|
|||
RIGHTCLICK:CLOCK,ADJUST DATE AND TIME,BUTTON:CANCEL
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
$include "REALIZE.ICN"
|
||||
|
||||
LINK DATETIME
|
||||
$define ISLEAPYEAR IsLeapYear
|
||||
$define JULIAN julian
|
||||
|
||||
PROCEDURE MAIN(A)
|
||||
PRINTCALENDAR(\A$<1$>|1969)
|
||||
END
|
||||
|
||||
PROCEDURE PRINTCALENDAR(YEAR)
|
||||
COLS := 3
|
||||
MONS := $<$>
|
||||
"JANUARY FEBRUARY MARCH APRIL MAY JUNE " ||
|
||||
"JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER " ?
|
||||
WHILE PUT(MONS, TAB(FIND(" "))) DO MOVE(1)
|
||||
|
||||
WRITE(CENTER("$<SNOOPY PICTURE$>",COLS * 24 + 4))
|
||||
WRITE(CENTER(YEAR,COLS * 24 + 4), CHAR(10))
|
||||
|
||||
M := LIST(COLS)
|
||||
EVERY MON := 0 TO 9 BY COLS DO $(
|
||||
WRITES(" ")
|
||||
EVERY I := 1 TO COLS DO {
|
||||
WRITES(CENTER(MONS$<MON+I$>,24))
|
||||
M$<I$> := CREATE CALENDARFORMATWEEK(1969,MON + I)
|
||||
$)
|
||||
WRITE()
|
||||
EVERY 1 TO 7 DO $(
|
||||
EVERY C := 1 TO COLS DO $(
|
||||
WRITES(" ")
|
||||
EVERY 1 TO 7 DO WRITES(RIGHT(@M$<C$>,3))
|
||||
$)
|
||||
WRITE()
|
||||
$)
|
||||
$)
|
||||
END
|
||||
|
||||
PROCEDURE CALENDARFORMATWEEK(YEAR,M)
|
||||
STATIC D
|
||||
INITIAL D := $<31,28,31,30,31,30,31,31,30,31,30,31$>
|
||||
|
||||
EVERY SUSPEND "SU"|"MO"|"TU"|"WE"|"TH"|"FR"|"SA"
|
||||
EVERY 1 TO (DAY := (JULIAN(M,1,YEAR)+1)%7) DO SUSPEND ""
|
||||
EVERY SUSPEND 1 TO D$<M$> DO DAY +:= 1
|
||||
IF M = 2 & ISLEAPYEAR(YEAR) THEN SUSPEND (DAY +:= 1, 29)
|
||||
EVERY DAY TO (6*7) DO SUSPEND ""
|
||||
END
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
$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
|
||||
|
|
@ -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,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,4 @@
|
|||
$_=["\0"..."~"];<
|
||||
114 117 110 32 34 99 97 116 32 115 110 111 111 112 121 46
|
||||
116 120 116 59 99 97 108 32 64 42 65 82 71 83 91 48 93 34
|
||||
>."$_[99]$_[104]$_[114]$_[115]"()."$_[101]$_[118]$_[97]$_[108]"()
|
||||
|
|
@ -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,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)
|
||||
1
Task/Calendar---for-REAL-programmers/README
Normal file
1
Task/Calendar---for-REAL-programmers/README
Normal file
|
|
@ -0,0 +1 @@
|
|||
Data source: http://rosettacode.org/wiki/Calendar_-_for_"REAL"_programmers
|
||||
|
|
@ -0,0 +1,170 @@
|
|||
/*REXX PROGRAM TO SHOW ANY YEAR'S (MONTHLY) CALENDAR (WITH/WITHOUT GRID)*/
|
||||
@ABC=
|
||||
DO J=0 TO 255;_=D2C(J);IF DATATYPE(_,'L') THEN @ABC=@ABC||_;END
|
||||
@ABCU=@ABC; UPPER @ABCU
|
||||
DAYS_='SUNDAY MONDAY TUESDAY WEDNESDAY THURSDAY FRIDAY SATURDAY'
|
||||
MONTHS_='JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER'
|
||||
DAYS=; MONTHS=
|
||||
DO J=1 FOR 7
|
||||
_=LOWER(WORD(DAYS_,J))
|
||||
DAYS=DAYS TRANSLATE(LEFT(_,1))SUBSTR(_,2)
|
||||
END
|
||||
DO J=1 FOR 12
|
||||
_=LOWER(WORD(MONTHS_,J))
|
||||
MONTHS=MONTHS TRANSLATE(LEFT(_,1))SUBSTR(_,2)
|
||||
END
|
||||
CALFILL=' '; MC=12; _='1 3 1234567890' "FB"X
|
||||
PARSE VAR _ GRID CALSPACES # CHK . CV_ DAYS.1 DAYS.2 DAYS.3 DAYSN SD SW
|
||||
_=0; PARSE VAR _ COLS 1 JD 1 LOWERCASE 1 MAXKALPUTS 1 NARROW 1,
|
||||
NARROWER 1 NARROWEST 1 SHORT 1 SHORTER 1 SHORTEST 1,
|
||||
SMALL 1 SMALLER 1 SMALLEST 1 UPPERCASE
|
||||
PARSE ARG MM '/' DD "/" YYYY _ '(' OPS; UOPS=OPS
|
||||
IF _\=='' | \IS#(MM) | \IS#(DD) | \IS#(YYYY) THEN CALL ERX 86
|
||||
|
||||
@CALMONTHS ='CALMON' || LOWER('THS')
|
||||
@CALSPACES ='CALSP' || LOWER('ACES')
|
||||
@DEPTH ='DEP' || LOWER('TH')
|
||||
@GRIDS ='GRID' || LOWER('S')
|
||||
@LOWERCASE ='LOW' || LOWER('ERCASE')
|
||||
@NARROW ='NAR' || LOWER('ROW')
|
||||
@NARROWER ='NARROWER'
|
||||
@NARROWEST ='NARROWES' || LOWER('T')
|
||||
@SHORT ='SHOR' || LOWER('T')
|
||||
@SHORTER ='SHORTER'
|
||||
@SHORTEST ='SHORTES' || LOWER('T')
|
||||
@UPPERCASE ='UPP' || LOWER('ERCASE')
|
||||
@WIDTH ='WID' || LOWER('TH')
|
||||
DO WHILE OPS\==''; OPS=STRIP(OPS,'L'); PARSE VAR OPS _1 2 1 _ . 1 _O OPS
|
||||
UPPER _
|
||||
SELECT
|
||||
WHEN ABB(@CALMONTHS) THEN MC=NAI()
|
||||
WHEN ABB(@CALSPACES) THEN CALSPACES=NAI()
|
||||
WHEN ABB(@DEPTH) THEN SD=NAI()
|
||||
WHEN ABBN(@GRIDS) THEN GRID=NO()
|
||||
WHEN ABBN(@LOWERCASE) THEN LOWERCASE=NO()
|
||||
WHEN ABBN(@NARROW) THEN NARROW=NO()
|
||||
WHEN ABBN(@NARROWER) THEN NARROWER=NO()
|
||||
WHEN ABBN(@NARROWEST) THEN NARROWEST=NO()
|
||||
WHEN ABBN(@SHORT) THEN SHORT=NO()
|
||||
WHEN ABBN(@SHORTER) THEN SHORTER=NO()
|
||||
WHEN ABBN(@SHORTEST) THEN SHORTEST=NO()
|
||||
WHEN ABBN(@SMALL) THEN SMALL=NO()
|
||||
WHEN ABBN(@SMALLER) THEN SMALLER=NO()
|
||||
WHEN ABBN(@SMALLEST) THEN SMALLEST=NO()
|
||||
WHEN ABBN(@UPPERCASE) THEN UPPERCASE=NO()
|
||||
WHEN ABB(@WIDTH) THEN SW=NAI()
|
||||
OTHERWISE NOP
|
||||
END /*SELECT*/
|
||||
END /*DO WHILE OPTS\== ...*/
|
||||
|
||||
MC=INT(MC,'MONTHSCALENDER'); IF MC>0 THEN CAL=1
|
||||
DAYS=' 'DAYS; MONTHS=' 'MONTHS
|
||||
CYYYY=RIGHT(DATE(),4); HYY=LEFT(CYYYY,2); LYY=RIGHT(CYYYY,2)
|
||||
DY.=31; _=30; PARSE VAR _ DY.4 1 DY.6 1 DY.9 1 DY.11; DY.2=28+LY(YYYY)
|
||||
YY=RIGHT(YYYY,2); SD=P(SD 43); SW=P(SW 80); CW=10; CINDENT=1; CALWIDTH=76
|
||||
IF SMALL THEN DO; NARROW=1 ; SHORT=1 ; END
|
||||
IF SMALLER THEN DO; NARROWER=1 ; SHORTER=1 ; END
|
||||
IF SMALLEST THEN DO; NARROWEST=1; SHORTEST=1; END
|
||||
IF SHORTEST THEN SHORTER=1
|
||||
IF SHORTER THEN SHORT =1
|
||||
IF NARROW THEN DO; CW=9; CINDENT=3; CALWIDTH=69; END
|
||||
IF NARROWER THEN DO; CW=4; CINDENT=1; CALWIDTH=34; END
|
||||
IF NARROWEST THEN DO; CW=2; CINDENT=1; CALWIDTH=20; END
|
||||
CV_=CALWIDTH+CALSPACES+2
|
||||
CALFILL=LEFT(COPIES(CALFILL,CW),CW)
|
||||
DO J=1 FOR 7; _=WORD(DAYS,J)
|
||||
DO JW=1 FOR 3; _D=STRIP(SUBSTR(_,CW*JW-CW+1,CW))
|
||||
IF JW=1 THEN _D=CENTRE(_D,CW+1)
|
||||
ELSE _D=LEFT(_D,CW+1)
|
||||
DAYS.JW=DAYS.JW||_D
|
||||
END /*JW*/
|
||||
__=DAYSN
|
||||
IF NARROWER THEN DAYSN=__||CENTRE(LEFT(_,3),5)
|
||||
IF NARROWEST THEN DAYSN=__||CENTER(LEFT(_,2),3)
|
||||
END /*J*/
|
||||
_YYYY=YYYY; CALPUTS=0; CV=1; _MM=MM+0; MONTH=WORD(MONTHS,MM)
|
||||
DY.2=28+LY(_YYYY); DIM=DY._MM; _DD=01; DOW=DOW(_MM,_DD,_YYYY); $DD=DD+0
|
||||
|
||||
/*─────────────────────────────NOW: THE BUSINESS OF THE BUILDING THE CAL*/
|
||||
CALL CALGEN
|
||||
DO _J=2 TO MC
|
||||
IF CV_\=='' THEN DO
|
||||
CV=CV+CV_
|
||||
IF CV+CV_>=SW THEN DO; CV=1; CALL CALPUT
|
||||
CALL FCALPUTS;CALL CALPB
|
||||
END
|
||||
ELSE CALPUTS=0
|
||||
END
|
||||
ELSE DO;CALL CALPB;CALL CALPUT;CALL FCALPUTS;END
|
||||
_MM=_MM+1; IF _MM==13 THEN DO; _MM=1; _YYYY=_YYYY+1; END
|
||||
MONTH=WORD(MONTHS,_MM); DY.2=28+LY(_YYYY); DIM=DY._MM
|
||||
DOW=DOW(_MM,_DD,_YYYY); $DD=0; CALL CALGEN
|
||||
END /*_J*/
|
||||
CALL FCALPUTS
|
||||
RETURN _
|
||||
|
||||
/*─────────────────────────────CALGEN SUBROUTINE────────────────────────*/
|
||||
CALGEN: CELLX=;CELLJ=;CELLM=;CALCELLS=0;CALLINE=0
|
||||
CALL CALPUT
|
||||
CALL CALPUTL COPIES('─',CALWIDTH),"┌┐"; CALL CALHD
|
||||
CALL CALPUTL MONTH ' ' _YYYY ; CALL CALHD
|
||||
IF NARROWEST | NARROWER THEN CALL CALPUTL DAYSN
|
||||
ELSE DO JW=1 FOR 3
|
||||
IF SPACE(DAYS.JW)\=='' THEN CALL CALPUTL DAYS.JW
|
||||
END
|
||||
CALFT=1; CALFB=0
|
||||
DO JF=1 FOR DOW-1; CALL CELLDRAW CALFILL,CALFILL; END
|
||||
DO JY=1 FOR DIM; CALL CELLDRAW JY; END
|
||||
CALFB=1
|
||||
DO 7; CALL CELLDRAW CALFILL,CALFILL; END
|
||||
IF SD>32 & \SHORTER THEN CALL CALPUT
|
||||
RETURN
|
||||
|
||||
/*─────────────────────────────CELLDRAW SUBROUTINE──────────────────────*/
|
||||
CELLDRAW: PARSE ARG ZZ,CDDOY;ZZ=RIGHT(ZZ,2);CALCELLS=CALCELLS+1
|
||||
IF CALCELLS>7 THEN DO
|
||||
CALLINE=CALLINE+1
|
||||
CELLX=SUBSTR(CELLX,2)
|
||||
CELLJ=SUBSTR(CELLJ,2)
|
||||
CELLM=SUBSTR(CELLM,2)
|
||||
CELLB=TRANSLATE(CELLX,,")(─-"#)
|
||||
IF CALLINE==1 THEN CALL CX
|
||||
CALL CALCSM; CALL CALPUTL CELLX; CALL CALCSJ; CALL CX
|
||||
CELLX=; CELLJ=; CELLM=; CALCELLS=1
|
||||
END
|
||||
CDDOY=RIGHT(CDDOY,CW); CELLM=CELLM'│'CENTER('',CW)
|
||||
CELLX=CELLX'│'CENTRE(ZZ,CW); CELLJ=CELLJ'│'CENTER('',CW)
|
||||
RETURN
|
||||
|
||||
/*═════════════════════════════GENERAL 1-LINE SUBS══════════════════════*/
|
||||
ABB:ARG ABBU;PARSE ARG ABB;RETURN ABBREV(ABBU,_,ABBL(ABB))
|
||||
ABBL:RETURN VERIFY(ARG(1)LEFT(@ABC,1),@ABC,'M')-1
|
||||
ABBN:PARSE ARG ABBN;RETURN ABB(ABBN)|ABB('NO'ABBN)
|
||||
CALCSJ:IF SD>49&\SHORTER THEN CALL CALPUTL CELLB;IF SD>24&\SHORT THEN CALL CALPUTL CELLJ; RETURN
|
||||
CALCSM:IF SD>24&\SHORT THEN CALL CALPUTL CELLM;IF SD>49&\SHORTER THEN CALL CALPUTL CELLB;RETURN
|
||||
CALHD:IF SD>24&\SHORTER THEN CALL CALPUTL;IF SD>32&\SHORTEST THEN CALL CALPUTL;RETURN
|
||||
CALPB:IF \GRID&SHORTEST THEN CALL PUT CHK;RETURN
|
||||
CALPUT:CALPUTS=CALPUTS+1;MAXKALPUTS=MAX(MAXKALPUTS,CALPUTS);IF SYMBOL('CT.'CALPUTS)\=='VAR' THEN CT.CALPUTS=;CT.CALPUTS=OVERLAY(ARG(1),CT.CALPUTS,CV);RETURN
|
||||
CALPUTL:CALL CALPUT COPIES(' ',CINDENT)LEFT(ARG(2)"│",1)CENTER(ARG(1),CALWIDTH)||RIGHT('│'ARG(2),1);RETURN
|
||||
CX:CX_='├┤';CX=COPIES(COPIES('─',CW)'┼',7);IF CALFT THEN DO;CX=TRANSLATE(CX,'┬',"┼");CALFT=0;END;IF CALFB THEN DO;CX=TRANSLATE(CX,'┴',"┼");CX_='└┘';CALFB=0;END;CALL CALPUTL CX,CX_;RETURN
|
||||
DOW:PROCEDURE;ARG M,D,Y;IF M<3 THEN DO;M=M+12;Y=Y-1;END;YL=LEFT(Y,2);YR=RIGHT(Y,2);W=(D+(M+1)*26%10+YR+YR%4+YL%4+5*YL)//7;IF W==0 THEN W=7;RETURN W
|
||||
ER:PARSE ARG _1,_2;CALL '$ERR' "14"P(_1) P(WORD(_1,2) !FID(1)) _2;IF _1<0 THEN RETURN _1;EXIT RESULT
|
||||
ERR:CALL ER '-'ARG(1),ARG(2);RETURN ''
|
||||
ERX:CALL ER '-'ARG(1),ARG(2);EXIT ''
|
||||
FCALPUTS: DO J=1 FOR MAXKALPUTS;CALL PUT CT.J;END;CT.=;MAXKALPUTS=0;CALPUTS=0;RETURN
|
||||
INT:INT=NUMX(ARG(1),ARG(2));IF \ISINT(INT) THEN CALL ERX 92,ARG(1) ARG(2);RETURN INT/1
|
||||
IS#:RETURN VERIFY(ARG(1),#)==0
|
||||
ISINT:RETURN DATATYPE(ARG(1),'W')
|
||||
LOWER:RETURN TRANSLATE(ARG(1),@ABC,@ABCU)
|
||||
LY:ARG _;IF LENGTH(_)==2 THEN _=HYY||_;LY=_//4==0;IF LY==0 THEN RETURN 0;LY=((_//100\==0)|_//400==0);RETURN LY
|
||||
NA:IF ARG(1)\=='' THEN CALL ERX 01,ARG(2);PARSE VAR OPS NA OPS;IF NA=='' THEN CALL ERX 35,_O;RETURN NA
|
||||
NAI:RETURN INT(NA(),_O)
|
||||
NAN:RETURN NUMX(NA(),_O)
|
||||
NO:IF ARG(1)\=='' THEN CALL ERX 01,ARG(2);RETURN LEFT(_,2)\=='NO'
|
||||
NUM:PROCEDURE;PARSE ARG X .,F,Q;IF X=='' THEN RETURN X;IF DATATYPE(X,'N') THEN RETURN X/1;X=SPACE(TRANSLATE(X,,','),0);IF DATATYPE(X,'N') THEN RETURN X/1;RETURN NUMNOT()
|
||||
NUMNOT:IF Q==1 THEN RETURN X;IF Q=='' THEN CALL ER 53,X F;CALL ERX 53,X F
|
||||
NUMX:RETURN NUM(ARG(1),ARG(2),1)
|
||||
P:RETURN WORD(ARG(1),1)
|
||||
PUT:_=ARG(1);_=TRANSLATE(_,,'_'CHK);IF \GRID THEN _=UNGRID(_);IF LOWERCASE THEN _=LOWER(_);IF UPPERCASE THEN UPPER _;IF SHORTEST&_=' ' THEN RETURN;CALL TELL _;RETURN
|
||||
TELL:SAY ARG(1);RETURN
|
||||
UNGRID:RETURN TRANSLATE(ARG(1),,"│║─═┤┐└┴┬├┼┘┌╔╗╚╝╟╢╞╡╫╪╤╧╥╨╠╣")
|
||||
|
|
@ -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,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,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,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,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
|
||||
Loading…
Add table
Add a link
Reference in a new issue