//{$O+,F+,R-,D-,L-,S-,I-}
unit grafiti3;
Interface
 uses //dos,crt,graph,
 edith,common,grafiti0,grafiti1,friend;
 var filtrFreqChange : boolean;
            InsPunct : integer;
procedure Interpol(var old_obs,xr:array of double;pix1,pix2:real;cp:word;lba_probek_na_osc:word;
                   minlev,maxlev,delta:realType;poz:byte;sfxy:real);
procedure pause_curs(var krok:boolean;nrKom:byte;rate:realType;count:word;
 var modyfPrmtr:realType;var insPunct:integer;interval:real;
 var virt_vect:array of double;leftBound,rightBound:longint;var cursPoz,idx:integer;
 var mark,unmark:pointer;lock:boolean;var sing,ins,Change_Insert,
 art_nat:boolean;patternPath:pathStr);

implementation

procedure Interpol(var old_obs,xr:array of double;pix1,pix2:real;cp:word;lba_probek_na_osc:word;
                   minlev,maxlev,delta:realType;poz:byte;sfxy:real);
{
Wypelnia odstep pomiedzy prazkami
Znajduje wektor o skladowyc bedacych wynikiem interpolacji
pomiedzy skladowymi wektora old_obs a xr
Wynik intrerpolacji umieszca w wektorze old_obs
pix1,pix2 - pozycje wektorow old_obs i xr w wymiarze czasu
}
 var i,j,k,k1,l:byte; pixX,r,dpix:real;
 begin
  if pix1>pix2 then pix2:=pix1;
    dpix:=pix2-pix1;            {zachowac info o prawdziwej odleglosci}
    if pix2>lba_probek_na_osc then pix2:=lba_probek_na_osc;
    k:=round(dpix*sfxy+0.5);
    if pix1<0 then k1:=round((dpix-pix2)*sfxy) else k1:=0;
     if k>1 then
      begin
       sfxy:=(pix2-pix1)/k;
       for i:=k1+1 to k-1 do
        begin
         l:=k-i+1;
         r:=(k-i)/l;
         for j:=0 to cp-1 do old_obs[j]:=r*old_obs[j]+xr[j]/l;
         pixX:=pix1+i*sfxy;
         pix_plot_h_v(old_obs,cp-1,pixX,minlev,maxlev,delta,12,poz,true);
        end;{for i}
       end;{if}
 end;{interpol}


 procedure pause_curs(var krok:boolean;nrKom:byte; rate:realType;count:word;
  var modyfPrmtr:realType;var insPunct:integer;interval:real;
  var virt_vect:array of double;leftBound,rightBound:longint;var cursPoz,idx:integer;
  var mark,unmark:pointer;lock:boolean;var sing,ins,Change_Insert,
  art_nat:boolean;patternPath:pathStr);
 {
   Wstrzymuje bieg programu glownego az do nacisniecia dowolnego klawisza za
 wyjatkiem klawiszy kursora, Home i End
   Klawiszami kursora uruchamiamy ruch kursora na tle malego oscylogramu, co
 pociaga za soba takze modyfikacje granicznej czestotliwosci filtrowania, ale
 tylko jesli program nie zostal zamkniety
       ins - uruchomic tryb wstawiania   F0 jesli nie Lock
       del - zapamietac wybrany przebieg F0   -    -    -
 leftBound - nr pierwszej probki malego oscylogramu
rightBound - nr ostatniej probki jw.
   cursPoz - poczatkowa pozycja kursora: index w tablicy danych
       idx - pozycja w spektrum jesli cursPoz jest pozycja w cepstrum
             albo pozycja w cepstrum w przeciwnym razie
 }
 var xCurs,xCurs1 : longint;
     cynk,lancuch : shortstring;
       znak1,znak : char;
              i,j : integer;
              bug : boolean;
               tl : byte;

 procedure backBar(push,pull:integer;farbe:byte);
 {
 kresli tlo dla komunikatow
 }
  var i,j:integer;
  begin
   cynk:='';
   bug:=false;
   j:=length(lancuch)+6; if j>255 then j:=255;
   for i:=1 to j do if lancuch[i]<>#94 then cynk:=cynk+' ' else bug:=true;
//   i:=GetMaxX div 8;
//   if i<length(cynk) then cynk[0]:=char(i);
   win_x_y_title(cynk,'x',push+4,pull,farbe,true);
   cynk:='';
   for i:=1 to j do if lancuch[i]<>#94 then cynk:=cynk+' ' else bug:=true;
//   i:=GetMaxX div 8;
//   if i<length(cynk) then cynk[0]:=char(i);
   win_x_y_title(cynk,'x',push+12,pull,farbe,true);
  end;{backBar}

 procedure config;
  begin
   lancuch:='TRYB KROKOWY; '#27#94#24#94#25#94#26#94+
           ', H^O^M^E^,'+' E^N^D^ ruchy kursora;'+descr(sing,' sin^gle')+
           descr(ins,' ins,')+descr(Change_Insert,'del ')+'F0; k^ - wyjsc';
//   backBar(-grstat.ypmax-24,-48,brown);
//   grColor:=black;
   win_x_y_title(lancuch,'x',-grstat.ypmax-16,-32,7,true);//lightGray=7
   tl:=length(lancuch);
  end;{config}

 BEGIN
  config;
  repeat
//   repeat bug:=KeyPressed until bug;
   While true do//KeyPressed
    begin
//     znak1:=readKey;
     if znak1=#0 then
      begin
//       znak:=readKey;
       with grstat do
       xCurs1:=round(xpmin+(cursPoz-leftBound)*(xpmax-xpmin)/
               (rightBound-leftBound));
       if nrKom>0 then
        begin
         case znak of
          #75 : dec(cursPoz);        {left  kursor}
          #77 : inc(cursPoz);        {right kursor}
          #72 : dec(cursPoz,5);      {up    kursor}
          #80 : inc(cursPoz,5);      {dn    kursor}
         #115 : dec(cursPoz,10);     {ctrl-left  kursor}
         #116 : inc(cursPoz,10);     {ctrl-right kursor}
          #71 : cursPoz:=0;          {home}
          #79 : cursPoz:=rightBound; {end}
          #83 : if not lock and (nrKom=3) then     {Del}
                 begin
                  if not ins then
    informator('Tryb wstawiania nie aktywny! nacisnij INS',0,12,255,100)
                  else
                   begin
    informator('Wstawki beda pobierane z akt. cpstr od pktu wskaz. kursorem',
                         0,12,255,150);
                    Art_Nat:=not Art_Nat;
                    If Art_Nat then informator('Wstawka naturalna',0,12,255,150)
                    else            informator('Wstawka sztuczna',0,12,255,150);
                    Change_Insert:=true;
                    config;
                    znak1:=#1;      {wyjsc z pauzy aby zaladowac przebieg F0}
                   end;{else}
                 end
                else
             informator('Del, zmiana wstawki, aktywne tylko na tle cepstrow',
                         0,12,255,150);
          #82 : if not lock and (nrKom=3) then  {ins  wstawianie przebiegu F0 }
                 begin                          {w pkcie InsPunct na tle cepst}
                  ins:=True;                    {po wyjsciu z pause}
informator('Zarejestrowac punkt, od ktorego bedzie pobierana wstawka cpstr',
            0,12,255,150);
                  InsPunct:=cursPoz;
                  znak1:=#1;          {wyjsc z pauzy aby wstawic przebieg F0}
                  Change_Insert:=true;
                  config;
                 end
                else
             informator('Ins, zmiana punktu, aktywne tylko na tle cepstrow',
                         0,12,255,150);
         #112 : begin
                 informator('Wysylamy obraz na dysk',0,12,255,150);
//                 ScreenToDisk(0,0,GetMaxX,GetMaxY,PATTERNpATH); {alt-F9-Przeslac obraz na dysk}
               end;
         end;{case}

         if cursPoz<leftBound then cursPoz:=leftBound;
         if cursPoz>rightBound then cursPoz:=rightBound;
         if not Lock then
          if nrKom in [2,4] then
           begin
            modyfPrmtr:=(cursPoz)*interval;
            if modyfPrmtr < rate/count then
             begin
              modyfPrmtr:=rate/(2*count);
              cursPoz:=round(modyfPrmtr/interval)
             end
           end
          else
           if (nrKom=3) and (cursPoz>0) then
            modyfPrmtr:=1000/(cursPoz*interval);
           lancuch:='                        ';
           if nrKom<>1 then str(modyfPrmtr:3:2,lancuch)
           else str(cursPoz*(1000/rate):1:1,lancuch);
           str(round(cursPoz),cynk);
           case nrKom of           {-----------------------tresc komunikatu}
            0 : ;
            1 : begin
                 lancuch:='Probka nr '+cynk+' czas '+lancuch+' [ms], wartosc ';
                 if cursPoz>=0 then
                  str(virt_vect[cursPoz-leftBound]:1:3,cynk);
                 lancuch:=lancuch+cynk;
                end;
            2 : begin
                 lancuch:='Prazek nr '+cynk+' czestotl.='+lancuch+
                 ' [hz]; poziom=';
                 str(virt_vect[cursPoz]:5:2,cynk);
                 lancuch:=lancuch+cynk+' [dB]';
                end;
            3 : begin
                 lancuch:='Linia cepstr nr '+cynk+' czest='+lancuch+' [hz]';
                 if leftBound+cursPoz<>0 then str(1000/modyfPrmtr:5:2,cynk)
                 else cynk:='b. duza';
                 lancuch:=lancuch+' tj. '+cynk+' [ms]; wartosc=';
                 str(virt_vect[cursPoz]:1:4,cynk);
                 lancuch:=lancuch+cynk+'[nep]';
                end;
            4 : begin                         {dla czesci rzeczyw. i urojonej}
                 lancuch:='Prazek nr '+cynk+' czestotl.='+lancuch+
                 ' [hz]; wartosc=';
                 str(virt_vect[cursPoz]:6:3,cynk);
                 lancuch:=lancuch+cynk+'    ';
                end;
           end;{case nr komunikatu}
           j:=tl-length(lancuch);
           for i:=1 to j do lancuch:=lancuch+' ';
//           backBar(-grstat.ypmax-8,-48,brown); grColor:=white;
           delete(lancuch,length(lancuch)-j+1,j);
           win_x_y_title(lancuch,'x',-grstat.ypmax,-12,1,true);//blue=1
           {--------------------------Ruchy kursora----------------}
           with grstat do
           begin
            xCurs:=round(xpmin+(cursPoz-leftBound)*(xpmax-xpmin)/
                         (rightBound-leftBound));
//            putImage(xCurs1,ypmin,unmark^,copyPut);
//            GetImage(xCurs,Ypmin,xCurs,Ypmax+20,unmark^);
//            putImage(xCurs,ypmin,mark^,copyPut);
            xCurs1:=xCurs;
           end;{with}
        end;{nrKom}
      end{if #0}
     else
      case znak1 of
//        #27 : while keyPressed do znak:=readKey;
        'n' : sing:=not sing;            {badac tylko ostatnia z cyklu analiz}
      end;{case}
    end;{while}       {nacisniecie klawisza spoza sterujacych kursorem spowo-}
   until znak1<>#0;   {duje wyjscie z ppr.}
   if znak1='k' then  {nacisniecie "k" w szczegolnosci, zamknie takze tryb} 
    begin             {krokowy}
     krok:=false; Config_Show:=true; filtrFreqChange:=true;
     lancuch:='';
     for i:=1 to tl do lancuch:=lancuch+' ';
     backBar(-grstat.ypmax-24,-48,0);//black=0
     backBar(-grstat.ypmax-8,-48,0);//black=0
    end;{'k'}
    if cursPoz>0 then idx:=round(count/cursPoz)
    else begin idx:=count div 2; cursPoz:=2 end
 END;{pause_curs}

 begin
  InsPunct:=1;
 end.

