'===========================================================================
' Subject: PRINTS OUT A CALENDAR             Date: 11-25-97 (12:30)       
' Author:  John P. Brown                     Code: QB, QBasic, PDS        
' Origin:  J.P.Brown@bradford.ac.uk        Packet: DATETIME.ABC
'===========================================================================
' File Name     : CAL.BAS
' Program Name  : CALENDAR
' Version       : Ver 1.0
' Type          : Freeware
' Developed     : 24/11/97
' Author        : John P. Brown
' Revised       :
'
' Thanks for downloading Calendar
'
' The author makes no warrenties about the operation of this program,
' expressed or implied.

DECLARE SUB out3 (Month AS INTEGER)
DECLARE SUB fillM (day1 AS INTEGER, Month AS INTEGER, n AS INTEGER)
DECLARE SUB init ()
DECLARE FUNCTION leapyear (y AS INTEGER)
DECLARE FUNCTION firstday (year AS INTEGER)

' program calendar
' prints a calendar for any year 1582 - 4902 using Rev. Zellers formula

CONST Mo = 0, Tu = 1, We = 2, Th = 3, Fr = 4, Sa = 5, Su = 6

'global variables
DIM SHARED mat3(1 TO 3, 1 TO 6, 0 TO 6)  'array variable to hold 3 months
DIM SHARED Mname(1 TO 12) AS STRING * 9  'holds the names of the months
DIM SHARED LastD(1 TO 12) AS INTEGER     'last day variable ie. month lengh

DIM Month AS INTEGER, day1 AS INTEGER, n AS INTEGER, year AS INTEGER

'*** Main Program ***
SCREEN 0: WIDTH 80: CLS
init ' fills month data arrays (month name and month lengh)
PRINT "Calendar maker (valid years 1582-4902)"
PRINT "======================================"
PRINT "For which year do you want a calendar?"
INPUT year
IF leapyear(year) THEN
  LastD(2) = 29  'adjust lengh of February
END IF
day1 = firstday(year)  'calculate day of week for jan 1st
LPRINT "                  ******* CALENDAR FOR "; year; " *******"
Month = 1  'initialize month number to January
DO
  FOR n = 1 TO 3   'n points to month in row of three
    CALL fillM(day1, Month, n) 'construct one month
    day1 = (day1 + LastD(Month)) MOD 7  'sets first day of next month
    Month = Month + 1  'next month
  NEXT n
  CALL out3(Month - 1)  'prints out three Months in a row
LOOP UNTIL Month > 12   'do until end of year
END   'main program

SUB fillM (day1 AS INTEGER, Mnth AS INTEGER, n AS INTEGER)
' fills 3 X "6 week by 7" day table with day numbers or zero
DIM i AS INTEGER, w AS INTEGER, d AS INTEGER
DIM k AS INTEGER, Mnd AS INTEGER
Mnd = LastD(Mnth) 'LastD day of this month  ie. how many days in this month
w = 1    'points to week in this month ie. row of calendar block
d = day1 'initialize day number count (Mo, Tu etc. etc.)
k = 0    'point to first valid day in calendar block
FOR i = 0 TO day1 - 1' fill leading elements
  mat3(n, 1, i) = 0  ' with zero mat3(month-position, week, day)
NEXT i
DO
  k = k + 1  'day number
  IF k <= Mnd THEN mat3(n, w, d) = k ELSE mat3(n, w, d) = 0 'leading days
   d = d + 1
  IF d > 6 THEN
    d = 0      ' point to
    w = w + 1  ' to next week
  END IF
LOOP UNTIL w = 7  'all elements of this month filled
END SUB  'fillM

FUNCTION firstday (year AS INTEGER)
' uses Zellers formula correct for 1582-4092
' calculates the day of week for 1st jan
' returns 0..6 = mon..sun   

DIM y, M, day, DayNum, C, YinC AS INTEGER
  y = year - 1  'jan & feb considered to be in previous year,
  M = 11       'jan is considered to be 11 for zellers formula
  day = 1
  C = y \ 100       'get a number for Century 1977 =19 for example
  YinC = y MOD 100  'year in century 1977 will = 77 for example
'Zellers formula:-
DayNum = (FIX(2.6 * M - .19) + day + YinC + C \ 4 + YinC \ 4 - 2 * C) MOD 7
  IF DayNum > 0 THEN   'adjust the day number for this program
    DayNum = DayNum - 1
  ELSE
    DayNum = 6
  END IF
firstday = DayNum
END FUNCTION 'firstday

SUB init
' fills global vectors for 12 Months

 Mname(1) = "January  ": LastD(1) = 31: 'LastD day of Month No
 Mname(2) = "February ": LastD(2) = 28
 'leap year taken care of outside this sub
 Mname(3) = "  March  ": LastD(3) = 31
 Mname(4) = "  April  ": LastD(4) = 30
 Mname(5) = "   May   ": LastD(5) = 31
 Mname(6) = "  June   ": LastD(6) = 30
 Mname(7) = "  July   ": LastD(7) = 31
 Mname(8) = " August  ": LastD(8) = 31
 Mname(9) = "September": LastD(9) = 30
 Mname(10) = " October ": LastD(10) = 31
 Mname(11) = "November ": LastD(11) = 30
 Mname(12) = "December ": LastD(12) = 31
 END SUB  'init

FUNCTION leapyear (y AS INTEGER)
 ' if a leap year returns true
 
IF (y MOD 400 = 0) OR (y MOD 4 = 0) AND (y MOD 100 <> 0) THEN
  leapyear = 1
ELSE
  leapyear = 0
END IF
END FUNCTION

SUB out3 (Month AS INTEGER)
' lprints three Months side by side
DIM w AS INTEGER, i AS INTEGER, d AS INTEGER, n AS INTEGER
'headings first
LPRINT        ' \/ lprint out the names of the Months
LPRINT "      ";
LPRINT Mname(Month - 2); "                ";
LPRINT Mname(Month - 1); "                ";
LPRINT Mname(Month)
FOR i = 1 TO 72   ' lprint a line across the sheet
  LPRINT "-";
NEXT i
LPRINT
  FOR i = 1 TO 3       'print the day names (3 months across the page)
    FOR dn = Mo TO Su
      IF dn = Mo THEN LPRINT " Mo";
      IF dn = Tu THEN LPRINT " Tu";
      IF dn = We THEN LPRINT " We";
      IF dn = Th THEN LPRINT " Th";
      IF dn = Fr THEN LPRINT " Fr";
      IF dn = Sa THEN LPRINT " Sa";
      IF dn = Su THEN LPRINT " Su";
    NEXT dn
    LPRINT "    ";
  NEXT i
  LPRINT
  FOR w = 1 TO 6       'print the dates 1st 2nd etc. in six lines.
    FOR i = 1 TO 3     '3 Months  across the page
      FOR d = 0 TO 6   '7 days of the week
        IF mat3(i, w, d) <= 0 THEN
           LPRINT "   ";    'print a blank (3 spaces)
        ELSE
          LPRINT USING "###"; mat3(i, w, d);  'print a date in field width
        END IF
       NEXT d   'day loop
        LPRINT "    ";          'print gap between Months
     NEXT i  'Month loop
    LPRINT
   NEXT w  'week loop
END SUB  'out3

       
'          -----  John P. Brown      J.P.Brown@bradford.ac.uk ----   
'          \    'Enjoy yourself, it's later than you think'    /
'           --------------------------------------------------