//{$O+,F+,R-,Q-,S+,I+,N+,D-,L-,X+,B-,P+}
Unit grafiti1;

INTERFACE
USES graphics,fft,
SysUtils,dialogs,common,friend,grafiti0;
const maxColors=15;
type PaletteType=record size:byte; colors:array[0..maxColors] of shortInt end;
 const
 barwy0:PaletteType=                                {kolory mapy}
  (size:15; colors:(1, 9, 3, 11, 2, 10, 14, 13, 5, 12, 4, 6, 15, 7, 8, 0));

 barwy1:PaletteType=                                {kolory LCD monochr}
  (size:15; colors:(0, 1, 4, 5, 2, 8, 6, 9, 3, 12, 13, 7, 10, 11, 14, 15));
 barwy1_1:PaletteType=
  (size:15; colors:(15, 14, 11, 10, 7, 13, 12, 3, 9, 6, 8, 2, 5, 4, 1, 0));

 barwy2:PaletteType=                                {kolory drukarki Manesm}
  (size:15; colors:(0, 14, 11, 13, 10, 12, 3, 6, 9, 2, 8, 5, 4, 1, 7, 15));

 var
 barwy:PaletteType;
 config_show : boolean;
procedure screenToDisk(x1,y1,x2,y2:word; patternPath:pathStr);
procedure informator(cynk:PathStr;x,y,z,s:word);
procedure MoveWindow(zxpmin,zxpmax,zypmin,zypmax,dX,dY:integer;
                     squash:boolean);
function Word_From_Heap(var tref:trefTyp; nr_obs:longWord;
                        grubosc,lba_danych:longWord;var err_code:integer):smallInt;//word; czytanie z wav
procedure Heap_line_plot_V(var tref:trefTyp;pocz,lba_danych:longint;
                           grubosc:word;numDat:word;var err_code:integer);
procedure Heap_line_plot_H(var tref:trefTyp;pocz,lba_danych:longint;
                           grubosc:word;numDat:word;var err_code:integer);
procedure line_plot_V(var dataSet:array of double;numDat:word);
procedure line_plot_H(var dataSet:array of double; px:word;cursPoz:longint;
                      kx:word;color1,color2:byte;doubleSide,hiPas:boolean);
procedure tecza(var barwy:PaletteType);
procedure Barwa(MeanVal,min:real;lba_kolor:byte;var delta:realtype;level:real;
                var b:integer;skala:real; poz:byte;var rise:boolean);
procedure pix_plot_h_v(var fft_results:array of double;numdat:word;Yax:real;
       min,max:real;var delta:realtype;lba_kolor:byte;poz:byte;horiz:boolean);
PROCEDURE dr_lab_y_ax_rev(lab_rev,turn:boolean);
PROCEDURE dr_lab_x_ax_top(time_interval:real;gora,turn:boolean);
function descr(podkresl:boolean; napis:shortString):shortString;
procedure win_x_y_title(var title:shortstring; win_x_y:char;shft,puh:real;
                        barcol:byte;whole:boolean);
PROCEDURE line_plot_data_turn(VAR dataset: rAryType;
                         numdat:  integer);
procedure int_graph_param(var x:longint;var GoToX:boolean;xp,yp:word;
                          cynk1:string);

IMPLEMENTATION
 type wrdary = array[0..127] of word;

  var ScrFile : file of wrdAry;
	mpAry : wrdAry;
	extchar : char;

  procedure screenToDisk(x1,y1,x2,y2:word; patternPath:pathStr);
   var i,j,l:word;
   drName:DirStr;
   procedure swap(var a,b:word);
    var c:word;
    begin
     if a>b then begin c:=a; a:=b;b:=c end;
    end;{swap}
   begin
    repeat inc(extChar); until not FileExists(patternPath+'.gr'+extChar);
    assignFile(ScrFile,patternPath+'.gr'+extChar);
    RewRite(ScrFile);
    {-------------------------------------------------parametry grafiki}
    swap(x1,x2); swap(y1,y2);
    mpAry[0]:=x1; mpAry[1]:=y1; mpAry[2]:=x2; mpAry[3]:=y2;
//    mpAry[4]:=GetGraphMode;
    i:=5;
//    drName:=GetDriverName+'????????';
    while i-4<length(drName)+2 do
     begin
      mpAry[i]:=10*byte(drName[i])+byte(drName[i+1]);
      inc(i,2);
     end;
     write(ScrFile,mpAry);
     l:=0;
     for j:=y1 to y2 do
      for i:=x1 to x2 do
       begin
//        mpAry[l]:=GetPixel(i,j);
        inc(l);
        if l=127 then
         begin
          l:=0;
          write(ScrFile,mpAry);
         end;
       end;
     write(ScrFile,mpAry);
    Close(ScrFile);
   end;{screenToDisk}

procedure informator(cynk:PathStr;x,y,z,s:word);
 var i,j,k:byte;
 begin
 showMessagePos(cynk,x,y);
//  sound(s);
//  k:=getColor;
  if x<4 then x:=4;
  if y<8 then y:=8;
  j:=length(cynk);
//  setColor(black);
//  for i:=0 to j-1 do outTextXY(x+4+8*i,y-4,#219);
//  for i:=0 to j-1 do outTextXY(x+4+8*i,y+4,#219);
//  setFillStyle(SolidFill,black);
//  bar(x-4,y-8,x+(j+2)*8+4,y+14);
//  setColor(white);
//  outTextXY(x+4,y,cynk);
//  rectangle(x-2,y-6,x+(length(cynk)+2)*8+2,y+12);
//  setColor(k);
//  delay(z);
//  nosound;
 end;{informator}

function Jump(u,du,w:integer;tb,xy,squash:boolean):integer;
 var v:integer;
 begin
  v:=u+du;  jump:=MaxInt;
  if v<0 then v:=0;
 // case xy of   {wspolrzedna x: true, y: false}
//   false : if v > getMaxY then v:=GetMaxY;    {sciskac okno na granicach ekr}
//   true  : if v > GetMaxX then v:=GetMaxX;
  //end;{case xy}
  case tb of  {granica dolna ramki: false, gorna: true}
   false: if ((w-v)<0) or not squash then jump:=v else jump:=w;
   true : if ((w-v)>0) or not squash then jump:=v else jump:=w
  end;{case tb}
 end;{jump}

procedure MoveWindow(zxpmin,zxpmax,zypmin,zypmax,dX,dY:integer;
                     squash:boolean);
 {
 Zmienna logiczna squash decyduje o tym, czy sciskac okno na
 granicach innego zewnetrznego wzgledem danego okna.
 Okno bedzie jednak podlegac kompresji na granicach ekranu niezaleznie od
 wartosci squash
 zxp.. i zyp.. to ramka wewnetrzna okna zewnetrznego
 }

 begin
  with grstat do
   begin

    winxmin:=jump(winxmin,dX,winxmin,false, true,false);
      xpmin:=jump(  xpmin,dX, zxpmin,false, true,squash);
    winxmax:=jump(winxmax,dX,winxmax,true,  true,false);
      xpmax:=jump(  xpmax,dX, zxpmax,true,  true,squash);

    winymin:=jump(winymin,dY,winymin,false,false,false);
      ypmin:=jump(  ypmin,dY, zypmin,false,false,squash);
    winymax:=jump(winymax,dY,winymax,true, false,false);
      ypmax:=jump(  ypmax,dY, zypmax,true, false,squash);

   end;{with}
 end;{MoveWindow}

function Word_From_Heap(var tref:trefTyp; nr_obs:longWord;
                        grubosc,lba_danych:longWord;var err_code:integer):smallInt;//word; czytanie z wav
 var
  nr_placka, nr_w_placku: word;
{
UWAGA. Zaklada sie, ze obserwacje liczone sa od 0;
         "      "   "  grubosc okresla naturalna liczbe danych na 1 warstwie
                       stery.
}

 begin
  if nr_obs<=lba_danych then
   begin
    err_code:=0;
    nr_placka:=nr_obs div grubosc;
    nr_w_placku:=nr_obs mod grubosc;
    Word_from_Heap:=tref[nr_placka]^[nr_w_placku]
   end{if}
  else
   begin
    err_code:=1;
    Word_From_Heap:=0;
   end;{else}
 end;{Word_From_Heap}

procedure Heap_line_plot_V(var tref:trefTyp;pocz,lba_danych:longint;
                           grubosc:word;numDat:word;var err_code:integer);

 var
  ypSize,y1,y2,i,j,k,index1,index2,x1,x2 : longint;
                              dy,MeanVal : real;
 begin
  with grStat do
  begin
//   SetViewPort(xpmin,ypmin,xpmax,ypmax,true);
   ypsize:=ypmax-ypmin; if ypSize=0 then exit;
//   if ypMin>getMaxY then
  //  begin
    // ypMin:=GetMaxY; yPmax:=yPmin+yPsize;
    // yWmin:=yPmin; yWmax:=yPmax;
    //end;
//   if ypmin+ypsize > GetMaxY then ypSize:=GetMaxY-ypmin;
   if ypSize>1 then dy:=0.9*numDat/(ypsize-1) else  dy:=numDat/ypsize;
   if dy>0.9 then dy:=0.9;if dy<1e-6 then dy:=1e-6;
   dy:=(numDat+dy)/ypSize;
   index1:=0; j:=index1; y1:=0;
   x1:=round((Word_From_Heap(tref,pocz,grubosc,lba_danych,err_code)-
       xwmin)*sfx);
//   setcolor(grcolor);
   for i:=1 to ypSize+1 do
   begin
    index2:=trunc(i*dy);
    if (j<=index2) and (index2>0) then
    begin
     MeanVal:=0; k:=0;                           {usrednianie w miedzyczasie}
     Repeat
      k:=k+1;
      if index2=1 then j:=j+1;
    MeanVal:=MeanVal+Word_From_Heap(tref,pocz+j,grubosc,lba_danych,err_code);
      if index2>1 then j:=j+1
     until j>=index2;
     MeanVal:=MeanVal/k;
     x2:=round((MeanVal-xwmin)*sfx); y2:=i;
//     line(x1,y1,x2,y2);
     index1:=index2+1;
     j:=index1;
     x1:=x2; y1:=y2;
    end;{if}
   end;{for}
  end;{with}
//  SetViewPort(0,0,GetX,GetY,true);
 end;{Heap_line_plot_V}


procedure Heap_line_plot_H(var tref:trefTyp;pocz,lba_danych:longint;
                           grubosc:word;numDat:word;var err_code:integer);

 var  xpSize,x1,x2,y1,y2 : longint;
     i,j,k,index1,index2 : longint;
              dx,MeanVal : real;
 begin
  with grStat do
  begin
//   SetViewPort(xpmin,ypmin,xpmax,ypmax,true);
   xpsize:=xpmax-xpmin; if XpSize=0 then exit;
//   if xpMin>getMaxX then
  //  begin
    // xpMin:=GetMaxX; xPmax:=xPmin+xPsize;
     //xWmin:=xPmin; xWmax:=xPmax;
    //end;
//   if xpmin+xpsize > GetMaxX then xpSize:=GetMaxX-xpmin;
   if xpSize>1 then dx:=0.9*numDat/(xpsize-1) else  dx:=numDat/xpsize;
   if dx>0.9 then dx:=0.9;if dx<1e-6 then dx:=1e-6;
   dx:=(numDat+dx)/xpSize;
   index1:=0;  j:=index1; x1:=0;
   meanVal:=(ywmax-Word_From_Heap(tref,pocz,grubosc,lba_danych,err_code))*sfy;
   if meanVal<0 then MeanVal:=0;
   y1:=round(meanVal);
//   setcolor(grcolor);
   for i:=1 to xpSize+1 do
   begin
    index2:=trunc(i*dx);
    if (j<=index2) and (index2>0) then
    begin
     MeanVal:=0; k:=0;                          {usrednianie w miedzyczasie}
     Repeat
      k:=k+1;
      if index2=1 then j:=j+1;
    MeanVal:=MeanVal+Word_From_Heap(tref,pocz+j,grubosc,lba_danych,err_code);
      if index2>1 then j:=j+1
     until j>=index2;
     MeanVal:=MeanVal/k;
     y2:=round((ywmax-MeanVal)*sfy); x2:=i;
//     line(x1,y1,x2,y2);
     index1:=index2+1;
     j:=index1;
     x1:=x2; y1:=y2;
    end;{if}
   end;{for}
  end;{with}
//  SetViewPort(0,0,GetX,GetY,true);
 end;{Heap_line_plot_H}


procedure line_plot_V(var dataSet:array of double;numDat:word);
{
tp - indeks w tablicy danych dataSet, od ktorego nalezy zaczac wykres
}
 var  ypSize,x1,x2,y1,y2 : word;
     i,j,k,index1,index2 : longint;
              dy,MeanVal : real;
 begin
  with grStat do
  begin
//   SetViewPort(xpmin,ypmin,xpmax,ypmax,true);
   ypsize:=ypmax-ypmin; if ypSize=0 then exit;
//   if ypMin>getMaxY then
    begin
//     ypMin:=GetMaxY; yPmax:=yPmin+yPsize;
     yWmin:=yPmin; yWmax:=yPmax;
    end;
//   if ypmin+ypsize > GetMaxY then ypSize:=GetMaxY-ypmin;
   if ypSize>1 then dy:=0.9*numDat/(ypsize-1) else  dy:=numDat/ypsize;
   if dy>0.9 then dy:=0.9;if dy<1e-6 then dy:=1e-6;
   dy:=(numDat+dy)/ypSize;
   index1:=0; j:=index1; y1:=0;
   x1:=round((DataSet[0]-xwmin)*sfx);
//   setcolor(grcolor);
   for i:=1 to ypSize do
   begin
    index2:=trunc(i*dy);
    if (j<=index2) and (index2>0) then
    begin
     MeanVal:=0; k:=0;                           {usrednianie w miedzyczasie}
     Repeat
      k:=k+1;
      if index2=1 then j:=j+1;
      MeanVal:=MeanVal+DataSet[j];
      if index2>1 then j:=j+1
     until (j>=index2);
     MeanVal:=MeanVal/k;
     if meanVal<xwMin then meanVal:=xwMin;
     x2:=round((MeanVal-xwmin)*sfx); y2:=i;
//     line(x1,y1,x2,y2);
     index1:=index2+1;
     j:=index1;
     x1:=x2; y1:=y2;
    end;{if}
   end;{for}
  end;{with}
//  SetViewPort(0,0,GetX,GetY,true);
 end;{line_plot_V}


procedure line_plot_H(var dataSet:array of double; px:word;cursPoz:longint;kx:word;
 color1,color2:byte;doubleSide,hiPas:boolean);
 var    xpSize,x1,x2,ch_color : word;
      y1,y2,j,k,index1,index2 : longint;
          rzmp,dx,dx1,MeanVal : real;
                          lpm : PathStr;

 procedure plotting(start,finish:longint;color:byte);
 {
 start i finish oznaczaja punkty poczatkowy i koncowy obrazka!
 }
 var i:longint;
 begin
//  setColor(color);
  if finish>xpSize then finish:=xpSize;
  with grstat do
  for i:=start to finish do
   begin
    index2:=round(i*dx)+px;
    if (j<=index2) and (index2>0) then
    begin
     MeanVal:=0; k:=0;                           {usrednianie w miedzyczasie}
     Repeat
      inc(k);
      MeanVal:=MeanVal+DataSet[j];
      inc(j);
     until j>=index2;
     MeanVal:=MeanVal/k;
     y2:=round((ywmax-MeanVal)*sfy);
      if (y2<0) or (y2>yPmax) then 
//       begin
//        if y2<0 then begin sound(800); y2:=0 end
  //      else  begin sound(50); y2:=ypmax end;
    //    delay(5);nosound;
      // end;{if}
     x2:=round(i+dx1*(kx-index2));  {z poprawka polozenia punktow wykresu}
//     line(x1,y1,x2,y2);
     index1:=index2+1;
     j:=index1;
     x1:=x2; y1:=y2;
    end;{if}
   end;{for}
 end;{ploting}

 begin
  with grStat do
  begin
   {--------------------------------------stale parametry grafiki ! }
   xpsize:=xpmax-xpmin;
   if XpSize<=1 then exit;
//   if xpSize>GetMaxX then
  //  begin xpSize:=GetMaxX; xpMin:=0; xpMax:=xpSize end;
   dx:=(kx-px-0.49)/xpSize;
   dx1:=xpSize/(2*sqr(kx));    {poprawka rozmieszczenia punktow wykresu}
//   SetViewPort(xpmin,ypmin,xpmax,ypmax,true);
   ch_color:=round((cursPoz+1-px)*(xpSize/(kx-px))-(kx-cursPoz)*dx1);
   index1:=px;
   j:=index1+1; x1:=0; x2:=0;
   rzmp:=ywmax-DataSet[index1]; {pominac pierwsza wartosc jesli jest za duza}
   if rzmp<0 then rzmp:=0;       {przyciac ja na wykresie do ymax}
   y1:=round(rzmp*sfy);
   plotting(1,ch_color,color1);
   if doubleSide then
    begin
     k:=ch_color;
     ch_color:=round((cursPoz-1)*xpSize/(kx-px+1));
     plotting(k+1,xpSize-ch_color,color2);
     plotting(xpSize-ch_color+1,xpSize,color1)
    end
   else
    plotting(ch_color+1,xpSize,color2);
  end;{with}
//  SetViewPort(0,0,GetX,GetY,true);
 end;{line_plot_H}

procedure tecza(var barwy:PaletteType);
 begin
 with barwy do
   begin
    colors[ 0]:=1;  //blue;
    colors[ 1]:=9;  //lightblue;
    colors[ 2]:=3;  //cyan;
    colors[ 3]:=11; //lightcyan;
    colors[ 4]:=2;  //green;
    colors[ 5]:=10; //lightgreen;
    colors[ 6]:=14; //yellow;
    colors[ 7]:=13; //lightmagenta;
    colors[ 8]:=5;  //magenta;
    colors[ 9]:=12; //lightred;
    colors[10]:=4;  //red;
    colors[11]:=6;  //brown;
    colors[12]:=15; //white;
    colors[13]:=7;  //lightgray;
    colors[14]:=8;  //darkgray;
    colors[15]:=0;  //black;
   end;{with}
 end;{tecza}

procedure Barwa(MeanVal,min:real;lba_kolor:byte;var delta:realtype;level:real;
                var b:integer;skala:real;poz:byte;var rise:boolean);
{
procedura okresla numer barwy [b] koloru pixela - numer z wykazu Tecza
poz: 3 - to kolorowe spektrum + poziomice,  1 - tylko poziomice, 2 - tylko ko-
     lorowe spektrum.
}
var b1:integer;
 begin
  b:=round((MeanVal-min)/delta); b1:=b;
  if b<0 then b:=0;
  if b>lba_kolor then b:=lba_kolor;
  if (poz=1) or (poz=3) then                                      {poziomice}
   begin
    if poz=1 then b:=15;    {czarny, tylko poziomice bez kolorowego spektrum}
    if (abs(meanVal-min-level)>=delta) or (meanval-min<level) and rise or
       (meanVal-min>=level) and not rise
    then b:=12;                                {bialy - zaznaczyc poziomice }
    if MeanVal-min < level then rise:=false else rise:=true;
    level:=b1*delta;
   end;{if poz}
 end;{barwa}

procedure pix_plot_h_v(var fft_results:array of double;numdat:word;Yax:real;
       min,max:real;var delta:realtype;lba_kolor:byte;poz:byte;horiz:boolean);
 {
 procedura kresli amplitude w postaci barwnych prazkow, przy czym automa-
 tycznie wlaczane jest usrednianie jesli lba punktow danych przekracza
 lbe punktow obrazu.
 min i max wyznaczaja zadany a priori mapowany zakres zmiennosci.
 }
 var
 sk_x_y,level,min_max,MeanVal,skala : real;
         size,x,i,j,k,index1,index2 : word;
                                  b : integer;
                               rise : boolean;

begin
 min_max:=max-min;   lba_kolor:=lba_kolor-1;
 with grstat do
 begin
//  SetViewPort(xpmin,ypmin,xpmax,ypmax,true);
  delta:=min_max/lba_kolor;    {kazda zmiana koloru bedzie rozpoczynac}
                               {sie bialym punktem}
                               {.sfx, .sfy = x|y(pmax-pmin)/x|y(wmax-wmin)}
                               {stosunek wymiaru obrazka do zakresu liczb.}
  if horiz then begin size:=xpmax-xpmin; yax:=round(yax*sfy) end
  else          begin size:=ypmax-ypmin; yax:=round(yax*sfx) end;
  sk_x_y:=numdat/size;
  level:=round((fft_results[0]-min)/delta)*delta;  {ustalenie najblizszej nizszej }
                                             {poziomicy (dla skladnika [0]) }
  if fft_results[0]-min < level then rise:=false else rise:=true;
  index1:=0;
  for i:=0 to size do         {polozyc pixele; xpsize - lba pktow na osi X}
   begin
    j:=index1;
    index2:=round(i*sk_x_y);
    if j>index2 then j:=index2;
    meanval:=0; k:=0;        { usrednianie miedzamplitudowe - polozyc punkt }
    repeat                   {o barwie odpow. sredniej amplitudzie w odcinku}
     meanVal:=meanVal+fft_results[j];
     j:=j+1; k:=k+1;         {  pomiedzy dwoma kolejnymi punktami na obrazie}
    until j>index2;          {usrednianie to dziala wtedy, gdy XpSize<numdat}
    meanVal:=MeanVal/k;
    index1:=index2+1;
    Barwa(MeanVal,min,lba_kolor,delta,level,b,skala,poz,rise);
//    if horiz then PutPixel(i+1,round(yax),barwy.colors[b])
//    else PutPixel(round(yax),size-i,barwy.colors[b]);
   end;{for}
  end;{with}
end;{pix_plot_horiz}

 const ptsn=6;
  type ptst=array[1..ptsn] of real;
  const pts:ptst=(1, 2, 3, 5, 8, 10);

 function rgp(dlt:real;pts:ptst; var numTic:integer; min,max:real):real;

  var zmp:real;

  function rgp1(i:byte):real;
   var k:byte;
   begin
    if (dlt-pts[i]<pts[i+1]-dlt) then zmp:=pts[i]
    else
     if i<ptsn-1 then zmp:=rgp1(i+1)
     else
      begin
       i:=1;
       for k:=1 to ptsn do pts[k]:=pts[k]*10;
       zmp:=rgp1(i);
      end;
      rgp1:=zmp;
   end;{rgp1}

  function rgp0(i:byte):real;
   var zmp:real;
         k:byte;
   begin
    if (dlt-pts[i-1]>pts[i]-dlt) then zmp:=pts[i]
    else
     if i>2 then zmp:=rgp0(i-1)
     else
      begin
       i:=ptsn;
       for k:=ptsn downto 1 do pts[k]:=pts[k]/10;
       zmp:=rgp0(i);
      end;
      rgp0:=zmp;
   end;{rgp1}

  begin
   zmp:=1;
   if dlt>0 then
   if dlt>=1 then zmp:=rgp1(1)
   else zmp:=rgp0(ptsn);
   rgp:=zmp;
   numTic:=round((max-min)/zmp);
   if numTic<1 then numTic:=1;
  end;{rgp}

procedure scale_pull(rev:boolean; var from,numTic:integer; min,max,pmin,pmax,dlt:real;
               var dp,minMax,min1,max1:real;n1:byte);
 var sc:real;
 label 1;
 begin
  if abs(max-min)<=abs(pmax-pmin)*1e-20 then
   begin
    numTic:=1; dp:=1; minMax:=min;
    min1:=min; max1:=max; from:=numtic;
    exit
   end;
  sc:=(pmax-pmin)/(max-min);
  min1:=n1*dlt*round(min/(n1*dlt));
  from:=round((min-min1)/dlt);
  max1:=min1+dlt*numTic;
  dp:=dlt*sc;
  if rev then minMax:=pmin-(min-min1)*sc
  else minMax:=pmax+(min-min1)*sc;
  numTic:=trunc((pmax-pmin)/dp)+from;
 end;{scale_pull}

PROCEDURE dr_lab_y_ax_rev(lab_rev,turn:boolean);

VAR
            from,numTic,rowloc,colloc,i : integer;
 labval,sigdig,dyp,dYw,minMax,min1,max1 : real;
                              labvalstr : string;

BEGIN
  WITH grstat DO
  BEGIN
    if grinit <> 999 then win_map_init;
//    SetViewPort(0,0,GetMaxX,GetMaxY,true);
//    SetColor(grColor);
    dYw:=(ywmax-ywmin)/numTicY;
    dYw:=rgp(dYw,pts,numTic,ywmin,ywmax);
//    line(xpmin,ypmin,xpmin,ypmax);
    scale_pull(lab_rev,from,numTic,ywmin,ywmax,ypmin,ypmax,dYw,dYp,minMax,
     min1,max1,5);
    sigdig:=dYw/5;
    FOR i:=from TO numtic DO
    BEGIN
     case lab_rev of
       true : rowloc:=round(MinMax+i*dYp);
      false : rowloc:=round(MinMax-i*dYp);
     end;{case}
     if i mod 5=0 then
      begin
//       line(xpmin+3,rowLoc,xpmin-5,rowLoc);                {dlugi tik}
       labval:=min1+(i*dYw);
       convert_num(labval,sigdig,labvalstr);
       if turn then colloc := round((xpmax+1)/8+length(labvalstr)+0.5)
       else         colloc := round((xpmin -1)/8 -length(labvalstr));
       case lab_rev of
         true : rowloc := round((MinMax+i*dYp+4)/8);
        false : rowloc := round((MinMax+4-i*(dYp-2.5/NumTic))/8);
       end;{case}
//       moveTo((colloc-1)*8,(rowloc-1)*8);
       uniwritestring(labvalstr,0);
      end{if}
     else //line(xpmin,rowLoc,xpmin-2,rowLoc);
    END;
  END;
END;{dr_lab_Y_ax}

PROCEDURE dr_lab_x_ax_top(time_interval:real;gora,turn:boolean);
{
time interval - to wspolczynnik skalujacy !!!
}

VAR                 from,rowloc,colloc : integer;
                i,ldigit,rdigit,numTic : integer;
labval,sigdig,dXp,dXw,minMax,min1,max1 : real;
                             labvalstr : string;

procedure cope;
 begin
  with Grstat do
   BEGIN
    IF (i MOD 5) = 0 THEN
     BEGIN
      if turn then labval:=(max1-i*dXw)
      else         labval:=(min1+i*dXw);
      convert_num(labval,sigdig,labvalstr);
      colloc:=round((minMax+4)/8+(i*dXp+4)/8);
      colloc:=colloc-round(length(labvalstr)/2);
      unigotoxy(colloc,rowloc);
      uniwritestring(labvalstr,0);
     END; {MOD condition}
   END;{with}
 end;{cope}

 procedure x_ax(y:word);
   var i,x:integer;

  procedure cope2;
   begin
    with grstat do
     begin
      x:=round(minMax+i*dXp);
      IF (i MOD 5)=0 THEN //line(x,y-2,x,y+4)
      ELSE //line(x,y-2,x,y+1);
     end;
   end;{cope2}

  begin
   with grstat do
   begin
//    line(xpmin,y,xpmax,y);
    if turn then for i:=numTic downto from do cope2
    else         for i:=from to numTic do cope2;
   end{with}
  end;{x_ax}



BEGIN
  WITH grstat DO
  BEGIN
    if grinit <> 999 then win_map_init;
//    SetViewPort(0,0,GetMaxX,GetMaxY,true);
//    SetColor(grcolor);
    dXw:=time_Interval*(xwmax - xwmin)/(numticX);
    min1:=xwmin*time_interval;
    max1:=xwmax*time_interval;
    dXw:=rgp(dXw,pts,numTic,min1,max1);
    dXp:=(xPmax-xPmin)/numTic;
    scale_pull(true,from,numTic,min1,max1,xpmin,xpmax,dXw,dXp,minMax,
     min1,max1,5);
    if gora then x_ax(ypmin)
    else x_ax(ypmax);
    sigdig := dXw;
    case gora of
     false : rowloc:=round((ypmax+4)/8+1.2);
      true : rowloc:=round((ypmin - 4)/8);
    end;{case}
    if turn then FOR i:=numtic downto from DO cope
    else         FOR i:=from TO numtic DO     cope;
  END;  {WITH grastat}
END;  {dr_lab_x_ax_top}

function pull(var title:string; var win_x_y:char):integer;
   var maxWidth, remain : integer;
 begin
  if grstat.grinit <> 999 then win_map_init;
  with grstat do
  case win_x_y of
   'y' : maxwidth := round((ypmax - ypmin)/8)
   else  maxwidth := round((xpmax - xpmin)/8)
  end;{case}
  remain := 79-maxwidth;
  delete(title,maxwidth,remain);
  pull:= round(0.1+length(title)/2);
 end;{pull}

function descr(podkresl:boolean; napis:shortString):shortString;
 var i,k,l:byte; tp:shortString;
 begin
  tp:=napis;
  if podkresl then
   begin
    i:=0; tp:='';
    repeat
     inc(i);
     if (napis[i+1]<>'^')  then tp:=tp+napis[i]+'^'
     else
      begin
       tp:=tp+napis[i];
       inc(i);
      end;
    until (i>=length(napis)-1) or (i>=255);
   end;
  descr:=tp
 end;{descr}

procedure win_x_y_title(var title:shortstring; win_x_y:char;shft,puh:real;
                        barCol:byte;whole:boolean);
{
 procedura ta laczy w sobie procedury _x_ax_, _window i title_y_ax
 parametr shft - daje dodatkowe mozliwosci przesuwania napisow wkier. prostop.,
        a  puh - w kier. rownol.
         whole - =true to wspolrzedne napisu odnosza sie do calego ekranu
                  =false, to do okna aktualnego
UWAGA! tytul moze zostac przyciety przez funkcje pull !!
}
 var rowloc, colloc, x, y,j : integer; i:byte; znak1,znak2:AnsiChar;
     title1:string;
 begin
  with grstat do
   begin
    if grinit<>999 then win_map_init;
    if whole then //SetViewPort(0,0,GetMaxX,GetMaxY,true)
    else          //SetViewPort(winXmin,winYmin,winXmax,winYmax,true);
    j:=0; title1:='';
    for i:=1 to length(title) do if title[i]<>'^' then title1:=title1+title[i];
    i:=length(title1);
    case win_x_y of
     'w': rowloc:=round(0.1+ypmin+(ypmin-8+shft));
     'x': rowloc:=round(0.1+(ypmax+20+shft));
     'y':begin
        rowloc:=round(0.1+(ypmin+(ypmax-ypmin)/2+puh))-8*pull(title1,win_x_y);
//          setTextStyle(0,1,1);
          colloc:=round(0.1+(winxmin+shft))+4;
         end;
    end;{case}
    case win_x_y of
      'x','w': begin
        colloc:=round(0.1+(xpmin+(xpmax-xpmin)/2+puh))-8*pull(title1,win_x_y);
               end
    end;{case}
    if colloc<1 then colloc:=1; if rowloc<1 then rowloc:=1;
    x:=(colloc-1); y:=(rowloc-1);
//    moveTo(x,y);                                     {*}
//    getFillSettings(flst);
//    setColor(black);SetFillStyle(1,barCol);
    case win_x_y of
     'y' : begin
//            bar(x-9,y,x,y+i*8);
            y:=y+(i-1)*8;
//            moveTo(x,y);
           end;
     else //bar(x,y,x+i*8,y+8);
    end;{case}
//    setColor(grColor); setTextJustify(LeftText,TopText);
    j:=length(title)-1; if j<0 then j:=0;
    for i:=1 to j do
     begin
      znak1:=title[i]; znak2:=title[i+1];
      if (znak1<>'^') and (znak2<>'^')then //outTextXY(x,y,title[i]);
      if (znak2='^') then
        begin
        // if barCol in [brown,red,lightRed,magenta,lightMagenta] then
//         setColor(lightgreen)
//         else
//          if barCol in [green,lightGreen] then //setColor(yellow)
//          else
//           if barCol in [blue,black] then setColor(lightRed)
//           else if barCol=yellow then setColor(brown) else SetColor(red);
//         outTextXY(x,y,title[i]);
//         SetColor(grColor);
        end;{if and or and}
      if not((znak1='^') and (znak2<>'^')) then
       if win_x_y='y' then y:=y-8 else x:=x+8
     end;{for}
//     if (title[j+1]<>'^') and (title[j+1]<>' ') then outTextXY(x,y,title[j+1]);
//    case win_x_y of 'y': SetTextStyle(0,0,1) end;{case; powrot do norm.}
   end;{with}
  title:=title1;
//  with flst do setFillStyle(pattern,color);
 end;{win_x_y_title}

PROCEDURE line_plot_data_turn(VAR dataset: rAryType;
                         numdat:  integer);

VAR i,x1,x2,y1,y2,xpsize :   integer;

BEGIN
  WITH grstat DO
  BEGIN
//    SetViewport(xpmin,ypmin,xpmax,ypmax,true);
    xpSize:=xpMax-xpMin; if XpSize=0 then exit;
//    if xpMin>getMaxX then
     begin
//      xpMin:=GetMaxX; xPmax:=xPmin+xPsize;
      xWmin:=xPmin; xWmax:=xPmax;
     end;
    x1:=xpsize-round((dataset[numDat]-xwmin) * sfx);
    y1:=0;
//    SetColor(grcolor);
    FOR i := 1 TO numdat DO
    BEGIN
      y2:= round(i*sfy);
      x2:= xpsize - round((dataset[numDat-i] - xwmin) * sfx);
//      line(x1,y1,x2,y2);
      x1:=x2;
      y1:=y2;
    END;
  END;
END;

procedure int_graph_param(var x:longint;var GoToX:boolean;xp,yp:word;
                          cynk1:string);
{
 wczytuje wartosc parametru calkowitego >0 przy trybie graficznym
}
var znak:char;  cynk,cynk2:string; action:boolean; x1:longint;

  procedure BackPlane(backColor:BYTE);
  var i,j:word;
  begin
   cynk:=''; j:=length(cynk1)+15; if j<35 then j:=35;            {dla gave up}
   for i:=1 to j do cynk:=cynk+' '; cynk2:=cynk;
  //with grstat do win_x_y_title(cynk,'x',getMaxY-Ypmax-yp-12,-xp,backColor,true);
  //with grstat do win_x_y_title(cynk2,'x',getMaxY-Ypmax-yp-3,-xp,backColor,true);
  end;{backPlane}

 begin    //----------------------------------int_graph_param-------------------
  goToX:=false; action:=false; x1:=x;
  REPEAT
//   backPlane(lightRed);
//   grColor:=white;
   cynk2:=cynk1;
//   with grstat do win_x_y_title(cynk1,'x',getMaxY-Ypmax-yp-8,-xp-60,blue,true);
//   znak:=ReadKey;  cynk1:=cynk2;
   if znak<>#27 then
   begin
    x:=0; //puc;    moveTo(GetX+length(cynk1)*8+2,GetY); action:=true;
    repeat
     if znak in ['0'..'9'] then
      begin
       x:= 10*x+byte(znak)-48;
//       outText(znak);
      end;
//      znak:=ReadKey;
    until znak in [#13,#27];
    if (znak =#13) or action then
     begin
//      puc;     setColor(lightCyan);
//      outText(' OK? - y/n');
//      znak:=ReadKey;
     end;{#13}
   end;{znak<>#27 (esc)}
 UNTIL znak in ['y',#27];
  if (znak = 'y') then
   begin
//    backPlane(blue);
    str(x,cynk);
    cynk:=cynk1+cynk; //grColor:=white;
//    with grstat do win_x_y_title(cynk,'x',getMaxY-Ypmax-yp-8,-xp,red,true);
   end{if #13}
  else
   begin
    x:=x1; //backPlane(lightcyan); grColor:=yellow;
    cynk:='YOU GAVE UP; NO ACTION WAS TAKEN!';
//    with grstat do win_x_y_title(cynk,'x',getMaxY-Ypmax-yp-8,-xp,blue,true);
   end;{else}
 end;{int_graph_param}

Initialization
 barwy:=barwy0;     {barwy ekranu kolorowego, VGA}
 extchar :=#64;     {numer obrazu w rozszerzeniu zbioru}
end.
