RosettaCodeData/Task/Doomsday-rule/BCPL/doomsday-rule.bcpl
2023-07-01 13:44:08 -04:00

37 lines
1.2 KiB
Text

get "libhdr"
let dayname(n) =
n = 0 -> "Sunday",
n = 1 -> "Monday",
n = 2 -> "Tuesday",
n = 3 -> "Wednesday",
n = 4 -> "Thursday",
n = 5 -> "Friday",
n = 6 -> "Saturday",
dayname(n rem 7)
let leap(year) = year rem 4 = 0 & (year rem 100 ~= 0 | year rem 400 = 0)
let weekday(y, m, d) = valof
$( let leapdoom = table 4,1,7,4,2,6,4,1,5,3,7,5
let normdoom = table 3,7,7,4,2,6,4,1,5,3,7,5
let c = y / 100 and r = y rem 100
let s = r / 12 and t = r rem 12
let an = (5 * (c rem 4) + 2) rem 7
let doom = (s + t + (t/4) + an) rem 7
let anchor = (leap(y) -> leapdoom, normdoom)!(m-1)
resultis (doom + d - anchor + 7) rem 7
$)
let start() be
$( writef("January 6, 1800 was on a %S.*N", dayname(weekday(1800, 1, 6)))
writef("March 29, 1875 was on a %S.*N", dayname(weekday(1875, 3, 29)))
writef("December 7, 1915 was on a %S.*N", dayname(weekday(1915, 12, 7)))
writef("December 23, 1970 was on a %S.*N", dayname(weekday(1970, 12, 23)))
writef("May 14, 2043 will be on a %S.*N", dayname(weekday(2043, 5, 14)))
writef("February 12, 2077 will be on a %S.*N", dayname(weekday(2077, 2, 12)))
writef("April 2, 2101 will be on a %S.*N", dayname(weekday(2101, 4, 2)))
$)