DUzun's Web
Programare, proiecte personale, divertisment

(*------------------------------------------------------------------*

 * Operatiile elementare asupra coordonatelor punctului/vectorului. *

 *------------------------------------------------------------------*)

​

{$N+}

unit Punct;

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

interface

uses Types;

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

const M_PI = 3.1415926535897932384626433832795;

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

function grad(r: TCoord): TCoord; {Radiani -> Grade}

function rad (g: TCoord): TCoord; {Grade -> Radiani}

function ArcTan2(Y, X: TCoord): TCoord;  {ArcTan(Y/X): -pi/2..pi/2}

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

function  sarrus(var p1, p2, p3: TPunct): TCoord;  {Pozitia p3 in raport cu vectorul p1p2}

function  apart(var p, v1,v2,v3: TPunct): boolean; {p apartine triunghiului v1v2v3 ?}

function  dist(var p1, p2: TPunct): TCoord;        {Distanta dintre p1 si p2}

procedure sum_vec(var r: TPunct; v1, v2: TPunct);

procedure dif_vec(var r: TPunct; v1, v2: TPunct);

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

function  Puncte2List(var p: TabelPuncte; nr: TNrElem): PCell;

function  List2Puncte(l: PCell; var p: TabelPuncte): TNrElem;

procedure ThrowCell(c: PCell); {Elimina celula c din lista circulara in care se afla}

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

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

procedure QSort_y(var p: TabelPuncte; left, right: TNrElem; var m: TElem);

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

procedure centru_polig(var p: TabelPuncte; nr: TNrElem; var g: TPunct);     {g - centrul de masa al poligonului}

procedure depl_polig_to(var p: TabelPuncte; nr: TNrElem; var c: TPunct);    {g -> c}

procedure depl_polig(var p: TabelPuncte; nr: TNrElem; var v: TPunct);       {g -> g + v}

function  unghi_puncte(p1, p2, p3: TPunct): TCoord;

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

function intre_val(x, v1, v2: TCoord):boolean; { Determina daca val x este intre v1 si v2. }

function in_patrat(p, v1, v2: TPunct):boolean; { Determina daca punctul p se afla in patratul cu diagonala [v1,v2] }

function rand_real(v: TCoord): TCoord;         { Analogic functiei random, numai pentru numere reale }

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

function CoordToStr(v: TCoord; prec: byte): string; {v -> String}

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

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

implementation

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

function grad(r: TCoord): TCoord; begin grad := r*180/M_PI; end;

function rad (g: TCoord): TCoord; begin rad  := g*M_PI/180; end;

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

function ArcTan2(Y, X: TCoord): TCoord;

begin

   if X > 0 then      ArcTan2 := ArcTan(Y/X) else

   if X < 0 then

        if Y > 0 then ArcTan2 := ArcTan(Y/X) + M_PI else

        if Y < 0 then ArcTan2 := ArcTan(Y/X) - M_PI else

                      ArcTan2 := M_PI

   else { X = 0 }

        if Y > 0 then ArcTan2 :=  M_PI / 2          else

        if Y < 0 then ArcTan2 := -M_PI / 2          else

                      ArcTan2 := 0

end;

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

function unghi_puncte(p1, p2, p3: TPunct): TCoord;

​

begin

  dif_vec(p1, p1, p2);

  dif_vec(p3, p3, p2);

  unghi_puncte := ArcTan2(p3.y, p3.x) - ArcTan2(p1.y, p1.x);

end;

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

function sarrus(var p1, p2, p3: TPunct): TCoord;

begin

   sarrus := p2.x*p1.y + p1.x*p3.y + p3.x*p2.y -

             p1.x*p2.y - p3.x*p1.y - p2.x*p3.y ;

end;

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

function apart(var p, v1,v2,v3: TPunct): boolean;

var k1, k2, k3: TCoord;

begin

   k1 := sarrus(v1,v2, p);

   k2 := sarrus(v2,v3, p);

   k3 := sarrus(v3,v1, p);

   apart := (k1 * k2 >= 0) and (k2 * k3 >= 0) and (k2 * k1 >= 0);

end;

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

function  dist(var p1, p2: TPunct): TCoord;

begin

   dist := sqrt(sqr(p2.x-p1.x)+sqr(p2.y-p1.y));

end;

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

procedure dif_vec(var r: TPunct; v1, v2: TPunct);

begin

  with r do begin

     x := v1.x - v2.x;

     y := v1.y - v2.y;

  end;

end;

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

procedure sum_vec(var r: TPunct; v1, v2: TPunct);

begin

  with r do begin

     x := v1.x + v2.x;

     y := v1.y + v2.y;

  end;

end;

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

{ Determina daca val x este intre v1 si v2. }

function intre_val(x, v1, v2: TCoord):boolean;

begin

   intre_val := ((v2)-(x))*((x)-(v1))>=0;

end;

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

{ Determina daca punctul p se afla in patratul cu diagonala [v1,v2] }

function in_patrat(p, v1, v2: TPunct):boolean;

begin

   in_patrat := intre_val(p.x, v1.x, v2.x) and intre_val(p.y, v1.y, v2.y);

end;

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

procedure centru_polig(var p: TabelPuncte; nr: TNrElem; var g: TPunct);

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

begin

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

   for i := nr-1 downto 0 do

     with p[i] do begin

       g.x := g.x + x;

       g.y := g.y + y;

     end;

   g.y := g.y / nr;

   g.x := g.x / nr;

end;

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

procedure depl_polig_to(var p: TabelPuncte; nr: TNrElem; var c: TPunct);   {g -> c}

var g: TPunct;

begin

   centru_polig(p, nr, g);

   dif_vec(c, c, g);

   depl_polig(p, nr, c);

end;

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

procedure depl_polig(var p: TabelPuncte; nr: TNrElem; var v: TPunct);   {g -> g + v}

var i: TNrElem;

begin

   for i := nr-1 downto 0 do with p[i] do begin

     x := x + v.x;

     y := y + v.y;

   end;

end;

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

function rand_real(v: TCoord): TCoord; {Analogic functiei random, numai pentru numere reale}

begin rand_real := v * random(maxint) / maxint; end;

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

function CoordToStr(v: TCoord; prec: byte): string;

var s, r: string;

    t: TCoord;

begin

   t := Int(abs(v));

   if t <> 0 then begin

     s := '';

     repeat

       s := Chr(Trunc(t) mod 10 + Ord('0')) + s ;

       t := Int(t/10);

     until t = 0;

     if v < 0 then s := '-' +  s;

   end else s := '0';

​

​

   t := Frac(abs(v));

   if (prec <> 0)and(t <> 0) then begin

     s := s + '.';

     repeat

       t := t * 10;

       s := s + Chr(Trunc(t)+Ord('0'));

       t := Frac(t);

       dec(prec);

     until (prec = 0)or(t = 0);

   end;

   CoordToStr := s;

end;

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

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

procedure QSort_y(var p: TabelPuncte; left, right: TNrElem; var m: TElem);

var u, v, j, b: TNrElem;

​

  procedure sort(e: TNrElem);

  var i: TNrElem;

  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;

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

function Puncte2List(var p: TabelPuncte; nr: TNrElem): PCell;

var c, l: PCell;

    i: TNrElem;

begin

  new(c);        {Creem primul element din lista circulara}

  l := c;        {Salvam adresa primului element din lista in l}

  c^.p := @p[0]; {Prima celula contine adresa primului punct}

  for i := 1 to nr-1 do

  begin

     new(c^.urm);       {Creem urmatorul element}

     c^.urm^.prec := c; {Elementului curent este precedent pentru urmatorul}

     c := c^.urm;       {Trecem la urmatorul element}

     c^.p := @p[i];     {Atasam adresa punctului p[i] celulei curente}

  end;

  {Acum c este ultimul element din lista, iar l - primul}

  {Sa unim capetele listei}

  c^.urm := l;   {Dupa ultimul vine primul}

  l^.prec := c;  {Inainte de primul este ultimul}

​

  Puncte2List := l;

end;

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

function List2Puncte(l: PCell; var p: TabelPuncte): TNrElem;

var nr: TNrElem;

    c: PCell;

begin

  nr := 0;

  c := l^.prec;

  repeat

    p[nr] := l^.p^;

    inc(nr);

    if l = c then break; {l^.urm deja nu exista, de aceea intrerupem bucla}

    l := l^.urm;

    dispose(l^.prec); {Nu uitam sa eliberam memoria din heap!}

  until false;

  dispose(c);

  List2Puncte := nr;

end;

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

procedure ThrowCell(c: PCell);

begin

     {Sa observam ca (c^.prec^.urm) = (c)}

     c^.prec^.urm := c^.urm;

     c := c^.prec;          {Trecem la elementul precedent}

     {Acum (c^.prec^.urm) -> (c^.urm^.prec), care este fostul (c)}

     dispose(c^.urm^.prec); {Se elimina fostul (c)}

     c^.urm^.prec := c;     {Unim capetele listei circulare}

end;

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

end.

​

​