mmfirflt.pas

一套及时通讯的原码

            Output[2*i+1] := -32768;
         end
         else Output[2*i+1] := s;
      end;
   end;

   {===========================================================================}
   procedure FIRSegSC(Input,Output: PSmallArray; Count,Channel: integer);
   var
      i,j,c: integer;
      sum: Double;
      s: Longint;

   begin
      c := Channel-1;

      for i := 0 to Count-1 do
      begin
         sum := 0;
         for j := pfir.nTaps-1 downto 0 do
         begin
             sum := sum + Input[2*(i+j)+c]*pfir.fTaps[j];
         end;

         s := Round(sum);

         if s > 32767 then
         begin
            Result := True;
            Output[2*i+c] := 32767;
         end
         else if s < -32768 then
         begin
            Result := True;
            Output[2*i+c] := -32768;
         end
         else Output[2*i+c] := s;
      end;
   end;

   {===========================================================================}
   procedure CopyData16(iChannel: integer; pIn,pOut: PSmallint; Len: Longint);
   var
      ci: integer;
   begin
      ci := iChannel+1;

      if (iChannel and CH_RIGHT = CH_RIGHT) then
      begin
         inc(pIn);
         inc(pOut);
         dec(Len,2);
         dec(ci);
      end;

      while Len > 0 do
      begin
         pOut^ := pIn^;
         inc(pOut,ci);
         inc(pIn,ci);
         dec(Len,2*ci);
      end;
   end;

begin
   { returns true on internal overflow }
   Result := False;
   if (pfir <> nil) and (pfir^.nTaps > 0) then
   with pfir^ do
   begin
      if (DataType and DT_STEREO = DT_STEREO) then    { stereo }
      begin
         Len := Len div 4;

         n := nTaps-1;
         if n > Len then n := Len;

         if (Channel = CH_BOTH) then
         begin
            { both channels }
            FillDLine(@DLine[2*(nTaps-1)],Pointer(BufIn),2*n);

            FIRSegSB(@DLine,Pointer(BufOut),n);

            FIRSegSB(Pointer(BufIn),Pointer(BufOut+4*n),Len-n);

            if n < nTaps-1 then
               FillDLine(@DLine[0],@DLine[2*n],2*(nTaps-n))
            else
               FillDLine(@DLine[0],Pointer(PChar(BufIn)+4*(Len-n)),2*(nTaps-1));
         end
         else
         begin
            { one channel only }
            FillDLine(@DLine[2*(nTaps-1)],Pointer(BufIn),2*n);

            FIRSegSC(@DLine,Pointer(BufOut),n,Channel);

            FIRSegSC(Pointer(BufIn),Pointer(BufOut+4*n),Len-n,Channel);

            if n < nTaps-1 then
               FillDLine(@DLine[0],@DLine[2*n],2*(nTaps-n))
            else
               FillDLine(@DLine[0],Pointer(PChar(BufIn)+4*(Len-n)),2*(nTaps-1));

            if (Channel and CH_LEFT = CH_LEFT) then
                CopyData16(CH_RIGHT,Pointer(BufIn),Pointer(BufOut),4*Len)
            else
                CopyData16(CH_LEFT,Pointer(BufIn),Pointer(BufOut),4*Len);
         end;
      end
      else                                            { Mono        }
      begin
         Len := Len div 2;

         n := nTaps-1;
         if n > Len then n := Len;

         FillDLine(@DLine[nTaps-1],Pointer(BufIn),n);

         FIRSegM(@DLine,Pointer(BufOut),n);

         FIRSegM(Pointer(BufIn),Pointer(BufOut+2*n),Len-n);

         if n < nTaps-1 then
             FillDLine(@DLine[0],@DLine[n],nTaps-n)
         else
             FillDLine(@DLine[0],Pointer(PChar(BufIn)+2*(Len-n)),nTaps-1);
      end;
   end;
end;
{$ENDIF}

{==============================================================================}
{$IFDEF USEASM}
{$F+}
procedure DoFIRFilterFloat(pfir: PFIRFilter; BufIn, BufOut: PFloatArray; Len: Longint); external;
{$F-}
{$ELSE}
procedure DoFIRFilterFloat(pfir: PFIRFilter; BufIn, BufOut: PFloatArray; Len: Longint);
var
   n: Longint;
   DLineF: PFloatArray;

   {===========================================================================}
   procedure FillDLine(DLine,Input: PFloatArray; Count: integer);
   var
      i: integer;
   begin
      for i := 0 to Count-1 do DLine[i]:= Input[i];
   end;

   {===========================================================================}
   procedure FIRSegM(Input,Output: PFloatArray; Count: integer);
   var
      i,j: integer;
      sum: Double;

   begin
      for i := 0 to Count-1 do
      begin
         sum := 0;
         for j := pfir.nTaps-1 downto 0 do
             sum := sum + Input[i+j]*pfir.fTaps[j];

         Output[i] := sum;
      end;
   end;

   {===========================================================================}
   procedure FIRSegSB(Input,Output: PFloatArray; Count: integer);
   var
      i,j: integer;
      sum,sum2: Double;

   begin
      for i := 0 to Count-1 do
      begin
         sum := 0;
         sum2:= 0;
         for j := pfir.nTaps-1 downto 0 do
         begin
             sum := sum + Input[2*(i+j)]*pfir.fTaps[j];
             sum2:= sum2 + Input[2*(i+j)+1]*pfir.fTaps[j];
         end;
         Output[2*i]   := sum;
         Output[2*i+1] := sum2;
      end;
   end;

   {===========================================================================}
   procedure FIRSegSC(Input,Output: PFloatArray; Count,Channel: integer);
   var
      i,j,c: integer;
      sum: Double;

   begin
      c := Channel-1;

      for i := 0 to Count-1 do
      begin
         sum := 0;
         for j := pfir.nTaps-1 downto 0 do
         begin
             sum := sum + Input[2*(i+j)+c]*pfir.fTaps[j];
         end;
         Output[2*i+c] := sum;
      end;
   end;

   {===========================================================================}
   procedure CopyData16(iChannel: integer; pIn,pOut: PFloat; Len: Longint);
   var
      ci: integer;
   begin
      ci := iChannel+1;

      if (iChannel and CH_RIGHT = CH_RIGHT) then
      begin
         inc(pIn);
         inc(pOut);
         dec(Len,sizeOf(Float));
         dec(ci);
      end;

      while Len > 0 do
      begin
         pOut^ := pIn^;
         inc(pOut,ci);
         inc(pIn,ci);
         dec(Len,sizeOf(Float)*ci);
      end;
   end;

begin
   { returns true on internal overflow }
   if (pfir <> nil) and (pfir^.nTaps > 0) then
   with pfir^ do
   begin
      DLineF := @pfir.DLine;
      
      if (DataType and DT_STEREO = DT_STEREO) then    { stereo }
      begin
         Len := Len div 2*sizeOf(Float);

         n := nTaps-1;
         if n > Len then n := Len;

         if (Channel = CH_BOTH) then
         begin
            { both channels }
            FillDLine(@DLineF[2*(nTaps-1)],BufIn,2*n);

            FIRSegSB(DLineF,Pointer(BufOut),n);

            FIRSegSB(BufIn,@BufOut[2*n],Len-n);

            if n < nTaps-1 then
               FillDLine(DLineF,@DLineF[2*n],2*(nTaps-n))
            else
               FillDLine(DLineF,Pointer(PChar(BufIn)+2*sizeOf(Float)*(Len-n)),2*(nTaps-1));
         end
         else
         begin
            { one channel only }
            FillDLine(@DLineF[2*(nTaps-1)],BufIn,2*n);

            FIRSegSC(DLineF,BufOut,n,Channel);

            FIRSegSC(BufIn,@BufOut[2*n],Len-n,Channel);

            if n < nTaps-1 then
               FillDLine(DLineF,@DLineF[2*n],2*(nTaps-n))
            else
               FillDLine(DLineF,@BufIn[2*(Len-n)],2*(nTaps-1));

            if (Channel and CH_LEFT = CH_LEFT) then
                CopyData16(CH_RIGHT,@BufIn[0],@BufOut[0],2*sizeOf(Float)*Len)
            else
                CopyData16(CH_LEFT,@BufIn[0],@BufOut[0],2*sizeOf(Float)*Len);
         end;
      end
      else                                            { Mono        }
      begin
         Len := Len div sizeOf(Float);

         n := nTaps-1;
         if n > Len then n := Len;

         FillDLine(@DLineF[nTaps-1],BufIn,n);

         FIRSegM(DLineF,BufOut,n);

         FIRSegM(BufIn,@BufOut[n],Len-n);

         if n < nTaps-1 then
             FillDLine(DLineF,@DLineF[n],nTaps-n)
         else
             FillDLine(DLineF,@BufIn[Len-n],nTaps-1);
      end;
   end;
end;
{$ENDIF}

end.