File: FORBAX.BA of Tape: Various/ETH/ba1
(Source file text)
100 DIM A$(15) 110 DIM B$(15) 120 DIM C$(15) 130 DIM A(512) 140 DIM B(512) 150 DIM C(512) 160 UDEF INI(N),PLY(Y),DLY(N),DIS(S,E,N,X) 170 UDEF REV(N,I),CLK(R,O,S),CLW(N),ADC(N) 180 UDEF GET(M,L),PUT(M,L),DRI(N),DRO(M,N) 185 P9=3.14159 190 PRINT "FILENAME"; 200 INPUT A$ 210 A$="DSK:"&A$ 220 FILE #1:A$ 230 INPUT #1:B$,D1 240 C$=SEG$(B$,1,1) 250 IF C$="D" THEN 280 260 PRINT "BAD FILE" 270 GOTO 190 280 INPUT #1:P3,D1 290 IF P3>512 THEN 260 300 FILEVN #2:"SYS:FOURTM.NU" 330 PRINT #2:P3 340 T0=0 350 FOR I=0 TO P3-1 360 INPUT #1:A(I),D1 370 PRINT #2:A(I) 380 T1=ABS(A(I)) 390 IF T1<=T0 THEN 410 400 T0=T1 410 NEXT I 420 USE C 430 Z=INI(0) 440 FOR I=0 TO P3-1 450 Y=.5+A(I)/(T0*4.001) 460 X=PLY(Y) 470 W=DLY(P3-1) 480 NEXT I 490 FOR K=0 TO (P3/2)-1 500 A(K)=A(2*K) 510 B(K)=A(2*K+1) 520 NEXT K 530 FOR I=P3/2 TO 512 540 A(I)=0\B(I)=0 550 NEXT I 560 GOSUB 1540 570 A(512)=A(0) 580 B(512)=B(0) 590 GOSUB 1940 600 B(0)=0 610 B(512)=0 620 X1=0 630 FOR I=0 TO 511 640 X=SQR(A(I)*A(I)+B(I)*B(I)) 650 IF X<=X1 THEN 670 660 X1=X 670 Y=0 680 IF A(I)>0 THEN 720 690 IF A(I)<0 THEN 710 700 Y=SGN(B(I))/8\GOTO 730 710 Y=SGN(B(I))/4 720 Y=Y+ATN(B(I)/A(I))/(4*3.1416) 730 B(I)=Y 740 A(I)=X 750 NEXT I 760 Z=INI(0) 770 FOR I=0 TO 511 780 Y=.5+A(I)/(4.0001*X1) 790 X=PLY(Y) 800 W=DLY(1023) 810 NEXT I 820 FOR I=0 TO 511 830 Y=.5+B(I) 840 X=PLY(Y) 850 W=DLY(1023) 860 NEXT I 870 FOR I=0 TO 100 880 W=DLY(1023) 890 NEXT I 900 FOR I=0 TO 512 910 C(I)=0 920 NEXT I 930 Z3=INT(512/P3) 940 FOR I=1 TO 20 950 C(I)=0 960 NEXT I 970 FOR I=0 TO 511 980 FOR J=9-Z3 TO 9+Z3 990 C(J)=C(J+1) 1000 NEXT J 1010 C(10+Z3)=A(I+1)-A(I) 1020 FOR J=10-Z3 TO 9 1030 IF C(J)<=0 THEN 1090 1040 IF C(J+Z3)>=0 THEN 1090 1050 NEXT J 1060 IF C(9-Z3)>0 THEN 1080 1070 IF C(10+Z3)>=0 THEN 1090 1080 C(I-Z3)=A(I-Z3) 1090 NEXT I 1100 INPUT #1:I9,D1 1110 INPUT #1:T9,D1 1120 Z4=1E10 1130 FOR J=0 TO 9 1140 X1=0 1150 GOSUB 1480 1160 IF X1=0 THEN 1210 1170 IF Q(0,2)/X1>20 THEN 1210 1180 Q(J,0)=T1*P9/512\Q(J,1)=4*P9*B(T1) 1190 Q(J,2)=X1\Q(J,3)=P9*T9/P3 1200 Z4=X1\GOTO 1220 1210 Q(J,0)=512 1220 NEXT J 1350 FOR I=0 TO 2 1360 PRINT #2:Q(I,0);Q(I,1);Q(I,2);Q(I,3) 1370 PRINT Q(I,0),Q(I,1),Q(I,2),Q(I,3) 1380 NEXT I 1390 PRINT #2:I9 1400 PRINT #2:T9 1410 FOR J=1 TO I9-1 1420 INPUT #1:D1,D2 1430 PRINT #2:D1 1440 NEXT J 1450 CLOSE #2 1460 CHAIN "DSK:NONLIR.BA" 1470 STOP 1480 FOR I=0 TO 511 1490 IF C(I)<X1 THEN 1520 1500 IF C(I)>=Z4 THEN 1520 1510 X1=C(I)\T1=I 1520 NEXT I 1530 RETURN 1540 C3=0 1550 I3=0 1560 L=256 1570 D3=-2/(1+C3*C3) 1580 D4=C3*D3 1590 H=2*D3 1600 C1=1 1610 S1=0 1620 FOR I=0 TO I3 1630 J=REV(9,I) 1640 K3=J+L-1 1650 FOR K=J TO K3 1660 K4=K+L 1670 P1=A(K) 1680 P2=B(K) 1690 Q1=A(K4)*C1-B(K4)*S1 1700 Q2=A(K4)*S1+B(K4)*C1 1710 A(K)=P1+Q1 1720 B(K)=P2+Q2 1730 A(K4)=P1-Q1 1740 B(K4)=P2-Q2 1750 NEXT K 1760 C1=C1+D3 1770 S1=S1+D4 1780 D3=H*C1+D3 1790 D4=H*S1+D4 1800 NEXT I 1810 I3=2*I3+1 1820 READ C3 1830 REM C3=C3+SQR(1+C3*C3) 1840 L=L/2 1850 IF L>.9 THEN 1570 1860 J=0 1870 FOR I=1 TO 511 1880 J=REV(9,I) 1890 IF J>=I THEN 1920 1900 H=A(I)\A(I)=A(J)\A(J)=H 1910 H=B(I)\B(I)=B(J)\B(J)=H 1920 NEXT I 1930 RETURN 1940 READ H1 1950 REM SIN(ATN(1)/256) 1960 R=-4*H1*H1 1970 D3=-R/2 1980 READ D4 1990 REM SIN(2*ATN(1)/256) 2000 F1=1/P3 2010 C1=1 2020 S1=0 2030 FOR K=0 TO 256 2040 N3=512-K 2050 F2=A(K)+A(N3) 2060 F3=B(K)-B(N3) 2070 G1=A(K)-A(N3) 2080 G2=B(K)+B(N3) 2090 H1=G1*C1+G2*S1 2100 H2=G2*C1-G1*S1 2110 A(K)=(F2+H2)*F1 2120 A(N3)=(F2-H2)*F1 2130 B(K)=(H1-F3)*F1 2140 B(N3)=(H1+F3)*F1 2150 D3=R*C1+D3 2160 C1=C1+D3 2170 D4=R*S1+D4 2180 S1=S1+D4 2190 NEXT K 2200 RETURN 2210 DATA 1,2.41421,5.02734,10.1532,20.3554,40.7355,81.4832,162.972 2220 DATA 325.948,0.00306795,0.00613588 2230 END