mmfx.pas

一套及时通讯的原码

         end;
         DLineSize := 2048;
         while i > 0 do
         begin
            DLineSize := DLineSize shl 1;
            dec(i);
         end;

         DLine := GlobalAllocMem(2*DLineSize);
         if (DLine = nil) then
         begin
            DonePhaser(Result);
         end;
      end;
   end;
end;

{========================================================================}
procedure DonePhaser(var pph: PPhaser);
begin
   if (pph <> nil) then
   begin
      GlobalFreeMem(Pointer(pph^.DLine));
      GlobalFreeMem(Pointer(pph));
   end;
end;

{========================================================================}
procedure SetPhaser(pph: PPhaser; iDelay: integer; iChannel: integer);
var
   Silence: integer;

begin
   if (pph <> nil) then
   begin
      with pph^ do
      begin
         Delay := Min(iDelay,MaxDelay);
         Channel := iChannel;
         if (DLineSize > 0) then
         begin
            if (DataType and DT_16BIT = DT_16BIT) then
                Silence := 0
            else
                Silence := 128;

            FillChar(DLine^,2*DLineSize,Silence);      { Clear delay line }
         end;
                                                       { Adjust phaser }
         Position := DLineSize-Long(SampleRate)*Delay div 1000-1;
         DLinePos := -1;
         if RealTime then Started := True;
      end;
   end;
end;

{========================================================================}
{$IFDEF USEASM}
{$L MMPHASL.OBJ}
{$F+}
procedure DoPhaser(pph: PPhaser; Buf: PChar; Len: Longint); external;
{$F-}
{$ELSE}
procedure DoPhaser(pph: PPhaser; Buf: PChar; Len: Longint);
var
   pW: PSmallInt;
   pB: PByte;
   mask: integer;

begin
   if (pph <> nil) and (pph^.Delay > 0) and
      (pph^.DataType and DT_STEREO = DT_STEREO) and
      (pph^.Channel <> 0) then
   with pph^ do
   begin
      mask := DLineSize-1;
      if (DataType and DT_16BIT = DT_16BIT) then { 16-bit }
      begin
         Len := (Len div 4) * 4;
         pW := PSmallInt(Buf);
         if (Channel and CH_RIGHT = CH_RIGHT) then inc(pW);
         while Len > 0 do
         begin
            DLinePos := (DLinePos+1) and mask;
            DLine^[DLinePos] := pW^;

            Position := (Position + 1) and mask;

            if not Started then pW^ := DLine^[Position]
            else if (Position = 0) then Started := False;

            inc(pW,2);
            dec(Len,2*sizeOf(SmallInt));
         end;
      end
      else                               { 8 bit }
      begin
         Len := Len and $FFFE;
         pB := PByte(Buf);
         if (Channel and CH_RIGHT = CH_RIGHT) then inc(pB);
         while (Len > 0) do
         begin
            DLinePos := (DLinePos+1) and mask;
            DLine^[DLinePos] := pB^;

            Position := (Position + 1) and mask;

            if not Started then pB^ := DLine^[Position]
            else if (Position = 0) then Started := False;

            inc(pB,2);
            dec(Len,2*sizeOf(Byte));
         end;
      end;
   end;
end;
{$ENDIF}

{========================================================================}
{ -- PhaseShift --                                                       }
{                                                                        }
{    Digital version of the popular '70s effect.  This one               }
{    does 4 stages just like old MXR Phase 90 stompbox.                  }
{========================================================================}
function InitPhaseShift(pwfx: PWaveFormatEx): PPhaseShift;
begin
   Result := GlobalAllocMem(SizeOf(TPhaseShift));
   if (Result <> nil) then
   begin
      with Result^ do
      begin
         DataType  := GetDataType(pwfx);
         SampleRate:= pwfx^.nSamplesPerSec;
         DryMix    := 50 * 256 div 100;
         WetMix    := 50 * 256 div 100;
      end;
   end;
end;

{========================================================================}
procedure DonePhaseShift(var pps: PPhaseShift);
begin
   if (pps <> nil) then
   begin
      GlobalFreeMem(Pointer(pps));
   end;
end;

{========================================================================}
procedure SetPhaseShift(pps: PPhaseShift; iDry,iWet,iFeedBack: Longint;
                        iSweep,iDepth,iRate: Float);
var
   Range: Float;

begin
   if (pps <> nil) then
   begin
      with pps^ do
      begin
         FeedBack:= iFeedBack * 256 div 100;
         DryMix  := iDry * 256 div 100;
         WetMix  := iWet * 256 div 100;
         Sweep   := iSweep;
         Depth   := iDepth;

         { calc params for sweeping filters }
         Range := pow(2.0, iDepth);
         Max_wp := (M_PI * iSweep * Range) / SampleRate;
         Min_wp := (M_PI * iSweep) / SampleRate;
         wp := Min_wp;
         Rate := pow(Range, iRate / (SampleRate / 2));
         SweepFact := Rate;

         { reset some things }
         inL1  := 0;
         inL2  := 0;
         inL3  := 0;
         inL4  := 0;
         outL1 := 0;
         outL2 := 0;
         outL3 := 0;
         outL4 := 0;
      end;
   end;
end;

{========================================================================}
function DoPhaseShift(pps: PPhaseShift; Buf: PChar; Len: Longint): Boolean;
var
   pW: PSmallInt;
   pB: PByte;
   coef: Longint;
   inval,outval: Longint;

begin
   Result := False;
   if (pps <> nil) then
   with pps^ do
   begin
      if (DataType and DT_STEREO = DT_STEREO) then  { stereo }
      begin
         if (DataType and DT_16BIT = DT_16BIT) then { 16-bit }
         begin
            pW := PSmallInt(Buf);
            while Len > 0 do
            begin
               { calc coef for current freq }
               coef := Trunc(8192*(1.0- wp)/(1.0 + wp));

               inval := pW^ + sar(outL4 * Feedback,8);

               { do 1st filter }
               outL1 := sar(coef*(outL1 + inval),13) - inL1;
               inL1 := inval;

               { do 2nd filter }
               outL2 := sar(coef*(outL2 + outL1),13) - inL2;
               inL2 := outL1;

               { do 3rd filter }
               outL3 := sar(coef*(outL3 + outL2),13) - inL3;
               inL3 := outL2;

               { do 4th filter }
               outL4 := sar(coef*(outL4 + outL3),13) - inL4;
               inL4 := outL3;

               { develop final output mix }
               outval := sar(outL4*WetMix,8);
               outval := outval+ sar(inval*DryMix,8);

               { clip output if necessary }
               if (outval > 32767) then
               begin
                  pW^ := 32767;
                  Result := True;
               end
               else if (outval < -32768) then
               begin
                  pW^ := -32768;
                  Result := True;
               end
               else pW^ := outval;

               inc(pW);

               inval := pW^+ sar(outR4 * Feedback,8);

               { do 1st filter }
               outR1 := sar(coef*(outR1 + inval),13) - inR1;
               inR1 := inval;

               { do 2nd filter }
               outR2 := sar(coef*(outR2 + outR1),13) - inR2;
               inR2 := outR1;

               { do 3rd filter }
               outR3 := sar(coef*(outR3 + outR2),13) - inR3;
               inR3 := outR2;

               { do 4th filter }
               outR4 := sar(coef*(outR4 + outR3),13) - inR4;
               inR4 := outR3;

               { develop final output mix }
               outval := sar(outR4*WetMix,8) + sar(inval*DryMix,8);

               { clip output if necessary }
               if (outval > 32767) then
               begin
                  pW^ := 32767;
                  Result := True;
               end
               else if (outval < -32768) then
               begin
                  pW^ := -32768;
                  Result := True;
               end
               else pW^ := outval;

               inc(pW);

               wp := wp * SweepFact;         { adjust freq of filters }
               if (wp > Max_wp) then         { max?                   }
                  SweepFact := 1.0/Rate      { sweep back down        }
               else if (wp < Min_wp) then    { min?                   }
                  SweepFact := Rate;         { sweep back up          }

               dec(Len,2*sizeOf(SmallInt));
            end;
         end
         else
         begin
            pB := PByte(Buf);
            while Len > 0 do
            begin
               { calc coef for current freq }
               coef := Trunc(8192*(1.0 - wp)/(1.0 + wp));

               inval := (pB^-128)shl 8 + sar(outL4 * Feedback,8);

               { do 1st filter }
               outL1 := sar(coef*(outL1 + inval),13) - inL1;
               inL1 := inval;

               { do 2nd filter }
               outL2 := sar(coef*(outL2 + outL1),13) - inL2;
               inL2 := outL1;

               { do 3rd filter }
               outL3 := sar(coef*(outL3 + outL2),13) - inL3;
               inL3 := outL2;

               { do 4th filter }
               outL4 := sar(coef*(outL4 + outL3),13) - inL4;
               inL4 := outL3;

               { develop final output mix }
               outval := sar(outL4*WetMix,8) + sar(inval*DryMix,8);

               { clip output if necessary }
               if (outval > 32767) then
               begin
                  pW^ := 32767;
                  Result := True;
               end
               else if (outval < -32768) then
               begin
                  pW^ := -32768;
                  Result := True;
               end
               else pW^ := outval;

               pB^ := (outval shr 8)+128;
               inc(pB);

               inval := (pB^-128)shl 8 + sar(outR4 * Feedback,8);

               { do 1st filter }
               outR1 := sar(coef*(outR1 + inval),13) - inR1;
               inR1 := inval;

               { do 2nd filter }
               outR2 := sar(coef*(outR2 + outR1),13) - inR2;
               inR2 := outR1;

               { do 3rd filter }
               outR3 := sar(coef*(outR3 + outR2),13) - inR3;
               inR3 := outR2;

               { do 4th filter }
               outR4 := sar(coef*(outR4 + outR3),13) - inR4;
               inR4 := outR3;

               { develop final output mix }
               outval := sar(outR4*WetMix,8) + sar(inval*DryMix,8);

               { clip output if necessary }
               if (outval > 32767) then
               begin
                  pW^ := 32767;
                  Result := True;
               end
               else if (outval < -32768) then
               begin
                  pW^ := -32768;
                  Result := True;
               end
               else pW^ := outval;

               pB^ := (outval shr 8)+128;
               inc(pB);

               wp := wp * SweepFact;         { adjust freq of filters }
               if (wp > Max_wp) then         { max?                   }
                  SweepFact := 1.0/Rate      { sweep back down        }
               else if (wp < Min_wp) then    { min?                   }