home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib27b.dsk / QUICK.CALENDAR.bas < prev    next >
BASIC Source File  |  2023-02-26  |  4KB  |  143 lines
  1. 10  REM ********4.3.86********
  2. 20  REM *   QUICK.CALENDAR   *
  3. 30  REM *   BY DON MAXWELL   *
  4. 40  REM * COPYRIGHT (C) 1986 *
  5. 50  REM * BY MICROSPARC, INC *
  6. 60  REM * CONCORD, MA  01742 *
  7. 70  REM **********************
  8. 80  GOTO 910
  9. 90  TEXT 
  10. 100  HOME 
  11. 110  VTAB 12: HTAB 12: FLASH : PRINT "COMPUTING"
  12. 120  DIM MTH(12,6,7),NAME$(12),M(12),D$(7)
  13. 130  FOR X = 1 TO 7
  14. 140  READ D$(X)
  15. 150  NEXT 
  16. 160  DATA  S,M,T,W,T,F,S
  17. 170  FOR X = 1 TO 12
  18. 180  READ NAME$(X)
  19. 190  NEXT 
  20. 200  DATA  JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER
  21. 210  FOR X = 1 TO 12
  22. 220  READ M(X)
  23. 230  NEXT 
  24. 240  DATA     31,28,31,30,31,30,31,31,30,31,30,31
  25. 250  IF Y$ = "Y"  THEN M(2) = 29
  26. 260 WEEK = 1
  27. 270  FOR I = 1 TO 12
  28. 280  FOR NOM = 1 TO M(I)
  29. 290 MTH(I,WEEK,DAY) = NOM
  30. 300 DAY = DAY +1
  31. 310  IF DAY >7  THEN DAY = 1:WEEK = WEEK +1
  32. 320  NEXT 
  33. 330 WEEK = 1:SPV = 3
  34. 340  NEXT 
  35. 350  HOME : NORMAL 
  36. 360  PRINT  CHR$(4)"PR# 1": PRINT  CHR$(9)"80N"
  37. 370  PRINT : PRINT  TAB( 38)YEAR
  38. 380  FOR I = 1 TO 12  STEP 2
  39. 390  GOSUB 640: GOSUB 670: GOSUB 710
  40. 400  FOR WEEK = 1 TO 6
  41. 410  PRINT  SPC( 7);
  42. 420  PRINT "*";
  43. 430  FOR X = 1 TO 7
  44. 440  IF MTH(I,WEEK,X) = 0  THEN  PRINT  SPC( 3)" ";: GOTO 480
  45. 450 SPV = 3
  46. 460  IF MTH(I,WEEK,X) >9  THEN SPV = 2
  47. 470  PRINT  SPC( SPV)MTH(I,WEEK,X);
  48. 480  NEXT 
  49. 490  PRINT  SPC( 3)"*";
  50. 500  FOR X = 1 TO 7
  51. 510  IF MTH(I +1,WEEK,X) = 0  THEN  PRINT  SPC( 3)" ";: GOTO 550
  52. 520  IF MTH(I +1,WEEK,X) >9  THEN SPV = 2: GOTO 540
  53. 530 SPV = 3
  54. 540  PRINT  SPC( SPV)MTH(I +1,WEEK,X);
  55. 550  NEXT 
  56. 560  PRINT  SPC( 3)"*"
  57. 570  NEXT WEEK
  58. 580  NEXT 
  59. 590  GOSUB 640
  60. 600  PRINT  CHR$(4)"PR# 0"
  61. 610  HOME : VTAB 12: HTAB 9
  62. 620  PRINT "QUICK CALENDAR COMPLETE": END 
  63. 630  REM  -----SUB ROUTINE-----
  64. 640  PRINT  SPC( 7);: FOR A = 1 TO 65: PRINT "*";: NEXT 
  65. 650  PRINT 
  66. 660  RETURN 
  67. 670  FOR B = 1 TO 12  STEP 2
  68. 680  IF B = I  THEN  GOSUB 800: GOTO 700
  69. 690  NEXT B
  70. 700  RETURN 
  71. 710  PRINT  SPC( 7);: PRINT "*" SPC( 3);
  72. 720  FOR D = 1 TO 2
  73. 730  FOR D1 = 1 TO 7
  74. 740  PRINT D$(D1) SPC( 3);
  75. 750  NEXT 
  76. 760  PRINT "*" SPC( 3)
  77. 770  NEXT 
  78. 780  PRINT 
  79. 790  RETURN 
  80. 800 TV =  LEN(NAME$(B)):T2 =  LEN(NAME$(B +1))
  81. 810 T5 =  INT((33 -TV)/2):T6 =  INT((33 -T2)/2)
  82. 820  PRINT  SPC( 7)"*";
  83. 830  PRINT  SPC( T5)NAME$(B);
  84. 840 RT = 33 -T5 -TV
  85. 850  PRINT  SPC( RT -2)"*";
  86. 860  PRINT  SPC( T6)NAME$(B +1);
  87. 870 RT = 33 -T6 -T2
  88. 880  PRINT  SPC( RT -2)"*";
  89. 890  PRINT 
  90. 900  RETURN 
  91. 910  TEXT : HOME 
  92. 920  VTAB 10: HTAB 5: PRINT "QUICK CALENDAR BY DON MAXWELL": PRINT : PRINT " ** COPYRIGHT 1986 BY MICROSPARC,INC **"
  93. 930  VTAB 21: HTAB 7: PRINT "PRESS <RETURN> TO CONTINUE";: GET Z$: PRINT 
  94. 940  HOME : VTAB 12: PRINT "ENTER THE DESIRED CALENDAR YEAR": INPUT "(1901-2099): ";YR$:YEAR =  INT( VAL(YR$)): IF YEAR <1901  OR YEAR >2099  THEN  PRINT  CHR$(7): GOTO 940
  95. 950  VTAB 21: HTAB 1: CALL  -958: VTAB 21: PRINT "    TURN ON THE PRINTER AND PRESS           <RETURN> WHEN READY...";
  96. 960  GET A$: IF A$ < > CHR$(13)  THEN 960
  97. 970  IF  ABS(1983 -YEAR) >50  THEN  HOME : HTAB 12: VTAB 12: FLASH : PRINT "COMPUTING": NORMAL 
  98. 980  IF YEAR -1983 >0  THEN 1020
  99. 990  IF YEAR -1983 <0  THEN 1200
  100. 1000 DAY = 7
  101. 1010  GOTO 1270
  102. 1020 DAY = 7:L = 2
  103. 1030  FOR X = 1983 TO YEAR -1
  104. 1040  GOSUB 1090
  105. 1050  IF L = 5  THEN  GOSUB 1090
  106. 1060  GOSUB 1140
  107. 1070  NEXT 
  108. 1080  GOTO 1270
  109. 1090  LET DAY = DAY +1
  110. 1100  IF DAY = 8  THEN 1120
  111. 1110  GOTO 1130
  112. 1120 DAY = 1
  113. 1130  RETURN 
  114. 1140 L = L +1: IF L = 4  THEN  GOSUB 1090:L = 0
  115. 1150  RETURN 
  116. 1160 DAY = DAY -1: IF DAY = 0  THEN DAY = 7
  117. 1170  RETURN 
  118. 1180 L = L -1: IF L = 0  THEN L = 4
  119. 1190  RETURN 
  120. 1200 DAY = 7:L = 3
  121. 1210  FOR X = 1983 TO YEAR +1  STEP  -1
  122. 1220  GOSUB 1160
  123. 1230  IF L = 1  THEN  GOSUB 1160
  124. 1240  GOSUB 1180
  125. 1250  NEXT 
  126. 1260  GOTO 1270
  127. 1270  ON DAY GOTO 1280,1290,1300,1310,1320,1330,1340
  128. 1280 A$ = "SUNDAY": GOTO 1350
  129. 1290 A$ = "MONDAY": GOTO 1350
  130. 1300 A$ = "TUESDAY": GOTO 1350
  131. 1310 A$ = "WEDNESDAY": GOTO 1350
  132. 1320 A$ = "THURSDAY": GOTO 1350
  133. 1330 A$ = "FRIDAY": GOTO 1350
  134. 1340 A$ = "SATURDAY"
  135. 1350  HOME : PRINT YEAR;" BEGINS ON A ";A$
  136. 1360 X2 = YEAR/4
  137. 1370 IX =  INT(YEAR/4)
  138. 1380  IF X2 = IX  THEN  PRINT "IT IS A LEAP YEAR":Y$ = "Y": GOTO 1400
  139. 1390  PRINT "IT IS NOT A LEAP YEAR"
  140. 1400  PRINT "WOULD YOU LIKE A CALENDAR OF THIS YEAR?";: GET ANS$
  141. 1410  IF ANS$ = "Y"  THEN 90
  142. 1420  HOME : HTAB 4: VTAB 12
  143. 1430  PRINT "THANK YOU FOR RUNNING 'CALENDAR'": PRINT : END