1 REM Ins{nd av Allan Lindblom <5879> 1986-03-05 18.40.18
10 REM +---------------------------------------------------+
20 REM ! STEREO.BAC !
30 REM ! Dave F. Watson Practical Computing aug. 1983 !
40 REM ! Till ABC80 av !
50 REM ! Allan Lindblom 860105 <5879> Ver. 1.2 !
60 REM +---------------------------------------------------+
62 REM Det tar n}gra sekunder innan uppritningen startar.
64 REM Se i |vrigt STEREO.INF.
70 REM ! STEREOSCOPIC SLICING
80 DEFFNC(X)=COS(X*PI/180%)
90 DEFFNC1(X)=SIN(X*PI/180%)
100 DEFFNM(X,Y,Z)=-X*(X>(-Y*(Y>Z)-Z*(Z>=Y)))-Y*(Y>(-X*(X>Z)-Z*(Z>=X)))-Z*(Z>=(-X*(X>Y)-Y*(Y>=X)))
110 DEFFNN(X,Y,Z)=-X*(X<(-Y*(YB2%(J%,1%) OR A2%(H%,B5%(I%,2%))<>B2%(J%,2%) THEN 650
580 M%=M%-1%
590 IF J%>M% THEN 690
600 FOR K%=J% TO M%
610 B2%(K%,1%)=B2%(K%+1%,1%)
620 B2%(K%,2%)=B2%(K%+1%,2%)
630 NEXT K%
640 GOTO 690
650 NEXT J%
660 M%=M%+1%
670 B2%(M%,1%)=A2%(H%,B5%(I%,1%))
680 B2%(M%,2%)=A2%(H%,B5%(I%,2%))
690 NEXT I%
700 NEXT H%
710 FOR I%=1% TO M%
720 K%=B1%(E%)
730 E%=E%+1%
740 FOR J%=1% TO 2%
750 L%=B2%(I%,J%)
760 B4(J%,1%)=A1(L%,1%)-A1(G%,1%)
770 B4(J%,2%)=A1(L%,2%)-A1(G%,2%)
780 B4(J%,3%)=B4(J%,1%)*(A1(L%,1%)+A1(G%,1%))/2%
790 B4(J%,3%)=B4(J%,2%)*(A1(L%,2%)+A1(G%,2%))/2%+B4(J%,3%)
800 NEXT J%
810 D=B4(1%,1%)*B4(2%,2%)-B4(1%,2%)*B4(2%,1%)
820 A3(K%,1%)=(B4(1%,3%)*B4(2%,2%)-B4(2%,3%)*B4(1%,2%))/D
830 A3(K%,2%)=(B4(1%,1%)*B4(2%,3%)-B4(2%,1%)*B4(1%,3%))/D
840 A3(K%,3%)=(A1(G%,1%)-A3(K%,1%))^2%+(A1(G%,2%)-A3(K%,2%))^2%
850 A2%(K%,1%)=B2%(I%,1%)
860 A2%(K%,2%)=B2%(I%,2%)
870 A2%(K%,3%)=G%
880 NEXT I%
890 P%=P%+2%
900 NEXT G%
910 GOTO 1000
920 REM ! ROTATE THE DATA SET
930 FOR G%=4% TO N%
940 Z=(A1(G%,3%)-V1)*B8(Q%,1%)-(A1(G%,1%)-.5)*B8(Q%,2%)+V1
950 A1(G%,1%)=(A1(G%,1%)-.5)*B8(Q%,1%)+(A1(G%,3%)-V1)*B8(Q%,2%)+.5
960 A1(G%,3%)=(Z-V1)*B8(Q%+1%,1%)+(A1(G%,2%)-.5)*B8(Q%+1%,2%)+V1
970 A1(G%,2%)=(A1(G%,2%)-.5)*B8(Q%+1%,1%)-(Z-V1)*B8(Q%+1%,2%)+.5
980 NEXT G%
990 REM ! SLICE THE DATA SET
1000 FOR H%=1% TO P%
1010 IF A2%(H%,1%)<4% OR A3(H%,3%)>1% THEN 1500
1020 T=FNM(A1(A2%(H%,1%),3%),A1(A2%(H%,2%),3%),A1(A2%(H%,3%),3%))
1030 S=FNN(A1(A2%(H%,1%),3%),A1(A2%(H%,2%),3%),A1(A2%(H%,3%),3%))
1040 R=-.866 : REM Altitude
1050 FOR I%=1% TO 100%
1060 R=R+B9(8%)
1070 IF TR THEN 1490
1080 Y%=1%
1090 U%=0%
1100 U%=U%+1%
1110 F=(R-A1(A2%(H%,B5%(U%,1%)),3%))/(A1(A2%(H%,B5%(U%,2%)),3%)-A1(A2%(H%,B5%(U%,1%)),3%))
1120 IF F<0% OR F>1% THEN 1160
1130 X3(Y%,1%)=A1(A2%(H%,B5%(U%,1%)),1%)+(A1(A2%(H%,B5%(U%,2%)),1%)-A1(A2%(H%,B5%(U%,1%)),1%))*F
1140 X3(Y%,2%)=A1(A2%(H%,B5%(U%,1%)),2%)+(A1(A2%(H%,B5%(U%,2%)),2%)-A1(A2%(H%,B5%(U%,1%)),2%))*F
1150 Y%=Y%+1%
1160 IF Y%<3% THEN 1100
1170 X3(1%,3%)=R
1180 X3(2%,3%)=R
1190 GOTO 1380
1200 REM ! REVERSE ROTATE THE INTERSECTION TRACES
1210 FOR G%=1% TO 2%
1220 Z=(X3(G%,3%)-V1)*B8(Q%+1%,1%)-(X3(G%,2%)-.5)*B8(Q%+1%,2%)+V1
1230 X3(G%,2%)=(X3(G%,2%)-.5)*B8(Q%+1%,1%)+(X3(G%,3%)-V1)*B8(Q%+1%,2%)+.5
1240 X3(G%,3%)=(Z-V1)*B8(Q%,1%)+(X3(G%,1%)-.5)*B8(Q%,2%)+V1
1250 X3(G%,1%)=(X3(G%,1%)-.5)*B8(Q%,1%)-(Z-V1)*B8(Q%,2%)+.5
1260 NEXT G%
1270 REM ! APPLY PERSPECTIVE AND VIEWPOINT
1280 FOR G%=1% TO 2%
1290 X4=X3(G%,1%)*X3(G%,2%)*B8(6%,2%)
1300 X3(G%,1%)=X3(G%,1%)+X4
1310 X3(G%,2%)=X3(G%,2%)+X4
1320 Y=(X3(G%,2%)-.5)*B8(5%,1%)+(X3(G%,1%)-.5)*B8(5%,2%)+.5
1330 X3(G%,1%)=(X3(G%,1%)-.5)*B8(5%,1%)+(X3(G%,2%)-.5)*B8(5%,2%)+.5
1340 X3(G%,2%)=(Y-.5)*B8(6%,1%)-(X3(G%,3%)-V1)*B8(6%,2%)+.5
1350 X3(G%,3%)=(X3(G%,3%)-V1)*B8(6%,1%)+(Y-.5)*B8(6%,2%)+V1
1360 NEXT G%
1370 REM ! DRAW THE STEREOGRAM PAIR
1380 X1=(X3(1%,1%)-.5)*B8(7%,1%)-(X3(1%,3%)-V1)*B8(7%,2%)+.5
1390 X2=(X3(2%,1%)-.5)*B8(7%,1%)-(X3(2%,3%)-V1)*B8(7%,2%)+.5
1400 REM ! LEFT PICTURE - DRAW A LINE FROM X1,X3(1,2) TO X2,X3(2,2)
1410 K9%=65% : V9%=0%
1420 X1=K9%*X1 : X2=K9%*X2 : Y1=K9%*X3(1%,2%) : Y2=K9%*X3(2%,2%)
1430 GOSUB 1630
1440 X1=(X3(1%,1%)-.5)*B8(7%,1%)+(X3(1%,3%)-V1)*B8(7%,2%)+.5
1450 X2=(X3(2%,1%)-.5)*B8(7%,1%)+(X3(2%,3%)-V1)*B8(7%,2%)+.5
1460 REM ! RIGHT PICTURE - DRAW A LINE FROM X1,X3(1,2) TO X2,X3(2,2)
1470 X1=K9%*X1 : X2=K9%*X2
1480 GOSUB 1690
1490 NEXT I%
1500 NEXT H%
1510 REM ! REVERSE ROTATE THE DATA SHEET
1520 IF Q%>B9(10%) THEN 1610
1530 FOR G%=4% TO N%
1540 Z=(A1(G%,3%)-V1)*B8(Q%+1%,1%)-(A1(G%,2%)-.5)*B8(Q%+1%,2%)+V1
1550 A1(G%,2%)=(A1(G%,2%)-.5)*B8(1%,1%)+(A1(G%,3%)-V1)*B8(Q%+1%,2%)+.5
1560 A1(G%,3%)=(Z-V1)*B8(Q%,1%)+(A1(G%,1%)-.5)*B8(Q%,2%)+V1
1570 A1(G%,1%)=(A1(G%,1%)-.5)*B8(Q%,1%)-(Z-V1)*B8(Q%,2%)+.5
1580 NEXT G%
1590 Q%=Q%+2%
1600 GOTO 930
1610 ; CUR(23%,5%)'KLART'; : GET \$
1614 END
1620 REM ! PLOTTING
1630 L1=(.5+(SQR(ABS(X2-X1)^2%+ABS(Y2-Y1)^2%)))
1640 FOR A%=0% TO L1
1650 X9%=X1+((X2-X1)*A%)/L1 : Y9%=Y1+((Y2-Y1)*A%)/L1
1660 SETDOT X9%+V9%,Y9%+10%
1670 NEXT A%
1680 RETURN
1690 L1=(.5+(SQR(ABS(X2-X1)^2%+ABS(Y2-Y1)^2%)))
1700 FOR A%=0% TO L1
1710 X9%=X1+((X2-X1)*A%)/L1 : Y9%=Y1+((Y2-Y1)*A%)/L1
1720 SETDOT X9%+V9%,Y9%+90%
1730 NEXT A%
1740 RETURN