EasterQB - Easter Dating Program Listing

This is a QuickBASIC program listing. The compiled executable file
EasterQB.exe is available at
http://www.geocities.com/hjsmithh/download.html#Easter .

'Start of file EasterQB.QB ---------------------------------------------

  DECLARE SUB Easter (d AS LONG, m AS LONG, y AS LONG)
    'd = Day of month of Easter Sunday (output)
    'm = Month of Easter Sunday (output)
    'y = Yeas to calculate Easter Sunday for (input)

  DECLARE SUB EasterO (d AS LONG, m AS LONG, y AS LONG)
    'd = Day of month of Easter Sunday (output)
    'm = Month of Easter Sunday (output)
    'y = Yeas to calculate Easter Sunday for (input)

Name$ = "EasterQB - What date does Easter Sunday come on in a given year?"
Version$ = "Version 1.23, last revised: 2008/06/18"
Author$ = "Copyright (c) 1981-2008 by author: Harry J. Smith,"
Address$ = "19628 Via Monte Dr., Saratoga CA 95070.  All rights reserved."

'Western Easter Sunday date is based on Scientific American, March 2001,
'Mathematical Recreations by Ian Stewart, Page 82
'The period is 5,700,000 years
'Gregorian calendar started October 15, 1582 (previous day was Oct 4)
'Germany switched to Gregorian calendar in 1700
'England and U.S. switched on Sept 14, 1752 (previous day was Sep 2)
'Earliest Easter Sunday is on March 22 (in year 1818 and 2285 for example)
'Latest Easter Sunday is on April 25 (in year 1943 and 2038 for example)

'For Orthodox Easter Sunday date see subroutine below.

' Global variables
DIM YI  AS LONG    'Year input
DIM y   AS LONG    'Year to compute for
DIM m   AS LONG    'Month, 3 or 4 Western Gregorian date
DIM d   AS LONG    'Day, 1 through 31 "       "      "
DIM m2  AS LONG    'Month, 4 or 5 Orthodox Gregorian date
DIM d2  AS LONG    'Day, 1 through 31 "        "      "
DIM m3  AS LONG    'Month, 3 or 4 Orthodox Julian date
DIM d3  AS LONG    'Day, 1 through 31 "      "     "
DIM ds  AS INTEGER 'days to subtract from Gregorian date for Julian date

'-----------------------------------------------------------------------
'Main
  GOSUB Init
  y = 2004
  DO
    INPUT "Year: ", YI
    IF YI < 0 THEN PRINT "Exit program Easter"; : END
    IF YI = 0 THEN YI = y + 1
    y = YI
    CALL Easter(d, m, y)
    CALL EasterO(d2, m2, y)
    ds = INT(y / 100) - INT(y / 400) - 2
    m3 = m2
    d3 = d2 - ds
    IF (d3 < 1) THEN
      m3 = m3 - 1
      IF (m3 = 4) THEN
        d3 = d3 + 30
      ELSE
        d3 = d3 + 31
      END IF
    END IF
    PRINT "Easter Sunday:"; USING "#####"; y;
    PRINT USING " ##"; m;
    PRINT "/"; USING "##"; d;
    PRINT " Western";
    IF (d = d2) AND (m = m2) THEN
      PRINT "  Same";
    ELSE
      PRINT USING " ##"; m2;
      PRINT "/"; USING "##"; d2;
    END IF
    PRINT " Orthodox  (";
    IF (m3 = 3) THEN PRINT "March";
    IF (m3 = 4) THEN PRINT "April";
    PRINT " "; USING "##"; d3; : PRINT " Julian date)"
  LOOP
END 'Main

'-----------------------------------------------------------------------
Init: 'Initialize the Program
  SCREEN 0
  COLOR 14, 1 'textcolor (YELLOW) textbackground (BLUE)
  CLS : PRINT : PRINT Name$: PRINT Version$: PRINT Author$: PRINT Address$
  PRINT
  PRINT "Input a year < 0 to quit"
  PRINT "Input a year = 0 or blank to add 1 to previous year computed"
  PRINT
  PRINT "Gregorian Calendar Dates"
  RETURN
'END SUB Init

'-----------------------------------------------------------------------
'The Date of Western Easter:
'
SUB Easter (day AS LONG, month AS LONG, Year AS LONG)

  DIM A    AS LONG   'Intermediate integer variables
  DIM B    AS LONG   '     "          "        "
  DIM C    AS LONG   '     "          "        "
  DIM d    AS LONG   '     "          "        "
  DIM E    AS LONG   '     "          "        "
  DIM G    AS LONG   '     "          "        "
  DIM H    AS LONG   '     "          "        "
  DIM m    AS LONG   '     "          "        "
  DIM J    AS LONG   '     "          "        "
  DIM K    AS LONG   '     "          "        "
  DIM L    AS LONG   '     "          "        "
  DIM N    AS LONG   'Month, 3 or 4
  DIM P    AS LONG   'Day, 1 through 31
  DIM Diag AS INTEGER  'Diagnostic flag


  Diag = 0  'Set Diag = 1 for diagnostic output
  A = Year MOD 19
  B = Year \ 100: C = Year MOD 100
  d = B \ 4: E = B MOD 4
  G = (8 * B + 13) \ 25
  H = (19 * A + B - d - G + 15) MOD 30
  m = (A + 11 * H) \ 319
  J = C \ 4: K = C MOD 4
  L = (2 * E + 2 * J - K - H + m + 32) MOD 7
  N = (H - m + L + 90) \ 25
  P = (H - m + L + N + 19) MOD 32
  IF Diag THEN
    PRINT " A ="; A;
    PRINT " B ="; B; " C ="; C;
    PRINT " D ="; d; " E ="; E;
    PRINT " G ="; G;
    PRINT " H ="; H;
    PRINT " M ="; m;
    PRINT " J ="; J; " K ="; K;
    PRINT " L ="; L
  END IF
  month = N
  day = P

END SUB 'Easter

'-----------------------------------------------------------------------
'The Date of Orthodox Easter:
'This simple algorithm is listed in the Calendar FAQ by Claus
'Tondering. It is based on Oudin's algorithm.
'
'Copyright and disclaimer
'------------------------
'This document is Copyright (C) 1996 by Claus Tondering.
'E-mail: [email protected].
'The document may be freely distributed, provided this
'copyright notice is included and no money is charged for
'the document.
'
'See:
'http://www.assa.org.au/edm.html
'http://www.smart.net/~mmontes/ortheast.html
'http://www.tondering.dk/claus/calendar.html
'
SUB EasterO (day AS LONG, month AS LONG, Year AS LONG)

  DIM G  AS LONG    'Intermediate integer variables
  DIM I  AS LONG    '     "          "        "
  DIM J  AS LONG    '     "          "        "
  DIM L  AS LONG    '     "          "        "
  DIM RC AS LONG    '     "          "        "

  G = Year MOD 19
  I = (19 * G + 15) MOD 30
  J = (Year + Year \ 4 + I) MOD 7
  L = I - J
  month = 3 + (L + 40) \ 44
  day = L + 28 - 31 * (month \ 4)
  IF month = 3 THEN RC = day - 21
  IF month = 4 THEN RC = day + 10

  day = RC + 21
  day = day + (Year \ 100 - Year \ 400 - 2)
  IF day <= 31 THEN
    month = 3
  ELSEIF day <= 61 THEN
    day = day - 31
    month = 4
  ELSE
    day = day - 61
    month = 5
  END IF

END SUB 'EasterO 'End of file EasterQB.QB -------------------------------