Rebol3 Code Examplex
Calendar - for "REAL" programmers
Generate a properly formatted calendar using the “REAL programmers” convention.
Rebol [
title: {Rosetta code: Calendar - for "REAL" programmers}
file: %Calendar_for_REAL_programmers.r3
url: https://rosettacode.org/wiki/Calendar_-_for_%22REAL%22_programmers
note: "Based on Red language implementation!"
]
REAL-CALENDAR: FUNCTION/WITH [YEAR [INTEGER!]][
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 DT -2]
] [
PRIN " "
] PRIN " "
]
] PRIN " "
] PRINT ""
] PRINT ""
]
][
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 STR NEGATE (WID - LPAD)
PAD STR WID
]
]
;; DEMO:
REAL-CALENDAR 2015