home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib22b.dsk / POSTMASTER.bas < prev    next >
BASIC Source File  |  2023-02-26  |  13KB  |  324 lines
  1. 10  REM   ***********************
  2. 20  REM   *      POSTMASTER     *
  3. 30  REM   * BY FINN ERIK LOVDAL *
  4. 40  REM   * COPYRIGHT (C)  1984 *
  5. 50  REM   * BY MICROSPARC, INC. *
  6. 60  REM   * CONCORD, MA   01742 *
  7. 70  REM   ***********************
  8. 80  REM 
  9. 90  TEXT : POKE 34,0: POKE 216,0: HOME 
  10. 100  GOSUB 220: REM INITIALIZE
  11. 110  GOSUB 410: REM TITLE
  12. 120  GOSUB 2960: REM CHECK FOR FILE
  13. 130  ONERR  GOTO 150
  14. 140  VTAB 23: HTAB 9: PRINT "PRESS ANY KEY TO START": GOSUB 3190: GOTO 160
  15. 150  CALL  -3288
  16. 160  GOSUB 500
  17. 170 HB = 1: HOME : INVERSE : GOSUB 3240: GOSUB 660: GOSUB 3240: NORMAL 
  18. 180  ON SE GOSUB 700,860,1490,1550,1640,1790,1880,1930,2130: GOTO 160
  19. 190  REM =========
  20. 200  REM MAIN INIT
  21. 210  REM =========
  22. 220 D$ =  CHR$(4)
  23. 230 AM = 9:CL = 1
  24. 240  DIM M$(AM)
  25. 250  DIM L$(10),P(3),K$(100,9)
  26. 260 M$(0) = "MAIN MENU "
  27. 270 M$(1) = "CREATE NEW LABEL"
  28. 280 M$(2) = "PRINT CURRENT LABEL "
  29. 290 M$(3) = "VIEW CURRENT LABEL"
  30. 300 M$(4) = "LOAD OLD LABEL"
  31. 310 M$(5) = "SAVE CURRENT LABEL"
  32. 320 M$(6) = "DELETE OLD LABEL"
  33. 330 M$(7) = "VIEW OLD LABELS "
  34. 340 M$(8) = "SORT LABELS "
  35. 350 M$(9) = "WRITE FILE AND QUIT "
  36. 360 L$(0) = "................................": REM 32 DOTS
  37. 370  RETURN 
  38. 380  REM ==========
  39. 390  REM MAIN TITLE
  40. 400  REM ==========
  41. 410  VTAB 3: INVERSE : GOSUB 3240
  42. 420  PRINT "            NIBBLE POSTMASTER           ";: GOSUB 3240: REM 12 AND 11 SPACES
  43. 430  PRINT "           BY FINN ERIK LOVDAL          ";: GOSUB 3240: REM 11 AND 10 SPACES
  44. 440  PRINT "** COPYRIGHT 1984 BY MICROSPARC, INC. **";: GOSUB 3240
  45. 450  NORMAL 
  46. 460  RETURN 
  47. 470  REM =========
  48. 480  REM MAIN MENU
  49. 490  REM =========
  50. 500  HOME :HB = 1:I = 0: INVERSE : GOSUB 3240: GOSUB 660: GOSUB 3240: NORMAL 
  51. 510 BB = 0: FOR I = 1 TO AM:B =  LEN(M$(I)): IF B >BB  THEN BB = B
  52. 520  NEXT I
  53. 530 HB =  INT((40 -(BB +4))/2) +1
  54. 540 VB =  INT((24 -(AM +5))/2) +4
  55. 550  VTAB VB +AM +1: HTAB 1: FOR I = 1 TO 40: PRINT  CHR$(45);: NEXT 
  56. 560  VTAB VB +AM +3: PRINT "  <= => SELECT           <RTN> EXECUTE  "
  57. 570  FOR I = 1 TO AM: GOSUB 650: NEXT :I = 1: INVERSE : GOSUB 650: NORMAL 
  58. 580  GOSUB 3190
  59. 590  IF X = 13  THEN SE = I: RETURN 
  60. 600  IF X = 21  AND I <AM  THEN  GOSUB 650:I = I +1: INVERSE : GOSUB 650: NORMAL : GOTO 580
  61. 610  IF X = 8  AND I >1  THEN  GOSUB 650:I = I -1: INVERSE : GOSUB 650: NORMAL : GOTO 580
  62. 620  IF X = 21  AND I = AM  THEN  GOSUB 650:I = 1: INVERSE : GOSUB 650: NORMAL : GOTO 580
  63. 630  IF X = 8  AND I = 1  THEN  GOSUB 650:I = AM: INVERSE : GOSUB 650: NORMAL : GOTO 580
  64. 640  GOTO 580
  65. 650  VTAB VB +I -1: HTAB HB
  66. 660  PRINT  SPC( ((40 -2 *HB - LEN(M$(I)))/2) +1);M$(I); SPC( ((40 -2 *HB - LEN(M$(I)))/2) +1): RETURN 
  67. 670  REM ================
  68. 680  REM CREATE NEW LABEL
  69. 690  REM ================
  70. 700  IF L$(1) < >""  THEN  GOSUB 2860
  71. 710  VTAB 10: HTAB 1
  72. 720  FOR I = 1 TO 9: PRINT "  "I" "L$(0): NEXT : PRINT " 10 "L$(0)
  73. 730  VTAB 23: HTAB 12: PRINT "<.> TO END INPUT"
  74. 740 VV = 9:C = 0
  75. 750 VV = VV +1:C = C +1: VTAB VV: HTAB 5: GOSUB 3110:L$(C) = A$: IF L$(C) = "."  THEN L$(C) = "": GOTO 780
  76. 760  IF C = 10  THEN C = 11: GOTO 780
  77. 770  GOTO 750
  78. 780 C = C -1: VTAB 10: HTAB 1: CALL  -958: GOSUB 3230
  79. 790  VTAB 20: FOR I = 1 TO 40: PRINT  CHR$(95);: NEXT 
  80. 800  VTAB 23: HTAB 11: PRINT "IS THIS CORRECT ? ";: GOSUB 3210
  81. 810  IF X = 78  THEN  GOSUB 2910
  82. 820  RETURN 
  83. 830  REM ===================
  84. 840  REM PRINT CURRENT LABEL
  85. 850  REM ===================
  86. 860  IF L$(1) = ""  THEN  RETURN 
  87. 870  VTAB 6: GOSUB 3230
  88. 880  VTAB 16: FOR II = 1 TO 40: PRINT  CHR$(95);: NEXT 
  89. 890  VTAB 20: HTAB 11: PRINT "PRINT THIS LABEL ? ";: GOSUB 3210
  90. 900  IF X = 78  THEN  RETURN 
  91. 910  VTAB 18: HTAB 1: CALL  -958
  92. 920  PRINT "ENHANCED CHARACTERS ?": PRINT "ENLARGED CHARACTERS ?": PRINT "CONDENSED CHARACTERS ?"
  93. 930  VTAB 23: PRINT "<SPACE> TO FLIP         <RTN> TO ACCEPT"
  94. 940  FOR V = 18 TO 20: VTAB V: HTAB 26: GOSUB 1450: NEXT 
  95. 950  FOR V = 18 TO 20
  96. 960  VTAB V: HTAB 35: GET A$: IF A$ < > CHR$(32)  AND A$ < > CHR$(13)  THEN 960
  97. 970  IF A$ =  CHR$(13)  THEN P(V -17) = 1: GOTO 990
  98. 980  VTAB V: HTAB 26: GOSUB 1440:P(V -17) = 0
  99. 990  NEXT V
  100. 1000  VTAB 23: PRINT "               ";: REM 15 SPACES
  101. 1010  VTAB 21: HTAB 1: CALL  -958: PRINT "START PRINTING IN COLUMN";: HTAB 28: PRINT CL;: HTAB 34: INPUT " ";A$: IF A$ = ""  THEN 1040
  102. 1020 CL =  VAL(A$): IF CL <1  OR CL >70  THEN CL = 1: GOTO 1010
  103. 1030  VTAB 21: HTAB 28: CALL  -868: PRINT CL;
  104. 1040  VTAB 23: HTAB 1: CALL  -868: HTAB 11: PRINT "IS THIS CORRECT ? ";: GOSUB 3210
  105. 1050  IF X = 78  THEN 910
  106. 1060 CC$ = "": FOR SP = 1 TO CL -1:CC$ = CC$ +" ": NEXT : IF CL = 1  THEN CC$ = ""
  107. 1070 I$ =  CHR$(9) +"80N": REM MAX CHAR. PER LINE
  108. 1080 T1$ =  CHR$(27) + CHR$(69): REM ENHANCED PRINT ON
  109. 1090 C1$ =  CHR$(27) + CHR$(70): REM ENHANCED PRINT OFF
  110. 1100 T2$ =  CHR$(14): REM ENLARGED PRINT ON
  111. 1110 C2$ =  CHR$(20): REM ENLARGED PRINT OFF
  112. 1120 T3$ =  CHR$(15): REM CONDENSED PRINT ON
  113. 1130 C3$ =  CHR$(18): REM CONDENSED PRINT OFF
  114. 1140  IF P(1)  THEN G1$ = T1$
  115. 1150  IF   NOT P(1)  THEN G1$ = ""
  116. 1160  IF P(2)  THEN G2$ = T2$
  117. 1170  IF   NOT P(2)  THEN G2$ = ""
  118. 1180  IF P(3)  THEN G3$ = T3$
  119. 1190  IF   NOT P(3)  THEN G3$ = ""
  120. 1200 GG$ = I$ +G1$ +G2$ +G3$
  121. 1210 G$ = C1$ +C2$ +C3$
  122. 1220  VTAB 18: HTAB 1: CALL  -958: PRINT 
  123. 1230  PRINT "         TURN THE PRINTER ";: INVERSE : PRINT "ON";: NORMAL : PRINT ".": PRINT "   PRINTING WILL START IN COLUMN ";CL;"."
  124. 1240  PRINT "     HIT <SPACE> TO START PRINTING,": PRINT "<ESC> TO ABORT AND RETURN TO MAIN MENU "
  125. 1250  GOSUB 3190: IF X < >32  AND X < >27  THEN 1250
  126. 1260  IF X = 27  THEN  RETURN 
  127. 1270  FOR II = 10 TO 1  STEP  -1
  128. 1280  IF L$(II) < >""  THEN C = II: GOTO 1300
  129. 1290  NEXT II
  130. 1300  PRINT D$"PR# 1": FOR I = 1 TO C: PRINT GG$ +CC$ +L$(I) +G$: NEXT : PRINT D$"PR# 0"
  131. 1310  VTAB 18: HTAB 1: CALL  -958: PRINT 
  132. 1320  PRINT "  HIT <SPACE> TO POSITION NEXT LABEL,": PRINT : PRINT : PRINT "          <RTN> TO CONTINUE"
  133. 1330  VTAB 20: GOSUB 3190: IF X < >32  AND X < >13  THEN 1330
  134. 1340  IF X = 13  THEN 1370
  135. 1350  PRINT D$"PR# 1": PRINT : PRINT D$"PR# 0"
  136. 1360  GOTO 1330
  137. 1370  PRINT : VTAB 18: HTAB 1: CALL  -958
  138. 1380  VTAB 20: HTAB 8: PRINT "PRINT SAME LABEL AGAIN ? ";: GOSUB 3210
  139. 1390  IF X = 78  THEN  RETURN 
  140. 1400  PRINT "Y"
  141. 1410  VTAB 22: HTAB 8: PRINT "SAME PRINTER SETTINGS ? ";: GOSUB 3210
  142. 1420  IF X = 78  THEN 910
  143. 1430  GOTO 1220
  144. 1440  PRINT "(Y/";: INVERSE : PRINT "N";: NORMAL : PRINT ")";: RETURN 
  145. 1450  PRINT "(";: INVERSE : PRINT "Y";: NORMAL : PRINT "/N)";: RETURN 
  146. 1460  REM ==================
  147. 1470  REM VIEW CURRENT LABEL
  148. 1480  REM ==================
  149. 1490  IF L$(1) = ""  THEN  RETURN 
  150. 1500  VTAB 10: GOSUB 3230: VTAB 23: PRINT "HIT ANY KEY TO RETURN TO MAIN MENU .....";: GOSUB 3190
  151. 1510  RETURN 
  152. 1520  REM ==============
  153. 1530  REM LOAD OLD LABEL
  154. 1540  REM ==============
  155. 1550  GOSUB 2600: GOSUB 2400
  156. 1560  VTAB 23: HTAB 11: PRINT "LOAD THIS LABEL ? ";: GOSUB 3210
  157. 1570  IF X = 78  THEN  RETURN 
  158. 1580  IF L$(1) < >""  THEN  GOSUB 2860
  159. 1590  FOR II = 1 TO 10:L$(II) = K$(Q,II -1): NEXT 
  160. 1600  RETURN 
  161. 1610  REM ==================
  162. 1620  REM SAVE CURRENT LABEL
  163. 1630  REM ==================
  164. 1640  IF L$(1) = ""  THEN  RETURN 
  165. 1650  VTAB 10: GOSUB 3230
  166. 1660  VTAB 23: HTAB 11: PRINT "SAVE THIS LABEL ? ";: GOSUB 3210
  167. 1670  IF X = 78  THEN  RETURN 
  168. 1680  GOSUB 2600
  169. 1690 CH = 1
  170. 1700 N = N +1: IF N >99  THEN 1730
  171. 1710  FOR I = 1 TO 10:K$(N,I -1) = L$(I): NEXT : HOME : VTAB 12: HTAB 10: PRINT "CURRENT LABEL SAVED": VTAB 23: PRINT "HIT ANY KEY TO RETURN TO MAIN MENU.....";: GOSUB 3190
  172. 1720  RETURN 
  173. 1730  VTAB 10: HTAB 1: CALL  -958: VTAB 15: HTAB 10
  174. 1740  INVERSE : PRINT "FILE IS FULL " CHR$(7) CHR$(7): NORMAL : VTAB 23: PRINT "HIT ANY KEY TO RETURN TO MAIN MENU .....";: GOSUB 3190
  175. 1750  RETURN 
  176. 1760  REM ================
  177. 1770  REM DELETE OLD LABEL
  178. 1780  REM ================
  179. 1790  GOSUB 2600: GOSUB 2400
  180. 1800  VTAB 23: HTAB 10: PRINT "DELETE THIS LABEL ? ";: GOSUB 3210
  181. 1810  IF X = 78  THEN  RETURN 
  182. 1820  FOR JJ = Q TO N: FOR II = 0 TO 9:K$(JJ,II) = K$(JJ +1,II): NEXT II: NEXT JJ
  183. 1830 N = N -1:CH = 1
  184. 1840  RETURN 
  185. 1850  REM ===============
  186. 1860  REM VIEW OLD LABELS
  187. 1870  REM ===============
  188. 1880  GOSUB 2600: GOSUB 2400
  189. 1890  RETURN 
  190. 1900  REM ===========
  191. 1910  REM SORT LABELS
  192. 1920  REM ===========
  193. 1930  VTAB 15: HTAB 5: PRINT "THIS SORT WILL TAKE SOME TIME"
  194. 1940  PRINT : HTAB 12: PRINT "OK TO PROCEED ? ": GOSUB 3210
  195. 1950  IF X = 78  THEN  RETURN 
  196. 1960  GOSUB 2600: IF N =  -1  THEN  RETURN 
  197. 1970 CH = 1
  198. 1980  VTAB 8: HTAB 14: CALL  -958: PRINT "SORTING....."
  199. 1990  VTAB 10: POKE 34,10
  200. 2000 J =  -1
  201. 2010 J = J +1: IF J = N  THEN  HTAB 5: PRINT K$(J,0): GOTO 2060
  202. 2020 K = J
  203. 2030 K = K +1: IF K >N  THEN  HTAB 5: PRINT K$(J,0): GOTO 2010
  204. 2040  IF  LEFT$(K$(J,0),5) > LEFT$(K$(K,0),5)  THEN  FOR II = 0 TO 9:TEMP$ = K$(J,II):K$(J,II) = K$(K,II):K$(K,II) = TEMP$: NEXT 
  205. 2050  GOTO 2030
  206. 2060  POKE 34,0: VTAB 8: HTAB 1: CALL  -958
  207. 2070  VTAB 15: HTAB 11: PRINT J +1;" LABELS SORTED"
  208. 2080  VTAB 23: PRINT "HIT ANY KEY TO RETURN TO MAIN MENU.....";: GOSUB 3190
  209. 2090  RETURN 
  210. 2100  REM ====
  211. 2110  REM QUIT
  212. 2120  REM ====
  213. 2130  IF   NOT CH  THEN 2310
  214. 2140  ONERR  GOTO 2320
  215. 2150  VTAB 15: HTAB 12: PRINT "PLEASE WAIT....."
  216. 2160  PRINT D$"OPEN LABEL.DATA"
  217. 2170  PRINT D$"CLOSE"
  218. 2180  PRINT D$"DELETE LABEL.DATA"
  219. 2190  PRINT D$"OPEN LABEL.DATA"
  220. 2200  PRINT D$"WRITE LABEL.DATA"
  221. 2210  PRINT N: IF N =  -1  THEN 2300
  222. 2220  FOR J = 0 TO N
  223. 2230  FOR I = 0 TO 9
  224. 2240  FOR S = 1 TO  LEN(K$(J,I))
  225. 2250  PRINT  MID$ (K$(J,I),S,1);
  226. 2260  NEXT S
  227. 2270  PRINT  CHR$(92)
  228. 2280  NEXT I
  229. 2290  NEXT J
  230. 2300  PRINT D$"CLOSE LABEL.DATA"
  231. 2310  POKE 216,0: HOME : GOSUB 410: PRINT : PRINT : END 
  232. 2320  CALL  -3288: POKE 216,0: VTAB 15: HTAB 12
  233. 2330  PRINT  CHR$(7)" ***  ERROR  *** " CHR$(7): PRINT : PRINT 
  234. 2340  PRINT "CHECK YOUR DISK AND PRESS <RETURN> TO": PRINT "TRY AGAIN."
  235. 2350  GET W$: PRINT 
  236. 2360  VTAB 15: HTAB 1: CALL  -958: GOTO 2140
  237. 2370  REM ==============
  238. 2380  REM DISPLAY LABELS
  239. 2390  REM ==============
  240. 2400 R =  -1
  241. 2410  VTAB 10: CALL  -958: IF R = N  THEN  POP : RETURN 
  242. 2420 R = R +1: HTAB 5: PRINT K$(R,0): IF R <N  AND  VAL( RIGHT$( STR$(R),1)) <9  THEN 2420
  243. 2430  IF SE = 7  THEN 2450
  244. 2440  FOR S = 0 TO  VAL( RIGHT$( STR$(R),1)): VTAB S +10: HTAB 1: PRINT "<"S">";: NEXT 
  245. 2450  VTAB 23: HTAB 1
  246. 2460  IF SE = 4  THEN  PRINT "<S> STOP     <#> LOAD     <RTN> CONTINUE";
  247. 2470  IF SE = 6  THEN  PRINT "<S> STOP    <#> DELETE    <RTN> CONTINUE";
  248. 2480  IF SE = 7  THEN  PRINT "<S> STOP                  <RTN> CONTINUE";
  249. 2490  GOSUB 3190
  250. 2500  IF X = 83  THEN  POP : RETURN 
  251. 2510  IF X = 13  THEN 2410
  252. 2520  IF X <48  OR X >57  OR SE = 7  THEN 2490
  253. 2530 Q = 10 *( VAL( LEFT$( STR$(R),1))) +X -48: IF R <10  THEN Q = X -48
  254. 2540  VTAB 10: HTAB 1: CALL  -958
  255. 2550  FOR II = 0 TO 9: HTAB 5: PRINT K$(Q,II): NEXT 
  256. 2560  RETURN 
  257. 2570  REM ==============
  258. 2580  REM READ FROM DISK
  259. 2590  REM ==============
  260. 2600  IF K$(0,0) < >""  OR N =  -1  THEN  RETURN 
  261. 2610  ONERR  GOTO 2770
  262. 2620  VTAB 10: HTAB 1: CALL  -958: VTAB 15: HTAB 12: PRINT "PLEASE WAIT....."
  263. 2630  PRINT D$"OPEN LABEL.DATA"
  264. 2640  PRINT D$"READ LABEL.DATA"
  265. 2650  INPUT N: IF N =  -1  THEN 2740
  266. 2660  FOR J = 0 TO N
  267. 2670  FOR I = 0 TO 9
  268. 2680 A$ = ""
  269. 2690  GET B$: IF  ASC(B$) <32  THEN 2690
  270. 2700  IF B$ < > CHR$(92)  THEN A$ = A$ +B$: GOTO 2690
  271. 2710 K$(J,I) = A$
  272. 2720  NEXT I
  273. 2730  NEXT J
  274. 2740  PRINT : PRINT D$"CLOSE LABEL.DATA"
  275. 2750  ONERR  GOTO 150
  276. 2760  RETURN 
  277. 2770  CALL  -3288: PRINT : PRINT D$"CLOSE"
  278. 2780  POKE 216,0: VTAB 15: HTAB 12
  279. 2790  PRINT  CHR$(7)" ***  ERROR  *** " CHR$(7): PRINT : PRINT 
  280. 2800  PRINT "CHECK YOUR DISK AND PRESS <RETURN> TO": PRINT "TRY AGAIN."
  281. 2810  GET W$: PRINT 
  282. 2820  VTAB 15: HTAB 1: CALL  -958: GOTO 2610
  283. 2830  REM ========
  284. 2840  REM WARNING!
  285. 2850  REM ========
  286. 2860  VTAB 10: HTAB 1: CALL  -958: VTAB 13
  287. 2870  HTAB 12: INVERSE : PRINT " *** WARNING *** ": NORMAL : PRINT : PRINT 
  288. 2880  HTAB 5: PRINT "THIS WILL REPLACE CURRENT LABEL": PRINT 
  289. 2890  HTAB 13: PRINT "OK TO PROCEED ? ";: GOSUB 3210
  290. 2900  IF X = 78  THEN  POP : RETURN 
  291. 2910  FOR II = 1 TO 10:L$(II) = "": NEXT 
  292. 2920  RETURN 
  293. 2930  REM ===============
  294. 2940  REM FIRST TIME USE?
  295. 2950  REM ===============
  296. 2960  ONERR  GOTO 3020
  297. 2970  PRINT : PRINT D$"OPEN LABEL.DATA"
  298. 2980  PRINT D$"READ LABEL.DATA"
  299. 2990  INPUT N
  300. 3000  PRINT D$"CLOSE LABEL.DATA"
  301. 3010  POKE 216,0: RETURN 
  302. 3020  PRINT D$"CLOSE": IF  PEEK(222) < >5  THEN 3070
  303. 3030  PRINT D$"OPEN LABEL.DATA": PRINT D$"WRITE LABEL.DATA"
  304. 3040 N =  -1: PRINT N
  305. 3050  PRINT D$"CLOSE LABEL.DATA"
  306. 3060  POKE 216,0: PRINT  CHR$(7): PRINT  CHR$(7): GOTO 130
  307. 3070  PRINT "ERROR "; PEEK(222): PRINT "OCCURRED WHILE TRYING TO INITIALIZE": PRINT "YOUR DATA FILE": PRINT : PRINT "PLEASE CORRECT THE PROBLEM AND PRESS": PRINT "ANY KEY TO START AGAIN": GET K$: RUN 
  308. 3080  REM ===============
  309. 3090  REM CHARACTER INPUT
  310. 3100  REM ===============
  311. 3110 A$ = ""
  312. 3120  GET B$
  313. 3130  IF B$ =  CHR$(13)  THEN  CALL  -868: RETURN 
  314. 3140  IF B$ < > CHR$(8)  AND  LEN(A$) = 32  THEN  PRINT  CHR$(7);: GOTO 3120
  315. 3150  IF B$ < > CHR$(8)  THEN A$ = A$ +B$: PRINT B$;: GOTO 3120
  316. 3160  IF  LEN(A$) = 0  THEN 3120
  317. 3170  PRINT B$"."B$;: IF  LEN(A$) = 1  THEN A$ = "": GOTO 3120
  318. 3180 A$ =  LEFT$(A$, LEN(A$) -1): GOTO 3120
  319. 3190 X =  PEEK( -16384): IF X <128  THEN 3190
  320. 3200  POKE  -16368,0:X = X -128: RETURN 
  321. 3210 X =  PEEK( -16384): IF X <128  OR (X < >217  AND X < >206)  THEN 3210
  322. 3220  POKE  -16368,0:X = X -128: RETURN 
  323. 3230  FOR I = 1 TO 10: HTAB 5: PRINT L$(I): NEXT : RETURN 
  324. 3240  PRINT "                                        ";: RETURN : REM 40 SPACES BETWEEN QUOTES