home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib34b.dsk / HIRES.SCAN.bas < prev    next >
BASIC Source File  |  2023-02-26  |  9KB  |  197 lines
  1. 10  REM **********************
  2. 20  REM * HIRES.SCAN         *
  3. 30  REM * BY RON SJOLANDER   *
  4. 40  REM * COPYRIGHT(C) 1988  *
  5. 50  REM * MICROSPARC, INC.   *
  6. 60  REM * CONCORD, MA 01742  *
  7. 70  REM **********************
  8. 80  TEXT : HOME : PRINT  CHR$(21): SCALE= 1: ROT= 0
  9. 90  POKE 49232,0: POKE 49235,0: POKE 49236,0: POKE 49239,0: REM  HGR W/O CLEARING SCREEN
  10. 100  LOMEM: 24576: REM  ABOVE PAGE 2
  11. 110 MEM = 16384: REM  STORE SHAPE TABLE ON PAGE 2
  12. 120  ONERR  GOTO 1840
  13. 130 PRODOS =  PEEK(48896) = 76: IF   NOT PRODOS  THEN D$ =  CHR$(13)
  14. 140 LF$ =  CHR$(8):RT$ =  CHR$(21):DN$ =  CHR$(10):UP$ =  CHR$(11)
  15. 150  DIM M(1000),VEC(900)
  16. 160  POKE 232,0: POKE 233,64
  17. 170 D$ = D$ + CHR$(4)
  18. 180  GOSUB 1750: REM  HIRES (SCRN) FUNCTION
  19. 190  GOTO 570
  20. 200  VTAB 21: HTAB 1: CALL  -958: INVERSE : HTAB 13: PRINT "PLEASE STANDBY": NORMAL : HTAB 1: RETURN 
  21. 210  REM  MOVE CURSOR
  22. 220  IF X$ = "J"  OR X$ = "j"  OR X$ = LF$  THEN H = X -5: IF H <0  THEN H = X: RETURN 
  23. 230  IF X$ = "K"  OR X$ = "k"  OR X$ = RT$  THEN H = X +5: IF H >279  THEN H = X: RETURN 
  24. 240  IF X$ = "I"  OR X$ = "i"  OR X$ = UP$  THEN V = Y -5: IF V <0  THEN V = Y: RETURN 
  25. 250  IF X$ = "M"  OR X$ = "m"  OR X$ = DN$  THEN V = Y +5: IF V >159  THEN V = Y: RETURN 
  26. 260  XDRAW 1 AT X,Y
  27. 270  XDRAW 1 AT H,V
  28. 280 X = H:Y = V: RETURN 
  29. 290  REM  CREATE SHAPE TABLE ENTRIES
  30. 300 B = 0:Q = 0: FOR V = 1 TO P
  31. 310  IF B = 2  AND M(V) >0  AND M(V) <4  THEN 340
  32. 320  IF B <2  AND (M(V) >0  OR M(V) >4)  THEN 340
  33. 330 B = 0:Q = Q +1
  34. 340 VEC(Q) = VEC(Q) +M(V) *(8 ^B)
  35. 350 B = B +1
  36. 360  IF B >2  THEN B = 0:Q = Q +1
  37. 370  VTAB 23: HTAB 34: PRINT V: NEXT V
  38. 380  RETURN 
  39. 390  REM  SCAN RIGHT
  40. 400  FOR I = X1 TO X2 -1
  41. 410  & C = I,Y1
  42. 420 P = P +1:M(P) = 1: IF C = 1  THEN M(P) = 5
  43. 430  NEXT I
  44. 440  & C = X2,Y1
  45. 450 P = P +1:M(P) = 2: IF C = 1  THEN M(P) = 6
  46. 460 Y1 = Y1 +1: IF Y1 >Y2  THEN E = 1
  47. 470  RETURN 
  48. 480  REM  SCAN LEFT
  49. 490  FOR I = X2 TO X1 +1  STEP  -1
  50. 500  & C = I,Y1
  51. 510 P = P +1:M(P) = 3: IF C = 1  THEN M(P) = 7
  52. 520  NEXT I
  53. 530  & C = X1,Y1
  54. 540 P = P +1:M(P) = 2: IF C = 1  THEN M(P) = 6
  55. 550 Y1 = Y1 +1: IF Y1 >Y2  THEN E = 1
  56. 560  RETURN 
  57. 570 F$ = "": VTAB 21: HTAB 1: CALL  -958: PRINT "DO YOU WANT TO ADD THIS SHAPE TO AN": PRINT "EXISTING TABLE? (Y/N) ";: POKE  -16368,0: GET X$
  58. 580  IF X$ = "N"  OR X$ = "n"  THEN 730
  59. 590  IF X$ < >"Y"  AND X$ < >"y"  THEN 570
  60. 600  VTAB 21: HTAB 1: CALL  -958: PRINT "ENTER SHAPE TABLE FILENAME": PRINT "OR PRESS '?' FOR CATALOG": INPUT ">";F$: IF F$ = "?"  THEN 1920
  61. 610  PRINT D$;"BLOAD ";F$;",A";MEM
  62. 620 LE =  PEEK(43616 +5224 *PRODOS) + PEEK(43617 +5224 *PRODOS) *256
  63. 630  IF  PEEK(MEM +2) + PEEK(MEM +3) *256 >( PEEK(MEM) +1) *2  THEN 790
  64. 640  VTAB 21: CALL  -958: PRINT "SORRY - THERE'S NOT ENOUGH ROOM IN YOUR"
  65. 650  PRINT "TABLE DIRECTORY FOR ANOTHER SHAPE."
  66. 660  PRINT "TRY ANOTHER SHAPE TABLE? (Y/N) ";:
  67. 670  GET X$
  68. 680  IF X$ = "Y"  OR X$ = "y"  THEN 570
  69. 690  IF X$ < >"N"  AND X$ < >"n"  THEN 670
  70. 700  GOTO 1820
  71. 710  REM  NEW SHAPE TABLE
  72. 720 F$ = ""
  73. 730  VTAB 21: HTAB 1: CALL  -958: PRINT "HOW MANY SHAPES WOULD YOU LIKE TO "
  74. 740  PRINT "LEAVE SPACE FOR IN THE SHAPE DIRECTORY?"
  75. 750  INPUT NS$:NS =  VAL(NS$): IF NS <1  OR NS >255  THEN  PRINT  CHR$(7); CHR$(7);: GOTO 730
  76. 760 X = NS *2 +1:HB =  INT(X/256):LB = X -HB *256
  77. 770  POKE MEM,1: POKE MEM +1,0: POKE MEM +2,LB: POKE MEM +3,HB
  78. 780 LOC = MEM +2 +NS *2: GOTO 830
  79. 790  POKE MEM, PEEK(MEM) +1:LOC = MEM +LE
  80. 800 ST = LOC -MEM:HB =  INT(ST/256):LB = ST -HB *256
  81. 810  POKE MEM + PEEK(MEM) *2,LB: POKE MEM +1 + PEEK(MEM) *2,HB
  82. 820  REM  OUTLINE SHAPE
  83. 830  VTAB 21: CALL  -958: PRINT "POSITION THE CURSOR"
  84. 840  VTAB 24: INVERSE : PRINT "PRESS 'P' WHEN IN POSITION.";: NORMAL 
  85. 850  HCOLOR= 3:X = 4:Y = 144: POKE 232,39: POKE 233,3: XDRAW 1 AT X,Y:H = X:V = Y
  86. 860  FOR I = 1 TO 3
  87. 870  ON I GOSUB 930,940,970
  88. 880  GET X$: VTAB 23: IF X$ = "P"  OR X$ = "p"  THEN H(I) = H:V(I) = V: GOTO 900
  89. 890  GOSUB 220: GOTO 880
  90. 900  NEXT I: HOME : HCOLOR= 3: XDRAW 1 AT H,VZ: POKE 232,0: POKE 233,64
  91. 910  HPLOT H(1),V(1) TO H(2),V(1) TO H(2),V(3) TO H(1),V(3) TO H(1),V(1)
  92. 920  GOTO 1010
  93. 930  VTAB 22: HTAB 1: CALL  -868: PRINT "SLIGHTLY ABOVE AND LEFT OF THE SHAPE.": RETURN 
  94. 940  VTAB 22: HTAB 1: CALL  -868: VTAB 21: HTAB 1: CALL  -868
  95. 950  PRINT "MOVE THE CURSOR STRAIGHT ACROSS"
  96. 960  PRINT "TO THE RIGHT OF THE SHAPE.": RETURN 
  97. 970  VTAB 22: HTAB 1: CALL  -868: VTAB 21: HTAB 1: CALL  -868
  98. 980  PRINT "MOVE THE CURSOR STRAIGHT DOWN"
  99. 990  PRINT "TO JUST BELOW THE SHAPE": RETURN 
  100. 1000  REM  SHRINK OUTLINE
  101. 1010  GOSUB 200: VTAB 23: HTAB 2: PRINT "SHRINKING OUTLINE TO A MINIMUM SIZE."
  102. 1020  FOR I = V(1) +1 TO V(3) -1
  103. 1030  FOR II = H(1) +1 TO H(2) -1
  104. 1040  & C = II,I
  105. 1050  IF C = 1  THEN 1070
  106. 1060  NEXT II,I
  107. 1070 Y1 = I
  108. 1080  FOR I = H(1) +1 TO H(2) -1
  109. 1090  FOR II = Y1 TO V(3) -1
  110. 1100  & C = I,II
  111. 1110  IF C = 1  THEN 1130
  112. 1120  NEXT II,I
  113. 1130 X1 = I
  114. 1140  FOR I = V(3) -1 TO Y1  STEP  -1
  115. 1150  FOR II = X1 TO H(2) -1
  116. 1160  & C = II,I
  117. 1170  IF C = 1  THEN 1190
  118. 1180  NEXT II,I
  119. 1190 Y2 = I
  120. 1200  FOR I = H(2) -1 TO X1  STEP  -1
  121. 1210  FOR II = Y1 TO Y2
  122. 1220  & C = I,II
  123. 1230  IF C = 1  THEN 1250
  124. 1240  NEXT II,I
  125. 1250 X2 = I
  126. 1260  HCOLOR= 0: HPLOT H(1),V(1) TO H(2),V(1) TO H(2),V(3) TO H(1),V(3) TO H(1),V(1)
  127. 1270  HCOLOR= 3: HPLOT X1 -3,Y1 -3 TO X2 +3,Y1 -3 TO X2 +3,Y2 +3 TO X1 -3,Y2 +3 TO X1 -3,Y1 -3
  128. 1280  REM  SCAN SHAPE
  129. 1290  GOSUB 200: HTAB 1
  130. 1300  VTAB 23: PRINT "SCANNING RIGHT - ";Y1
  131. 1310  GOSUB 400: REM  SCAN RIGHT
  132. 1320  IF E = 1  THEN 1380
  133. 1330  VTAB 23: HTAB 1: CALL  -868: PRINT "SCANNING LEFT - ";Y1
  134. 1340  GOSUB 490: REM  SCAN LEFT
  135. 1350  IF E = 1  THEN 1380
  136. 1360  GOTO 1300
  137. 1370  REM  CREATE SHAPE TABLE ENTRIES AND POKE INTO TABLE
  138. 1380  GOSUB 200: VTAB 23: HTAB 3: PRINT "CREATING SHAPE TABLE ENTRIES -"
  139. 1390  VTAB 21: HTAB 33: PRINT "VECTOR";
  140. 1400  GOSUB 300
  141. 1410  GOSUB 200: VTAB 23: HTAB 4: PRINT "POKING SHAPE ENTRIES INTO TABLE."
  142. 1420  FOR I = 0 TO Q
  143. 1430  POKE LOC,VEC(I)
  144. 1440 LOC = LOC +1
  145. 1450  NEXT I
  146. 1460  POKE LOC,0
  147. 1470 LOC = LOC +1: POKE LOC,0
  148. 1480  HOME : VTAB 21: HTAB 1: PRINT "WOULD YOU LIKE TO SEE THE SHAPES IN": PRINT "THIS SHAPE TABLE? (Y OR N) ";: GET X$
  149. 1490  IF X$ = "N"  OR X$ = "n"  THEN 1610
  150. 1500  IF X$ < >"Y"  AND X$ < >"y"  THEN 1480
  151. 1510  HCOLOR= 3: SCALE= 1: ROT= 0
  152. 1520  FOR I = 1 TO  PEEK(MEM)
  153. 1530  HGR : DRAW I AT 100,100
  154. 1540  HOME : VTAB 21: HTAB 1
  155. 1550  VTAB 21: HTAB 1: CALL  -958: PRINT "PRESS RETURN TO CONTINUE ";: POKE  -16368,0: GET Z$
  156. 1560  NEXT I
  157. 1570  HOME : VTAB 21: PRINT "SEE THEM AGAIN? (Y OR N) ";: GET X$
  158. 1580  IF X$ = "Y"  OR X$ = "y"  THEN 1520
  159. 1590  IF X$ < >"N"  AND X$ < >"n"  THEN 1570
  160. 1600  HOME : VTAB 21: HTAB 1
  161. 1610  IF F$ = ""  THEN 1660
  162. 1620  PRINT "DO YOU WANT TO ADD THIS SHAPE"
  163. 1630  PRINT "TO ";F$;" (Y/N) ";: POKE  -16368,0: GET X$
  164. 1640  IF X$ = "Y"  OR X$ = "y"  THEN 1710
  165. 1650  IF X$ < >"N"  AND X$ < >"n"  THEN 1600
  166. 1660  HOME : VTAB 21: PRINT "WANT TO SAVE THIS SHAPE TABLE? (Y OR N)"
  167. 1670  GET X$: IF X$ = "N"  OR X$ = "n"  THEN 1820
  168. 1680  IF X$ < >"Y"  AND X$ < >"y"  THEN 1610
  169. 1690  VTAB 21: HTAB 1: CALL  -958
  170. 1700  PRINT "ENTER A NAME FOR THE TABLE": PRINT "OR PRESS RETURN TO CANCEL": INPUT ">";F$: IF F$ < >""  THEN LE = LOC -MEM: PRINT D$"BSAVE ";F$;",A";MEM;",L";LE
  171. 1710  ON F$ = "" GOTO 1820:LE = LOC -MEM
  172. 1720  PRINT D$;"BSAVE ";F$;",A";MEM;",L";LE
  173. 1730  GOTO 1820
  174. 1740  REM  POKE IN M/L HIRES "SCRN" FUNCTION FOLLOWED BY DOT SHAPE TABLE
  175. 1750  FOR I = 768 TO 812: READ J: POKE I,J: NEXT I
  176. 1760  DATA  32,227,223,133,133,132,134,169,208,32
  177. 1770  DATA  192,222,165,18,72,165,17,72,32,185
  178. 1780  DATA  246,32,17,244,165,48,49,38,240,2
  179. 1790  DATA  169,1,168,32,1,227,76,91,218,1,0,4,0,57,0
  180. 1800  POKE 1013,76: POKE 1014,0: POKE 1015,3
  181. 1810  RETURN 
  182. 1820  TEXT : HOME : VTAB 12: PRINT "PRESS RETURN TO CONTINUE": PRINT "OR ESCAPE TO QUIT": POKE  -16368,0: GET Z$: IF Z$ =  CHR$(27)  THEN  HOME : VTAB 23: END 
  183. 1830  RUN 
  184. 1840  VTAB 21: HTAB 1: CALL  -958:EN =  PEEK(222):EL =  PEEK(218) + PEEK(219) *256: REM    ERROR TRAP ROUTINE 
  185. 1850  IF EN = 6  THEN  PRINT "FILE NOT FOUND": GOTO 1890
  186. 1860  IF EN = 9  THEN  PRINT "DISK FULL"
  187. 1870  IF EN = 4  THEN  PRINT "DISK WRITE-PROTECTED": GOTO 1890
  188. 1880  IF EL = 1950  OR EL = 610  OR EL = 1700  OR EL = 1720  THEN  PRINT "DISK ERROR"
  189. 1890  PRINT "PRESS RETURN TO CONTINUE ";: POKE  -16368,0: GET Z$
  190. 1900  ON (EL = 610) +2 *(EL = 1700) +3 *(EL = 1720) +4 *(EL = 1950) GOTO 570,1660,1600,1920
  191. 1910  HOME : VTAB 23: PRINT "ERROR ";EN;" AT LINE ";EL: PRINT "PROGRAM TERMINATED";: END 
  192. 1920  TEXT : HOME : REM  CATALOG ROUTINE
  193. 1930  VTAB 2: HTAB 1: PRINT  SPC( 39): HTAB 1: INPUT "SLOT ?";SL$:SL =  VAL(SL$): IF SL <1  OR SL >7  THEN 1930
  194. 1940  VTAB 4: HTAB 1: PRINT  SPC( 39): HTAB 1: INPUT "DRIVE ?";DR$:DR =  VAL(DR$): IF DR <1  OR DR >2  THEN 1940
  195. 1950  PRINT D$; LEFT$("CATALOG",7 -4 *PRODOS);",S";SL;",D",DR: IF PRODOS  THEN  PRINT D$"PREFIX,S";SL;",D";DR
  196. 1960  PRINT : PRINT "PRESS RETURN TO CONTINUE ";: POKE  -16368,0: GET Z$
  197. 1970  POKE  -16304,0: GOTO 570