'===========================================================================
' Subject: CALCULATE DAY OF WEEK             Date: 04-21-96 (16:23)       
' Author:  Steve M. Wiegand                  Code: QB, QBasic, PDS        
' Origin:  stevewie@ksc9.th.com            Packet: DATETIME.ABC
'===========================================================================
'This program will calculate a day of the week for any year from 1753 to 2030

DEFINT A-Z
DECLARE SUB TRANSLATE ()
DECLARE SUB LETTERS ()
DECLARE SUB LAYER1 ()
DECLARE SUB NORMAL1 ()
DECLARE SUB NORMAL0 ()
DECLARE SUB Initialize ()
DECLARE SUB FancyCls (dots%, Background%)
DECLARE SUB Center (Row%, text$)
DECLARE SUB OPENINTRO ()
DECLARE SUB Box (Row1%, Col1%, Row2%, Col2%)
DECLARE SUB PAUSE ()
DECLARE SUB DAYERROR ()
DECLARE SUB inputerror ()
DECLARE FUNCTION GetNum# (Row%, Col%)
CONST TRUE = -1
CONST FLASE = NOT TRUE
CONST BYEAR = 1753
COMMON SHARED P$(), P$, SIZE$
COMMON SHARED C1$, C2$, C3$
COMMON SHARED C4$, BGC, DOT$
COMMON SHARED SPACING$, Word$
COMMON SHARED PFT, PFL
COMMON SHARED m, d, y, nt%
DIM P$(122)
DIM SHARED Colorpref
DIM SHARED Colors(0 TO 20, 1 TO 4)
DIM SHARED year%(278)
DIM SHARED M1%(12), M2%(12), M3%(12), M4%(12), M5%(12), M6%(12), M7%(12)
DIM SHARED M8%(12), M9%(12), M10%(12), M11%(12), M12%(12), M13%(12), M14%(12)
DIM SHARED d1%(31), d2%(31), d3%(31), d4%(31), d5%(31), d6%(31), d7%(31)
DIM SHARED dn$(7)
DIM SHARED mn$(12): DIM SHARED mnu%(12)
CALL LETTERS                                'CALL LETTERSET
'
' Begin Mainline Code
'
Initialize
OPENINTRO
BEGIN:
Colorpref = 1
FancyCls Colors(2, Colorpref), Colors(1, Colorpref)
Box 9, 19, 15, 61
COLOR 7, 0
Center 11, "Enter the Century and Year (CCYY)"
nt% = 1
y = GetNum#(13, 38)
FancyCls Colors(2, Colorpref), Colors(1, Colorpref)
Box 9, 19, 15, 61
COLOR 7, 0
Center 11, "Enter the Month of the Year (01-12)"
nt% = 2
m = GetNum#(13, 39)
FancyCls Colors(2, Colorpref), Colors(1, Colorpref)
Box 9, 19, 15, 61
COLOR 7, 0
Center 11, "Enter the Day of the Month (01-31)"
nt% = 3
d = GetNum#(13, 39)
DATEEDIT:
IF m = 2 THEN
   z% = y MOD 4
   IF z% = 0 THEN
       mnu%(2) = 29
   END IF
END IF
IF d > mnu%(m) THEN
    CALL DAYERROR
    CALL PAUSE
    GOTO doagain
END IF
INDEX1 = (y - BYEAR) + 1
INDEX2 = year%(INDEX1)
SELECT CASE INDEX2
    CASE IS = 1
        index3 = M1%(m)
    CASE IS = 2
        index3 = M2%(m)
    CASE IS = 3
        index3 = M3%(m)
    CASE IS = 4
        index3 = M4%(m)
    CASE IS = 5
        index3 = M5%(m)
    CASE IS = 6
        index3 = M6%(m)
    CASE IS = 7
        index3 = M7%(m)
    CASE IS = 8
        index3 = M8%(m)
    CASE IS = 9
        index3 = M9%(m)
    CASE IS = 10
        index3 = M10%(m)
    CASE IS = 11
        index3 = M11%(m)
    CASE IS = 12
        index3 = M12%(m)
    CASE IS = 13
        index3 = M13%(m)
    CASE IS = 14
        index3 = M14%(m)
END SELECT
SELECT CASE index3
    CASE IS = 1
        bd% = d1%(d)
    CASE IS = 2
        bd% = d2%(d)
    CASE IS = 3
        bd% = d3%(d)
    CASE IS = 4
        bd% = d4%(d)
    CASE IS = 5
        bd% = d5%(d)
    CASE IS = 6
        bd% = d6%(d)
    CASE IS = 7
        bd% = d7%(d)
END SELECT
FancyCls Colors(2, Colorpref), Colors(1, Colorpref)
Box 9, 19, 15, 61
COLOR 7, 0
IF bd% > 7 OR bd% < 0 THEN
   LOCATE 10, 20, 0
   PRINT "Calculation Error - bd%"
   LOCATE 11, 41, 0
   PRINT bd%
   GOTO finish
END IF
z1$ = mn$(m): z2$ = STR$(d): z3$ = STR$(y): z4$ = z1$ + " " + z2$ + z3$
A$ = "The date entered is a " + dn$(bd%)
Center 10, z4$
Center 12, A$
A$ = ""
PAUSE
doagain:
FancyCls Colors(2, Colorpref), Colors(1, Colorpref)
Box 9, 19, 15, 61
COLOR 7, 0
Center 12, "Do another date ? [Y/N]"
LOCATE 14, 40, 1
WHILE INKEY$ <> "": WEND
DO
   kbd$ = UCASE$(INKEY$)
LOOP UNTIL kbd$ = "Y" OR kbd$ = "N"
IF kbd$ = "Y" THEN
   mnu%(2) = 28
   GOTO BEGIN
END IF
CLS
SYSTEM
finish:
END

'The following data defines the color schemes available via the main menu.
'
'    scrn  dots  bar  back   title  shdow  choice  curs   cursbk  shdow
DATA 0,    7,    15,  7,     0,     7,     0,      15,    0,      0
DATA 1,    9,    12,  3,     0,     1,     15,     0,     7,      0
DATA 3,    15,   13,  1,     14,    3,     15,     0,     7,      0
DATA 7,    12,   15,  4,     14,    0,     15,     15,    1,      0

'Box:
'  Draw a box on the screen between the given coordinates.
SUB Box (Row1, Col1, Row2, Col2) STATIC
    COLOR 14, 0
    BoxWidth = Col2 - Col1 + 1

    LOCATE Row1, Col1
    PRINT "Ú"; STRING$(BoxWidth - 2, "Ä"); "¿";

    FOR A = Row1 + 1 TO Row2 - 1
        LOCATE A, Col1
        PRINT "³"; SPACE$(BoxWidth - 2); "³";
    NEXT A

    LOCATE Row2, Col1
    PRINT "À"; STRING$(BoxWidth - 2, "Ä"); "Ù";

END SUB

DEFSNG A-Z
'Center:
'  Center text on the given row.
SUB Center (Row%, text$)
DEFINT A-Z
    LOCATE Row, 41 - LEN(text$) / 2
    PRINT text$;
END SUB

SUB DAYERROR
z1$ = STR$(m)
z2$ = STR$(d)
z3$ = STR$(y)
LINE (158, 235)-(390, 249), 7, B
LINE (159, 236)-(389, 248), 15, BF
Word$ = "              " + z1$ + "/" + z2$ + "/" + z3$
SPACING$ = "R0"
SIZE$ = " 4"
DOT$ = "N"
BGC = 15
CALL TRANSLATE
C1$ = "C 4"
C2$ = "C12"
PFT = 245: PFL = 163: CALL NORMAL1
LINE (158, 262)-(390, 274), 7, B
LINE (159, 263)-(389, 273), 15, BF
Word$ = "The day of the month is invalid"
SPACING$ = "R0"
SIZE$ = " 4"
DOT$ = "N"
BGC = 15
CALL TRANSLATE
C1$ = "C 4"
C2$ = "C12"
PFT = 272: PFL = 163: CALL NORMAL1
LINE (158, 279)-(415, 291), 7, B
LINE (159, 280)-(414, 290), 15, BF
x$ = STR$(mnu%(m))
Word$ = "The month you selected has " + x$ + " days"
SPACING$ = "R0"
SIZE$ = " 4"
DOT$ = "N"
BGC = 15
CALL TRANSLATE
C1$ = "C 4"
C2$ = "C12"
PFT = 289: PFL = 163: CALL NORMAL1
LEAPYRERROR:
IF m < 2 OR m > 2 THEN
        GOTO exitsub
END IF
IF d > 29 THEN
        GOTO exitsub
END IF
LINE (158, 296)-(415, 308), 7, B
LINE (159, 297)-(414, 307), 15, BF
Word$ = "The year is not a leap year"
SPACING$ = "R0"
SIZE$ = " 4"
DOT$ = "N"
BGC = 15
CALL TRANSLATE
C1$ = "C 4"
C2$ = "C12"
PFT = 306: PFL = 163: CALL NORMAL1

exitsub:
END SUB

DEFSNG A-Z
'FancyCls:
'  Clears screen in the right color, and draws nice dots.
SUB FancyCls (dots%, Background%)
DEFINT A-Z
    VIEW PRINT 7 TO 25
    COLOR dots, Background
    CLS 2

    FOR A = 560 TO 1820 STEP 45
        Row = A / 80 + 1
        Col = A MOD 80 + 1
        LOCATE Row, Col
        PRINT CHR$(250);
    NEXT A
END SUB

'GetNum:
'  Gets valid numeric input from user
'Parameters:
'  Row, Col - location to echo input
FUNCTION GetNum# (Row, Col)
  result$ = ""
  Done = FALSE
  WHILE INKEY$ <> "": WEND   'Clear keyboard buffer

  DO WHILE NOT Done

    LOCATE Row, Col
    PRINT result$; CHR$(95); "    ";
    
    kbd$ = INKEY$
    SELECT CASE kbd$
      CASE "0" TO "9"
        result$ = result$ + kbd$
      CASE "."
        IF INSTR(result$, ".") = 0 THEN
          result$ = result$ + kbd$
        END IF
      CASE CHR$(13)
        IF (VAL(result$) > 2030 OR VAL(result$) < 1753) AND nt% = 1 THEN
          result$ = ""
            CALL inputerror
        ELSE
        IF (VAL(result$) > 12 OR VAL(result$) < 1) AND nt% = 2 THEN
          result$ = ""
          CALL inputerror
        ELSE
        IF (VAL(result$) > 31 OR VAL(result$) < 1) AND nt% = 3 THEN
          result$ = ""
          CALL inputerror
        ELSE
          Done = TRUE
        END IF
         END IF
          END IF
       
      CASE CHR$(8)
        IF LEN(result$) > 0 THEN
          result$ = LEFT$(result$, LEN(result$) - 1)
        END IF
      CASE ELSE
        IF LEN(kbd$) > 0 THEN
          BEEP
        END IF
      END SELECT
  LOOP

  LOCATE Row, Col
  PRINT result$; " ";

  GetNum# = VAL(result$)
'
END FUNCTION

'Initialize:
'  Read colors in and set up assembly routines
SUB Initialize
year%(1) = 1: year%(2) = 2: year%(3) = 3: year%(4) = 11: year%(5) = 6: year%(6) = 7
year%(7) = 1: year%(8) = 9: year%(9) = 4: year%(10) = 5: year%(11) = 6: year%(12) = 14
year%(13) = 2: year%(14) = 3: year%(15) = 4: year%(16) = 12: year%(17) = 7: year%(18) = 1
year%(19) = 2: year%(20) = 10: year%(21) = 5: year%(22) = 6: year%(23) = 7: year%(24) = 8
year%(25) = 3: year%(26) = 4: year%(27) = 5: year%(28) = 13: year%(29) = 1: year%(30) = 2
year%(31) = 3: year%(32) = 11: year%(33) = 6: year%(34) = 7: year%(35) = 1: year%(36) = 9
year%(37) = 4: year%(38) = 5: year%(39) = 6: year%(40) = 14: year%(41) = 2: year%(42) = 3
year%(43) = 4: year%(44) = 12: year%(45) = 7: year%(46) = 1: year%(47) = 2: year%(48) = 3
year%(49) = 4: year%(50) = 5: year%(51) = 6: year%(52) = 14: year%(53) = 2: year%(54) = 3
year%(55) = 4: year%(56) = 12: year%(57) = 7: year%(58) = 1: year%(59) = 2: year%(60) = 10
year%(61) = 5: year%(62) = 6: year%(63) = 7: year%(64) = 8: year%(65) = 3: year%(66) = 4
year%(67) = 5: year%(68) = 13: year%(69) = 1: year%(70) = 2: year%(71) = 3: year%(72) = 11
year%(73) = 6: year%(74) = 7: year%(75) = 1: year%(76) = 9: year%(77) = 4: year%(78) = 5
year%(79) = 6: year%(80) = 14: year%(81) = 2: year%(82) = 3: year%(83) = 4: year%(84) = 12
year%(85) = 7: year%(86) = 1: year%(87) = 2: year%(88) = 10: year%(89) = 5: year%(90) = 6
year%(91) = 7: year%(92) = 8: year%(93) = 3: year%(94) = 4: year%(95) = 5: year%(96) = 13
year%(97) = 1: year%(98) = 2: year%(99) = 3: year%(100) = 11: year%(101) = 6: year%(102) = 7
year%(103) = 1: year%(104) = 9: year%(105) = 4: year%(106) = 5: year%(107) = 6: year%(108) = 14
year%(109) = 2: year%(110) = 3: year%(111) = 4: year%(112) = 12: year%(113) = 7: year%(114) = 1
year%(115) = 2: year%(116) = 10: year%(117) = 5: year%(118) = 6: year%(119) = 7: year%(120) = 8
year%(121) = 3: year%(122) = 4: year%(123) = 5: year%(124) = 13: year%(125) = 1: year%(126) = 2
year%(127) = 3: year%(128) = 11: year%(129) = 6: year%(130) = 7: year%(131) = 1: year%(132) = 9
year%(133) = 4: year%(134) = 5: year%(135) = 6: year%(136) = 14: year%(137) = 2: year%(138) = 3
year%(139) = 4: year%(140) = 12: year%(141) = 7: year%(142) = 1: year%(143) = 2: year%(144) = 10
year%(145) = 5: year%(146) = 6: year%(147) = 7: year%(148) = 1: year%(149) = 2: year%(150) = 3
year%(151) = 4: year%(152) = 12: year%(153) = 7: year%(154) = 1: year%(155) = 2: year%(156) = 10
year%(157) = 5: year%(158) = 6: year%(159) = 7: year%(160) = 8: year%(161) = 3: year%(162) = 4
year%(163) = 5: year%(164) = 13: year%(165) = 1: year%(166) = 2: year%(167) = 3: year%(168) = 11
year%(169) = 6: year%(170) = 7: year%(171) = 1: year%(172) = 9: year%(173) = 4: year%(174) = 5
year%(175) = 6: year%(176) = 14: year%(177) = 2: year%(178) = 3: year%(179) = 4: year%(180) = 12
year%(181) = 7: year%(182) = 1: year%(183) = 2: year%(184) = 10: year%(185) = 5: year%(186) = 6
year%(187) = 7: year%(188) = 8: year%(189) = 3: year%(190) = 4: year%(191) = 5: year%(192) = 13
year%(193) = 1: year%(194) = 2: year%(195) = 3: year%(196) = 11: year%(197) = 6: year%(198) = 7
year%(199) = 1: year%(200) = 9: year%(201) = 4: year%(202) = 5: year%(203) = 6: year%(204) = 14
year%(205) = 2: year%(206) = 3: year%(207) = 4: year%(208) = 12: year%(209) = 7: year%(210) = 1
year%(211) = 2: year%(212) = 10: year%(213) = 5: year%(214) = 6: year%(215) = 7: year%(216) = 8
year%(217) = 3: year%(218) = 4: year%(219) = 5: year%(220) = 13: year%(221) = 1: year%(222) = 2
year%(223) = 3: year%(224) = 11: year%(225) = 6: year%(226) = 7: year%(227) = 1: year%(228) = 9
year%(229) = 4: year%(230) = 5: year%(231) = 6: year%(232) = 14: year%(233) = 2: year%(234) = 3
year%(235) = 4: year%(236) = 12: year%(237) = 7: year%(238) = 1: year%(239) = 2: year%(240) = 10
year%(241) = 5: year%(242) = 6: year%(243) = 7: year%(244) = 8: year%(245) = 3: year%(246) = 4
year%(247) = 5: year%(248) = 13: year%(249) = 1: year%(250) = 2: year%(251) = 3: year%(252) = 11
year%(253) = 6: year%(254) = 7: year%(255) = 1: year%(256) = 9: year%(257) = 4: year%(258) = 5
year%(259) = 6: year%(260) = 14: year%(261) = 2: year%(262) = 3: year%(263) = 4: year%(264) = 12
year%(265) = 7: year%(266) = 1: year%(267) = 2: year%(268) = 10: year%(269) = 5: year%(270) = 6
year%(271) = 7: year%(272) = 8: year%(273) = 3: year%(274) = 4: year%(275) = 5: year%(276) = 13
year%(277) = 1: year%(278) = 2
M1%(1) = 1: M1%(2) = 4: M1%(3) = 4: M1%(4) = 7: M1%(5) = 2: M1%(6) = 5
M1%(7) = 7: M1%(8) = 3: M1%(9) = 6: M1%(10) = 1: M1%(11) = 4: M1%(12) = 6
M2%(1) = 2: M2%(2) = 5: M2%(3) = 5: M2%(4) = 1: M2%(5) = 3: M2%(6) = 6
M2%(7) = 1: M2%(8) = 4: M2%(9) = 7: M2%(10) = 2: M2%(11) = 5: M2%(12) = 7
M3%(1) = 3: M3%(2) = 6: M3%(3) = 6: M3%(4) = 2: M3%(5) = 4: M3%(6) = 7
M3%(7) = 2: M3%(8) = 5: M3%(9) = 1: M3%(10) = 3: M3%(11) = 6: M3%(12) = 1
M4%(1) = 4: M4%(2) = 7: M4%(3) = 7: M4%(4) = 3: M4%(5) = 5: M4%(6) = 1
M4%(7) = 3: M4%(8) = 6: M4%(9) = 2: M4%(10) = 4: M4%(11) = 7: M4%(12) = 2
M5%(1) = 5: M5%(2) = 1: M5%(3) = 1: M5%(4) = 4: M5%(5) = 6: M5%(6) = 2
M5%(7) = 4: M5%(8) = 7: M5%(9) = 3: M5%(10) = 5: M5%(11) = 1: M5%(12) = 3
M6%(1) = 6: M6%(2) = 2: M6%(3) = 2: M6%(4) = 5: M6%(5) = 7: M6%(6) = 3
M6%(7) = 5: M6%(8) = 1: M6%(9) = 4: M6%(10) = 6: M6%(11) = 2: M6%(12) = 4
M7%(1) = 7: M7%(2) = 3: M7%(3) = 3: M7%(4) = 6: M7%(5) = 1: M7%(6) = 4
M7%(7) = 6: M7%(8) = 2: M7%(9) = 5: M7%(10) = 7: M7%(11) = 3: M7%(12) = 5
M8%(1) = 1: M8%(2) = 4: M8%(3) = 5: M8%(4) = 1: M8%(5) = 3: M8%(6) = 6
M8%(7) = 1: M8%(8) = 4: M8%(9) = 7: M8%(10) = 2: M8%(11) = 5: M8%(12) = 7
M9%(1) = 2: M9%(2) = 5: M9%(3) = 6: M9%(4) = 2: M9%(5) = 4: M9%(6) = 7
M9%(7) = 2: M9%(8) = 5: M9%(9) = 1: M9%(10) = 3: M9%(11) = 6: M9%(12) = 1
M10%(1) = 3: M10%(2) = 6: M10%(3) = 7: M10%(4) = 3: M10%(5) = 5: M10%(6) = 1
M10%(7) = 3: M10%(8) = 6: M10%(9) = 2: M10%(10) = 4: M10%(11) = 7: M10%(12) = 2
M11%(1) = 4: M11%(2) = 7: M11%(3) = 1: M11%(4) = 4: M11%(5) = 6: M11%(6) = 2
M11%(7) = 4: M11%(8) = 7: M11%(9) = 3: M11%(10) = 5: M11%(11) = 1: M11%(12) = 3
M12%(1) = 5: M12%(2) = 1: M12%(3) = 2: M12%(4) = 5: M12%(5) = 7: M12%(6) = 3
M12%(7) = 5: M12%(8) = 1: M12%(9) = 4: M12%(10) = 6: M12%(11) = 2: M12%(12) = 4
M13%(1) = 6: M13%(2) = 2: M13%(3) = 3: M13%(4) = 6: M13%(5) = 1: M13%(6) = 4
M13%(7) = 6: M13%(8) = 2: M13%(9) = 5: M13%(10) = 7: M13%(11) = 3: M13%(12) = 5
M14%(1) = 7: M14%(2) = 3: M14%(3) = 4: M14%(4) = 7: M14%(5) = 2: M14%(6) = 5
M14%(7) = 7: M14%(8) = 3: M14%(9) = 6: M14%(10) = 1: M14%(11) = 4: M14%(12) = 6
dn$(1) = "MONDAY   ": dn$(2) = "TUESDAY  ": dn$(3) = "WEDNESDAY": dn$(4) = "THURSDAY ": dn$(5) = "FRIDAY   ": dn$(6) = "SATURDAY ": dn$(7) = "SUNDAY"
d1%(1) = 1: d1%(2) = 2: d1%(3) = 3: d1%(4) = 4: d1%(5) = 5: d1%(6) = 6:
d1%(7) = 7: d1%(8) = 1: d1%(9) = 2: d1%(10) = 3
d1%(11) = 4: d1%(12) = 5: d1%(13) = 6: d1%(14) = 7: d1%(15) = 1: d1%(16) = 2: d1%(17) = 3: d1%(18) = 4: d1%(19) = 5: d1%(20) = 6
d1%(21) = 7: d1%(22) = 1: d1%(23) = 2: d1%(24) = 3: d1%(25) = 4: d1%(26) = 5: d1%(27) = 6: d1%(28) = 7: d1%(29) = 1: d1%(30) = 2
d1%(31) = 3
d2%(1) = 2: d2%(2) = 3: d2%(3) = 4: d2%(4) = 5: d2%(5) = 6: d2%(6) = 7: d2%(7) = 1: d2%(8) = 2: d2%(9) = 3: d2%(10) = 4
d2%(11) = 5: d2%(12) = 6: d2%(13) = 7: d2%(14) = 1: d2%(15) = 2: d2%(16) = 3: d2%(17) = 4: d2%(18) = 5: d2%(19) = 6: d2%(20) = 7
d2%(21) = 1: d2%(22) = 2: d2%(23) = 3: d2%(24) = 4: d2%(25) = 5: d2%(26) = 6: d2%(27) = 7: d2%(28) = 1: d2%(29) = 2: d2%(30) = 3
d2%(31) = 4
d3%(1) = 3: d3%(2) = 4: d3%(3) = 5: d3%(4) = 6: d3%(5) = 7: d3%(6) = 1: d3%(7) = 2: d3%(8) = 3: d3%(9) = 4: d3%(10) = 5
d3%(11) = 6: d3%(12) = 7: d3%(13) = 1: d3%(14) = 2: d3%(15) = 3: d3%(16) = 4: d3%(17) = 5: d3%(18) = 6: d3%(19) = 7: d3%(20) = 1
d3%(21) = 2: d3%(22) = 3: d3%(23) = 4: d3%(24) = 5: d3%(25) = 6: d3%(26) = 7: d3%(27) = 1: d3%(28) = 2: d3%(29) = 3: d3%(30) = 4
d3%(31) = 5
d4%(1) = 4: d4%(2) = 5: d4%(3) = 6: d4%(4) = 7: d4%(5) = 1: d4%(6) = 2: d4%(7) = 3: d4%(8) = 4: d4%(9) = 5: d4%(10) = 6
d4%(11) = 7: d4%(12) = 1: d4%(13) = 2: d4%(14) = 3: d4%(15) = 4: d4%(16) = 5: d4%(17) = 6: d4%(18) = 7: d4%(19) = 1: d4%(20) = 2
d4%(21) = 3: d4%(22) = 4: d4%(23) = 5: d4%(24) = 6: d4%(25) = 7: d4%(26) = 1: d4%(27) = 2: d4%(28) = 3: d4%(29) = 4: d4%(30) = 5
d4%(31) = 6
d5%(1) = 5: d5%(2) = 6: d5%(3) = 7: d5%(4) = 1: d5%(5) = 2: d5%(6) = 3: d5%(7) = 4: d5%(8) = 5: d5%(9) = 6: d5%(10) = 7
d5%(11) = 1: d5%(12) = 2: d5%(13) = 3: d5%(14) = 4: d5%(15) = 5: d5%(16) = 6: d5%(17) = 7: d5%(18) = 1: d5%(19) = 2: d5%(20) = 3
d5%(21) = 4: d5%(22) = 5: d5%(23) = 6: d5%(24) = 7: d5%(25) = 1: d5%(26) = 2: d5%(27) = 3: d5%(28) = 4: d5%(29) = 5: d5%(30) = 2
d5%(31) = 7
d6%(1) = 6: d6%(2) = 7: d6%(3) = 1: d6%(4) = 2: d6%(5) = 3: d6%(6) = 4: d6%(7) = 5: d6%(8) = 6: d6%(9) = 7: d6%(10) = 1
d6%(11) = 2: d6%(12) = 3: d6%(13) = 4: d6%(14) = 5: d6%(15) = 6: d6%(16) = 7: d6%(17) = 1: d6%(18) = 2: d6%(19) = 3: d6%(20) = 4
d6%(21) = 5: d6%(22) = 6: d6%(23) = 7: d6%(24) = 1: d6%(25) = 2: d6%(26) = 3: d6%(27) = 4: d6%(28) = 5: d6%(29) = 6: d6%(30) = 7
d6%(31) = 1
d7%(1) = 7: d7%(2) = 1: d7%(3) = 2: d7%(4) = 3: d7%(5) = 4: d7%(6) = 5: d7%(7) = 6: d7%(8) = 7: d7%(9) = 1: d7%(10) = 2
d7%(11) = 3: d7%(12) = 4: d7%(13) = 5: d7%(14) = 6: d7%(15) = 7: d7%(16) = 1: d7%(17) = 2: d7%(18) = 3: d7%(19) = 4: d7%(20) = 5
d7%(21) = 6: d7%(22) = 7: d7%(23) = 1: d7%(24) = 2: d7%(25) = 3: d7%(26) = 4: d7%(27) = 5: d7%(28) = 6: d7%(29) = 7: d7%(30) = 1
d7%(31) = 2
mn$(1) = "January": mn$(2) = "February": mn$(3) = "March": mn$(4) = "April": mn$(5) = "May": mn$(6) = "June"
mn$(7) = "July": mn$(8) = "August": mn$(9) = "September": mn$(10) = "October": mn$(11) = "November": mn$(12) = "December"
mnu%(1) = 31: mnu%(2) = 28: mnu%(3) = 31: mnu%(4) = 30: mnu%(5) = 31: mnu%(6) = 30: mnu%(7) = 31: mnu%(8) = 31: mnu%(9) = 30: mnu%(10) = 31: mnu%(11) = 30: mnu%(12) = 31

FOR ColorSet = 1 TO 4
     FOR x = 1 TO 10
            READ Colors(x, ColorSet)
     NEXT x
NEXT ColorSet

END SUB

SUB inputerror
LINE (158, 235)-(390, 249), 7, B
LINE (159, 236)-(389, 248), 15, BF
Word$ = "Input Error"
SPACING$ = "R0"
SIZE$ = " 4"
DOT$ = "N"
BGC = 15
CALL TRANSLATE
C1$ = "C 4"
C2$ = "C12"
PFT = 245: PFL = 163: CALL NORMAL1
LINE (158, 262)-(390, 274), 7, B
LINE (159, 263)-(389, 273), 15, BF
IF nt% = 1 THEN
   Word$ = "The Year entered is invalid"
ELSEIF nt% = 2 THEN
   Word$ = "The Month entered is invalid"
ELSEIF nt% = 3 THEN
   Word$ = "The Day entered is invalid"
END IF
SPACING$ = "R0"
SIZE$ = " 4"
DOT$ = "N"
BGC = 15
CALL TRANSLATE
C1$ = "C 4"
C2$ = "C12"
PFT = 272: PFL = 163: CALL NORMAL1
LINE (158, 279)-(415, 291), 7, B
LINE (159, 280)-(414, 290), 15, BF
IF nt% = 1 THEN
    Word$ = "Valid range is 1753 - 2030"
ELSEIF nt% = 2 THEN
    Word$ = "Valid range is 1 - 12"
ELSEIF nt% = 3 THEN
    Word$ = "Valid range is 1 -31"
END IF
SPACING$ = "R0"
SIZE$ = " 4"
DOT$ = "N"
BGC = 15
CALL TRANSLATE
C1$ = "C 4"
C2$ = "C12"
PFT = 289: PFL = 163: CALL NORMAL1
LINE (158, 296)-(415, 308), 7, B
LINE (159, 297)-(414, 307), 15, BF
Word$ = "Please re-enter"
SPACING$ = "R0"
SIZE$ = " 4"
DOT$ = "N"
BGC = 15
CALL TRANSLATE
C1$ = "C 4"
C2$ = "C12"
PFT = 306: PFL = 163: CALL NORMAL1

END SUB

SUB LAYER1
  PSET (PFL + 2, PFT + 5), BGC: DRAW C3$ + P$
  PSET (PFL + 0, PFT + 5), BGC: DRAW C3$ + P$
  PSET (PFL + 1, PFT + 5), BGC: DRAW C3$ + P$
  PSET (PFL + 0, PFT + 4), BGC: DRAW C3$ + P$
  PSET (PFL + 1, PFT + 2), BGC: DRAW C2$ + P$
  PSET (PFL + 2, PFT + 4), BGC: DRAW C1$ + P$
  PSET (PFL + 3, PFT + 3), BGC: DRAW C4$ + P$
  PSET (PFL + 3, PFT + 2), BGC: DRAW C2$ + P$
  PSET (PFL + 4, PFT + 4), BGC: DRAW C2$ + P$
  PSET (PFL + 5, PFT + 2), BGC: DRAW C3$ + P$
  PSET (PFL + 5, PFT + 3), BGC: DRAW C2$ + P$
  PSET (PFL + 4, PFT + 3), BGC: DRAW C1$ + P$
END SUB

SUB LETTERS
   P$(32) = "BR4"                                                  'SPACE
   P$(33) = "BR1BD1U1BU2U5BD7BR3"                                  '!
   P$(34) = "BR0BU7D2BR2U2BD7BR3"                                  '"
   P$(35) = "BD1BR1U8D2L1R5L1U2D8U2L4R5BR2BD1"                     '#
   P$(36) = "BD1BR3U8D8BL3BU5U1E1R3F1BD1BL5F1R3F1D1G1L3H1BR7BD1"   '$
   P$(37) = "BD1U1E6U1BL5BD2U1R1D1L1BD4BR4R1D1L1U1BD1BR5"          '%
   P$(38) = "BR1BU2BL1E3U1H1L1G1D1F6BU1BL5BU3G2D1F1R3E3BD2BR2"     '&
   P$(39) = "BR2BU7D1G1BD5BR4"                                     ''
   P$(40) = "BR1BD1BU2U4E2G2D4F2BU1BR4"                            '(
   P$(41) = "BR2BD1BU2U4H2F2D4G2BU1BR5"                            ')
   P$(42) = "BR2BU2U6D3L2R4BL4BD2E4BL4F4BD3BR4"                    '*
   P$(43) = "BR2BD1U7D3L2R5BD3BR3"                                 '+
   P$(44) = "BD1U1R1D2G1BU3BR4"                                    ',
   P$(45) = "BR1BU3R3L3BD3BR5"                                     '-
   P$(46) = "BD1BR1L1BU1BR4"                                       '.
   P$(47) = "BR1E5G5BR7"                                           '/
   P$(48) = "BD1BU1U6E1R2F1D6G1L2H1BR6"                            '0
   P$(49) = "BD1BR2U7BL1E1D1BD6BR3"                                '1
   P$(50) = "BR1BU6E1R2F1D2G4D1R4BU1BR3"                           '2
   P$(51) = "BU6E1R2F1D2G1L2R2F1D2G1L2H1BR7"                       '3
   P$(52) = "BU3E4D8U4L4R5BD3BR3"                                  '4
   P$(53) = "BR1BU3U4R4L4D4E1R2F1D3G1L2H1BR7"                      '5
   P$(54) = "BR1BD1BU4U3E1R2F1H1L2G1D6F1R2E1U3H1L2G1BD3BR6"        '6
   P$(55) = "BR1BU7R4D3G4D1BU1BR7"                                 '7
   P$(56) = "BR1BU6E1R2F1D2G1L2R2F1D2G1L2H1U2E1H1U2BD6BR7"         '8
   P$(57) = "BR1BU4U2E1R2F1D6G1L2H1BU4F1R3BD3BR3"                  '9
   P$(58) = "BR1U1BU2U1BD4BR3"                                     ':
   P$(59) = "BD1BR1BU1U1BU2U1BD4G1BU1BR6"                          ';
   P$(60) = "BU3E3G3F3BR3"                                         '<
   P$(61) = "BU3R4BD2L4BR7BD1"                                     '=
   P$(62) = "BU6BR1F3G3BR5"                                        '>
   P$(63) = "BR1BU5U1E1R2F1D2G1D1BD2D1BU1BR3"                      '?
   P$(64) = "BD1BU1U6E1R3F1D5L2H1U2E1R1D3BD3L3H1F1R3E1BR3"         '@
   P$(65) = "BD1U7E1R3F1D3L5R5D4BR4BU1"                            'A
   P$(66) = "BD1U8R4F1D2G1L4R4F1D2G1L4BU1BR9"                      'B
   P$(67) = "BD1BU1U6E1R3F1BD6G1L3H1F1R3BR4BU1"                    'C
   P$(68) = "BD1U8R4F1D6G1L4BR9BU1 "                               'D
   P$(69) = "BD1U8R4L4D4R3L3D4R4BU1BR4"                            'E
   P$(70) = "BD1U8R5L5D4R4L4D4BR8BU1"                              'F
   P$(71) = "BD1BU1U6E1R3F1BD6G1L3H1F1R3E1U3L2R2D3BR4"             'G
   P$(72) = "BD1U8D4R4U4D8BR4BU1"                                  'H
   P$(73) = "BD1BR3U8L1R2L1D8L1R2BR4BU1"                           'I
   P$(74) = "BD1BU1F1R2E1U7L1R2L1D7BR5"                            'J
   P$(75) = "BD1BU8D8U4R1E4G4F4BR4BU1"                             'K
   P$(76) = "BD1BU8D8R4BU1BR4"                                     'L
   P$(77) = "BD1U7E1R2F1D7U7E1R2F1D7BU1BR4"                        'M
   P$(78) = "BD1U8F7D1U8D8BR4BU1"                                  'N
   P$(79) = "BD1BU1U6E1R3F1BD6G1L3H1BR5U6D6BR4"                    'O
   P$(80) = "BD1U8R4F1D2G1L4D4BR9BU1"                              'P
   P$(81) = "BD1BU1U6E1R3F1BD6G1L3H1BR5U6BL3BD5F3BG3BR7BU5"        'Q
   P$(82) = "BD1U8R4F1D2G1L4R1F4BR4BU1"                            'R
   P$(83) = "BD1BU5U2E1R3F1BD2BL5F1R3F1D2G1L3H1BR9"                'S
   P$(84) = "BR3BD1BU8L4R6L3D8BR6BU1"                              'T
   P$(85) = "BD1BU1U7D7F1R3E1U7D7BR4"                              'U
   P$(86) = "BD1BU8D5F2D1U1E2U5D5BR5BD2"                           'V
   P$(87) = "BD1BU1U7D7F1R2E1U7D7F1R2E1U7D7BD1BR4BU1"              'W
   P$(88) = "BD1BU8D1F3E3U1D1G6D1U1E3F3D1BU1BR5"                   'X
   P$(89) = "BL1BU5U2D2F3E3U2D2G3D3BU1BR7"                         'Y
   P$(90) = "BU7R5D2G5D1R5BR4BU1"                                  'Z
   P$(91) = "BR1BD1BR3L3U8R3BR3BD7"                                '[
   P$(92) = "BU5F5BR3"                                             '\
   P$(93) = "BD1R3U8L3BR2BD7BR4"                                   ']
   P$(94) = "BR1BU5E2F2BD5BR2"                                     '^
   P$(95) = "BD1R4BU1BL2BR5"                                       '_
   P$(96) = "BR2BU7D1F1BD5BR2"                                     '`
   P$(97) = "U2E1R3U1H1L2G1E1R2F1D4G1L2H1F1BR2E1U2D3BR4BU1"        'a
   P$(98) = "BD1U8D8R3E1U4H1L2G1D4BR8"                             'b
   P$(99) = "BR0U4E1R2F1BD4G1L2H1F1R2E1BR4"                        'c
   P$(100) = "U4E1R2F1H1L2G1D4F1R2E1U7D7D1BU1BR4"                  'd
   P$(101) = "U4E1R2F1D2L4D2F1R2E1BR4"                             'e
   P$(102) = "BR1BD1U7E1R2F1H1L2G1D3L1R3BD3BR5"                    'f
   P$(103) = "U4E1R2F1D4G1L2H1BD3F1R2E1U3BR4"                      'g
   P$(104) = "BU7D8U5E1R2F1D5BU1BR4"                               'h
   P$(105) = "BR3BD1U6BU2BD7BR4"                                   'i
   P$(106) = "BR1BD1U6BU2BD7D3G1L2BU4BR8"                          'j
   P$(107) = "BD1BU8D8U3E3G3F3BU1BR3"                              'k
   P$(108) = "BR1BD1U8L1R1D8L1R2BR4BU1"                            'l
   P$(109) = "BD1U6D1E1R1F1D5U5E1R1F1D5BU1BR4"                     'm
   P$(110) = "BD1U6D1E1R2F1D5U4BD3BR4"                             'n
   P$(111) = "U4E1R2F1D4G1L2H1BR8"                                 'o
   P$(112) = "U4E1R2F1D4G1L2H1D4U4BR8"                             'p
   P$(113) = "U4E1R2F1D4G1L2H1BR4D4L1R2L1U4BR5"                    'q
   P$(114) = "BD1U6D1E1R2F1H1L2G1U1D6BU1BR7"                       'r
   P$(115) = "BU3U1E1R2F1H1L2G1D1F1R2F1D1G1L2H1BR8"                's
   P$(116) = "BR1BU7D2L2R4L2D5F1R1E1BR4"                           't
   P$(117) = "U5D5F1R2E1U5D5BR4"                                   'u
   P$(118) = "BD1BU6D3F2D1U1E2U3D3BD2BR4"                          'v
   P$(119) = "BD1BU6D5F1R1E1U4D4F1R1E1U5D5BR4"                     'w
   P$(120) = "BD1BU6D1F2E2U1D1G4D1U1E2F2D1BU1BR4"                  'x
   P$(121) = "BU5D5F1R2E1U5D8G1L2H1BU3BR8"                         'y
   P$(122) = "BU5R4D1G4D1R4BU1BR4"                                 'z
END SUB

SUB NORMAL0
PSET (PFL + 0, PFT + 0), BGC: DRAW C1$ + P$
END SUB

SUB NORMAL1
    PSET (PFL + 0, PFT + 1), BGC: DRAW C2$ + P$
    PSET (PFL + 1, PFT + 0), BGC: DRAW C1$ + P$
    PSET (PFL + 2, PFT + 0), BGC: DRAW C1$ + P$
END SUB

SUB OPENINTRO
COLOR 7, 0
SCREEN 9                                    'SET SCREEN MODE TO 9
CLS
LINE (1, 1)-(590, 72), 13, B
LINE (3, 3)-(588, 70), 7, BF
Word$ = "What Day Was It ?"
SPACING$ = "L1"
SIZE$ = "20"
DOT$ = "N"
BGC = 7
CALL TRANSLATE
C1$ = "C 5": C2$ = "C 8": C3$ = "C 8": C4$ = "C 8"
PFT = 52: PFL = 16: CALL LAYER1
PFT = 52: PFL = 14: CALL LAYER1
PFT = 52: PFL = 12: CALL LAYER1
C1$ = "C 5": C2$ = "C 0": C3$ = "C 0": C4$ = "C15"
PFT = 50: PFL = 18: CALL LAYER1
PFT = 50: PFL = 17: CALL LAYER1
Colorpref = 1
FancyCls Colors(2, Colorpref), Colors(1, Colorpref)

LINE (158, 100)-(390, 116), 7, B
LINE (159, 101)-(389, 115), 15, BF
Word$ = "Display Any Day of the Week for"
SPACING$ = "R0"
SIZE$ = " 4"
DOT$ = "N"
BGC = 15
CALL TRANSLATE
C1$ = "C 1"
C2$ = "C 9"
PFT = 110: PFL = 163: CALL NORMAL1
LINE (158, 122)-(390, 138), 7, B
LINE (159, 123)-(389, 137), 15, BF
Word$ = "   Any Date Between 1753 - 2030"
SPACING$ = "R0"
SIZE$ = " 4"
DOT$ = "N"
BGC = 15
CALL TRANSLATE
C1$ = "C 1"
C2$ = "C 9"
PFT = 132: PFL = 163: CALL NORMAL1

HITENTER:
LINE (228, 337)-(340, 350), 7, BF
Word$ = "Press any Key"
SPACING$ = "R1"
SIZE$ = " 4"
DOT$ = "N"
BGC = 15
CALL TRANSLATE
C1$ = "C 0"
C2$ = "C 8"
PFT = 346: PFL = 231: CALL NORMAL1
INKEY1:
C1$ = "C 0"
C2$ = "C 8"
PFT = 346: PFL = 231: CALL NORMAL1
SLEEP 1
C1$ = "C 4"
C2$ = "C 8"
PFT = 346: PFL = 231: CALL NORMAL1
SLEEP 1
A$ = INKEY$: IF A$ = "" THEN GOTO INKEY1
END SUB

SUB PAUSE
LINE (248, 337)-(360, 350), 7, BF
Word$ = "Press any Key"
SPACING$ = "R1"
SIZE$ = " 4"
DOT$ = "N"
BGC = 15
CALL TRANSLATE
C1$ = "C 0"
C2$ = "C 8"
PFT = 346: PFL = 251: CALL NORMAL1
INKEY2:
C1$ = "C 0"
C2$ = "C 8"
PFT = 346: PFL = 251: CALL NORMAL1
SLEEP 1
C1$ = "C 4"
C2$ = "C 8"
PFT = 346: PFL = 251: CALL NORMAL1
SLEEP 1
A$ = INKEY$: IF A$ = "" THEN GOTO INKEY2
END SUB

SUB TRANSLATE
  SPACING$ = "B" + UCASE$(SPACING$)
     SIZE$ = "S" + UCASE$(SIZE$)
  P$(105) = "BR0BD1U6BU2BD7BR4"                     'i
  P$(106) = "BR1BD1U6BU2BD7D3G1L2BU4BR8"            'j
  IF DOT$ = "Y" THEN P$(105) = "BR0BD1U6BU1U1BD7BR4"            'DOT OVER i
  IF DOT$ = "Y" THEN P$(106) = "BR1BD1U6BU1U1BD7D3G1L2BU4BR8"   'DOT OVER j
  P$ = SIZE$
  FOR J = 1 TO LEN(Word$)
  P$ = P$ + P$(ASC(MID$(Word$, J, 1))) + SPACING$
  NEXT J
END SUB