//{$O+,F+,N+,R-,I+,D-,L-,S-}
unit gen;

INTERFACE
{
 uwaga! Grubosc=bufor
}
uses //dos,crt,
windows,common,friend,disco;

procedure GenInfo(var data:kod_opisu;var rate:realType; var czest:real;
                  var lba_danych:longint;var freq:word;var gain:integer;
		  var modul:real; var create:DirStr);
procedure genToHeap(var lba_danych:longint; var lba_plackow:word;
            var tref:TrefTyp;grubosc:word; var p:boolean; var rez:word;
	    bity_danych:byte;czest,modul,freq:real;create:DirStr);
procedure genStat(var czest:real; var lba_danych:longint; var rate:realType;
   var freq:word;  var modul,f0max:real;var gain:integer; var path:PathStr;
   var create:DirStr);



implementation
 type funtype=function(j:longint):longint;

type convol=record
             convMin,convMax,scaler,scale1,
             scale2,a,b,th,tp,T : real;
	     rate,mn : word;
             clap : boolean;
               action:funtype;
	    end;

var      crz : convol;
          mn : word;
  pimod,pipi : real;


function sinex(x:real):real;
{
calka z exp(a*x)*sin(b*x)
}
 begin
  with crz do
  sinex:=(a*sin(b*x)-b*cos(b*x))*exp(a*x)
 end;{sinex}

function cosinex(x:real):real;
{
calka z exp(a*x)*cos(b*x)
}

 begin
  with crz do
  cosinex:=((a*cos(b*x)+b*sin(b*x)))*exp(a*x);
 end;{cosinex}

 function calka_ozn(t1,t2:real):real;
 var zmp:real;
  begin
   zmp:=sinex(t2)-sinex(t1);
   calka_ozn:=zmp
  end;{calka_ozn}

function Dirac_inst_convol(j:longint):longint;
 {
 wartosc chwilowa splotu z ciagiem Diraca
 }
 var t0,tp,curr_th : real;
                 k : longint;
  begin
   with crz do
    begin
     t0:=j/rate; tp:=trunc(t0/T)*T;
     k:=0;
     curr_th:=t0-tp;
     scaler:=0;
     while (curr_th<th) and (curr_th<=t0) do
      begin
       scaler:=scaler+exp(a*curr_th)*sin(b*curr_th);
       inc(k);
       curr_th:=curr_th+k*T;
      end;{while}
     Dirac_inst_convol:=round(scale1*scaler-scale2);
    end;{with}
  end;{Dirac_inst_convol}

 function Rect_inst_convol(j:longint):longint;
 {
 wartosc chwilowa splotu
 }
 var t0,R,SR,SL : real;
	    i,N : longint;
  begin
   with crz do
    begin
     t0:=j/rate;
     tp:=trunc(t0/T)*T; {najblizszy poczatek impulsow}
     R:=t0-tp;          {"czolo" splotu}
     SR:=0; SL:=0;
 {1} if R<=T/2 then
      if th > R then
       begin
        if R=0 then SR:=0
        else SR:=calka_ozn(0,R)
       end
 {2}  else SR:=calka_ozn(0,th)
     else
 {3}  if th>=R then SR:=calka_ozn(t0-tp-T/2, t0-tp)
 {4}  else
{4a}   if th>(t0-tp-T/2) then SR:= calka_ozn(t0-tp-T/2, th)
{4b}   else SR:=0;
     if (R<th) and (t0>0) then
      begin
       N:=trunc((th-R)/T);
       i:=0; Sl:=0;
       if N>0 then
	repeat
	 inc(i);
	 SL:=SL+calka_ozn((2*i+1)*T/2+R, 2*(i+1)*T/2+R);
	until i>=N-1
       else SL:=0;
       if th-N*T>T/2 then SL:=SL+calka_ozn(R+N*T+T/2, th);
      end;{R<th}
      scaler:=SL+SR;
     Rect_inst_convol:=round(scale1*scaler-scale2);
    end;{with}
  end;{Rect_inst_convol}

 procedure convolStat;
 begin
//  TextColor(lightCyan);
  with crz do
   begin
    scale1:=1; scale2:=0;
    th:=128/rate;
    //writeln(cons,'Czas odpowiedzi impuls.          ',th:6:4);  blok 22032017
    a:=ln(0.01)/th;
   // writeln(cons,'stala wykladnika (zaniku)     ',a:9:4); blok 22032017
    b:=32*pi/th;
    //writeln(cons,'Okres oscylacji odp. imp.        ', blok 22032017
     //2*pi/b:6:4,' tj.',b/(2*pi):6:2,' Hz;'#13#10' co daje ',
    // b*th/(2*pi):4:1,' cykli w czasie odpowiedzi impulsowej');
    scaler:=0;
    convMin:=action(0);
    convMin:=scaler;
    convMax:=convMin;
   // writeln(cons,'Okres impulsow prostok. (sygnal) ',T:6:4,' tj.',1/T:6:2,' Hz');
   end;{with}
   //write(cons,'Enter!'); //writeln(cons,ReadKey);
 end{convolStat};

procedure GenInfo(var data:kod_opisu; var rate:realType;var czest:real;
                  var lba_danych:longint;var freq:word;var gain:integer;
		  var modul:real; var create:DirStr);
{
create - parametr okreslany w disco1 w data_info
}
 label 1;
 var x,y : byte;opis,opis0,message : PathStr;
   begin
//    ClrScr;
   // writeln(cons,'----------------------------------------------------------');
    //writeln(cons,'          Sztuczny Generator');
   // writeln(cons,'----------------------------------------------------------');
//    GetDate(data[1],data[2],data[3],data[4]);
  //  GetTime(data[5],data[6],data[7],data[8]);
    opis:=''; opis0:='';
//   TextColor(red);
1: if create='sin_cos' then
    begin
     czest:=par_fiz('czestotliwosc sygnalu   cosinus...(477)');
//     TextColor(red);
     modul:=par_fiz('czestotliwosc modulacji sinus....( 50)');
    end
   else
    if (create='Rect_convol') or (create='Dirac_convol') then
     begin
      if (create='Dirac_convol') then message:= ' jednost'
      else message:=' prostok';
      czest:=par_fiz('czestotliwosc impulsow '+message+'...(500)');
      crz.T:=1/czest
     end
    else
     begin
      //writeln(cons,'takiej operacji nie przewidziano!');
      create:='Dirac_convol';
      goto 1;
    end;
   str(czest:5:0,opis);
//   TextColor(red);
   rate:=par_fiz('czestotliwosc probkowania........(7000)');
   crz.rate:=round(rate);
//   TextColor(red);
   lba_danych:=par_int('liczba probek....................(2000)');
   opis:='gen'+opis;
   freq:=round(rate);
   str(freq:5,opis0); opis:=opis+'/'+opis0;
   str(modul:1:1,opis0);opis:=opis+'/'+opis0;
   data[9]:=freq; Gain:=0;
  end;{GenInfo}



 {$F+}
 function sin_cos_mod(j:longint):longint;
  begin
   crz.scaler:=(mn*cos(pipi*j)*(1-sin(pimod*j))/2+mn);
   sin_cos_mod:=round(crz.scaler);
  end;


procedure genToHeap(var lba_danych:longint; var lba_plackow:word;
            var tref:TrefTyp;grubosc:word; var p:boolean; var rez:word;
	    bity_danych:byte;czest,modul,freq:real;create:DirStr);
{
create - parametr okreslany w Disco1, w data_info
}

  var i,j,k,l : longint;
       pomiar : word;
      message : PathStr;

 procedure execute_gen(operat:funtype);
 label 1;
 var k:longint;
  begin
   for k:=0 to lba_plackow do
    begin
     i:=0;
    // write(cons,'ladujemy blok nr ',k:2);
     Repeat
      tref[k]^[i]:=operat(j);;
      inc(i); inc(j);
      if j=lba_danych then goto 1;
     until i>=l; {koniec ladowania kolejnego plastra}
    // writeln(cons,' wygenerowano ',j:6,' danych');
    end;{for - koniec sterty}
   if j<lba_danych then
   begin
    p:=True;
   // write(cons,'Zabraklo miejsca na stercie dla ');
    //TextColor(white+blink);
    //write(cons,lba_danych-j); //TextColor(white);
    //writeln(cons,' danych');
   end {if}
   else;// writeln(cons,'Zaladowano ',j:6,' danych, tj. o ',j-lba_danych,' wiecej','niz zadano!');
  1:if i<l then rez:=i else rez:=0;
   lba_danych:=j;
   lba_plackow:=k;
   //writeln(cons);
 end;{execute_gen}

 procedure fun_min_max(operat:funtype);
 label 1;
 var k,m:longint;
  begin
   for k:=0 to lba_plackow do
    begin
     i:=0;
     Repeat
      m:=operat(j);
      with crz do
       begin
        if convMin>scaler then  ConvMin:=scaler;
        if convMax<scaler then  ConvMax:=scaler;
       end;
      inc(i); inc(j);
      if j=lba_danych then goto 1;
     until i>=l;
    end;
  1: with crz do
    begin
    // writeln(cons);
     //writeln(cons,'   convMin ','     convMax ','     rozstep');
     //writeln(cons,convMin:12:3,convMax:12:3,convMax-convMin:12:3);
     //writeln(cons);
//     TextColor(yellow);
    end;
 end;{fun_min_max}


 begin
  l:=grubosc+1; j:=0; p:=false;
  k:=2; mn:=(k shl (bity_danych-2))-1;
//  TextColor(lightBlue);
  if create='sin_cos' then
   begin
    //writeln(cons,'Generuje dane ');
//    TextColor(white);
    pipi:=2*pi*czest/freq;
    pimod:=2*pi*modul/freq;
    crz.action:=sin_cos_mod;
   end;
  if (create='Rect_convol')  or (create='Dirac_convol') then
   begin
    if (create='Rect_convol') then
     begin
      crz.action:=Rect_inst_convol;
      message:=' protokatnych'
     end
    else
     begin
       crz.action:=Dirac_inst_convol;
      message:=' Diraca'
     end;
   // writeln(cons,'Generuje splot impulsow'+message+#10#13,
   //         'z odpowiedzia impulsowa exp(-a*x)*sin(b*x)');
   end;
   crz.mn:=mn;
   convolStat;
   fun_min_max(crz.action); j:=0;
   with crz do
    begin
     if convMax<-convMin then convMax:=-convMin
     else convMin:=-convMax;
     if convMax<>convMin then scale1:=2*mn/(convMax-convMin)
     else scale1:=1;
     scale2:=convMin*scale1;
    end;
   execute_gen(crz.action);
 // writeln(cons,'Wygenerowano ogolem ',j:6,' danych; w ostatnim bloku jest ',rez:5,' danych');
 end; {genToHeap}

procedure genStat(var czest:real; var lba_danych:longint; var rate:realType;
   var freq:word; var modul,f0max:real; var gain:integer;var path:PathStr;
   var create:DirStr);
   label 1;
   var message:nameStr;
   begin
    czest:=100; lba_danych:=700; freq:=round(64*czest);
     rate:=freq; modul:=0.1*czest;
    crz.T:=1/czest; crz.rate:=round(rate);
    f0max:=1000;
    gain:=0;
//    textColor(white);
   // writeln(cons,'----------------------------------------------------');
   // writeln(cons,'  generujemy dane o z gory ustalonych parametrach');
   // writeln(cons,'----------------------------------------------------');
//    TextColor(lightGreen);
    path:=locDrv+'\pomiary.wrd';
 1: if create='sin_cos' then
     begin
      //writeln(cons,'czestotliwosc sygnalu _____',czest:6:1);
      //writeln(cons,'czestotliwosc modulacji ___',modul:6:1);
     end
    else
     if (create='Rect_convol') or (create='Dirac_convol') then
       begin
        if create='Dirac_convol' then message:='Dirac`a'
        else message:='prostok';
        //writeln(cons,'czestotliwosc impulsow  '+message+'...',czest:6:1)
       end
     else
      begin
       //writeln(cons,'takiej operacji nie przewidziano! - wykonujemy splot Dirac`a');
       create:='Dirac_convol';
       goto 1;
      end;
    //writeln(cons,'czestotliwosc probkow. ____',freq:6);
    //writeln(cons,'liczba danych _____________',lba_danych:6);
    //writeln(cons,'path wynikow ___________',path);
   end;{genStat}
 begin
 end.


