RosettaCodeData/Task/Calendar---for-REAL-program.../Red/calendar---for-real-program...

53 lines
1.3 KiB
Plaintext

Red [ "PRINT CALENDAR IN SIX MONTHS ACROSS AND FOR TWO ROWS - HINJO, 20 JULY 2025" ]
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!
]
; CENTER STRING
CENTR: FUNCTION [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]
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 ""
]