MODULE MCALC; CONST PI=3.1416; CON=0.0174; NPTS=500; NODIM =6; NUS=540; TYPE PLANES=ARRAY[1..6,-25..25] OF REAL8; STAR= ARRAY[1..6,1..3] of real; ROM=ARRAY[1..8,1..6] OF INTEGER; VAR [EXTERN] COUNT,LIST,NUMU,NEXT,NXT:INTEGER; F1:ADS OF ARRAY[1..NUS,1..3,1..8]OF REAL; F:ARRAY[1..3,1..NPTS]OF REAL; VAR PLANE:PLANES; R:ROM; E:STAR; ORDER,DD,EE,FF:INTEGER; X,Y,Z:REAL8; K:ARRAY[1..6] OF INTEGER; SING: ARRAY[1..3,1..100] OF REAL; IDS: ARRAY[1..3] OF INTEGER; PROCEDURE READKEY(VAR I:INTEGER);EXTERN; PROCEDURE PPLOT(A:INTEGER);EXTERN; PROCEDURE CLEAR;EXTERN; PROCEDURE SET_DIS;EXTERN; PROCEDURE MENUE;EXTERN; FUNCTION ACSRQQ(CONSTS A:REAL4):REAL4;EXTERN; PROCEDURE DEFINE; VAR B,J,I,ARGI,ANS:INTEGER; PSI,ARG,A1,A2,A3,A4,A5,A6,B1,B2,B3,B4,B5,B6,A,INV,BB:REAL; PROCEDURE LOOPS; VAR I:INTEGER; BEGIN I:= -25; REPEAT ARG := (I/A1) + B1; ARGI := TRUNC(ARG); IF ARG <0 THEN ARGI := ARGI -1; B:= TRUNC(B1); IF B1 <0 THEN B:= B-1; PLANE[1,I]:=I+0.6180*ARGI+A1 {-B*0.618} ; I:= I+1; UNTIL I = 26; I:= -25; REPEAT ARG := (I/A2) + B2; ARGI := TRUNC(ARG); IF ARG <0 THEN ARGI := ARGI -1; B:= TRUNC(B2); IF B2 <0 THEN B:= B-1; PLANE[2,I]:=I+0.6180*ARGI+A2 {-B*0.618} ; I:= I+1; UNTIL I = 26; I:= -25; REPEAT ARG := (I/A3) + B3; ARGI := TRUNC(ARG); IF ARG <0 THEN ARGI := ARGI -1; B:= TRUNC(B3); IF B3 <0 THEN B:= B-1; PLANE[3,I]:=I+0.6180*ARGI+A3 {-B*0.618} ; I:= I+1; UNTIL I = 26; I:= -25; REPEAT ARG := (I/A4) + B4; ARGI := TRUNC(ARG); IF ARG <0 THEN ARGI := ARGI -1; B:= TRUNC(B4); IF B4 <0 THEN B:= B-1; PLANE[4,I]:=I+0.6180*ARGI+A4 {-B*0.618} ; I:= I+1; UNTIL I = 26; I:= -25; REPEAT ARG := (I/A5) + B5; ARGI := TRUNC(ARG); IF ARG <0 THEN ARGI := ARGI -1; B:= TRUNC(B5); IF B5 <0 THEN B:= B-1; PLANE[5,I]:=I+0.6180*ARGI+A5 {-B*0.618} ; I:= I+1; UNTIL I = 26; I:= -25; REPEAT ARG := (I/A6) + B6; ARGI := TRUNC(ARG); IF ARG <0 THEN ARGI := ARGI -1; B:= TRUNC(B6); IF B6 <0 THEN B:= B-1; PLANE[6,I]:=I+0.6180*ARGI+A6 {-B*0.618} ; I:= I+1; UNTIL I = 26; END; BEGIN {PLANE [ ONE OF SIX DIRECTIONS, K OR ORDINAL POSITION] := VALUE OF QUASIPERIODIC OR PERIODIC LEGNTH; THIS MEANS THAT FOR EVERY DIRECTION EVERY SLOT OR ORDINAL POSITION OF THE ARRAY HAS ASSOCIATED WITH IT A REAL NUMBER WHICH IS ITS DISTANCE FROM THE ORIGIN } A:=1.618; {tau is 1.618 1/tau is 0.6180} WRITELN; WRITELN(' CHOOSE BY NUMBER AND HIT RETURN '); WRITELN('1:CHOOSE ALPHAS AND BETAS '); WRITELN('2:CHOOSE DEFAULT ALPHAS AND BETAS '); WRITELN('3:CHOOSE UNIT PERIODIC ALPHAS AND BETAS '); READLN(ANS); CASE ANS OF 1: BEGIN WRITELN(' A1 B1 '); READLN(A1,B1); WRITELN(' A2 B2 '); READLN(A2,B2); WRITELN(' A3 B3 '); READLN(A3,B3); WRITELN(' A4 B4 '); READLN(A4,B4); WRITELN(' A5 B5 '); READLN(A5,B5); WRITELN(' A6 B6 '); READLN(A6,B6); LOOPS; END; 2: BEGIN A1:=0.6300;A2:=0.6300;A3:=0.6300;A4:=0.6300;A5:=0.6300;A6:=0.6300; B1:=-0.5;B2:=-0.5;B3:=-0.5;B4:=-0.5;B5:=-0.5;B6:=-0.5; LOOPS; END; 3: BEGIN WRITELN(' ENTER SHIFT FACTOR -->RETURN'); READLN(A1); FOR I:= -25 TO 25 DO PLANE [1,I] := I + A1; WRITELN(' ENTER SHIFT FACTOR -->RETURN'); READLN(A1); FOR I:= -25 TO 25 DO PLANE [2,I] := I + A1; WRITELN(' ENTER SHIFT FACTOR -->RETURN'); READLN(A1); FOR I:= -25 TO 25 DO PLANE [3,I] := I + A1; WRITELN(' ENTER SHIFT FACTOR -->RETURN'); READLN(A1); FOR I:= -25 TO 25 DO PLANE [4,I] := I + A1; WRITELN(' ENTER SHIFT FACTOR -->RETURN'); READLN(A1); FOR I:= -25 TO 25 DO PLANE [5,I] := I + A1; WRITELN(' ENTER SHIFT FACTOR -->RETURN'); READLN(A1); FOR I:= -25 TO 25 DO PLANE [6,I] := I + A1; end; END; (* writeln(plane[1,-6]:8,plane[1,-5]:8,plane[1,-4]:8,plane[1,-3]:8,plane[1,-2]:8,plane[1,-1]:8); writeln(plane[1,0]:8,plane[1,1]:8,plane[1,2]:8,plane[1,3]:8,plane[1,4]:8); WRITELN(plane[1,5]:8,plane[1,6]:8,plane[1,7]:8,plane[1,8]:8,plane[1,9]:8,plane[1,10]:8); *) (*THE STAR VECTOR MATRIX*) BB:=2*(1/SQRT(5)); INV:=1/SQRT(5); E[1,1]:=BB; E[1,2]:=0; E[1,3]:=INV; E[2,1]:=BB*COS(2*PI/5); E[2,2]:=BB*SIN(2*PI/5); E[2,3]:=INV; E[3,1]:=BB*COS(4*PI/5); E[3,2]:=BB*SIN(4*PI/5); E[3,3]:=INV; E[4,1]:=BB*COS(6*PI/5); E[4,2]:=BB*SIN(6*PI/5); E[4,3]:=INV; E[5,1]:=BB*COS(8*PI/5); E[5,2]:=BB*SIN(8*PI/5); E[5,3]:=INV; E[6,1]:=0; E[6,2]:=0; E[6,3]:=1; (* WRITELN( E[1,1]:10:4,E[1,2]:10:4,E[1,3]:10:4); WRITELN( E[2,1]:10:4,E[2,2]:10:4,E[2,3]:10:4); WRITELN( E[3,1]:10:4,E[3,2]:10:4,E[3,3]:10:4); WRITELN( E[4,1]:10:4,E[4,2]:10:4,E[4,3]:10:4); WRITELN( E[5,1]:10:4,E[5,2]:10:4,E[5,3]:10:4); WRITELN( E[6,1]:10:4,E[6,2]:10:4,E[6,3]:10:4); *) PSI := ACSRQQ(0.5/SIN(PI/5)); (*WRITELN( PSI:10:4,'PSI'); FOR I := 1 TO 5 DO BEGIN E[I,1] := COS((I-0.4)* 2*PI/5) * SIN( 2* PSI); E[I,2] := SIN((I-0.4)* 2*PI/5) * SIN( 2* PSI); E[I,3] := COS( 2*PSI); END; E[6,1]:=0; E[6,2]:=0; E[6,3]:=1; WRITELN( E[1,1]:10:4,E[1,2]:10:4,E[1,3]:10:4); WRITELN( E[2,1]:10:4,E[2,2]:10:4,E[2,3]:10:4); WRITELN( E[3,1]:10:4,E[3,2]:10:4,E[3,3]:10:4); WRITELN( E[4,1]:10:4,E[4,2]:10:4,E[4,3]:10:4); WRITELN( E[5,1]:10:4,E[5,2]:10:4,E[5,3]:10:4); WRITELN( E[6,1]:10:4,E[6,2]:10:4,E[6,3]:10:4); *) END; PROCEDURE DT(K:ROM;X:INTEGER); VAR I:INTEGER; BEGIN FOR I:=1 TO 8 DO BEGIN F1^[X,1,I]:=K[I,1]* E[1,1] + K[I,2] * E[2,1] + K[I,3] * E[3,1] + K[I,4]* E[4,1] + K[I,5] * E[5,1] + K[I,6] * E[6,1]; F1^[X,2,I]:=K[I,1]* E[1,2] + K[I,2] * E[2,2] + K[I,3] * E[3,2] + K[I,4]* E[4,2] + K[I,5] * E[5,2] + K[I,6] * E[6,2]; F1^[X,3,I]:=K[I,1]* E[1,3] + K[I,2] * E[2,3] + K[I,3] * E[3,3] + K[I,4]* E[4,3] + K[I,5] * E[5,3] + K[I,6] * E[6,3]; END; IF SQR(F1^[X,1,1])+SQR(F1^[X,2,1])+SQR(F1^[X,3,1]) <30 THEN PPLOT(X) ELSE BEGIN NEXT := NEXT-1; IF NEXT<1 THEN NEXT:=1; END; (*FOR I := 1 TO 8 DO WRITELN(K[I,1]:6,K[I,2]:6,K[I,3]:6,K[I,4]:6,K[I,5]:6,K[I,6]:6); *) END; FUNCTION FINDK( X:REAL8; A:INTEGER): INTEGER; VAR I:INTEGER; BEGIN IF X < PLANE[A,-25] THEN BEGIN FINDK := -25;WRITELN('FINK TOO LOW');END; FOR I :=-25 TO 24 DO BEGIN IF (X > PLANE[A,I]+0.005 ) AND (X < PLANE[A,I+1]-0.005) THEN FINDK := I ELSE IF (X>PLANE[A,I+1]-0.005) AND (X0) AND (IDS[2]=0) THEN IDS[2] := A ELSE IF (IDS[1]>0) AND (IDS[2]>0) THEN IDS[3] := A; END;{IF} END; {FOR} IF X >=PLANE[A,25] THEN BEGIN FINDK := 25;WRITELN('FINDK TOO HIGH');END; END; PROCEDURE DIREC(A,B,C:INTEGER); {TAKES IN THE THREE DIRECTIONS AND DISCOVERS THE OTHER THREE} VAR I:INTEGER;LEGAL:ARRAY[1..6] OF BOOLEAN; BEGIN FOR I := 1 TO 6 DO LEGAL[I]:=TRUE; LEGAL[A]:=FALSE; LEGAL[B]:=FALSE; LEGAL[C]:=FALSE; I:=0; REPEAT I:=I+1; IF LEGAL[I] THEN DD:= I UNTIL LEGAL[I]; LEGAL[I]:= FALSE; I:=0; REPEAT I:=I+1; IF LEGAL[I] THEN EE:= I UNTIL LEGAL[I]; LEGAL[I]:= FALSE; I:=0; REPEAT I:=I+1; IF LEGAL[I] THEN FF:= I UNTIL LEGAL[I]; END; PROCEDURE RHOMBUS(A,B,C:INTEGER); { SEVEN SIX-TUPLETS ARE COMPUTED FROM ONE KNOWN } { THE DIRECTIONS ARE PASSED THROUGH ie ARBITRARY SET OF DIRECTIONS} { R IS A 6x8 MATRIX THAT HOLDS THE KS FOR ONE RHOMBUS} { CALLS DT} BEGIN R[1,A]:=K[A]; R[1,B]:=K[B]; R[1,C]:=K[C]; R[1,DD]:=K[DD]; R[1,EE]:=K[EE]; R[1,FF]:=K[FF]; R[2,A]:=K[A]-1;R[2,B]:=K[B]; R[2,C]:=K[C]; R[2,DD]:=K[DD]; R[2,EE]:=K[EE]; R[2,FF]:=K[FF]; R[3,A]:=K[A]; R[3,B]:=K[B]-1; R[3,C]:=K[C]; R[3,DD]:=K[DD]; R[3,EE]:=K[EE]; R[3,FF]:=K[FF]; R[4,A]:=K[A]; R[4,B]:=K[B]; R[4,C]:=K[C]-1; R[4,DD]:=K[DD]; R[4,EE]:=K[EE]; R[4,FF]:=K[FF]; R[5,A]:=K[A]-1;R[5,B]:=K[B]-1; R[5,C]:=K[C]; R[5,DD]:=K[DD]; R[5,EE]:=K[EE]; R[5,FF]:=K[FF]; R[6,A]:=K[A]-1;R[6,B]:=K[B]; R[6,C]:=K[C]-1; R[6,DD]:=K[DD]; R[6,EE]:=K[EE]; R[6,FF]:=K[FF]; R[7,A]:=K[A]; R[7,B]:=K[B]-1; R[7,C]:=K[C]-1; R[7,DD]:=K[DD]; R[7,EE]:=K[EE]; R[7,FF]:=K[FF]; R[8,A]:=K[A]-1;R[8,B]:=K[B]-1; R[8,C]:=K[C]-1; R[8,DD]:=K[DD]; R[8,EE]:=K[EE]; R[8,FF]:=K[FF]; (* R[1,A]:=K[A]; R[1,B]:=K[B]; R[1,C]:=K[C]; R[1,DD]:=K[DD]; R[1,EE]:=K[EE]; R[1,FF]:=K[FF]; R[2,A]:=K[A]; R[2,B]:=K[B]; R[2,C]:=K[C]; R[2,DD]:=K[DD]+1; R[2,EE]:=K[EE]; R[2,FF]:=K[FF]; R[3,A]:=K[A]; R[3,B]:=K[B]; R[3,C]:=K[C]; R[3,DD]:=K[DD]; R[3,EE]:=K[EE]+1; R[3,FF]:=K[FF]; R[4,A]:=K[A]; R[4,B]:=K[B]; R[4,C]:=K[C]; R[4,DD]:=K[DD]; R[4,EE]:=K[EE]; R[4,FF]:=K[FF]+1; R[5,A]:=K[A]; R[5,B]:=K[B]; R[5,C]:=K[C]; R[5,DD]:=K[DD]+1; R[5,EE]:=K[EE]+1; R[5,FF]:=K[FF]; R[6,A]:=K[A]; R[6,B]:=K[B]; R[6,C]:=K[C]; R[6,DD]:=K[DD]+1; R[6,EE]:=K[EE]; R[6,FF]:=K[FF]+1; R[7,A]:=K[A]; R[7,B]:=K[B]; R[7,C]:=K[C]; R[7,DD]:=K[DD]; R[7,EE]:=K[EE]+1; R[7,FF]:=K[FF]+1; R[8,A]:=K[A]; R[8,B]:=K[B]; R[8,C]:=K[C]; R[8,DD]:=K[DD]+1; R[8,EE]:=K[EE]+1; R[8,FF]:=K[FF]+1; *) DT(R,NEXT); {THE VERTICIES OF A RHOMBUS ARE COMPUTED AND SEND TO F^ } (*FOR I := 1 TO 8 DO WRITELN( R[I,1]:6,R[I,2]:6,R[I,3]:6,R[I,4]:6,R[I,5]:6,R[I,6]:6); *) END; PROCEDURE DODEC(A,B,C,D:INTEGER); VAR AA,BB,CC:INTEGER; BEGIN (* R[1,A]:=K[A]; R[1,B]:=K[B]; R[1,C]:=K[C]; R[1,DD]:=K[DD]; R[1,EE]:=K[EE]; R[1,FF]:=K[FF]; R[2,A]:=K[A]+1;R[2,B]:=K[B]; R[2,C]:=K[C]; R[2,DD]:=K[DD]; R[2,EE]:=K[EE]; R[2,FF]:=K[FF]; R[3,A]:=K[A]; R[3,B]:=K[B]+1; R[3,C]:=K[C]; R[3,DD]:=K[DD]; R[3,EE]:=K[EE]; R[3,FF]:=K[FF]; R[4,A]:=K[A]; R[4,B]:=K[B]; R[4,C]:=K[C]+1; R[4,DD]:=K[DD]; R[4,EE]:=K[EE]; R[4,FF]:=K[FF]; R[5,A]:=K[A]+1;R[5,B]:=K[B]+1; R[5,C]:=K[C]; R[5,DD]:=K[DD]; R[5,EE]:=K[EE]; R[5,FF]:=K[FF]; R[6,A]:=K[A]+1;R[6,B]:=K[B]; R[6,C]:=K[C]+1; R[6,DD]:=K[DD]; R[6,EE]:=K[EE]; R[6,FF]:=K[FF]; R[7,A]:=K[A]; R[7,B]:=K[B]+1; R[7,C]:=K[C]+1; R[7,DD]:=K[DD]; R[7,EE]:=K[EE]; R[7,FF]:=K[FF]; R[8,A]:=K[A]+1;R[8,B]:=K[B]+1; R[8,C]:=K[C]+1; R[8,DD]:=K[DD]; R[8,EE]:=K[EE]; R[8,FF]:=K[FF]; DT(R,NEXT); NEXT:=NEXT+1; *) (* A:=AA;B:=BB;C:=CC; A:=B;B:=C;C:=DD;DD:=A; K[DD]:=K[DD]+1; R[1,A]:=K[A]; R[1,B]:=K[B]; R[1,C]:=K[C]; R[1,DD]:=K[DD]; R[1,EE]:=K[EE]; R[1,FF]:=K[FF]; R[2,A]:=K[A]+1;R[2,B]:=K[B]; R[2,C]:=K[C]; R[2,DD]:=K[DD]; R[2,EE]:=K[EE]; R[2,FF]:=K[FF]; R[3,A]:=K[A]; R[3,B]:=K[B]+1; R[3,C]:=K[C]; R[3,DD]:=K[DD]; R[3,EE]:=K[EE]; R[3,FF]:=K[FF]; R[4,A]:=K[A]; R[4,B]:=K[B]; R[4,C]:=K[C]+1; R[4,DD]:=K[DD]; R[4,EE]:=K[EE]; R[4,FF]:=K[FF]; R[5,A]:=K[A]+1;R[5,B]:=K[B]+1; R[5,C]:=K[C]; R[5,DD]:=K[DD]; R[5,EE]:=K[EE]; R[5,FF]:=K[FF]; R[6,A]:=K[A]+1;R[6,B]:=K[B]; R[6,C]:=K[C]+1; R[6,DD]:=K[DD]; R[6,EE]:=K[EE]; R[6,FF]:=K[FF]; R[7,A]:=K[A]; R[7,B]:=K[B]+1; R[7,C]:=K[C]+1; R[7,DD]:=K[DD]; R[7,EE]:=K[EE]; R[7,FF]:=K[FF]; R[8,A]:=K[A]+1;R[8,B]:=K[B]+1; R[8,C]:=K[C]+1; R[8,DD]:=K[DD]; R[8,EE]:=K[EE]; R[8,FF]:=K[FF]; DT(R,NEXT); NEXT:=NEXT+1; *) END; PROCEDURE ICO(A,B,C,D,F:INTEGER); BEGIN END; PROCEDURE TRIA; BEGIN END; PROCEDURE XNTSECT(A,B,C,H,I,J:INTEGER); { A,B,C ARE THE THREE DIRECTION BEING CONSIDERED H I J ARE THE ORDINAL POSITIONS -THE KS -PLANES OF THE THREE DIRECTIONS} VAR C1,C2,EX1,EX2,EX3,EY1,EY2,EY3,EZ1,EZ2,EZ3:REAL8; MX12,MX13,MY13,BX12,BX13,BY13,R1,R2,R3,X,Y,Z:REAL8; LL,MM,NN,RK1,RK2,RK3,RK4,RK5,RK6:REAL8; K1,K2,K3,K4,K5,K6:INTEGER; GO:BOOLEAN; BEGIN EX1:=E[A,1];EY1:=E[A,2];EZ1:=E[A,3]; EX2:=E[B,1];EY2:=E[B,2];EZ2:=E[B,3]; EX3:=E[C,1];EY3:=E[C,2];EZ3:=E[C,3]; R1:=PLANE[A,H];R2:=PLANE[B,I];R3:=PLANE[C,J]; IF C=6 THEN BEGIN C1 := R1 - EZ1*R3; C2 := R2 - EZ2*R3; Y:= (C1*EX2 - C2*EX1) / (EX2*EY1 - EX1*EY2); X:= (C1 -EY1 *Y)/EX1; Z:= R3;END ELSE BEGIN MX12 := (EY1*EZ2 - EY2*EZ1) / (EY2*EX1 - EY1*EX2); MX13 := (EY1*EZ3 - EY3*EZ1) / (EY3*EX1 - EY1*EX3); MY13 := (EX1*EZ3 - EX3*EZ1) / (EX3*EY1 - EX1*EY3); BX12 := ( R1*EY2 - R2*EY1) / (EY2*EX1 - EY1*EX2); BX13 := ( R1*EY3 - R3*EY1) / (EY3*EX1 - EY1*EX3); BY13 := ( R1*EX3 - R3*EX1) / (EX3*EY1 - EX1*EY3); Z:= (BX13 -BX12) / (MX12 -MX13); X:= MX13*Z + BX13; Y:= MY13*Z + BY13; END; GO:=TRUE; (* CHECH AGAINST PREVIOUS LIST*) (* FOR I := 1 TO COUNT DO BEGIN IF (X > SING[1,I]-0.005 ) AND (X < SING[1,I]+0.005) AND (Y > SING[2,I]-0.005 ) AND (Y < SING[2,I]+0.005) AND (Z > SING[3,I]-0.005 ) AND (Z < SING[3,I]+0.005) THEN GO := FALSE; END; *) IF GO THEN BEGIN {CALCULATE THE LEGNTH ON ALL SIX} RK1:= (X*E[1,1]) + (Y*E[1,2]) + (Z*E[1,3]); RK2:= (X*E[2,1]) + (Y*E[2,2]) + (Z*E[2,3]); RK3:= (X*E[3,1]) + (Y*E[3,2]) + (Z*E[3,3]); RK4:= (X*E[4,1]) + (Y*E[4,2]) + (Z*E[4,3]); RK5:= (X*E[5,1]) + (Y*E[5,2]) + (Z*E[5,3]); RK6:= (X*E[6,1]) + (Y*E[6,2]) + (Z*E[6,3]); (* K1:=FINDK(RK1,1); K2:=FINDK(RK2,2); K3:=FINDK(RK3,3); K4:=FINDK(RK4,4); K5:=FINDK(RK5,5); K6:=FINDK(RK6,6); *) DIREC(A,B,C); {THE OTHER THREE DIRECTIONS ARE DISCOVERED} LL:=(X * E[DD,1]) + (Y * E[DD,2]) + (Z * E[DD,3]); MM:=(X * E[EE,1]) + (Y * E[EE,2]) + (Z * E[EE,3]); NN:=(X * E[FF,1]) + (Y * E[FF,2]) + (Z * E[FF,3]); K[A]:=H; K[B]:=I; K[C]:=J; ORDER:=1;IDS[1]:=0;IDS[2]:=0;IDS[3]:=0; K[DD]:=FINDK(LL,DD); K[EE]:=FINDK(MM,EE); K[FF]:=FINDK(NN,FF); IF ORDER>1 THEN BEGIN SING[1,COUNT] :=X; SING[2,COUNT] :=Y; SING[3,COUNT] :=Z; COUNT:=COUNT+1; END; (* WRITELN(' A B C H I J'); WRITELN( A:6,B:6,C:6,R1:6,R2:6,R3:6); WRITELN(' X Y Z'); WRITELN( X:10,Y:10,Z:10); WRITELN( RK1:10,RK2:10,RK3:10,RK4:10,RK5:10,RK6:10); WRITELN( K[1]:6,K[2]:6,K[3]:6,K[4]:6,K[5]:6,K[6]:6); *) ORDER:=1; CASE ORDER OF 1: BEGIN RHOMBUS(A,B,C); END; 2: BEGIN DODEC(A,B,C,IDS[1]); WRITE('DODEC');END; 3: BEGIN ICO(A,B,C,IDS[1],IDS[2]); WRITE('ICO');END; 4: BEGIN TRIA; WRITE('TRIA');END; END; END; {GO} END; {PROC} PROCEDURE INTSECT(A,B,C,H,I,J:INTEGER); { A,B,C ARE THE THREE DIRECTION BEING CONSIDERED H I J ARE THE ORDINAL POSITIONS -THE KS -PLANES OF THE THREE DIRECTIONS} VAR AX,AY,AZ,BX,BY,BZ,CX,CY,CZ,AAX,AAY,AAZ,BBX,BBY:REAL8; BBZ,CCX,CCY,CCZ,X,Y,Z:REAL8; NUM,r1,r2,r3:REAL8; U:ARRAY[1..3,1..3] OF REAL8; K1,K2,K3,K4,K5,K6:INTEGER; LL,MM,NN,RK1,RK2,RK3,RK4,RK5,RK6:REAL8; BEGIN { Uabc =Eb x Ec/ (Ea* (Eb x Ec) Ubca =Ec x Ea/ (Eb* (Ec x Ea) Ucab =Ea x Eb/ (Ec* (Ea x Eb) AX AY AZ AX AY BX BY BZ BX BY CX CY CZ CX CY } AX:=E[A,1];AY:=E[A,2];AZ:=E[A,3]; BX:=E[B,1];BY:=E[B,2];BZ:=E[B,3]; CX:=E[C,1];CY:=E[C,2];CZ:=E[C,3]; {EQUATION FOR Uabc} NUM:=AX * ((BY * CZ) - ( BZ * CY)) + AY * ((BZ * CX) - ( CZ * BX)) + AZ * ((BX * CY) - ( CX * BY)) ; CCX:=CX/NUM; CCY:=CY/NUM; CCZ:=CZ/NUM; U[1,1]:= (BY * CCZ) - (BZ * CCY); U[1,2]:= (BZ * CCX) - (BX * CCZ); U[1,3]:= (BX * CCY) - (BY * CCX); {EQUATION FOR Ubca} NUM:=BX * ((CY * AZ) - ( CZ * AY)) + BY * ((CZ * AX) - ( AZ * CX)) + BZ * ((CX * AY) - ( AX * CY)) ; AAX:=AX/NUM; AAY:=AY/NUM; AAZ:=AZ/NUM; U[2,1]:= (CY * AAZ) - (CZ * AAY); U[2,2]:= (CZ * AAX) - (CX * AAZ); U[2,3]:= (CX * AAY) - (CY * AAX); {EQUATION FOR Ucab} NUM:=CX * ((AY * BZ) - ( AZ * BY)) + CY * ((AZ * BX) - ( BZ * AX)) + CZ * ((AX * BY) - ( BX * AY)) ; BBX:=BX/NUM; BBY:=BY/NUM; BBZ:=BZ/NUM; U[3,1]:= (AY * BBZ) - (AZ * BBY); U[3,2]:= (AZ * BBX) - (AX * BBZ); U[3,3]:= (AX * BBY) - (AY * BBX); r1:=plane[a,h];r2:=plane[b,i];r3:=plane[c,j]; X:=(r1*U[1,1]) + (r2*U[2,1]) + (r3*U[3,1]); Y:=(r1*U[1,2]) + (r2*U[2,2]) + (r3*U[3,2]); Z:=(r1*U[1,3]) + (r2*U[2,3]) + (r3*U[3,3]); DIREC(A,B,C); {THE OTHER THREE DIRECTIONS ARE DISCOVERED} LL:=(X * E[DD,1]) + (Y * E[DD,2]) + (Z * E[DD,3]); MM:=(X * E[EE,1]) + (Y * E[EE,2]) + (Z * E[EE,3]); NN:=(X * E[FF,1]) + (Y * E[FF,2]) + (Z * E[FF,3]); K[A]:=H; K[B]:=I; K[C]:=J; ORDER:=1;IDS[1]:=0;IDS[2]:=0;IDS[3]:=0; K[DD]:=FINDK(LL,DD); K[EE]:=FINDK(MM,EE); K[FF]:=FINDK(NN,FF); IF ORDER>1 THEN BEGIN SING[1,COUNT] :=X; SING[2,COUNT] :=Y; SING[3,COUNT] :=Z; COUNT:=COUNT+1; END; RHOMBUS(A,B,C); NEXT:=NEXT+1; END; PROCEDURE FILL; {LOOPS THROUGH THREE PLANE INTERSECTIONS VIA THEIR } VAR DIR,PLN,A,B,C,H,I,J:INTEGER; {ORDINAL POSITIONS - THEIR KS -AND CALLS INTSECT EACH} ANS:CHAR; BEGIN NEXT:=1; FOR I := 1 TO 3 DO BEGIN FOR J := 1 TO NPTS DO BEGIN F[I,J] :=0 ; END;END; WRITELN; WRITELN('DO YOU WISH TO DRAW THE WHOLE FIGURE? Y/N AND HIT RETURN'); READLN(ANS); IF ANS IN ['Y','y'] THEN BEGIN FOR A:= 1 TO 6 DO BEGIN FOR B:= 1 TO 6 DO BEGIN FOR C:= 1 TO 6 DO BEGIN { FOR EACH A NOT B NOT C IN ONLY ONE ORDER} IF (A<>B) AND (B<>C) AND (A<>C) AND (A