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 [Y [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 2015Output:
[ S N O O P Y ]
2015
JANUARY FEBRUARY MARCH APRIL MAY JUNE
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 1 2 3 4 5 6 7 1 2 3 4 5 6 7 1 2 3 4 1 2 1 2 3 4 5 6
4 5 6 7 8 9 10 8 9 10 11 12 13 14 8 9 10 11 12 13 14 5 6 7 8 9 10 11 3 4 5 6 7 8 9 7 8 9 10 11 12 13
11 12 13 14 15 16 17 15 16 17 18 19 20 21 15 16 17 18 19 20 21 12 13 14 15 16 17 18 10 11 12 13 14 15 16 14 15 16 17 18 19 20
18 19 20 21 22 23 24 22 23 24 25 26 27 28 22 23 24 25 26 27 28 19 20 21 22 23 24 25 17 18 19 20 21 22 23 21 22 23 24 25 26 27
25 26 27 28 29 30 31 29 30 31 26 27 28 29 30 24 25 26 27 28 29 30 28 29 30
31
JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER
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 2 3 4 5 1 2 3 1 2 3 4 5 6 7 1 2 3 4 5
5 6 7 8 9 10 11 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 6 7 8 9 10 11 12
12 13 14 15 16 17 18 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 13 14 15 16 17 18 19
19 20 21 22 23 24 25 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 20 21 22 23 24 25 26
26 27 28 29 30 31 23 24 25 26 27 28 29 27 28 29 30 25 26 27 28 29 30 31 29 30 27 28 29 30 31
30 31