' +---------------------------------------------------+
    ' | Calendar by Antoni Gual 2005                      |
    ' | Runs in Qbasic and in FreeBASIC -lang qb          |
    ' +---------------------------------------------------+
    ' | The above 2 lines were comments of Antoni Gual    |
    ' | and were left intact as they appeared in his      |
    ' | Calendar.Bas. I choose to call it CalGual.Bas     |
    ' +---------------------------------------------------+
    ' |      -WARNING-     -WARNING-     -WARNING-        |
    ' | If you download just the .BAS files and use it    |
    ' | in the QB editor, you'll need to replace the      |
    ' | lines where Metapad.exe is used in a SHELL        |
    ' | statement, to "notepad.exe". Either that or       |
    ' | import Metapad.Exe into the same directory where  |
    ' | your QB .BAS files are.                           |
    ' |                                                   |
    ' | Metapad homepage:                                 |
    ' |        http://liquidninja.com/metapad/            |
    ' +---------------------------------------------------+
    ' | I downloaded Antoni's code from the QBasic Forum. |
    ' | I have added many changes:                        |
    ' |                                                   |
    ' | 1. It now opens in the current year, whereas      |
    ' |    before it requested the user to input a year.  |
    ' |                                                   |
    ' | 2. The program now has the ability to increase or |
    ' |    decrease years by pressing <=> or <=>.       |
    ' |                                                   |
    ' | 3. By pressng <Enter> the program prints the year |
    ' |    being viewed to the text file, YEARFILE.TXT,   |
    ' |    and subsequently puts it into Metapad.Exe.     |
    ' |                                                   |
    ' | 4. Another change is that Antoni had created a    |
    ' |    European style calendar, what we call a        |
    ' |    "business calendar, in which the week begins   |
    ' |    with Monday and ends with Sunday. His code =>  |
    ' |                                                   |
    ' |    PRINT " Mo Tu We Th Fr Sa Su"                  |
    ' |                                                   |
    ' |    I changed the code in order to have a regular  |
    ' |    American style calender such that =>           |
    ' |                                                   |
    ' |    PRINT " Su Mo Tu We Th Fr Sa"                  |
    ' |                                                   |
    ' |    Of course, there was the need to change        |
    ' |    Antoni's code to fit the newly configured      |
    ' |    week.                                          |
    ' |                                                   |
    ' | 5. Each month now has a box around it, in a very  |
    ' |    pleasing style.                                |
    ' +---------------------------------------------------+
    ' | A big thanks to Antoni Gual for his original      |
    ' | coding which made my modifications easy to do.    |
    ' |                                                   |
    ' |         Don Smith [MarineDon]                     |
    ' |         Email: smithdonb@earthlink.net            |
    ' |                                                   |
    ' +---------------------------------------------------+
    ' | To find out if the calendars are accurate, go to  |
    ' | this website and it will tell you on which day of |
    ' | the week that July 4, 1776, our Independence Day, |
    ' | fell on. You'll see that by both calendars, the   |
    ' | signing was on a Tuesday:                         |
    ' |                                                   +---------------------+
    ' | http://www.internetfamilyfun.com/holidays/fourthofjuly/4thjulyfacts.htm |
    ' +-------------------------------------------------------------------------+

    DEFINT A-Z
    DECLARE FUNCTION DayofWeek (Y, M, D)
    DECLARE FUNCTION daysinmonth (Y, M)
    DECLARE SUB printmonth (M, Y, R, C)
    DECLARE SUB printyear (Y, ULRow1, UlCol1)
    DECLARE SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%)
    DECLARE SUB TinyBox (ULRow, UlCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub)
    '===============================================================

    DIM Y, M, D
    WIDTH , 50
    IF Change = 0 THEN
        Y = VAL(RTRIM$(LTRIM$(MID$(DATE$, 7, 4))))
    END IF
begin:
    Change = 0
    COLOR 15, 1: CLS
    ULRow1 = 5
    UlCol1 = 3
    CALL printyear(Y, ULRow1, UlCol1)
    RESTORE monthstrings
    FOR i = 1 TO M
        READ ms$
    NEXT
    IF file = 1 THEN
        file = 0
        GOTO makefile
    END IF
    '============================================================
    '        Use SUB TinyBox to create the bottom box
    '==========================================================
    ULRow = 48
    UlCol = 5
    LRRow = 50
    LRCol = 75
    BoxFGColr = 15
    BoxBGColr = 4
    SingOrDoub = 2

    CALL TinyBox(ULRow, UlCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub)
    LOCATE 48, 27, 0: PRINT CHR$(209);
    LOCATE 49, 27, 0: PRINT CHR$(179);
    LOCATE 50, 27, 0: PRINT CHR$(207);

    LOCATE 48, 54, 0: PRINT CHR$(209);
    LOCATE 49, 54, 0: PRINT CHR$(179);
    LOCATE 50, 54, 0: PRINT CHR$(207);

    LOCATE 48, 41, 0: PRINT CHR$(209);
    LOCATE 49, 41, 0: PRINT CHR$(179);
    LOCATE 50, 41, 0: PRINT CHR$(207);

    LOCATE 49, 7, 0: PRINT "<=> Decrease Years";
    LOCATE 49, 28, 0: PRINT "<Enter> Print";
    LOCATE 49, 43, 0: PRINT "<Esc> Exit";
    LOCATE 49, 56, 0: PRINT "Increase Years <=>";
    COLOR 11, 4
    LOCATE 49, 8, 0: PRINT "=";
    LOCATE 49, 29, 0: PRINT "Enter";
    LOCATE 49, 44, 0: PRINT "Esc";
    LOCATE 49, 72, 0: PRINT "=";
   
    file = 0
    '===============================================================
    ' Here user chooses Right/Left Arrow to Increase/Decrease
    ' years or to print the calendar to file: YEARFILE.TXT
    '===============================================================
    Change = 0
    DO
        DO
            k$ = INKEY$
        LOOP UNTIL LEN(k$)
        k% = CVI(k$ + CHR$(0))
        SELECT CASE k%
            CASE 27            '............<Esc>
                COLOR 7, 0: CLS : END
            CASE 19200         '............<Left Arrow>
                Y = Y - 1
                Change = 1
                GOTO begin
            CASE 19712         '............<Right Arrow>
                Y = Y + 1
                Change = 1
                GOTO begin
            CASE 13            '............<Enter>
                file = 1
                GOTO begin
         END SELECT
     LOOP

makefile:
    IF file = 1 THEN
        '=========================================
        '  Make calendar again without bottom box
        '=========================================
        GOTO begin
    END IF

    OPEN "YearFile.Txt" FOR OUTPUT AS #2

    '=========================================
    '  Use SUB SaveRestScrn to save screen
    '  and the print it to "YEARFILE.TXT"
    '=========================================
    REDIM ReadLine$(50): REDIM ReadColr%(50, 80)
    CALL SaveRestScrn(ReadLine$(), ReadColr%(), 1, 1, 50, 80, 1)

    FOR abc% = 1 TO 50
        PRINT #2, ReadLine$(abc%)
    NEXT
    ERASE ReadLine$: ERASE ReadColr%
    CLOSE #2
    SHELL "metapad.exe" + " " + "YearFile.Txt"
    file = 0
    RUN "calgual"

monthstrings:
    DATA "January","February","March","April","May","June","July"
    DATA "August","September","October","November","December"

FUNCTION DayofWeek (Y, M, D)
    'calculates the day of week using Zeller's congruences
    'returns 0 for monday .... 6 for sunday
    DIM P, Q
    IF M > 2 THEN
        P = M - 3
        Q = Y
    ELSE
        P = M + 9
        Q = Y - 1
    END IF
    DayofWeek = (D + 2 + Q + Q \ 4 - Q \ 100 + Q \ 400 + CINT(2.6 * P)) MOD 7

 END FUNCTION

FUNCTION daysinmonth (Y, M)
    'get nr of days in a month of a year(check for leap year if february)
    SELECT CASE M
        CASE 2: daysinmonth = 28 - ((Y MOD 4 = 0) - (Y MOD 100 = 0) + (Y MOD 400 = 0))
        CASE 1, 3, 5, 7, 8, 10, 12: daysinmonth = 31
        CASE ELSE: daysinmonth = 30
    END SELECT
END FUNCTION

SUB printmonth (M, Y, R, C)
    COLOR 15, 1
    DIM i, j, sd, ld, a$, R$
    sd = DayofWeek(Y, M, 1)
    ld = daysinmonth(Y, M)
    j = 0
    READ R$
    LOCATE R + 1, C + 11 - (LEN(R$) \ 2)
    PRINT R$ + CHR$(13) + CHR$(10);
    LOCATE , C + 2
    PRINT "Su Mo Tu We Th Fr Sa"
    LOCATE , C + 1
    DO
        FOR i = 0 TO 6
            IF i = sd OR j > 0 THEN
                j = j + 1
            END IF
            IF j < 1 THEN
                PRINT " ";
                PRINT SPACE$(2);
                
            ELSE
                PRINT USING " ##"; j;
            END IF
            IF j = ld THEN
                EXIT SUB
            END IF
        NEXT
        'PRINT : LOCATE , C
        PRINT : LOCATE , C + 1
    LOOP

END SUB

SUB printyear (Y, ULRow1, UlCol1)
   
    DIM M, i, j
    M = 1
    COLOR 15, 1
    LOCATE , , 0
    LOCATE 1, 29
    PRINT CHR$(201) + STRING$(22, "Í") + CHR$(187)
    LOCATE 2, 29
    PRINT CHR$(186) + SPACE$(3) + "Calendar of" + STR$(Y) + SPACE$(3) + CHR$(186);
    LOCATE 3, 29
    PRINT CHR$(200) + STRING$(22, "Í") + CHR$(188);
    LOCATE 7, 1
    FOR i = 0 TO 3
        FOR j = 0 TO 2
            GOSUB makebox
            'CALL printmonth(M, Y, i * 9 + 4, j * 25 + 4)
            CALL printmonth(M, Y, i * 11 + 4, j * 25 + 4)
            M = M + 1
        NEXT
    NEXT
    EXIT SUB

makebox:
    IF M = 1 THEN
        BoxULRow = 4: BoxULCol = 4
    ELSEIF M = 2 THEN
        BoxULRow = 4: BoxULCol = 29
    ELSEIF M = 3 THEN
       BoxULRow = 4: BoxULCol = 54

    ELSEIF M = 4 THEN
        BoxULRow = 15: BoxULCol = 4
    ELSEIF M = 5 THEN
        BoxULRow = 15: BoxULCol = 29
    ELSEIF M = 6 THEN
        BoxULRow = 15: BoxULCol = 54

    ELSEIF M = 7 THEN
        BoxULRow = 26: BoxULCol = 4
    ELSEIF M = 8 THEN
        BoxULRow = 26: BoxULCol = 29
    ELSEIF M = 9 THEN
        BoxULRow = 26: BoxULCol = 54

    ELSEIF M = 10 THEN
        BoxULRow = 37: BoxULCol = 4
    ELSEIF M = 11 THEN
        BoxULRow = 37: BoxULCol = 29
    ELSEIF M = 12 THEN
        BoxULRow = 37: BoxULCol = 54
    END IF

    COLOR 15, 1
    LOCATE BoxULRow, BoxULCol, 0
    PRINT "É" + STRING$(22, "Í") + "»";
    LOCATE BoxULRow + 1, BoxULCol, 0
    PRINT "º" + STRING$(22, " ") + "º";
    LOCATE BoxULRow + 2, BoxULCol, 0
    PRINT "Ì" + STRING$(22, "Í") + "¹";
    FOR PrintSides = BoxULRow + 3 TO BoxULRow + 9
        LOCATE PrintSides, BoxULCol, 0
        PRINT "º" + SPACE$(22) + "º";
    NEXT
    LOCATE BoxULRow + 10, BoxULCol, 0
    PRINT "È" + STRING$(22, "Í") + "¼";
    RETURN
    END SUB

SUB SaveRestScrn (ReadLine$(), ReadColr%(), SR.UL.Row%, SR.UL.Col%, SR.LR.Row%, SR.LR.Col%, SaveOrRest%)

    '+----------------------------------------------------------------------+
    '| SUB written by Don Smith on 02/20/02 - Public Domain FreeWare.       |
    '| No need to name Don as the author.   EMail: smithdonb@earthlink.net  |
    '+----------------------------------------------------------------------+

    '+----------------------------------------------------------------------+
    '|                    PROGRAM SETS NUMBERS 1 AND 2 ->                   |
    '+------------------+---------------------------------------------------+
    '| (1) ReadLine$()  |   Program self reads data at each Row and Column  |
    '+------------------+---------------------------------------------------+
    '| (2) ReadColr%()  |   Program self reads color at each Row and Column |
    '+------------------+---------------------------------------------------+

    '+----------------------------------------------------------------------+
    '|            THE PROGRAMMER MUST SET NUMBERS 3 TO 9 ->                 |
    '+----------------------------------------------------------------------+
    '|       (Note: The "SR" below means "Save" Or "Restore")               |
    '+------------------+---------------------------------------------------+
    '| (3) SR.UL.Row%   |   Screen to save or restore at upper left row.    |
    '| (4) SR.UL.Col%   |   Screen to save or restore at upper left column. |
    '| (5) SR.LR.Row%   |   Screen to save or restore at lower right row.   |
    '| (6) SR.LR.Col%   |   Screen to save or restore at lower right column.|
    '|                  +---------------------------------------------------+
    '|                  |   SPECIAL CAUTION:                                |
    '|                  |   ---------------                                 |
    '|                  |   When you call the SUB to restore the underlying |
    '|                  |   screen, use MUST use the same row and column    |
    '|                  |   numbers as you used when you first called the   |
    '|                  |   SUB to save the screen.                         |
    '+------------------+---------------------------------------------------+
    '| (7) SaveOrRest%  |   SaveOrRest% = 1 (1 means save the screen)       |
    '|                  |   SaveOrRest% = 2 (2 means restore the screen)    |
    '+------------------+----------+----------------------------------------+
    '| (8) REDIM ReadLine$(25)     | The REDIM for ReadLine$ and ReadColr%  |
    '|     REDIM ReadColr%(25, 80) | must be placed in the main program     |
    '|                             | before calling the SUB.  The 25 and 80 |
    '|                             | reflects a screen of 25 lines and 80   |
    '|                             | columns.  You may use smaller amounts  |
    '|                             | of memory if you do not need all 25    |
    '|                             | lines and 80 columns.                  |
    '+-----------------------------+----------------------------------------+
    '| (9) ERASE ReadLine$         | Reclaim memory after calling the SUB   |
    '|     ERASE ReadColr%         | to restore the screen.  Use REDIM and  |
    '|                             | ERASE in main program please!          |
    '+-----------------------------+----------------------------------------+

    IF SR.LR.Col% > 80 THEN
          SR.LR.Col% = 80
    END IF
    'IF SR.LR.Row% > 25 THEN
    '      SR.LR.Row% = 25
    'END IF

    IF SaveOrRest% = 1 THEN
          GOSUB save.screen
    ELSEIF SaveOrRest% = 2 THEN
          GOSUB restore.screen
    END IF
    EXIT SUB

save.screen:
    FOR ViewIt% = SR.UL.Row% TO SR.LR.Row%
          FOR Horizon% = SR.UL.Col% TO SR.LR.Col%
              ReadLine$(ViewIt%) = ReadLine$(ViewIt%) + CHR$(SCREEN(ViewIt%, Horizon%))
              ReadColr%(ViewIt%, Horizon%) = SCREEN(ViewIt%, Horizon%, 1)
          NEXT
    NEXT
    RETURN
restore.screen:
    FOR FindRow% = SR.UL.Row% TO SR.LR.Row%
          FOR ScrnCol% = SR.UL.Col% TO SR.LR.Col%
              LOCATE FindRow%, ScrnCol%, 0
              OneColr% = ReadColr%(FindRow%, ScrnCol%)
              FGScrnColr% = OneColr% MOD 16
              BGScrnColr% = OneColr% \ 16
              COLOR FGScrnColr%, BGScrnColr%
              PRINT MID$(ReadLine$(FindRow%), ScrnCol% - (SR.UL.Col% - 1));
          NEXT
    NEXT
    RETURN
END SUB

SUB TinyBox (ULRow, UlCol, LRRow, LRCol, BoxFGColr, BoxBGColr, SingOrDoub)

    ' +----------------------------------------------------------------------+
    ' |                          SUB TinyBox                                 |
    ' +----------------------------------------------------------------------+
    ' |  ULRow = Upper Left Row.  ULCol = Upper Left Column.                 |
    ' |  LRRow = Lower Right Row. LRCol = Lower Right Column.                |
    ' |  BoxFGColr = The Foreground Color The Box.                           |
    ' |  BoxBGColr = The Back Ground Color Of The Box.                       |
    ' |  SingOrDoub = 1 (Single Line Box). SingOrDoub = 2 (Double Line Box). |
    ' +----------------------------------------------------------------------+

    COLOR BoxFGColr, BoxBGColr
    IF SingOrDoub = 1 THEN
        LOCATE ULRow, UlCol
        PRINT CHR$(218) + STRING$(LRCol - UlCol, CHR$(196)) + CHR$(191);
        FOR BoxY = ULRow + 1 TO LRRow - 1
            LOCATE BoxY, UlCol
            PRINT CHR$(179) + STRING$(LRCol - UlCol, " ") + CHR$(179);
        NEXT
        LOCATE LRRow, UlCol
        PRINT CHR$(192) + STRING$(LRCol - UlCol, CHR$(196)) + CHR$(217);
    ELSEIF SingOrDoub = 2 THEN
        LOCATE ULRow, UlCol
        PRINT CHR$(201) + STRING$(LRCol - UlCol, CHR$(205)) + CHR$(187);
        FOR BoxY = ULRow + 1 TO LRRow - 1
            LOCATE BoxY, UlCol
            PRINT CHR$(186) + STRING$(LRCol - UlCol, " ") + CHR$(186);
        NEXT
        LOCATE LRRow, UlCol
        PRINT CHR$(200) + STRING$(LRCol - UlCol, CHR$(205)) + CHR$(188);
    END IF
END SUB