# TITLE:  Day of Week for Britain and Colonies from 500 to 4099
# AUTHOR: BazzaB
# EMAIL:  barries_ecdl@hotmail.com
# DATE:   1st December 2003
# MAKE:   Casio
# MODEL:  CFX-9850G or similar

# NOTES: The lower year limit of 500 is arbitrary, and you can change the
# relevant bits to the year 1 if you want to ; it still works all right.
# I chose 500 because by now the Romans have long departed British shores,
# and Britain was invaded and conquered a few years before 500 by the Saxons,
# who brought with them a sophisticated business machinery which relied heavily
# on a common calendar between other nations and Britain. The Saxons
# consolidated all this stuff, which is why this program starts at the year 500.

# The upper limit of 4099 is to do with the way leap years are calculated.
# At present there are 3 rules to apply as to whether a year is leap or not,
# and by around 4099 a new 4th rule will have to be invented, but we obviously
# don't know what that rule will be. So beware any 'calendar' programs that
# purport to give dates for years from 4100 onwards. They are just hogwash.

# This program takes into account the British changeover in September 1752
# from the Julian to the Gregorian system, instituted by Pope Gregory
# the 13th in 1582 for the Catholic countries. The people of Britain and America
# (then a British colony) went to bed on the night of Wednesday 2nd Sept 1752,
# and woke up the next morning on Thursday 14th Sept.
# Enter 1752 September, and see for yourself.

# For more details on Calendars, Easter, etc., see:-
#   http://users.chariot.net/~gmarts/eastalg.htm
#   http://aa.usno.navy.mil/faq/docs/easter.html
#   www.assa.org.au/edm.html
#   www.polysyllabic.com/GregConv.html
#   www.cviog.uga.edu/Projects/gainfo/dates.htm

# KEYS:
#   ->     assignment      above [ AC/ON ]
#   =>     if-then         shift vars f3 f3
#   \^-1   reciprocal      shift [ ) ] key
#   {      curly bracket   shift [ multiply ]
#__________________________________________________


@@ Program "WEEKDAY"

# Needs Subroutines "S-MTHCOD", "S-MTHTBL" and "S-DAYTBL",
# shown at the end of the main listing.

Norm:ClrList:0->A~Z
{0,3,3,6,1,4,6,2,5,0,3,5->List 1
{31,28,31,30,31,30,31,31,30,31,30,31->List 2
Do:ClrText
Locate 1,3,"BRITISH AND":Locate 1,4,"AMERICAN WEEKDAYS"
Locate 2,6,"ENTER YEAR":Locate 2,7,"FROM 500 TO 4099"
"YEAR -> "?->Y:LpWhile Frac Y+(Y<500)+(Y>4099
Int .01Y->H:Y-100H->J
(Y<1753)(Frac .25Y<.1->P         ; if P=1 then the year is Leap
If Y>1752
Then Frac .25Y<.1->A:Frac .01Y<.001->B:Frac .0025Y<.001->C
2Frac (.5(A+B+C->P               ; if P=1 then the year is Leap
IfEnd
Do:ClrText
Locate 2,2,"MONTH OF YEAR":Locate 16,2,Y:Prog "S-MTHCOD"
"MONTH -> "?->M:LpWhile Frac M+(M<1)+(M>12
List 1[M->N:List 2[M->K:P(M=2=>29->K
If (Y=1752)(M=9
Then Do:ClrText
Locate 1,3,"DATE OF SEPT 1752":Locate 4,6,"FROM"
Locate 10,6,"1 TO":Locate 16,6,"2":Locate 6,7,"OR 14 TO 30"
"DATE -> "?->D:LpWhile Frac D+(D<1)+(D>30)+((D>2)(D<14
D+1->W:D>2=>7Frac (7\^-1(D-10->W
IfEnd
If Not ((Y=1752)(M=9
Then Do:ClrText
Locate 1,3,"DATE OF":9->C:3->L:Prog "S-MTHTBL"
Locate 1,4,"FOR YEAR":Locate 10,4,Y
Locate 1,5,"FROM 1 TO":Locate 11,5,K
"DATE -> "?->D:LpWhile Frac D+(D<1)+(D>K
((Y>1752)+((Y=1752)(M>9)))->S
18-H->W:S=>6-8Frac .25H->W
W+Int (12\^-1J+.01)+12Frac 12\^-1J->W
D+N+W+Int (.25(12Frac 12\^-1J)+.1->W
P((M=1)+(M=2))=>W-1->W
W<.1=>W+7->W:7Frac 7\^-1W->W
IfEnd
Int (W+.1->W
'  RESULT
ClrText:Locate 1,1,D
Locate 1,2,"FOR YEAR":Locate 10,2,Y:Locate 1,3,"IS"
3-(D<10->C:Locate C,1,"TH"
(D=1)+(D=21)+(D=31=>Locate C,1,"ST"
(D=2)+(D=22=>Locate C,1,"ND"
(D=3)+(D=23=>Locate C,1,"RD"
C+3->C:1->L:Prog "S-MTHTBL":4->C:3->L:Prog "S-DAYTBL"
Locate 2,7,"'EXE' FOR ANOTHER"
#_____________________________________________

@@ Program "S-MTHCOD"

Locate 2,4,"1=JAN  2=FEB  3=MAR"     ;  note the
Locate 2,5,"4=APR  5=MAY  6=JUN"     ;  spacings in these
Locate 2,6,"7=JUL  8=AUG  9=SEP"     ;  three lines.
Locate 1,7,"10=OCT 11=NOV 12=DEC"
#_____________________________________________

@@ Program "S-MTHTBL"

M=1=>Locate C,L,"JANUARY":M=2=>Locate C,L,"FEBRUARY"
M=3=>Locate C,L,"MARCH":M=4=>Locate C,L,"APRIL"
M=5=>Locate C,L,"MAY":M=6=>Locate C,L,"JUNE
M=7=>Locate C,L,"JULY":M=8=>Locate C,L,"AUGUST"
M=9=>Locate C,L,"SEPTEMBER":M=10=>Locate C,L,"OCTOBER"
M=11=>Locate C,L,"NOVEMBER":M=12=>Locate C,L,"DECEMBER"
#_____________________________________________

@@ Program "S-DAYTBL"

W=0=>Locate C,L,"SUNDAY":W=1=>Locate C,L,"MONDAY"
W=2=>Locate C,L,"TUESDAY":W=3=>Locate C,L,"WEDNESDAY"
W=4=>Locate C,L,"THURSDAY":W=5=>Locate C,L,"FRIDAY"
W=6=>Locate C,L,"SATURDAY"
#_____________________________________________