home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib25a.dsk / SEPTEMBER.1985 / DESK.CALENDAR.bas next >
BASIC Source File  |  2023-02-26  |  24KB  |  460 lines
  1. 1  REM **********************
  2. 2  REM *   DESK.CALENDAR    *
  3. 3  REM *   BY MARK CRAVEN   *
  4. 4  REM * COPYRIGHT (C) 1985 *
  5. 5  REM * BY MICROSPARC, INC *
  6. 6  REM * CONCORD, MA  01742 *
  7. 7  REM **********************
  8. 10  LET IN$ = "X": REM  INITIATE INPUT VARIABLE
  9. 20 Y = 1985:YR$ =  STR$(Y)
  10. 30 D$ =  CHR$(4)
  11. 40  TEXT : GOSUB 180
  12. 50  DIM M$(13),D(40): REM  MONTHS AND EVENT DATES
  13. 60  DIM IN$(40),EV$(40): REM  INPUT AND EVENTS
  14. 70  DIM N(12),FM(12): REM   DAYS IN EACH MONTH, FIRST OF EACH MONTH (0-6)
  15. 80  FOR I = 1 TO 5: READ MU$(1,I): NEXT 
  16. 90  FOR I = 1 TO 13: READ M$(I): NEXT 
  17. 100  FOR J = 768 TO 790: READ I: POKE J,I: NEXT J
  18. 110  FOR I = 1 TO 12: READ N(I): NEXT 
  19. 120  FOR I = 1 TO 3: READ MU$(2,I): NEXT : REM   DISPLAY MENU 
  20. 130  FOR I = 1 TO 3: READ MU$(3,I): NEXT : REM DISPLAY PRINT MENU   
  21. 140  FOR I = 1 TO 3: READ MU$(4,I): NEXT : REM   ADD/CHANGE/DELETE/MENU 
  22. 150  FOR I = 1 TO 2: READ MU$(5,I): NEXT : REM  YES/NO
  23. 160  GOSUB 4310
  24. 170  GOTO 3700: REM  HEADING
  25. 180  FOR Z = 38 TO 0  STEP  -1: POKE 32,Z: POKE 33,40 -Z: HOME : NEXT : RETURN 
  26. 190  POKE 32,0: FOR Z = 0 TO 39: POKE 33,Z +1: HOME : NEXT : RETURN 
  27. 200 C = 1: GOTO 240
  28. 210  VTAB V% +2 *OS: HTAB H: PRINT MU$(M1,OS)
  29. 220  VTAB V% +2 *CS: INVERSE : HTAB H: PRINT MU$(M1,CS): NORMAL 
  30. 230  RETURN 
  31. 240 CS = C:I = 0: INVERSE 
  32. 250  IF M1 = 2  THEN  VTAB 8: HTAB 1: PRINT "DISPLAY..."
  33. 260  FOR M2 = 1 TO S: IF M2 = CS  THEN : INVERSE 
  34. 270  VTAB VS% *M2 +V%
  35. 280  HTAB H: PRINT MU$(M1,M2): NORMAL 
  36. 290  NEXT 
  37. 300  VTAB 23: INVERSE : PRINT "<-";: NORMAL : PRINT " ";: INVERSE : PRINT "->";: NORMAL : PRINT " TO SELECT .... ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT " TO EXECUTE."
  38. 310  IF M1 < >1  THEN  VTAB 24: HTAB 10: PRINT "<";: INVERSE : PRINT "ESC";: NORMAL : PRINT "> FOR MAIN MENU";
  39. 320  POKE  -16368,0
  40. 330 K =  PEEK( -16384): IF K <128  THEN 330
  41. 340  POKE  -16368,0:K = K -128: IF K < >8  AND K < >21  AND K < >10  AND K < >11  AND K < >13  AND K < >27  OR (K = 27  AND M1 = 1)  THEN 330
  42. 350 OS = CS: IF K = 27  THEN CS = S:OS = S
  43. 360  IF K = 11  OR K = 8  THEN CS = CS -1:CS = CS *(CS >0) +S *(CS = 0): GOSUB 210: GOTO 330
  44. 370  IF K = 21  OR K = 10  THEN CS = CS +1:CS = CS *(CS < = S) +(CS = S +1): GOSUB 210: GOTO 330
  45. 380 C = CS: REM  HOLDING VALUE OF CS
  46. 390  POKE 894,M1: POKE 895,CS: POKE 896,0: REM  SAVE LAST MENU CHOICE FOR ERROR RECOVERY
  47. 400  ON M1 GOTO 410,420,440,450,760,770,780,790,800
  48. 410 NC = 40:MC = 40: ON CS GOTO 1640,2170,2670,4230,3690: REM MAIN MENU CHOICES--M1=1  
  49. 420  ON CS GOTO 1730,1740,430: REM   M1=2  DISPLAY MENU 
  50. 430  TEXT : GOSUB 190: GOTO 3700
  51. 440  ON CS GOTO 1770,1780,3700: REM   DISPLAY OPTIONS-COLUMNS 
  52. 450  ON CS GOTO 2690,2690,3700: REM   M1=4 CHANGE
  53. 460 S = 13: FOR I = 1 TO 13: VTAB V% +I -1: HTAB H: PRINT M$(I): NEXT 
  54. 470  IF M1 >4  THEN  VTAB V%: HTAB H: PRINT MU$(5,1);: HTAB H +5: PRINT MU$(5,2)
  55. 480  GOTO 540
  56. 490  IF M1 = 5  OR M1 = 6  THEN  HTAB H +5 *OS -5: VTAB V%: PRINT MU$(5,OS): GOTO 510
  57. 500  HTAB H: VTAB V% +OS -1: CALL  -868: PRINT M$(OS)
  58. 510  IF M1 = 5  OR M1 = 6  THEN  HTAB H +5 *CS -5: INVERSE : VTAB V%: PRINT MU$(5,CS): NORMAL : GOTO 530
  59. 520  HTAB H: INVERSE : VTAB V% +CS -1: CALL  -868: PRINT M$(CS): NORMAL 
  60. 530  RETURN 
  61. 540 CS = 1 +(M1 = 6): INVERSE 
  62. 550  HTAB H
  63. 560  IF M1 = 5  OR M1 = 6  THEN  VTAB V%: HTAB H +5 *CS -5: PRINT MU$(5,CS): GOTO 580
  64. 570  VTAB V%: CALL  -868: PRINT M$(CS): NORMAL 
  65. 580  VTAB 21: INVERSE : PRINT "<-";: NORMAL : PRINT " ";: INVERSE : PRINT "->";: NORMAL : PRINT " TO SELECT .... ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT " TO EXECUTE.": VTAB 22: HTAB 10: PRINT "<";
  66. 590  INVERSE : PRINT "ESC";: NORMAL : PRINT "> FOR MAIN MENU"
  67. 600  POKE  -16368,0
  68. 610 K =  PEEK( -16384): IF K <128  THEN 610
  69. 620  POKE  -16368,0:K = K -128: IF K < >8  AND K < >21  AND K < >10  AND K < >11  AND K < >27  AND K < >13  AND M1 <5  THEN 610: REM   ONLY CHOICES   
  70. 630  IF M1 <5  AND (K = 78  OR K = 89  OR K = 110  OR K = 121) GOTO 610
  71. 640 OS = CS
  72. 650  IF K = 8  OR K = 11  THEN CS = CS -1:CS = CS *(CS >0) +S *(CS = 0): GOSUB 490: GOTO 610: REM  LEFT OR UP ARROW
  73. 660  IF K = 21  OR K = 10  THEN CS = CS +1:CS = CS *(CS < = S) +(CS = S +1): GOSUB 490: GOTO 610: REM  RIGHT OR DOWN ARROW
  74. 670 C = CS: IF M1 <5  THEN 710
  75. 680  IF K = 78  OR K = 110  THEN CS = 2
  76. 690  IF K = 89  OR K = 121  THEN CS = 1
  77. 700  ON M1 -4 GOTO 810,820
  78. 710  IF K = 27  THEN 3700: REM  MAIN MENU
  79. 720  POKE 894,M1: POKE 895,CS: POKE 896,1: REM  SAVE MONTH FOR ERROR TRAPPING RECOVERY
  80. 730  ON M1 GOTO 740,760,770,790,810,820: REM SELECTION MADE CS=MONTH # 
  81. 740  IF CS = 13  THEN 3700: REM  MAIN MENU
  82. 750  GOTO 2210: REM   M1=1
  83. 760  ON CS GOTO 1730,2240,1740,3700: REM  M1=2--DISPLAY
  84. 770  IF CS = 13  THEN 3700: REM  MAIN MENU
  85. 780  GOTO 1720: REM  MONTH CHOSEN -SAVE NUMBER IN 'F2'
  86. 790  IF CS = 13  THEN 3700: REM  MAIN MENU
  87. 800  GOTO 2720: REM ADD/CHANGE/DEL 
  88. 810  ON CS GOTO 2750,2670: REM Y/N
  89. 820  GOTO 3170
  90. 830  HTAB (20 - LEN(X$)/2): VTAB V: PRINT X$;: RETURN 
  91. 840  HTAB (20 - LEN(MU$(M1,J))/2): VTAB V: PRINT MU$(M1,J): RETURN 
  92. 850  IF X <1  OR X >N(C)  THEN ER = 1: RETURN 
  93. 860  RETURN : REM  ERROR CHECK FOR NUMBER
  94. 870  VTAB 22: FOR Z = 1 TO 40: PRINT "-";: NEXT :V = 23:X$ = "ENTER <Q> TO QUIT": GOSUB 830:V = 24:X$ = "ENTER ZERO (0) TO DISPLAY DATES": GOSUB 830: POKE 35,21: RETURN 
  95. 880  VTAB 23: PRINT "<";: INVERSE : PRINT "RET";: NORMAL : PRINT ">";: PRINT " = CONTINUE  <";: INVERSE : PRINT "ESC";: NORMAL : PRINT "> FOR MAIN MENU";
  96. 890  RETURN 
  97. 900  VTAB 23: HTAB 1: PRINT "ANY KEY TO CONTINUE..<";: INVERSE : PRINT "ESC";: NORMAL : PRINT "> FOR MENU";: GET X$: POKE  -16368,0: HOME : IF X$ =  CHR$(27)  THEN EF = 1
  98. 910  RETURN 
  99. 920  GOSUB 180:V = 10: FLASH :X$ = " SORTING EVENTS BY DATE": GOSUB 830: GOSUB 1010: FOR I = 1 TO 1500: NEXT : HOME : RETURN 
  100. 930  PRINT D$"PR#1": PRINT  CHR$(0)
  101. 940  PRINT D$"PR#0": RETURN 
  102. 950  REM 
  103. 960  REM   ****************
  104. 970  REM   *              *
  105. 980  REM   * SORT EVENTS  *
  106. 990  REM   *              *
  107. 1000  REM   ****************
  108. 1010  IF N = 1  THEN  RETURN : REM NO NEED TO SORT
  109. 1020 K = N -1: FOR I = 1 TO K: REM  BUBBLE SORT TO NUMERICALLY SORT EVENTS BY DATE
  110. 1030 L = N -I: FOR J = 1 TO L
  111. 1040  IF D(J) <D(J +1)  THEN 1070
  112. 1050 T = D(J):T$ = EV$(J):D(J) = D(J +1):EV$(J) = EV$(J +1):D(J +1) = T:EV$(J +1) = T$
  113. 1060  REM  SWAP COMPLETE
  114. 1070  NEXT : NEXT : RETURN 
  115. 1080  REM 
  116. 1090  REM    *** DISK WRITE ***
  117. 1100  REM 
  118. 1110  TEXT : GOSUB 180
  119. 1120  ONERR  GOTO 4120
  120. 1130 V = 10: INVERSE :X$ = " WRITING " +M$(F) +", " +YR$ +" ": GOSUB 830: NORMAL 
  121. 1140  PRINT 
  122. 1150  PRINT D$"OPEN"M$(F)YR$
  123. 1160  PRINT D$"WRITE"M$(F)YR$
  124. 1170  PRINT N
  125. 1180  IF N = 0  THEN  PRINT : PRINT D$"CLOSE"M$(F)YR$: PRINT : PRINT D$"DELETE"M$(F)YR$: RETURN 
  126. 1190  FOR K = 1 TO N: PRINT D(K)
  127. 1200 IN$ = EV$(K)
  128. 1210  PRINT IN$
  129. 1220  NEXT 
  130. 1230  PRINT D$"CLOSE"
  131. 1240  HOME : RETURN 
  132. 1250  TEXT : GOSUB 180: LET IN$ = " "
  133. 1260 V = 10: INVERSE :X$ = " READING " +M$(F) +", " +YR$ +" ": GOSUB 830: NORMAL 
  134. 1270  PRINT 
  135. 1280  ONERR  GOTO 4000: REM  FILE NOT FOUND
  136. 1290  PRINT D$"VERIFY "M$(F)YR$
  137. 1300  PRINT D$"OPEN"M$(F)YR$
  138. 1310  VTAB 11: CALL  -958
  139. 1320  PRINT D$"READ"M$(F)YR$
  140. 1330  INPUT N
  141. 1340  IF N = 0  THEN 1400: REM  NO EVENTS
  142. 1350  FOR I = 1 TO N
  143. 1360  INPUT D(I)
  144. 1370  CALL 768:IN$ =  MID$ (IN$,1)
  145. 1380 EV$(I) = IN$
  146. 1390  NEXT 
  147. 1400  PRINT D$"CLOSE"
  148. 1410  HOME : RETURN 
  149. 1420  REM  ******************
  150. 1430  REM  *                *
  151. 1440  REM  * TEXT FORMATTER *
  152. 1450  REM  *                *
  153. 1460  REM  ******************
  154. 1470  IF NC = 0  THEN NC = 40:MC = 40: REM  TEXT FORMATTER FROM NIBBLE 4/6 PAGE 118
  155. 1480  IF MC <NC  THEN MC = MC +40: GOTO 1480
  156. 1490 LM =  INT((MC -NC)/2) +1
  157. 1500  IF  LEFT$(A$,1) = " "  THEN A$ =  MID$ (A$,2): GOTO 1500
  158. 1510  IF  LEN(A$) < = NC  THEN 1560
  159. 1520 Y$ = A$: FOR J1 = NC +1 TO 1  STEP  -1: IF  MID$ (Y$,J1,1) = " "  THEN 1540
  160. 1530  NEXT :J1 = NC +1
  161. 1540 A$ =  LEFT$(Y$,J1 -1): GOSUB 1560: IF J1 >0  THEN A$ =  MID$ (Y$,J1)
  162. 1550  GOTO 1500
  163. 1560  HTAB LM: PRINT A$;: IF  LEN(A$) < >MC  THEN  PRINT 
  164. 1570 A$ = "": RETURN 
  165. 1580  REM 
  166. 1590  REM  ****************
  167. 1600  REM  *              *
  168. 1610  REM  *   DISPLAY    *
  169. 1620  REM  *              *
  170. 1630  REM  ****************
  171. 1640  TEXT 
  172. 1650 PR = 0: REM  PRINTER FLAG
  173. 1660  GOSUB 180:J = 1:V = 2:M1 = 1: GOSUB 840: PRINT : REM HOME & HEADING  
  174. 1670  FOR Z = 1 TO 40: PRINT "*";: NEXT : POKE 34,4
  175. 1680  REM MENU FOR 1MO,YR,MENU--->CHOICES 2230-2250  
  176. 1690 S = 3:V% = 9:H = 14:M1 = 2: GOTO 200
  177. 1700  GOSUB 190:S = 13: REM MENU FOR MONTH CHOICE JAN-DEC   
  178. 1710 M1 = 3:V% = 6:H = 15: GOTO 460: REM   HORIZONTAL MENU
  179. 1720 F2 = CS: GOTO 1750: REM   SAVE MONTH CHOICE - NEXT MENU FOR OUTPUT DEVICE 
  180. 1730 F1 = 0: GOTO 1700: REM   ONLY 1 MONTH
  181. 1740 F1 = 11:F2 = 1: REM  FULL YEAR  
  182. 1750  TEXT : GOSUB 190:S = 3:M1 = 1:J = 1::V% = 7:H = 10: GOSUB 840:M1 = 3: GOTO 200
  183. 1760  REM   SET 'F' FOR DISK READ 
  184. 1770 MC = 40:NC = 40: GOTO 1790
  185. 1780 MC = 80:NC = 80:PR = 1: GOTO 1790
  186. 1790  TEXT : GOSUB 190: FOR F = F2 TO F2 +F1
  187. 1800  PRINT : PRINT D$"PR#0"
  188. 1810  GOSUB 1250
  189. 1820  IF   NOT N  AND F1 = 11  THEN 2010
  190. 1830  IF   NOT N  THEN 2040
  191. 1840  GOSUB 3470
  192. 1850  IF PR  THEN  PRINT  CHR$(13);: PRINT D$"PR#1": PRINT  CHR$(9);"N"
  193. 1860  TEXT :V = 2:X$ = "EVENTS FOR " +M$(F) +", " +YR$: INVERSE : GOSUB 830: NORMAL : POKE 34,4: HOME 
  194. 1870  IF PR  THEN  PRINT : PRINT 
  195. 1880  FOR J = 1 TO N
  196. 1890 A$ = M$(F) +" " + STR$(D(J)) +", " +YR$ +" - " +EV$(J)
  197. 1900 L =  LEN(M$(F) +", " +YR$) + LEN( STR$(D(J))) +1
  198. 1910  IF PR  THEN  PRINT  CHR$(27); CHR$(88);: FOR I = 1 TO L: PRINT  CHR$(32);: NEXT 
  199. 1920  IF PR  THEN  PRINT  CHR$(27); CHR$(89);: PRINT  CHR$(12);: PRINT  CHR$(27); CHR$(114);: PRINT  CHR$(10): PRINT  CHR$(27); CHR$(102)
  200. 1930  GOSUB 1470: REM  PRINT STRING
  201. 1940  PRINT : IF PR  THEN 1960
  202. 1950  IF J <N  AND  PEEK(37) =  >19  THEN EF = 0: GOSUB 900: IF EF GOTO 3700
  203. 1960  NEXT J
  204. 1970  IF PR  THEN  PRINT : PRINT : PRINT : PRINT D$;"PR#0": PRINT  CHR$(9);"I": HOME 
  205. 1980  POKE  -16368,0: VTAB 22: HTAB 1: PRINT "ANY KEY TO CONTINUE..<";: INVERSE : PRINT "ESC";: NORMAL : PRINT "> FOR MENU";: GET X$: POKE  -16368,0: HOME : IF X$ =  CHR$(27)  THEN 3700
  206. 1990  TEXT : GOSUB 190
  207. 2000  IF PR  THEN  PRINT : PRINT D$;"PR#1"
  208. 2010  NEXT F
  209. 2020  PRINT : PRINT D$"PR#0"
  210. 2030  GOTO 1640: REM  DISPLAY CHOICES
  211. 2040  CALL 65338: CALL 65338: VTAB 6: GOSUB 2090
  212. 2050 V = 10:X$ = "THERE ARE NO EVENTS FOR " +M$(F) +" " +YR$: GOSUB 830:V = 12:X$ = "PRESS ANY KEY FOR MENU": GOSUB 830: GOSUB 2090: POKE  -16368,0
  213. 2060  VTAB 12: HTAB 32
  214. 2070  GET X$: IF   NOT N  THEN 3700
  215. 2080  GOTO 1640
  216. 2090  PRINT : PRINT : FOR I = 1 TO 40: PRINT "*";: NEXT : PRINT : RETURN 
  217. 2100  REM 
  218. 2110  REM  *******************
  219. 2120  REM  *                 *
  220. 2130  REM  * CREATE CALENDAR *
  221. 2140  REM  *                 *
  222. 2150  REM  *******************
  223. 2160  REM 
  224. 2170  TEXT 
  225. 2180 J = C
  226. 2190  GOSUB 190:V = 1:M1 = 1: GOSUB 840: REM   HOME & HEADING  
  227. 2200 V% = 6:H = 15: GOTO 460: REM  MENU
  228. 2210  GOSUB 180: GOSUB 840:V = 2: INVERSE :X$ = M$(CS): GOSUB 830: NORMAL 
  229. 2220  POKE 34,2: REM   SET TOP OF WINDOW
  230. 2230  PRINT : PRINT 
  231. 2240  INVERSE : PRINT "NOTE:": NORMAL :NC = 35:A$ = "THIS PART OF THE PROGRAM WILL DELETE ANY EXISTING EVENTS IN THE MONTH CHOSEN.": GOSUB 1470: PRINT 
  232. 2250 A$ = "TO ADD, CHANGE, OR DELETE ANY EVENTS RETURN TO THE MAIN MENU AND CHOOSE THE ADD/CHANGE/DELETE OPTION."
  233. 2260  GOSUB 1470: PRINT 
  234. 2270  GOSUB 880
  235. 2280  POKE  -16368,0: GET X$
  236. 2290  IF X$ =  CHR$(27)  THEN  TEXT : GOSUB 190: GOTO 3700
  237. 2300  GOSUB 180
  238. 2310 I = 1
  239. 2320  VTAB 4:NC = 40
  240. 2330  IF I +N *AD >39  THEN  PRINT  CHR$(7)"NO MORE ROOM IN THIS CALENDAR MONTH.": PRINT : PRINT "PRESS ANY KEY TO CONTINUE.": GET Z$: PRINT : ON   NOT (AD) GOTO 2590: RETURN 
  241. 2340 A$ = "ENTER THE DATE OF THE EVENT IN " +M$(C)
  242. 2350  GOSUB 1470: IF I < >1  THEN 2370
  243. 2360  GOSUB 870
  244. 2370  VTAB 14: HTAB 1: CALL  -868: PRINT M$(C)"(1-";N(C);") ";: INPUT "";IN$(I)
  245. 2380  IF (IN$(I) = "Q"  OR IN$(I) =  CHR$(113))  AND AD  THEN  RETURN : REM QUIT ADD ROUTINE 
  246. 2390  IF IN$(I) = "Q"  OR IN$(I) =  CHR$(113)  THEN 2590: REM  QUIT   
  247. 2400  IF IN$(I) = "0"  AND I <2  AND   NOT N  AND AD  THEN  VTAB 6:A$ = "NO ENTRIES": GOSUB 1470: GOTO 2370
  248. 2410  IF IN$(I) = "0"  AND I <2  AND   NOT AD  THEN  VTAB 6:A$ = "NO ENTRIES": GOSUB 1470: GOTO 2370
  249. 2420  IF IN$(I) = "0"  THEN  VTAB 6: FOR J = 1 TO N *AD +I -1:A$ = A$ + STR$(D(J)) +" ": NEXT : GOSUB 1470: GOTO 2370
  250. 2430 X =  VAL(IN$(I)): GOSUB 850: IF ER = 1  THEN ER = 0: POKE 34,0: POKE 35,24: GOTO 2320
  251. 2440  IF AD  THEN D(N +I) = X: GOTO 2460
  252. 2450 D(I) = X: REM  DATE OF EVENT
  253. 2460  GOSUB 190:V = 4:X$ = "ENTER THE EVENT(S) FOR THE DATE": GOSUB 830:X$ = M$(C) +" " + STR$(X):V = 5: GOSUB 830: PRINT : PRINT 
  254. 2470  FOR Z = 1 TO 40: PRINT "-";: NEXT : PRINT 
  255. 2480  CALL 768:IN$ =  MID$ (IN$,1)
  256. 2490 IN$(I) = IN$
  257. 2500  IF (IN$(I) = "Q"  OR IN$(I) =  CHR$(113))  AND AD  THEN  RETURN : REM QUIT ADD ROUTINE 
  258. 2510  IF  LEN(IN$(I)) >159  THEN IN$(I) =  LEFT$(IN$(I),159): VTAB 10: HTAB 1: CALL  -958: VTAB 11: PRINT "ENTRY TRUNCATED TO 159 CHARACTERS.": PRINT "START OVER(Y/N)? ";: CALL 65338: CALL 65338: POKE  -16368,0: GET X$: PRINT X$: ON X$ = "Y" GOTO 2460
  259. 2520  IF IN$(I) = "Q"  OR IN$(I) =  CHR$(113)  THEN 2590: REM   QUIT 
  260. 2530  IF IN$(I) = "0"  AND I <2  AND   NOT N  AND AD  THEN  VTAB 9:A$ = "NO ENTRIES -- ANY KEY TO CONTINUE": GOSUB 1470: VTAB 9: HTAB 34: POKE  -16368,0: GET X$: GOTO 2460
  261. 2540  IF IN$(I) = "0"  AND I <2  AND   NOT AD  THEN  VTAB 9:A$ = "NO ENTRIES - ANY KEY TO CONTINUE": GOSUB 1470: VTAB 9: HTAB 34: POKE  -16368,0: GET X$: GOTO 2460
  262. 2550  IF IN$(I) = "0"  THEN  VTAB 9: FOR J = 1 TO N +I -1:A$ = A$ + STR$(D(J)) +" ": NEXT : GOSUB 1470: VTAB 12:A$ = "ANY KEY TO CONTINUE..": GOSUB 1470: VTAB 12: HTAB 22: POKE  -16368,0: GET X$: GOTO 2460
  263. 2560  IF AD  THEN EV$(N +I) = IN$(I): GOTO 2580
  264. 2570 EV$(I) = IN$(I): REM  EVENT DESCRIPTION
  265. 2580 I = I +1: GOSUB 180: IF I +N *(AD) <40 GOTO 2320: REM  ANOTHER ENTRY
  266. 2590  IF I <2  THEN  TEXT : GOSUB 190: GOTO 3700
  267. 2600 N = I -1:F = C: GOSUB 920: GOSUB 1110: REM DISK WRITE ROUTINE AFTER SORT
  268. 2610  GOTO 2190: REM   ANOTHER MONTH?
  269. 2620  REM  ******************
  270. 2630  REM  *                *
  271. 2640  REM  * CHANGE/DELETE  *
  272. 2650  REM  *                *
  273. 2660  REM  ******************
  274. 2670  TEXT 
  275. 2680 M1 = 1:V% = 6:H = 15:V = 2:S = 3: GOSUB 180:J = 3: INVERSE : GOSUB 840: NORMAL :M1 = 4: GOTO 200
  276. 2690 FLAG = CS: REM   1=ADD 2=CHANGE/DELETE 3=MENU
  277. 2700  TEXT : GOSUB 190:M1 = 4:J = FLAG:V = 1: INVERSE : GOSUB 840: NORMAL : REM  HEADING 
  278. 2710  GOTO 460
  279. 2720 F = CS: GOSUB 1250: REM   READ FILE
  280. 2730  VTAB 3: PRINT MU$(4,FLAG): PRINT " IN ";M$(CS);" OK?";
  281. 2740 S = 2:H = 18:V% = 4:M1 = 5: GOTO 470
  282. 2750  ON FLAG GOTO 2760,2890,3700
  283. 2760  TEXT : GOSUB 190
  284. 2770 X$ = "ADD EVENT": INVERSE :V = 1: GOSUB 830: NORMAL : REM   HEADING
  285. 2780  PRINT : VTAB 2
  286. 2790  FOR I = 1 TO 40: PRINT "-";: NEXT 
  287. 2800  POKE 34,3: REM   TOP OF WINDOW
  288. 2810 AD = 1:C = F: GOSUB 2300: REM   ADD FLAG (AD) AND USE 'CREATE' ROUTINE  
  289. 2820 AD = 0: REM  CLEAR ADD FLAG
  290. 2830  GOSUB 180
  291. 2840  IF I <2  THEN 2670
  292. 2850 N = N +I -1: REM  INCREMENT # OF RECORDS
  293. 2860  GOSUB 920
  294. 2870  TEXT : GOSUB 190: GOSUB 1110
  295. 2880  GOTO 2670: REM  ADD/CHANGE MENU
  296. 2890  GOSUB 180
  297. 2900  IF CH = 1  THEN CH = 0: GOSUB 1110: REM   WRITE CHANGED FILE
  298. 2910  IF   NOT N  THEN  GOTO 2040
  299. 2920  VTAB 21: FOR K = 1 TO 40: PRINT "-";: NEXT : CALL  -958
  300. 2930  VTAB 22: HTAB 5: PRINT "<";: INVERSE : PRINT "RTN";: NORMAL : PRINT "> OR ";: INVERSE : PRINT "->";: NORMAL : PRINT " TO SCROLL FORWARD"
  301. 2940  VTAB 23: INVERSE : PRINT "<-";: NORMAL : PRINT " TO REVERSE SCROLL    ";: INVERSE : PRINT "'D'";: NORMAL : PRINT " TO DELETE"
  302. 2950  VTAB 24: PRINT "<";: INVERSE : PRINT "ESC";: NORMAL : PRINT "> FOR MENU          ";: INVERSE : PRINT "'C'";: NORMAL : PRINT " TO CHANGE";
  303. 2960  POKE 35,20: REM  SET WINDOW PROMPTS
  304. 2970  IF DL = 1  THEN DL = 0: RETURN 
  305. 2980 V = 2:M1 = 4:J = FLAG: GOSUB 840: FOR K = 1 TO 40: PRINT "-";: NEXT : POKE 34,3: REM  WINDOW
  306. 2990  FOR I = 1 TO N
  307. 3000  HOME 
  308. 3010  VTAB 5: PRINT "EVENT #";I; TAB( 10)" OF "N" ";: HTAB 17: PRINT "EVENT DATE="M$(F)" "D(I)" ";
  309. 3020  POKE 34,6: REM  BIGGER WINDOW
  310. 3030 A$ = EV$(I): VTAB 8: GOSUB 1470
  311. 3040  VTAB 24: HTAB 19: GET X$: POKE  -16368,0
  312. 3050  IF I = N  THEN  IF X$ =  CHR$(13)  OR X$ =  CHR$(21)  OR X$ =  CHR$(10)  THEN I = 1: GOTO 3000: REM   BACK TO BEGINNING   
  313. 3060  IF X$ =  CHR$(13)  OR X$ =  CHR$(21)  OR X$ =  CHR$(10)  THEN  NEXT 
  314. 3070  IF I = 1  AND (X$ =  CHR$(8)  OR X$ =  CHR$(11))  THEN I = N: GOTO 3000: REM  CONTINUE REVERSE SCROLL    
  315. 3080  IF X$ =  CHR$(8)  OR X$ =  CHR$(11)  THEN I = I -1: GOTO 3000
  316. 3090  IF X$ = "D"  OR X$ =  CHR$(100)  THEN 3140: REM DELETE RECORD AFTER CHECKING FOR SURE 
  317. 3100  IF X$ = "C"  OR X$ =  CHR$(99)  THEN 3230: REM CHANGE RECORD & CHECK FOR SURE
  318. 3110  IF X$ =  CHR$(27)  AND CH = 1  THEN  GOSUB 1110:CH = 0: GOTO 2670
  319. 3120  IF X$ =  CHR$(27)  THEN 2670
  320. 3130  GOTO 3040
  321. 3140  POKE 35,24: HOME : VTAB 10:A$ = "ARE YOU SURE YOU WANT TO DELETE THIS EVENT FROM THE FILE? "
  322. 3150  GOSUB 1470
  323. 3160 S = 2:H = 23:V% = 11:M1 = 6: GOTO 470
  324. 3170  IF CS = 1  THEN 3340: REM  DELETE IT
  325. 3180 DL = 1: POKE 35,24: GOSUB 2890: GOTO 3000: REM  RESET SCREEN
  326. 3190  REM  **********
  327. 3200  REM  * CHANGE *
  328. 3210  REM  **********
  329. 3220  REM 
  330. 3230  POKE 35,24: POKE 34,21: REM  SET INSTRUCTIONS WINDOW
  331. 3240  HOME : PRINT " ENTER NEW EVENT -OR- <";: INVERSE : PRINT "RTN";: NORMAL : PRINT "> TO RETAIN"
  332. 3250  POKE 34,13: POKE 35,20: HOME : CALL 768:IN$ =  MID$ (IN$,1):X$ = IN$
  333. 3260  IF X$ = ""  THEN CH = 0: GOTO 3180
  334. 3270 EV$(I) = X$: POKE 34,6: POKE 35,20: HOME : VTAB 8:A$ = EV$(I): GOSUB 1470
  335. 3280 CH = 1: GOTO 3180
  336. 3290  REM 
  337. 3300  REM  **********
  338. 3310  REM  * DELETE *
  339. 3320  REM  **********
  340. 3330  REM 
  341. 3340  HOME :CH = 1: REM  CHANGE FILE FLAG
  342. 3350  IF N = 1  THEN N = 0:X$ =  CHR$(27): GOTO 3110
  343. 3360 V = 10:X$ = " DELETING EVENT ": FLASH : GOSUB 830: NORMAL 
  344. 3370  FOR J = 1 TO 1000: NEXT 
  345. 3380  IF I <N  THEN  FOR J = I TO N -1:D(J) = D(J +1):EV$(J) = EV$(J +1): NEXT :N = N -1: GOTO 2890
  346. 3390  IF I = N  THEN N = N -1: REM  LAST ENTRY IN FILE
  347. 3400  GOTO 2890
  348. 3410  REM 
  349. 3420  REM  ***********
  350. 3430  REM  *   DRAW  *
  351. 3440  REM  * CALENDAR*
  352. 3450  REM  ***********
  353. 3460  REM 
  354. 3470  TEXT : GOSUB 190:M = N(F):B = 5:H = 3: REM    M=DAYS IN MONTH--H=HORIZONTAL OFFSET--B=BOX WIDTH
  355. 3480  PRINT 
  356. 3490 V = 1:X$ = M$(F) +", " +YR$: GOSUB 830
  357. 3500 NR = 5 -(F = 2  AND FM(2) = 0) +(FM(F) +M >35): FOR I = 0 TO NR: HTAB H
  358. 3510  VTAB (I +1) *H: FOR J = 1 TO 36: PRINT  CHR$(45);: NEXT J,I
  359. 3520  FOR J = H TO NR *H +H: VTAB J: FOR I = 0 TO 7: HTAB B *I +H: PRINT  CHR$(33);: NEXT I,J
  360. 3530  FOR I = 1 TO M:D = I +FM(F) -1:DX = D/7:DD =  INT(7 *(DX - INT(DX) +.00001)):WK =  INT(DX)
  361. 3540  VTAB ((WK +1) *3) +1: HTAB DD *5 +4: PRINT I;: NEXT 
  362. 3550  FOR I = 1 TO N
  363. 3560 D = D(I) +FM(F) -1:DX = D/7:CL =  INT(7 *(DX - INT(DX) +.00001))
  364. 3570 R =  INT(DX)
  365. 3580  VTAB ((R +1) *3) +2: HTAB CL *5 +7: FLASH : PRINT "X": NORMAL 
  366. 3590  NEXT 
  367. 3600  IF PR  THEN 3620
  368. 3610  VTAB 22: HTAB 6: PRINT "'P' TO PRINT SCREEN"
  369. 3620  POKE  -16368,0: VTAB 23: HTAB 1: PRINT "ANY KEY TO CONTINUE..<";: INVERSE : PRINT "ESC";: NORMAL : PRINT "> FOR MENU";: GET X$: POKE  -16368,0: IF X$ =  CHR$(27)  THEN 3700
  370. 3630  IF PR  THEN 3660
  371. 3640  IF X$ = "P"  OR X$ =  CHR$(112)  THEN  POKE 8,20: VTAB 20: PRINT : GOSUB 930: GOSUB 4460: POKE 8,23: PRINT D$"PR#1": PRINT  CHR$(13);: PRINT D$"PR#0": GOTO 3680
  372. 3650  HOME : RETURN 
  373. 3660  VTAB 22: HTAB 1: CALL  -958: VTAB 22: PRINT : REM  CLEAR BOTTOM OF SCREEN
  374. 3670  IF PR  THEN  POKE 8,18: GOSUB 930: GOSUB 4460: REM PRINT SCREEN  
  375. 3680  POKE  -16368,0: VTAB 21: CALL  -958: VTAB 22: HTAB 1: PRINT "ANY KEY TO CONTINUE..";: PRINT "<";: INVERSE : PRINT "ESC";: NORMAL : PRINT "> FOR MENU";: GET X$: ON X$ =  CHR$(27) GOTO 3700: HOME : RETURN : REM  BACK TO PRINT EVENTS
  376. 3690  GOSUB 190: VTAB 10: HTAB 18: PRINT "END": END 
  377. 3700  TEXT : HOME : PRINT "****************************************";:
  378. 3710  HTAB 1: PRINT "*";: HTAB 40: PRINT "*";
  379. 3720  PRINT  TAB( 1)"*"; TAB( 10)"NIBBLE DESK CALENDAR"; TAB( 40)"*";
  380. 3730  PRINT  TAB( 1)"*"; TAB( 19)"BY"; TAB( 40)"*";
  381. 3740  PRINT  TAB( 1)"*"; TAB( 13)"MARK R. CRAVEN"; TAB( 40)"*";
  382. 3750  HTAB 1: PRINT "*";: HTAB 40: PRINT "*";
  383. 3760  HTAB 1: PRINT "*  COPYRIGHT 1985 BY MICROSPARC, INC.  *";
  384. 3770  HTAB 1: PRINT "*";: HTAB 40: PRINT "*";
  385. 3780  PRINT "**************";: INVERSE : PRINT " MAIN  MENU ";: NORMAL : PRINT "**************";:
  386. 3790 H = 10:V% = 10:S = 5:C = 1:VS% = 2:M1 = 1:FLAG = 0: REM  PARAMETERS FOR MAIN MENU 
  387. 3800  GOTO 240
  388. 3810  REM MAIN MENU DATA  MU$(1,X)
  389. 3820  DATA  "DISPLAY EVENT CALENDAR  ","CREATE CALENDAR MONTH   ","ADD/CHANGE/DELETE EVENTS","DISPLAY/CHANGE YEAR     ","QUIT                    "
  390. 3830  REM MONTHS OF YEAR DATA M$(X)
  391. 3840  DATA  "JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER"
  392. 3850  DATA "MAIN  MENU"
  393. 3860  REM  9020-9050=INPUT ROUTINE DATA
  394. 3870  DATA 162,0,32,117,253,160,2  
  395. 3880  DATA 138,145,105,200,169,0  
  396. 3890  DATA 145,105,200,169,2,145
  397. 3900  DATA 105,76,57,213   
  398. 3910  REM  DAYS IN EACH MONTH N(X)
  399. 3920  DATA  31,29,31,30,31,30,31,31,30,31,30,31
  400. 3930  REM DISPLAY EVENT MENU MU$(2,X)
  401. 3940  DATA      "ONE MONTH    ","FULL YEAR    ",  "MAIN MENU
  402. 3950  REM DISPLAY PRINT MENU MU$(3,X)
  403. 3960  DATA    "SCREEN ONLY     ","PRINTER - 80 COL","MAIN  MENU      "   
  404. 3970  REM ADD/CHANGE/DELETE MENU MU$(4,X)
  405. 3980  DATA     "ADD  EVENT         ","CHANGE/DELETE EVENT","MAIN  MENU         "
  406. 3990  DATA  "YES","NO "
  407. 4000  IF  PEEK(222) = 5  THEN  PRINT  PEEK(222): GOTO 4030
  408. 4010  IF  PEEK(222) = 6  THEN 4060
  409. 4020  GOTO 4120
  410. 4030  PRINT D$"OPEN"M$(F)YR$
  411. 4040  PRINT D$;"CLOSE"M$(F)YR$
  412. 4050  PRINT D$;"DELETE"M$(F)YR$
  413. 4060  PRINT D$"OPEN "M$(F)YR$
  414. 4070  PRINT D$"WRITE"M$(F)YR$
  415. 4080  PRINT 0,0,""
  416. 4090  PRINT D$"CLOSE"M$(F)YR$
  417. 4100  POKE 216,0
  418. 4110  RESUME 
  419. 4120  TEXT : HOME :V = 8
  420. 4130  IF  PEEK(222) = 4  THEN X$ = " DISK WRITE PROTECTED ": GOSUB 830: GOTO 4200
  421. 4140  IF  PEEK(222) = 8  THEN X$ = " I/O ERROR -- CHECK DRIVE DOOR ": GOSUB 830: GOTO 4200
  422. 4150  IF  PEEK(222) = 9  THEN X$ = " DISK FULL -- INSERT ANOTHER DISK ": GOSUB 830: GOTO 4200
  423. 4160  IF  PEEK(222) = 10  THEN X$ = "FILE IS LOCKED--UNLOCK ? (Y/N) ?": GOSUB 830: CALL 65338: CALL 65338: POKE  -16368,0: GET X$: IF  LEFT$(X$,1) = "N"  OR  LEFT$(X$,1) =  CHR$(110)  THEN  PRINT : PRINT " CANNOT CONTINUE ": END 
  424. 4170  PRINT :V = 8: IF  PEEK(222) = 6  THEN X$ = "PROGRAM NOT ON DISK": TEXT : HOME : GOSUB 830:V = 9:X$ = "CANNOT CONTINUE": GOSUB 830: END 
  425. 4180  IF  PEEK(222) = 10  THEN X$ = " UNLOCKING FILE IN PROGRESS": VTAB 8: CALL  -868: GOSUB 830: PRINT : PRINT D$"UNLOCK"M$(F)YR$: GOSUB 1110: GOTO 4200: REM WRITE FILE AGAIN 
  426. 4190  HOME : PRINT "ERROR " PEEK(222)" IN LINE " PEEK(219) *256 + PEEK(218)
  427. 4200  VTAB 20: HTAB 1: PRINT "PRESS ANY KEY TO CONTINUE..";: POKE  -16368,0: GET X$
  428. 4210 DL = 0
  429. 4220 M1 =  PEEK(894):CS =  PEEK(895): ON  PEEK(896) +1 GOTO 400,730: REM   BACK TO LAST USED MENU AFTER ERROR 
  430. 4230  REM ** GET NEW YEAR
  431. 4240  HOME : VTAB 6: PRINT "CURRENT YEAR: "YR$: VTAB 22: PRINT "<RETURN> TO KEEP SAME YEAR"
  432. 4250  VTAB 12: CALL  -868: VTAB 12: PRINT "INPUT NEW YEAR (YYYY): ";: INPUT "";YY$
  433. 4260  IF YY$ = "" GOTO 3700
  434. 4270  IF  LEN(YY$) < >4 GOTO 4250
  435. 4280  IF  VAL(YY$) <1753  OR  VAL(YY$) >9999 GOTO 4250
  436. 4290 YR$ = YY$:Y =  INT( VAL(YR$))
  437. 4300  GOSUB 4310: GOTO 3700
  438. 4310  REM ** CALCULATE FIRST OF MONTH
  439. 4320 N(2) = 28 +((Y/4 - INT(Y/4)) = 0) -((Y/100 - INT(Y/100)) = 0) +((Y/400 - INT(Y/400)) = 0)
  440. 4330  GOSUB 4360:FM(1) = FM
  441. 4340  FOR I = 2 TO 12:X = (FM(I -1) +N(I -1) +.00001)/7:FM(I) =  INT(7 *(X - INT(X))): NEXT 
  442. 4350  RETURN 
  443. 4360  REM  ***ZELLER'S CONGRUENCE LAW***
  444. 4370 CN =  INT(Y/100): IF  RIGHT$( STR$(Y),2) = "00"  THEN CN = CN -1
  445. 4380 D = (Y -(100 *CN)) -1: IF D =  -1  THEN D = 99
  446. 4390 K = 1
  447. 4400 M = 11
  448. 4410 X = ( INT(2.6 *M -.2) +K +D + INT(D/4) + INT(CN/4) -(2 *CN))/7
  449. 4420 G =  ABS(X - INT(X))
  450. 4430 FM =  INT(7 *G +.00001)
  451. 4440  RETURN 
  452. 4450  REM ** SCREEN DUMP ROUTINE
  453. 4460  GOTO 4480
  454. 4470  FOR J = I TO I +39:A =  PEEK(J):A = A +(A <32) *192:A = A +(A <64) *128:A = A +(A <96) *64:A = A +(A <128) *64:A = A +(A <160) *64: PRINT  CHR$(A);: NEXT J: PRINT  CHR$(13);: RETURN 
  455. 4480  PRINT  CHR$(4)"PR#1": PRINT  CHR$(9)"80N"
  456. 4490  FOR I = 1024 TO 1920  STEP 128: GOSUB 4470: NEXT I
  457. 4500  FOR I = 1064 TO 1960  STEP 128: GOSUB 4470: NEXT I
  458. 4510  FOR I = 1104 TO 1616 -384 *(NR <6)  STEP 128: GOSUB 4470: NEXT I
  459. 4520  PRINT  CHR$(4)"PR#0"
  460. 4530  RETURN