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