program drei_d_darstellung;

{$I fnz.pas}
{$I grbs.bic}
{$I grdisk.bic}

const   pi :          real    = 3.14159;

var     a, b :        real;    (* Achsenwinkel *)
        mx, my, mz :  real;    (* Verkuerzungsfaktoren *)
        xmin, xmax :  real;    (* x-Funktionswertgrenzen *)
        ymin, ymax :  real;    (* y-Funktionswertgrenzen *)
        zmin, zmax :  real;    (* z-Funktionswertgrenzen *)
        p :           integer; (* Sichtbedingung *)
        g :           integer; (* Diskretisierung *)
        gitter :      integer; (* Lage der Gitterlinien *)
        markierung :  integer; (* Achsenskalierung *)

        norm_x :      real;    (* Normierung x-Achse *)
        norm_y :      real;    (* Normierung y-Achse *)
        norm_z :      real;    (* Normierung z-Achse *)
        xurp, yurp:   integer; (* Ursprung des Koordinatensystems *)
        ey :          real;    (* Lage Koordinatenursprung *)
        nx, ny, nz :  integer; (* Pixelanzahlen in Achsenrichtungen *)
        k1, k2 :      real;    (* Skalierungsfaktoren *)
        l1, l2, l3 :  real;    (* Skalierungsfaktoren *)

        sx, sy :      integer; (* Spurpunkte *)
        dx, dy :      real;    (* Schritweite *)
        dxs, dys :    real;    (* Schrittweite fuer Spurpunkte *)
        nmax :        integer; (* Anzahl der Spurpunkte *)
        v_x, v_y :    integer; (* Schrittsteuerparameter *)
        c :           integer; (* Kennzahl fuer Achsanordnung *)


function fnxp(x,y:real):integer;
begin fnxp:=xurp+trunc(k1*x+k2*y); end;

function fnyp(x,y,z:real):integer;
begin fnyp:=yurp+trunc(l1*x+l2*y+l3*z); end;

procedure minmax;

var xi, yi, zij : real;
    rx, ry :      integer;
    dx, dy :      real;

begin
zmin:=1e30;
zmax:=-zmin;
rx:=30; ry:=30;
dx:=(xmax-xmin)/(rx-1);
dy:=(ymax-ymin)/(ry-1);
xi:=xmin;
repeat
  yi:=ymin;
  repeat
    zij:=fnz(xi,yi);
    if zmin>zij then zmin:=zij;
    if zmax<zij then zmax:=zij;
    yi:=yi+dy;
  until (yi>ymax);
  xi:=xi+dx;
until (xi>xmax);
if xmin>=0 then norm_x:=xmax else norm_x:=xmax-xmin;
if ymin>=0 then norm_y:=ymax else norm_y:=ymax-ymin;
if zmin>=0 then norm_z:=zmax else norm_z:=zmax-zmin;
if zmin=zmax then norm_z:=zmax;
end;

procedure konstanten;

begin
a:=a*pi/180; b:=b*pi/180;
if a<0 then a:=a+2*pi;
if b<0 then b:=b+2*pi;
xurp:=180 (*256*); yurp:=round(199*(1-ey));
nx:=100; ny:=100; nz:=100;
k1:=nx*mx*cos(a)/norm_x;
k2:=ny*my*cos(b)/norm_y;
l1:=-nx*mx*sin(a)/norm_x;
l2:=-ny*my*sin(b)/norm_y;
l3:=-nz*mz/norm_z;
case g of
   1: begin sx:=15; sy:=15; end;
   2: begin sx:=50; sy:=50; end;
   3: begin sx:=75; sy:=75; end;
   end;
dx:=(xmax-xmin)/(sx-1);
dy:=(ymax-ymin)/(sy-1);
dxs:=dx;
dys:=dxs*k1/abs(k2);
nmax:=trunc((xmax-xmin)/dxs)+1;
if a>pi then v_x:=1 else v_x:=-1;
if b>pi then v_y:=1 else v_y:=-1;
if a<pi
   then begin if b<pi
                 then c:=1
                 else c:=2;
        end
   else begin if b>pi
                 then c:=3
                 else c:=4;
        end;
end;


procedure achsenkreuz;

var  xx, xy, yx, yy, zy : integer;    (* Enden der Achsen *)
     hx, hy, hz :         real;
     xx_p, xy_p :         integer;
     yx_p, yy_p :         integer;
     zx_p, zy_p :         integer;
     u :                  integer;    (* Laufvariable *)
     un, ob :             string [20];

begin
xx:=trunc(1.2*nx*cos(a));
xy:=trunc(1.2*nx*sin(a));
yx:=trunc(1.2*ny*cos(b));
yy:=trunc(1.2*ny*sin(b));
zy:=trunc(1.25*nz);
DrawLineDirect(xurp,yurp,xurp,yurp-zy);
DrawLineDirect(xurp,yurp,xurp+xx,yurp-xy);
DrawLineDirect(xurp,yurp,xurp+yx,yurp-yy);
DrawText(xurp,yurp-trunc(1.05*zy),1,'Z');
DrawText(xurp+trunc(1.1*xx),yurp-trunc(1.1*xy),1,'X');
DrawText(xurp+trunc(1.1*yx),yurp-trunc(1.1*yy),1,'Y');
(* Achsenskalierung *)
hx:=nx*xmax/norm_x*mx/10;
hy:=ny*ymax/norm_y*my/10;
hz:=nz*zmax/norm_z*mz/10;
if markierung=1 then for u:=1 to 10 do
   begin
     xx_p:=xurp+trunc(u*hx*cos(a));
     xy_p:=yurp-trunc(u*hx*sin(a));
     yx_p:=xurp+trunc(u*hy*cos(b));
     yy_p:=yurp-trunc(u*hy*sin(b));
     zx_p:=xurp;
     zy_p:=yurp-trunc(u*hz);
     DrawLineDirect(xx_p,xy_p,xx_p+trunc(nx/50+cos(b)),xy_p+trunc(nx/50*sin(b)));
     DrawLineDirect(yx_p,yy_p,yx_p-trunc(ny/50-cos(a)),yy_p+trunc(ny/50*sin(a)));
     DrawLineDirect(zx_p,zy_p,zx_p+trunc(nx/50),zy_p);
   end;
str(xmin:11:2,un); str(xmax:11:2,ob); DrawText(400,163,1,'X:'+un+' ... '+ob);
str(ymin:11:2,un); str(ymax:11:2,ob); DrawText(400,171,1,'Y:'+un+' ... '+ob);
str(zmin:11:2,un); str(zmax:11:2,ob); DrawText(400,179,1,'Z:'+un+' ... '+ob);
end;


procedure rechnen;

var x1, y1, x2, y2, x3, y3 : integer;
    x4, y4, x5, y5, x6, y6 : integer;
    x7, y7, x8, y8 :         integer;
    z1_5, z2_6, z3_7, z4_8 : real;

begin
x1:=fnxp(xmin,ymax); y1:=fnyp(xmin,ymax,0);
x2:=fnxp(xmax,ymax); y2:=fnyp(xmax,ymax,0);
x3:=fnxp(xmax,ymin); y3:=fnyp(xmax,ymin,0);
x4:=fnxp(xmin,ymin); y4:=fnyp(xmin,ymin,0);
x5:=x1; z1_5:=fnz(xmin,ymax); y5:=fnyp(xmin,ymax,z1_5);
x6:=x2; z2_6:=fnz(xmax,ymax); y6:=fnyp(xmax,ymax,z2_6);
x7:=x3; z3_7:=fnz(xmax,ymin); y7:=fnyp(xmax,ymin,z3_7);
x8:=x4; z4_8:=fnz(xmin,ymin); y8:=fnyp(xmin,ymin,z4_8);
if a>pi
   then begin
          DrawLineDirect(x2,y2,x6,y6);
          DrawLineDirect(x2,y2,x3,y3);
          DrawLineDirect(x3,y3,x7,y7);
        end
   else begin
          DrawLineDirect(x4,y4,x8,y8);
          DrawLineDirect(x4,y4,x1,y1);
          DrawLineDirect(x1,y1,x5,y5);
        end;
if b>pi
   then begin
          DrawLineDirect(x1,y1,x5,y5);
          DrawLineDirect(x1,y1,x2,y2);
          DrawLineDirect(x2,y2,x6,y6);
        end
   else begin
          DrawLineDirect(x3,y3,x7,y7);
          DrawLineDirect(x3,y3,x4,y4);
          DrawLineDirect(x4,y4,x8,y8);
        end;
end;


procedure kurven;

  var xi, yj, zij : real;
      i, j :        integer;
      berg :        integer;

  procedure sicht;

      label 1;

      var n          : integer;
          xn, yn, zn : real;

      begin
        for n:=1 to nmax do
            begin
              if n=1
                 then begin
                        if (c=1) and (i=0) then goto 1;
                        if (c=1) and (j=0) then goto 1;
                        if (c=2) and (i=0) then goto 1;
                        if (c=2) and (j=sy-1) then goto 1;
                        if (c=3) and (i=sx-1) then goto 1;
                        if (c=3) and (j=sy-1) then goto 1;
                        if (c=4) and (i=sx-1) then goto 1;
                        if (c=4) and (j=0) then goto 1;
                      end;
              xn:=xi+v_x*dxs*n;
              yn:=yj+v_y*dys*n;
              zn:=fnz(xn,yn);
              if fnyp(xn,yn,zn)<fnyp(xi,yj,zij)
                 then berg:=1;
              if berg=1 then goto 1;
              if xn>=xmax then goto 1;
              if yn>=ymax then goto 1;
              if xn<=xmin then goto 1;
              if yn<=ymin then goto 1;
            end;
      1:end;

var delta_x, delta_y :   integer;
    xpalt, ypalt :       integer;

begin
delta_x:=1; delta_y:=1;
if gitter=2 then delta_y:=sy-1;
j:=0;
repeat
    i:=0;
    repeat
          berg:=0;
          xi:=xmin+i*dx;
          yj:=ymin+j*dy;
          zij:=fnz(xi,yj);
          if xi=xmin
             then begin xpalt:=fnxp(xi,yj); ypalt:=fnyp(xi,yj,zij); end;
          if p=1 then sicht;
          if berg=0
             then DrawLineDirect(xpalt,ypalt,fnxp(xi,yj),fnyp(xi,yj,zij));
          xpalt:=fnxp(xi,yj);
          ypalt:=fnyp(xi,yj,zij);
          i:=i+delta_x;
    until (i>sx-1);
    j:=j+delta_y;
until (j>sy-1);
if gitter=1 then delta_x:=sx-1;
if gitter=2 then delta_y:=1;
i:=0;
repeat
    j:=0;
    repeat
          berg:=0;
          xi:=xmin+i*dx;
          yj:=ymin+j*dy;
          zij:=fnz(xi,yj);
          if yj=ymin
             then begin xpalt:=fnxp(xi,yj); ypalt:=fnyp(xi,yj, zij); end;
          if p=1 then sicht;
          if berg=0
             then DrawLineDirect(xpalt,ypalt,fnxp(xi,yj),fnyp(xi,yj,zij));
          xpalt:=fnxp(xi,yj);
          ypalt:=fnyp(xi,yj,zij);
          j:=j+delta_y;
    until (j>sy-1);
    i:=i+delta_x;
until (i>sx-1);
end;

procedure eingaben;

begin
clrscr;
writeln ('Eingaben fuer 3-D-Funktionsdarstellung');
writeln;

write ('Xmin ?     '); xmin:=-10; readln (xmin);

repeat
write ('Xmax ?     '); xmax:=xmin+20; readln (xmax);
until (xmax>xmin);

write ('Ymin ?     '); ymin:=-10; readln (ymin);

repeat
write ('Ymax ?     '); ymax:=ymin+20; readln (ymax);
until (ymax>ymin);

(*
repeat
writeln;
write ('Winkel x-Achse/Horizontale  (-90 ... +90)?            ');
a:=-20; readln (a);
until (a>=-90) and (a<=90);
*)

a:=-10;

(*
repeat
writeln;
write ('Winkel y-Achse/Horizontale (>',a:3:0,' und <180)?            ');
b:=a+60; readln (b);
until (b>a) and (b<180);
*)

b:=25;

(*
repeat
writeln;
write ('Verkuerzung x-Achse ?                          ');
mx:=1.5; readln (mx);
until (mx>0);
*)

mx:=1.5;

(*
repeat
writeln;
write ('Verkuerzung y-Achse ?                          ');
my:=1; readln (my);
until (my>0);
*)

my:=1;

(*
repeat
writeln;
write ('Verkuerzung z-Achse ?                          ');
mz:=1; readln (mz);
until (mz>0);
*)

mz:=1;

(*
repeat
writeln;
writeln ('Vertikale Lage der Ursprungs auf dem BS');
write ('Wert zischen 0 und 1 (unten ... oben)?         ');
ey:=0.45; readln (ey);
until (ey>0) and (ey<1);
*)

ey:=0.3;

repeat
writeln;
write ('Sichtbedingung einhalten (1=ja/0=nein)?        ');
p:=1; readln (p);
until (p=0) or (p=1);

repeat
writeln;
write ('Diskretisierung (1=grob/2=genau/3=sehr genau)? ');
g:=1; readln (g);
until (g=1) or (g=2) or (g=3);

repeat
writeln;
write ('Gitter parallel zu (1=x/2=y/3=x+y)?            ');
gitter:=1; readln (gitter);
until (gitter=1) or (gitter=2) or (gitter=3);

(*
repeat
writeln;
write ('Achsenskalierung (1=ja/0=nein)?                ');
markierung:=1; readln(markierung);
until (markierung=0) or (markierung=1);
*)

markierung:=0;

end;

var zeichen:char;

begin

eingaben;
clrscr;
writeln ('Bitte einen Augenblick Geduld!');
minmax;

InitGraphic;
konstanten;
achsenkreuz;
rechnen;
kurven;

readln;
LeaveGraphic;

end.