fxalgo.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: [phone]                   =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 20.01.1998 - 18:00:00 $                                      =}
{========================================================================}
unit Fxalgo;

interface

const
     BFSZ     = 4096    { main delay buffer }
     MAX_XTAB = 512;    { crossfade lookup table size for pitch change }

type
    // program description struct
    TProgram = record
       Name: String;        // ASCII name of program */
       dry_mix: Double;     // dry (unaffected) signal mix */
       wet_mix: Double;     // wet (affected) signal mix */
       feedback: Double;    // feedback */
       rate    : Double;    // usually rate of sweep */
       depth   : Double;    // width of sweep */
       delay   : Double;    // fixed delay factor (base pitch for phaser) */
    end;

    // handy typedefs
    Tbw = record
        case integer of
           1: b: array [0..1] of Byte;
           2: w: word;
        end;
    end;

    Twl = record
        case integer of
           1: w: array [0..1] of Word;
           2: l: Longint;
        end;
    end;

implementation

// macros for pitch_change delay index manipulation
procedure inc_index(var x: integer);
begin
   x := (x + 1) and (BFSZ - 1);
end;

procedure inc_indexes(var x1,x2: integer);
begin
   x2 := x1;
   inc_index(x1);
end;

(*// table of programs (it's very easy to modify and add programs)
var
   struct program programs[] = {
         /*  Name/vector      Dry     Wet   Feedback Rate    Depth   Delay */
     "Echoes", flange_chorus,  0.999,  0.999,  0.7,    0.0,    0.0,    250.0},
{"Slow flange",flange_chorus,  0.999,  0.999,  0.0,    2.0,    6.0,    0.0},
{ "Slow invert flange w FB",
                flange_chorus,  0.999,  -0.999, -0.7,   2.0,    6.0,    0.0},
{ "Slow chorus",flange_chorus,  0.999,  0.999,  0.0,    11.0,   20.0,   20.0},
{ "Cheesy \"take me to your leader\" robot voice",
                  flange_chorus,  0.0,    0.999,  0.75,   0.0,    0.0,    12.5},
{ "Crazy pitch bend chorus",
                   flange_chorus,  0.999,  0.999,  0.3,    150.0,  40.0,   40.0},

{ "Darth",pitch_change,            0.0,    0.999,  0.0,    -0.35,  25.0,   0.0},
{ "Major third up", pitch_change,  0.999,  0.999,  0.0,    0.2599, 35.0,   0.0},
{ "Octave up",pitch_change,        0.999,  0.999,  0.0,    1.0,    40.0,   0.0},
{ "Munchkins on helium",pitch_change,0.0,  0.999,  0.4,    0.3348, 35.0,   0.0},
{ "Descending echoes",pitch_change, 0.0,   0.999,  0.5,    -0.2,   35.0,   120.0},
{ "Ascending echoes",pitch_change,  0.0,   0.999,  0.4,    0.2599, 35.0,   120.0},

{ "Phase shift", phase_shift,       0.999,  0.999, 0.0,    1.0,    4.0,    100.0},
{ "Slow invert phase shift with feedback",
                   phase_shift,    0.999,  -0.999, -0.6,   0.2,    6.0,    100.0},
{ "Noise gate",    noise_gate,     NA,     NA,     NA,     500.0,  0.05,   NA},
{ "Straight Thru", thru,           NA,     NA,     NA,     NA,     NA,     NA},
};
*)

//#define NPROGS (sizeof(programs) / sizeof(struct program))

// globals
var
   SampleRate: Longint;            // sample rate set by init_1848 */
   Buf: array[0..BFSZ-1] of Double;// buffer used by delay based effects */


(*=======================================================================
                                noise_gate

    Super simple noise gate to demonstrate how much of the hiss
    comes directly from the ADC on this card, but how quiet the
    DACs are by comparison.

    Only parms are:
        rate        decay time in ms
        depth       threshold for turn on
========================================================================*)
procedure noise_gate(p: PProgram);
var
   inval,decay_fac,gain: Double;
   data: tbw;
   scan: Longint;

begin
    gain := 0;
    scan := 0;
    // calculate decay factor for 20db atten in spec'd time
    decay_fac := pow(10.0,1.0 / ((p^.rate/1000.0) * SampleRate));
    decay_fac := 1.0 / decay_fac;

    // disable interrupts, go to it
    while (True) do
    begin
       while((inp(SR) & 0x20) == 0);       // wait for input ready

       data.b[0] := inp(PDR);              // read input from chip
       data.b[1] := inp(PDR);

       inval := data.w;
       if (inval > p^.depth) then      // see if we crossed threshold
           gain := 1.0;                // turn gate on */

       data.w := (inval * gain);

       while((inp(SR) & 0x2) == 0);    // wait for output ready */

       outp(PDR,data.b[0]);            // write output to chip */
       outp(PDR,data.b[1]);

       gain := gain * decay_fac;       // adjust attenuation */
    end;
end;


(*=======================================================================
                                flange_chorus

    Does flanging/chorusing family of effects based on a single
    varying delay.

    dry_mix     mix of unaffected signal (-0.999 to 0.999)
    wet_mix     mix of affected signal (-0.999 - 0.999)
    feedback    amount of recirculation (-0.9 - 0.9)
    rate        rate of delay change in millisecs per sec
    sweep       sweep range in millisecs
    delay       fixed additional delay in millisecs
========================================================================*)
procedure flange_chorus(p: PProgram);
var
   fp,ep1,ep2: integer;
   step,depth,delay,min_sweep,max_sweep: integer;
   inval,outval,ifac: Double;
   scan: Longint;
   data:  Tbw;
   sweep: Twl;

begin
   ifac := 65536.0;
   scan := 0;
   // fetch params
   step := p^.rate * 65.536;
   depth := p^.depth * SampleRate div 1000;
   delay := p^.delay * SampleRate div 1000;

   // init/calc some stuff
   max_sweep := BFSZ - 2 - delay;
   min_sweep := max_sweep - depth;
   if (min_sweep < 0) then
   begin
        printf("Can't do that much delay or depth at this sample rate.\n");
        exit(1);
   end;
   sweep.w[1] := (min_sweep + max_sweep) div 2;
   sweep.w[0] := 0;

   // init store and read ptrs to known value
   fp := 0;
   ep1 := 0;
   ep2 := 0;

    while (True) do
    begin
        data.b[0] := inp(PDR);               /* read input from chip */
        data.b[1] := inp(PDR);

        // interpolate from the 2 read values
        outval := (Buf[ep1]*sweep.w[0]+
                   Buf[ep2]*(ifac-sweep.w[0]))/ifac;

        // store finished input plus feedback
        inval := data.w + outval * p^.feedback;
        Buf[fp] := inval;

        // develop final output mix
        outval := outval * p^.wet_mix + inval * p^.dry_mix;
        if (outval > 32767.0) then
            data.w := 32767
        else if (outval < -32768.0) then
            data.w := -32768;
        else
            data.w := outval;

        outp(PDR,data.b[0]);                // write output to chip
        outp(PDR,data.b[1]);

        // update ptrs
        fp := (fp + 1) and (BFSZ - 1);
        sweep.l := sweep.l + step;
        ep1 := (fp + sweep.w[1]) and (BFSZ - 1);
        ep2 := (ep1 - 1) and (BFSZ - 1);

        // check for sweep reversal
        if (sweep.w[1] > max_sweep) or   // see if we hit top of sweep
           (sweep.w[1] < min_sweep) then // or if we hit bottom of sweep */
            step := -step;               // reverse

    end;
end;

(*=======================================================================
                                pitch_change

    dry_mix     mix of unaffected signal (-0.999 to 0.999)
    wet_mix     mix of affected signal (-0.999 - 0.999)
    feedback    amount of recirculation (-0.9 - 0.9)
    rate        amount of pitch change (see table below for values)
    depth       sweep range in millisecs for generating pitch shift
    delay       fixed additional delay

    Semitones      Up              Down
        1       0.059463        -0.056126
        2       0.122462        -0.109101
        3       0.189207        -0.159104
        4       0.259921        -0.206299
        5       0.334840        -0.250846
        6       0.414214        -0.292893
        7       0.498307        -0.332580
        8       0.587401        -0.370039
        9       0.681793        -0.405396
        10      0.781797        -0.438769
        11      0.887749        -0.470268
        12      1.000000        -0.500000