old/PAS/Plotting/VIDEO.BAK

Uses CRT,GRAPH,Strcalc;
Const
  Eps = 0.001;
  Del = 5000;
  LeftGr = -50;
  RightGr = 50;

Var
 Fn:string;

Procedure InitG;
Var
  grDriver: Integer;
  grMode: Integer;
  i : integer;
Begin
  grDriver := Detect;
  InitGraph(grDriver, grMode,'');
{  SetWriteMode(XORPut);}
  SetFillStyle(XHatchFill,Green);
  Bar(0,0,GetMaxX,GetMaxY);
  SetFillStyle(SolidFill,Black);
  Bar(100,50,540,450);
  SetColor(Red);
  Line(100,250,540,250);
End;{InitG}
{--------------------------------}
Function Func(x: real): real;
Var
 ret: real;
Begin
  ret := StrFunc(fn,x/10);
  Func := ret;
End;
{-----------------------------}
Procedure WriteGraph(l,r,Color:Integer);
Var
  x,y,Razm : Integer;
Begin
  Razm := r-l;
  SetColor(Color);
  MoveTo(100,250-Round(Func(l)*200));
  for x := L to R do
    begin
      y := round(Func(x)*200);
      LineTo(round(100+(x-l)*((440)/razm)),250-y);
    end;
End;{WriteGraph}
{---------------------------------}
Procedure ShowWaterLine(x:integer);
Var
  temp : integer;
  x1 : integer;
Begin
    temp := GetColor;
    SetColor(Yellow);
    x1 := round(440*((x-LeftGr)/(RightGr-LeftGr))+100);
    Line(x1,50,x1,450);
    SetColor(temp)
End;{ShowWaterLine}
{---------------------------------}
Procedure Calculate;
Var
R,L : real;
Begin
  R := RightGr;
  L := LeftGr;
  WriteGraph(round(L),round(R),Blue);
  repeat
      ShowWaterLine(round((L+R)/2));
      Delay(Del);
      if func((L+R)/2)>0 then L := ((L+R)/2)
      else R := ((L+R)/2);
  until abs(func((L+R)/2)) < Eps;
End;
{------------------}
Begin
  Write('Enter function: ');
  ReadLn(fn);
  InitG;
  Calculate;
  CloseGraph;
End.