Atari XL/XE Crystals (BASIC)

1 REM ******************************
2 REM * CRYSTALS - author unknown  *
3 REM * -------------------------- *
4 REM *  NEW ATARI USER - Dec '91  *
5 REM ******************************
10 GOSUB 9000
15 DEG :RA=12:I=RA/2
20 DIM Q(80),W(80),E(80),R(80)
30 POKE 77,0
143 A1X=150:A2X=150:A1Y=95:A2Y=95
144 F1=RA*RND(1)-I:F2=RA*RND(1)-I
145 F5=RA*RND(1)-I:F6=RA*RND(1)-I
147 F7=RA*RND(1)-I:F8=RA*RND(1)-I
148 F3=RA*RND(1)-I:F4=RA*RND(1)-I
170 GOSUB 300
188 GRAPHICS 24
190 SETCOLOR 1,0,15:SETCOLOR 2,0,0
200 SETCOLOR 4,0,0
205 COLOR 1
206 GOSUB 4000
210 GOSUB 1000
230 FOR D=1 TO 200:POKE 53279,0:NEXT D:REM ADD GO SUB 10000 FOR PRINTOUT AND ENTER GR8DUMP1
270 GOTO 30
300 REM 
304 P=0
305 Z1=INT(361*RND(1)):Z2=INT(361*RND(1))
306 Z3=INT(361*RND(1)):Z4=INT(361*RND(1))
307 V=361*RND(1)
308 Z5=INT(361*RND(1)):Z6=INT(361*RND(1))
309 Z7=INT(361*RND(1)):Z8=INT(361*RND(1))
310 FOR X=V TO V+47 STEP 0.6
315 T1=SIN((Z1+X)*F1):T2=SIN((Z5+X)*F5)
320 Q(P)=ABS((A1X*(T1*T2+0.4)/1.4))
321 T1=SIN((Z2+X)*F2):T2=SIN((Z6+X)*F6)
322 W(P)=ABS((A1Y*(T1*T2+0.4)/1.4))
326 T1=SIN((Z3+X)*F3):T2=SIN((Z7+X)*F7)
330 E(P)=ABS((A2X*(T1*T2+0.4)/1.4))
331 T1=SIN((Z4+X)*F4):T2=SIN((Z8+X)*F8)
332 R(P)=ABS((A2Y*(T1*T2+0.4)/1.4))
338 IF P=74 THEN SETCOLOR 1,TINT,LUM:COLOR 1
340 P=P+1:NEXT X
350 RETURN 
1000 REM CALCULATE LINE
1010 K=P-1
1020 FOR P=1 TO K
1030 M=(W(P)-R(P))/(Q(P)-E(P))
1040 B=W(P)-M*Q(P)
1050 ST=(E(P)-Q(P))/20
1065 IF Q(P)=E(P) THEN Q(P)=Q(P)+1:GOTO 1030
1070 GOSUB 1500
1080 NEXT P
1085 FOR XX=1 TO 400:NEXT XX
1090 RETURN 
1500 FOR X=Q(P) TO E(P) STEP ST
1510 Y=M*X+B
1520 PLOT 160+X,96+Y
1530 PLOT 160+X,96-Y
1540 PLOT 160-X,96-Y
1550 PLOT 160-X,96+Y
1560 NEXT X
1570 RETURN 
4000 N=P
4010 K=P-1
4020 FOR P=1 TO K
4030 PLOT E(P),W(P)
4035 PLOT Q(P),R(P)
4040 PLOT E(P),191-W(P)
4045 PLOT Q(P),191-R(P)
4050 PLOT 319-E(P),191-W(P)
4055 PLOT 319-Q(P),191-R(P)
4060 PLOT 319-E(P),W(P)
4065 PLOT 319-Q(P),R(P)
4070 NEXT P
4080 P=N
4090 RETURN 
9000 DIM CR$(1):CR$=CHR$(155):DIM A$(192):REM FOR PRINTER DUMP
9010 GRAPHICS 2:OPEN #1,4,0,"K:":POKE 752,1
9020 SETCOLOR 0,8,10:SETCOLOR 2,0,0
9030 PRINT #6;CR$;CR$;CR$;CR$;
9050 PRINT #6;"      CRYSTALS"
9060 PRINT #6;""
9070 PRINT #6;"     by dynacomp"
9080 PRINT " Please Wait ........"
9090 POKE 752,0:RETURN