Sztereó

Ezen a lapon a térnek síkban (képernyőn) történő ábrázolására mutatunk néhány programot. Az alapja a projekció, azaz testek megatározó pontjainak a síkra történő vetítése. Minden programban valamilyen egyszerű test, térbeli mozgást végez.

A projekció mellett a tér érzékeltetését kétféle módon oldjuk majd meg. Az első esetben a test nem átlátszó, a térbeliséget a láthatósággal valósítjuk meg, így miközben az ábrázolás egyszerű projekció, ennek ellenére szemünk hajlandó térbeliséget kölcsönözni a látványnak.

Második esetben a testek átlátszók, úgynevezett dróthálós megjelenítésűek, viszont kettős projekciót hajtunk végre, külön-külön a két szem számára, ezeket a vetületeket különböző színekkel fogjuk megrajzolni és a sztereóhatást színes (térhatású képek, filmek nézésére alkalmas kétszínű) szemüveggel fogjuk elérni.

Először nézzük az egy centrumú projekciót. Ennek szemléltetésére egy rajzot nézhetünk meg, mely Turbo Pascal-ban készült, grafikus képernyőre:

Másodjára a két középpontú (a két szemnek megfelelő távolságú) projekciót tekinthetjük meg egy, az előzőhöz hasonló ábrán.

Az előző ábrákon található, a vetítéseket létrehozó összefüggések a programjainkban megtalálhatóak. Szükségünk van még a mozgáshoz a vektorok térbeli transzformációs mátrixára, valamint a konvex testek felületének láthatóságát meghatározó vektoriális szorzatra. A programokban előforduló testek: 9 alapélű kettős gúla (egy csiszolt gyémánthoz hasonló, némi jóindulattal), az öt szabályos test (tetraéder, kocka, oktaéder, ikozaéder, dodekaéder), valamint az egyköpenyű hiperboloid és a hiperbolikus paraboloid.

Nézzünk az első lehetőségre egy programot. Egy futtatási képe:

Ennek a programnak a listája:

Program GrGula;
Uses NewDelay,Crt, Graph;

Const c  = 260; 
      t  = 50; 
      a  = 10; 
qx = 15; 
qy = 11;
      n = 9;
Cs = n+2; 
Lc = 3; 
Ls = 2*n;


Type Vekt   = Array[1..3] Of Real;
Csucsok= Array[1..Cs] Of Vekt;
     Lapok  = Array[1..Ls,1..Lc] Of Byte;

Const Al : Integer=   2;
      Be : Integer=   0;
Ga : Integer=   1;

Var Mx, My: Integer;
Kx, Ky: Integer;
Page  : Word;
    Test:  Csucsok;
TestL: Lapok;
    S: Longint;

Procedure GrInit;
Var Gd, Gm: Integer;
Begin
DetectGraph(Gd, Gm); Gm:= 1; InitGraph(Gd, Gm, 'c:\Tp\Bgi');
Mx:= GetMaxX; Kx:= Mx Div 2; My:= GetMaxY; Ky:= My Div 2;
End;

Procedure Gula;
Var i: Byte;
Begin
  Test[1,1]:=0; Test[1,2]:=0; Test[1,3]:=a;
For i:=0 to n-1 do
Begin
    Test[i+2,1]:=a*Cos(i*360/n*Pi/180);
    Test[i+2,2]:=a*Sin(i*360/n*Pi/180);
    Test[i+2,3]:=0;
End;
  Test[n+2,1]:=0; Test[n+2,2]:=0; Test[n+2,3]:=-a/3;

For i:=1 to n-1 Do
Begin
TestL[i,1]:=1;
TestL[i,2]:=i+1;
TestL[i,3]:=i+2;
End;
TestL[n,1]:=1; TestL[n,2]:=n+1; TestL[n,3]:=2;

For i:=n+1 to 2*n-1 Do
Begin
TestL[i,1]:=n+2;
TestL[i,2]:=i-n+2;
TestL[i,3]:=i-n+1;
End;
TestL[2*n,1]:=n+2; TestL[2*n,2]:=2; TestL[2*n,3]:=n+1;

End;

Procedure Forgatas;
Var i: Byte;
Px, Py, Pz: Real;
SinAl, CosAl, SinBe, CosBe, SinGa, CosGa: Real;
Begin
  Inc(S); If S Mod 100=0 Then
Begin
Al:= Al+Random(2)-1;
    Be:= Be+Random(2)-1;
Ga:= Ga+Random(2)-1;
If Abs(Al)>4 Then Al:= 2;
If Abs(Be)>2 Then Be:= 0;
If Abs(Ga)>3 Then Ga:= 1;
End;
SinAl:= Sin(Al*pi/180); CosAl:= Cos(Al*pi/180);
SinBe:= Sin(Be*pi/180); CosBe:= Cos(Be*pi/180);
SinGa:= Sin(Ga*pi/180); CosGa:= Cos(Ga*pi/180);
For i:= 1 To Cs Do
Begin
Px:= Test[i,1]*CosBe*CosGa-

Test[i,2]*CosBe*SinGa+Test[i,3]*SinBe;

Py:= Test[i,1]*(CosAl*SinGa+SinAl*SinBe*CosGa)+
         Test[i,2]*(CosAl*CosGa-SinAl*SinBe*SinGa)-
         Test[i,3]*SinAl*CosBe;

Pz:= Test[i,1]*(SinAl*SinGa-CosAl*SinBe*CosGa)+
         Test[i,2]*(SinAl*CosGa+CosAl*SinBe*SinGa)+
         Test[i,3]*CosAl*CosBe;

    Test[i,1]:= Px;
    Test[i,2]:= Py;
    Test[i,3]:= Pz;
End;
End;

Procedure Vetites;
Var Kp: Array[1..Lc+1] Of PointType;
    i, j: Byte;
    s, k1, k2: Vekt;
CosDe: Real;
Procedure VektSzor(a, b: Vekt; Var s: Vekt);
Begin
    s[1]:= a[2]*b[3]-a[3]*b[2];
s[2]:= a[3]*b[1]-a[1]*b[3];
    s[3]:= a[1]*b[2]-a[2]*b[1];
End;

Procedure VektKul(a, b: Vekt; Var k: Vekt);
Begin
    k[1]:= a[1]-b[1];
    k[2]:= a[2]-b[2];
    k[3]:= a[3]-b[3];
End;

Begin
SetActivePage(Page);
ClearDevice;
For I:= 1 To Ls Do
Begin
For J:= 1 To Lc Do
Begin
If j = 1 Then
Begin
        Kp[Lc+1].x:= Round(Kx + c * Test[TestL[i,j],1] * qx/
                        (c - t - Test[TestL[i,j],3]));
        Kp[Lc+1].y:= Round(Ky - c * Test[TestL[i,j],2] * qy/
                        (c - t - Test[TestL[i,j],3]));
End;
Kp[j].x:= Round(Kx + c * Test[TestL[i,j],1] * qx/
                      (c - t - Test[TestL[i,j],3]));
      Kp[j].y:= Round(Ky - c * Test[TestL[i,j],2] * qy/
                      (c - t - Test[TestL[i,j],3]));
End;
If Kp[1].x*(Kp[2].y-Kp[3].y)+
       Kp[2].x*(Kp[3].y-Kp[1].y)+
       Kp[3].x*(Kp[1].y-Kp[2].y)<0 Then
Begin
SetFillStyle(1,i+1);
FillPoly(3, Kp);
End;
End;
SetVisualPage(Page);
Page:=1-Page;
End;

Var p: array[1..Lc] of PointType;
Begin
GrInit;
Delay(1500);
Gula;
Page:=0;
Repeat
Vetites;
Forgatas;
While ((Port[$3DA] And 8) <> 8) Do;
Until KeyPressed;
End.

Térjünk át a második lehetőségre. A kétszínű megjelenítéshez szükség van egy segédprogramra, mert a megfelelő hatás elérése érdekében, a két képernyő színt és a szemüveg két színét össze kell illeszteni. Erre lesz alkalmas a Színválasztó program. A szemüveget a képernyőre kell helyezni, az alatta elhelyezkedő, vele azonos színű vonalat nem szabad látni, az ellentétes színű vonalat pedig feketének (ez jelenti az összehangolást, majd a beállítás RGB értékeit be kell írni a SetRGBPalette eljárás hívásába, paraméterekként).

A színeket beállító program listája:

Program Szinek;
Uses NewDelay, Crt, CrtPlus, Graph;
Var Mx, My:Integer;
    R, G, B: Byte;
Ch: Char;
    S: String;

Procedure GrInit;
Var Gd, Gm: Integer;
Begin
DetectGraph(Gd,Gm);
InitGraph(Gd,Gm,'C:\Tp\Bgi');
End;

Begin
GrInit; Mx:= GetMaxX; My:= GetMaxY;

SetRGBPalette(0,63,63,63);
SetFillStyle(1,0);
  Bar(0,0,Mx,My);
SetTextStyle(0,0,2);
SetColor(2);
MoveTo(Round(0.05*Mx),Round(0.9*My));
OutText('Red: F1,F2 Green: F3,F4 Blue: F5,F6');
Repeat
SetFillStyle(1,0);
    Bar(Round(0.2*Mx),Round(0.1*My),
Round(0.8*Mx),Round(0.2*My));
SetColor(2);
MoveTo(Round(0.25*Mx),Round(0.1*My));
Str(R,S); OutText('R: '+S);
MoveTo(Round(0.45*Mx),Round(0.1*My));
Str(G,S); OutText('G: '+S);
MoveTo(Round(0.65*Mx),Round(0.1*My));
Str(B,S); OutText('B: '+S);
SetRGBPalette(1,R,G,B);
SetColor(1);
SetFillStyle(1,1);
    Bar(Round(0.25*Mx),Round(0.25*My),
Round(0.75*Mx),Round(0.75*My));
Line(Round(0.2*Mx),Round(0.25*My),
Round(0.2*Mx),Round(0.75*My));
Line(Round(0.25*Mx),Round(0.8*My),
Round(0.75*Mx),Round(0.8*My));
Ch:= ReadKey;
If Ch = #0 Then
Begin
Ch:= ReadKey;
Case Ch Of
        #59: If R>0 Then Dec(R);
        #60: If R<63 Then Inc(R);
        #61: If G>0 Then Dec(G);
        #62: If G<63 Then Inc(G);
        #63: If B>0 Then Dec(B);
        #64: If B<63 Then Inc(B);
End;
End;
Until Ch= #27;
CloseGraph;
End.

Nyilvánvaló, hogy az IMAX által kínált 3D-s filmek, és a nemrég megjelent Avatar korában az így vázolt látvány igen szerény, de a dróthálós, kétszínű megjelenítésben a lényeg benne van (külön készül rajz a két szemnek, és agyunkban összeáll térhatású képpé), és csak ezt szeretné bemutatni, ez az egyszerű program.

Néhány futási képet nézzünk meg a dróthálós megjelenítésű programból. A menü:

Az oktaéder:

Az ikozaéder:

Az egyköpenyű hiperboloid:

A program egy, a geometriai elemeket tartalmazó UST nevű Unit-ot használ. Ennek és a programnak a listája:

Unit UST;
Interface

Uses
Graph;
Const
      KS= 25;
      KM= 18;
      KT= 100;
      ST= 3.5;
HSzin= 7;
JSzin= 3;
BSzin= 4;
Type
     Vektor= Array[1..3] Of Real;
Var
Kx, Ky: Integer;
    H, S  : Vektor;
    A, B  : Vektor;
    DX, DY, DZ: Real;
DAl, DBe, DGa: Real;
    I     : Integer;
    N     : Integer;


Procedure Forgato(Var Z:Vektor;U,F:Vektor);
Procedure LinKep(Var H, S: Vektor; V, W: Vektor; JSzin, Bszin: Byte);
Procedure Init;

Implementation

Procedure Forgato(Var Z:Vektor;U,F:Vektor);
Begin
Z[1]:=U[1]*Cos(F[2])*Cos(F[3])-U[2]*Cos(F[2])*Sin(F[3])+U[3]*Sin(F[2]);

  Z[2]:=U[1]*(Cos(F[1])*Sin(F[3])+Sin(F[1])*Sin(F[2])*Cos(F[3]))
       +U[2]*(Cos(F[1])*Cos(F[3])-Sin(F[1])*Sin(F[2])*Sin(F[3]))
       -U[3]*Sin(F[1])*Cos(F[2]);

  Z[3]:=U[1]*(Sin(F[1])*Sin(F[3])-Cos(F[1])*Sin(F[2])*Cos(F[3]))
       +U[2]*(Sin(F[1])*Cos(F[3])+Cos(F[1])*Sin(F[2])*Sin(F[3]))
       +U[3]*Cos(F[1])*Cos(F[2]);
end;

Procedure LinKep(Var H, S: Vektor; V, W: Vektor; JSzin, Bszin: Byte);
Var VJX, VJY, VBX, VBY, WJX, WJY, WBX, WBY: Integer;
Begin
Forgato(V,V,S);
Forgato(W,W,S);

VJX:=Round((KT*(KS+V[1]+H[1])+(V[3]+H[3])*(KS-ST))/(KT+V[3]+H[3])*Kx/Ks);
  VJY:=Round((KT*(KM-V[2]-H[2])+(V[3]+H[3])*KM)/(KT+V[3]+H[3])*KY/KM);
  VBX:=Round((KT*(KS+V[1]+H[1])+(V[3]+H[3])*(KS+ST))/(KT+V[3]+H[3])*Kx/Ks);
  VBY:=Round((KT*(KM-V[2]-H[2])+(V[3]+H[3])*KM)/(KT+V[3]+H[3])*KY/KM);

  WJX:=Round((KT*(KS+W[1]+H[1])+(W[3]+H[3])*(KS-ST))/(KT+W[3]+H[3])*Kx/Ks);
  WJY:=Round((KT*(KM-W[2]-H[2])+(W[3]+H[3])*KM)/(KT+W[3]+H[3])*KY/KM);
  WBX:=Round((KT*(KS+W[1]+H[1])+(W[3]+H[3])*(KS+ST))/(KT+W[3]+H[3])*Kx/Ks);
  WBY:=Round((KT*(KM-W[2]-H[2])+(W[3]+H[3])*KM)/(KT+W[3]+H[3])*KY/KM);

SetColor(JSzin); Line(VJX,VJY,WJX,WJY);
SetColor(BSzin); Line(VBX,VBY,WBX,WBY);

End;

Procedure Init;
Var Gd, Gm: Integer;
Begin
DetectGraph(Gd, Gm); InitGraph(Gd, Gm, 'C:\Tp\Bin');
Kx:= Round(GetMaxX/2);
Ky:= Round(GetMaxY/2);
SetColor(JSzin);
SetRGBPalette(JSzin, 0, 45, 4);
SetColor(BSzin);
SetRGBPalette(BSzin, 47, 13, 0);
SetBkColor(HSzin);
ClearDevice;
End;

End.

A program listája:

Program StOk;
Uses NewDelay, Crt, CrtPlus, Graph, UST;
Const MaxI= 200;
MPont:Array[1..8] Of String[25]=
      (' Tetraéder               ',
       ' Kocka                   ',
       ' Oktaéder                ',
       ' Dodekaéder              ',
       ' Ikozaéder               ',
       ' Egyköpenyű hiperboloid  ',
       ' Hiperbolikus paraboloid ',
       ' Kilépés a programból    ');
Var AT, BT: Array[1..MaxI] Of Vektor;
    MP: Byte;

Procedure Kezdet;
Begin
  H[1]:= 0; H[2]:= 0; H[3]:= -40;
  S[1]:= 0; S[2]:= 0; S[3]:= 0;

  DX:= 0.07; DY:= 0.05; DZ:=0.03;
DAl:= 0.05; DBe:= 0.03; DGa:= 0.02;
End;

Procedure Mozgas;
Begin
  H[1]:= H[1]+DX;  If (H[1]<-8)  Or (H[1]>8)   Then DX:=-DX;
  H[2]:= H[2]+DY;  If (H[2]<-8)  Or (H[2]>8)   Then DY:=-DY;
  H[3]:= H[3]+DZ;  If (H[3]<-50) Or (H[3]>-10) Then DZ:=-DZ;

  S[1]:= S[1]+DAl;
  S[2]:= S[2]+DBe;
  S[3]:= S[3]+DGa;
End;

Procedure EgykopenyuHip;
Var P     : Real;
Ra, Rf: Real;
    Ma, Mf: Real;
Ds, IM: Integer;
Begin
Ra:= 4; Rf:= 2;
  Ma:= -3; Mf:= 3;
  P:= 2;
Ds:=20; IM:= 19;
  N:=0;
For I:=1 To IM Do
Begin
    A[1]:=Rf*Cos(I*Ds*Pi/180+P);
    A[2]:=Mf;
A[3]:=Rf*Sin(I*Ds*Pi/180+P);
    B[1]:=Ra*Cos(I*Ds*Pi/180);
    B[2]:=Ma;
    B[3]:=Ra*Sin(I*Ds*Pi/180);
    Inc(N); AT[N]:=A; BT[N]:=B;

    B[1]:=Rf*Cos((I+1)*Ds*Pi/180+P);
    B[2]:=Mf;
    B[3]:=Rf*Sin((I+1)*Ds*Pi/180+P);
    Inc(N); AT[N]:=A; BT[N]:=B;

    A[1]:=Ra*Cos(I*Ds*Pi/180);
    A[2]:=Ma;
    A[3]:=Ra*Sin(I*Ds*Pi/180);
    B[1]:=Ra*Cos((I+1)*Ds*Pi/180);
    B[2]:=Ma;
    B[3]:=Ra*Sin((I+1)*Ds*Pi/180);
    Inc(N); AT[N]:=A; BT[N]:=B;
End;

End;

Procedure HipPar;
Begin
  N:=0;
For I:=0 To 15 Do
Begin
    A[1]:=-6; A[2]:=0; A[3]:=6-I*0.8;
B[1]:= 6; B[2]:=6-I*0.8; B[3]:=0;
    Inc(N); AT[N]:=A; BT[N]:=B;
End;
  A[1]:=-6; A[2]:=0; A[3]:=6;
  B[1]:=-6; B[2]:=0; B[3]:=6-I*0.8;
  Inc(N); AT[N]:=A; BT[N]:=B;
  A[1]:= 6; A[2]:=6; A[3]:=0;
  B[1]:= 6; B[2]:=6-I*0.8; B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;
End;

Procedure Oktaeder;
Const E=5;
Begin
  N:=0;
  A[1]:=E;A[2]:=0;A[3]:=0;
  B[1]:=0;B[2]:=E;B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=E;A[3]:=0;
  B[1]:=-E;B[2]:=0;B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-E;A[2]:=0;A[3]:=0;
  B[1]:=0;B[2]:=-E;B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

A[1]:=0;A[2]:=-E;A[3]:=0;
  B[1]:=E;B[2]:=0;B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=0;A[3]:=E;
  B[1]:=0;B[2]:=E;B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=E;A[3]:=0;
  B[1]:=0;B[2]:=0;B[3]:=-E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=0;A[3]:=-E;
  B[1]:=0;B[2]:=-E;B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=-E;A[3]:=0;
  B[1]:=0;B[2]:=0;B[3]:=E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=E;A[2]:=0;A[3]:=0;
  B[1]:=0;B[2]:=0;B[3]:=-E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=0;A[3]:=-E;
  B[1]:=-E;B[2]:=0;B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

A[1]:=-E;A[2]:=0;A[3]:=0;
  B[1]:=0;B[2]:=0;B[3]:=E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=0;A[3]:=E;
  B[1]:=E;B[2]:=0;B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;
End;

Procedure Kocka;
Const E=3;
Begin
  n:=0;
  A[1]:=E;A[2]:=E;A[3]:=E;
  B[1]:=-E;B[2]:=E;B[3]:=E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-E;A[2]:=E;A[3]:=E;
  B[1]:=-E;B[2]:=E;B[3]:=-E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-E;A[2]:=E;A[3]:=-E;
  B[1]:=E;B[2]:=E;B[3]:=-E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=E;A[2]:=E;A[3]:=-E;
  B[1]:=E;B[2]:=E;B[3]:=E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=E;A[2]:=-E;A[3]:=E;
B[1]:=-E;B[2]:=-E;B[3]:=E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-E;A[2]:=-E;A[3]:=E;
  B[1]:=-E;B[2]:=-E;B[3]:=-E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-E;A[2]:=-E;A[3]:=-E;
  B[1]:=E;B[2]:=-E;B[3]:=-E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=E;A[2]:=-E;A[3]:=-E;
  B[1]:=E;B[2]:=-E;B[3]:=E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=E;A[2]:=E;A[3]:=E;
  B[1]:=E;B[2]:=-E;B[3]:=E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-E;A[2]:=E;A[3]:=E;
  B[1]:=-E;B[2]:=-E;B[3]:=E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-E;A[2]:=E;A[3]:=-E;
  B[1]:=-E;B[2]:=-E;B[3]:=-E;
  Inc(N); AT[N]:=A; BT[N]:=B;

A[1]:=E;A[2]:=E;A[3]:=-E;
  B[1]:=E;B[2]:=-E;B[3]:=-E;
  Inc(N); AT[N]:=A; BT[N]:=B;
End;

Procedure Tetraeder;
Const E=3;
Begin
  N:=0;
  A[1]:=E;A[2]:=E;A[3]:=E;
  B[1]:=-E;B[2]:=E;B[3]:=-E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-E;A[2]:=-E;A[3]:=E;
  B[1]:=E;B[2]:=-E;B[3]:=-E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=E;A[2]:=E;A[3]:=E;
  B[1]:=-E;B[2]:=-E;B[3]:=E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=E;A[2]:=E;A[3]:=E;
  B[1]:=E;B[2]:=-E;B[3]:=-E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-E;A[2]:=-E;A[3]:=E;
  B[1]:=-E;B[2]:=E;B[3]:=-E;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-E;A[2]:=E;A[3]:=-E;
  B[1]:=E;B[2]:=-E;B[3]:=-E;
  Inc(N); AT[N]:=A; BT[N]:=B;

End;

Procedure Ikozaeder;
Const E=6;
Var R, X, Y, V, Z, U, T: Real;
Begin
  R:= E*SQRT(2*(5+SQRT(5)))/4;
  X:= E*SQRT((5+SQRT(5))/10);
  Y:= E*SQRT((5-SQRT(5))/10);
  Z:= E*SQRT((5+2*SQRT(5))/20);
  U:= E*SQRT(1/(10+2*SQRT(5)));
  V:= E*SQRT((5+2*SQRT(5))/(10+2*SQRT(5)));
  T:= R-Y;

  N:=0;
  A[1]:=X;A[2]:=T;A[3]:=0;
  B[1]:=U;B[2]:=T;B[3]:=V;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=U;A[2]:=T;A[3]:=V;
  B[1]:=-Z;B[2]:=T;B[3]:=E/2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-Z;A[2]:=T;A[3]:=E/2;
  B[1]:=-Z;B[2]:=T;B[3]:=-E/2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-Z;A[2]:=T;A[3]:=-E/2;
B[1]:=U;B[2]:=T;B[3]:=-V;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=U;A[2]:=T;A[3]:=-V;
  B[1]:=X;B[2]:=T;B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=R;A[3]:=0;
  B[1]:=X;B[2]:=T;B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=R;A[3]:=0;
  B[1]:=U;B[2]:=T;B[3]:=V;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=R;A[3]:=0;
  B[1]:=-Z;B[2]:=T;B[3]:=E/2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=R;A[3]:=0;
  B[1]:=-Z;B[2]:=T;B[3]:=-E/2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=R;A[3]:=0;
  B[1]:=U;B[2]:=T;B[3]:=-V;
  Inc(N); AT[N]:=A; BT[N]:=B;


A[1]:=-X;A[2]:=-T;A[3]:=0;
  B[1]:=-U;B[2]:=-T;B[3]:=V;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-U;A[2]:=-T;A[3]:=V;
  B[1]:=Z;B[2]:=-T;B[3]:=E/2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=Z;A[2]:=-T;A[3]:=E/2;
  B[1]:=Z;B[2]:=-T;B[3]:=-E/2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=Z;A[2]:=-T;A[3]:=-E/2;
  B[1]:=-U;B[2]:=-T;B[3]:=-V;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-U;A[2]:=-T;A[3]:=-V;
  B[1]:=-X;B[2]:=-T;B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=-R;A[3]:=0;
  B[1]:=-X;B[2]:=-T;B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=-R;A[3]:=0;
  B[1]:=-U;B[2]:=-T;B[3]:=V;
Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=-R;A[3]:=0;
  B[1]:=Z;B[2]:=-T;B[3]:=E/2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=-R;A[3]:=0;
  B[1]:=Z;B[2]:=-T;B[3]:=-E/2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=0;A[2]:=-R;A[3]:=0;
  B[1]:=-U;B[2]:=-T;B[3]:=-V;
  Inc(N); AT[N]:=A; BT[N]:=B;



  A[1]:=X;A[2]:=T;A[3]:=0;
  B[1]:=Z;B[2]:=-T;B[3]:=-E/2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=X;A[2]:=T;A[3]:=0;
  B[1]:=Z;B[2]:=-T;B[3]:=E/2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=U;A[2]:=T;A[3]:=V;
  B[1]:=Z;B[2]:=-T;B[3]:=E/2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=U;A[2]:=T;A[3]:=V;
B[1]:=-U;B[2]:=-T;B[3]:=V;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-Z;A[2]:=T;A[3]:=E/2;
  B[1]:=-U;B[2]:=-T;B[3]:=V;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-Z;A[2]:=T;A[3]:=E/2;
  B[1]:=-X;B[2]:=-T;B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-Z;A[2]:=T;A[3]:=-E/2;
  B[1]:=-X;B[2]:=-T;B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-Z;A[2]:=T;A[3]:=-E/2;
  B[1]:=-U;B[2]:=-T;B[3]:=-V;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=U;A[2]:=T;A[3]:=-V;
  B[1]:=-U;B[2]:=-T;B[3]:=-V;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=U;A[2]:=T;A[3]:=-V;
  B[1]:=Z;B[2]:=-T;B[3]:=-E/2;
  Inc(N); AT[N]:=A; BT[N]:=B;
End;

Procedure Dodekaeder;
Const E=3;
Var X, Y, Z, U, U1, U2, V, V1, V2, R, R1, R2, P, Q: Real;
Begin
  X:= E*SQRT((5+SQRT(5))/10);
  Z:=E*SQRT((5+2*SQRT(5))/20);
  R:= E/2*SQRT((25+11*SQRT(5))/10);
  R1:= R*(3-SQRT(5));
  R2:= R*(SQRT(5)-1);
  Y:= R*(SQRT(5)-2);
  P:= SQRT(E*E-R1*R1);
  Q:= SQRT((X+Z)*(X+Z)-R2*R2);
  U:= E*SQRT(1/(10+2*SQRT(5)));
  U1:= U*(X+P)/X;
  U2:= Z*(X+P)/X;
  V:= E*SQRT((5+2*SQRT(5))/(10+2*SQRT(5)));
  V1:= V*(X+P)/X;
  V2:= E*(P+X)/2/X;

  N:=0;
  A[1]:=0;A[2]:=0;A[3]:=0;B[1]:=0;B[2]:=0;B[3]:=0;Inc(N);AT[N]:=A;BT[N]:=B;

A[1]:=X;A[2]:=R;A[3]:=0;B[1]:=U;B[2]:=R;B[3]:=V;Inc(N);AT[N]:=A;BT[N]:=B;
  A[1]:=U;A[2]:=R;A[3]:=V;B[1]:=-Z;B[2]:=R;B[3]:=E/2;Inc(N);AT[N]:=A;BT[N]:=B;
  A[1]:=-Z;A[2]:=R;A[3]:=E/2;B[1]:=-Z;B[2]:=R;B[3]:=-E/2;Inc(N);AT[N]:=A;BT[N]:=B;
  A[1]:=-Z;A[2]:=R;A[3]:=-E/2;B[1]:=U;B[2]:=R;B[3]:=-V;Inc(N);AT[N]:=A;BT[N]:=B;
  A[1]:=U;A[2]:=R;A[3]:=-V;B[1]:=X;B[2]:=R;B[3]:=0;Inc(N);AT[N]:=A;BT[N]:=B;


  A[1]:=X; A[2]:=R; A[3]:=0;
  B[1]:=X+P; B[2]:=Y; B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=U; A[2]:=R; A[3]:=V;
  B[1]:=U1; B[2]:=Y; B[3]:=V1;
  Inc(N); AT[N]:=A; BT[N]:=B;

A[1]:=-Z; A[2]:=R; A[3]:=E/2;
  B[1]:=-U2; B[2]:=Y; B[3]:=V2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-Z; A[2]:=R; A[3]:=-E/2;
  B[1]:=-U2; B[2]:=Y; B[3]:=-V2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=U; A[2]:=R; A[3]:=-V;
  B[1]:=U1; B[2]:=Y; B[3]:=-V1;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=Z; A[2]:=-R; A[3]:=-E/2;B[1]:=Z; B[2]:=-R; B[3]:=E/2;Inc(N); AT[N]:=A; BT[N]:=B;
  A[1]:=Z; A[2]:=-R; A[3]:=E/2;B[1]:=-U; B[2]:=-R; B[3]:=V;Inc(N); AT[N]:=A; BT[N]:=B;
  A[1]:=-U; A[2]:=-R; A[3]:=V;B[1]:=-X; B[2]:=-R; B[3]:=0;Inc(N); AT[N]:=A; BT[N]:=B;
A[1]:=-X; A[2]:=-R; A[3]:=0;B[1]:=-U; B[2]:=-R; B[3]:=-V;Inc(N); AT[N]:=A; BT[N]:=B;
  A[1]:=-U; A[2]:=-R; A[3]:=-V;B[1]:=Z; B[2]:=-R; B[3]:=-E/2;Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=Z; A[2]:=-R; A[3]:=-E/2;
  B[1]:=U2; B[2]:=-Y; B[3]:=-V2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=Z; A[2]:=-R; A[3]:=E/2;
  B[1]:=U2; B[2]:=-Y; B[3]:=V2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-U; A[2]:=-R; A[3]:=V;
  B[1]:=-U1; B[2]:=-Y; B[3]:=V1;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-X; A[2]:=-R; A[3]:=0;
  B[1]:=-X-P; B[2]:=-Y; B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-U; A[2]:=-R; A[3]:=-V;
B[1]:=-U1; B[2]:=-Y; B[3]:=-V1;
  Inc(N); AT[N]:=A; BT[N]:=B;


  A[1]:=X+P; A[2]:=Y; A[3]:=0;
  B[1]:=U2; B[2]:=-Y; B[3]:=-V2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=X+P; A[2]:=Y; A[3]:=0;
  B[1]:=U2; B[2]:=-Y; B[3]:=V2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=U1; A[2]:=Y; A[3]:=V1;
  B[1]:=U2; B[2]:=-Y; B[3]:=V2;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=U1; A[2]:=Y; A[3]:=V1;
  B[1]:=-U1; B[2]:=-Y; B[3]:=V1;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-U2; A[2]:=Y; A[3]:=V2;
  B[1]:=-U1; B[2]:=-Y; B[3]:=V1;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-U2; A[2]:=Y; A[3]:=V2;
B[1]:=-X-P; B[2]:=-Y; B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-U2; A[2]:=Y; A[3]:=-V2;
  B[1]:=-X-P; B[2]:=-Y; B[3]:=0;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=-U2; A[2]:=Y; A[3]:=-V2;
  B[1]:=-U1; B[2]:=-Y; B[3]:=-V1;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=U1; A[2]:=Y; A[3]:=-V1;
  B[1]:=-U1; B[2]:=-Y; B[3]:=-V1;
  Inc(N); AT[N]:=A; BT[N]:=B;

  A[1]:=U1; A[2]:=Y; A[3]:=-V1;
  B[1]:=U2; B[2]:=-Y; B[3]:=-V2;
  Inc(N); AT[N]:=A; BT[N]:=B;

End;

Begin
  MP:=1;
Repeat
Szinek(1,14);
ClrScr;
    Ablak(7,0,24,4,52,13,true,'Menü');
For I:=1 To 8 Do WriteXY(26,4+I,MPont[i]);
MP:=Menu(7,0,2,26,5,25,8,MP);
Case Mp Of
      1:Tetraeder;
      2:Kocka;
      3:Oktaeder;
      4:Dodekaeder;
      5:Ikozaeder;
      6:EgykopenyuHip;
      7:HipPar;
      8:Halt;
End;
Init;Kezdet;
Repeat
Mozgas;
For I:=1 To N Do LinKep(H,S,AT[I],BT[I],JSzin,BSzin);
Delay(100);
ClearDevice;
Until KeyPressed;
CloseGraph;
While keypressed do readkey;
If MP=0 Then MP:=1;
Until False;
End.