program bez4;
uses Graph, DOS;
const n = 32; n1 = 33; n2=34;
      XMax = 640; YMax = 480;
      Xc = 320; Yc = 240;

type tpoint = record x,y,z,w: real end;
     tcontr = array[1..4] of tpoint;
     tcurve = array[1..n] of tpoint;
     TPoly = array[1..n2] of PointType;

var GDriver, GMode, ErrCode: integer;
    { NoOfXPoints, NoOfYPoints: integer; }
    Dx,Dy: integer;
    X0,Y0: integer;
    SinX,SinY: real;
    mycp: tcontr; mycc: tcurve;

procedure InitGr;
begin
  write('Init'); readln;
  X0:=XMax div 2-50; Y0:=YMax;
  {NoOfXPoints:=70; NoOfYPoints:=70;}
  SinX:=0.5; SinY:=0.5;
  Dx:=X0 div n+2;  Dy:=Y0 div n;
  {write('dx:',dx,' dy:',dy); readln;}
  GDriver:=Detect;
  InitGraph(GDriver,GMode,'');
  ErrCode:=GraphResult;
  if ErrCode <> GrOk then
    begin
      writeln('Erro em InitGraph:',ErrCode);
      Halt;
    end;
end;

procedure FinishGr;
begin
  CloseGraph;
end;

procedure cbezier4(var cp: tcontr; var cc: tcurve);
var i: integer; t,t1,delta: real;
begin
  with cc[1] do begin x:=cp[1].x; y:=cp[1].y end;
  delta:= 1.0 / n;
  for i:=2 to n do
    begin
      t:=i*delta; t1:=1.0-t;
      cc[i].x := cp[1].x*t1*t1*t1
               + cp[2].x*3.0*t*t1*t1
               + cp[3].x*3.0*t*t*t1
               + cp[4].x*t*t*t;

      cc[i].y := cp[1].y*t1*t1*t1
               + cp[2].y*3.0*t*t1*t1
               + cp[3].y*3.0*t*t*t1
               + cp[4].y*t*t*t;

      cc[i].z := cp[1].z*t1*t1*t1
               + cp[2].z*3.0*t*t1*t1
               + cp[3].z*3.0*t*t*t1
               + cp[4].z*t*t*t;

      cc[i].w := cp[1].w*t1*t1*t1
               + cp[2].w*3.0*t*t1*t1
               + cp[3].w*3.0*t*t*t1
               + cp[4].w*t*t*t
    end;
end;

procedure CurveToPoly(var Curve: tCurve; var P: TPoly);
var i,j: integer;
begin
  for i:=1 to n do with Curve[i] do
    begin
      P[i].x:=trunc(x*120); P[i].y:=Ymax-trunc(y*50);
    end;
  P[n+1].x:=P[n].x; P[n+1].y:=YMax;
  P[n+2].x:=0; P[n+2].y:=YMax;
end;

procedure AdjPoly(var P: tPoly; dX,dY: integer);
const mX= 0.0; X0=100; Y0=50;
var i: integer;
begin
  for i:=1 to n+2 do with P[i] do
    begin
      inc(x,dx+x0); inc(y,dy-(trunc(x*mx)));
    end;
end;

procedure Test2;
var P: tPoly; var i: integer;
begin
  InitGr;
  for i:=1 to 10 do
    begin
      MyCP[2].y:=i-5;  MyCP[3].y:=12-2*i;
      cbezier4(MyCP,MyCC);
      CurveToPoly(MyCC,P);
      AdjPoly(P,0,-80);
      DrawPoly(n+2,P);
    end;
  readln;
  FinishGr
end;

procedure DrawCurve(Y0: integer; var Curve:tCurve; var Points);

  procedure CurveToPoly(var Poly: TPoly);
  var i: integer;
  begin
    for i:=1 to n do with Poly[i] do
      begin
        x:=trunc((Curve[i].x/3.0)*5);
        y:=trunc((Curve[i].y/3.0)*2);
      end;
  end;

  procedure Adjust(var Poly: TPoly);
  var i: integer; n1: integer;
  begin
    n1:=n+1;
    CurveToPoly(Poly);
    Poly[n1].x:=n-1;
    Poly[n1].y:=0;
    Poly[n1+1].x:=0;
    Poly[n1+1].y:=0;
    for i:=1 to n+2 do with Poly[i] do
      begin
        Y:=YMax-(Y*Dy div 4)-Dy-(X*Dy div 4)-(Y0*dy*5 div 16);
        x:=x*dx+x0-(Y0*dy*5 div 8);
      end;
  end;

begin
  Adjust(TPoly(Points));
  SetFillStyle(SolidFill,Black);
  FillPoly(n+2,Points);
  SetColor(yellow);
  DrawPoly(n+2,Points);
end;



procedure cp1;
var i: integer;
begin
  for i:=1 to 4 do
  with mycp[i] do begin x:=i-1; y:=2*(i-1) end;
end;

procedure prcurve;
var i: integer;
begin
  for i:=1 to n do
    with mycc[i] do writeln(x:5:3,' - ', y:5:3);
  readln;
end;

procedure Test1;
var P: array[1..100] of PointType;
    i,j: integer;
begin
  InitGr;
  for j:=25 downto 1 do
    begin
     {
      for i:=1 to NoOfXPoints do   P[i].x:=i;
      for i:=1 to 10 do P[i].y:=i div 3+10;
      for i:=11 to 20 do P[i].y:=3+10;
      for i:=21 to 31 do P[i].y:=3+i-20+10;
      for i:=31 to NoOfXPoints do P[i].y:=30+10;
     }
      DrawCurve(j,MyCC,P);
    end;
  readln;
  FinishGr
end;


begin
  cp1; mycp[2].y:=-4; mycp[2].x:=0.5;
       mycp[3].y:=2;  mycp[3].x:=1.5; mycp[4].y:=2;
  cbezier4(mycp,mycc);
  prcurve;
  {
  InitGr;
  readln;
  FinishGr;
  }
  Test2;
end.

program draw3d;
{
  desenho de superficie em 3D
  Tela: 640 x 480
}



MinVal = 10e-20;
      MaxVal = 10e30;
      NCurvas = 11;   { numero maximo de curvas de nivel }
      NPontos = 512;  { numero maximo de pontos por curva de nivel }

type
      Ponto = record
                X, Y: real
              end;

      CurvaN = record
                np: integer;
                pp: array[1..NPontos] of Ponto;
              end;

      ApCurvaN = ^ CurvaN;


      ZVector = array[1..200] of integer;

var
      VetCurva : array[1..NCurvas] of ApCurvaN;
      Alt      : array[1..NCurvas] of real;
      CurN : integer;  { numero de curvas deste mapa }
(*    MaxX,MaxY: real;  { tamanho deste mapa }   *)


var GDriver, GMode, ErrCode: integer;
    NoOfXPoints, NoOfYPoints: integer;
    Dx,Dy: integer;
    X0,Y0: integer;
    SinX,SinY: real;

procedure Init;
begin
  {write('Init'); readln;}
  X0:=XMax div 2-50; Y0:=YMax;
  NoOfXPoints:=70; NoOfYPoints:=70;
  SinX:=0.5; SinY:=0.5;
  Dx:=X0 div NoOfXPoints+2;  Dy:=Y0 div NoOfYPoints;
  {write('dx:',dx,' dy:',dy); readln;}
  GDriver:=Detect;
  InitGraph(GDriver,GMode,'');
  ErrCode:=GraphResult;
  if ErrCode <> GrOk then
    begin
      writeln('Erro em InitGraph:',ErrCode);
      Halt;
    end;
end;

procedure Finish;
begin
  CloseGraph;
end;


procedure CarregaMapa(FName: PathStr);
var F: text; cont,i: integer; ACurva: CurvaN;
    MaxX,MaxY: real;
begin
  Assign(F,FName); reset(F);
  CurN:=0;
  readln(F,MaxX,MaxY);
  while not(eof(F)) do
    begin
      inc(CurN);
      readln(F,Alt[CurN]); cont:=0;
      repeat
        inc(cont);
        with ACurva.pp[cont] do readln(F,X,Y);
      until ACurva.pp[cont].X < 0;
      dec(cont);
      {GetMem(VetCurva[CurN],cont*SizeOf(Ponto));}
      New(VetCurva[CurN]);
      for i:=1 to cont do VetCurva[CurN]^.pp[i]:=ACurva.pp[i];
      VetCurva[CurN]^.np:=cont;
    end;
  close(F);
end;


function InterpZ(pX,pY: real): real;
const KDiv=9.0;  DMax=30.0;
var i,j,k: integer;
    zz,D,S1,S2: real; b: boolean;
begin
  S1:=0.0; S2:=0.0; b:=false;
  for i:=1 to CurN do
    with VetCurva[i]^ do
      begin
        k:=np;
        for j:=1 to np do
          begin
            D:=sqrt(sqr(pX-pp[j].x)+sqr(pY-pp[j].y));
            if D < 10E-5
              then begin
                     b:=true;
                     ZZ:=Alt[i];
                   end
              else
             if D <= DMax then
                  begin
                    S1:=S1+(Alt[i]/exp(ln(D)*KDiv));
                    S2:=S2+(1.0/exp(ln(D)*KDiv));
                    {
                    S1:=S1+(Alt[i]/D);
                    S2:=S2+(1.0/D);
                    }
                   end
          end
      end;
  if b then InterpZ:=ZZ else InterpZ:=(S1/S2);
end;

procedure ListaMapa;
var i,j: integer;
begin
  for i:=1 to CurN do
    with VetCurva[i]^ do
      begin
        writeln('No.de pontos:',np,' Altura:',Alt[i]:5:2);
        for j:=1 to np do writeln(pp[j].x:5:2,':',pp[j].y:5:2);
        readln
      end;
end;


procedure Test2;
var P: array[1..200] of PointType;
    i,j,k: integer; Z: real;
begin
  CarregaMapa('mapa4.dat');  {ListaMapa;}

(*
  k:=0;
  for j:=1 to 50 do
    for i:=1 to 50 do
      begin
        inc(k); 
        Z:=InterpZ(i,j);
        if (k mod 125)=0
          then begin
                 writeln('InterpZ(',i,',',j,'):',Z:5:3);
               end
    end;
    readln;
*)

  Init;

(*
  for k:=1 to 10 do
  for j:= NoOfYPoints downto 1 do
    begin
      for i:=1 to NoOfXPoints do with P[i] do
        begin
          y:=(trunc(sqrt(sqr(i-50)+sqr(j-40)))mod 15)*2+(sqr(i)div 100)-(sqr(j) div 150)+4*k;
          x:=i
        end;
       DrawCurve(j,P);
    end;
  readln;
*)
  for j:= NoOfYPoints downto 1 do
    begin
      for i:=1 to NoOfXPoints do with P[i] do
        begin
          y:=trunc(InterpZ(i,j)*2.5);
          x:=i
        end;
       DrawCurve(j,P);
    end;
  readln;

  Finish
end;


begin
  Test2;
end.