aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Another update from ingydotnet^djgoku

Browse source
This commit is contained in:
Ingy döt Net 2015-11-18 06:14:39 +00:00
parent 91df62d461
commit 948b86eafa
7604 changed files with 108452 additions and 22726 deletions
Download patch file Download diff file Expand all files Collapse all files

93
Task/Calendar/Batch-File/calendar.bat Normal file
View file

@ -0,0 +1,93 @@
::Calender Task from Rosetta Code Wiki
::Batch File Implementation
@echo off
setlocal enabledelayedexpansion
%== Set a valid year [will not be validated] ==%
set y=1969
%== Set the variables for months (feb_l=the normal 28 days) ==%
set jan_l=31&set apr_l=30
set mar_l=31&set jun_l=30
set may_l=31&set sep_l=30
set jul_l=31&set nov_l=30
set aug_l=31&set feb_l=28
set oct_l=31
set dec_l=31
%== Compute day for first day of the year ==%
set /a d=(y/4+y)-(y/100-y/400)
%== Check if that year is a leap year ==%
set /a "op1=y%%4","op2=y%%100","op3=y%%400"
if not "%op1%"=="0" (goto :no_leap)
if not "%op2%"=="0" (goto :yes_leap)
if not "%op3%"=="0" (goto :no_leap)
:yes_leap
%== Ooops... Leap year. Change feb_l to 29. ==%
set feb_l=29
set/a d-=1
:no_leap
%== Compute weekday of the first day... ==%
set /a d%%=7
%== Generate everything that's inside the calendar ==%
for %%a in (jan feb mar apr may jun jul aug sep oct nov dec) do (
set %%a=
set chars_added=0
for /l %%b in (1,1,!d!) do (set "%%a=!%%a! "&set /a chars_added+=3)
for /l %%c in (1,1,!%%a_l!) do (
if %%c lss 10 (set "%%a=!%%a! %%c ") else (set "%%a=!%%a!%%c ")
set /a chars_added+=3
)
for /l %%d in (!chars_added!,1,124) do set "%%a=!%%a! "
set /a d=^(d+%%a_l^)%%7
)
%== Display the calendar ==%
cls
echo.
echo. [SNOOPY]
echo.
echo. YEAR = %y%
echo.
echo. January February March
echo. Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa
echo. %jan:~0,20% %feb:~0,20% %mar:~0,20%
echo. %jan:~21,20% %feb:~21,20% %mar:~21,20%
echo. %jan:~42,20% %feb:~42,20% %mar:~42,20%
echo. %jan:~63,20% %feb:~63,20% %mar:~63,20%
echo. %jan:~84,20% %feb:~84,20% %mar:~84,20%
echo. %jan:~105% %feb:~105% %mar:~105%
echo.
echo. April May June
echo. Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa
echo. %apr:~0,20% %may:~0,20% %jun:~0,20%
echo. %apr:~21,20% %may:~21,20% %jun:~21,20%
echo. %apr:~42,20% %may:~42,20% %jun:~42,20%
echo. %apr:~63,20% %may:~63,20% %jun:~63,20%
echo. %apr:~84,20% %may:~84,20% %jun:~84,20%
echo. %apr:~105% %may:~105% %jun:~105%
echo.
echo. July August September
echo. Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa
echo. %jul:~0,20% %aug:~0,20% %sep:~0,20%
echo. %jul:~21,20% %aug:~21,20% %sep:~21,20%
echo. %jul:~42,20% %aug:~42,20% %sep:~42,20%
echo. %jul:~63,20% %aug:~63,20% %sep:~63,20%
echo. %jul:~84,20% %aug:~84,20% %sep:~84,20%
echo. %jul:~105% %aug:~105% %sep:~105%
echo.
echo. October November December
echo. Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa Su Mo Tu We Th Fr Sa
echo. %oct:~0,20% %nov:~0,20% %dec:~0,20%
echo. %oct:~21,20% %nov:~21,20% %dec:~21,20%
echo. %oct:~42,20% %nov:~42,20% %dec:~42,20%
echo. %oct:~63,20% %nov:~63,20% %dec:~63,20%
echo. %oct:~84,20% %nov:~84,20% %dec:~84,20%
echo. %oct:~105% %nov:~105% %dec:~105%
echo.
pause
endlocal

11
Task/Calendar/Befunge/calendar.bf Normal file
View file

@ -0,0 +1,11 @@
"P"00p&>:::4%!\"d"%*\45*:*%!+!!65*+31p:1-:::"I"5**\4/+\"d"/-\45*:*/+1+7%:0v
J!F?M!A M!J J!A!S O!N D!SaFrThWeTuMoSuvp01:_1#!-#%:#\>#+6<v-2g1+1g01p1p01:<
January February March April >:45**00g\-\1-:v:<<6>+7%:10g2+:38*\`|
May June July August v02-1:+4*-4\`\4:/_$:^^:/*2+92+2:g00$$$<
September October November December>p:45*+10g*\--2/00g4-2/>:#,1#*-#8\#4_$v
>20g>:#,1#*-#8\#4_$6"$S" v. .vp040\$_4#!8#\*#-,#1>#:<+5g03g01:,,:+55<0.p03<
^_v#:-1$_v#!:,*84,g1+1,< < ^ >::4%9*40g:8`!#v_$$$1+v^+g02_#v$#,$#+5<^_v#`\<
-#8\#4_$7>1-:2*64*+:1g>^ ^ ^,g+2/4\+p04+1:<>1#\-#<:66+\^ >>$10g30g>:#,1#*
> > $$55+,6>>40p:10g30g>:#,1#*-#8\#4_$>\:2*:1+1g2-50p1g640g-7*1+\-7v v@,<6
2:+g01$_55+,^ > > > > #^>#g>#0>#2_v v*2!!\%+55:\/+55:**`0\!`g05:::\< >2-^^
->:> >#^>#<>#<^#!:-1g04$$ < < < < < >4+8*+\:!!2*4+8*+,,48*,1+\1-:>#^_$$1+\1

75
Task/Calendar/Common-Lisp/calendar.lisp Normal file
View file

@ -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))))

283
Task/Calendar/Fortran/calendar.f Normal file
View file

@ -0,0 +1,283 @@
MODULE DATEGNASH !Assorted vexations. Time and calendar games, with local flavourings added.
TYPE DateBag !Pack three parts into one.
INTEGER DAY,MONTH,YEAR !The usual suspects.
END TYPE DateBag !Simple enough.
CHARACTER*9 MONTHNAME(12),DAYNAME(0:6) !Re-interpretations.
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"/)) !Index this array with DayNum mod 7.
CHARACTER*3 MTHNAME(12) !The standard abbreviations.
PARAMETER (MTHNAME = (/"JAN","FEB","MAR","APR","MAY","JUN",
1 "JUL","AUG","SEP","OCT","NOV","DEC"/))
INTEGER*4 JDAYSHIFT !INTEGER*2 just isn't enough.
PARAMETER (JDAYSHIFT = 2415020) !Thus shall 31/12/1899 give 0, a Sunday, via DAYNUM.
CONTAINS
INTEGER FUNCTION LSTNB(TEXT) !Sigh. Last Not Blank.
Concocted yet again by R.N.McLean (whom God preserve) December MM.
Code checking reveals that the Compaq compiler generates a copy of the string and then finds the length of that when using the latter-day intrinsic LEN_TRIM. Madness!
Can't DO WHILE (L.GT.0 .AND. TEXT(L:L).LE.' ') !Control chars. regarded as spaces.
Curse the morons who think it good that the compiler MIGHT evaluate logical expressions fully.
Crude GO TO rather than a DO-loop, because compilers use a loop counter as well as updating the index variable.
Comparison runs of GNASH showed a saving of ~3% in its mass-data reading through the avoidance of DO in LSTNB alone.
Crappy code for character comparison of varying lengths is avoided by using ICHAR which is for single characters only.
Checking the indexing of CHARACTER variables for bounds evoked astounding stupidities, such as calculating the length of TEXT(L:L) by subtracting L from L!
Comparison runs of GNASH showed a saving of ~25-30% in its mass data scanning for this, involving all its two-dozen or so single-character comparisons, not just in LSTNB.
CHARACTER*(*),INTENT(IN):: TEXT !The bumf. If there must be copy-in, at least there need not be copy back.
INTEGER L !The length of the bumf.
L = LEN(TEXT) !So, what is it?
1 IF (L.LE.0) GO TO 2 !Are we there yet?
IF (ICHAR(TEXT(L:L)).GT.ICHAR(" ")) GO TO 2 !Control chars are regarded as spaces also.
L = L - 1 !Step back one.
GO TO 1 !And try again.
2 LSTNB = L !The last non-blank, possibly zero.
RETURN !Unsafe to use LSTNB as a variable.
END FUNCTION LSTNB !Compilers can bungle it.
CHARACTER*2 FUNCTION I2FMT(N) !These are all the same.
INTEGER*4 N !But, the compiler doesn't offer generalisations.
IF (N.LT.0) THEN !Negative numbers cop a sign.
IF (N.LT.-9) THEN !But there's not much room left.
I2FMT = "-!" !So this means 'overflow'.
ELSE !Otherwise, room for one negative digit.
I2FMT = "-"//CHAR(ICHAR("0") - N) !Thus. Presume adjacent character codes, etc.
END IF !So much for negative numbers.
ELSE IF (N.LT.10) THEN !Single digit positive?
I2FMT = " " //CHAR(ICHAR("0") + N) !Yes. This.
ELSE IF (N.LT.100) THEN !Two digit positive?
I2FMT = CHAR(N/10 + ICHAR("0")) !Yes.
1 //CHAR(MOD(N,10) + ICHAR("0")) !These.
ELSE !Otherwise,
I2FMT = "+!" !Positive overflow.
END IF !So much for that.
END FUNCTION I2FMT !No WRITE and FORMAT unlimbering.
CHARACTER*8 FUNCTION I8FMT(N) !Oh for proper strings.
INTEGER*4 N
CHARACTER*8 HIC
WRITE (HIC,1) N
1 FORMAT (I8)
I8FMT = HIC
END FUNCTION I8FMT
SUBROUTINE SAY(OUT,TEXT) !Gutted version that maintains no file logging output, etc.
INTEGER OUT
CHARACTER*(*) TEXT
WRITE (6,1) TEXT(1:LSTNB(TEXT))
1 FORMAT (A)
END SUBROUTINE SAY
INTEGER*4 FUNCTION DAYNUM(YY,M,D) !Computes (JDayN - JDayShift), not JDayN.
C Conversion from a Gregorian calendar date to a Julian day number, JDayN.
C Valid for any Gregorian calendar date producing a Julian day number
C greater than zero, though remember that the Gregorian calendar
C was not used before y1582m10d15 and often, not after that either.
C thus in England (et al) when Wednesday 2'nd September 1752 (Julian style)
C was followed by Thursday the 14'th, occasioning the Eleven Day riots
C because creditors demanded a full month's payment instead of 19/30'ths.
C The zero of the Julian day number corresponds to the first of January
C 4713BC on the *Julian* calendar's naming scheme, as extended backwards
C with current usage into epochs when it did not exist: the proleptic Julian calendar.
c This function employs the naming scheme of the *Gregorian* calendar,
c and if extended backwards into epochs when it did not exist (thus the
c proleptic Gregorian calendar) it would compute a zero for y-4713m11d24 *if*
c it is supposed there was a year zero between 1BC and 1AD (as is convenient
c for modern mathematics and astronomers and their simple calculations), *but*
c 1BC immediately preceeds 1AD without any year zero in between (and is a leap year)
c thus the adjustment below so that the date is y-4714m11d24 or 4714BCm11d24,
c not that this name was in use at the time...
c Although the Julian calendar (introduced by himself in what we would call 45BC,
c which was what the Romans occasionally called 709AUC) was provoked by the
c "years of confusion" resulting from arbitrary application of the rules
c for the existing Roman calendar, other confusions remain unresolved,
c so precise dating remains uncertain despite apparently precise specifications
c (and much later, Dennis the Short chose wrongly for the birth of Christ)
c and the Roman practice of inclusive reckoning meant that every four years
c was interpreted as every third (by our exclusive reckoning) so that the
c leap years were not as we now interpret them. This was resolved by Augustus
c but exactly when (and what date name is assigned) and whose writings used
c which system at the time of writing is a matter of more confusion,
c and this has continued for centuries.
C Accordingly, although an algorithm may give a regular sequence of date names,
c that does not mean that those date names were used at the time even if the
c calendar existed then, because the interpretation of the algorithm varied.
c This in turn means that a date given as being on the Julian calendar
c prior to about 10AD is not as definite as it may appear and its alignment
c with the astronomical day number is uncertain even though the calculation
c is quite definite.
c
C Computationally, year 1 is preceded by year 0, in a smooth progression.
C But there was never a year zero despite what astronomers like to say,
C so the formula's year 0 corresponds to 1BC, year -1 to 2BC, and so on back.
C Thus y-4713 in this counting would be 4714BC on the Gregorian calendar,
C were it to have existed then which it didn't.
C To conform to the civil usage, the incoming YY, presumed a proper BC (negative)
C and AD (positive) year is converted into the computational counting sequence, Y,
C and used in the formula. If a YY = 0 is (improperly) offered, it will manifest
C as 1AD. Thus YY = -4714 will lead to calculations with Y = -4713.
C Thus, 1BC is a leap year on the proleptic Gregorian calendar.
C For their convenience, astronomers decreed that a day starts at noon, so that
C in Europe, observations through the night all have the same day number.
C The current Western civil calendar however has the day starting just after midnight
C and that day's number lasts until the following midnight.
C
C There is no constraint on the values of D, which is just added as it stands.
C This means that if D = 0, the daynumber will be that of the last day of the
C previous month. Likewise, M = 0 or M = 13 will wrap around so that Y,M + 1,0
C will give the last day of month M (whatever its length) as one day before
C the first day of the next month.
C
C Example: Y = 1970, M = 1, D = 1; JDAYN = 2440588, a Thursday but MOD(2440588,7) = 3.
C and with the adjustment JDAYSHIFT, DAYNUM = 25568; mod 7 = 4 and DAYNAME(4) = "Thursday".
C The Julian Day number 2440588.0 is for NOON that Thursday, 2440588.5 is twelve hours later.
C And Julian Day number 2440587.625 is for three a.m. Thursday.
C
C DAYNUM and MUNYAD are the infamous routines of H. F. Fliegel and T.C. van Flandern,
C presented in Communications of the ACM, Vol. 11, No. 10 (October, 1968).
Carefully typed in again by R.N.McLean (whom God preserve) December XXMMIIX.
C Though I remain puzzled as to why they used I,J,K for Y,M,D,
C given that the variables were named in the INTEGER statement anyway.
INTEGER*4 JDAYN !Without rebasing, this won't fit in INTEGER*2.
INTEGER YY,Y,M,MM,D !NB! Full year number, so 1970, not 70.
Caution: integer division in Fortran does not produce fractional results.
C The fractional part is discarded so that 4/3 gives 1 and -4/3 gives -1.
C Thus 4/3 might be Trunc(4/3) or 4 div 3 in other languages. Beware of negative numbers!
Y = YY !I can fiddle this copy without damaging the original's value.
IF (Y.LT.1) Y = Y + 1 !Thus YY = -2=2BC, -1=1BC, +1=1AD, ... becomes Y = -1, 0, 1, ...
MM = (M - 14)/12 !Calculate once. Note that this is integer division, truncating.
JDAYN = D - 32075 !This is the proper astronomer's Julian Day Number.
a + 1461*(Y + 4800 + MM)/4
b + 367*(M - 2 - MM*12)/12
c - 3*((Y + 4900 + MM)/100)/4
DAYNUM = JDAYN - JDAYSHIFT !Thus, *NOT* the actual *Julian* Day Number.
END FUNCTION DAYNUM !But one such that Mod(n,7) gives day names.
Could compute the day of the year somewhat as follows...
c DN:=D + (61*Month + (Month div 8)) div 2 - 30
c + if Month > 2 then FebLength - 30 else 0;
TYPE(DATEBAG) FUNCTION MUNYAD(DAYNUM) !Oh for palindromic programming!
Conversion from a Julian day number to a Gregorian calendar date. See JDAYN/DAYNUM.
INTEGER*4 DAYNUM,JDAYN !Without rebasing, this won't fit in INTEGER*2.
INTEGER Y,M,D,L,N !Y will be a full year number: 1950 not 50.
JDAYN = DAYNUM + JDAYSHIFT !Revert to a proper Julian day number.
L = JDAYN + 68569 !Further machinations of H. F. Fliegel and T.C. van Flandern.
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 !The other side of conformity to BC/AD, as in DAYNUM.
MUNYAD%YEAR = Y !Now place for the world to see.
MUNYAD%MONTH = M
MUNYAD%DAY = D
END FUNCTION MUNYAD !A year has 365.2421988 days...
INTEGER FUNCTION PMOD(N,M) !Remainder, mod M; always positive even if N is negative.
c For date calculations, the MOD function is expected to yield positive remainders,
c in line with the idea that MOD(a,b) = MOD(a ± b,b) as is involved in shifting the zero
c of the daynumber count by a multiple of seven when considering the day of the week.
c For this reason, the zero day was chosen to be 31/12/1899, a Sunday, so that all
c day numbers would be positive. But, there was generation at Reefton in 1886.
c For some computers, the positive interpretation is implemented, for others, not.
c In the case MOD(N,M) = N - Truncate(N/M)*M, MOD(-6,7) = -6 even though MOD(1,7) = 1.
INTEGER N,M !The numbers. M presumed positive.
PMOD = MOD(MOD(N,M) + M,M) !Double do does de deed.
END FUNCTION PMOD !Simple enough.
SUBROUTINE CALENDAR(Y1,Y2,COLUMNS) !Print a calendar, with holiday annotations.
Careful with the MOD function. MOD(-6,7) may be negative on some systems, positive on others. Thus, PMOD.
INTEGER Y1,Y2,YEAR !Ah yes. Year stuff.
INTEGER M,M1,M2,MONTH !And within each year are the months.
INTEGER*4 DN1,DN2,DN,D !But days are handled via day numbers.
INTEGER W,G !Layout: width and gap.
INTEGER L,LINE !Vertical layout.
INTEGER COL,COLUMNS,COLWIDTH !Horizontal layout.
INTEGER CODE !Days are not all alike.
CHARACTER*200 STRIPE(6),SPECIAL(6),MLINE,DLINE !Scratchpads.
IF (Y1.LE.0) CALL SAY(MSG,"Despite the insinuations of "
1 //"astronomers seduced by the ease of their arithmetic, "
2 //"there is no year zero. 1AD is preceded by 1BC, "
3 //"corresponding to year -1, 2BC to year -2, etc.")
IF (Y1.LT.1582) CALL SAY(MSG,"This Gregorian calendar"
1 //" scheme did not exist prior to 1582.")
c COLUMNS = 4 !Number of months across the page.
c W = 4 !Width of a day's field.
c G = 3 !Added gap between month columns.
W = 3 !Abandon the annotation of the day's class, so just a space and two digits.
G = 1 !Set the gap to one.
COLWIDTH = 7*W + G !Seven days to a week, plus a gap.
Y:DO YEAR = Y1,Y2 !Step through the years.
CALL SAY(MSG,"") !Space out between each year's schedule.
IF (YEAR.EQ.0) THEN !This year number is improper.
CALL SAY(MSG,"There is no year zero.") !Declare correctness.
CYCLE Y !Skip this year.
END IF !Otherwise, no evasions.
MLINE = "" !Prepare a field..
L = (COLUMNS*COLWIDTH - G - 8)/2 !Find the centre.
IF (YEAR.GT.0) THEN !Ordinary Anno Domine years?
MLINE(L:) = I8FMT(YEAR) !Yes. Place the year number.
ELSE !Otherwise, we're in BC.
MLINE(L - 1:) = I8FMT(-YEAR)//"BC" !There is no year zero.
END IF !So much for year games.
CALL SAY(MSG,MLINE) !Splot the year.
DO MONTH = 1,12,COLUMNS !Step through the months of this YEAR.
M1 = MONTH !The first of this lot.
M2 = MIN(12,M1 + COLUMNS - 1) !The last.
MLINE = "" !Scrub the month names.
DLINE = "" !Wipe the day names in case COLUMNS does not divide 12.
STRIPE = "" !Scrub the day table.
SPECIAL = "" !And the associated special day remarks.
c L0 = W - 1 !Locate the first day number's first column.
L0 = 1 !Cram: no space in front of the Sunday day-of-the-month.
DO M = M1,M2 !Work through the months.
L = (COLWIDTH - G - LSTNB(MONTHNAME(M)))/2 - 1 !Centre the month name.
MLINE(L0 + L:) = MONTHNAME(M) !Splot.
DO D = 0,6 !Prepare this month's day name heading.
L = L0 + (3 - W) + D*W !Locate its first column.
DLINE(L:L + 2) = DAYNAME(D)(1:W - 1) !Squish.
END DO !On to the next day.
DN1 = DAYNUM(YEAR,M,1) !Day number of the first day of the month.
DN2 = DAYNUM(YEAR,M + 1,0)!Thus the last, without annoyance.
COL = MOD(PMOD(DN1,7) + 7,7) !What day of the week is the first day?
LINE = 1 !Whichever it is, it is on the first line.
D = 1 !Day of the month, not number of the day.
DO DN = DN1,DN2 !Step through the day numbers of this month.
L = L0 + COL*W !Finger the starting column.
STRIPE(LINE)(L:L + 1) = I2FMT(D) !Place the two-digit day number.
D = D + 1 !Advance to the next day of the current month
COL = COL + 1 !So, one more day along in the week.
IF (COL.GT.6) THEN !A fresh week is needed?
LINE = LINE + 1 !Yes.
COL = 0 !Start the new week.
END IF !So much for the end of a week.
END DO !On to the next day of this month.
L0 = L0 + 7*W + G !Locate the start column of the next month's column.
END DO !On to the next month in this layer.
CALL SAY(MSG,MLINE) !Name the months.
C CALL SAY(MSG,"") !Set off.
CALL SAY(MSG,DLINE) !Give the day name headings.
DO LINE = 1,6 !Now roll the day number table.
IF (STRIPE(LINE).NE."") THEN !Perhaps there was no use of the sixth line.
CALL SAY(MSG,STRIPE(LINE)) !Ah well. Show the day numbers.
END IF !So much for that week line.
END DO !On to the next week line.
END DO !On to the next batch of months of the YEAR.
END DO Y !On to the next YEAR.
CALL SAY(MSG,"") !Take a breath.
END SUBROUTINE CALENDAR !Enough of this.
END MODULE DATEGNASH !An ad-hoc assemblage.
PROGRAM SHOW1968 !Put it to the test.
USE DATEGNASH
INTEGER NCOL
DO NCOL = 1,6
CALL CALENDAR(1969,1969,NCOL)
END DO
END

4
Task/Calendar/Perl-6/calendar.pl6
View file

@ -11,8 +11,8 @@ sub fmt-year ($year) {
my $str = (' ' x 30) ~ $year ~ "\n";
my @month-strs;
@month-strs[$_] = fmt-month($year, $_).lines for 1 .. 12;
my Array @month-strs;
@month-strs[$_] = fmt-month($year, $_).lines.Array for 1 .. 12;
loop ( my $month = 1; $month <= 12; $month += $months-per-col ) {
while @month-strs[$month] {

16
Task/Calendar/Racket/calendar.rkt
View file

@ -1,5 +1,5 @@
#lang racket
(require racket/date)
(require racket/date net/base64 file/gunzip)
(define (calendar yr)
(define (nsplit n l) (if (null? l) l (cons (take l n) (nsplit n (drop l n)))))
(define months
@ -18,14 +18,12 @@
,@(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#2X3x7! 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* #rx"!" (string-append* s) "\n")]
[s (regexp-replace* #rx".(?:[1-7][0-9]*|[1-9])" s
(λ(m) (make-string (string->number (substring m 1))
(string-ref m 0))))])
(printf s yr))
(let ([s #"nZA7CsAgDED3nCLgoAU/3Uvv4SCE3qKD5OyNWvoBhdIHSswjMYp4YR2z80Tk8StOgP
sY0EyrMZOE6WsL3u4G5lyV+d8MyVOy8hZBt7RSMca9Ac/KUIs1L/BOysb50XMtMzEj
ZqiuRxIVqI+4kSpy7GqpXNsz+bfpfWIGOAA="]
[o (open-output-string)])
(inflate (open-input-bytes (base64-decode s)) o)
(display (regexp-replace #rx"~a" (get-output-string o) (~a yr))))
(for-each displayln
(dropf-right (for*/list ([3ms (nsplit 3 months)] [s (apply map list 3ms)])
(regexp-replace #rx" +$" (string-join s " ") ""))