' CALEND00.BAS (originally CALENDAR.BAS)
' Copyright (C) 1993 DOS Resource Guide
' Published in Issue #8, March 1993, page 47
'
' PERPETUAL CALENDAR PROGRAM
'
' modified 08/23/96 by kwmelvin@nr.infi.net
' to print to a file instead of a printer.
' This program also runs in QBasic 1.1.

Setup:
	CLS
	CLEAR
	DIM Year(12, 6, 7), Month$(12), Month(12), Day$(7)
	FOR X = 1 TO 12
		FOR Y = 0 TO 6
			FOR Z = 0 TO 7
				Year(X, Y, Z) = 0
			NEXT Z
		NEXT Y
	NEXT X

GetYear:
	CLS
	PRINT TAB(30); "Calendar Creator"
	PRINT
	PRINT TAB(20); "By Antonio and Alfonso De Pasquale"
	PRINT
	INPUT "What is the calendar year you want"; Year$
	YR = VAL(Year$)

	IF YR < 1753 THEN
		PRINT
		PRINT "Year must be greater than 1752.  ";
		INPUT "Press <Enter> to try again"; A$
		GOTO GetYear
	END IF

	PRINT
	PRINT "Calculating dates...please wait"
	PRINT

CalcYear:
	C = INT(YR / 100)
	IF RIGHT$(STR$(YR), 2) = "00" THEN C = C - 1
	D = (YR - (100 * C)) - 1
	IF D = -1 THEN D = 99
	K = 1
	M = 11
	X = (INT(2.6 * M - .2) + K + D + INT(D / 4) + INT(C / 4) - (2 * C)) / 7
	G = ABS(X - INT(X))
	F = INT(7 * G + .00001) + 1

	IF (YR / 4) = INT(YR / 4) AND RIGHT$(Year$, 2) <> "00" THEN
		LY = 1
		GOTO FillYear
	END IF

	IF (YR / 400) = INT(YR / 400) AND RIGHT$(Year$, 2) = "00" THEN
		LY = 1
		GOTO FillYear
	END IF

	LY = 0

FillYear:
	FOR X = 1 TO 7
		READ Day$(X)
	NEXT X
	FOR X = 1 TO 12
		READ Month$(X)
	NEXT X
	FOR X = 1 TO 12
		READ Month(X)
	NEXT X
	IF LY = 1 THEN Month(2) = 29

	FOR X = 1 TO 12
		R = 1
		FOR G = 1 TO Month(X)
			Year(X, R, F) = G
			F = F + 1
			IF F = 8 THEN F = 1: R = R + 1
		NEXT G
	NEXT X
	DATA S,M,T,W,T,F,S
	DATA JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY
	DATA AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER
	DATA 31,28,31,30,31,30,31,31,30,31,30,31

BuildCalendar:
	OPEN "calendar.txt" FOR OUTPUT AS #1
	PRINT #1,
	PRINT #1,
	PRINT #1, SPACE$(36);
	FOR X = 1 TO 5
	PRINT #1, MID$(Year$, X, 1); " ";
	NEXT X
	PRINT #1,
	PRINT #1,
	FOR I = 1 TO 12 STEP 2
		GOSUB PrintStars
		GOSUB PrintMonth
		GOSUB PrintWeek
		FOR Week = 1 TO 6
		PRINT #1, SPACE$(7);
		PRINT #1, "* ";
			FOR X = 1 TO 7
				SELECT CASE Year(I, Week, X)
			CASE = 0
			PRINT #1, SPACE$(4);
			CASE < 10
						SPV = 1
			PRINT #1, SPACE$(SPV); Year(I, Week, X);
			CASE > 9
						SPV = 0
			PRINT #1, SPACE$(SPV); Year(I, Week, X);
				END SELECT
			NEXT X
		PRINT #1, SPACE$(2); "* ";
			FOR X = 1 TO 7
				SELECT CASE Year(I + 1, Week, X)
			CASE = 0
			PRINT #1, SPACE$(4);
			CASE < 10
						SPV = 1
			PRINT #1, SPACE$(SPV); Year(I + 1, Week, X);
			CASE > 9
						SPV = 0
			PRINT #1, SPACE$(SPV); Year(I + 1, Week, X);
				END SELECT
			NEXT X
		PRINT #1, SPACE$(2); "*"
		NEXT Week
	NEXT I
	GOSUB PrintStars
	PRINT #1, CHR$(12)
	PRINT "Calendar has been printed to CALENDAR.TXT."
	END

PrintStars:
	PRINT #1, SPACE$(7);
	FOR A = 1 TO 65
	PRINT #1, "*";
	NEXT A
	PRINT #1,
	RETURN

PrintMonth:
	FOR B = 1 TO 12 STEP 2
		IF B = I THEN
			GOSUB FindMonth
		END IF
	NEXT B
	RETURN

PrintWeek:
	PRINT #1, SPACE$(7);
	PRINT #1, "*"; SPACE$(3);
	FOR D = 1 TO 2
		FOR D1 = 1 TO 7
		PRINT #1, Day$(D1); SPACE$(3);
		NEXT D1
	PRINT #1, "*"; SPACE$(3);
	NEXT D
	PRINT #1,
	RETURN

FindMonth:
	T1 = LEN(Month$(B))
	T2 = LEN(Month$(B + 1))
	T3 = INT((33 - T1) / 2)
	T4 = INT((33 - T2) / 2)
	PRINT #1, SPACE$(7); "*";
	PRINT #1, SPACE$(T3); Month$(B);
	RT = 33 - T3 - T1
	PRINT #1, SPACE$(RT - 2); "*";
	PRINT #1, SPACE$(T4); Month$(B + 1);
	RT = 33 - T4 - T2
	PRINT #1, SPACE$(RT - 2); "*";
	PRINT #1,
	RETURN

'end of calend00.bas