音声ファイルの最後まで残すことができましたが、終盤音が乱れます。

[sample-delphi/sample-DELPHI.git] / effect.pas

diff --git a/effect.pas b/effect.pas
index b538904..d934c22 100644 (file)
--- a/effect.pas
+++ b/effect.pas
@@ -6,73 +6,102 @@ uses System.Classes, System.SysUtils, Math, spWav;
 
 function effect8BitWav(const sp: SpParam): integer;
 function effect16BitWav(const sp: SpParam): integer;
+function sinc(x: Single): Single;
 procedure usage;
 function effectwav(const sp: SpParam): integer;
 
 implementation
 
 function effect8BitWav(const sp: SpParam): integer;
-var
-  i, delayStart: integer;
-  pMem, pCpy: array of Byte;
-  s: TMemoryStream;
-  L, R, DuetL, DuetR: SmallInt;
 begin
-  result := 0;
-  try
-    s := TMemoryStream.Create;
-    s.ReadBuffer(sp.pWav^, sp.sizeOfData);
-    pMem := sp.pWav;
-    pCpy := s.Memory;
-    delayStart := sp.samplePerSec * sp.cycleuSec;
-    for i := delayStart to sp.sizeOfData div (sp.bitsPerSample *
-      SizeOf(Byte)) do
-    begin
-      L := pMem[i + 0];
-      R := pMem[i + 1];
-      DuetL := pCpy[i + 0 - delayStart];
-      DuetR := pCpy[i + 1 - delayStart];
-      inc(L, DuetL);
-      inc(R, DuetR);
-      pMem[i+0]:=L;
-      pMem[i+1]:=R;
-    end;
-  except
-    result := -1;
-  end;
 end;
 
 function effect16BitWav(const sp: SpParam): integer;
+const
+  j = 24;
 var
-  i, delayStart: integer;
-  pMem, pCpy: array of SmallInt;
+  i, k, a, b, pmin, pmax: integer;
+  len, temp_size, offset0, offset1, p, q: integer;
+  m, ma, pitch, rate: Single;
+  pMem, pCpy, pRes: array of SmallInt;
   s: TMemoryStream;
-  L, R, DuetL, DuetR: SmallInt;
+  r: array of Single;
 begin
   result := 0;
   try
-    s := TMemoryStream.Create;
-    s.ReadBuffer(sp.pWav^, sp.sizeOfData);
-    pMem := sp.pWav;
-    pCpy := s.Memory;
-    delayStart := sp.samplePerSec * sp.cycleuSec;
-    for i := delayStart to sp.sizeOfData div (sp.bitsPerSample *
-      SizeOf(SmallInt)) do
+    temp_size := trunc(sp.samplePerSec * sp.bitsPerSample * sp.channels * 0.01);
+    pmin := trunc(sp.samplePerSec * sp.bitsPerSample * sp.channels * 0.005);
+    pmax := trunc(sp.samplePerSec * sp.bitsPerSample * sp.channels * 0.02);
+    SetLength(r, pmax - pmin);
+    offset0 := sp.posOfData;
+    offset1 := sp.posOfData;
+    rate := 0.66;
+    len := trunc(sp.sizeOfData / (rate * sp.channels));
+    SetLength(pCpy, len);
+    SetLength(pRes,len);
+    s:=TMemoryStream.Create;
+    s.Write(sp.pWav^,sp.sizeOfData);
+    s.Position:=0;
+    s.Read(Pointer(pRes)^,s.Size);
+    s.Free;
+    pMem:=sp.pWav;
+    k := (sp.sizeOfData - sp.posOfData) div sp.channels;
+    for b := 0 to pmax - pmin - 1 do
     begin
-      L := pMem[i + 0];
-      R := pMem[i + 1];
-      DuetL := pCpy[i + 0 - delayStart];
-      DuetR := pCpy[i + 1 - delayStart];
-      inc(L, DuetL);
-      inc(R, DuetR);
-      L := SmallInt(max(-32768, min(32767, L)));
-      R := SmallInt(max(-32768, min(32767, R)));
-      pMem[i + 0] := L;
-      pMem[i + 1] := R;
+      r[b] := 0.0;
+      for a := sp.posOfData to sp.posOfData + temp_size do
+        r[b] := r[b] + pMem[a] * pMem[a + b];
+      if r[b] > ma then
+      begin
+        ma := r[b];
+        p := b;
+      end;
+    end;
+    while offset1 + 2 * pmax < len do
+    begin
+      ma := 0.0;
+      p := pmin;
+      for i := 0 to p do
+      begin
+        pCpy[offset1 + i] := pRes[offset0 + i];
+        pCpy[offset1 + i + p] := trunc(pRes[offset0 + p + i] * (p - i) / p +
+          pRes[offset0 + i] * i / p);
+      end;
+      q := trunc(rate * p / (1.0 - rate) + 0.5);
+      for i := p to q - 1 do
+      begin
+        if offset1 + i + p >= k then
+          break;
+        pCpy[offset1 + p + i] := pMem[offset0 + i];
+      end;
+      inc(offset0, q);
+      inc(offset1, p + q);
+    end;
+    pitch := 1.5;
+    for i := sp.posOfData to k - 1 do
+    begin
+      m := pitch * i;
+      q := trunc(m);
+      for a := q - j div 2 to q + j div 2 do
+        if (a >= sp.posOfData) and (a < len) then
+          pMem[i] := pCpy[a] + pRes[a] * trunc(sinc(pi * (m - a)))
+        else
+          pMem[i] := 0;
     end;
   except
     result := -1;
   end;
+  Finalize(pRes);
+  Finalize(pCpy);
+  Finalize(r);
+end;
+
+function sinc(x: Single): Single;
+begin
+  if x = 0 then
+    result := 1.0
+  else
+    result := sin(x) / x;
 end;
 
 procedure usage;
@@ -86,7 +115,7 @@ begin
   if sp.channels = 1 then
   begin
     Writeln('\83X\83e\83\8c\83I\83t\83@\83C\83\8b\82É\82µ\82Ä\82­\82¾\82³\82¢');
-    result := -1;
+    // result := -1;
   end;
   if sp.bitsPerSample = 8 then
     result := effect8BitWav(sp)