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

Data update

Browse source
This commit is contained in:
Ingy döt Net 2026-02-01 16:33:20 -08:00
parent 5150844a7d
commit 4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
Download patch file Download diff file Expand all files Collapse all files

66
Task/Calendar---for-REAL-programmers/Red/calendar---for-real-programmers.red
View file

@ -4,19 +4,19 @@ MONTHS: SYSTEM/LOCALE/MONTHS
; GET DAY FROM YEAR, MONTH, WEEK, AND WEEKDAY!
GETDAY: FUNCTION [Y[INTEGER!] M[INTEGER!] W[INTEGER!] WD[INTEGER!]] [
FD: TO-DATE REDUCE [1 M Y] ; FIRST DAY!
SWD: FD/WEEKDAY + 1 IF SWD > 7 [SWD: 1] ; SHIFT FROM MON=1 TO SUN=1
OFS: (W - 1) * 7 + (WD - SWD) ; OFFSET
D: FD + OFS ; DATE
EITHER D/MONTH = M [D/DAY][0] ; RETURN DAY OR ZERO!
FD: TO-DATE REDUCE [1 M Y] ; FIRST DAY!
SWD: FD/WEEKDAY + 1 IF SWD > 7 [SWD: 1] ; SHIFT FROM MON=1 TO SUN=1
OFS: (W - 1) * 7 + (WD - SWD) ; OFFSET
D: FD + OFS ; DATE
EITHER D/MONTH = M [D/DAY][0] ; RETURN DAY OR ZERO!
]
; CENTER STRING
CENTR: FUNCTION [STR WID] [
GAP: WID - LENGTH? STR
LPAD: TO-INTEGER GAP / 2
PAD/LEFT STR WID - LPAD
PAD STR WID
GAP: WID - LENGTH? STR
LPAD: TO-INTEGER GAP / 2
PAD/LEFT STR WID - LPAD
PAD STR WID
]
EITHER "" = Y: ASK "YEAR (ENTER FOR CURRENT): " [Y: NOW/YEAR][Y: TO-INTEGER Y]
@ -25,28 +25,28 @@ PRINT CENTR "[ S N O O P Y ]" 130 ; PRINT SNOOPY BLOCK CENTERED
PRINT CENTR TO-STRING Y 130 ; PRINT YEAR
FOREACH R [[1 2 3 4 5 6][7 8 9 10 11 12]] [
; PRINT MONTH'S NAME
FOREACH M R [
PRIN REJOIN [CENTR UPPERCASE MONTHS/:M 21 " "]
] PRINT ""
; PRINT FOR EACH WEEK ACROSS MONTHS
FOREACH W [0 1 2 3 4 5 6] [
; EACH MONTHS
FOREACH M R [
EITHER W = 0 [ ; PRINT WEEKDAYS
FOREACH D ["SU" "MO" "TU" "WE" "TH" "FR" "SA"]
[PRIN [FORM PAD D 3]]
] [
FOREACH WD [1 2 3 4 5 6 7] [ ; PRINT DATES
; RECONSTRUCT THE DAY
EITHER 0 < DT: GETDAY Y M W WD [
PRIN [FORM PAD/LEFT DT 2]
] [
PRIN " "
] PRIN " "
]
] PRIN " "
] PRINT ""
] PRINT ""
; PRINT MONTH'S NAME
FOREACH M R [
PRIN REJOIN [CENTR UPPERCASE MONTHS/:M 21 " "]
] PRINT ""
; PRINT FOR EACH WEEK ACROSS MONTHS
FOREACH W [0 1 2 3 4 5 6] [
; EACH MONTHS
FOREACH M R [
EITHER W = 0 [ ; PRINT WEEKDAYS
FOREACH D ["SU" "MO" "TU" "WE" "TH" "FR" "SA"]
[PRIN [FORM PAD D 3]]
] [
FOREACH WD [1 2 3 4 5 6 7] [ ; PRINT DATES
; RECONSTRUCT THE DAY
EITHER 0 < DT: GETDAY Y M W WD [
PRIN [FORM PAD/LEFT DT 2]
] [
PRIN " "
] PRIN " "
]
] PRIN " "
] PRINT ""
] PRINT ""
]