home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib34b.dsk / POSTER.CREATOR.bas < prev    next >
BASIC Source File  |  2023-02-26  |  11KB  |  237 lines
  1. 10  REM  ***********************
  2. 20  REM  * POSTER.CREATOR      *
  3. 30  REM  * BY TERRY JOHNSTON   *
  4. 40  REM  * COPYRIGHT(C) 1988   *
  5. 50  REM  * BY MICROSPARC, INC. *
  6. 60  REM  * CONCORD, MA 01742   *
  7. 70  REM  ***********************
  8. 80  GOSUB 2190:SL$ = "1":D$ =  CHR$(4): REM MACHINE ID
  9. 90  GOSUB 2300: REM LOAD M/L ROUTINE TO CLEAR D-HI-RES SCREEN
  10. 100  REM  SELECT TYPE OF IMAGE TO BE PRINTED
  11. 110  REM 
  12. 120 MX = 0: HOME : VTAB 21: IF ID = 234  THEN HR$ = "S": GOTO 180
  13. 130  PRINT "S)TANDARD OR D)OUBLE HI-RES ?": PRINT "DOUBLE HI-RES NEEDS 128K": PRINT "PRESS ";: INVERSE : PRINT "0";: NORMAL : PRINT " TO QUIT": VTAB 21: HTAB 30: GOSUB 2030:HR$ = AN$: PRINT : IF HR$ = "S"  THEN  PRINT  CHR$(12); CHR$(21)
  14. 140  IF AN$ =  CHR$(48)  THEN  GOSUB 1950: GOTO 1300
  15. 150  IF HR$ < >"S"  AND HR$ < >"D"  THEN  VTAB 21: GOTO 130
  16. 160  VTAB 23: PRINT "CLEAR GRAPHICS SCREEN? (Y/N) ";: GOSUB 2340: IF Y$ = "Y"  THEN  GOSUB 2320
  17. 170  POKE 36,0: PRINT  SPC( 30);: POKE 36,0: GOTO 200
  18. 180  VTAB 23: PRINT "CLEAR GRAPHICS SCREEN? (Y/N) ";: GOSUB 2340: IF Y$ = "Y"  THEN  GOSUB 2320
  19. 190  POKE 36,0: PRINT  SPC( 30);: POKE 36,0
  20. 200 MX = 5 *(HR$ = "S"): IF HR$ = "D"  THEN  PRINT  CHR$(21): PRINT  CHR$(4)"PR#3"
  21. 210 V = 4 +MX
  22. 220  IF MX = 5  THEN 320
  23. 230  REM  
  24. 240  REM  IF DOUBLE HI-RES, PREPARE THE SCREEN
  25. 250  REM 
  26. 260  PRINT D$;"PR#3": PRINT  CHR$(12)
  27. 270  POKE 49153,0: POKE 49154,0: POKE 49156,0: POKE 49160,0
  28. 280  POKE 49165,0: POKE 49246,0
  29. 290  REM  
  30. 300  REM  CREATE ARRAY OF BIT VALUES AND POKE IN MACHINE CODE 
  31. 310  REM 
  32. 320  FOR J = 0 TO 6:BV(J) = 2 ^J: NEXT J
  33. 330  POKE 768,169: POKE 769,0: POKE 770,32: POKE 771,17: POKE 772,244: POKE 773,96
  34. 340  REM 
  35. 350  REM  COLLECT GARBAGE AND DISPLAY SCREEN
  36. 360  REM 
  37. 370  GOSUB 1950: IF   NOT DS  THEN FR =  FRE(0): GOTO 390
  38. 380  PRINT D$;"FRE"
  39. 390  POKE 230,32: POKE 49239,0: POKE 49232,0: POKE 49235,0
  40. 400  ONERR  GOTO 2080
  41. 410  REM 
  42. 420  REM  LOAD IMAGE OR DISPLAY CATALOG
  43. 430  REM 
  44. 440  GOSUB 1950:NAME$ = "":DI$ = "": PRINT "ENTER NAME OF PICTURE": INVERSE : PRINT "?";: NORMAL : PRINT " - CATALOG DISK     ";: INVERSE : PRINT "0";: NORMAL : PRINT " - CANCEL"
  45. 450  INVERSE : PRINT "CTRL-Q";: NORMAL : PRINT " - QUIT   ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT " - ACCEPT": VTAB 21: HTAB 22: PRINT ":";
  46. 460  GOSUB 2030: IF AN$ > =  CHR$(32)  THEN NAME$ = NAME$ +AN$: PRINT AN$;
  47. 470  IF AN$ =  CHR$(17)  THEN  PRINT : GOSUB 1950: GOTO 1300
  48. 480  IF AN$ =  CHR$(48)  THEN  TEXT : GOTO 120
  49. 490  IF AN$ =  CHR$(13)  THEN  PRINT : PRINT : PRINT : GOTO 530
  50. 500 L =  LEN(NAME$): IF AN$ =  CHR$(8)  AND L >1  THEN  HTAB L +22: PRINT " ";: HTAB L +22:NAME$ =  LEFT$(NAME$,L -1)
  51. 510  IF AN$ =  CHR$(8)  AND L = 1  THEN  HTAB L +22: PRINT " ";: HTAB L +22:NAME$ = ""
  52. 520  GOTO 460
  53. 530  IF NAME$ = ""  THEN 760
  54. 540  IF NAME$ < >"?"  AND NAME$ < >"/"  THEN 680
  55. 550 CA$ =  LEFT$("CATALOG",7 -4 *DS):PR$ = "ENTER PREFIX OR DISK DRIVE #": IF   NOT DS  THEN PR$ = "ENTER DISK DRIVE #"
  56. 560  TEXT : HOME : VTAB 5: PRINT PR$: PRINT "PRESS ";: INVERSE : PRINT "0";: NORMAL : PRINT " TO CANCEL": VTAB 5: HTAB  LEN(PR$) +1:DI$ = ""
  57. 570  GOSUB 2030: IF AN$ > =  CHR$(32)  THEN DI$ = DI$ +AN$: PRINT AN$;
  58. 580  IF AN$ =  CHR$(13)  THEN  PRINT : GOTO 630
  59. 590  IF AN$ =  CHR$(48)  THEN  PRINT : GOTO 390
  60. 600 L =  LEN(DI$): IF AN$ =  CHR$(8)  AND L >1  THEN  HTAB L +28: PRINT " ";: HTAB L +28:DI$ =  LEFT$(DI$,L -1)
  61. 610  IF AN$ =  CHR$(8)  AND L = 1  THEN  HTAB L +28: PRINT " ";: HTAB L +28:DI$ = ""
  62. 620  GOTO 570
  63. 630  IF ( VAL(DI$) = 0  AND  LEN(DI$) >1  AND  LEFT$(DI$,1) < >"/")  THEN DI$ = "/" +DI$
  64. 640  IF  VAL(DI$) = 1  OR  VAL(DI$) = 2  THEN DI$ = ",D" +DI$
  65. 650  IF (  NOT DS  AND  LEFT$(DI$,1) = "/")  OR ( VAL(DI$) >2)  THEN DI$ = "": GOTO 560
  66. 660  IF DS  THEN  PRINT D$;"PREFIX "DI$
  67. 670  PRINT D$;CA$ +DI$: INPUT "PRESS <RETURN> TO CONTINUE";AN$: GOSUB 1950: GOTO 390
  68. 680  IF MX = 5  THEN  PRINT D$;"BLOAD ";NAME$;",A$2000": GOTO 760
  69. 690  POKE 49237,0: IF DS  THEN  PRINT D$;"BLOAD ";NAME$;",A$2000,L$2000": GOTO 710
  70. 700 NL =  LEN(NAME$):NAME$ = NAME$ +".AUX": PRINT D$;"BLOAD ";NAME$;",A$2000":NAME$ =  LEFT$(NAME$,NL)
  71. 710  POKE 49236,0: IF DS  THEN  PRINT D$;"BLOAD ";NAME$;",A$2000,B$2000": GOTO 760
  72. 720  PRINT D$;"BLOAD ";NAME$;",A$2000"
  73. 730  REM 
  74. 740  REM  CHECK FOR CORRECT IMAGE
  75. 750  REM 
  76. 760  GOSUB 1950: PRINT "IS THIS THE CORRECT PICTURE (Y/N) ?": PRINT "PRESS ";: INVERSE : PRINT "0";: NORMAL : PRINT " TO CANCEL";: VTAB 21: POKE 36,35: GOSUB 2030
  77. 770  PRINT 
  78. 780  IF AN$ =  CHR$(48)  OR AN$ = "N"  THEN 440
  79. 790  IF AN$ < >"Y"  THEN 760
  80. 800  REM 
  81. 810  REM  CALL CROPPING SUBROUTINE
  82. 820  REM 
  83. 830  GOSUB 1450: POKE 49235,0: POKE 216,0
  84. 840  GOSUB 1950
  85. 850  REM 
  86. 860  REM  SELECT TYPE OF PRINTOUT
  87. 870  REM 
  88. 880  PRINT "PRINT OUT IN N)ORMAL OR I)NVERSE ?": PRINT "PRESS ";: INVERSE : PRINT "0";: NORMAL : PRINT " TO CANCEL"
  89. 890  VTAB 21: POKE 36,34: GOSUB 2030:PR$ = AN$: PRINT 
  90. 900  IF PR$ =  CHR$(48)  THEN 830
  91. 910  IF PR$ < >"N"  AND PR$ < >"I"  THEN 840
  92. 920  GOSUB 1950: PRINT "TURN ON THE PRINTER AND PRESS RETURN": PRINT "PRESS ";: INVERSE : PRINT "0";: NORMAL : PRINT " TO CANCEL PRINTING"
  93. 930  VTAB 21: POKE 36,36: GET AN$: PRINT : POKE 49234,0: IF AN$ = "0"  THEN  GOTO 1260
  94. 940  REM 
  95. 950  REM  ACTIVATE THE PRINTER
  96. 960  REM 
  97. 970  PRINT D$;"PR#";SL$
  98. 980  REM 
  99. 990  REM  READ BYTES FROM SCREEN AND FORM STRING FOR OUTPUT
  100. 1000  REM 
  101. 1010 TS =  INT((R -L)/(5 +MX)):PE = 0
  102. 1020  FOR P = 0 TO TS
  103. 1030  FOR Y = T TO B:FI = L:LA = FI +V: IF LA >R  THEN LA = R
  104. 1040 P$ = "": REM  NULL STRING
  105. 1050  POKE 769,Y: GOSUB 1990
  106. 1060  FOR X = LA TO FI  STEP  -1: IF MX = 5  THEN 1080
  107. 1070  FOR SR = 49236 TO 49237: POKE SR,0
  108. 1080 Z =  PEEK(S +X):SB = Z: IF PR$ = "I"  THEN Z = 255 -Z
  109. 1090  IF  PEEK(49152) >127  THEN  GET AN$: IF AN$ =  CHR$(48)  THEN X = FI:Y = B:P = TS:PE = 1: GOTO 1260
  110. 1100  IF Z > = 128  THEN Z = Z -128
  111. 1110  POKE S +X,255 -SB: GOSUB 1370: POKE S +X,SB: IF MX = 5  THEN 1130
  112. 1120  NEXT SR
  113. 1130  NEXT X
  114. 1140  PRINT "     " +P$: REM  5 SPACES
  115. 1150  NEXT Y:L = L +(MX +5)
  116. 1160  REM 
  117. 1170  REM  ADVANCE TO NEXT FULL SHEET
  118. 1180  REM 
  119. 1190 LE = B -T:EL = ((LE/66) - INT(LE/66)) *66
  120. 1200 EL =  INT(66 -EL)
  121. 1210  FOR MP = 1 TO EL: PRINT : NEXT MP
  122. 1220  NEXT P
  123. 1230  REM 
  124. 1240  REM  TURN OFF PRINTER AND ASK TO DO ANOTHER POSTER
  125. 1250  REM 
  126. 1260  PRINT D$;"PR#0"
  127. 1270  POKE 49235,0: GOSUB 1950
  128. 1280  IF PE = 1  THEN  PRINT "POSTER PRINTING TERMINATED": GOTO 1300
  129. 1290  PRINT "--PRINTING IS COMPLETE--"
  130. 1300  PRINT "DO YOU WANT TO QUIT (Y/N) ?";: GOSUB 2030: PRINT 
  131. 1310  IF AN$ = "N"  THEN  TEXT : HOME : GOTO 120
  132. 1320  IF AN$ = "Y"  THEN  PRINT  CHR$(12); CHR$(21): TEXT : HOME : END 
  133. 1330  GOSUB 1950: GOTO 1300
  134. 1340  REM 
  135. 1350  REM  CONVERT BYTE VALUE TO A STRING
  136. 1360  REM 
  137. 1370  FOR J = 6 TO 0  STEP  -1
  138. 1380  IF Z <BV(J)  THEN P$ = "*" +P$: GOTO 1400
  139. 1390 P$ = " " +P$:Z = Z -BV(J): REM  ONE SPACE
  140. 1400  NEXT J
  141. 1410  RETURN 
  142. 1420  REM 
  143. 1430  REM  CROPPING SUBROUTINE
  144. 1440  REM 
  145. 1450  GOSUB 1950
  146. 1460  PRINT "DO YOU WANT TO CROP THE IMAGE (Y/N) ?": PRINT "PRESS ";: INVERSE : PRINT "0";: NORMAL : PRINT " TO CANCEL"
  147. 1470  VTAB 21: POKE 36,37: GOSUB 2030: PRINT 
  148. 1480  IF AN$ =  CHR$(48)  THEN  POP : GOTO 760
  149. 1490  IF AN$ = "N"  THEN L = 0:R = 39:T = 0:B = 191: RETURN 
  150. 1500  IF AN$ < >"Y"  THEN 1450
  151. 1510  GOSUB 1950:ESC = 0
  152. 1520  PRINT "MOVE CURSOR WITH A,Z, AND ARROWS.": IF ID = 234  THEN  PRINT "USE 'S' KEY TO CHANGE CURSOR SPEED": GOTO 1540
  153. 1530  PRINT "USE APPLES WITH KEYS TO MOVE FASTER"
  154. 1540  PRINT "PRESS <RETURN> FOR TOP AND BOTTOM"
  155. 1550  PRINT "PRESS <RETURN> TO BEGIN    ";: INVERSE : PRINT "0";: NORMAL : PRINT " TO EXIT";
  156. 1560  GET AN$: PRINT : IF AN$ =  CHR$(48)  THEN 1450
  157. 1570  POKE 49234,0: GOSUB 1630:T = Y1:L = X1: IF ESC  THEN  GOSUB 1640: POKE 49235,0: GOTO 1450
  158. 1580  GOSUB 1630:B = Y1:R = X1: IF ESC  THEN  GOSUB 1640:Y1 = T:X1 = L: GOSUB 1640: POKE 49235,0: GOTO 1450
  159. 1590  GOSUB 1870
  160. 1600  IF T >B  THEN TEMP = T:T = B:B = TEMP
  161. 1610  IF L >R  THEN TEMP = L:L = R:R = TEMP
  162. 1620  RETURN 
  163. 1630 Y1 = 95:X1 = 20:A = 1
  164. 1640  POKE 769,Y1: GOSUB 1990
  165. 1650  POKE (S +X1),255 - PEEK(S +X1): IF   NOT MX  THEN  POKE 49237,0: POKE (S +X1),255 - PEEK(S +X1): POKE 49236,0: REM CURSOR ON
  166. 1660  IF ESC  THEN  RETURN 
  167. 1670 TX = X1
  168. 1680  IF  PEEK(49152) >127  THEN 1740
  169. 1690  POKE (S +X1),255 - PEEK(S +X1): IF   NOT MX  THEN  POKE 49237,0: POKE (S +X1),255 - PEEK(S +X1): POKE 49236,0: REM CURSOR OFF
  170. 1700  GOTO 1650
  171. 1710  REM 
  172. 1720  REM  PROCESS KEYPRESS
  173. 1730  REM 
  174. 1740  IF (ID = 6  AND ( PEEK(49249) >127  OR  PEEK(49250) >127))  THEN A = 5 +MX
  175. 1750  GOSUB 2030: PRINT : POKE 49168,0: IF ID = 234  AND AN$ = "S"  THEN A = ((A = 10) *1 +(A < >10) *10)
  176. 1760  IF AN$ = "A"  OR AN$ =  CHR$(11)  THEN Y1 = Y1 -A: IF Y1 <0  THEN Y1 = 0
  177. 1770  IF AN$ = "Z"  OR AN$ =  CHR$(10)  THEN Y1 = Y1 +A: IF Y1 >191  THEN Y1 = 191
  178. 1780  IF AN$ =  CHR$(8)  THEN X1 = X1 -A: IF X1 <0  THEN X1 = 0
  179. 1790  IF AN$ =  CHR$(21)  OR AN$ =  CHR$(32)  THEN X1 = X1 +A: IF X1 >39  THEN X1 = 39
  180. 1800  IF AN$ =  CHR$(48)  THEN ESC = 1: RETURN 
  181. 1810 A = (A *(ID = 234)) +(1 *(ID = 6)): IF AN$ =  CHR$(13)  THEN  RETURN 
  182. 1820  POKE (S +TX1),255 - PEEK(S +TX): IF   NOT MX  THEN  POKE 49237,0: POKE (S +TX),255 - PEEK(S +TX): POKE 49236,0: REM  OLD CURSOR OFF
  183. 1830  GOTO 1640
  184. 1840  REM 
  185. 1850  REM  ERASE CROPPING MARKS 
  186. 1860  REM 
  187. 1870  POKE 769,T: GOSUB 1990
  188. 1880  POKE (S +L),255 - PEEK(S +L): IF   NOT MX  THEN  POKE 49237,0: POKE (S +L),255 - PEEK(S +L): POKE 49236,0
  189. 1890  POKE 769,B: GOSUB 1990
  190. 1900  POKE (S +R),255 - PEEK(S +R): IF   NOT MX  THEN  POKE 49237,0: POKE (S +R),255 - PEEK(S +R): POKE 49236,0
  191. 1910  RETURN 
  192. 1920  REM 
  193. 1930  REM  PREPARE TO DISPLAY TEXT
  194. 1940  REM 
  195. 1950  VTAB 21: CALL 64578: RETURN 
  196. 1960  REM 
  197. 1970  REM  FIND ACTUAL ADDRESS OF BYTE IN MEMORY 
  198. 1980  REM    
  199. 1990  CALL 768:S =  PEEK(39) *256 + PEEK(38): RETURN 
  200. 2000  REM 
  201. 2010  REM  CONVERT LOWER CASE TO UPPER
  202. 2020  REM 
  203. 2030  GET AN$: IF  ASC(AN$) > = 97  THEN AN$ =  CHR$( ASC(AN$) -32)
  204. 2040  RETURN 
  205. 2050  REM 
  206. 2060  REM  ERROR HANDLING ROUTINE
  207. 2070  REM 
  208. 2080 ER =  PEEK(222)
  209. 2090  PRINT " ": GOSUB 1950: HOME 
  210. 2100  VTAB 21: PRINT "ERROR #";ER;" IN LINE "; PEEK(219) *256 + PEEK(218)
  211. 2110  IF ER = 6  THEN  PRINT "FILE NOT FOUND : ";NAME$
  212. 2120  IF ER = 8  THEN  PRINT "IS A DISK IN THE DRIVE?"
  213. 2130  IF ER = 13  THEN  PRINT "THAT IS NOT A PICTURE"
  214. 2140  PRINT : PRINT "PRESS <RETURN> TO CONTINUE";: GET AN$: PRINT 
  215. 2150  GOTO 370
  216. 2160  REM   
  217. 2170  REM  DISPLAY TITLE PAGE
  218. 2180  REM 
  219. 2190  IF  PEEK(104) < >64  THEN  POKE 103,1: POKE 104,64: POKE 16384,0: PRINT  CHR$(4);"RUN POSTER.CREATOR"
  220. 2200  POKE 49164,0
  221. 2210  TEXT : HOME : VTAB 5: HTAB 13: PRINT "POSTER CREATOR": PRINT : HTAB 19: PRINT "BY": PRINT : HTAB 13: PRINT "TERRY JOHNSTON": PRINT : HTAB 12: PRINT "COPYRIGHT(C) 1988": PRINT : HTAB 13: PRINT "MICROSPARC, INC."
  222. 2220  VTAB 20: HTAB 7: INVERSE : PRINT "PRESS <RETURN> TO CONTINUE": NORMAL 
  223. 2230  IF  PEEK(49152) <127  THEN 2230
  224. 2240 ID =  PEEK(64435): REM MACHINE TYPE
  225. 2250 DS = ( PEEK(48896) = 76): REM DOS TYPE
  226. 2260  POKE 49168,0
  227. 2270  RETURN 
  228. 2280  REM 
  229. 2290  REM  M/L CODE TO CLEAR D-HI-RES
  230. 2300  FOR I = 1 TO 25: READ BYTE%: POKE 847 +I,BYTE%: NEXT I: RETURN 
  231. 2310  DATA 169,00,133,60,133,66,169,32,133,61,133,67,169,255,133,62,169,63,133,63,56,32,17,195,96
  232. 2320  HGR : IF HR$ = "D"  THEN  PRINT  CHR$(21): CALL 848: PRINT  CHR$(4)"PR#3"
  233. 2330  RETURN 
  234. 2340  GET Y$: IF Y$ = "N"  OR Y$ = "n"  THEN  RETURN 
  235. 2350  IF Y$ = "Y"  THEN  RETURN 
  236. 2360  IF Y$ = "y"  THEN Y$ = "Y": RETURN 
  237. 2370  GOTO 2340