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*(Y<Z)-Z*(Z<=Y)))-Y*(Y<(-X*(X<Z)-Z*(Z<=X)))-Z*(Z<=(-X*(X<Y)-Y*(Y<=X)))
120 DIM A1(53%,3%),A2%(101%,3%),A3(101%,3%),X3(2%,3%)
130 DIM B1%(101%),B2%(50%,2%),B4(3%,3%),B5%(3%,2%),B8(7%,2%),B9(10%)
140 DATA -1,-1,5,-1,-1,5,1,2,3,2,2,18
150 DATA 1,2,1,3,2,3
160 DATA 1,2,1
170 REM rotera :   190 DATA 15,-15,0,0,15,-15,6,.02,6,0 ta bort rad 740 och 1020
180 REM {ggkartong :   190 DATA 90,0,0,90,15,-15,6,.03,4,.2
190 DATA 0,0,0,0,0,0,6,.025,6,0
200 RANDOMIZE 
210 FOR I%=1% TO 3% : FOR J%=1% TO 2% : READ A1(I%,J%) : NEXT J% : NEXT I%
220 FOR I%=1% TO 3% : READ A2%(1%,I%),A3(1%,I%) : NEXT I%
230 FOR I%=1% TO 3% : FOR J%=1% TO 2% : READ B5%(I%,J%) : NEXT J% : NEXT I%
240 READ P%,E%,Q%
250 FOR I%=1% TO 10% : READ B9(I%) : NEXT I%
260 V1=.5/B9(9%)
270 ; CHR$(12%)TAB(37%)'STEREO'
280 FOR I%=0% TO 23% : ; CUR(I%,0%)CHR$(151%); : NEXT I%
290 FOR G%=1% TO 7%
300 B8(G%,1%)=FNC(B9(G%))
310 B8(G%,2%)=FNC1(B9(G%))
320 NEXT G%
330 FOR G%=1% TO 101%
340 B1%(G%)=G%
350 NEXT G%
360 N%=23%
370 REM ! INPUT THE DATA
380 FOR G%=4% TO N%
390 A1(G%,1%)=RND(0)
400 A1(G%,2%)=RND(0)
410 A1(G%,3%)=RND(0)/B9(9%)
420 NEXT G%
430 REM ! GENERATE THE DELAUNAY TRIANGULATION
440 FOR G%=4% TO N%
450 M%=0%
460 FOR H%=1% TO P%
470 D=A3(H%,3%)-(A1(G%,1%)-A3(H%,1%))^2%
480 IF D<0% THEN 700
490 D=D-(A1(G%,2%)-A3(H%,2%))^2%
500 IF D<0% THEN 700
510 E%=E%-1%
520 B1%(E%)=H%
530 FOR I%=1% TO 3%
540 IF M%<1% THEN 660
550 L%=M%
560 FOR J%=1% TO L%
570 IF A2%(H%,B5%(I%,1%))<>B2%(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 T<R OR S>R 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