{$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.