mmstretch.pas

P2P即时通讯源码(DELPHI编写)

   FEnabled     := True;
   FOpen        := False;
   FWriteBuffer := nil;
   FFirstRead   := True;
   //SetPitch(0.0);
end;

{-- TMMTimeStretch ------------------------------------------------------------}
destructor TMMTimeStretch.Destroy;
begin
   Close;

   inherited Destroy;
end;

{-- TMMTimeStretch ------------------------------------------------------------}
procedure TMMTimeStretch.SetEnabled(aValue: Boolean);
begin
   if (aValue <> FEnabled) then
   begin
      FEnabled := aValue;
      if FEnabled then Reset;
   end;
end;

(*
{-- TMMTimeStretch ------------------------------------------------------------}
procedure TMMTimeStretch.SetPitch(aValue: Float);
begin
//   FPitch := MinMaxR(aValue,-50.0,+50.0);
//   FPitchInc := Trunc((FPitch+50)*65536/100+32768);
end;
*)

{-- TMMTimeStretch ------------------------------------------------------------}
procedure TMMTimeStretch.SetPWaveFormat(aValue: PWaveFormatEx);
begin
   if (aValue <> nil) then
   begin
      if not (csDesigning in ComponentState) then
         if not pcmIsValidFormat(aValue) or (aValue^.wBitsPerSample = 8) then
            raise EMMTimeStretchError.Create(LoadResStr(IDS_INVALIDFORMAT));
   end;
   inherited SetPWaveFormat(aValue);
end;

{-- TMMTimeStretch ------------------------------------------------------------}
procedure TMMTimeStretch.Open;
begin
   if not FOpen then
   begin
      FRealBufSize               := Max(BufferSize,Max(QUEUE_READ_SIZE,BufferSize));
      FWaveHdr.wh.dwBufferLength := 2*FRealBufSize;
      FWaveHdr.wh.lpData         := GlobalAllocMem(FWaveHdr.wh.dwBufferLength);
      FWriteBuffer               := GlobalAllocMem(FRealBufSize);
      FFirstRead                 := True;
      FOpen                      := True;
   end;
end;

{-- TMMTimeStretch ------------------------------------------------------------}
procedure TMMTimeStretch.Close;
begin
   if FOpen then
   begin
      FOpen := False;
      GlobalFreeMem(Pointer(FWaveHdr.wh.lpData));
      GlobalFreeMem(Pointer(FWriteBuffer));
   end;
end;

{-- TMMTimeStretch ------------------------------------------------------------}
procedure TMMTimeStretch.Reset;
begin
   if FOpen then
   begin
      FWaveHdr.wh.dwBytesRecorded := 0;
      FWaveHdr.LoopRec.dwLooping  := False;
      FBytesRead    := 0;
      FBytesWritten := 0;
      FFirstRead    := True;
      FDone         := False;
   end;
end;

{-- TMMTimeStretch ------------------------------------------------------------}
procedure TMMTimeStretch.Opened;
begin
   Open;

   inherited Opened;
end;

{-- TMMTimeStretch ------------------------------------------------------------}
procedure TMMTimeStretch.Closed;
begin
   Close;

   inherited Closed;
end;

{-- TMMTimeStretch ------------------------------------------------------------}
procedure TMMTimeStretch.Reseting;
begin
   Reset;

   inherited Reseting;
end;

{-- TMMTimeStretch ------------------------------------------------------------}
procedure TMMTimeStretch.Started;
begin
   Reset;

   inherited Started;
end;

{-- TMMTimeStretch ------------------------------------------------------------}
function TMMTimeStretch.ReadData(Buffer: PChar; dwLength: Longint; var MoreData: Boolean): Longint;
Label _Again;
var
   nRead,nBytes: Longint;
begin
   nRead := 0;
   MoreData := False;
   with FWaveHdr.wh do
   begin
_Again:
      nBytes := dwBytesRecorded - FBytesRead;
      if (nBytes > 0) then
      begin
         nBytes := Min(nBytes,dwLength);
         GlobalMoveMem((FWaveHdr.wh.lpData+FBytesRead)^,(Buffer+nRead)^,nBytes);

         inc(nRead,nBytes);
         inc(FBytesRead,nBytes);
         dec(dwLength,nBytes);
      end;

      { do we need more data ? }
      if (dwLength > 0) and not FDone then
      begin
         dwBytesRecorded := 0;

         (*
         // TODO: LoopHandling !!!!
         if FWaveHdr.LoopRec.dwLooping then
         begin
            PMMWaveHdr(lpwh)^.LoopRec.dwLooping := True;
            PMMWaveHdr(lpwh)^.LoopRec.dwLoopTmpCnt := FWaveHdr.LoopRec.dwLoopTmpCnt;
            FWaveHdr.LoopRec.dwLooping := False;
         end;

         FWaveHdr.LoopRec.dwLoop := PMMWaveHdr(lpwh)^.LoopRec.dwLoop;
         if FWaveHdr.LoopRec.dwLoop then
         begin
            FWaveHdr.LoopRec.dwLoopCnt    := PMMWaveHdr(lpwh)^.LoopRec.dwLoopCnt;
            FWaveHdr.LoopRec.dwLoopTmpCnt := PMMWaveHdr(lpwh)^.LoopRec.dwLoopTmpCnt;
            FWaveHdr.LoopRec.dwLooping    := False;
         end;
         *)

         FMoreBuffers := False;
         inherited BufferLoad(@FWaveHdr,FMoreBuffers);

         if not FMoreBuffers or (dwBytesRecorded <= 0) then FDone := True;

         FBytesRead := 0;

         if (dwBytesRecorded > 0) then goto _Again;
      end;
      MoreData := FMoreBuffers or (dwBytesRecorded-FBytesRead > 0);
   end;
   Result := nRead;
end;

{-- TMMTimeStretch ------------------------------------------------------------}
function TMMTimeStretch.WriteData(Buffer: PChar; dwLength: Longint): Longint;
begin
   GlobalMoveMem(Buffer^,(FWriteBuffer+FBytesWritten)^,dwLength);
   inc(FBytesWritten,dwlength);
   Result := FBytesWritten;
end;

{-- TMMTimeStretch ------------------------------------------------------------}
procedure TMMTimeStretch.ReadFromInput(lpwh: PWaveHdr; var MoreBuffers: Boolean);
var
   i: integer;
   nBytes: Longint;
   HasMoreData: Boolean;
begin
   if (Input <> nil) then
   begin
      // TODO: wenn geskippt wird weil keine pitch 膎derung dann aufpassen das MoreBuffers richtig gesetzt wird
      HasMoreData := True;
   //   lpwh.dwBytesRecorded := ReadData(lpwh^.lpData,lpwh.dwBufferLength,MoreBuffers);

      total := length + pitmax;
      if (rate >= 1.0) then
      begin
         // TODO:rate darf nicht 1.0 sein, also bei rate := 1.0 skippen
         rcomp := 1.0  / (rate - 1.0);
      end
      else if (rate > 0) then
      begin
         rcomp := rate / (1.0 - rate);
      end
      else
      begin
         //	fprintf(stderr, "Error from %s: illeagal compansion rate!\n", argv[0]);
         //	exit(0);
      end;

      //------------------- body ---------------
      // Todo: nur bei Initial read
      if FFirstRead then
      begin
         wantread := total;
         nread := ReadData(@_is, 2*wantread, HasMoreData) div 2;
         FFirstRead := False;
      end;

      while (nread = wantread) and (FBytesWritten < lpwh.dwBufferLength) do
      begin
         //---- pitch extraction ----
         pitch := amdfpitch(pitmin, pitmax, length, _is);

         //---- PICOLA OverLap and ADD stage ----//

         if (rate < 1.0) then
         begin
            ola(pitch, @_is, @_is[pitch]);
            point := pitch;
         end
         else
         begin
            WriteData(@_is, 2*pitch);
            ola(pitch, @_is[pitch], @_is);
	    point := 0;
         end;

         //---- compensate compansion rate ----*/

         sl := pitch * rcomp;
         lcp := trunc(sl);
         err := err + lcp - sl;

         if (err >= 0.5) then
         begin
            dec(lcp);
            err := err - 1.0;
         end
         else if (err <= -0.5) then
         begin
       	    inc(lcp);
            err := err + 1.0;
         end;
         lproc := lproc + pitch;

         //---- PICOLA Pointer Interval Control (PIC) stage ----*/

	 wantread := point + lcp;
	 if (wantread > total) then
         begin
            wantread := total - point;
	    WriteData(@_is[point], 2*wantread);
	    lcp := lcp - wantread;
	    wantread := total;
	    while (lcp > 0) do
            begin
               if (lcp <= total) then
               begin
                  wantread := lcp;
	          nread := ReadData(@_is, 2*wantread,HasMoreData)div 2;
	          WriteData(@_is, 2*nread);
	          if (nread <> wantread) then
                      break;
	    	  wantread := total;
	    	  nread := ReadData(@_is, 2*wantread,HasMoreData)div 2;
               end
               else
               begin
                  nread := ReadData(@_is, 2*wantread,HasMoreData)div 2;
	          WriteData(@_is, 2*nread);
	          if (nread <> wantread) then
	              break;
               end;
               lcp := lcp - total;
            end;
         end
         else
         begin
            WriteData(@_is[point], 2*lcp);
	    point := total - wantread;
	    // shift to next pitch period

	    for i := 0 to point-1 do
            begin
               _is[i] := _is[i+wantread];
            end;
            nread := ReadData(@_is[point], 2*wantread,HasMoreData)div 2;
         end;
      end;

      if not HasMoreData then
      begin
         // write rest */
         WriteData(@_is, 2*(total - wantread + nread));
      end;

      nBytes := Min(FBytesWritten,lpwh.dwBufferLength);
      GlobalMoveMem(FWriteBuffer^,lpwh^.lpData^,nBytes);
      GlobalMoveMem((FWriteBuffer+nBytes)^,FWriteBuffer^,FBytesWritten-nBytes);
      dec(FBytesWritten,nBytes);
      lpwh^.dwBytesRecorded := nBytes;
      MoreBuffers := HasMoreData or (FBytesWritten > 0);
   end
   else lpwh^.dwBytesRecorded := 0;
end;

{-- TMMTimeStretch ------------------------------------------------------------}
procedure TMMTimeStretch.BufferReady(lpwh: PWaveHdr);
begin
   if Enabled and FOpen then
   begin
      { TODO: Pitch f黵 recording schreiben }
   end;
   inherited BufferReady(lpwh);
end;

{-- TMMTimeStretch ------------------------------------------------------------}
procedure TMMTimeStretch.BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean);
begin
   // TODO: wenn Enabled auf False gesetzt wird dann ev. noch im Puffer befindliche Daten abspielen.
   if Enabled and FOpen {and ((FPitchInc <> $10000) or (FWaveHdr.wh.dwBytesRecorded - FBytesRead > 0))} then
   begin
      ReadFromInput(lpwh,MoreBuffers);
   end
   else inherited BufferLoad(lpwh, MoreBuffers);
end;

end.