program func_3d (input,output);     (* 3D-Darstellung von Funktionen *)

{$S-,R-}
{$N+,E+}

uses crt , graph , hcopyu;

const r = 20;
      d = 900;
      t = 0.5;
      p = 1.1;
      s = 0.15;       (* Bestimmt GrÖße der Rechtecke *)
      l = 28;         (* Anzahl der Rechtecke *)



var GrDriver,GrMode,i,j,
    k,xc,yc,ErrCode       : integer;
    x,y,st,sp,ct,cp       : single;         (* schnelleres Berechnen *)
    v                     : array[1..4] of pointtype;   (* Punkt x,y *)
    drucken               : char;

procedure hercules; external;
{$l herc }

function f(x,y : real): real;       (* Hier die Funktion eingeben *)
begin
{ if (x<0) or (x>1) or (y<0) or (y>1) then f:=0  else  }
  f:=1.5*x*y*exp(sin(x)+cos(y)) / (1+x*x+y*y);
end;


procedure q (var p :pointtype ;x,y,z :single);
var a,b : single;
begin
 a   :=-(x*ct+y*st);
 b   := (a*sp-z*cp+r)/d;
 p.x := round(xc+(y*ct-x*st)/b);
 p.y := round(yc-(a*cp+z*sp)/b);
end;


begin
 GrDriver:=Detect;
 ErrCode:=RegisterBGIDriver(@hercules);
 InitGraph(GrDriver,GrMode,'');
 Errcode:=GraphResult;
 if ErrCode <> grOk then
  begin                    (* Fehler ausgeben *)
   writeln('Fehler bei Grafik-Initialisierung : ',GraphErrorMsg(ErrCode));
   halt;
  end;
 xc:=GetmaxX shr 1;
 yc:=GetmaxY shr 1 +30;
 SetFillStyle(0,1);                   { Hintergrund bleibt schwarz }
 Bar(0,0,GetmaxX,GetmaxY);
 SetFillstyle(1,4*Byte(GrDriver<>7));
 st:=sin(t);
 sp:=sin(p);
 ct:=cos(t);
 cp:=cos(p);
 for i:=-l to l-1 do
  for j:=-l to l-1 do
    if not keypressed then        (* vorzeitiger Abbruch mÖglich *)
      begin
       for k:=1 to 4 do
         begin
           x:=(i + k and 2 shr 1)*s;
           y:=(j+(k-1) shr 1)*s;
           q(v[k], x, y, f(x,y) );
         end;
       FillPoly(4,v);
      end;
 Rectangle(0,0,GetmaxX,GetmaxY);

 OutTextXY(5,5,'Drucken ?  (j/N)');
 repeat until keypressed ;
 drucken:=readkey;
 if (drucken='j') or (drucken='J') then
   begin
     OutTextXY(5,5,'                 ');
     hcopy(1,1,719,400,false);
   end;

 CloseGraph;

end.