{$N+}
unit GrGeom;
interface
uses graph, crt, Types, Transf;
(*----------------------------------------------------------------*)
type TGrOpt = (fit_big, fit_small, s_accel, s_polig, s_infas, s_rect, s_filrect);
     TGrSet = set of TGrOpt;
(*----------------------------------------------------------------*)
var MidX, MidY: integer;
    Ratio: Real;
    gr_set: TGrSet;
(*----------------------------------------------------------------*)
function  InitGr(gm: integer): boolean;   {Initialiseaza modul grafic}
procedure CloseGr;                        {Inkide modul grafic}
function  PauseGr: boolean;               {Restabileste modul textual, dar nu inkide modul grafic}
function  ResumeGr: boolean;              {Restabileste modul grafic, daca a fost initializat}
function  GrInited: boolean;              {Verifica daca modul grafic a fost initializat}
procedure ChgPg;

function  GetMidX: integer;
function  GetMidY: integer;

procedure AbsMaxCoord(var p: TabelPuncte; nr: TNrElem; var mx, my: TCoord);
function  detect_ratio(mx, my: TNumber): TNumber;

procedure drow_punct(p: TPunct; color: integer);
procedure drow_segment(p1, p2: TPunct);
procedure drow_poligon(var p: TabelPuncte; nr: integer; color: integer);
procedure drow_drept(l, h: TPunct; color: integer);
procedure drow_cerc(p: TPunct; raz: integer);

procedure drow_pol_segm(p: TPunct; color: integer);

procedure drow_set_puncte(var p: TabelPuncte; nr: integer; color: integer);
procedure drow_set_puncte_pol(var p: TabelPuncte; nr: integer; color: integer);

procedure drow_poz(t: TPunct; alfa: TNumber);
(*----------------------------------------------------------------*)
{ Controlul tastelor }
function key_control(var dir: TPunct; var alfa: TNumber; delta: TCoord; k: Char): Char;
{ Afiseaza coordonatele punctului t }
procedure print_poz(t: TPunct; x, y: integer; n: string);
(*----------------------------------------------------------------*)
function SwitchGrSet(o:TGrOpt): boolean;
function GetGrSet(o:TGrOpt): boolean;
(*----------------------------------------------------------------*)
implementation
uses IOGeom, Punct;
var Page: boolean;
(*----------------------------------------------------------------*)
function isGrOk: boolean; begin isGrOk := graphresult = grOk; end;

function InitGr(gm: integer): boolean;
var gd: integer;
begin
   InitGr := false;
   {Incerc sa initializez modulul grafic}
   gd := DETECT;
   InitGraph(gd, gm, '');
   if( not isGrOk)then initgraph(gd, gm, 'BGI');
   if( not isGrOk)then initgraph(gd, gm, '..\BGI');
   if( not isGrOk)then exit; {Error}
   SetWriteMode( XORPut );

   {Determinarea coordonatelor mijlocului ecranului}
   MidX := GetMidX;
   MidY := GetMidY;

   InitGr := true; {Success}
end;
(*----------------------------------------------------------------*)
function  GrInited: boolean; begin GrInited := (MidX or MidY)<>0; end;
procedure CloseGr;
begin
  CloseGraph;
  MidX := 0;
  MidY := 0;
end;

function PauseGr: boolean;
begin
  PauseGr := true;
  if GrInited then RestoreCrtMode else
  PauseGr := false;
end;

function ResumeGr: boolean;
begin
  ResumeGr := true;
  if GrInited then SetGraphMode(GetGraphMode or $100) else
  ResumeGr := false;
end;

(*----------------------------------------------------------------*)
procedure ChgPg;
begin
  if Page then begin
    SetActivePage(0);SetVisualPage(1{$ifdef __TMT__}, true{$endif});
    Page:=false;
  end else begin
    SetActivePage(1);SetVisualPage(0{$ifdef __TMT__}, true{$endif});
    Page:=true;
  end;
  {$ifdef __TMT__}ClearPage{$else}ClearViewPort{$endif};
end;
(*----------------------------------------------------------------*)
function  GetMidX: integer; begin GetMidX := GetMaxX shr 1; end;
function  GetMidY: integer; begin GetMidY := GetMaxY shr 1; end;
(*----------------------------------------------------------------*)
procedure AbsMaxCoord(var p: TabelPuncte; nr: TNrElem; var mx, my: TCoord);
var i: integer;
begin
   mx := 0;
   my := 0;
   for i := nr-1 downto 0 do with p[i] do begin
     if abs(x) > mx then mx := abs(x);
     if abs(y) > my then my := abs(y);
   end;
end;
(*----------------------------------------------------------------*)
function detect_ratio(mx, my: TNumber): TNumber;
var i: integer;
    r: TNumber;
begin
   if [fit_big, fit_small] * gr_set <> [] then begin
      if mx = 0 then mx := 1;
      if my = 0 then my := 1;

      if not GrInited then InitGr(0);
      mx := MidX / mx;
      my := MidY / my;

      if fit_big in gr_set then
      begin
        if mx < Ratio then Ratio := mx;
        if my < Ratio then Ratio := my;
      end;

      if fit_small in gr_set then
      begin
        if (mx > Ratio) and (mx < my) then Ratio := mx else
        if (my > Ratio) and (my < mx) then Ratio := my;
      end;
   end;
   detect_ratio := Ratio;
end;
(*----------------------------------------------------------------*)
procedure drow_punct(p: TPunct; color: integer);
begin putpixel(MidX + trunc(p.x*Ratio), MidY - trunc(p.y*Ratio), color); end;
(*----------------------------------------------------------------*)
procedure drow_cerc(p: TPunct; raz: integer);
begin Circle(MidX + trunc(p.x*Ratio), MidY - trunc(p.y*Ratio), trunc(raz*Ratio)); end;
(*----------------------------------------------------------------*)
procedure drow_set_puncte(var p: TabelPuncte; nr: integer; color: integer);
var i: integer;
    mx, my: TCoord;
begin
   if not GrInited then  InitGr(0);
   AbsMaxCoord(p, nr, mx, my);
   detect_ratio(mx, my);
   for i := 0 to nr-1 do drow_punct(p[i], color);
end;
(*----------------------------------------------------------------*)
procedure drow_pol_segm(p: TPunct; color: integer);
begin
  cartez_punct(p, p);
  setcolor(color);
  line(MidX, MidY, MidX + trunc(p.x*Ratio), MidY - trunc(p.y*Ratio));
end;
(*----------------------------------------------------------------*)
procedure drow_segment(p1, p2: TPunct);
begin
  line(MidX + trunc(p1.x*Ratio), MidY - trunc(p1.y*Ratio),
       MidX + trunc(p2.x*Ratio), MidY - trunc(p2.y*Ratio));
end;
(*----------------------------------------------------------------*)
procedure drow_drept(l, h: TPunct; color: integer);
begin
  SetColor(Color);
  Rectangle(MidX + trunc(l.x*Ratio), MidY - trunc(l.y*Ratio),
            MidX + trunc(h.x*Ratio), MidY - trunc(h.y*Ratio));
end;
(*----------------------------------------------------------------*)
procedure drow_poligon(var p: TabelPuncte; nr: integer; color: integer);
var i: integer;
    mx, my: TCoord;
begin
   SetColor(color);
   if not GrInited then  InitGr(0);
   AbsMaxCoord(p, nr, mx, my);
   detect_ratio(mx, my);
   for i := 0 to nr-2 do drow_segment(p[i], p[i+1]);
                         drow_segment(p[nr-1], p[0]);
end;
(*----------------------------------------------------------------*)
procedure drow_set_puncte_pol(var p: TabelPuncte; nr: integer; color: integer);
var i: integer;
begin
   if not GrInited then  InitGr(0);
   for i := 0 to nr-1 do drow_pol_segm(p[i], color);
end;
(*----------------------------------------------------------------*)
function key_control(var dir: TPunct; var alfa: TNumber; delta: TCoord; k: Char): Char;
begin
  dir := ZeroP;  alfa := 0;
  k := UpCase(k);
  key_control := k;
  with dir do
    case k of
      {Directions}
      #77: x := delta * Ratio;
      #75: x := -delta * Ratio;
      #72: Y := delta * Ratio;
      #80: y := -delta * Ratio;
      '+': Ratio := Ratio * 1.1;
      '-': Ratio := Ratio * 0.9;
      '>', '.': alfa := alfa - delta * 0.2;
      '<', ',': alfa := alfa + delta * 0.2;
      {Switches}
      '1': SwitchGrSet(s_polig);
      '2': SwitchGrSet(s_infas);
      '3': SwitchGrSet(s_rect);
      '0': SwitchGrSet(s_accel);
      'F': SwitchGrSet(s_filrect);
      'B': SwitchGrSet(fit_big);
      'S': SwitchGrSet(fit_small);
      else
    end;
end;
(*----------------------------------------------------------------*)
function GetGrSet(o:TGrOpt): boolean; begin GetGrSet := o in gr_set; end;
(*----------------------------------------------------------------*)
function SwitchGrSet(o:TGrOpt): boolean;
begin
  if o in gr_set then gr_set := gr_set - [o]   else gr_set := gr_set + [o];
  SwitchGrSet := GetGrSet(o);
end;
(*----------------------------------------------------------------*)
procedure drow_poz(t: TPunct; alfa: TNumber);
begin
    OutTextXY(0, 0, 'Alfa: ' + CoordToStr(alfa, 2));
    print_poz(t, 0, TextHeight('H')*1, 'T');
    if fit_big   in gr_set then   OutTextXY(0, TextHeight('H')*3, 'Adaptare micsorare');
    if fit_small in gr_set then   OutTextXY(0, TextHeight('H')*4, 'Adaptare marire');

    drow_punct(t, WHITE);
    drow_cerc(t, 5);
end;
(*----------------------------------------------------------------*)
procedure print_poz(t: TPunct; x, y: integer; n: string);
begin
  if n <> '.' then n := n + '.';
  OutTextXY(x, y, n+'x: ' + CoordToStr(t.x, 2));
  OutTextXY(x, y+TextHeight('H'),  n+'y: ' + CoordToStr(Round(t.y), 0));
end;
(*----------------------------------------------------------------*)
begin
  MidX   := 0;
  MidY   := 0;
  Ratio  := 1;
  gr_set := [fit_big{, fit_small}];
  Page   := true;
end.