program G3d;
{$path "ram:include/","pascal:include/"}
{$incl "graphics.lib","intuition.lib"}

 const
  pi    = 3.14159;
  width = 320;
  height= 256;
  filename = 'pascal:work/figure.dat';
 type
  coord2d = Record
              x,y:integer;
            end;
  coord3d = Record
              x,y,z:real;
            end;

 var
  p:string;
  t1:IntuiText;
  Scr1,Scr2: ^Screen;
  Win1,Win2: ^Window;
  Rp1,Rp2,Rp: ^RastPort;
  figure: array[1..10,1..4] of coord3d;
  last,i,j,x,y:integer;
  point2d:coord2d;
  point3s:coord3d;
  plane:boolean;
  sq3,m,angle,alf,sin_rot_angle,cos_rot_angle:real;
  pointer:^byte;
  key:byte;

procedure Init;
 var f: file of char;
     i,j:integer;
 begin
   angle:=pi/128; m:=20;
   alf:=sqrt(2)/2;sq3:=sqrt(3);
   sin_rot_angle:=sin(angle);
   cos_rot_angle:=cos(angle);
   OpenLib(GfxBase,'graphics.library',0);
   OpenLib(IntBase,'intuition.library',0);
   Scr1:=Open_Screen(0,0,320,256,1,0,1,16384,'');
   Scr2:=Open_Screen(0,0,320,256,1,0,1,16384,'');
   Win1:=Open_Window(0,0,320,256,1,0,$800,Nil,Scr1,320,256,320,256);
   Win2:=Open_Window(0,0,320,256,1,0,$800,Nil,Scr2,320,256,320,256);
   SetRGB4(^Scr1^.ViewPort,0,0,0,3);
   SetRGB4(^Scr1^.ViewPort,1,15,15,15);
   SetRGB4(^Scr2^.ViewPort,0,0,0,3);
   SetRGB4(^Scr2^.ViewPort,1,15,15,15);
   Rp1:=Win1^.RPort;
   Rp2:=Win2^.Rport;
   Rp:=Rp1;
   plane:=true;
   Reset (f,FileName);
   if eof(f) then write ('File not found: ',FileName);
   i:=1;
   while not(eof(f)) do
     begin
       for j:=1 to 4 do with figure[i,j] do readln(f,x,y,z);
       i:=i+1;
     end;
   last:=i-2;
 end;

procedure Close;
 begin
   Close_Window(Win1);
   Close_Window(Win2);
   Close_Screen(Scr1);
   Close_Screen(Scr2);
 end;

PROCEDURE Rotate_alfa (VAR a: coord3d) { We change the original point }
 var oldy:real;
BEGIN
   oldy:=a.y;
   a.y := a.y * cos_rot_angle - a.z * sin_rot_angle;
   a.z := oldy * sin_rot_angle + a.z * cos_rot_angle;
END; { Proc Rotate_alfa }

PROCEDURE Rotate_beta (VAR a: coord3d) { We change the original point }
 var oldx:real;
BEGIN
   oldx:=a.x;
   a.x := a.x * cos_rot_angle + a.z * sin_rot_angle;
   a.z := a.z * cos_rot_angle - oldx * sin_rot_angle ;
END; { Proc Rotate_beta }

PROCEDURE Rotate_gamma (VAR a: coord3d) { We change the original point }
 var oldx:real;
BEGIN
   oldx:=a.x;
   a.x := a.x * cos_rot_angle - a.y * sin_rot_angle;
   a.y := oldx * sin_rot_angle + a.y * cos_rot_angle;
END; { Proc Rotate_gamma }

procedure rotx;
  var i,j:integer;
  begin
    for i:=1 to last do
      for j:=1 to 4 do rotate_alfa(figure[i,j]);
  end;
procedure rotz;
  var i,j:integer;
  begin
    for i:=1 to last do
      for j:=1 to 4 do rotate_gamma(figure[i,j]);
  end;
procedure roty;
  var i,j:integer;
  begin
    for i:=1 to last do
      for j:=1 to 4 do rotate_beta(figure[i,j]);
  end;

{ 3d --> 2d }
procedure project(a:coord3d; var b:coord2d);
  begin
    with a do begin
      b.x:=160+round(m*(sq3*(y-x)));
      b.y:=255-(128+round(m*2*(z-(x+y)/2)));
    end;
  end;

procedure DrawSide(number:integer);
  var j:integer; a,b:coord2d;
  begin
    project(figure[number,1],b);
    move(Rp,b.x,b.y);
    for j:=2 to 4 do
      begin
        project(figure[number,j],a);
        Draw(Rp,a.x,a.y);
      end;
    Draw(Rp,b.x,b.y);
  end;

procedure normal(side:integer; var a,b,c:real);
  var x1,x2,x3,y1,y2,y3,z1,z2,z3:real;
  begin
    x1:=figure[side,1].x; x2:=figure[side,2].x; x3:=figure[side,3].x;
    y1:=figure[side,1].y; y2:=figure[side,2].y; y3:=figure[side,3].y;
    z1:=figure[side,1].z; z2:=figure[side,2].z; z3:=figure[side,3].z;
    a:=(y2-y1)*(z3-z1)-(y3-y1)*(z2-z1);
    b:=(x3-x1)*(z2-z1)-(x2-x1)*(z3-z1);
    c:=(x2-x1)*(y3-y1)-(x3-x1)*(y2-y1);
  end;

function Visible(side:integer):boolean;
  const
   m = 1; { Coordinates of surface }
   n = 1;
   p = 1;
  var a,b,c,alfa:real;
  begin
    normal(side,a,b,c);
    alfa:=(a*m+b*n+c*p)/(sqrt(m*m+n*n+p*p)*sqrt(a*a+b*b+c*c));
    if alfa>0 then visible:=true
           else visible:=false;
  end;

procedure DrawFigure;
  var i:integer;
  begin
    SetAPen(Rp,0);
    rectfill(Rp,0,0,width-1,height-1);
    SetAPen(Rp,1);
    for i:=1 to last do if Visible(i) then DrawSide(i);
    if plane then begin
                    ScreenToFront(Scr1);
                    Rp:=Rp2;
                  end
             else begin
                    ScreenToFront(Scr2);
                    Rp:=Rp1;
                  end;
    plane:=not plane;
  end;

begin
 Init;
 pointer:=ptr($bfec01);
 repeat
  drawfigure;
  rotz;
  rotx;rotx;

  key:=pointer^;
  case key of
   233: m:=m/1.05;
   231: m:=m*1.05;
   Otherwise
  end;
 until key=126;
 Close;
end.