DUzun's Web
Programare, proiecte personale, divertisment

{$N+}

{********************************************************************

 * Operatii de Intrare/Iesire cu sctructurile bibliotecii grafice.  *

 ********************************************************************}

unit IOGeom;

interface

uses Types, GrGeom;

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

​

(* Fisier *)

​

{Fisierele contin cate doua/trei numere reale pe rand, separate prin spatiu.

 Numarul de randuri se determina automat de catre functie.

 Functiile returneaza nr de elemente scrise/citite din fisier }

​

function readf_puncte  (numef: string; var p: TabelPuncte): TNrElem;

function readf_drepte  (numef: string; var d: TabelDrepte): TNrElem;

function readf_segmente(numef: string; var s: TabelSegmente): TNrElem;

​

function writef_puncte  (numef: string; var p: TabelPuncte; nr: TNrElem): TNrElem;

function writef_drepte  (numef: string; var d: TabelDrepte; nr: TNrElem): TNrElem;

function writef_segmente(numef: string; var s: TabelSegmente; nr: TNrElem): TNrElem;

​

function open_file(var f: text; numef: string; mode: char): boolean;

​

(* Consola *)

{ Singular }

{ Daca nume = '', atunci se ignora, in caz contrar se afiseaza impreuna cu coordonatele}

procedure read_punct(var p: TPunct; nume: string);

procedure read_dreapta(var d: Dreapta; nume: string);

procedure read_segment(var s: Segment; nume: string);

​

procedure write_punct(var p: TPunct; nume: string);

procedure write_dreapta(d: Dreapta; nume: string);

procedure write_segment(s: Segment; nume: string);

​

{ Plural }

{Functiile returneaza nr de elemente citite/scrise.

 Daca nr = 0, se solicita utilizatorul sa specifice nr de puncte}

function read_puncte(var p: TabelPuncte; nr: TNrElem): TNrElem;

function read_segmente(var s: TabelSegmente; nr: TNrElem): TNrElem;

procedure write_segmente(var s: TabelSegmente; nr: TNrElem);

procedure write_puncte(var p: TabelPuncte; nr: TNrElem);

procedure write_puncte_pol(var p: TabelPuncte; nr: TNrElem);

​

{Propune generarea sau introducerea manuala a elementelor}

function introdu_puncte(var p: TabelPuncte): TNrElem;

function introdu_segmente(var s: TabelSegmente): TNrElem;

​

{Genereaza o lista de elemente. MidX si MidY reprezinta cadrul de generarea a punctelor}

procedure gen_puncte(var p: TabelPuncte; nr, mx, my: integer);

procedure gen_segmente(var s: TabelSegmente; nr, mx, my: integer);

procedure gen_drepte(var d: TabelDrepte; nr, max: integer);

​

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

implementation

uses Punct, Transf, crt;

​

(* IO *)

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

{Incearca sa deschida fisierul in modul specificat. In caz de eroarea se afiseaza mesaj.

 Returneaza true pentru succes si false pentru eroare. }

function open_file(var f: text; numef: string; mode: char): boolean;

begin

   if(numef = '') then begin

      writeln('Introdu numele fisierului:');

      readln(numef);

   end;

   open_file := false;

{$I-}

   assign(f, numef);

   case mode of

     'r': begin reset(f);   numef := '"' + numef + '" pentru citire'; end;

     'w': begin rewrite(f); numef := '"' + numef + '" pentru scriere'; end;

     'a': begin append(f);  numef := '"' + numef + '" pentru actualizare'; end;

     else exit;

   end;

   if(IOResult <> 0) then writeln('Nu pot deschide fisierul '+numef+'!')

   else

     open_file := true;

{$I+}

end;

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

function readf_puncte(numef: string; var p: TabelPuncte): TNrElem;

var  nr: TNrElem;

     fin: text;

begin

   nr := 0;

   readf_puncte := 0;

   if not open_file(fin, numef, 'r') then exit;

   while(not eof(fin))do with p[nr] do

   begin

      readln(fin, x, y);

      inc(nr);

   end;

   close(fin);

   readf_puncte := nr;

end;

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

function writef_puncte(numef: string; var p: TabelPuncte; nr: TNrElem): TNrElem;

var fout: text;

    i: integer;

begin

   writef_puncte := 0;

   if not open_file(fout, numef, 'w') then exit;

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

   close(fout);

   writef_puncte := i;

end;

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

function readf_drepte(numef: string; var d: TabelDrepte): TNrElem;

var nr: TNrElem;

    fin: text;

begin

   nr := 0;

   readf_drepte := 0;

   if not open_file(fin, numef, 'r') then exit;

   while(not eof(fin))do with d[nr] do

   begin

      readln(fin, A, B, C);

      inc(nr);

   end;

   close(fin);

   readf_drepte := nr;

end;

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

function writef_drepte(numef: string; var d: TabelDrepte; nr: TNrElem): TNrElem;

var fout: text;

    i: integer;

begin

   writef_drepte := 0;

   if not open_file(fout, numef, 'w') then exit;

   for i := 0 to nr-1 do with d[i] do writeln(fout, A:8:2,' ',B:8:2,' ',C:8:2);

   close(fout);

   writef_drepte := i;

end;

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

function readf_segmente(numef: string; var s: TabelSegmente): TNrElem;

var  nr: TNrElem;

     fin: text;

begin

   nr := 0;

   readf_segmente := 0;

   if not open_file(fin, numef, 'r') then exit;

   while(not eof(fin))do with s[nr] do

   begin

      readln(fin, p1.x, p1.y);

      if eof(fin) then break;

      readln(fin, p2.x, p2.y);

      inc(nr);

   end;

   close(fin);

   readf_segmente := nr;

end;

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

function writef_segmente(numef: string; var s: TabelSegmente; nr: TNrElem): TNrElem;

var fout: text;

    i: integer;

begin

   writef_segmente := 0;

   if not open_file(fout, numef, 'w') then exit;

   for i := 0 to nr-1 do with s[i] do

   begin

      with p1 do writeln(fout, x:8:2,' ',y:8:2);

      with p2 do writeln(fout, x:8:2,' ',y:8:2);

   end;

   close(fout);

   writef_segmente := i;

end;

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

function read_puncte(var p: TabelPuncte; nr: TNrElem): TNrElem;

var i: integer;

begin

   if(nr = 0) then

   begin

     writeln(#10#13'Introdu nr de puncte: ');

     readln(nr);

   end;

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

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

   end;

   read_puncte := nr;

end;

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

function read_segmente(var s: TabelSegmente; nr: TNrElem): TNrElem;

var i: integer;

begin

   if(nr = 0) then

   begin

     writeln(#10#13'Introdu nr de segmente: ');

     readln(nr);

   end;

   for i := 0 to nr-1 do with s[i] do

   begin

      writeln('s[',i,']: ');

      read_punct(p1, ' p1');

      read_punct(p2, ' p2');

   end;

   read_segmente := nr;

end;

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

procedure read_punct(var p: TPunct; nume: string);

begin

   if(nume<>'') then write(nume + '(x, y) = ');

   readln(p.x, p.y);

end;

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

procedure write_punct(var p: TPunct; nume: string);

begin

   if(nume<>'') then write(nume);

   with p do write('(', x:8:2, ', ', y:8:2, ') ');

end;

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

procedure read_dreapta(var d: Dreapta; nume: string);

begin

   writeln('Introdu coeficientii dreptei '+nume);

   write(nume+'.A = '); readln(d.A);

   write(nume+'.B = '); readln(d.B);

   write(nume+'.C = '); readln(d.C);

end;

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

procedure write_dreapta(d: Dreapta; nume: string);

begin

  writeln;

  writeln(nume+'.A = ', d.A:8:2, '  ',

          nume+'.B = ', d.B:8:2, '  ',

          nume+'.C = ', d.C:8:2 );

end;

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

procedure read_segment(var s: Segment; nume: string);

begin

    writeln;

    writeln('Introdu coordonatele extremitatilor segmentului '+nume);

    read_punct(s.p1, 'p1');

    read_punct(s.p2, 'p2');

end;

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

procedure write_segment(s: Segment; nume: string);

begin

    if(nume<>'') then write(nume + ': ');

    write_punct(s.p1,'p1');

    write_punct(s.p2,'p2');

end;

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

function introdu_puncte(var p: TabelPuncte): TNrElem;

var nr: TNrElem;

    c: char;

    mx, my: integer;

begin

  writeln('Sa generez punctele? (D/N)');

  c := readkey;

​

  writeln(#10#13'Introdu nr de puncte: ');

  readln(nr);

  introdu_puncte := nr;

  if(MidX=0)or(MidY=0) then begin mx := 325; my := 200 end else begin mx := MidX; my := MidY end;

  if(UpCase(c)='D') then gen_puncte(p, nr, mx, my) {Generarea coordonatelor punctelor}

                    else read_puncte(p, nr);       {Citirea coordonatelor punctelor}

end;

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

function introdu_segmente(var s: TabelSegmente): TNrElem;

var nr: TNrElem;

    c: char;

    mx, my: integer;

begin

  writeln('Sa generez punctele? (D/N)');

  c := readkey;

​

  writeln(#10#13'Introdu nr de puncte: ');

  readln(nr);

  introdu_segmente := nr;

​

  if(MidX=0)or(MidY=0) then begin mx := 325; my := 200 end else begin mx := MidX; my := MidY end;

  if(UpCase(c)='D')  then gen_segmente(s, nr, mx, my) {Generarea coordonatelor punctelor}

                     else read_segmente(s, nr);             {Citirea coordonatelor punctelor}

end;

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

procedure write_puncte(var p: TabelPuncte; nr: TNrElem);

var i: integer;

begin

  writeln;

  for i := 0 to nr-1 do

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

end;

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

procedure write_puncte_pol(var p: TabelPuncte; nr: TNrElem);

var i: integer;

begin

  writeln;

  for i := 0 to nr-1 do

     writeln('p',i,'(ro, fi): (',p[i].x:8:2, ',', grad(p[i].y):2:0,')');

end;

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

procedure write_segmente(var s: TabelSegmente; nr: TNrElem);

var i: integer;

begin

  for i := 0 to nr-1 do with s[i] do begin

     write('s[',i:2,']: ');

     write_punct(p1,'');

     write_punct(p2,'');

     writeln;

  end;

end;

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

procedure gen_puncte(var p: TabelPuncte; nr, mx, my: integer);

var i: integer;

begin

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

   begin

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

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

   end;

end;

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

procedure gen_drepte(var d: TabelDrepte; nr, max: integer);

var i: integer;

begin

   for i := 0 to nr-1 do

   begin

     d[i].A := random(2*max)-max;

     d[i].B := random(2*max)-max;

     d[i].C := random(2*max)-max;

   end;

end;

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

procedure gen_segmente(var s: TabelSegmente; nr, mx, my: integer);

var i: integer;

begin

   for i := 0 to nr-1 do with s[i] do

   begin

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

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

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

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

   end;

end;

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

begin

   randomize;

end.

​

​