unit ingraph;
interface
 uses TypesAndConst;


const
 ScaleSize = 0.085; { Maswtab graficheskoy matrici }
 Detalize = 0.05;   { Detalizacia grafikov }

type
 FFunc = function (x: real): real;

var
 Scale : real;

  function Init : boolean; {esli inicilizacia grafiki ne udalas - FALSE}
  function InitGr : boolean; {esli inicilizacia grafiki ne udalas - FALSE}
  procedure InitMatrix(xr, yt : real; cx, cy : integer);

  { Osnovnaya procedura, zapuskaet obolochku }
  procedure ShellWork(f1,f2,f3: FFunc; sys: TSystem);

  { Otrisovka VSEY sceny }
  procedure DrawScene(f1,f2,f3:FFunc; sys:TSystem; selected:integer);

  procedure DrawAxes;                     { Osi koordinat }
  procedure DrawFunc(f:FFunc; c:integer); { Otrisovka odnoy funkcii cvetom C }
  procedure Draw3Func(f1,f2,f3:FFunc);    { Otrisovka odnoy funkcii }
  procedure DrawCross(sys:TSystem; selected:integer); { Tochki peresechenia }
  procedure DrawInfo(sys:TSystem);  { Otricovka informacii o Integrale i pr.}

   { Vspomogatelnie procedury & funkcii }
   procedure line(x, y, xx, yy : real);
   procedure lineto(x, y : real);
   procedure moveto(x, y : real);
   procedure outtextmx(x,y:real; s:string);

   function floattostr(x:real) : string;
   function inttostr(x:integer) : string;

implementation
 uses crt, graph;

 type
  TGraph = record              { "matrica" ;) }
    transx, transy : integer;  { Perenos grafika }
    sx, sy, rx, ry : real;     { Masshtab i normirovka grafika }
  end;

 var
  mx : TGraph;

{--- Graphic in Work :: graphicheskaya obolochka i interface ---}
procedure ShellWork;
var i : integer;
    c : char;
begin
    i := 1;
      repeat
       DrawScene(f1,f2,f3, sys, i);
        c := readkey;
         case c of
          VK_DOWN : i := i + ord(i<CrossCount);
            VK_UP : i := i - ord(i>1);
          VK_PLUS : begin
                      scale := scale + 0.01*ord(scale<0.7); { uvelichivaem kartinku }
                      InitMatrix(Scale, Scale, getmaxx div 2, getmaxy div 2 - getmaxy div 10); { pereschitivaem matricu }
                    end;
          VK_MINUS: begin
                      scale := scale - 0.01*ord(scale>0.05); { uvelichivaem kartinku }
                      InitMatrix(Scale, Scale, getmaxx div 2, getmaxy div 2 - getmaxy div 10); { pereschitivaem matricu }
                    end;
         end;
      until c = VK_ESC;
   closegraph;
end;


{--- DrawScene :: otrisovka VSEY sceny ---}
procedure DrawScene(f1,f2,f3:FFunc; sys:TSystem; selected:integer);
begin
 ClearDevice;

  DrawAxes;              { Risuem osi koordinat i ramku }
  Draw3Func(f1, f2, f3);    { Risuem funkcii }
  DrawCross(sys,selected);     { Risuem tochki peresecheniya }
  DrawInfo(sys);
end;

procedure DrawInfo(sys:TSystem);
var i : integer;
begin
 setcolor(LIGHTGRAY);
 for i := 1 to CrossCount do
  outtextmx(-mx.rx*1.0, -mx.ry*1.2-mx.ry*0.05*i,
            '[I(f'+inttostr(i)+') = ' +floattostr(sys.I[i])+']');

  outtextmx( mx.rx*0.06, -mx.ry*1.22-mx.ry*0.05,
            '[I(f1)-I(f2)-I(f3) = ');
  outtextmx( mx.rx*0.18, -mx.ry*1.28-mx.ry*0.05,
            +floattostr(sys.Iall)+']');
end;

{--- DrawCross :: otrisovka tochek perese4eniy ---}
procedure DrawCross;
var i:integer;
begin
 for i:=1 to CrossCount do
  begin
  if selected = i then setcolor(WHITE) else setcolor(LIGHTGRAY);
    circle(round(sys.crp[i].x*mx.sx)+mx.transx,
            round(sys.crp[i].y*mx.sy)+mx.transy, 3);
    outtextmx(-mx.rx*0.85, -mx.ry*0.98-mx.ry*0.05*i,
              '(x = '+floattostr(sys.crp[i].x)+
              '   y = '+floattostr(sys.crp[i].y)+')');
  end;
end;

{--- Draw3Func :: otrisovka 3x funkciy srazu ---}
procedure Draw3Func(f1, f2, f3 : FFunc);
begin
   DrawFunc(f1, RED);  { Risuem funciu krasnim }
   DrawFunc(f2, GREEN);
   DrawFunc(f3, BLUE);
end;

{--- DrawFunc :: otrisovka odnoy funkcii ---}
procedure DrawFunc;
var
 h : real;
 limx, limy : real;
 x, fx : real;
begin
 limx := mx.rx * 0.9;     { Grany ekrana }
 limy := mx.ry * 0.85;
   h := Detalize;         { Detalizacia grafika }
    x := limx;
      setcolor(c);
 while x >= -limx do
  begin
   moveto(x, f(x));
    x := x - h;
    fx := f(x);
      {esli grafik vilez za oblast otrisovki - ne risuem ego}
      if abs(fx) < limy then
       lineto(x, f(x));
  end;
end;

{--- DrawAxes :: osi koordinat, zasechki i nadpis '1.0' ---}
procedure DrawAxes;
begin
 with mx do
 begin
   { ramka }
  setcolor(DARKGRAY);
   line(-rx,-ry,rx,-ry);
   line(rx,-ry,rx,ry*0.93);
   line(rx,ry*0.93,-rx,ry*0.93);
   line(-rx,ry*0.93,-rx,-ry);

   { osi i strelochki }
  setcolor(WHITE);
   line(-rx*0.9, 0.0, rx*0.9, 0);    { X }
   line(rx*0.9, 0, rx*0.85, ry*0.015);
   line(rx*0.9, 0, rx*0.85, -ry*0.015);

   line(0.0, -ry*0.9, 0.0, ry*0.9);  { Y }
   line(0.0, ry*0.9, rx*0.015, ry*0.85);
   line(0.0, ry*0.9, -rx*0.015, ry*0.85);

   { zasechki }
   line(1, -0.01*ry, 1, 0.01*ry);   { X }
   line(-rx*0.01, 1, rx*0.01, 1);   { Y }

  setcolor(DARKGRAY);
    outtextmx(1-mx.rx*0.036, -0.02*ry, '1.0');
    outtextmx(rx*0.02, 1+mx.ry*0.019, '1.0');
 end;
end;

{--- Vspomogatelnie funkcii :: Otrisovka s perenosom i mashtabom ---}

procedure outtextmx(x, y:real; s:string);
begin
  outtextxy(round(x*mx.sx)+mx.transx, round(y*mx.sy)+mx.transy, s);
end;

procedure line(x, y, xx, yy : real);
begin
  graph.line(round(x*mx.sx)+mx.transx, round(y*mx.sy)+mx.transy,
              round(xx*mx.sx)+mx.transx,round(yy*mx.sy)+mx.transy);
end;

procedure lineto(x, y : real);
begin
  graph.lineto(round(x*mx.sx)+mx.transx, round(y*mx.sy)+mx.transy);
end;

procedure moveto(x, y : real);
begin
  graph.moveto(round(x*mx.sx)+mx.transx, round(y*mx.sy)+mx.transy);
end;
{=== ======================================== ===}


{--- Inicilizacia drivera grafiki ---}
function InitGr : boolean;
var
  grDriver : Integer;
  grMode : Integer;
  ErrCode : Integer;
begin
 grDriver := Detect;
 InitGraph(grDriver, grMode, '');
 ErrCode:=GraphResult;
 InitGr := true;
 If not (ErrCode = grOk) Then
  begin
   writeLn('Graph error init: ', GraphErrorMsg(ErrCode));
   InitGr := false;
  end;

end;


{--- Inicilizacia matrici grafiki ---}
 procedure InitMatrix(xr, yt : real; cx, cy : integer);
 begin
  with mx do
  begin
   {Za praviy ugol ekrana prinimaem xr}
   {Za niz - yt}
   sx := getmaxx / 2.0 * xr;
   sy := - getmaxy / 2.0 * yt;
   {Centr koordinat raspolojen v cx, cy}
   transx := cx;
   transy := cy;

   rx := 0.85/xr;
   ry := 0.85/yt;
  end;
 end;

{--- Obwaya Inicilizacia ---}
function Init : boolean;
begin
  Scale := ScaleSize;
  init := InitGr;       {inicilizacia grafiki}
  InitMatrix(Scale, Scale, getmaxx div 2, getmaxy div 2 - getmaxy div 10);
end;

{--- Perevod iz real v string ---}
 function floattostr(x:real):string;
 var s:string;
 begin
  str(x, s);
  floattostr:=s;
 end;

{--- Perevod iz integer v string ---}
 function inttostr(x:integer) : string;
 var s:string;
 begin
  str(x, s);
  inttostr:=s;
 end;

end.