(*------------------------------------------------------------------* * 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.