effect.pas

   1 unit effect;
   2
   3 interface
   4
   5 uses System.Classes, System.SysUtils, Math, spWav;
   6
   7 function effect8BitWav(const sp: SpParam): integer;
   8 function effect16BitWav(const sp: SpParam): integer;
   9 function sinc(x: Single): Single;
  10 procedure usage;
  11 function effectwav(const sp: SpParam): integer;
  12
  13 implementation
  14
  15 function effect8BitWav(const sp: SpParam): integer;
  16 begin
  17 end;
  18
  19 function effect16BitWav(const sp: SpParam): integer;
  20 const
  21   j = 24;
  22 var
  23   i, k, a, b, pmin, pmax: integer;
  24   len, temp_size, offset0, offset1, p, q: integer;
  25   m, ma, pitch, rate: Single;
  26   pMem, pCpy, pRes: array of SmallInt;
  27   s: TMemoryStream;
  28   r: array of Single;
  29 begin
  30   result := 0;
  31   try
  32     temp_size := trunc(sp.samplePerSec * sp.bitsPerSample * sp.channels * 0.01);
  33     pmin := trunc(sp.samplePerSec * sp.bitsPerSample * sp.channels * 0.005);
  34     pmax := trunc(sp.samplePerSec * sp.bitsPerSample * sp.channels * 0.02);
  35     SetLength(r, pmax - pmin);
  36     offset0 := sp.posOfData;
  37     offset1 := sp.posOfData;
  38     rate := 0.66;
  39     len := trunc(sp.sizeOfData / (rate * sp.channels));
  40     SetLength(pCpy, len);
  41     SetLength(pRes, len);
  42     s := TMemoryStream.Create;
  43     s.Write(sp.pWav^, sp.sizeOfData);
  44     s.Position := 0;
  45     s.Read(Pointer(pRes)^, s.Size);
  46     s.Free;
  47     pMem := sp.pWav;
  48     k := (sp.sizeOfData - sp.posOfData) div sp.channels;
  49     for b := 0 to pmax - pmin - 1 do
  50     begin
  51       r[b] := 0.0;
  52       for a := sp.posOfData to sp.posOfData + temp_size do
  53         r[b] := r[b] + pMem[a] * pMem[a + b];
  54       if r[b] > ma then
  55       begin
  56         ma := r[b];
  57         p := b;
  58       end;
  59     end;
  60     while offset1 + 2 * pmax < len do
  61     begin
  62       ma := 0.0;
  63       p := pmin;
  64       for i := 0 to p do
  65       begin
  66         pCpy[offset1 + i] := pRes[offset0 + i];
  67         pCpy[offset1 + i + p] := trunc(pRes[offset0 + p + i] * (p - i) / p +
  68           pRes[offset0 + i] * i / p);
  69       end;
  70       q := trunc(rate * p / (1.0 - rate) + 0.5);
  71       for i := p to q - 1 do
  72       begin
  73         if offset1 + i + p >= len then
  74           break;
  75         pCpy[offset1 + p + i] := pMem[offset0 + i];
  76       end;
  77       inc(offset0, q);
  78       inc(offset1, p + q);
  79     end;
  80     pitch := 1.5;
  81     for i := sp.posOfData to k - 1 do
  82     begin
  83       m := pitch * i;
  84       q := trunc(m);
  85       for a := q - j div 2 to q + j div 2 do
  86         if (a >= sp.posOfData) and (a < len) then
  87           pMem[i] := pCpy[a] + pRes[a] * trunc(sinc(pi * (m - a)))
  88         else
  89           pMem[i] := 0;
  90     end;
  91   except
  92     result := -1;
  93   end;
  94   Finalize(pRes);
  95   Finalize(pCpy);
  96   Finalize(r);
  97 end;
  98
  99 function sinc(x: Single): Single;
 100 begin
 101   if x = 0 then
 102     result := 1.0
 103   else
 104     result := sin(x) / x;
 105 end;
 106
 107 procedure usage;
 108 begin
 109   Writeln('\82Ì\82±\82¬\82è\94g');
 110   Writeln('\97á\81Feffect.wav 100 2000');
 111 end;
 112
 113 function effectwav(const sp: SpParam): integer;
 114 begin
 115   if sp.channels = 1 then
 116   begin
 117     Writeln('\83X\83e\83\8c\83I\83t\83@\83C\83\8b\82É\82µ\82Ä\82\82¾\82³\82¢');
 118     // result := -1;
 119   end;
 120   if sp.bitsPerSample = 8 then
 121     result := effect8BitWav(sp)
 122   else
 123     result := effect16BitWav(sp);
 124 end;
 125
 126 end.