home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib28b.dsk / FORMS.MX80.bas < prev    next >
BASIC Source File  |  2023-02-26  |  12KB  |  211 lines
  1. 10  REM *******8.1.86*********
  2. 20  REM *     FORMS.SHOP     *
  3. 30  REM * BY PAUL S. DUNSEATH*
  4. 40  REM * COPYRIGHT (C) 1986 *
  5. 50  REM * BY MICROSPARC, INC *
  6. 60  REM * CONCORD, MA  01742 *
  7. 70  REM **********************
  8. 80  HOME : VTAB 10: HTAB 13: INVERSE : PRINT "THE FORMS SHOP": NORMAL : PRINT :ST$ = "BY  PAUL S. DUNSEATH": GOSUB 1470
  9. 90  VTAB 20: PRINT "*COPYRIGHT (C) 1986 BY MICROSPARC, INC.*": GOSUB 1990: GOSUB 2050
  10. 100  VTAB 1: HTAB 13: INVERSE : PRINT "THE FORMS SHOP": NORMAL : POKE 34,1
  11. 110  ONERR  GOTO 1880
  12. 120  REM 
  13. 130  REM      SET UP
  14. 140  REM 
  15. 150 NC = 4: DIM L(55),LE(55),M(55),Y(55),T$(55),E$(55),X(55),PC$(NC,1),PN$(NC),LL(NC)
  16. 160  REM 
  17. 170  REM DISK AND PRINTER COMMANDS
  18. 180  REM 
  19. 190 D$ =  CHR$(4):CR$ =  CHR$(13):BS$ =  CHR$(8):EX$ =  CHR$(27):BL$ =  CHR$(7): REM COMMONLY USED CONTROL CHARS
  20. 200 PC$(1,1) = EX$ +"Q":PC$(1,0) = "":LL(1) = 80:PN$(1) = "NORMAL"
  21. 210 PC$(2,1) =  CHR$(14):PC$(2,0) =  CHR$(20):LL(2) = 40:PN$(2) = "EXPANDED"
  22. 220 PC$(3,1) =  CHR$(15):PC$(3,0) =  CHR$(18):LL(3) = 132:PN$(3) = "COMPRESSED"
  23. 230 PC$(4,1) = EX$ +"4":PC$(4,0) = EX$ +"5":LL(4) = 80:PN$(4) = "ITALICS"
  24. 240  REM 
  25. 250 B1$ = EX$ +"G":BZ$ = EX$ +"H": REM  BOLDFACE
  26. 260  REM 
  27. 270  REM   MAIN PROGRAM
  28. 280  REM 
  29. 290  HOME : POKE  -16368,0: VTAB 10: PRINT "ENTER SLOT NUMBER FOR YOUR": PRINT " FORMAT DISK (1-7): <6>";BS$;BS$;: GET SL$: IF SL$ = CR$  THEN SL$ = "6"
  30. 300 SL =  VAL(SL$): VTAB 11: HTAB 22: PRINT SL$
  31. 310  IF (SL <1)  OR (SL >7)  THEN  PRINT BL$;BL$;: GOTO 290
  32. 320  VTAB 14: HTAB 1: POKE  -16368,0: CALL  -958: PRINT "ENTER DRIVE NUMBER FOR YOUR": PRINT " FORMAT DISK (1-2): <1>";BS$;BS$;: GET DR$: IF DR$ = CR$  THEN DR$ = "1"
  33. 330 DR =  VAL(DR$): VTAB 15: HTAB 22: PRINT DR$
  34. 340  IF DR <1  OR DR >2  THEN  PRINT BL$;BL$;: GOTO 320
  35. 350  VTAB 17: HTAB 1: POKE  -16368,0: CALL  -958: PRINT "ENTER SLOT NUMBER FOR YOUR": PRINT " PRINTER INTERFACE (1-7): <1>";BS$;BS$;: GET PS$: IF PS$ = CR$  THEN PS$ = "1"
  36. 360 PS =  VAL(PS$): VTAB 18: HTAB 28: PRINT PS$
  37. 370  IF PS <1  OR PS >7  THEN  PRINT BL$;BL$;: GOTO 350
  38. 380  HOME : POKE  -16368,0: VTAB 10: PRINT "DO YOU WISH TO USE A FORMAT": PRINT "  WHICH IS ON THE DISK <Y/N> ? < >";BS$;BS$;: GET A$: PRINT A$
  39. 390  IF A$ = "N"  OR A$ =  CHR$(110) GOTO 620
  40. 400  IF A$ = "Y"  OR A$ =  CHR$(121) GOTO 420
  41. 410  PRINT BL$ +BL$: GOTO 380
  42. 420 FLAG = 1: HOME : VTAB 10: PRINT "    WHAT FORMAT DO YOU WISH TO USE?": PRINT " PRESS  ?  TO SEE A CATALOG OF THE DISK": PRINT : INPUT "FORMAT NAME: ";F$: IF  LEN(F$) >15  THEN F$ =  LEFT$(F$,15)
  43. 425  IF F$ = ""  THEN 380
  44. 430  IF F$ < >"?"  THEN 510
  45. 440  IF F$ = "?"  THEN  HOME : PRINT : PRINT D$; LEFT$("CATALOG",7 -( PEEK(48896) = 76) *4);",S";SL;",D";DR
  46. 450  GOSUB 1990: REM  CALL THE KEYPRESS SUBROUTINE
  47. 460  POKE  -16368,0
  48. 470  GOTO 420
  49. 480  REM 
  50. 490  REM   READ THE DISK FILE
  51. 500  REM 
  52. 510 FLAG = 2: PRINT : PRINT D$;"VERIFY";F$
  53. 520 FLAG = 3: PRINT : PRINT D$;"OPEN";F$;",S";SL;",D";DR: PRINT : PRINT D$;"READ";F$
  54. 530  INPUT M: INPUT H: INPUT R: INPUT L: INPUT CE$
  55. 540  FOR K = 1 TO M
  56. 550  INPUT X(K): INPUT E$(K)
  57. 552  CALL 54572: FOR B = 512 TO 768: IF  PEEK(B) < >0  THEN  NEXT 
  58. 555 T$(K) = "":AD =  VAL(T$(K)) + PEEK(131) +256 * PEEK(132): POKE AD,B -512: POKE AD +1,0: POKE AD +2,2:T$(K) =  MID$ (T$(K),1):B = 768: NEXT 
  59. 557  INPUT Y(K)
  60. 560  NEXT 
  61. 570  PRINT D$;"CLOSE";F$
  62. 580  GOSUB 1760
  63. 590  REM 
  64. 600  REM   PREPARE THE FORM
  65. 610  REM 
  66. 620  REM 
  67. 630  HOME : VTAB 10: PRINT "HOW MANY LINES (1 TO 33) DO YOU WISH": PRINT "  TO PRINT ON EACH FORM ? ";: INPUT "";A$:M =  VAL(A$)
  68. 640  IF M <1  OR M >33  THEN  PRINT BL$BL$: PRINT : PRINT "   SORRY, IT MUST BE BETWEEN 1 AND 33": GOSUB 1990: GOTO 630
  69. 650  POKE  -16368,0: VTAB 13: CALL  -958: VTAB 14: PRINT "DO YOU WISH IT CENTERED <Y/N> ? < >";BS$;BS$;: GET CE$: PRINT CE$
  70. 660  IF CE$ = "Y"  OR CE$ =  CHR$(121) GOTO 690
  71. 670  IF CE$ = "N"  OR CE$ =  CHR$(110) GOTO 690
  72. 680  PRINT BL$;BL$: GOTO 650
  73. 690  HOME : FOR K = 1 TO M
  74. 700  GOSUB 1510
  75. 710  NEXT 
  76. 720  HOME : VTAB 10: PRINT "HOW MANY BLANK LINES": PRINT "  BETWEEN FORMS ? ";: INPUT "";L$:L =  VAL(L$):A$ = ""
  77. 730  POKE  -16368,0: IF ((2 *M) +L) >66  THEN  PRINT BL$;BL$: PRINT "THAT IS LONGER THAN AN 11-INCH PAGE;": PRINT "  ARE YOU SURE <Y/N> ? < >";BS$;BS$;: GET A$: PRINT A$
  78. 740  IF A$ = "Y"  OR A$ =  CHR$(121) GOTO 770
  79. 750  IF A$ = "N"  OR A$ =  CHR$(110) GOTO 720
  80. 760  IF ((2 *M) +L) >66  THEN  PRINT BL$;BL$: GOTO 730
  81. 770  HOME : VTAB 10: PRINT "HOW MANY REPETITIONS ? ";: INPUT "";A$
  82. 780 R =  VAL(A$)
  83. 790  HOME : VTAB 10: PRINT "HOW MANY LINES DOWN FROM THE TOP": PRINT "  DO YOU WISH THE PRINTING TO BEGIN ? ";: INPUT "";A$:H =  VAL(A$)
  84. 800  IF H >66  THEN  PRINT BL$;BL$: PRINT "THAT WILL BE OFF THE PAGE AT THE BOTTOM": GOSUB 1990: GOTO 790
  85. 810  IF H <0  THEN  PRINT BL$;BL$: PRINT "  PLEASE USE A NUMBER BETWEEN 1 AND 66": GOTO 790
  86. 820  GOSUB 1990: GOSUB 1760
  87. 830  GOSUB 1690: PRINT : PRINT D$;"PR#0": REM  CLEAR THE DECKS
  88. 840  REM 
  89. 850  REM   START PRINTING
  90. 860  REM 
  91. 870  PRINT : PRINT D$;"PR#"PS$: PRINT  CHR$(9)"136N": PRINT PC$(1,1);
  92. 880  FOR N = 1 TO R
  93. 890  IF H = 0 GOTO 910
  94. 900  FOR G = 1 TO H: PRINT : NEXT 
  95. 910  FOR K = 1 TO M
  96. 920 BF$ = "": IF E$(K) = "Y"  OR E$(K) =  CHR$(121)  THEN BF$ = B1$
  97. 930  IF T$(K) = ""  THEN  PRINT : GOTO 960
  98. 940  HTAB 1: PRINT R$;: PRINT  TAB( Y(K));PC$(X(K),1);BF$;T$(K);BZ$;PC$(X(K),0)
  99. 950  PRINT 
  100. 960  NEXT 
  101. 970  IF L = 0 GOTO 990
  102. 980  FOR J = 0 TO L: PRINT : NEXT 
  103. 990  NEXT 
  104. 1000  PRINT : PRINT D$;"PR#0"
  105. 1010  REM 
  106. 1020  REM  DO IT AGAIN?
  107. 1030  REM 
  108. 1040  POKE  -16368,0: HOME : VTAB 10: PRINT "WOULD YOU LIKE TO REPEAT WITH THE": PRINT "  SAME SETTINGS <Y/N> ? < >";BS$;BS$;: GET A$: PRINT A$
  109. 1050  IF A$ = "Y"  OR A$ =  CHR$(121)  THEN  GOSUB 1690: GOTO 870
  110. 1060  IF A$ = "N"  OR A$ =  CHR$(110) GOTO 1150
  111. 1070  VTAB 15: PRINT BL$;BL$: GOTO 1040
  112. 1080  POKE  -16368,0: HOME : VTAB 10: PRINT "WOULD YOU LIKE TO RERUN <Y/N>? < >";BS$;BS$;: GET Z$: PRINT Z$
  113. 1090  IF Z$ = "Y"  OR Z$ =  CHR$(121)  THEN  HOME : GOTO 210
  114. 1100  IF Z$ = "N"  OR Z$ =  CHR$(110) GOTO 1150
  115. 1110  PRINT BL$;BL$: GOTO 1080
  116. 1120  REM 
  117. 1130  REM  SAVE THE FORM
  118. 1140  REM 
  119. 1150  POKE  -16368,0:FLAG = 4: HOME : VTAB 10: PRINT "WOULD YOU LIKE TO SAVE THIS FORMAT": PRINT "  TO DISK <Y/N> ? < >";BS$;BS$;: GET A$: PRINT A$
  120. 1160  IF A$ = "N"  OR A$ =  CHR$(110) GOTO 1330
  121. 1170  IF A$ = "Y"  OR A$ =  CHR$(121) GOTO 1190
  122. 1180  PRINT BL$;BL$: GOTO 1150
  123. 1190  HOME : VTAB 10: PRINT "  WHAT FILE NAME DO YOU WISH TO USE? ": PRINT " PRESS  ?  TO SEE A CATALOG OF THE DISK": PRINT : INPUT "FILE NAME: ";F$
  124. 1195  IF F$ = ""  THEN 1330
  125. 1200  IF F$ < >"?" GOTO 1240
  126. 1210  IF F$ = "?"  THEN  HOME : PRINT : PRINT D$; LEFT$("CATALOG",7 -( PEEK(48896) = 76) *4);",S";SL;",D";DR
  127. 1220  GOSUB 1990
  128. 1230  GOTO 1190
  129. 1240  PRINT : PRINT D$;"OPEN";F$;",S";SL;",D";DR: PRINT D$;"CLOSE";F$: PRINT D$;"DELETE";F$: PRINT D$;"OPEN";F$: PRINT D$"WRITE";F$
  130. 1250  PRINT M: PRINT H: PRINT R: PRINT L: PRINT CE$
  131. 1260  FOR K = 1 TO M
  132. 1270  PRINT X(K): PRINT E$(K): PRINT T$(K): PRINT Y(K)
  133. 1280  NEXT 
  134. 1290  PRINT D$;"CLOSE";F$: PRINT : PRINT "      FILE ";F$;" CREATED": GOSUB 1990: REM 6 SPACES
  135. 1300  REM 
  136. 1310  REM   LEAVING THE PROGRAM
  137. 1320  REM 
  138. 1330  POKE  -16368,0: HOME 
  139. 1340  VTAB 6: PRINT "WOULD YOU LIKE TO QUIT?": PRINT : PRINT "  PRESS <Y> FOR YES": PRINT  SPC( 8);"<N> TO  RETURN TO THE": PRINT  SPC( 16);"PREVIOUS STEP": PRINT  SPC( 8);"<R> TO RESTART": PRINT : PRINT  SPC( 8);"< >";BS$;BS$;: GET A$: PRINT A$
  140. 1350  IF A$ = "Y"  OR A$ =  CHR$(121) GOTO 1390
  141. 1360  IF A$ = "N"  OR A$ =  CHR$(110) GOTO 1150
  142. 1370  IF A$ = "R"  OR A$ =  CHR$(114) GOTO 380
  143. 1380  PRINT : PRINT BL$;BL$: GOTO 1330
  144. 1390  PRINT : PRINT : PRINT : PRINT "EXITING WILL DESTROY ANY FILE IN RAM...": PRINT : PRINT "  PRESS ";: INVERSE : PRINT "E";: NORMAL : PRINT " TO CONFIRM YOU WISH TO EXIT"
  145. 1400  PRINT : PRINT : HTAB 6: PRINT "OR ";: INVERSE : PRINT "ANY OTHER KEY";: NORMAL : PRINT " TO CONTINUE  ";:
  146. 1410  GET A$: IF A$ = "E"  OR A$ =  CHR$(101)  THEN  PRINT : GOTO 1430
  147. 1420  GOTO 1150
  148. 1430  VTAB 22: PRINT : HTAB 13:ST$ = "'BYE FOR NOW..": GOSUB 1470: POKE 34,0: HOME : END 
  149. 1440  REM 
  150. 1450  REM   SLOWPRINT SUBROUTINE
  151. 1460  REM 
  152. 1470  SPEED= 175: HTAB 10: FOR X = 1 TO  LEN(ST$): PRINT  MID$ (ST$,X,1);:Z =  PEEK( -16336) + PEEK( -16336): FOR Y = 1 TO 20: NEXT : NEXT : PRINT : SPEED= 255: FOR I = 1 TO 1000: NEXT : RETURN 
  153. 1480  REM 
  154. 1490  REM   START OF SET-UP
  155. 1500  REM 
  156. 1510  HOME : VTAB 10: PRINT "WHAT DO YOU WISH TO PRINT": PRINT "  ON LINE ";K;" ? "
  157. 1520  VTAB 13: HTAB 1: FOR L = 1 TO 39: PRINT ".";: NEXT : PRINT "^";: FOR L = 1 TO 39: PRINT ".";: NEXT : PRINT "^";: FOR I = 1 TO 52: PRINT ".";: NEXT : VTAB 13: HTAB 1
  158. 1525  CALL 54572: FOR B = 512 TO 768: IF  PEEK(B) < >0  THEN  NEXT 
  159. 1530 T$(K) = "":AD =  VAL(T$(K)) + PEEK(131) +256 * PEEK(132): POKE AD,B -512: POKE AD +1,0: POKE AD +2,2:T$(K) =  MID$ (T$(K),1):B = 768: NEXT 
  160. 1540  HOME : VTAB 10: PRINT "PLEASE SELECT ONE OF -": PRINT : FOR I = 1 TO NC: PRINT "   <"I"> "PN$(I): NEXT I: PRINT : PRINT "   < >";BS$;BS$;: GET X$: PRINT X$
  161. 1550  REM 
  162. 1560  REM  CENTERING CALCULATION
  163. 1570  REM 
  164. 1580  IF X$ <"1"  OR X$ > STR$(NC)  THEN  PRINT BL$;BL$: PRINT "SORRY, IT MUST BE ONE OF C, I, W, OR R": PRINT : PRINT : GOSUB 1990: GOTO 1540
  165. 1590 X(K) =  VAL(X$):M(K) = 40:L(K) = 80 * LEN(T$(K))/LL(X(K))
  166. 1600  POKE  -16368,0: HTAB 1: VTAB 20: PRINT "DO YOU WANT BOLD-FACE PRINT <Y/N>?  < >";BS$;BS$;: GET E$: PRINT E$: IF E$ < >"N"  AND E$ < > CHR$(110)  AND E$ < > CHR$(121)  AND E$ < >"Y"  THEN 1600
  167. 1610 E$(K) = E$
  168. 1620 LE(K) = (L(K))/2
  169. 1630 Y(K) = M(K) -LE(K)
  170. 1640  IF CE$ = "N"  OR CE$ =  CHR$(110)  THEN Y(K) = 1
  171. 1650  RETURN 
  172. 1660  REM 
  173. 1670  REM   PRINTER PREPARATION
  174. 1680  REM 
  175. 1690  VTAB 23: HTAB 1: CALL  -958
  176. 1700  VTAB 23: HTAB 1: PRINT " PLEASE                 AND PRESS A KEY";: FOR PAUSE = 1 TO 250: NEXT : VTAB 23: HTAB 1: PRINT " PLEASE PREPARE PRINTER AND PRESS A KEY";: FOR PAUSE = 1 TO 250: NEXT : IF  PEEK( -16384) <128 GOTO 1690: REM 17 SPACES
  177. 1710  VTAB 23: CALL  -958
  178. 1720  RETURN 
  179. 1730  REM 
  180. 1740  REM  USER'S VERIFICATION OF SET-UP
  181. 1750  REM 
  182. 1760  HOME : PRINT "SUMMARY OF THE FORMAT YOU HAVE CHOSEN :": PRINT : PRINT "LINES PER FORM = ";M: PRINT "BLANK LINES BETWEEN FORMS = ";L: PRINT "NO. OF REPETITIONS = ";R: PRINT "FIRST LINE IS ";H;" LINE(S) FROM TOP":
  183. 1770  IF CE$ = "Y"  OR CE$ =  CHR$(121)  THEN  PRINT "TEXT IS CENTERED": GOTO 1790
  184. 1780  PRINT "TEXT IS LEFT JUSTIFIED"
  185. 1790  POKE 34,9: SPEED= 200
  186. 1800  FOR K = 1 TO M: PRINT "LINE # ";K;": ";T$(K): NEXT : PRINT 
  187. 1810  SPEED= 255: POKE  -16368,0: HTAB 1: VTAB 23: CALL  -868: PRINT "IS THIS SET-UP OK <Y/N> ? < >";BS$;BS$;: GET A$: PRINT A$;: POKE 34,1
  188. 1820  IF A$ = "Y"  OR A$ =  CHR$(121) GOTO 830
  189. 1830  IF A$ = "N"  OR A$ =  CHR$(110)  THEN  HOME : GOTO 630
  190. 1840  PRINT BL$;BL$;: GOTO 1810
  191. 1850  REM 
  192. 1860  REM    ERROR TRAPS
  193. 1870  REM  
  194. 1880 ER =  PEEK(222):EL =  PEEK(218) +256 * PEEK(219): CALL  -3288
  195. 1890  IF ER = 5  OR ER = 6  OR ER = 4  OR ER = 8  OR ER = 9  THEN  PRINT D$;"CLOSE";F$
  196. 1900  IF ER = 8  THEN  PRINT "I/O ERROR--CHECK DRIVE DOOR": GOTO 1950
  197. 1910  IF ER = 4  THEN  PRINT "DISK IS WRITE-PROTECTED.": GOTO 1950
  198. 1920  IF ER = 9  THEN  PRINT "DISK IS FULL. INSERT ANOTHER DISK.": GOTO 1950
  199. 1930  IF FLAG = 2  AND ER = 5  OR ER = 6  OR ER = 254  THEN  PRINT F$" NOT ON THIS DISK.": GOTO 1950
  200. 1940  PRINT "ERROR "ER" IN LINE "EL"."
  201. 1950  GOSUB 1990: ON FLAG GOTO 420,420,420,1150
  202. 1960  REM 
  203. 1970  REM  PRESS A KEY ROUTINE
  204. 1980  REM 
  205. 1990  VTAB 24: CALL  -868: HTAB 7: PRINT "PRESS          TO CONTINUE";: FOR PAUSE = 1 TO 250: NEXT : VTAB 24: HTAB 7: PRINT "PRESS <RETURN> TO CONTINUE";: FOR PAUSE = 1 TO 250: NEXT : IF  PEEK( -16384) <128 GOTO 1990: REM 10 SPACES
  206. 2000  POKE  -16368,0: PRINT 
  207. 2010  RETURN 
  208. 2020  REM 
  209. 2030  REM  SCREEN SCROLL
  210. 2040  REM 
  211. 2050  VTAB 24: FOR I = 1 TO 24: PRINT : FOR J = 1 TO 75: NEXT : NEXT : HOME : RETURN