home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib36a.dsk / MARCH.1989 / GRAPHICS.SWITCH.bas next >
BASIC Source File  |  2023-02-26  |  12KB  |  226 lines
  1. 10  REM   *********************
  2. 20  REM   * GRAPHICS.SWITCH   *
  3. 30  REM   * BY THOMAS DORRIS  *
  4. 40  REM   * COPYRIGHT(C) 1989 *
  5. 50  REM   * MICROSPARC, INC.  *
  6. 60  REM   * CONCORD, MA 01742 *
  7. 70  REM   *********************
  8. 80  REM 
  9. 90 D$ =  CHR$(4): DIM MN$(50),CL(16),DR$(14),SL(14),DR(14)
  10. 100  PRINT  CHR$(21)
  11. 110  HOME 
  12. 120  VTAB 10: PRINT "ONE MOMENT...": GOSUB 1770
  13. 130  HOME : VTAB 6: PRINT "THE GRAPHICS SWITCHER": PRINT : PRINT "BY TOM DORRIS": VTAB 10: PRINT "COPYRIGHT(C) 1989": PRINT "MICROSPARC, INC."
  14. 140  VTAB 24: PRINT "PRESS RETURN TO CONTINUE";: GET A$
  15. 150  REM  FIND VALID SLOT AND DRIVE NUMBERS
  16. 160  FOR I = 1 TO 7: IF  PEEK(48912 +I *2) = 172  AND  PEEK(48913 +I *2) = 222  THEN 180
  17. 170 DR = DR +1:DR$(DR) = "SLOT " + STR$(I) +", DRIVE 1":SL(DR) = I:DR(DR) = 1
  18. 180  IF I = 3  THEN  NEXT 
  19. 190  IF  PEEK(48928 +I *2) = 172  AND  PEEK(48929 +I *2) = 222  THEN 210
  20. 200 DR = DR +1:DR$(DR) = "SLOT " + STR$(I) +", DRIVE 2":SL(DR) = I:DR(DR) = 2
  21. 210  NEXT 
  22. 220 RT = 1: GOTO 1500
  23. 230  GOTO 240
  24. 240 ML$(1) = "SELECT NEW DISK/PREFIX":ML$(2) = "VIEW HI-RES SCREEN":ML$(3) = "LOAD HI-RES SCREEN"
  25. 250 ML$(4) = "SAVE HI-RES SCREEN":ML$(5) = "DEFINE COLOR PALETTE":ML$(6) = "MOVE DISPLAY WINDOW"
  26. 260 ML$(7) = "SELECT SUPER HI-RES PICTURE":ML$(8) = "CONVERT SUPER HI-RES PICTURE":ML$(9) = "CATALOG DISK":ML = 9
  27. 270  FOR I = 9 TO 16:CL(I) = 1: NEXT :XF = 0
  28. 280 LM = 1
  29. 290  HOME : HTAB 5: VTAB 1: PRINT "THE GRAPHICS SWITCHER": HTAB 5: PRINT "COPYRIGHT(C) 1989 MICROSPARC, INC.": HTAB 5: VTAB 4: PRINT "USE ARROW KEYS TO MOVE MARKER": HTAB 5: PRINT "PRESS RETURN TO MAKE SELECTION"
  30. 300  HTAB 5: VTAB 6: PRINT "------------------------------": HTAB 11: VTAB 19: PRINT "PRESS ESCAPE TO EXIT": REM  30 -'s
  31. 310 EF = 1
  32. 320  HTAB 5: VTAB 21: PRINT "PREFIX: "PR$: HTAB 5: PRINT "SUPER HI-RES PICTURE: "PC$: IF   NOT  LEN(PC$)  THEN  HTAB 26:: VTAB 22: PRINT "NONE"
  33. 330 Q$ = "EXIT TO BASIC":CP = LM
  34. 340  FOR I = 1 TO ML:MN$(I) = ML$(I): NEXT :MN = ML: GOSUB 1320
  35. 350  IF   NOT ES  THEN 380
  36. 360  HOME : HTAB 5: VTAB 10: PRINT "DO YOU WANT TO QUIT ?";: GET A$: IF A$ = "Y"  OR A$ = "y"  THEN  HOME : VTAB 23: END 
  37. 370  GOTO 290
  38. 380 RT = 2
  39. 390 LM = CP
  40. 400  ON CP GOTO 1500,420,440,500,620,730,940,810,1740
  41. 410  REM  DISPLAY SCREEN
  42. 420  POKE 49237,0: POKE 49232,0: POKE 49239,0: GET A$: TEXT : GOTO 290
  43. 430  REM  LOAD STANDARD HI-RES
  44. 440 BL = 17: GOSUB 1180: REM  STANDARD HI-RES PIC LENGTH IS 17 BLOCKS
  45. 450  IF ES  THEN 290
  46. 460  HGR2 : ONERR  GOTO 2060
  47. 470  PRINT D$"BLOAD "PR$;A$;",A$4000": POKE 216,0
  48. 480  GET A$: TEXT : GOTO 290
  49. 490  REM  SAVE STANDARD HI-RES SCREEN
  50. 500  REM 
  51. 510  HOME : HTAB 12: VTAB 2: PRINT "SAVE HI-RES SCREEN":EF = 1
  52. 520  ONERR  GOTO 2060
  53. 530  PRINT D$"PREFIX "PR$: POKE 216,0
  54. 540  HTAB 7: VTAB 19: PRINT "PRESS RETURN ALONE TO EXIT"
  55. 550  HTAB 5: VTAB 5: PRINT "TYPE NAME TO SAVE HI-RES SCREEN AS:"
  56. 560  HTAB 5: VTAB 7: INPUT "-->";A$
  57. 570  IF   NOT  LEN(A$)  THEN 290
  58. 580  ONERR  GOTO 2060
  59. 590  HOME : HTAB 5: VTAB 5: PRINT "SAVING FILE..."
  60. 600  PRINT D$"BSAVE "PR$;A$;",A$4000,L$1FFF": POKE 216,0: GOTO 290
  61. 610  REM  COLOR PALETTE DEFINITION
  62. 620  HOME : HTAB 14: VTAB 2: PRINT "COLOR PALETTE"
  63. 630  HTAB 3: VTAB 9: PRINT "COLOR  STATE         COLOR  STATE"
  64. 640  FOR X = 1 TO 16: GOSUB 700: NEXT 
  65. 650  HTAB 7: VTAB 23: PRINT "PRESS RETURN ALONE TO EXIT"
  66. 660  HTAB 7: VTAB 21: PRINT "ENTER COLOR TO CHANGE --";: INPUT ">";A$: IF   NOT  LEN(A$)  THEN 290
  67. 670  IF   NOT  VAL(A$)  THEN 660
  68. 680  IF  VAL(A$) >16  OR  VAL(A$) <1  THEN 660
  69. 690 X =  INT( VAL(A$)):CL(X) =   NOT (CL(X)): INVERSE : GOSUB 700: NORMAL : GOSUB 700: GOTO 660
  70. 700  HTAB 4 +20 *(X >8) +(X <10): VTAB 10 +X -8 *(X >8): PRINT X" --- ";: IF CL(X)  THEN  PRINT "ON ": RETURN 
  71. 710  PRINT "OFF": RETURN 
  72. 720  REM  OFFSET DISPLAY WINDOW
  73. 730  HOME : HTAB 13: VTAB 2: PRINT "DISPLAY WINDOW"
  74. 740  HTAB 5: VTAB 5: PRINT "CURRENT WINDOW OFFSET IS:": PRINT : HTAB 8: PRINT XF" PIXELS"
  75. 750  HTAB 7: VTAB 20: PRINT "PRESS RETURN ALONE TO EXIT"
  76. 760  HTAB 5: VTAB 10: PRINT "ENTER NEW PIXEL OFFSET UP TO 40": HTAB 5: PRINT "(OFFSET MUST BE AN EVEN NUMBER)"
  77. 770  HTAB 5: VTAB 13: PRINT "-->";: CALL  -868: INPUT "";A$: IF   NOT  LEN(A$)  THEN 290
  78. 780 X =  INT( VAL(A$)): IF X >40  OR X <0  OR (X < >2 * INT(X/2))  THEN 770
  79. 790 XF = X: GOTO 290
  80. 800  REM  CONVERT SELECTED PICTURE
  81. 810  IF   NOT  LEN(PC$)  THEN  HOME : HTAB 5: VTAB 5: PRINT "NO PICTURE HAS BEEN SELECTED": PRINT : HTAB 5: PRINT "PRESS RETURN TO CONTINUE";: GET A$: GOTO 290
  82. 820 P$ = PR$:A$ = PC$: ONERR  GOTO 840
  83. 830  PRINT D$"PREFIX,S3,D2":P$ = "/RAM/":A$ = "PIC"
  84. 840  ONERR  GOTO 2060
  85. 850  PRINT D$"VERIFY "P$;A$: POKE 216,0
  86. 860  POKE 252,XF: REM   WINDOW OFFSET
  87. 870  REM  POKE FILENAME FOR MLI
  88. 880  POKE 24576, LEN(A$): FOR I = 1 TO  LEN(A$): POKE 24576 +I, ASC( MID$ (A$,I,1)): NEXT 
  89. 890  PRINT D$"PREFIX "P$: REM  SET PREFIX FOR MLI CALLS
  90. 900  FOR I = 1 TO 16: POKE 24671 +I,CL(I): NEXT : REM  DEFINE COLOR PALETTE
  91. 910  CALL 25856: REM  CONVERT PICTURE
  92. 920  GET A$: TEXT : GOTO 290
  93. 930  REM  SELECT SUPER HI-RES PICTURE
  94. 940 BL = 65: GOSUB 1180: REM  SUPER HI-RES PICTURE IS 65 BLOCKS LONG
  95. 950  IF ES  THEN 290
  96. 960 PC$ = A$
  97. 970  IF  RIGHT$(PC$,1) = " "  THEN PC$ =  LEFT$(PC$, LEN(PC$) -1): GOTO 970
  98. 980  ONERR  GOTO 1000
  99. 990  PRINT D$"PREFIX,S3,D2": POKE 216,0: GOTO 1010: REM  CHECK FOR RAMDISK
  100. 1000  POKE 216,0: GOTO 290
  101. 1010  REM  MOVE SUPER HI-RES PICTURE TO RAMDISK
  102. 1020  HOME : HTAB 5: VTAB 5: PRINT "ONE MOMENT...": PRINT : PRINT : HTAB 5: PRINT "MOVING PICTURE TO RAM"
  103. 1030 A$ = "PIC": ONERR  GOTO 1050
  104. 1040  PRINT D$"DELETE PIC"
  105. 1050 T$ = "BIN": ONERR  GOTO 1130
  106. 1060  FOR I = 1 TO 4: REM  LOAD SUPER HI-RES FILE IN FOUR SECTIONS
  107. 1070 X = (I -1) *8192
  108. 1080  PRINT D$"BLOAD "PR$;PC$;",A$4000,B"X",L8191,T"T$
  109. 1090  PRINT D$"BSAVE "A$",A$4000,B"X",L8191": REM  SAVE EACH SECTION AS IT'S LOADED
  110. 1100  NEXT 
  111. 1110  POKE 216,0
  112. 1120  GOTO 290
  113. 1130 T$ = "$C1": ONERR  GOTO 2060
  114. 1140  GOTO 1060
  115. 1150  REM    ***********
  116. 1160  REM    SUBROUTINES
  117. 1170  REM    ***********
  118. 1180  HOME : HTAB 14: VTAB 2: PRINT "FILE SELECTOR": HTAB 11: VTAB 19: PRINT "PRESS ESCAPE TO EXIT"
  119. 1190  ONERR  GOTO 2060
  120. 1200  PRINT D$"PREFIX "PR$: POKE 216,0
  121. 1210  ONERR  GOTO 1260
  122. 1220  PRINT D$"OPEN "PR$",TDIR": PRINT D$"READ "PR$:MN = 0
  123. 1230  INPUT A$: IF  LEFT$(A$,5) = "BLOCK"  THEN 1260
  124. 1240  IF  VAL( MID$ (A$,25,5)) = BL  THEN MN = MN +1:MN$(MN) =  MID$ (A$,2,15)
  125. 1250  GOTO 1230
  126. 1260  POKE 216,0: PRINT D$"CLOSE"
  127. 1270  IF   NOT MN  THEN  HOME : HTAB 5: VTAB 5: PRINT "SORRY, UNABLE TO FIND ANY FILES": HTAB 5: PRINT "IN CURRENT DIRECTORY.": HTAB 5: VTAB 10: PRINT "PRESS RETURN";: GET A$:ES = 1: GOTO 290
  128. 1280 Q$ = "EXIT TO MAIN MENU": GOSUB 1310
  129. 1290 A$ = MN$(CP): RETURN 
  130. 1300  END 
  131. 1310 CP = 1
  132. 1320 RN = MN +1:MN$(RN) = Q$
  133. 1330 PS = 1:ST = 10:ES = 0: IF ST >RN  THEN ST = RN
  134. 1340 SB = PS -1: FOR I = PS TO ST: HTAB 5: VTAB 7 +I -SB: PRINT MN$(I); SPC( 30 - LEN(MN$(I))): NEXT 
  135. 1350  INVERSE : HTAB 5: VTAB 7 +CP -SB: PRINT MN$(CP): NORMAL 
  136. 1360  IF  PEEK( -16384) <128  THEN 1360
  137. 1370 A =  PEEK( -16384) -128: POKE  -16368,A: IF A < >13  AND A < >8  AND A < >21  AND A < >10  AND A < >11  AND A < >27  THEN 1360
  138. 1380  HTAB 5: VTAB 7 +CP -SB: PRINT MN$(CP)
  139. 1390  IF A = 27  THEN ES = 1: RETURN 
  140. 1400  IF A < >21  AND A < >10  THEN 1440
  141. 1410 CP = CP +1: IF CP >ST  THEN  IF CP >RN  THEN CP = 1: GOTO 1330
  142. 1420  IF CP >ST  THEN PS = PS +1:ST = ST +1: GOTO 1340
  143. 1430  GOTO 1350
  144. 1440  IF A = 13  THEN 1480
  145. 1450 CP = CP -1: IF CP <PS  THEN  IF PS = 1  THEN CP = RN:ST = RN:PS = ST -9:PS = PS +((PS <1) *1 +(PS <1) * -1 *PS): GOTO 1340
  146. 1460  IF CP <PS  THEN PS = PS -1:ST = ST -1: GOTO 1340
  147. 1470  GOTO 1350
  148. 1480  IF CP = RN  THEN ES = 1
  149. 1490  RETURN 
  150. 1500  HOME : HTAB 10: VTAB 2: PRINT "SELECT DRIVE LOCATION":EF = 2
  151. 1510 Q$ = "EXIT TO MAIN MENU"
  152. 1520  HTAB 11: VTAB 19: PRINT "PRESS ESCAPE TO EXIT"
  153. 1530  FOR I = 1 TO DR:MN$(I) = DR$(I): NEXT :MN = DR: GOSUB 1310
  154. 1540  IF ES  THEN 290
  155. 1550 A$ = MN$(CP):S =  VAL( MID$ (A$,6,1)):D =  VAL( RIGHT$(A$,1))
  156. 1560  ONERR  GOTO 2060
  157. 1570  PRINT D$"PREFIX,S"S",D"D: PRINT D$"PREFIX": INPUT PR$
  158. 1580  POKE 216,0
  159. 1590  HOME : HTAB 5: VTAB 5: PRINT "ONE MOMENT..": PRINT D$"OPEN "PR$",TDIR": PRINT D$"READ "PR$:MN = 0
  160. 1600  ONERR  GOTO 1640
  161. 1610  INPUT A$: IF  LEFT$(A$,5) = "BLOCK"  THEN 1640
  162. 1620  IF  MID$ (A$,18,3) = "DIR"  THEN MN = MN +1:MN$(MN) =  MID$ (A$,2,15)
  163. 1630  GOTO 1610
  164. 1640  POKE 216,0: PRINT D$"CLOSE"
  165. 1650  IF MN = 0  THEN 1720
  166. 1660  HOME : HTAB 6: VTAB 2: PRINT "SELECT DESIRED SUB-DIRECTORY": HTAB 11: VTAB 19: PRINT "PRESS  ESCAPE TO EXIT"
  167. 1670  HTAB 5: VTAB 17: PRINT "CURRENT PREFIX: "PR$
  168. 1680 Q$ = ">>ACCEPT<<": GOSUB 1310: IF ES  THEN 1720
  169. 1690 A$ = MN$(CP)
  170. 1700  IF  RIGHT$(A$,1) = " "  THEN A$ =  LEFT$(A$, LEN(A$) -1): GOTO 1700
  171. 1710 PR$ = PR$ +A$ +"/": GOTO 1590
  172. 1720  IF RT = 1  THEN 240
  173. 1730  GOTO 290
  174. 1740  HOME : ONERR  GOTO 2060
  175. 1750  PRINT D$"CAT"PR$: PRINT : PRINT "PRESS RETURN";: GET A$: POKE 216,0: GOTO 290
  176. 1760  END 
  177. 1770  FOR I = 0 TO 261: READ A: POKE 25856 +I,A:C = C +A: NEXT : IF C = 30529  THEN  RETURN 
  178. 1780  HOME : HTAB 5: VTAB 5: PRINT "ERROR IN DATA STATEMENTS!!"
  179. 1790  DATA  32,216,243,169,1,133,250,169,0,133
  180. 1800  DATA  7,133,251,32,17,244,169,3,141,85
  181. 1810  DATA  96,169,0,141,86,96,141,88,96,169
  182. 1820  DATA  96,141,87,96,169,97,141,89,96,169
  183. 1830  DATA  1,141,90,96,32,0,191,200,85,96
  184. 1840  DATA  240,3,133,6,96,162,7,32,240,246
  185. 1850  DATA  169,4,141,85,96,169,1,141,86,96
  186. 1860  DATA  169,0,141,87,96,141,89,96,141,91
  187. 1870  DATA  96,141,92,96,169,32,141,90,96,169
  188. 1880  DATA  112,141,88,96,32,223,101,165,252,240
  189. 1890  DATA  9,32,238,101,198,252,198,252,208,247
  190. 1900  DATA  32,238,101,133,253,41,240,24,106,106
  191. 1910  DATA  106,106,32,155,101,176,9,165,253,41
  192. 1920  DATA  15,32,155,101,144,230,169,1,141,85
  193. 1930  DATA  96,141,86,96,32,0,191,204,85,96
  194. 1940  DATA  169,0,133,6,96,170,189,96,96,240
  195. 1950  DATA  8,164,251,177,38,5,250,145,38,6
  196. 1960  DATA  250,16,6,169,1,133,250,230,251,165
  197. 1970  DATA  251,201,40,208,36,169,20,133,6,32
  198. 1980  DATA  238,101,198,6,208,249,169,0,133,6
  199. 1990  DATA  133,251,169,1,133,250,230,7,165,7
  200. 2000  DATA  32,17,244,165,7,201,192,208,2,56
  201. 2010  DATA  96,24,96,32,0,191,202,85,96,169
  202. 2020  DATA  0,133,8,169,112,133,9,96,165,8
  203. 2030  DATA  208,9,165,9,201,144,208,3,32,223
  204. 2040  DATA  101,160,0,177,8,230,8,208,2,230
  205. 2050  DATA  9,96
  206. 2060  HOME :ER =  PEEK(222): POKE 216,0
  207. 2070  HTAB 5: VTAB 5: PRINT "ERROR #"ER" HAS OCCURED."
  208. 2080  IF ER = 9  OR ER = 17  OR ER = 12  OR ER = 6  OR ER = 8  OR ER = 3  OR ER = 4  THEN 2110
  209. 2090  HTAB 5: VTAB 8: PRINT "THIS ERROR IS NOT DEFINED.  THIS": HTAB 5: PRINT "INDICATES A ERROR WITHIN THE": HTAB 5: PRINT "PROGRAM ITSELF."
  210. 2100  GOTO 2240
  211. 2110  IF ER >3  THEN 2130
  212. 2120  HTAB 5: VTAB 8: PRINT "THIS INDICATES THAT NO DEVICE IS": HTAB 5: PRINT "CONNECTED.": GOTO 2240
  213. 2130  IF ER >4  THEN 2150
  214. 2140  HTAB 5: VTAB 8: PRINT "THIS INDICATES THAT AN ATTEMPT": HTAB 5: PRINT "TO WRITE TO A WRITE-PROTECTED DISK": HTAB 5: PRINT "HAS OCCURED.  REMOVE WRITE": HTAB 5: PRINT "PROTECTION AND TRY AGAIN.":EF = 3: GOTO 2240
  215. 2150  IF ER >6  THEN 2170
  216. 2160  HTAB 5: VTAB 8: PRINT "THIS MEAN THAT A SPECIFIED DISK": HTAB 5: PRINT "CANNOT BE FOUND. REINSERT OLD DISK": HTAB 5: PRINT "OR SELECT A NEW ONE.": GOTO 2240
  217. 2170  IF ER >8  THEN 2190
  218. 2180  HTAB 5: VTAB 8: PRINT "THIS IS AN I/O ERROR.  THIS": HTAB 5: PRINT "USUALLY MEANS THERE IS A BAD BLOCK": HTAB 5: PRINT "ON THIS DISK OR THE DISK DRIVE DOOR": HTAB 5: PRINT "IS OPEN.": GOTO 2240
  219. 2190  IF ER >9  THEN 2210
  220. 2200  HTAB 5: VTAB 8: PRINT "THIS MEANS THAT THIS DISK IS FULL.": HTAB 5: PRINT "INSERT ANOTHER DISK, RESELECT THE": HTAB 5: PRINT "SLOT AND DRIVE, AND TRY AGAIN.": GOTO 2240
  221. 2210  IF ER >12  THEN 2230
  222. 2220  HTAB 5: VTAB 8: PRINT "THIS MEANS THAT NO BUFFERS ARE": HTAB 5: PRINT "AVAILABLE.": GOTO 2240
  223. 2230  HTAB 5: VTAB 8: PRINT "THIS MEANS THAT THIS DIRECTORY IS": HTAB 5: PRINT "FULL.  EITHER SELECT ANOTHER DISK": HTAB 5: PRINT "OR SELECT ANOTHER DIRECTORY."
  224. 2240  HTAB 5: VTAB 15: PRINT "PRESS RETURN TO CONTINUE:";: GET A$: IF EF = 1  THEN 290
  225. 2250  IF EF = 2  THEN 1500
  226. 2260  IF EF = 3  THEN 510