[REBOL] Revised discordian dates
From: chris::starforge::demon::co::uk at: 6-Jul-2001 14:22
Hi,
Below should be a copy of Johan' poee-calendar script with a few
modifications I made yesterday.
Chris
--
New sig in the works
Explorer2260 Designer and Coder
http://www.starforge.co.uk
--
-- Attached file included as plaintext by Listar --
-- File: discordian.r
REBOL [
title: "Discordian dates"
version: 0.0.3
author: "Johan Forsberg"
file: %ddate.r
email: [johan--forsberg--6117--student--uu--se]
date: 5-jul-2001
ddate: "Sweetmorn, Confusion 40, Year of Our Lady of Discord 3167"
purpose: {Date Converter from the Gregorian to the Semi-Divinely
Revealed POEE Calendar.}
example: {poee-calendar/make-poee-date-string now}
history: [
0.0.1 [25-jun-2001 "First version" "Johan"]
0.0.2 [25-jun-2001 "Corrected for ST. Tib's Day" "Johan"]
0.0.3 [5-jul-2001 {Added /long refinement to make-poee-date-string to
allow ddate like output. Corrected wekdays/5. Made
poee-calendar and object! rather than a context} "Chris"]
]
]
poee-calendar: make object! [
seasons: ["Chaos" "Discord" "Confusion" "Bureaucracy" "The Aftermath"]
weekdays: ["Setting Orange" "Sweetmorn" "Boomtime" "Pungenday" "Prickle-Prickle"]
holidays: [
apostle ["Mungoday" "Mojoday" "Syaday" "Zaraday" "Maladay"]
season ["Chaoflux" "Discoflux" "Confuflux" "Bureflux" "Afflux"]
]
leap-year?: function [year] [] [
return either ((year // 4) = 0) and ((year // 400) = 0) [true] [false]
]
get-day-of-year: function [date /notib] [day] [
gregorian: [
31 (either (not notib) and (leap-year? date/year) [29] [28]) 31 30 31 30
31 31 30 31 30 31
]
day: date/day
for i 1 (date/month - 1) 1 [
day: day + do gregorian/:i
]
return day
]
get-season-and-day: function [date] [day season] [
day: get-day-of-year date
season: 1
ly: leap-year? date/year
while [day > 73] [
day: day - either (season = 1) and ly [
74
] [
73
]
season: season + 1
]
return reduce [
either (season = 1) and (day > 59) [day: day - 1 (day = 59)] [false]
season day
]
]
day-ending: function [day] [base] [
base: day // 10
switch base [
1 [ return "st" ]
2 [ return "nd" ]
3 [ return "rd" ]
]
return "th"
]
make-poee-date: function [date] [] [
sd: get-season-and-day date
wd: ((get-day-of-year/notib date) // 5) + 1
return compose [
st-tibs-day (sd/1)
weekday (pick weekdays wd)
season (pick seasons sd/2)
day (sd/3)
year (date/year + 1166)
holiday (
switch/default sd/3 [
5 [pick holidays/apostle sd/2]
50 [pick holidays/season sd/2]
] [none]
)
]
]
make-poee-date-string: function [date /long] [pd] [
pd: make-poee-date date
either long [
return rejoin [
"Today is "
either pd/st-tibs-day [
"St. Tib's Day"
] [
rejoin [pd/weekday ", the " pd/day day-ending pd/day " day of " pd/season " "]
]
"in the YOLD " pd/year
either none? pd/holiday [""] [rejoin [" -- " pd/holiday]]
]
][
return rejoin [
either pd/st-tibs-day [
"St. Tib's Day"
] [
rejoin [pd/weekday ", " pd/season " " pd/day]
]
", YOLD " pd/year
either none? pd/holiday [""] [rejoin [" -- " pd/holiday]]
]
]
]
]
