DUzun's Web
Programare, proiecte personale, divertisment

{$N+}

unit OPolig;

(*----------------------------------------------------------------*)

interface

uses Types;

(*----------------------------------------------------------------*)

type

   TIndici = Word;

   TPerm = array[TNrElem] of TIndici;

   PPerm = ^TPerm;

   TPoligon = object

     nr: TIndici;      {Nr de puncte in P^}

     P:  PTabelPuncte; {Tabelul de puncte}

     nm: TIndici;      {Nr de elemente in m^}

     m:  PPerm;        {Tabelul de permutari, folosit pu infasuratoare}

     lx, ly: TIndici;  {Indicii punctelor extreme de minim}

     hx, hy: TIndici;  {Indicii punctelor extreme de maxim}

​

     {Initializare si distrugere}

     constructor Init(size: TIndici);

     constructor Twin(list: PTabelPuncte; n: TIndici);

     destructor  Done;

​

     {Redimensionare}

     function SetSize(size: TIndici): boolean;

     function Resize(size: TIndici): boolean;

     function SetSizeM(size: TIndici): boolean;

     function ResizeM(size: TIndici): boolean;

​

     function Generate(size: TIndici; mx, my: Integer): TIndici;

     function GenStel(size: TIndici; raz: Integer; c: TPunct): TIndici;

     function GenConv(size: TIndici; raz: Integer; c: TPunct): TIndici;

​

     {Citire/Scriere}

     function QueryInput(size: TIndici): TIndici;      {Dialogul de introducere a coordonatelor}

     function Input(size: TIndici): TIndici;           {Citire de la tastatura}

     function Output: TIndici;                         {Afisare pe ecran}

     function QueryFile: TIndici;                      {Cere numele fisierului si citeste din el punctele}

     function QuerySize(size: TIndici): TIndici;       {Cere nr de puncte si seteaza acest nr}

     function LoadFromFile(FileName: string): TIndici; {Citire din fisierul FileName}

     function SaveToFile(FileName: string): TIndici;   {Scriere in fisierul FileName}

     function SaveMToFile(FileName: string): TIndici;  {Scriere infasuratoarea in fisierul FileName}

     function CopyFromTabel(t: PTabelPuncte; n: TIndici): TIndici;

     function CopyToTabel(var t: TabelPuncte): TIndici; {t trebuie sa contina suficient spatiu}

     function CopyMToTabel(var t: TabelPuncte): TIndici;

​

     {Transformati}

{O(nr)}    procedure Center(var g: TPunct);                {g - centrul de masa}

{O(nr)}    function  Move(dx, dy: TCoord): TNumber;        {Deplaseaza originii in (dx,dy) }

{O(nr)}    function  MoveRel(v: TPunct): TNumber;          {Deplaseaza originii sistemului: O -> v }

{O(nr)}    procedure MoveTo(c: TPunct);                    {Deplaseaza centrului de masa:   G -> c }

{O(nr)}    procedure Rotate(alfa: TNumber; o: TPunct);     {Rotirea cu alfa radiani in jurul punctului o }

{O(nr)}    procedure RotateGrad(alfa: TNumber; o: TPunct); {Rotirea cu alfa grade in jurul punctului o }

{O(NlogN)} function  Infasa: TIndici;                {Determinarea infasuratoarei convexe in permutarile m (Algoritmul Andrew)}

{O(nr)}    function  Interior(s: TPunct): boolean;         {Determina daca punctul s apartine interiorului poligonului}

{O(nr)}    function  InRect(s: TPunct): boolean;        {Determina daca punctul s apartine dreptunghiului cadru al poligonului}

           function  Extrem(var l, h: TPunct): boolean;    {Determina valorile extreme ale P^ (l - minime, h - maxime)}

           function  AbsExtrem(var e: TPunct): boolean;    {Determina valorile absolute extreme ale P^}

​

     {Grafica}

     procedure DrowPoints(color: Integer);

     procedure DrowPoligon(color: Integer);

     procedure DrowM(color: Integer);

     procedure DrowMPoints(color: Integer);

     procedure DrowRect(color: Integer);

     procedure FillRect(outCl, inCl: Integer);

​

     {Implementare}

     function  GetExtrem: boolean;

     function  GetExtremM: boolean;

     function  IsNilExtrem: boolean; {Verifica daca punctele extreme au fost detectate}

     procedure NilExtrem;            {Sterge indicii punctelor extreme}

     function  IsSimplu: boolean;    {Determina daca poligonul este simplu}

     function  OnlyM: TIndici; 

​

   end;

(*----------------------------------------------------------------*)

implementation

uses CRT, IOGeom, Punct, Poligon, Graph, GrGeom;

(*----------------------------------------------------------------*)

{Sorteaza elementele p[m[left]..m[right]] dupa permutarile m}

procedure QSort_y(p: PTabelPuncte; left, right: TIndici; var m: PPerm);

var u, v, j, b: TIndici;

  procedure sort(e: TIndici);

  var i: TIndici;

  begin

    if b >= e then exit;

    i := b;  j := e;

    u := m^[(b+e) div 2];

    repeat

      with P^[u] do while (P^[m^[i]].y < y) or ((P^[m^[i]].y = y)and(P^[m^[i]].x < x)) do inc(i);

      with P^[u] do while (y < P^[m^[j]].y) or ((y = P^[m^[j]].y)and(x < P^[m^[j]].x)) do dec(j);

      if i<=j then begin

        v:=m^[i]; m^[i]:=m^[j]; m^[j]:=v;

        inc(i); dec(j);

      end;

    until i>j;

    sort(j);  b := i;  sort(e);

  end;

begin

  b := left; sort(right)

end;

(*----------------------------------------------------------------*)

procedure TPoligon.DrowPoints(color: Integer);  begin drow_set_puncte(P^, nr, Color) end;

(*----------------------------------------------------------------*)

procedure TPoligon.DrowPoligon(color: Integer); begin drow_poligon(P^, nr, Color) end;

(*----------------------------------------------------------------*)

procedure TPoligon.DrowRect(color: Integer);

var l, h: TPunct;

begin

  Extrem(l, h);

  drow_drept(l, h, color);

end;

(*----------------------------------------------------------------*)

procedure TPoligon.FillRect(outCl, inCl: Integer);

var l, h, t: TPunct;

    delta, u: TNumber;

begin

  if not Extrem(l, h) then Exit;

  if not GrInited then InitGr(0);

  AbsExtrem(t); with t do detect_ratio(x, y);

  delta := 1/Ratio; 

  t.x := l.x;

  with t do while (x < h.x) do begin

    y := l.y;

    while (y < h.y) do begin

      if Interior(t) then drow_punct(t, inCl) else drow_punct(t, outCl);

      u := y*Ratio; 

      repeat y := y + delta until Int(u) <> Int(y*Ratio); 

    end;

      u := x*Ratio; 

      repeat x := x + delta until Int(u) <> Int(x*Ratio); 

  end;

end;

(*----------------------------------------------------------------*)

procedure TPoligon.DrowMPoints(color: Integer);

var i: integer;

    e: TPunct;

begin

   if m = nil then Infasa;

   if not GrInited then InitGr(0);

   AbsExtrem(e); with e do detect_ratio(x, y);

   for i := 0 to nm-1 do drow_punct(p^[m^[i]], color);

end;

(*----------------------------------------------------------------*)

procedure TPoligon.DrowM(color: Integer);

var i, j: integer;

    e: TPunct;

begin

   if m = nil then Infasa;

   if not GrInited then  InitGr(0);

   SetColor(color);

   AbsExtrem(e); with e do detect_ratio(x, y);

   j := nm-1;

   for i := 0 to nm-1 do begin

     drow_segment(p^[m^[i]], p^[m^[j]]);

     j := i;

   end

end;

(*----------------------------------------------------------------*)

function  TPoligon.GetExtrem: boolean;

var i: TIndici;

begin

   GetExtrem := false;

   if nr < 1 then Exit;

   GetExtrem := true;

​

   {Determinam punctele de ordonata si abscisa minima si maxima (P^[lx], P^[ly], P^[hx], P^[hy]) }

   i := nr - 1;

   lx := i; ly := lx; hx := lx; hy := hx;

   while i > 0 do

   begin

     dec(i);

     if P^[i].x < P^[lx].x then lx := i;

     if P^[i].y < P^[ly].y then ly := i;

     if P^[hx].x < P^[i].x then hx := i;

     if P^[hy].y < P^[i].y then hy := i;

   end;

end;

(*----------------------------------------------------------------*)

function  TPoligon.GetExtremM: boolean;

var i: TIndici;

begin

   GetExtremM := false;

   if nm < 1 then Exit;

   GetExtremM := true;

​

   i := nm - 1;

   lx := m^[i]; ly := lx; hx := lx; hy := hx;

   while i > 0 do

   begin

     dec(i);

     if P^[m^[i]].x < P^[lx].x then lx := m^[i];

     if P^[m^[i]].y < P^[ly].y then ly := m^[i];

     if P^[hx].x < P^[m^[i]].x then hx := m^[i];

     if P^[hy].y < P^[m^[i]].y then hy := m^[i];

   end;

end;

(*----------------------------------------------------------------*)

function  TPoligon.Extrem(var l, h: TPunct): boolean;

begin

   if IsNilExtrem and not (GetExtremM or GetExtrem) then Extrem := false

   else begin

      l.x := (P^[lx].x);  h.x := (P^[hx].x);

      l.y := (P^[ly].y);  h.y := (P^[hy].y);

      Extrem := true;

   end;

end;

(*----------------------------------------------------------------*)

function TPoligon.AbsExtrem(var e: TPunct): boolean;

var l: TPunct;

begin

   if IsNilExtrem and not (GetExtremM or GetExtrem) then AbsExtrem := false

   else with e do begin

     x := abs(P^[lx].x); y := abs(P^[ly].y);

     with l do begin x := abs(P^[hx].x); y := abs(P^[hy].y);

        if e.x < x then e.x := x;

        if e.y < y then e.y := y;

     end;

     AbsExtrem := true;

   end;  

end;

(*----------------------------------------------------------------*)

function TPoligon.IsSimplu: boolean;

var u, v, i, j: TIndici;

begin

  if nr > 3 then begin

    v := 0;

    IsSimplu := false;

    for u := nr-1 downto 2 do

    begin

      j := u-1;

      for i := u-2 downto 0 do begin

        if i <> v then

        if intersect(P^[v], P^[u], P^[j], P^[i]) then Exit;

        j := i;

      end;

      v := u;

    end;

  end;

  IsSimplu := true;

end;

(*----------------------------------------------------------------*)

function  TPoligon.Infasa: TIndici;

var i, j, u, v, a, b: TIndici;

    r: TNumber;

begin

   Infasa := 0;

   if not SetSizeM(nr) then exit;   {Alocam spatiu pentru lista de permutari}

​

   {1. Determinam punctele de ordonata minima si maxima (P^[ly], P^[hy]) }

   GetExtrem;

​

   {2. Separam P^ in doua submultimi, in functie de pozitia

       fata de vectorul (P^[a],P^[b])}

   u := 0;

   v := nr;

   {Amplasam punctele de ordonata minima/maxima la capetele listei}

   m^[u] := ly;  {Sfirsitul S1}

   m^[v] := hy;  {Inceputul S2}

   for i := nr-1 downto 0 do if(i<>ly)and(i<>hy)then begin

      r := sarrus(P^[ly], P^[hy], P^[i]);

      {S1} if r > 0 then begin inc(u); m^[u] := i; end else

      {S2} if r < 0 then begin dec(v); m^[v] := i; end else

      {Punctele de pe dreapta (P^[a], P^[b]) sunt ignorate (r=0)}

   end;

   {Acum P^[m^[0]..m^[u]] = S1, P^[m^[v]..m^[nr]] = S2}

​

   {3. Sortarea dupa ordonata}

   QSort_y(P, 1, u, m);

   QSort_y(P, v, nr-1, m);

​

   {4. Excludem punctele care nu sunt pe infasuratoare}

   {a. Verificam tripletele formate din S1}

   m^[u+1] := m^[nr]; {Punctul cu ordonata maxima}

   a := 0;   {Ultimul element din infasuratoare}

   i := a+1; {Punctul care se verifica}

   j := i+1; {Un punct oarecare din S1}

   while i <= u do {Se verifica toate punctele pana la u, inclusiv}

   begin

     if sarrus(P^[m^[a]], P^[m^[j]], P^[m^[i]]) > 0 then

     begin     {Miscarea inainte}

        inc(a);

        if a <> i then m^[a] := m^[i];

        i := j;  inc(j);

     end else  {Miscarea inapoi}

       if a > 0 then begin {Daca nu s-a ajuns la primul element}

         i := a;  dec(a);

       end else begin      {Daca a e primul element, mergem tot inainte}

         i := j;  inc(j);

       end;

   end;

​

   {b. Verificam tripletele formate din S2}

   m^[v-1] := m^[0];  {Punctul cu ordonata minima}

   b := nr;  {Ultimul element din infasuratoare}

   i := b-1; {Punctul care se verifica}

   j := i-1; {Un punct oarecare din S2}

   while i >= v do {Se verifica toate punctele pana la v, inclusiv}

   begin

     if sarrus(P^[m^[b]], P^[m^[j]], P^[m^[i]]) > 0 then

     begin          {Miscarea inainte}

        dec(b);

        if b <> i then m^[b] := m^[i];

        i := j;  dec(j);

     end else       {Miscarea inapoi}

       if b < nr then begin {Daca nu s-a ajuns la primul element}

         i := b;  inc(b);

       end else begin       {Daca b e primul element, mergem tot inainte}

         i := j;  dec(j);

       end;

   end;

​

   {5. Formam solutia: S1 + S2}

   inc(a); {Nr. nr de elemente din S1}

   for i := nr downto b do m^[a+nr-i] := m^[i];

   dec(b); {Omologul lui a}

   ResizeM(a + nr - b);

   Infasa := nm;  {Nr. de puncte din infasuratoare}

end;

(*----------------------------------------------------------------*)

procedure TPoligon.Rotate(alfa: TNumber; o: TPunct); {Rotirea cu alfa radiani in jurul punctului c}

var c, s: TNumber;

    i: TIndici;

    u, v: TCoord;

begin

   if alfa = 0 then exit;

   c := cos(alfa);

   s := sin(alfa);

   i := 0;

   while i < nr do with P^[i] do begin

     u := x - o.x;  {skimbam originea de coordonate in o}

     v := y - o.y;

     x := c * u - s * v + o.x;

     y := s * u + c * v + o.y;

     inc(i);

   end;

   NilExtrem; {La rotire punctele extreme se skimba}

end;

(*----------------------------------------------------------------*)

procedure TPoligon.RotateGrad(alfa: TNumber; o: TPunct); begin Rotate(alfa*pi/180, o) end;

(*----------------------------------------------------------------*)

function TPoligon.Move(dx, dy: TCoord): TNumber;

var i: TIndici;

    r: TNumber;

begin

   r := sqrt(sqr(dx)+sqr(dy));

   Move := r;

   if r = 0 then exit;

   i := 0;

   while i < nr do with P^[i] do begin

     x := x + dx;

     y := y + dy;

     inc(i);

   end;

end;

(*----------------------------------------------------------------*)

function TPoligon.MoveRel(v: TPunct): TNumber; begin MoveRel := Move(v.x, v.y) end; {O -> v}

(*----------------------------------------------------------------*)

procedure TPoligon.MoveTo(c: TPunct);   {G -> c}

var g: TPunct;

begin

   Center(g);

   dif_vec(c, c, g);

   with c do Move(x, y);

end;

(*----------------------------------------------------------------*)

procedure TPoligon.Center(var g: TPunct);

var i: TIndici;   {g - centrul de masa al poligonului}

begin

   g.x := 0; g.y := 0;

   i := 0;

   while i < nr do with P^[i] do

     begin

       g.x := g.x + x;

       g.y := g.y + y;

       inc(i);

     end;

   g.y := g.y / nr;

   g.x := g.x / nr;

end;

(*----------------------------------------------------------------*)

function TPoligon.SetSize(size: TIndici): boolean;

begin

  if size <> nr then begin

    Done;

    GetMem(P, (size+1)*SizeOf(TPunct));

    if P = nil then nr := 0 

               else nr := size;

  end;

  SetSize := size = nr;

end;

(*----------------------------------------------------------------*)

function TPoligon.Resize(size: TIndici): boolean;

var t: PTabelPuncte;

    i: TIndici;

begin

  if P = nil then SetSize(size);

  if size <> nr then begin

    Resize := false;

    SetSizeM(0);

    GetMem(t, (size+1)*SizeOf(TPunct));

    if t = nil then exit;

    if P <> nil then begin

       if size > nr then i := nr else i := size;

       while i > 0 do begin

         dec(i);

         t^[i] := P^[i];

       end;

       FreeMem(P, (nr+1)*SizeOf(TPunct));

    end;  

    P := t;

    nr := size;

    if(lx>=nr)or(ly>=nr)or(hx>=nr)or(hy>=nr)then NilExtrem;

  end;

  Resize := true;

end;

(*----------------------------------------------------------------*)

function TPoligon.SetSizeM(size: TIndici): boolean;

begin

  if size <> nm then begin

    if m <> nil then  FreeMem(m, (nm+1)*SizeOf(TIndici));

    GetMem(m, (size+1)*SizeOf(TIndici));

    if m = nil then nm := 0

               else nm := size;

  end;

  SetSizeM := size = nm;

end;

(*----------------------------------------------------------------*)

function TPoligon.ResizeM(size: TIndici): boolean;

var t: PPerm;

    i: TIndici;

begin

  if size <> nm then begin;

    ResizeM := false;

    GetMem(t, (size+1)*SizeOf(TIndici));

    if t = nil then exit;

    if m <> nil then begin

       if size > nm then i := nm else i := size;

       while i > 0 do begin

         dec(i);

         t^[i] := m^[i];

       end;

       FreeMem(m, (nm+1)*SizeOf(TIndici));

    end;

    m := t;

    nm := size;

  end;

  ResizeM := true;

end;

(*----------------------------------------------------------------*)

function  TPoligon.OnlyM: TIndici; 

var t: PTabelPuncte;

    i: TIndici;

begin

  if (P <> nil) and (m <> nil) then begin

     GetMem(t, (nm+1)*SizeOf(TPunct));

     i := nm;

     while i > 0 do begin dec(i); t^[m^[i]] := P^[i]; end;    

     FreeMem(P, (nr+1)*SizeOf(TPunct));

     P := t;

     nr := nm;

  end;

  OnlyM := nr;

  if(lx>=nr)or(ly>=nr)or(hx>=nr)or(hy>=nr)then NilExtrem;

end;

(*----------------------------------------------------------------*)

constructor TPoligon.Init(size: TIndici);

begin

  nr := 0; P := nil; m := nil;

  if not SetSize(size) then Fail;

end;

(*----------------------------------------------------------------*)

constructor TPoligon.Twin(list: PTabelPuncte; n: TIndici);

begin

  if list = nil then n := 0;

  Init(n);

  while n > 0 do begin

    dec(n);

    P^[n] := list^[n];

  end;

end;

(*----------------------------------------------------------------*)

destructor  TPoligon.Done;

begin

    if P <> nil then  FreeMem(P, (nr+1)*SizeOf(TPunct));

    if m <> nil then  FreeMem(m, (nm+1)*SizeOf(TIndici));

    nr := 0; P := nil; m := nil;

    NilExtrem;

end;

(*----------------------------------------------------------------*)

procedure TPoligon.NilExtrem; begin lx := 0; ly := 0; hx := 0; hy := 0; end;

function  TPoligon.IsNilExtrem: boolean; begin IsNilExtrem := lx or ly or hx or hy = 0; end;

(*----------------------------------------------------------------*)

function TPoligon.QueryInput(size: TIndici): TIndici;      {Dialogul de introducere a coordonatelor}

var s: string;

    r: TNumber;

    v: boolean;

begin

   PauseGr;

   v := true;

   repeat

   if not v then writeln('Optiune invalida! Mai incearca o data...'+endl);

   writeln;

   writeln('Alege o optiune prin tastarea literei corespunzatoare:'+endl);

   writeln(' I: Introducerea coordonatelor manual (implicit)'+endl +

           ' F: Citirea din fisier'+endl +

           ' G: Generarea unei multimi aleatoare de puncte'+endl +

           ' S: Generarea unui poligon stelat'+endl +

           ' C: Generarea unui poligon convex'+endl);

​

    case UpCase(ReadKey) of

    'I': Input(size);

    'F': QueryFile;

    'G': begin write('Raza: '); readln(r); Generate(size, abs(Trunc(r)), abs(Trunc(r))) end;

    'S': begin write('Raza: '); readln(r); GenStel(size, abs(Trunc(r)), ZeroP) end;

    'C': begin write('Raza: '); readln(r); GenConv(size, abs(Trunc(r)), ZeroP) end;

    else v := false;

    end;

    clrscr;

    until v;

    ResumeGr;

end;

(*----------------------------------------------------------------*)

function TPoligon.QueryFile: TIndici; {Cere numele fisierului si citeste din el punctele}

var s: string;

begin

   QueryFile := 0;

   s := '';

   repeat

      if s <> '' then writeln('Fisierul "' + s + '" nu e valid!');

      write('Nume fisier: ');

      readln(s);

   until (s = '') or (LoadFromFile(s) <> 0);

   QueryFile := nr;

end;

(*----------------------------------------------------------------*)

function TPoligon.QuerySize(size: TIndici): TIndici; {Cere nr de puncte si seteaza acest nr}

begin

   if(size = 0) then begin

     writeln; writeln('Introdu nr de puncte: ');

     readln(size);

   end;

   while not SetSize(size) do dec(size);

   writeln('Spatiu alocat petru ', size, ' puncte!');

   QuerySize := nr;

end;

(*----------------------------------------------------------------*)

function TPoligon.Input(size: TIndici): TIndici;

var i: TIndici;

begin

   PauseGr;

   QuerySize(size);

   i := 0;

   while i < nr do with P^[i] do begin

      write('p[',i,'](x,y): '); readln(x, y);

      inc(i);

   end;

   Input := nr;

   ResumeGr;

end;

(*----------------------------------------------------------------*)

function TPoligon.Output: TIndici;

var i: TIndici;

begin

  PauseGr;

  writeln;

  i := 0;

  while i < nr do with P^[i] do begin

     writeln('p',i,'(x, y): (', x:8:2, ',', y:8:2,')');

     inc(i);

     if i mod WindMax = 0 then readkey;

  end;

  Output := nr;

  ResumeGr;

end;

(*----------------------------------------------------------------*)

function  TPoligon.LoadFromFile(FileName: string): TIndici;

var f: text;

    l, c: ListPuncte;

    i: TIndici;

begin

   LoadFromFile := 0;

   if not open_file(f, FileName, 'r') then exit;

   Done;   {Stergem punctele existente}

   new(l); {Cream lista de puncte}

   c := l;

   i := 0;

   while(not eof(f))do

   begin   {Citirea punctelor din fisier}

      with c^.p do readln(f, x, y);

      new(c^.urm);

      c := c^.urm;

      inc(i);

   end;

   c^.urm := nil;

   Close(f);

   SetSize(i);

   c := l;

   i := 0;

   while c^.urm <> nil do

   begin   {Transferul din lista in tabel}

     P^[i] := c^.p;

     c := c^.urm;

     Dispose(l);

     l := c;

     inc(i);

   end;

   Dispose(l);

   LoadFromFile := nr; {Nr de puncte citite}

end;

(*----------------------------------------------------------------*)

function  TPoligon.SaveToFile(FileName: string): TIndici;

var f: text;

    i: TIndici;

begin

   SaveToFile := 0;

   if (P=nil)or(nr=0) or not open_file(f, FileName, 'w') then exit;

   for i := 0 to nr-1 do with P^[i] do writeln(f, x:8:2,' ',y:8:2);

   close(f);

   SaveToFile := nr-1;

end;

(*----------------------------------------------------------------*)

function  TPoligon.SaveMToFile(FileName: string): TIndici;

var f: text;

    i: TIndici;

begin

   if m = nil then Infasa;

   SaveMToFile := 0;

   if (m=nil)or(nm=0) or not open_file(f, FileName, 'w') then exit;

   for i := 0 to nm-1 do with P^[m^[i]] do writeln(f, x:8:2,' ',y:8:2);

   close(f);

   SaveMToFile := nm-1;

end;

(*----------------------------------------------------------------*)

function TPoligon.CopyToTabel(var t: TabelPuncte): TIndici;

var i: TIndici;

begin

  if P = nil then CopyToTabel := 0 else

  begin

    CopyToTabel := nr;  i := nr;

    while i > 0 do begin dec(i); t[i] := P^[i]; end;

  end;

end;

(*----------------------------------------------------------------*)

function TPoligon.CopyMToTabel(var t: TabelPuncte): TIndici;

var i: TIndici;

begin

  if (m = nil)and(Infasa = 0) then CopyMToTabel := 0 else

  begin

    CopyMToTabel := nm;  i := nm;

    while i > 0 do begin dec(i); t[i] := P^[m^[i]]; end;

  end;

end;

(*----------------------------------------------------------------*)

function TPoligon.CopyFromTabel(t: PTabelPuncte; n: TIndici): TIndici;

begin

  if t = nil then n := 0;

  Resize(n);

  while n > 0 do begin

    dec(n);

    P^[n] := t^[n];

  end;

end;

(*----------------------------------------------------------------*)

function TPoligon.Generate(size: TIndici; mx, my: Integer): TIndici;

begin

  Generate := QuerySize(size);

  size := nr;

  while size > 0 do begin

    dec(size);

    with P^[size] do begin

      x := random(2*mx)-mx;

      y := random(2*my)-my;

    end;

  end;

end;

(*----------------------------------------------------------------*)

function TPoligon.GenStel(size: TIndici; raz: Integer; c: TPunct): TIndici;

var pas: TNumber;

    t: TPunct;

begin

   GenStel := 0;

   repeat QuerySize(size); size := 0; until nr > 3;

​

   P^[nr] := c;

   pas := 2 * pi / nr;          {Pasul unghiular mediu de la un varf la altul}

   size := nr;

   while size > 0 do with t do begin

      dec(size);

      x := raz * 0.1 + rand_real(raz * 0.9); {ro}

      y := size * pas  + rand_real(pas);       {fi}

      cartez_punct(t, t);       {Trecem la coordonate carteziene}

      sum_vec(P^[size], t, c);  {Transformam punctul in sistemul de coordonate cu centrul c}

   end;

   GenStel := nr;

end;

(*----------------------------------------------------------------*)

function TPoligon.GenConv(size: TIndici; raz: Integer; c: TPunct): TIndici;

var lat, pas: TNumber;

    t: TPunct;

    u, v: TNumber;

begin

   GenConv := 0;

   repeat QuerySize(size); size := 0; until nr > 3;

​

  { gen_puncte(p, nr, max_x, max_y);  gen_polig_conv := Infasa(p, p, nr); }

   u   := pi * (nr-2) / nr;           {Unghiul poligonului regulat cu nr laturi}

   lat := (raz) * sqrt(2*(1-cos(u))); {Latura poligonului regulat de raza raz}

   pas := pi - u;

​

   P^[0] := ZeroP;

   P^[1].x := rand_real(lat)+1;

   P^[1].y := rand_real(lat)+1;

​

   with P^[1] do v := ArcTan2(y, x);

​

   for size := 2 to nr-1 do with t do begin

      y := abs(u - unghi_puncte(P^[size-2], P^[size-1], P^[0]));

      if pas < y then y := pas;

      y := v - M_PI + u + (rand_real(2*y)-y);         {fi}

      x := lat / 10 + rand_real(lat - lat / 10);  {ro}

      v := y;

      cartez_punct(t, t);       {Obtinem coordonatele carteziene}

      sum_vec(P^[size], P^[size-1], t); {Apmlasam varful la locul sau, dupa varful precedent}

   end;

   Infasa; {Pentru orice eventualitate determinam infasuratoarea convexa}

   for size := 0 to nm-1 do P^[size] := P^[m^[size]];

   Resize(nm);

   MoveTo(c);

   GenConv := nr;

end;

(*----------------------------------------------------------------*)

function  TPoligon.InRect(s: TPunct): boolean;

begin      

   if IsNilExtrem and not (GetExtremM or GetExtrem) then InRect := false

   else with s do 

      InRect := (P^[lx].x < x)and(x < P^[hx].x)and(y < P^[ly].y)and(y < P^[hy].y)

end;

(*----------------------------------------------------------------*)

function  TPoligon.Interior(s: TPunct): boolean;

var i, j, k: integer;

    t, u, v: TCoord;

begin

    Interior := false;

    if IsNilExtrem then 

    Interior := true;

                                                                          { Fie l dreapta ce trece prin s, paralela la Ox }

    k := 0;                                                               {Numarul de intersectii cu dreapta l la stanga lui s}

    j := 0;                                                               {Ultimul punct analizat}

    u := P^[j].y - s.y;                                                   {Ultima ordonata care nu se afla pe l}

    for i := nr-1 downto 0 do with P^[i] do

    begin

      if y = s.y then                                                     {P^[i] se afla pe l}

        if (P^[j].y = s.y) and intre_val(s.x, P^[j].x, x) then Exit else  {s se afla pe latura P^[j]P^[i]}

      else begin                                                          {P^[i] nu se afla pe l}

        v := y - s.y;

        if u*v < 0 then begin                                             {Domeniul a fost intersectat de dreapta l}

          if P^[j].y = s.y then t := P^[j].x                              {intersectat intr-un varf al poligonului}

                           else t := x + (P^[j].x-x)*(s.y-y)/(P^[j].y-y); {intersectat pe o latura a poligonului}

                                                                          {t este abscisa punctului de intersectie cu l}

          with s do if t < x then inc(k)                                  {Daca a fost intersectat la stanga de s}

               else if t = x then Exit;                                   {s se afla pe latura P^[j]P^[i]}

        end;

        u := v;

      end;

      j := i;

    end;

    Interior := k and 1 <> 0;

end;

(*----------------------------------------------------------------*)

(*----------------------------------------------------------------*)

begin

  randomize;

end.

​

​