10  *|     *** CALENDAR ***
   20  :
   30  *| From PCW Oct83. Algorithm only by Kevin R Smith.
   40  *| Program corrected and rewritten for BBC's by dp-j 20Feb90
   50  *| 1AD to 4AD incl. now correct
   60  *| Original span 25000 BC to 20000 AD invalid
   70  :
   80  *FX229,1
   90  *FX4,2
  100  MODE7
  110  PROCtitle
  120  PRINT'CHR$129"Corrected and rewritten for BBC/Master"
  130  PRINTTAB(10)CHR$129"by dp-j 20Feb90"
  140  PRINT''CHR$134"Displays a calendar of any month of any"CHR$134"      year from 1 AD to 3999 AD"
  150  PRINT'CHR$134"  Great Britain and American Colonies"
  160 :
  170  DIM M$(12):FOR I=1 TO 12:READ M$(I):NEXT
  180  REPEAT:REPEAT:PRINTTAB(0,21)CHR$130"Enter date        mm,yyyy "'CHR$130"or 0, to Quit     ";:INPUT""M,Y;
  190  IF M=0 AND Y=0 PRINT'CHR$129"FINISHED":OSCLI"FX229,0":OSCLI"FX4,0":END
  200  IF M=0 OR Y=0 OR M<0 OR M>12 OR Y<0 OR Y>3999 PRINTTAB(31,21)CHR$129"ERROR"TAB(29,22)CHR$129"<Any key>";:VDU7:g=GET:PRINTTAB(31,21)"      "TAB(18,22)STRING$(21," "):PRINTSTRING$(10," "):UNTILFALSE
  210  I=Y
  220  CLS:PROCtitle:PRINTTAB(9,11)CHR$131M$(M)SPC(3);I" AD"
  230  PROCcalc:I=J
  240  PRINTTAB(9,13)CHR$134"S  M  T  W  T  F  S"
  250 :
  260  M=M+1:IF M>12 M=1:Y=Y+1
  270  PROCcalc:N=J-I:J=I MOD7+1
  280  IF J=7 J=0
  290  J=J*3+10:K=1
  300  IF Y<>1752 OR M<>10 PROCdo ELSE  PRINTTAB(J-1)CHR$131"1  2";:K=14:J=22:N=30:PROCdo
  310  UNTILFALSE
  320 :
  330  DEF PROCdo
  340  FOR I=K TO N
  350  IF I<10 PRINTTAB(J-1);CHR$131I; ELSE PRINTTAB(J-2);CHR$131I;
  360  J=J+3
  370  IF J>29 J=10
  380  NEXT:ENDPROC
  390  :
  400  DEF PROCcalc
  410  K=Y+4712:J=INT(K/4)+365*K
  420  IF Y<4 J=J+1: *|4AD not a leap yr
  430  N=30.6*M-32.3
  440  IF M<3 N=N+2.32:IF Y>4 AND K MOD4=0 J=J-1:*|leap yr recognition after 4AD
  450  J=J+INT(N+1)
  460  IF J<2361221 ENDPROC
  470  K=Y-300
  480  IF M<3 K=K-1
  490  N=INT(K/100)
  500  J=J-INT(.75*N)-1:ENDPROC
  510 :
  520  DEF PROCtitle
  530  CLS:PRINTTAB(13,4)CHR$141CHR$134"CALENDAR":PRINTTAB(13,5)CHR$141CHR$130"CALENDAR"
  540  PRINTTAB(10,7)CHR$134"by Kevin R Smith"
  550  ENDPROC
  560 :
  570  DATA January,February,March,April,May,June,July,August,September,October,November,December