
unit disco1;
INTERFACE
 uses
 Controls,
StdCtrls,
  windows,Messages,Forms,sysUtils,dialogs,Graphics,common,friend,disco,gen,porto,visualization,drawings;

 var
         storedDataNb : longint;
               create : DirStr;
        NewFileOpened : boolean;
           CheckBreak : boolean;

 type dtva= array[0..max_buffer] of typ_skl;
      dtvp=^dtva;

procedure retriev_results_to_disk(lbaBit:byte; Smax,Smin:realType;
   var realTypePlik:realPlik;var nowyPlik:typ_sklFile);
procedure data_info(var path,pathspectr:pathStr;var source:char;
      var rate:realType;var format:char;var gain:integer;var data:kod_opisu;
      var lba_danych:longint;var plikz:typ_sklFile;var startPoint:longint;
      var lookFor1:word;var czest:real;var freq:word;var modul:real;
      var dataVector:dtvp;clock_freq,f0max:real;var spow:byte;
      var p,kontr_glob:boolean;var board_num,trigger,mode,chanlo,int_level,
      error_code : integer;var sklSt:word; var base_adr : integer;
      var triglev:byte;var opis:string; var create:DirStr);
procedure dataPut(var pathCpstr:pathStr;lba_plackow:word;var plik:typ_sklFile;
        rate:real;gain,rez,bufor:word;path:pathStr;opis:string;spow:integer;
        var pathspectr:pathStr);
procedure data_input(source:char;var lookFor,startPoint,lba_danych:longint;format:char;
    var lba_plackow:word;var tref:trefTyp;bufor:word;var plikz:typ_sklFile;
    var HeapFull:boolean;var rez:word;lookfor1:word;var storedDataNb:longint;
    czest,modul,freq:real;chanlo,mode,trigger:integer;var clock_freq:real;
    var rate:realType;
    base_adr:integer;var datavector:dtvp;var error_code:integer;p:boolean;
    var trigLev:byte; var sklSt:word;lbaBit:byte; var create:DirStr);


IMPLEMENTATION

 uses unit1,NewSpectrum;
procedure Otw_zb_retriev(var oRettoDisc:boolean;
   var path,nowapath:pathStr;ext:extStr;rate:realType; opis:string;
   gain:byte;skok:real;var nowyPlik:typ_sklFile);
{
otwiera na dysku stalym zbior .re# dla wynikow odzyskanych z transformaty
odwrotnej, a zapisanych na RAM-dysku jako wartosci typu Real
}
  procedure retInfo;
   var        i : integer;
              j : longint;
    opis_danych : array[0..265] of typ_skl;
       data_zal : array[1..8] of typ_skl;
   begin
      for i:=0 to 265 do opis_danych[i] := typ_skl(' ');
      for i:=0 to 255 do opis_danych[i]:=typ_skl(opis[i]);
      for i:=0 to 255 do write(nowyPlik,opis_danych[i]);
//      GetDate(data_zal[1],data_zal[2],data_zal[3],data_zal[4]);
      for i:=1 to 4 do opis_danych[i]:=typ_skl(data_zal[i]);
//      GetTime(data_zal[5],data_zal[6],data_zal[7],data_zal[8]);
      for i:=5 to 8 do opis_danych[i]:=typ_skl(data_zal[i]);
      j:=round(rate);
      opis_danych[9]:=typ_skl(j);
      opis_danych[10]:=typ_skl(gain);
      for i:=1 to 10 do write(nowyPlik,opis_danych[i]);
   end;{retInfo}

  var d:dirStr; n:nameStr;e:extStr;

  begin
//   fSplit(path,d,n,e);
   nowapath:=d+n+'.'+ext;
   assignFile(NowyPlik,nowapath);
   rewrite(NowyPlik);
   newFileOpened:=True;
   retInfo;
  end;{otw_zb_retriev}

procedure retriev_results_to_disk(lbaBit:byte; Smax,Smin:realType;
   var realTypePlik:realPlik;var nowyPlik:typ_sklFile);
 {
 1. konwersja z +-1 na 0-4096 (jesli lba bit =12; stad pochodzi 4096)
 }
 var i,k:integer; skal:real; retword:word; t:realType;
  begin
   reset(realTypePlik);
   i:=2;
   skal:=(i shl (lbaBit-1))/(Smax-Smin);
    repeat
     read(realTypePlik,t);
     retword:=round((t-Smin)*skal);
     write(nowyPlik,retword);
    until eof(realTypePlik)
  end;{retriev_result_to_disk}



procedure data_info(var path,pathspectr:pathStr;var source:char;
      var rate:realType;var format:char;var gain:integer;var data:kod_opisu;
      var lba_danych:longint;
      var plikz:typ_sklFile;var startPoint:longint;var lookFor1:word;var czest:real;
      var freq:word;var modul:real;var dataVector:dtvp;clock_freq,f0max:real;
      var spow:byte;var p,kontr_glob:boolean;
      var board_num,trigger,mode,chanlo,int_level,error_code : integer;
      var sklSt:word;var base_adr:integer; var triglev:byte; var opis:string;
      var create:DirStr);

var                                               znak : char;
                                                  cynk : pathStr;
 procedure dataSource(out source,znak,format:char);
  Begin
   source:='d';
   znak:='c';
   format:='v';
   path:='C:\apl\mowy\mowa.wrd';       //radigroup3
   case form1.radioGroup8.ItemIndex of
    0:source:='d'; //- z dysku '
    1:source:='p'; //- z przetwornika
    2:source:='g'; //- generujemy
    3:source:='t'  //- generujemy przy nast. domyślnych
   end;{case}
   with unit1.Form1 do Panel3.Visible:=RadioGroup8.itemIndex=0;
   if source in ['g','t'] then
    begin                                                     //radigroup4
     case form1.radioGroup9.ItemIndex of
      0:znak:='c';  // - generowac cos modulowany sin
      1:znak:='p'; // - splot fali prostokatnej z zadana odpowiedzia impulsowa'
      2:znak:='d'  // - splot ciagu imp. Dirac`a z zadana odpowiedzia impulsowa
     end;{case}
     case znak of
      'p' : create:='Rect_convol';
      'd' : create:='Dirac_convol';
      'c' : create:='sin_cos'
     end;{case}
    end
    else
     case form1.radioGroup10.ItemIndex of
      0:begin format:='v'; path:=waveFilePath end;
      1:begin format:='w'; form1.Panel1.Visible:=false; showMessage('Data format ("word") not supported now, program will be halted...'); halt; end;
     end;{case}
  End;

  var pathtemp:pathStr;  logos:boolean;
 Begin //--------------------------------------------- data_info ------------------------------
  DataSource(source,znak,format); //dysk/przetwornik AC/ generator wewnętrzny
    if source = 'd' then
     begin
      repeat
       pathtemp:=path;
       logos:=OpenFile(pathtemp,'Open "'+path+'" file','*');
       path:=pathtemp;                                     {szukac pliku aż do skutku}
      until fileExists(path) or not logos;                    //przerwać szukanie, gdy zostanie wybrany Cancel w oknie dialogowym
      if format='w' then WordFileInfo(path,rate,gain,data,lba_danych,plikz,startPoint,lookFor1,opis)                         //------odczytuje naglowek informacyjny
      else
      begin
       showWaveHead(form1.canvas,waveFile,path,RIFF,fileLength,Wave,fmt,lengthOfFmtData,PCM,MonoSter,Rate,blockAlign, //------odczytuje naglowek informacyjny
          BACBS,bits_sample,wave_data,dataBlockLength);
       lba_danych:=(dataBlockLength+1) div 2;
       sklSt:=0;
      end;{format wave}
      patternPath:=copy(path,1,lastdelimiter('.',path)-1);
      pathspectr:=patternPath;
     end{if dysk}
    else if source<>'t' then   //czyli nie dysk, ani nie generator domyślny
     begin
      repeat
       if source ='p' then    //przetwornik
        cynk:='Gdzie kierowac wyniki pomiarow?'#10#13' podać pełną scieżkę dostępu na dysk '
       else                   //generator wewnętrzny
        cynk:='Gdzie kierowac wygenerowane dane?'#10#13' - podac pelna sciezke'+
        ' dostepu na dysk ';
       road(path,cynk);
 //      TextColor(lightCyan);
 //      fileInfor(path,patternPath);
 //      puc; textColor(Cyan);
      // write(cons,'OK? -t/n - '); //znak:=readKey; textColor(lightGray);
 //      textColor(lightCyan);
      // writeln(cons,znak);
      until znak='t';
     end;{else : 'p' or'g'}
  if source='g' then
    genInfo(data,rate,czest,lba_danych,freq,gain,modul,create);
  if source='p' then
   begin
    p:=false; kontr_glob:=false; board_num:=1;trigger:=1;mode:=1;
    chanlo:=1;int_level:=3;base_adr:=$300;spow:=1;trigLev:=0;sklSt:=2049;
    PortInfo(datavector^[0],max_buffer,Gain,rate,kontr_glob, board_num,
     trigger,mode,chanlo,int_level, base_adr,clock_freq,spow,
     error_code,triglev,sklst);
     opis:='Dane czytane z portu nie zapisane na dysk';
   end;
  if source='t' then
   genStat(czest,lba_danych,rate,freq,modul,f0max,gain,pathspectr,create);
   if source in ['t','g'] then
    begin
     spow:=1; pathspectr:=locDrv+'TestGen.Wrd';StartPoint:=0; lookfor1:=0;
     opis:='Dane z generatora wewnetrznego nie zapisane na dysk';
    end;
 end;{data_info}

 procedure dataPut(var pathCpstr:pathStr;lba_plackow:word;var plik:typ_sklFile;
        rate:real;gain,rez,bufor:word;path:pathStr;opis:string;spow:integer;
        var pathspectr:pathStr);

 var znak:char;
 begin
//  textColor(cyan);
  //write(cons,'Zapisac dane na dysk? - t/n '); no_jak(znak); writeln(cons);
  if znak='t' then
  begin
//   TextColor(brown);
   //write(cons,'Podaj opis zbioru ');
//    napis(pathCpstr);
    opis:=pathCpstr;
   toDisc(tref,lba_plackow,plik,rate,gain,rez,bufor,path,opis,spow,pathspectr,0,1,'wrd');
  end;{dane na dysk}
 end;{dataPut}

 procedure TrefOscShow(var wspx,wspy:double; var q:integer);
  var i,j,l,n:longInt;
  Begin     //-------------------------------------oscylogram kontrolny-----------------------------------
    if application.MessageBox('Pokazać oscylogram?','OSCYLOGRAM',MB_YESNO)=idyes then
    with form2 do
     begin
      show;
      frame(Panel1,Canvas,dataBlockLength div 2,high(smallInt),-8,wspx,wspy,q,false,false);//div 2, bo każda próbka w Wave zajmuje 2 bajty, a data
      panel1.Visible:=false;
      canvas.Pen.Color:=clnavy;
      l:=0; i:=0;                                                                 //l - licznik ogólny
      Repeat
       j:=0;                                                                 //j - licznik w plastrze
       repeat
        n:=tref[i]^[j];
        with form2.Panel1 do form2.canvas.LineTo(round(l*wspx+left),round(-n*wspy+q));
        application.processmessages;
        inc(j);inc(l);
       // form2.label38.caption:='i='+intTostr(i+1)+' j='+intTostr(j)+' l='+intTostr(l);
       until (j>bufor) or (l>=storedDataNb);
       inc(i);
      Until l>=StoredDataNb;
      //form2.label38.caption:=form2.label38.caption+' storedDataNb='+intTostr(storedDataNb);
      showMessage('Gotowe!')
     end;{with}
  End;{TrefOscShow}

procedure data_input(source:char;var lookFor,startPoint,lba_danych:longint;format:char;
    var lba_plackow:word;var tref:trefTyp;bufor:word;var plikz:typ_sklFile;
    var HeapFull:boolean;var rez:word;lookfor1:word;var storedDataNb:longint;
    czest,modul,freq:real;chanlo,mode,trigger:integer;var clock_freq:real;
    var rate:realType;
    base_adr:integer;var datavector:dtvp;var error_code:integer;p:boolean;
    var trigLev:byte; var sklSt:word;lbaBit:byte; var create:DirStr);

var i,j,m,n : longint;
      wspx,wspy : double;
              q : integer;
 Begin   //-----------------------------------------------data_input-------------------------------
   case source of
   'd' :
    begin
     case format of
     'w':begin
          reset(plikz);
          storedDataNb:=j;
          //writeln(cons,'Bylo do wczytania ',lba_danych-lookFor,' a wczytano ',j,' danych');
        end;{'w'}
     'v':begin
          fromDiscToHeap(44,lba_danych,lba_plackow,tref,bufor,waveFile,HeapFull,rez,j,lookfor1);
          storedDataNb:=j;
          //writeln(cons,'Bylo do wczytania ',lba_danych-lookFor,' a wczytano ',j,' danych');
         end;{'v'}
         end;{case}
    end;{'d'ysk}
't','g' : begin
           i:=lba_danych;
           if (create <>'sin_cos') and
                    (create<>'Rect_convol') and
                    (create<>'Dirac_convol')
                 then
            begin
             //writeln(cons,'Nie zdefiniowano operacji "',create,'"');
             //writeln(cons,'realizujemy splot Dirac`a');
             create:='Dirac_convol';
            end;
           genToHeap(lba_danych,lba_plackow,tref,bufor,HeapFull,rez,12,czest,modul,freq,create);
           storedDataNb:=lba_danych; lba_danych:=i;
	        end;{gen}
   'p' :
    begin
     CheckBreak:=false;
     fromPortToHeap(0,chanlo,mode,trigger,clock_freq,rate,base_adr,
                    datavector^[0],error_code,lba_plackow,rez,p,false,
                    trigLev,sklSt,lba_plackow,tref);
     lba_danych:=(lba_plackow+1)*(bufor+1)+rez;
     storedDataNb:=lba_danych;
    end;{'p'ort}
  end;{case source}
  TrefOscShow(wspx,wspy,q); //-------------------------------------oscylogram kontrolny-----------------------------------
  End;{data_input}

Begin
 NewFileOpened:=false;   {zbioru dla wynikow z odwtotnej FFT nie otwarto}
End.



