' Calendar
' By, Richard Copeland -- 1996
' V. 1.01

' Sub & Function (2) total
DECLARE SUB Details ()
DECLARE FUNCTION GetKey! ()

CONST PgUp = -&H49
CONST PgDn = -&H51
CONST ESC = 27

  CLS
ON ERROR GOTO 1000
LOCATE 1, 1
PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
PRINT "³                    P R O G R A M   M A N A G E R                    <ESC>³"
PRINT "³                  C  A  L  E  N  D  A  R  (V. 1.01)                       ³"
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
PRINT "³                          ENTER SCREEN TYPE                               ³"
PRINT "³**************************************************************************³"
PRINT "³(1) MDPA                                                                  ³"
PRINT "³(2) CGA                                                                   ³"
PRINT "³(3) HERCULES   (MUST HAVE MSHERC.COM DRIVER LOADED)                       ³"
PRINT "³(4) OLIVETTI                                                              ³"
PRINT "³(5) EGA                                                                   ³"
PRINT "³(6) VGA OR SVGA                                                           ³"
PRINT "³(7) MCGA                                                                  ³"
PRINT "³(8) AT&T 6300                                                             ³"
PRINT "³(9) EGA OR VGA MONOCROME                                                  ³"
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

DO
SELECT CASE INKEY$
  CASE "1"
    SCREEN 0: GOTO SetUp
  CASE "2"
    SCREEN 2: GOTO SetUp
  CASE "3"
    SCREEN 3: GOTO SetUp
  CASE "4"
    SCREEN 3: GOTO SetUp
  CASE "5"
    SCREEN 8: GOTO SetUp
  CASE "6"
    SCREEN 11: GOTO SetUp
  CASE "7"
    SCREEN 11: GOTO SetUp
  CASE "8"
    SCREEN 4: GOTO SetUp
  CASE "9"
    SCREEN 10: GOTO SetUp
CASE CHR$(27)
    CLS : PRINT "Please Wait..."
    CHAIN "MoneyCga"
CASE ELSE
  END SELECT
LOOP
ON ERROR GOTO 0

SetUp:
    CLS
PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
PRINT "³                    P R O G R A M   M A N A G E R                    <ESC>³"
PRINT "³                  C  A  L  E  N  D  A  R  (V. 1.01)                       ³"
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
PRINT "³                   Please Wait -- (I'm Thinking...)                       ³"
PRINT "³**************************************************************************³"
PRINT "³                                                                          ³"
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
    CLEAR
    DIM Year(12, 12, 7), Month$(12), Month(12), Day$(7)
    FOR x = 1 TO 12
    IF INKEY$ = CHR$(27) THEN CLS : PRINT "Please Wait...": CHAIN "MoneyCga" ELSE
        A% = A% + 1
        FOR Y = 0 TO 12
            FOR Z = 0 TO 7
                Year(x, Y, Z) = 0
            LOCATE 8, 3 + A%: PRINT STRING$(20, CHR$(219))
            NEXT Z
         LOCATE 8, 3 + 20 + A%: PRINT STRING$(20, CHR$(219))
         NEXT Y
      LOCATE 8, 3 + 40 + A%: PRINT STRING$(20, CHR$(219))
      NEXT x
     
GetYear:
    CLS
PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
PRINT "³                    P R O G R A M   M A N A G E R                         ³"
PRINT "³                  C  A  L  E  N  D  A  R  (V. 1.01)                       ³"
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
PRINT "³ ENTER CALENDAR YEAR->                                                    ³"
PRINT "³**************************************************************************³"
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
    LOCATE 6, 24
    INPUT "", Year$
    YR = VAL(Year$)
   
    IF YR < 1753 THEN
CLS
PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
PRINT "³                   Year must be greater than 1752                         ³"
PRINT "³                   PRESS (any key) TO CONTINUE...                         ³"
PRINT "³**************************************************************************³"
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
        DO: LOOP UNTIL INKEY$ <> ""
        GOTO GetYear
    END IF
CLS
PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
PRINT "³                        Calculating dates...                              ³"
PRINT "³                            please wait                                   ³"
PRINT "³**************************************************************************³"
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:
    CLS
    PRINT
    PRINT
    PRINT SPACE$(36);
    FOR x = 1 TO 5
        PRINT MID$(Year$, x, 1); " ";
    NEXT x
    PRINT
    PRINT
   FOR I = 1 TO 12 STEP 2
        GOSUB PrintStars
        GOSUB PrintMonth
        GOSUB PrintWeek
        FOR Week = 1 TO 7
            PRINT SPACE$(7);
            PRINT "³ ";
            FOR x = 1 TO 7
                SELECT CASE Year(I, Week, x)
                    CASE IS = 0
                        PRINT SPACE$(4);
                    CASE IS < 10
                        SPV = 1
                        PRINT SPACE$(SPV); Year(I, Week, x);
                    CASE IS > 9
                        SPV = 0
                        PRINT SPACE$(SPV); Year(I, Week, x);
                END SELECT
            NEXT x
            PRINT SPACE$(2); "³ ";
            FOR x = 1 TO 7
                SELECT CASE Year(I + 1, Week, x)
                    CASE IS = 0
                        PRINT SPACE$(4);
                    CASE IS < 10
                        SPV = 1
                        PRINT SPACE$(SPV); Year(I + 1, Week, x);
                    CASE IS > 9
                        SPV = 0
                        PRINT SPACE$(SPV); Year(I + 1, Week, x);
                END SELECT
            NEXT x
            PRINT SPACE$(2); "³"
        NEXT Week
    NEXT I
    GOSUB PrintStars
    DO
    LOOP UNTIL INKEY$ <> ""
     GOTO SetUp
PrintStars:
    PRINT SPACE$(7);
    FOR A = 1 TO 65
        PRINT "Ä";
    NEXT A
    PRINT
    RETURN

PrintMonth:
    FOR B = 1 TO 12 STEP 2
        IF B = I THEN
            GOSUB FindMonth
        END IF
    NEXT B
     DO
    SELECT CASE GetKey
    CASE ESC
       CLS
       PRINT "Please Wait..."
       CHAIN "MoneyCga"
    CASE PgUp
      CALL Details
    CASE PgDn
      RETURN
    CASE ELSE
      END SELECT
    LOOP

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

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

1000
CLS : PRINT "ERROR - Screen Mode not suported"
DO
FOR x = 1 TO 4000
NEXT x
IF x = 6000 THEN CLS : PRINT "Please Wait...": CHAIN "MoneyCga"
LOOP UNTIL INKEY$ <> ""
CLS
PRINT "Loading Program Manager"
PRINT "***Please Wait...***": CHAIN "MoneyCga"

SUB Details
CLS
PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
PRINT "³                    P R O G R A M   M A N A G E R                    <ESC>³"
PRINT "³                  C  A  L  E  N  D  A  R  (V. 1.01)                       ³"
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
PRINT "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿"
PRINT "³                                                                          ³"
PRINT "³                                                                          ³"
PRINT "³                                                                          ³"
PRINT "³                                                                          ³"
PRINT "³                                                                          ³"
PRINT "³                                                                          ³"
PRINT "³                                                                          ³"
PRINT "³                                                                          ³"
PRINT "³                                                                          ³"
PRINT "³                                                                          ³"
PRINT "³                                                                          ³"
PRINT "³                                                                          ³"
PRINT "³                                                                          ³"
PRINT "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"

SELECT CASE GetKey
 CASE ESC
   CLS : PRINT "PgDn-For More Calendar"
   EXIT SUB
 CASE ELSE
END SELECT
END SUB

FUNCTION GetKey
DO
     Ch$ = INKEY$
  LOOP UNTIL LEN(Ch$) > 0
  IF LEN(Ch$) = 1 THEN
     GetKey = ASC(UCASE$(Ch$))
  ELSE
     GetKey = -1 * ASC(RIGHT$(Ch$, 1))
  END IF
END FUNCTION