home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib34a.dsk / JUNE.1988 / SUPER.CONVERTER.bas < prev   
BASIC Source File  |  2023-02-26  |  10KB  |  170 lines
  1. 10  REM   **********************
  2. 20  REM   *  SUPER.CONVERTER   *
  3. 30  REM   *   BY TOM DORRIS    *   
  4. 40  REM   * COPYRIGHT (C) 1988 *
  5. 50  REM   * BY MICROSPARC, INC *
  6. 60  REM   * CONCORD, MA  01742 *
  7. 70  REM   **********************
  8. 80  LOMEM: 25088
  9. 90  PRINT  CHR$(4)"PR#3"
  10. 100  DIM DR$(30),PD$(30):SL = 5:DV = 1
  11. 110  REM   *** MAIN MENU ARRAY ***
  12. 120 MN$(1) = "CAT DISK":MN$(2) = "CHANGE PREFIX":MN$(3) = "LOAD STANDARD HIRES PICTURE":MN$(4) = "VIEW STANDARD HIRES SCREEN":MN$(5) = "VIEW SUPER HIRES SCREEN"
  13. 130 MN$(6) = "CONVERT STANDARD TO SUPER":MN$(7) = "SAVE SUPER HIRES SCREEN":MN$(8) = "QUIT":MN = 8
  14. 140  REM   *** CONVERSION MENU ARRAY ***
  15. 150 CV$(1) = "FULL COLOR CONVERSION":CV$(2) = "BLACK AND WHITE":CV$(3) = "GREEN MONOCHROME":CV$(4) = "AMBER MONOCHROME":CV$(5) = "EXIT BACK TO MAIN":CN = 5
  16. 160  ONERR  GOTO 190
  17. 170  REM   *** GET DISKS NAME ***
  18. 180  PRINT  CHR$(4)"PREFIX/": PRINT  CHR$(4)"PREFIX": INPUT PR$:CH = 1:CS = 1: POKE 216,0: GOTO 200
  19. 190  POKE 216,0:RT = 4:D$ =  CHR$(4): GOTO 840
  20. 200  HOME : HTAB 28: VTAB 10: PRINT "SUPER HI-RES CONVERTER"
  21. 210  PRINT : HTAB 32: PRINT "BY TOM DORRIS": HTAB 20: PRINT "COPYRIGHT(C) 1988 BY MICROSPARC, INC."
  22. 220  VTAB 15: HTAB 33: PRINT "ONE MOMENT..."
  23. 230  GOSUB 1410: REM   *** POKE IN MACHINE LANGUAGE ***
  24. 240  VTAB 15: HTAB 25: PRINT "PRESS RETURN TO CONTINUE......";: GET A$
  25. 250 D$ =  CHR$(4):MC = 1
  26. 260  HOME : PRINT : TEXT : POKE 49193,1
  27. 270  HTAB 15: VTAB 1: PRINT "SUPER HI-RES CONVERTER": HTAB 15: PRINT "Copyright(c) 1988 MicroSPARC, Inc.": HTAB 15: VTAB 4: PRINT "Use arrow keys to move marker.": HTAB 15: PRINT "Press Return to make selection": HTAB 15: PRINT "Press Escape to Quit."
  28. 280  IF  RIGHT$(PR$,1) < >"/"  THEN PR$ = PR$ +"/"
  29. 290  FOR I = 1 TO MN:DR$(I) = MN$(I): NEXT :DR = MN
  30. 300  HTAB 15: VTAB 19: PRINT "PREFIX: "PR$
  31. 310 CD = MC:MP = 1: GOSUB 1560:MP = 0: REM   *** MENU MAKER ***
  32. 320 CH = CD:MC = CD
  33. 330  IF CH = MN  THEN  HOME : VTAB 12: PRINT "ARE YOU SURE YOU WANT TO QUIT? ";: POKE  -16368,0: GET A$: IF A$ = "Y"  OR A$ = "y"  THEN  HOME : PRINT D$"PREFIX/": END 
  34. 340  IF CH = MN  THEN 260
  35. 350  IF CH = 4  THEN  HOME : PRINT D$"PR#0": PRINT  CHR$(149): POKE 49232,0: POKE 49234,0: POKE 49237,0: POKE 49239,0: GOTO 380: REM      DISPLAY STANDARD HIRES    
  36. 360  IF CH < >5  THEN 390
  37. 370  POKE 49193,163: REM   DISPLAY SUPER HIRES
  38. 380  GET A$: POKE 49193,1: PRINT D$"PR#3": TEXT : GOTO 260
  39. 390  IF CH < >7  THEN 590
  40. 400  REM   *** SAVE SUPER HIRES SCREEN ***
  41. 410  HOME : ONERR  GOTO 430
  42. 420  PRINT D$"PREFIX "PR$: POKE 216,0: GOTO 440
  43. 430  POKE 216,0:RT = 3: GOTO 850
  44. 440  HOME 
  45. 450  HTAB 15: VTAB 5: PRINT "Enter the name you would like to save": HTAB 15: PRINT "the picture as.": HTAB 15: VTAB 9: PRINT "-->"PR$; CHR$(29);
  46. 460  HTAB 18 + LEN(PR$): VTAB 9: INPUT "";A$: IF   NOT  LEN(A$)  THEN 260
  47. 470 NF = 1: FOR I = 1 TO  LEN(A$):J =  ASC( MID$ (A$,I,1))
  48. 480 NF = ((J >64  AND J <91)  OR (J = 46)  OR (J >47  AND J <58  AND I >1))  AND NF = 1: NEXT 
  49. 490  IF  LEFT$(A$,1) = "."  OR  LEN(A$) >15  OR NF = 0  THEN  HTAB 15: VTAB 11: PRINT "Invalid ProDOS filename.": HTAB 15: PRINT "Press Return to continue.";: POKE  -16368,0: GET A$: VTAB 10: PRINT : PRINT  CHR$(29): PRINT  CHR$(29): GOTO 450
  50. 500  POKE 49193,163
  51. 510  ONERR  GOTO 580
  52. 520  FOR I = 1 TO 4
  53. 530  POKE 771,0: POKE 772,I *32: POKE 773,225
  54. 540  POKE 775,0: POKE 776,64: POKE 777,0: POKE 791,(I +1) *32
  55. 550  CALL 768: REM   *** LOAD NEXT PICTURE SEGMENT INTO MAIN MEMORY ***
  56. 560  PRINT D$"BSAVE "A$",A$4000,L$2000,B"(I -1) *8192
  57. 570  NEXT : POKE 49193,1: GOTO 260
  58. 580  POKE 49193,1: HOME : HTAB 15: VTAB 7: PRINT "Disk error!": PRINT : HTAB 15: PRINT "Press  Return to continue";: GET A$: GOTO 260
  59. 590  IF CH < >6  THEN 750
  60. 600  REM   *** CONVERT STANDARD TO SUPER HIRES ***
  61. 610  HOME : HTAB 15: VTAB 5: PRINT "Choose the desired conversion method:"
  62. 620  FOR I = 1 TO CN:DR$(I) = CV$(I): NEXT :DR = CN
  63. 630  GOSUB 1550: REM   *** MENU MAKER ***
  64. 640  IF CD = CN  THEN 260
  65. 650  POKE 230,64
  66. 660  POKE 24656,165: POKE 24657,233: POKE 24658,5: POKE 24659,234: POKE 24660,240: POKE 24661,22: POKE 24662,32: POKE 24663,19: REM    DEFAULT TO COLOR CONVERSION
  67. 670  IF CD = 1  THEN 720
  68. 680  POKE 24656,169: POKE 24657,0: POKE 24658,32: POKE 24659,184: POKE 24660,96: POKE 24661,76: POKE 24662,216: POKE 24663,96: REM   CHANGE TO BLACK & WHITE
  69. 690  IF CD = 2  THEN 720
  70. 700  IF CD = 3  THEN  POKE 24657,2: GOTO 720: REM   CHANGE TO GREEN
  71. 710  IF CD = 4  THEN  POKE 24657,4: REM   CHANGE TO AMBER (RED)
  72. 720  HOME : POKE 49193,163
  73. 730  CALL 24576
  74. 740  GET A$: POKE 49193,1: GOTO 610
  75. 750  IF CH >1  THEN 810
  76. 760  REM   *** CATALOG WITH PREFIX ***
  77. 770  HOME : ONERR  GOTO 800
  78. 780  PRINT D$"CATALOG "PR$
  79. 790  POKE 216,0: PRINT : PRINT "Press  Return to continue:";: GET A$: GOTO 260
  80. 800  PRINT : PRINT "ERROR!": GOTO 790
  81. 810  IF CH >2  THEN 1210
  82. 820  REM   *** CHANGE PREFIX ***
  83. 830 RT = 1
  84. 840  ONERR  GOTO 980
  85. 850  HOME 
  86. 860  HTAB 10: VTAB 7: PRINT "Select data disk drive:"
  87. 870  HTAB 10: VTAB 10: PRINT "Slot: "SL"          Drive: "DV
  88. 880  IF RT < >4  THEN  HTAB 27: VTAB 15: PRINT "Press ESC to return to menu"
  89. 890  HTAB 16: VTAB 10: GET A$: IF A$ < > CHR$(13)  AND A$ < > CHR$(27)  AND (A$ <"1"  OR A$ >"7")  THEN 890
  90. 900  IF A$ =  CHR$(27)  AND RT < >4  THEN 260
  91. 910  IF A$ =  CHR$(27)  THEN 890
  92. 920  IF  VAL(A$)  THEN SL =  VAL(A$): HTAB 16: VTAB 10: PRINT SL: GOTO 890
  93. 930  HTAB 16: VTAB 10: NORMAL : PRINT SL: HTAB 34: VTAB 10: GET A$: IF A$ < > CHR$(13)  AND A$ < > CHR$(27)  AND A$ < >"1"  AND A$ < >"2"  THEN 930
  94. 940  IF A$ =  CHR$(27)  AND RT < >4  THEN 260
  95. 950  IF A$ =  CHR$(27)  THEN 930
  96. 960  IF  VAL(A$)  THEN DV =  VAL(A$): HTAB 34: VTAB 10: PRINT DV: GOTO 930
  97. 970  PRINT : PRINT D$"PREFIX /": PRINT D$"PREFIX,S"SL",D"DV: PRINT D$"PREFIX": INPUT PR$: POKE 216,0: GOTO 1000
  98. 980  POKE 216,0: HOME : HTAB 10: VTAB 7: PRINT "I/O error": PRINT : IF RT < >4  THEN  HTAB 10: PRINT "Press  Return to return to menu";: GET A$: GOTO 260
  99. 990  HTAB 10: PRINT "Press  Return to try again.";: GET A$: GOTO 850
  100. 1000  HOME : PRINT D$"OPEN "PR$",TDIR": PRINT D$"READ "PR$
  101. 1010  ONERR  GOTO 1060
  102. 1020 DR = 0
  103. 1030  INPUT A$: IF  LEN(A$) <21  THEN 1030
  104. 1040  IF  MID$ (A$,18,3) < >"DIR"  THEN 1030
  105. 1050 DR = DR +1:DR$(DR) =  MID$ (A$,2,15): IF DR <20  THEN 1030
  106. 1060  PRINT D$"CLOSE"
  107. 1070  IF   NOT DR  THEN 1160
  108. 1080  POKE 216,0: HOME : HTAB 15: VTAB 5: PRINT "Select a subdirectory, or": HTAB 15: PRINT "Accept prefix as shown."
  109. 1089 DR = DR +1:DR$(DR) = ">>>ACCEPT<<<"
  110. 1090  HTAB 15: VTAB 19: PRINT "PREFIX: "PR$
  111. 1100  GOSUB 1550
  112. 1110  IF CD = DR  THEN 1170<CTRL-I>
  113. 1120  FOR I = 15 TO 1  STEP  -1: IF  MID$ (DR$(CD),I,1) = " "  THEN DR$(CD) =  LEFT$(DR$(CD),I -1): NEXT I
  114. 1130  IF  RIGHT$(PR$,1) < >"/"  THEN PR$ = PR$ +"/"
  115. 1140 PR$ = PR$ +DR$(CD)
  116. 1150 A =  FRE(0): GOTO 1000
  117. 1160  IF  RIGHT$(PR$,1) < >"/"  THEN PR$ = PR$ +"/"
  118. 1170  IF RT = 1  THEN 260
  119. 1180  IF RT = 2  THEN 1210
  120. 1190  IF RT = 3  THEN 410
  121. 1200  IF RT = 4  THEN 160
  122. 1210  HOME : ONERR  GOTO 1240: REM  *** LOAD STANDARD HIRES ***
  123. 1220  PRINT D$"PREFIX "PR$: IF PR$ = PD$  THEN 1340
  124. 1230  GOTO 1250
  125. 1240  POKE 216,0:RT = 2: GOTO 850
  126. 1250  PRINT D$"OPEN "PR$",TDIR": PRINT D$"READ "PR$: ONERR  GOTO 1300
  127. 1260 PD = 0
  128. 1270  INPUT A$: IF  LEN(A$) <30  THEN 1270
  129. 1280  IF  VAL( MID$ (A$,26,3)) < >17  THEN 1270
  130. 1290 PD = PD +1:PD$(PD) =  MID$ (A$,2,15): GOTO 1270
  131. 1300  POKE 216,0: PRINT D$"CLOSE": IF PD  THEN 1340
  132. 1310  POKE 216,0
  133. 1320  HOME : HTAB 15: VTAB 5: PRINT "There are no standard hires pictures": HTAB 15: PRINT "in this directory."
  134. 1330  PRINT : PRINT "Press  Return to continue:";: GET A$:A =  FRE(0): GOTO 260
  135. 1340  HOME : HTAB 15: VTAB 5: PRINT "Choose picture to load:"
  136. 1350 CD = PD +1:PD$(CD) = "RETURN TO MAIN": FOR I = 1 TO CD:DR$(I) = PD$(I): NEXT :DR = CD: GOSUB 1550:PD$ = PR$
  137. 1360  IF CD = DR  THEN 260
  138. 1370  PRINT D$"PR#0"
  139. 1380  PRINT  CHR$(149): HGR2 
  140. 1390  PRINT D$"BLOAD "PR$;DR$(CD)",A$4000"
  141. 1400  GET A$: TEXT : PRINT D$"PR#3": GOTO 260
  142. 1410  FOR I = 0 TO 26: READ A: POKE 768 +I,A:C = C +A: NEXT 
  143. 1420  IF C < >3025  THEN  HOME : PRINT "DATA STATEMENT ERROR!": END 
  144. 1430  DATA    162,0,191,0,64,0,159,0,32,225,232,208,245,238,4,3,238,8,3,173,4,3,201,96,208,232,96
  145. 1440  FOR I = 1 TO 365
  146. 1450  READ A: POKE 24575 +I,A: NEXT 
  147. 1460  RETURN 
  148. 1470  DATA    100,253,100,233,100,234,100,235,169,32,133,254,169,225,133,255,169,255,135,253,230,253,208,248,230,254,165,254,201,157,208,240,160,0,169,0,151,253,200,208,249,169,32,133,254,162,10,189,95
  149. 1480  DATA    97,159,0,158,225,202,16,246,169,0,143,30,158,225,143,31,158,225,32,50,97,208,8,169,15,32,184,96,76,216,96,165,233,5,234,240,22,32,19,97,32,50,97,240,11,32,30,97,169,0  
  150. 1490  DATA    32,184,96,76,216,96,32,30,97,32,30,97,32,50,97,240,11,32,19,97,169,0,32,184,96,76,216,96,100,7,32,19,97,32,50,97,177,38,41,128,240,4,169,2,133,7,165,233,41,1
  151. 1500  DATA    5,7,26,133,8,32,184,96,32,30,97,32,37,97,32,30,97,32,50,97,168,32,19,97,152,240,5,165,8,32,184,96,76,216,96,133,7,10,10,10,10,5,7,133,7,165,233,41,1,170
  152. 1510  DATA    189,107,97,37,7,133,7,189,105,97,39,253,5,7,135,253,96,32,30,97,32,37,97,165,234,208,3,76,67,96,169,20,141,2,97,165,233,201,24,16,3,76,67,96,240,3,206,2,97,100 
  153. 1520  DATA    233,100,234,230,235,165,253,24,105,20,133,253,144,2,230,254,165,235,201,192,240,3,76,67,96,96,198,233,165,233,201,255,208,2,198,234,96,230,233,208,2,230,234,96,165,233,41,1,240,6
  154. 1530  DATA    230,253,208,2,230,254,96,165,235,162,0,160,0,32,17,244,160,0,165,233,166,234,240,5,160,36,24,105,4,201,7,144,5,233,7,200,208,247,170,177,38,61,88,97,96,1,2,4,8,16
  155. 1540  DATA     32,64,255,15,15,15,240,0,15,0,0,15,240,15,15,240    
  156. 1550 CD = 1
  157. 1560 DD = 0:DT = DR: IF DT >10  THEN DD = DT -10:DT = 10
  158. 1570  IF   NOT MP  THEN  HTAB 26: VTAB 21: PRINT "Press ESC to return to menu"
  159. 1580  FOR I = 1 TO DT: HTAB 15: VTAB 7 +I: PRINT DR$(I): NEXT 
  160. 1590  IF DD  THEN  FOR I = 1 TO DD: HTAB 55: VTAB 7 +I: PRINT DR$(10 +I): NEXT 
  161. 1600  HTAB 15: VTAB 7 +CD -(10 *(CD >10)): IF CD >10  THEN  HTAB 55
  162. 1610  INVERSE : PRINT DR$(CD): NORMAL 
  163. 1620  IF  PEEK( -16384) <128  THEN 1620
  164. 1630 A =  PEEK( -16384) -128: POKE  -16368,0: IF A < >8  AND A < >10  AND A < >11  AND A < >13  AND A < >21  AND A < >27  THEN 1620
  165. 1640  IF A = 27  THEN CD = DR: RETURN 
  166. 1650  HTAB 15: VTAB 7 +CD -(10 *(CD >10)): IF CD >10  THEN  HTAB 55
  167. 1660  PRINT DR$(CD)
  168. 1670  IF A = 8  OR A = 11  THEN CD = CD -1 +((CD = 1) *DT): GOTO 1600
  169. 1680  IF A = 21  OR A = 10  THEN CD = CD +1 -((CD = DT +DD) *(DT +DD)): GOTO 1600
  170. 1690  RETURN