From 59525eee1ab0446f9d81293307eba4bdb0c0d528 Mon Sep 17 00:00:00 2001
From: yamat0jp <yamat0jp@yahoo.co.jp>
Date: Fri, 18 May 2018 18:20:22 +0900
Subject: [PATCH] =?utf8?q?=E3=81=A8=E3=81=A6=E3=82=82=E9=9B=A3=E3=81=97?=
 =?utf8?q?=E3=81=84=E6=A6=82=E5=BF=B5=E3=81=8C=E5=87=BA=E3=81=A6=E3=81=8D?=
 =?utf8?q?=E3=81=BE=E3=81=99=20=E5=8B=95=E4=BD=9C=E3=81=97=E3=81=A6?=
 =?utf8?q?=E3=81=84=E3=81=BE=E3=81=9B=E3=82=93?=
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

---
 effect.pas   | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++--------
 wav_proj.dpr | 15 +-------------
 2 files changed, 60 insertions(+), 23 deletions(-)

diff --git a/effect.pas b/effect.pas
index 3b9e699..4366d94 100644
--- a/effect.pas
+++ b/effect.pas
@@ -24,9 +24,10 @@ begin
   result := 0;
   try
     s := TMemoryStream.Create;
-    s.ReadBuffer(sp.pWav^, sp.sizeOfData);
+    s.Write(sp.pWav^, sp.sizeOfData);
+    s.Position := 0;
+    s.Read(Pointer(pCpy)^, sp.sizeOfData);
     pMem := sp.pWav;
-    pCpy := s.Memory;
     i := sp.posOfData;
     k := 8 * sp.sizeOfData / sp.bitsPerSample;
     while i < k do
@@ -39,16 +40,18 @@ begin
   except
     result := -1;
   end;
+  s.Free;
+  Finalize(pCpy);
 end;
 
 function effect16BitWav(const sp: SpParam): integer;
 const
-  depth = 1.0;
-  rate = 170.0;
+  j = 24;
 var
-  i: integer;
-  k, m: Single;
+  i, a, b, pmin, pmax, temp_size, offset0, offset1, p, q: integer;
+  k, m, max, pitch, rate: Single;
   pMem, pCpy: array of SmallInt;
+  r: array of Single;
   s: TMemoryStream;
 begin
   result := 0;
@@ -61,16 +64,63 @@ begin
     pMem := sp.pWav;
     i := sp.posOfData;
     k := 8 * sp.sizeOfData / sp.bitsPerSample;
+    temp_size := trunc(sp.samplePerSec * 0.01);
+    pmin := trunc(sp.samplePerSec * sp.bitsPerSample * 0.005);
+    pmax := trunc(sp.samplePerSec * sp.bitsPerSample * 0.02);
+    SetLength(r, pmax - pmin);
+    offset0 := sp.posOfData;
+    offset1 := sp.posOfData;
+    rate := 1.5;
+    while offset0 + pmax * 2 < sp.sizeOfData do
+    begin
+      max := 0.0;
+      p := pmin;
+      for b := pmin to pmax do
+      begin
+        r[b] := 0.0;
+        for a := sp.posOfData to sp.posOfData + temp_size do
+          r[b] := r[b] + pMem[a] * pCpy[a + b];
+        if r[b] > max then
+        begin
+          max := r[b];
+          p := b;
+        end;
+      end;
+      for i := 0 to p do
+      begin
+        pMem[offset1 + i] := trunc(pCpy[offset0 + i]);
+        pMem[offset1 + i + p] := trunc(pCpy[offset0 + i + p] * (p - i) / p) +
+          trunc(pCpy[offset0 + p + i] * i / p);
+      end;
+      inc(offset0, q);
+      inc(offset1, p + q);
+    end;
+    q := trunc(p / (rate - 1) + 0.5);
+    for i := p to q do
+    begin
+      if offset0 + p + i > sp.sizeOfData then
+        break;
+      pMem[offset1 + p + i] := pCpy[offset0 + i];
+    end;
+    pitch := 0.66;
     while i < k do
     begin
-      m := depth * sin(2 * rate * pi * i / sp.samplePerSec);
-      pMem[i + 0] := trunc(m * pMem[i + 0]);
-      pMem[i + 1] := trunc(m * pMem[i + 1]);
+      m := pitch * i;
+      q := trunc(m);
+      for a := q - j div 2 to q + j div 2 do
+        if (m >= sp.posOfData) and (m < sp.sizeOfData) then
+        begin
+          pMem[a + 0] := trunc(pMem[a + 0] + pCpy[a + 0] *
+            ArcSin(pi * (m - a)));
+          pMem[a + 1] := trunc(pMem[a + 1] + pCpy[a + 1] *
+            ArcSin(pi * (m - a)));
+        end;
       inc(i, 2);
     end;
   except
     result := -1;
   end;
+  Finalize(r);
   s.Free;
   Finalize(pCpy);
 end;
diff --git a/wav_proj.dpr b/wav_proj.dpr
index a59ce19..c710e44 100644
--- a/wav_proj.dpr
+++ b/wav_proj.dpr
@@ -17,15 +17,6 @@ var
   pMem: TMemoryStream;
   fileName: string;
 
-function getPara(var sp: SpParam): integer;
-var
-  i: integer;
-begin
-  sp.pWav:=pMem.Memory;
-  sp.cyclicSec:=i;
-  result:=0;
-end;
-
 begin
   try
     { TODO -oUser -cConsole ƒƒCƒ“ : ‚±‚±‚ɃR[ƒh‚ð‹Lq‚µ‚Ä‚­‚¾‚³‚¢ }
@@ -34,11 +25,7 @@ begin
       Exit;
     if readWav(ParamStr(1), pMem) = false then
       Exit;
-    if getPara(sp) = -1 then
-    begin
-      pMem.Free;
-      Exit;
-    end;
+    sp.pWav := pMem.Memory;
     if effectWav(sp) = 0 then
     begin
       PlaySound(pMem.Memory, 0, SND_ASYNC or SND_NODEFAULT or SND_MEMORY);
-- 
2.11.0