home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / tech / electro / design.bas next >
BASIC Source File  |  1979-12-31  |  17KB  |  469 lines
  1. 0 ' == D E S I G N . B A S == Version 2.0
  2. 1 ' Graphic formulas from Bob Boothe, from 80-Microcomputing, April-June 1981,      and TRSColor Computer routines from Jake Commander and Kavlos Gesamte, in       80-Micro, March 1982.
  3. 2 ' IBM PC conversions and modifications by Marty Smith. Houston, Texas.            (713) 661-1241  (Office)
  4. 3 ' SOURCE ST2259, COMPUSERVE 72155,1214.
  5. 4 ' This program requires BASICA, the Color Board, 64K and up, should work with     any  color display. My system has both boards and exiting through <M> or        <ALT X> makes <F7> a toggle between Color and B/W.
  6. 5 ' The <ALT X> exit leaves a design on the Color Screen and puts you in Command    Mode on Monochrome.
  7. 6 ' Originally the Function Keys called up elaborate designs that took too long     to generate on the screen. (One took the PC 2 1/2 hours). These were saved      in 16K BLOAD screens, which pretty much filled a whole disk.
  8. 7 ' That's what the BEEP's from function keys 1-8 are. This also keeps you from     inputting text strings to the program, while leaving them intact at command     mode.
  9. 25 GOSUB 8000
  10. 30 PI=3.141593
  11. 40 GOSUB 10000
  12. 45 IF ALT=1 THEN GOSUB 1601 ELSE GOSUB 1600
  13. 46 N=VAL(I$):IF I$="m" OR I$="M" THEN KEY 7,"gosub 65000"+CHR$(13):END
  14. 50 IF I$="0" THEN N=10 ELSE IF I$="c" OR I$="C" THEN GOSUB 20000
  15. 52 IF I$=CHR$(45) OR I$=CHR$(95) THEN N=11 ELSE IF I$="=" THEN N=12
  16. 53 IF I$="q" OR I$="Q" THEN M=1:GOTO 5810 ELSE IF I$="w" OR I$="W" THEN M=2:GOTO 5810 ELSE IF I$="e" OR I$="E" THEN M=3:GOTO 5810 ELSE IF I$="r" OR I$="R" THEN M=4:GOTO 5810 ELSE IF I$="t" OR I$="T" THEN M=5:GOTO 5810
  17. 54 IF I$="y" OR I$="Y" THEN M=6:GOTO 5810 ELSE IF I$="u" OR I$="U" THEN M=7:GOTO 5810 ELSE IF I$="i" OR I$="I" THEN M=8:GOTO 5810
  18. 55 ON N GOTO 110,210,320,400,500,700,850,1000,1200,1400,5000,5800
  19. 60 GOTO 40
  20. 100 REM design #5, Circle and circle
  21. 110 CLS:FOR T=0 TO 2*PI STEP PI/50
  22. 120 X1=COS(T)*160+159:Y1=SIN(T)*100+99
  23. 130 A=T+3*PI/4
  24. 140 X2=COS(A)*160+159:Y2=SIN(A)*100+99
  25. 150 GOSUB 1500
  26. 160 NEXT
  27. 170 GOSUB 1600
  28. 180 IF I$="x" THEN 40 ELSE IF I$=" " THEN 110 ELSE IF I$="0" THEN N=10:GOTO 50
  29. 200 N=VAL(I$):IF N>=0 AND N<16 THEN 50 ELSE 110
  30. 210 REM design #3, Moire Pattern
  31. 215 CLS:FOR T=0 TO PI/2 STEP PI/180
  32. 220 X1=FIX(COS(T)*100):Y1=SIN(T)*50
  33. 230 X2=FIX(COS(T)*320):Y2=SIN(T)*199
  34. 240 CO3=1:GOSUB 1500
  35. 250 X1=319-X1:Y1=199-Y1
  36. 260 X2=319-X2:Y2=199-Y2
  37. 270 CO3=2:GOSUB 1500
  38. 280 NEXT
  39. 300 GOSUB 1600
  40. 305 IF I$="x" THEN 40 ELSE IF I$=" " THEN 210 ELSE IF I$="0" THEN N=10:GOTO 50
  41. 310 N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 210
  42. 320 CLS:FOR T=0 TO 10*PI STEP PI/20:REM design 6, Spiral
  43. 330 X1=COS(T)*3.5*T+160:Y1=SIN(T)*3.5*T+100
  44. 340 A=T+2*PI/3
  45. 350 X2=COS(A)*3.5*A+160:Y2=SIN(A)*3.5*A+100
  46. 360 GOSUB 1500
  47. 370 NEXT
  48. 380 GOSUB 1600
  49. 390 IF I$="x" THEN 40 ELSE IF I$=" " THEN 320 ELSE IF I$="0" THEN N=10:GOTO 50
  50. 395 N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 320
  51. 400 CLS: FOR T=0 TO 2*PI STEP PI/60:REM design #8, Rotating Squares
  52. 410 R=COS(2*T)*100
  53. 420 X1=COS(T)*R+160:Y1=SIN(T)*R+100
  54. 430 A=T+PI/2
  55. 440 R2=COS(2*A)*100
  56. 450 X2=COS(A)*R2+160:Y2=SIN(A)*R2+100
  57. 460 GOSUB 1500
  58. 470 NEXT
  59. 480 GOSUB 1600
  60. 490 IF I$="x" THEN 40 ELSE IF I$=" " THEN 400 ELSE IF I$="0" THEN N=10:GOTO 50
  61. 495 N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 400
  62. 500 REM design #1, N-Sided Polygon
  63. 505 Z=0
  64. 510 PRINT"Number of points? (Maximum 48) "
  65. 515 FOR X=0 TO 10000:NEXT
  66. 516 I$=INKEY$:J$=INKEY$:I$=I$+J$:N=VAL(I$)
  67. 517 IF N=0 THEN N=CO1+10
  68. 518 IF N>48 THEN 510
  69. 519 CLS
  70. 520 FOR T=0 TO 2*PI-.001 STEP 2*PI/N
  71. 530 Z=Z+1
  72. 540 A(Z)=COS(T)*159+159:B(Z)=SIN(T)*99+99
  73. 550 NEXT
  74. 560 FOR S=1 TO N-1:FOR D=S+1 TO N
  75. 570 X1=A(S):Y1=B(S)
  76. 580 X2=A(D):Y2=B(D)
  77. 590 GOSUB 1500
  78. 600 NEXT:NEXT
  79. 650 GOSUB 1600:IF I$="x" THEN 40 ELSE IF I$=" " THEN 500 ELSE IF I$="0" THEN N=10:GOTO 50
  80. 660 N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 500
  81. 700 CLS:REM design #4, Square Spiral
  82. 710 X1=200:Y1=120
  83. 720 FOR Q=1 TO 40
  84. 730 X2=X1+5*Q+2:Y2=Y1
  85. 740 CO3=1:GOSUB 1500
  86. 750 X1=X2:Y1=Y2+5*Q+3
  87. 760 CO3=2:GOSUB 1500
  88. 770 X2=X1-5*Q-5:Y2=Y1
  89. 780 CO3=3:GOSUB 1500
  90. 790 X1=X2:Y1=Y2-5*Q-6
  91. 800 CO3=2:GOSUB 1500
  92. 810 NEXT
  93. 820 GOSUB 1600
  94. 830 IF I$="x" THEN 40 ELSE IF I$=" " THEN 700 ELSE IF I$="0" THEN N=10:GOTO 50
  95. 840 N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 700
  96. 850 CLS:REM design# 7, Four Leaf Rose
  97. 860 FOR T=0 TO 2*PI STEP PI/75
  98. 870 R=COS(2*T)*100
  99. 880 X1=COS(T)*R+159:Y1=SIN(T)*R+99
  100. 900 R2=COS(2*A)*100
  101. 910 X2=COS(A)*R2+159:Y2=SIN(A)*R2+99
  102. 920 GOSUB 1500
  103. 930 NEXT
  104. 940 GOSUB 1600
  105. 950 IF I$="x" THEN 40 ELSE IF I$=" " THEN 850 ELSE IF I$="0" THEN N=10:GOTO 50
  106. 960 N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 850
  107. 1000 CLS:REM design #10, Triangle Spiral
  108. 1010 FOR T=0 TO 2*PI STEP PI/30
  109. 1020 R=T*23
  110. 1030 X1=COS(T)*R+159:Y1=SIN(T)*R+99
  111. 1040 A=T+2*PI/3
  112. 1050 X2=COS(A)*R+159:Y2=SIN(A)*R+99
  113. 1060 GOSUB 1500
  114. 1070 B=T+4*PI/3
  115. 1080 X1=COS(B)*R+159:Y1=SIN(B)*R+99
  116. 1090 GOSUB 1500
  117. 1100 X2=COS(T)*R+159:Y2=SIN(T)*R+99
  118. 1110 GOSUB 1500
  119. 1120 NEXT
  120. 1130 GOSUB 1600
  121. 1140 IF I$="x" THEN 40 ELSE IF I$=" " THEN 1000 ELSE IF I$="0" THEN N=10:GOTO 50
  122. 1150 N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 1000
  123. 1200 REM design #11, Triangles in triangles
  124. 1210 R=1
  125. 1220 FOR T=0 TO 3.24 STEP PI/30
  126. 1230 R=R*1.16557
  127. 1240 X1=COS(T)*R+159:Y1=SIN(T)*R+99
  128. 1250 A=T+2*PI/3
  129. 1260 X2=COS(A)*R+159:Y2=SIN(A)*R+99
  130. 1270 CO3=1:GOSUB 1500
  131. 1280 B=T+4*PI/3
  132. 1290 X1=COS(B)*R+159:Y1=SIN(B)*R+99
  133. 1300 CO3=2:GOSUB 1500
  134. 1310 X2=COS(T)*R+159:Y2=SIN(T)*R+99
  135. 1320 CO3=3:GOSUB 1500
  136. 1330 NEXT
  137. 1340 CO3=2:GOSUB 1600
  138. 1350 IF I$="x" THEN 40 ELSE IF I$=" " THEN 1200 ELSE IF I$="0" THEN N=10:GOTO 50
  139. 1360 N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 1200
  140. 1400 Z=0:REM design # 2
  141. 1405 FOR Q=0 TO 319 STEP 9
  142. 1410 CO3=1:X1=0:Y1=Q*.625:X2=Q:Y2=199
  143. 1415 GOSUB 1500
  144. 1420 CO3=2:X1=Q:Y1=0:X2=319:Y2=Q*.625
  145. 1425 GOSUB 1500
  146. 1430 NEXT
  147. 1435 N=15
  148. 1440 FOR T=0 TO 2*PI -.001 STEP 2*PI/N
  149. 1445 Z=Z+1
  150. 1450 A(Z)=COS(T)*100+159:B(Z)=SIN(T)*65+99
  151. 1455 NEXT
  152. 1460 FOR S=1 TO N-1:FOR D=S+1 TO N
  153. 1465 X1=A(S):Y1=B(S)
  154. 1470 X2=A(D):Y2=B(D)
  155. 1475 CO3=3:GOSUB 1500
  156. 1477 NEXT:NEXT
  157. 1480 GOSUB 1600
  158. 1490 IF I$="x" THEN 40 ELSE IF I$=" " THEN 1400 ELSE IF I$="0" THEN N=10: GOTO 50
  159. 1495 N=VAL(I$):IF N>=0 AND N < 13 THEN 50 ELSE 1400
  160. 1500 LINE(X1,Y1)-(X2,Y2),CO3
  161. 1510 RETURN
  162. 1600 I$="":DEF SEG:IF ALT=1 THEN 3600: ' DELAY/COLOR/SELECTION ROUTINE
  163. 1601 FOR Z=0 TO 3000
  164. 1602 I$=INKEY$:IF I$<>"" THEN Z=3000
  165. 1603 NEXT:Z=FRE(X$)
  166. 1604 IF I$="" THEN N1=CO1 MOD 16:I$ = STR$(N1)
  167. 1605 GOSUB 2000
  168. 1607 IF CO1 MOD 2 = 0 THEN CO2 = 1 ELSE IF CO1 MOD 2 = 1 THEN CO2 = 0
  169. 1608 IF LEN(I$)=2 THEN GOSUB 1640
  170. 1610 CLS:SCREEN 1,0:COLOR CO1,CO2:OUT 980,2:OUT 981,HSYNC%
  171. 1620 RETURN
  172. 1640 IF ASC(RIGHT$(I$,1))=45 THEN GOSUB 65000:END
  173. 1645 IF ASC(RIGHT$(I$,1))=30 THEN IF ALT=0 THEN ALT=1:GOSUB 4100 ELSE IF ALT=1 THEN ALT=0:GOSUB 4200
  174. 1650 RETURN
  175. 2000 CO1=RND(RNDGEN):CO2=RND(RNDGEN+1):CO3=RND(RNDGEN+3)
  176. 2005 CO2=CO2*100 MOD 2
  177. 2010 CO1=CO1*100 MOD 16
  178. 2040 CO3=CO3*100 MOD 3 + 1
  179. 2100 RETURN
  180. 3000 REM ///// F10 COLOR CHANGE ROUTINE \\\\\
  181. 3005 I$=""
  182. 3020 FOR XIT=0 TO 3000
  183. 3030 I$=INKEY$:IF I$ <> "" THEN XIT=3000
  184. 3040 NEXT XIT
  185. 3050 IF I$="b" OR I$="B" THEN CO1=0 ELSE IF I$="u" OR I$="U" THEN CO1=1 ELSE IF I$="g" OR I$="G" THEN CO1=2 ELSE IF I$="c" OR I$="C" THEN CO1=3 ELSE IF I$="r" OR I$="R" THEN CO1=4
  186. 3055 IF I$="m" OR I$="M" THEN CO1=5 ELSE IF I$="n" OR I$="N" THEN CO1=6 ELSE IF I$="w" OR I$="W" THEN CO1=7
  187. 3060 IF I$="s" OR I$="S" THEN CO1=9 ELSE IF I$="y" OR I$="Y" THEN CO1=14 ELSE IF I$="h" OR I$="H" THEN CO1=15
  188. 3065 IF I$="0" THEN CO2=0 ELSE IF I$="1" THEN CO3=1 ELSE IF I$="2" THEN CO3=2 ELSE IF I$=""THEN CO3=3 ELSE IF I$="9" THEN CO2=1
  189. 3070 COLOR CO1,CO2
  190. 3100 RETURN
  191. 3600 REM alternate non-auto
  192. 3610 Z=0
  193. 3620 FOR Z1= 0 TO 100
  194. 3625 I$=INKEY$
  195. 3630 NEXT Z1
  196. 3632 ZAP=FRE(X$)
  197. 3635 IF Z=0 THEN 3620
  198. 3636 I$="x"
  199. 3640 GOTO 1604
  200. 3700 REM toggle non-auto
  201. 3710 BEEP
  202. 3720 Z=1
  203. 3730 SOUND 500,2
  204. 3740 RETURN
  205. 3800 I$="":DEF SEG:IF ALT=1 THEN 3600
  206. 3801 FOR ZINT=0 TO 3000
  207. 3802 I$=INKEY$:IF I$<>"" THEN ZINT=3000
  208. 3803 NEXT:ZAP=FRE(X$)
  209. 3810 GOTO 1604
  210. 3900 REM clear input buffer
  211. 3910 DEF SEG=&H40:BEGIN%=PEEK(&H1A):POKE &H1C,BEGIN%
  212. 3920 BEEP
  213. 3930 RETURN
  214. 4000 REM Dummy keys
  215. 4010 PLAY "MBXO$;"
  216. 4020 RETURN
  217. 4100 REM play my bonnie to indicate change of state
  218. 4110 PLAY "MBXM$;"
  219. 4120 RETURN
  220. 4200 REM more music
  221. 4210 PLAY "MBXN$;"
  222. 4220 RETURN
  223. 4300 REM
  224. 4310 PLAY "MBXP$;"
  225. 4320 RETURN
  226. 5000 A=31:FOR DO3%=1 TO 2
  227. 5010 Z=VAL(RIGHT$(TIME$,2))
  228. 5020 Z%=VAL(RIGHT$(TIME$,2))
  229. 5030 GOSUB 2000:COLOR CO1,CO2
  230. 5040 FOR N=10 TO 1 STEP -2
  231. 5050 FOR Q=316 TO 319
  232. 5060 LINE(Q,0)-(Q,199),3
  233. 5070 NEXT
  234. 5080 FOR Q=197 TO 199
  235. 5090 LINE(0,Q)-(319,Q),3
  236. 5100 NEXT
  237. 5110 FOR X=79 TO 0 STEP -N
  238. 5120 LINE(X,0)-(39,33),3
  239. 5130 NEXT
  240. 5140 FOR Y=0 TO 67 STEP N
  241. 5150 LINE(0,Y)-(39,33),3
  242. 5160 NEXT
  243. 5170 FOR X=0 TO 79 STEP N
  244. 5180 LINE(X,67)-(39,33),3
  245. 5190 NEXT
  246. 5200 FOR Y=67 TO 0 STEP -N
  247. 5210 LINE(79,Y)-(39,33),3
  248. 5220 NEXT
  249. 5230 GET(0,0)-(78,66),C
  250. 5240 PUT( 79,  0),C,PRESET
  251. 5250 PUT(157,  0),C,PSET
  252. 5260 PUT(235,  0),C,PRESET
  253. 5270 PUT(  0, 67),C,PRESET
  254. 5280 PUT( 79, 67),C,PSET
  255. 5290 PUT(157, 67),C,PRESET
  256. 5300 PUT(235, 67),C,PSET
  257. 5310 PUT(  0,133),C,PSET
  258. 5320 PUT( 79,133),C,PRESET
  259. 5330 PUT(157,133),C,PSET
  260. 5340 PUT(235,133),C,PRESET
  261. 5350 NEXT
  262. 5360 FOR A=0 TO 319 STEP 5
  263. 5370 LINE(  A,  0)-(159, 99),2
  264. 5380 NEXT
  265. 5390 FOR A=0 TO 199 STEP 5
  266. 5400 LINE(319,  A)-(159, 99),2
  267. 5410 NEXT
  268. 5420 FOR A=319 TO 0 STEP -5
  269. 5430 LINE(  A,199)-(159, 99),2
  270. 5440 NEXT
  271. 5450 FOR A=199 TO 0 STEP -5
  272. 5460 LINE(  0,  A)-(159, 99),2
  273. 5470 NEXT
  274. 5480 FOR A=1 TO 318 STEP 5
  275. 5490 LINE(  A,  0)-(159, 99),0
  276. 5500 NEXT
  277. 5510 FOR A=1 TO 198 STEP 5
  278. 5520 LINE(319,  A)-(159, 99),0
  279. 5530 NEXT
  280. 5540 FOR A=318 TO 1 STEP -5
  281. 5550 LINE(  A,199)-(159, 99),0
  282. 5560 NEXT
  283. 5570 FOR A=199 TO 1 STEP -5
  284. 5580 LINE(  0,  A)-(159, 99),0
  285. 5590 NEXT
  286. 5600 FOR A=1 TO 130 STEP 3
  287. 5610 CIRCLE(159,99),A,2
  288. 5620 NEXT
  289. 5630 FOR B=0 TO 99
  290. 5640 LINE(159,99-B)-(159+B,99),0
  291. 5650 LINE -(159, 99+B),0
  292. 5660 LINE -(159-B,99 ),0
  293. 5670 LINE -(159, 99-B),0
  294. 5680 CIRCLE(159,99),B/2,1
  295. 5690 NEXT
  296. 5695 NEXT
  297. 5700 GOSUB 1600
  298. 5710 IF I$="x" OR I$="X" THEN 40 ELSE IF I$=" " THEN 5000 ELSE IF I$="0" THEN N=10:GOTO 50
  299. 5720 N=VAL(I$):IF N>=0 AND N<14 THEN 50 ELSE 5000
  300. 5800 M=RND(1)*1000 MOD 8 + 1
  301. 5810 GOSUB 7000
  302. 5820 GOSUB 6000
  303. 5890 GOSUB 1600
  304. 5900 IF I$="x" OR I$="X" THEN 40 ELSE IF I$=" " THEN 5810 ELSE IF I$="0" THEN N=10:GOTO 50
  305. 5910 N=VAL(I$):IF N>=0 AND N<14 THEN 50 ELSE 5810
  306. 6000 D=D/57.29578
  307. 6005 CLS:XA=159:YA=99
  308. 6010 R=0
  309. 6020 X=R*COS(R)*A+159:Y=R*SIN(R)*B+99
  310. 6030 XP=X+OF:YP=Y:OF=OF+DO
  311. 6040 IF XP<0 OR XP>319 OR YP<0 OR YP> 199 THEN 6110
  312. 6050 IF S$="d" OR S$="D" THEN 6090 ELSE IF S$="b" OR S$="B" THEN 6070 ELSE IF S$="c" OR S$="C" THEN 6080
  313. 6060 LINE(XA,YA)-(XP,YP),CO3:GOTO 6100
  314. 6070 LINE(XA,YA)-(XP,YP),CO3,B:GOTO 6100
  315. 6080 CIRCLE(XP,YP),5,CO3:GOTO 6100
  316. 6090 PSET(XP,YP),CO3
  317. 6100 XA=X:YA=Y:R=R+D:GOTO 6020
  318. 6110 RETURN
  319. 7000 IF M=1 THEN D=73:S$="L":OF=0:DO=0:A=.6:B=.4:RETURN
  320. 7010 IF M=2 THEN D=183:S$="L":OF=0:DO=.3:A=.3:B=.2:RETURN
  321. 7020 IF M=3 THEN D=357.8:S$="L":OF=0:DO=.4:A=.05:B=.05:RETURN
  322. 7030 IF M=4 THEN D=45.1:S$="L":OF=0:DO=.3:A=.3:B=.3:RETURN
  323. 7040 IF M=5 THEN D=44.9:S$="B":OF=0:DO=0:A=.6:B=.6:RETURN
  324. 7050 IF M=6 THEN D=33:S$="B":OF=0:DO=0:A=.4:B=.4:RETURN
  325. 7060 IF M=7 THEN D=180.5:S$="B":OF=0:DO=0:A=.4:B=.4:RETURN
  326. 7070 D=91:S$="L":OF=0:DO=0:A=.5:B=.5
  327. 7100 RETURN
  328. 8000 KEY (9) ON:KEY (10) ON:KEY(11) ON
  329. 8002 FOR X% = 1 TO 8: KEY (X%) ON: ON KEY (X%) GOSUB 9000:NEXT X%
  330. 8005 ON KEY (9) GOSUB 3700:ON KEY (10) GOSUB 3000:ON KEY(11) GOSUB 3900
  331. 8010 DIM A(50),B(50),C(350)
  332. 8014 KEY OFF:CLS
  333. 8015 TOG=2:GOSUB 65010:SCREEN 0,1
  334. 8020 SCREEN 0,1:HSYNC%=45
  335. 8025 RNDGEN=VAL(RIGHT$(TIME$,2))+VAL(MID$(TIME$,4,2))*12:ALT=0
  336. 8026 GOSUB 40000:GOSUB 30000
  337. 8030 RETURN
  338. 9000 REM Dummy Function keys
  339. 9010 BEEP
  340. 9020 RETURN
  341. 10000 REM menu
  342. 10010 SCREEN 0,1,0,0:COLOR 15,1,1:CLS:OUT 980,2:OUT 981,HSYNC%
  343. 10020 IF ALT=0 THEN COLOR 0,7 ELSE IF ALT=1 THEN COLOR 7,0
  344. 10025 LOCATE 3,8,0
  345. 10030 PRINT CHR$(16);" IBM PC LINE PATTERNS "; CHR$(17):PRINT
  346. 10040 COLOR  0,1
  347. 10050 PRINT "*** Press X to return to this Menu ***"
  348. 10060 PRINT "   Function Keys 1 to 10 are active."
  349. 10065 PRINT
  350. 10070 COLOR 15,1
  351. 10080 PRINT "        1 - Circle and Circle."
  352. 10090 PRINT "        2 - Moire Pattern."
  353. 10100 PRINT "        3 - Spiral."
  354. 10110 PRINT "        4 - Rotating Squares."
  355. 10120 PRINT "        5 - N-Sided Polygon."
  356. 10130 PRINT "        6 - Square Spiral."
  357. 10140 PRINT "        7 - Four Leaf Rose."
  358. 10150 PRINT "        8 - Outside Triangle Spiral."
  359. 10160 PRINT "        9 - Inside Triangle Spiral."
  360. 10165 PRINT "        0 - Big Eye."
  361. 10170 PRINT "        - - Multiple Pattern."
  362. 10175 PRINT "        = - Spirographs."
  363. 10180 PRINT "  Keys  Q thru I are more Spirographs."
  364. 10185 COLOR 23,1
  365. 10190 PRINT :PRINT "PRESS a key, C for Colors, or M to end?"
  366. 10200 RETURN
  367. 20000 SCREEN 1,0:COLOR 0,1
  368. 20010 PRINT "****  COLOR CONTROL COMMAND MENU  ****"
  369. 20020 PRINT
  370. 20030 PRINT "       PRESS F10 and a letter:"
  371. 20040 PRINT
  372. 20050 PRINT " B = Black   U = Blue    G = Green"
  373. 20060 PRINT " C = Cyan    R = Red     M = Magenta"
  374. 20070 PRINT " N = Brown   W = White   S = Light Blue"
  375. 20080 PRINT " Y = Yellow  H = High Intensity White"
  376. 20090 PRINT
  377. 20100 PRINT "     Or PRESS F10 and a number:
  378. 20110 PRINT
  379. 20120 PRINT "   0 = Palette 0    9 = Palette 1
  380. 20130 PRINT
  381. 20140 PRINT "       Depending on Palette:"
  382. 20150 PRINT
  383. 20160 PRINT "    Green   =   1   =     Cyan"
  384. 20170 PRINT "     Red    =   2   =    Magenta"
  385. 20180 PRINT "    Brown   =   3   =     White"
  386. 20190 PRINT
  387. 20200 PRINT " PRESS RETURN TO CONTINUE OR TRY F10!"
  388. 20202 PRINT "       ";STRING$(6,19)
  389. 20205 FOR Z=0 TO 20000
  390. 20210 I$=INKEY$:IF I$=CHR$(13) THEN Z=20000
  391. 20220 NEXT
  392. 20230 RETURN
  393. 29000 REM move screen left
  394. 29010 HSYNC%=HSYNC%+1:IF HSYNC% > 46 THEN BEEP:HSYNC%=46
  395. 29020 OUT 980,2:OUT 981,HSYNC%
  396. 29030 RETURN
  397. 29100 REM move screen right
  398. 29110 HSYNC%=HSYNC%-1:IF HSYNC% < 36 THEN BEEP:HSYNC%=36
  399. 29120 OUT 980,2:OUT 981,HSYNC%
  400. 29130 RETURN
  401. 30000 CLS
  402. 30020 SCREEN 0,1:COLOR 3,0:OUT 980,2:OUT 981,HSYNC%
  403. 30050 PRINT "This program will run unattended all "
  404. 30060 PRINT "by itself, or it can be shifted into "
  405. 30070 PRINT "manual operation by pressing ";:COLOR 12,0:PRINT "ALT A";:COLOR 3,0
  406. 30080 PRINT "at the menu screen. ";:COLOR 5,0:PRINT "In this mode, to"
  407. 30090 PRINT "procede with the next design press ";:COLOR 12,0:PRINT "F9.":COLOR 3,0
  408. 30110 PRINT "Pressing ";:COLOR 12,0:PRINT "ALT A";:COLOR 3,0:PRINT " again will return the"
  409. 30120 PRINT "program to auto operation.
  410. 30130 PRINT :COLOR 2,0
  411. 30140 PRINT "During any mode the top row of"
  412. 30150 PRINT "keys, from ";:COLOR 12,0:PRINT "1";:COLOR 2,0:PRINT " to ";:COLOR 12,0:PRINT "=";:COLOR 2,0:PRINT ", will call a design,"
  413. 30160 PRINT "as will ";:COLOR 12,0:PRINT "Q";:COLOR 2,0:PRINT " to ";:COLOR 12,0:PRINT "I";:COLOR 2,0:PRINT ". If nothing is done"
  414. 30170 PRINT "after about 10 seconds, the program"
  415. 30180 PRINT "will pick a design for you."
  416. 30190 COLOR 4,0:PRINT "RETURN";:COLOR 2,0:PRINT " is NOT needed for most input.";
  417. 30200 PRINT "Color backgrounds and palettes can be"
  418. 30210 PRINT "changed during operation. Press ";:COLOR 12,0:PRINT "C";:COLOR 2,0:PRINT
  419. 30220 PRINT "at the menu prompt for an explantion."
  420. 30230 PRINT :COLOR 6,0
  421. 30240 PRINT "Hitting the ";:COLOR 4,0:PRINT "SPACE";:COLOR 6,0:PRINT " bar repeats a design"
  422. 30250 PRINT "with a different color. Entering a"
  423. 30260 PRINT "series of keys results in a series of"
  424. 30270 PRINT "designs, but they come on top of each"
  425. 30280 PRINT "other. Press ";:COLOR 4,0:PRINT "UP ARROW";:COLOR 6,0:PRINT " to clear buffer."
  426. 30290 LOCATE 25,1:INPUT "   Press RETURN to continue";I$:RETURN
  427. 30295 FOR GEN%=1 TO 32766
  428. 30296 RNDGEN%=GEN%:I$=INKEY$
  429. 30297 IF I$ <> ""  THEN GEN%=32766:X%=1
  430. 30298 NEXT GEN%
  431. 30299 Y=FRE(X$):IF X% <> 1 THEN 30295
  432. 30300 RANDOMIZE RNDGEN%
  433. 30310 RETURN
  434. 30311 X=X+1
  435. 30312 X=X-1
  436. 3031 f$=INKEY$
  437. 30314 IF I$=CHR$(13) THEN 30320
  438. 30315 X=FRE(X$)
  439. 30316 GOTO 30311
  440. 30320 KEY(12) OFF:KEY(13) OFF:SCREEN 1,0:OUT 980,0:OUT 981,HSYNC%:RETURN
  441. 40000 LOCATE 11,9:PRINT "IBM LINE PATTERNS PROGRAM":COLOR 22,0:LOCATE 15,16:PRINT "Press RETURN":COLOR 0,7:GOSUB 30295
  442. 40005 KEY(12) ON:KEY(13) ON:ON KEY(12) GOSUB 29000:ON KEY(13) GOSUB 29100:REM    Center Screen
  443. 40010 SCREEN 0,1:COLOR 7,1,4:CLS
  444. 40055 COLOR 7,1
  445. 40060 LOCATE  7, 8:PRINT "If this is not centered";
  446. 40070 LOCATE 10, 8:PRINT "on your screen, use the";
  447. 40080 LOCATE 13,13:PRINT "left and right";
  448. 40085 LOCATE 16, 8:PRINT "arrow keys to center it.";
  449. 40088 COLOR 31,1:LOCATE 19,14:PRINT "PRESS RETURN";:COLOR 7,1
  450. 40090 GOSUB 40400:RETURN
  451. 40400 X=X+1
  452. 40410 X=X-1
  453. 40420 I$=INKEY$
  454. 40430 IF I$=CHR$(13) THEN 40460
  455. 40440 X=FRE(X$)
  456. 40450 GOTO 40400
  457. 40460 KEY(12) OFF:KEY(13) OFF:SCREEN 1,0:RETURN
  458. 65000 IF TOG=1 THEN TOG=2 ELSE TOG=1
  459. 65010 ON TOG GOSUB 65080, 65030
  460. 65020 RETURN
  461. 65030 REM toggle color graphics
  462. 65050 DEF SEG=0: A=PEEK(&H410): POKE &H410,(A AND &HCF) OR &H20
  463. 65060 WIDTH 40:SCREEN 1:SCREEN 0:LOCATE ,,1,6,7: SCREEN 1,0
  464. 65070 RETURN
  465. 65080 REM toggle monochrome display
  466. 65100 DEF SEG=0: A=PEEK(&H410): POKE &H410,A OR &H30
  467. 65110 WIDTH 80: LOCATE ,,1,12,13:SCREEN 0,0,0
  468. 65120 RETURN
  469.