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 const
  17   j = 24;
  18 var
  19   i, a, b, pmin, pmax, temp_size, offset0, offset1, p, q: integer;
  20   k, m, ma, pitch, rate: Single;
  21   pMem, pCpy: array of SmallInt;
  22   r: array of Single;
  23   s: TMemoryStream;
  24 begin
  25   result := 0;
  26   s := TMemoryStream.Create;
  27   try
  28     SetLength(pCpy, sp.sizeOfData);
  29     s.Write(sp.pWav^, sp.sizeOfData);
  30     s.Position := 0;
  31     s.Read(Pointer(pCpy)^, sp.sizeOfData);
  32     pMem := sp.pWav;
  33     temp_size := trunc(sp.samplePerSec * sp.bitsPerSample * sp.channels * 0.01);
  34     pmin := trunc(sp.samplePerSec * sp.bitsPerSample * sp.channels * 0.005);
  35     pmax := trunc(sp.samplePerSec * sp.bitsPerSample * sp.channels * 0.02);
  36     SetLength(r, pmax - pmin);
  37     offset0 := sp.posOfData;
  38     offset1 := sp.posOfData;
  39     rate := 0.66;
  40     while offset0 + pmax * 2 < sp.sizeOfData do
  41     begin
  42       ma := 0.0;
  43       p := pmin;
  44       for b := 0 to pmax - pmin - 1 do
  45       begin
  46         r[b] := 0.0;
  47         for a := sp.posOfData to sp.posOfData + temp_size do
  48           r[b] := r[b] + pCpy[a] * pCpy[a + b];
  49         if r[b] > ma then
  50         begin
  51           ma := r[b];
  52           p := b;
  53         end;
  54       end;
  55       for i := 0 to p - 1 do
  56       begin
  57         pMem[offset1 + i] := pCpy[offset0 + i];
  58         pMem[offset1 + i + p] := trunc(pCpy[offset0 + p + i] * (p - i) / p +
  59           pCpy[offset0 + i] * i / p);
  60       end;
  61       q := trunc(rate * p / Abs(1.0 - rate) + 0.5);
  62       for i := p to q - 1 do
  63       begin
  64         if offset0 + i >= sp.sizeOfData then
  65           break;
  66         pMem[offset1 + p + i] := pCpy[offset0 + i];
  67       end;
  68       inc(offset0, q);
  69       inc(offset1, p + q);
  70     end;
  71     pitch := 1.5;
  72     for i := sp.posOfData to sp.sizeOfData do
  73     begin
  74       m := pitch * i;
  75       q := trunc(m);
  76       for a := q - j div 2 to q + j div 2 do
  77         if (m >= sp.posOfData) and (m < sp.sizeOfData) then
  78           pMem[a] := trunc(pMem[a + 0] + pCpy[a + 0] * sinc(pi * (m - a)));
  79     end;
  80   except
  81     result := -1;
  82   end;
  83   Finalize(r);
  84   s.Free;
  85   Finalize(pCpy);
  86 end;
  87
  88 function effect16BitWav(const sp: SpParam): integer;
  89 const
  90   j = 24;
  91 var
  92   i, k, a, b, pmin, pmax, temp_size, offset0, offset1, p, q: integer;
  93   m, ma, pitch, rate: Single;
  94   pMem, pCpy: array of SmallInt;
  95   r: array of Single;
  96   s: TMemoryStream;
  97 begin
  98   result := 0;
  99   s := TMemoryStream.Create;
 100   try
 101     SetLength(pCpy, sp.sizeOfData);
 102     s.Write(sp.pWav^, sp.sizeOfData);
 103     s.Position := 0;
 104     s.Read(Pointer(pCpy)^, sp.sizeOfData);
 105     pMem := sp.pWav;
 106     temp_size := trunc(sp.samplePerSec * sp.bitsPerSample * sp.channels * 0.01);
 107     pmin := trunc(sp.samplePerSec * sp.bitsPerSample * sp.channels * 0.005);
 108     pmax := trunc(sp.samplePerSec * sp.bitsPerSample * sp.channels * 0.02);
 109     SetLength(r, pmax - pmin);
 110     offset0 := sp.posOfData;
 111     offset1 := sp.posOfData;
 112     rate := 0.66;
 113     k := (sp.sizeOfData - sp.posOfData) div sp.channels;
 114     for b := 0 to pmax - pmin - 1 do
 115     begin
 116       r[b] := 0.0;
 117       for a := sp.posOfData to sp.posOfData + temp_size do
 118         r[b] := r[b] + pCpy[a] * pCpy[a + b];
 119       if r[b] > ma then
 120       begin
 121         ma := r[b];
 122         p := b;
 123       end;
 124     end;
 125     while offset1 + 2 * pmax < k do
 126     begin
 127       ma := 0.0;
 128       p := pmin;
 129       for i := 0 to p do
 130       begin
 131         pMem[offset1 + i] := pCpy[offset0 + i];
 132         pMem[offset1 + i + p] := trunc(pCpy[offset0 + p + i] * (p - i) / p +
 133           pCpy[offset0 + i] * i / p);
 134       end;
 135       q := trunc(rate * p / (1.0 - rate) + 0.5);
 136       for i := p to q - 1 do
 137       begin
 138         if offset1 + i + p >= k then
 139           break;
 140         pMem[offset1 + p + i] := pCpy[offset0 + i];
 141       end;
 142       inc(offset0, q);
 143       inc(offset1, p + q);
 144     end;
 145     pitch := 1.5;
 146     for i := sp.posOfData to k - 1 do
 147     begin
 148       m := pitch * i;
 149       q := trunc(m);
 150       for a := q - j div 2 to q + j div 2 do
 151         if (a >= sp.posOfData) and (a < k) then
 152           pMem[i] := pMem[a] + pCpy[a] * trunc(sinc(pi * (m - a)))
 153         else
 154           pMem[i] := 0;
 155     end;
 156   except
 157     result := -1;
 158   end;
 159   Finalize(pCpy);
 160   Finalize(r);
 161   s.Free;
 162 end;
 163
 164 function sinc(x: Single): Single;
 165 begin
 166   if x = 0 then
 167     result := 1.0
 168   else
 169     result := sin(x) / x;
 170 end;
 171
 172 procedure usage;
 173 begin
 174   Writeln('\82Ì\82±\82¬\82è\94g');
 175   Writeln('\97á\81Feffect.wav 100 2000');
 176 end;
 177
 178 function effectwav(const sp: SpParam): integer;
 179 begin
 180   if sp.channels = 1 then
 181   begin
 182     Writeln('\83X\83e\83\8c\83I\83t\83@\83C\83\8b\82É\82µ\82Ä\82\82¾\82³\82¢');
 183     // result := -1;
 184   end;
 185   if sp.bitsPerSample = 8 then
 186     result := effect8BitWav(sp)
 187   else
 188     result := effect16BitWav(sp);
 189 end;
 190
 191 end.