home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib42b.dsk / SHAPE.BUILDER.bas < prev    next >
BASIC Source File  |  2023-02-26  |  12KB  |  313 lines
  1. 10  REM  **********************
  2. 20  REM  * SHAPE BUILDER      *
  3. 30  REM  * BY BILL FORTENBERRY*
  4. 40  REM  * COPYRIGHT (C) 1992 *
  5. 50  REM  * BY MINDCRAFT PUBL. *
  6. 60  REM  * LINCOLN, MA. 01773 *
  7. 70  REM  **********************
  8. 80  LOMEM: 24576
  9. 90  TEXT : HOME : PRINT "****************************************": REM  40 *
  10. 100  FOR I = 2 TO 12: VTAB I: PRINT "*"; TAB( 40);"*": NEXT 
  11. 110  VTAB I
  12. 120  PRINT "****************************************": REM  40 *
  13. 130  INVERSE :A$ = "               ": VTAB 3: GOSUB 2420: VTAB 5: GOSUB 2420: REM  15 SPACES
  14. 140  VTAB 4: INVERSE :A$ = " SHAPE BUILDER ": GOSUB 2420: NORMAL 
  15. 150  VTAB 7:A$ = "APPLE II SHAPE TABLE UTILITY": GOSUB 2420
  16. 160  VTAB 9:A$ = "BY:   BILL FORTENBERRY": GOSUB 2420
  17. 170 A$ = "(C) 1992 BY MINDCRAFT PUBL.": VTAB 11: GOSUB 2420
  18. 180  POKE 34,13
  19. 190  REM  MENU
  20. 200  VTAB 15: HTAB 1: PRINT "WOULD YOU LIKE TO": PRINT : PRINT "     1.   BUILD A SHAPE TABLE": PRINT "     2.   CALCULATE POKE VALUES"
  21. 210  PRINT : INPUT "TYPE THE NUMBER (1-2) OF YOUR CHOICE    =->";A$
  22. 220  IF A$ = ""  THEN 200
  23. 230 A =  VAL(A$)
  24. 240  IF A <1  OR A >2  THEN 200
  25. 250  HOME 
  26. 270  IF A = 2  THEN 2430
  27. 280  REM  GATHER DATA
  28. 290  VTAB 17: INPUT "HOW MANY SHAPES IN THIS TABLE  ";SN$
  29. 300  IF SN$ = ""  THEN 290
  30. 310 SN =  VAL(SN$)
  31. 320  IF SN <0  THEN 290
  32. 330 SS = 10300
  33. 340  REM   POKE SHAPE LOCATION
  34. 350  POKE 232,SS - INT(SS/256) *256
  35. 360  POKE 233, INT(SS/256)
  36. 370  DIM G(1445),SD(SN +2)
  37. 380 SD(1) = SS +2 +SN *2
  38. 390  GR : POKE 34,20
  39. 400  REM  LOOP FOR # OF SHAPES
  40. 410  FOR SC = 1 TO SN
  41. 420 QQ =  FRE(0)
  42. 430  GR : HOME : POKE 34,20: HOME 
  43. 440  HOME : PRINT "SHAPE #";SC: PRINT "T)URTLE OR L)INE MODE (T/L)";: GET A$: IF A$ = "T"  THEN 2620
  44. 450  COLOR= 1:F = 0
  45. 460  HOME : PRINT  TAB( 33)"PLOT": POKE 33,30
  46. 470  REM  HLIN MODE
  47. 480  HOME : PRINT "HLIN FROM ";: INPUT "";A$
  48. 490  IF A$ = ""  THEN 480
  49. 500  IF A$ = "V"  THEN  HOME : GOTO 730
  50. 510  IF A$ = "F"  THEN 980
  51. 520  IF A$ = "P"  THEN 2330
  52. 530  IF A$ = "E"  THEN 2370
  53. 540  IF A$ = "Q"  THEN 1190
  54. 550  IF A$ = "?"  THEN 2980
  55. 560  PRINT "TO ";: INPUT "";B$
  56. 570  IF B$ = ""  THEN 560
  57. 580  IF B$ = "?"  THEN 2980
  58. 590 B =  VAL(B$)
  59. 600  IF B >38  THEN B = 38
  60. 610  IF B <1  THEN B = 1
  61. 620  PRINT "ON ";: INPUT "";C$
  62. 630  IF C$ = "?"  THEN 2980
  63. 640  IF C$ = ""  THEN 620
  64. 650 C =  VAL(C$)
  65. 660  IF C >38  THEN C = 38
  66. 670  IF C <1  THEN C = 1
  67. 680 A =  VAL(A$)
  68. 690  IF A <1  THEN A = 1
  69. 700  IF A >38  THEN A = 38
  70. 710  HLIN A,B AT C: PRINT : HOME : GOTO 480
  71. 720  REM  VLIN MODE
  72. 730  INPUT "VLIN FROM ";A$
  73. 740  IF A$ = ""  THEN 730
  74. 750  IF A$ = "H"  THEN  HOME : GOTO 480
  75. 760  IF A$ = "F"  THEN 980
  76. 770  IF A$ = "P"  THEN 2330
  77. 780  IF A$ = "E"  THEN 2370
  78. 790  IF A$ = "Q"  THEN 1190
  79. 800  IF A$ = "?"  THEN 2980
  80. 810  INPUT "TO ";B$
  81. 820  IF B$ = "?"  THEN 2980
  82. 830  IF B$ = ""  THEN 810
  83. 840 B =  VAL(B$)
  84. 850  IF B >38  THEN B = 38
  85. 860  IF B <1  THEN B = 1
  86. 870  INPUT "AT ";C$
  87. 880  IF C$ = "?"  THEN 2980
  88. 890  IF C$ = ""  THEN 870
  89. 900 C =  VAL(C$)
  90. 910  IF C >38  THEN C = 38
  91. 920  IF C <1  THEN C = 1
  92. 930 A =  VAL(A$)
  93. 940  IF A <1  THEN A = 1
  94. 950  IF A >38  THEN A = 38
  95. 960  VLIN A,B AT C: PRINT : HOME : GOTO 730
  96. 970  REM  FREE CURSOR MODE
  97. 980 X = 20:Y = 20
  98. 990 ZC =  SCRN( X,Y): COLOR= 15: PLOT X,Y
  99. 1000  POKE 33,40
  100. 1010  HOME : PRINT "X=";X;"  Y=";Y
  101. 1020  GET A$
  102. 1030  IF A$ = "Q"  THEN  COLOR= ZC: PLOT X,Y: GOTO 2330
  103. 1040  IF A$ = "P"  THEN ZC = 1: GOTO 1020
  104. 1050  IF A$ = "E"  THEN ZC = 0: GOTO 1020
  105. 1060  IF A$ = "?"  THEN 3040
  106. 1070 XX = X:YY = Y
  107. 1080  IF A$ = "I"  AND Y >1  THEN YY = Y -1: GOTO 1130
  108. 1090  IF A$ = "M"  AND Y <38  THEN YY = Y +1: GOTO 1130
  109. 1100  IF A$ = "J"  AND X >1  THEN XX = X -1: GOTO 1130
  110. 1110  IF A$ = "K"  AND X <38  THEN XX = X +1: GOTO 1130
  111. 1120  GOTO 1020
  112. 1130 CZ =  SCRN( XX,YY)
  113. 1140  COLOR= 15: PLOT XX,YY: COLOR= ZC: PLOT X,Y:X = XX:Y = YY
  114. 1150 ZC = CZ
  115. 1160  HOME : PRINT "X=";X;"  Y=";Y
  116. 1170  GOTO 1020
  117. 1180  REM  BOX IN SHAPE
  118. 1190 L = 0:Z = 0
  119. 1200  POKE 33,40: HOME 
  120. 1210  PRINT "LOCATING SHAPE EDGES"
  121. 1220  FOR D = 1 TO 39: IF  SCRN( L +1,D) = 1  THEN Z = 1
  122. 1230  NEXT 
  123. 1240  IF Z = 0  THEN L = L +1: GOTO 1220
  124. 1250 J = 39:Z = 0
  125. 1260  FOR D = 1 TO 39: IF  SCRN( J -1,D) = 1  THEN Z = 1
  126. 1270  NEXT 
  127. 1280  IF Z = 0  THEN J = J -1: GOTO 1260
  128. 1290 Z = 0:K = 39
  129. 1300  FOR D = 1 TO 39: IF  SCRN( D,K -1) = 1  THEN Z = 1
  130. 1310  NEXT 
  131. 1320  IF Z = 0  THEN K = K -1: GOTO 1300
  132. 1330 Z = 0:I = 0
  133. 1340  FOR D = 1 TO 39: IF  SCRN( D,I +1) = 1  THEN Z = 1
  134. 1350  NEXT 
  135. 1360  IF Z = 0  THEN I = I +1: GOTO 1340
  136. 1370  REM  CODE SHAPE
  137. 1380 Z = 1:D = 1:X = L:Y = I +1
  138. 1390  PRINT "CODING PLOT VECTORS"
  139. 1400 X = X +1:SX = X:SY = Y: IF  SCRN( X,Y) = 0  THEN 1400
  140. 1410 BX = X:BY = Y
  141. 1420  GOTO 1440
  142. 1430 X = X +D
  143. 1440  IF D = 1  AND X = J -1  AND  SCRN( X,Y) = 1  THEN G(Z) = 6:Y = Y +1:D =  -D:Z = Z +1: GOTO 1490
  144. 1450  IF D = 1  AND X = J -1  AND  SCRN( X,Y) = 0  THEN G(Z) = 2:Y = Y +1:D =  -D:Z = Z +1: GOTO 1490
  145. 1460  IF D =  -1  AND X = L +1  AND  SCRN( X,Y) = 0  THEN G(Z) = 2:Y = Y +1:D =  -D:Z = Z +1: GOTO 1490
  146. 1470  IF D =  -1  AND X = L +1  AND  SCRN( X,Y) = 1  THEN G(Z) = 6:Y = Y +1:D =  -D:Z = Z +1: GOTO 1490
  147. 1480  GOTO 1580
  148. 1490  IF Y > = K  THEN 1630
  149. 1500 F = 0
  150. 1510  FOR B = L TO J
  151. 1520  IF  SCRN( B,Y) = 1  THEN F = 1
  152. 1530  NEXT B
  153. 1540  IF F = 0  THEN G(Z) = 2:Y = Y +1:Z = Z +1: GOTO 1490
  154. 1550 F = 0
  155. 1560  IF Y > = K  THEN 1630
  156. 1570  GOTO 1440
  157. 1580  IF  SCRN( X,Y) = 1  AND D = 1  THEN G(Z) = 5:Z = Z +1
  158. 1590  IF  SCRN( X,Y) = 1  AND D =  -1  THEN G(Z) = 7:Z = Z +1
  159. 1600  IF  SCRN( X,Y) = 0  AND D = 1  THEN G(Z) = 1:Z = Z +1
  160. 1610  IF  SCRN( X,Y) = 0  AND D =  -1  THEN G(Z) = 3:Z = Z +1
  161. 1620  GOTO 1430
  162. 1630 G(Z) = 10
  163. 1640  REM  POKE SHAPE
  164. 1650 A = SD(SC)
  165. 1660 T = A
  166. 1670 Z = 0
  167. 1680  PRINT "POKING SHAPE DEFINITION"
  168. 1690 Z = Z +1
  169. 1700  IF G(Z) = 10  THEN 1790
  170. 1710 K = G(Z):Z = Z +1
  171. 1720  IF G(Z) = 10  THEN 1780
  172. 1730 K = K +G(Z) *8:Z = Z +1
  173. 1740  IF G(Z) = 10  THEN 1780
  174. 1750  IF G(Z) <4  AND G(Z) >0  THEN K = K +G(Z) *64:Z = Z +1
  175. 1760 Z = Z -1
  176. 1770  POKE A,K:A = A +1: GOTO 1690
  177. 1780  POKE A,K:A = A +1
  178. 1790  POKE A,0
  179. 1800  PRINT  CHR$(7)
  180. 1810  COLOR= 15: PLOT SX,SY
  181. 1820  HOME : PRINT "THIS DEFINITION STARTS ON THE WHITE DOT."
  182. 1830  VTAB 24: INPUT "PRESS RETURN TO PLOT SHAPE ";A$
  183. 1840  REM  DRAW SHAPE
  184. 1850  HOME 
  185. 1860  INPUT "SCALE = ";G$:G =  VAL(G$): IF G <1  THEN 1860
  186. 1870  SCALE= G: INPUT "ROT = ";G$:G =  VAL(G$): ROT= G
  187. 1880  HOME : PRINT "G)REEN  P)URPLE  O)RANGE  B)LUE  W)HITE": PRINT : PRINT "ENTER FIRST LETTER OF COLOR ";: GET A$: PRINT A$
  188. 1890  IF A$ < >"G"  AND A$ < >"P"  AND A$ < >"O"  AND A$ < >"B"  AND A$ < >"W"  THEN 1880
  189. 1900  REM   POKE THE DIRECTORY
  190. 1910  POKE SS,SN: POKE SS +1,0
  191. 1920 X = SS +1
  192. 1930  FOR I = 1 TO SC
  193. 1940 B = SD(I) -SS
  194. 1950 X = X +1:TA =  INT(B/256)
  195. 1960  POKE X,B -TA *256
  196. 1970 X = X +1: POKE X,TA
  197. 1980  NEXT I
  198. 1990  REM  EDIT THE SHAPE
  199. 2000  IF A$ = "W"  THEN  HCOLOR= 3
  200. 2010  IF A$ = "G"  THEN  HCOLOR= 1
  201. 2020  IF A$ = "O"  THEN  HCOLOR= 5
  202. 2030  IF A$ = "P"  THEN  HCOLOR= 2
  203. 2040  IF A$ = "B"  THEN  HCOLOR= 6
  204. 2050  HGR2 : DRAW SC AT 140,40
  205. 2060  INPUT A$: POKE  -16298,0: POKE  -16300,0: POKE  -16301,0
  206. 2070 SD(SC +1) = A +1
  207. 2080  IF TM = 0  THEN  COLOR= 1: PLOT BX,BY
  208. 2090  HOME 
  209. 2100  PRINT "DRAW THIS SHAPE AGAIN (Y/N) ";: GET A$: IF A$ = ""  THEN 2090
  210. 2110  IF A$ = "Y"  THEN 1850
  211. 2120  HOME 
  212. 2130  PRINT "EDIT THIS SHAPE (Y/N) ";: GET A$: IF A$ = ""  THEN 2130
  213. 2140  IF A$ = "Y"  AND TM = 1  THEN 2620
  214. 2150  IF A$ = "Y"  THEN 450
  215. 2160  IF TM = 1  THEN 2200
  216. 2170  HOME : PRINT "USE THIS SHAPE AS A BASE FOR ANOTHER ";: GET A$
  217. 2180  IF A$ = "Y"  AND SC <SN  THEN SC = SC +1: GOTO 450
  218. 2190  REM  NEXT SHAPE
  219. 2200  NEXT SC
  220. 2210  REM  TABLE DATA
  221. 2220  TEXT 
  222. 2230  HOME : PRINT "          SHAPE TABLE DATA"
  223. 2240  PRINT : PRINT : PRINT "SHAPE TABLE STARTS AT ";SS
  224. 2250  PRINT : PRINT "AND ENDS AT ";SD(SC)
  225. 2260  PRINT : PRINT "TABLE LENGTH IS ";SD(SC) -SS +1
  226. 2270  REM   SHAPE LOCATION
  227. 2280  PRINT : PRINT "SAVE SHAPE WITH THIS COMMAND -"
  228. 2290  PRINT 
  229. 2300  PRINT "BSAVE ";: INVERSE : PRINT "FILE NAME";: NORMAL : PRINT ",A";SS;",L";SD(SC) -SS +1
  230. 2310  END 
  231. 2320  REM  PLOT & ERASE SUBS
  232. 2330  POKE 33,40: HOME :
  233. 2340  PRINT  TAB( 33)"PLOT": POKE 33,30
  234. 2350  COLOR= 1
  235. 2360  HOME : GOTO 480
  236. 2370  POKE 33,40: HOME 
  237. 2380  PRINT  TAB( 33)"ERASE": POKE 33,30
  238. 2390  COLOR= 0
  239. 2400  HOME : GOTO 480
  240. 2410  REM  CENTER SUB
  241. 2420  HTAB 21 - LEN(A$)/2: PRINT A$: RETURN 
  242. 2430  REM  POKE CALCS
  243. 2440  VTAB 19: PRINT "START HEX NUMBERS WITH A '$'"
  244. 2450  VTAB 17: INPUT "WHERE WILL YOU PUT THE TABLE ";X$
  245. 2460 Y =  VAL(X$)
  246. 2470  IF  LEFT$(X$,1) = "$"  THEN X$ =  RIGHT$(X$, LEN(X$) -1): GOSUB 2540
  247. 2480 X = Y - INT(Y/256) *256:Z =  INT(Y/256)
  248. 2490  HOME : PRINT "USE THESE POKES IN YOUR PROGRAM BEFORE  YOU DRAW YOUR FIRST SHAPE"
  249. 2500  PRINT : PRINT "POKE 232,";X: PRINT "POKE 233,";Z
  250. 2510  PRINT 
  251. 2520  END 
  252. 2530  REM  HEX CONVERTER
  253. 2540 Y = 0:Z = 0
  254. 2550  FOR I =  LEN(X$) -1 TO 0  STEP  -1
  255. 2560 Z = Z +1
  256. 2570 Y1 =  ASC( MID$ (X$,Z,1)) -48
  257. 2580  IF Y1 >16  THEN Y1 = Y1 -7
  258. 2590 Y = Y +Y1 *16 ^I
  259. 2600  NEXT 
  260. 2610  RETURN 
  261. 2620  REM  TURTLE MODE
  262. 2630  GR : POKE 34,20: HOME : PRINT "MOVE DOT TO START & PRESS 'P'": POKE 34,21
  263. 2640 Z = 1:X = 20:Y = X:XX = Y:YY = Y:TM = 1
  264. 2650  COLOR= 0: PLOT XX,YY: COLOR= 15: PLOT X,Y:XX = X:YY = Y: HOME : PRINT "X=";X;"  Y=";Y: GET A$
  265. 2660  IF A$ = "P"  THEN SX = X:SY = Y: GOTO 2720
  266. 2670  IF A$ = "I"  AND Y >0  THEN Y = Y -1
  267. 2680  IF A$ = "M"  AND Y <39  THEN Y = Y +1
  268. 2690  IF A$ = "K"  AND X <39  THEN X = X +1
  269. 2700  IF A$ = "J"  AND X >0  THEN X = X -1
  270. 2710  GOTO 2650
  271. 2720 P = 1:ZC = 0: POKE 34,20
  272. 2730 XX = X:YY = Y: HOME : PRINT "X=";X;"  Y=";Y
  273. 2740  IF P = 1  THEN  INVERSE : PRINT "PLOT ON": NORMAL : GOTO 2760
  274. 2750  PRINT "PLOT OFF"
  275. 2760  GET A$
  276. 2770  IF A$ = "M"  AND Y <39  THEN G(Z) = 2:Z = Z +1:F = 0:Y = Y +1: GOTO 2870
  277. 2780  IF A$ = "J"  AND X >0  THEN G(Z) = 3:Z = Z +1:F = 0:X = X -1: GOTO 2870
  278. 2790  IF A$ = "K"  AND X <39  THEN G(Z) = 1:Z = Z +1:F = 0:X = X +1: GOTO 2870
  279. 2800  IF A$ = "I"  AND Y >0  AND (F = 0  OR P = 1)  THEN G(Z) = 0:F = 1:Z = Z +1:Y = Y -1: GOTO 2870
  280. 2810  IF A$ = "?"  THEN 3110
  281. 2820  IF A$ = "E"  THEN P = 0: GOTO 2730
  282. 2830  IF A$ = "P"  THEN P = 1: GOTO 2730
  283. 2840  IF A$ = "Q"  THEN G(Z) = 10: COLOR= ZC: PLOT X,Y: GOTO 1650
  284. 2850  IF A$ =  CHR$(27)  THEN 2900: REM    ESC KEY
  285. 2860  GOTO 2730
  286. 2870 CZ =  SCRN( X,Y): COLOR= ZC: PLOT XX,YY: COLOR= 15: PLOT X,Y:ZC = CZ
  287. 2880  IF P = 1  THEN G(Z -1) = G(Z -1) +4: COLOR= 1: PLOT XX,YY
  288. 2890  GOTO 2730
  289. 2900  IF Z >0  THEN Z = Z -1
  290. 2910  IF Z < = 0  THEN 2730
  291. 2920  ON G(Z) +1 GOSUB 2940,2950,2960,2970,2940,2950,2960,2970
  292. 2930  COLOR= 15: PLOT X,Y: COLOR= 0: PLOT XX,YY: GOTO 2730
  293. 2940 Y = Y +1: RETURN 
  294. 2950 X = X -1: RETURN 
  295. 2960 Y = Y -1: RETURN 
  296. 2970 X = X +1: RETURN 
  297. 2980  REM  LINE MODE HELP
  298. 2990  POKE 33,40: HOME 
  299. 3000  PRINT "V->  DRAW VERTICAL LINES": PRINT "H->  DRAW HORIZONTAL LINES": PRINT "F->  ENTER FREE CURSOR MODE": INPUT "PRESS RETURN";A$: HOME 
  300. 3010  PRINT "DRAW LINES BY GIVING THE ENDPOINTS AND": PRINT "LEVEL TO DRAW ON": INPUT "PRESS RETURN";A$: HOME 
  301. 3020  PRINT "P->  TURNS PLOT ON (DRAW LINES)": PRINT "E->  TURNS PLOT OFF (ERASE LINES)": INPUT "PRESS RETURN";A$: HOME 
  302. 3030  PRINT "Q->  QUIT DRAWING AND CODE THE SHAPE": INPUT "PRESS RETURN";A$: HOME : GOTO 2330
  303. 3040  REM  FREE CUR HELP
  304. 3050  HOME 
  305. 3060  PRINT "I,J,K,M KEYS MOVE THE CURSOR": PRINT "P->  PLOT A POINT": PRINT "E->  ERASE A POINT": INPUT "PRESS RETURN";A$
  306. 3070  HOME 
  307. 3080  PRINT "P & E ONLY EFFECT THE POINT THE CURSOR": PRINT "IS RESTING ON, NO OTHERS!": INPUT "PRESS RETURN";A$: HOME 
  308. 3090  PRINT "Q->  RETURNS YOU TO THE HLIN MODE WITH": PRINT "     PLOT ON": INPUT "PRESS RETURN";A$: HOME 
  309. 3100  GOTO 1000
  310. 3110  REM  TURTLE MODE HELP
  311. 3120  HOME : PRINT "I,J,K,M KEYS MOVE THE CURSOR": PRINT "P->  TURN PLOTTING ON": PRINT "E->  TURN PLOTTING OFF": INPUT "PRESS RETURN";A$: HOME 
  312. 3130  PRINT "THE ESC KEY WILL ALLOW YOU TO 'BACK UP'": PRINT "AND ERASE ERRORS": INPUT "PRESS RETURN";A$: HOME 
  313. 3140  PRINT "Q->  QUIT DRAWING AND CODE THE SHAPE": INPUT "PRESS RETURN";A$: HOME : GOTO 2730