\ easter 99.1.1 6:17 pm NAB
needs calendar
: century ( year -- c ) 100 / 1+ ;
: shifted-epact ( year -- s )
dup 19 mod 11 * 14 + ( y y1 )
swap century ( y1 c )
tuck ( c y1 c ) 3 4 */ - ( c y2 )
swap ( y2 c ) 8 * 5 + 25 / + ( y3 )
30 mod ( s ) ;
: adjusted-epact ( year -- a )
dup 19 mod 10 > ( year y1 )
swap shifted-epact tuck ( s y1 s )
1 = and over 0= or 1 and + ( a ) ;
: paschal-moon ( year -- date. )
>r 19 April r@ dmy>date
r> adjusted-epact s>d d- ;
: easter ( year -- date. )
paschal-moon sunday after ;
\ Holidays depending on Easter:
: ash-wednesday ( year -- d. )
easter 46. d- ;
: passion-sunday ( year -- d. )
easter 14. d- ;
: palm-sunday ( year -- d. )
easter 7. d- ;
: holy-thursday ( year -- d. )
easter 3. d- ;
: good-friday ( year -- d. )
easter 2. d- ;
: rogation-sunday ( year -- d. )
easter 35. d+ ;
: ascension-day ( year -- d. )
easter 39. d+ ;
: pentecost ( year -- d. )
easter 49. d+ ;
: whitmundy ( year -- d. )
easter 50. d+ ;
: trinity-sunday ( year -- d. )
easter 56. d+ ;
: corpus-christi ( year -- d. )
easter 60. d+ ;
: corpus-christi-us-catholic
( year -- d. )
easter 63. d+ ;
: septuagesima-sunday ( year -- d. )
easter 63. d- ;
: sexagesima-sunday ( year -- d. )
easter 56. d- ;
: shrove-sunday ( year -- d. )
easter 49. d- ;
: shrove-monday ( year -- d. )
easter 48. d- ;
: shrove-tuesday ( year -- d. )
easter 47. d- ;
\ Test scaffolding:
needs tools-ext
0 [if]
needs tester
decimal
TESTING EASTER
{ 1999 easter date>dmy
-> 4 April 1999 }
{ 1999 shrove-tuesday date>dmy
-> 16 February 1999 }
{ 1999 ash-wednesday date>dmy
-> 17 February 1999 }
{ 1999 palm-sunday date>dmy
-> 28 March 1999 }
{ 1999 holy-thursday date>dmy
-> 1 April 1999 }
{ 1999 good-friday date>dmy
-> 2 April 1999 }
{ 1999 ascension-day date>dmy
-> 13 May 1999 }
{ 1999 pentecost date>dmy
-> 23 May 1999 }
[then]