units/32audio/AudioUtils.pas

   1 {
   2 ********************************************************************
   3 VSTUtils
   4 Otiginally a unit to extend the VST SDK with some useful functions.
   5 expanded with generic audioprocessing utilities by Thaddy de Koning
   6
   7 Based upon Frederic Vanmol's DVstUtils.pas, but with some
   8 extensions by Tobybear and Thaddy.
   9 You can easily use this instead
  10 of the original DVstUtils.pas
  11
  12 I have also translated some of TobyBear's functions to assembler as well
  13 as making this KOL compatible,
  14
  15 Note that most assembler functions would run more efficient if
  16 written in external assembler. (Because of superfluous stack allocations,
  17 result allocation and register pushing by the compiler)
  18 I have incluede remarks to that extend where appropiate.
  19
  20 Thaddy
  21 ********************************************************************
  22 }
  23
  24 unit AudioUtils;
  25
  26 interface
  27
  28
  29 type
  30   PPERect = ^PERect;
  31   PERect = ^ERect;
  32   ERect = record
  33     top, left, bottom, right: smallint;
  34   end;
  35
  36   // Frederic's functions:
  37
  38 function FourCharToLong(C1, C2, C3, C4: char): longint;
  39   // Converts four chars to a longint in the format required
  40   // by Cubase VST for the identifier of the effect.
  41
  42 function FMod(d1, d2: double): double;
  43   // Gets the remainder after the floating point division of d1 and d2.
  44
  45
  46 procedure dB2string(Value: single; Text: PChar);
  47   // Converts value to a null terminated string representation in decibels.
  48
  49 procedure dB2stringRound(Value: single; Text: PChar);
  50   // Converts value to a null terminated string representation in decibels
  51   // after having rounded it.
  52
  53 procedure float2string(const Value: single; Text: PChar);
  54   // Converts the floating point variable value to a null terminated string
  55   // representation.
  56
  57 procedure long2string(Value: longint; Text: PChar);
  58   // Converts the integer variable value to a null terminated string
  59   // representation.
  60
  61 procedure float2stringAsLong(Value: single; Text: PChar);
  62   // Converts the floating point variable value to a null terminated string
  63   // representation with nothing after the decimal point.
  64
  65 procedure Hz2string(samples, sampleRate: single; Text: PChar);
  66   // Converts samples in combination with sampleRate to Hz.
  67
  68 procedure ms2string(samples, sampleRate: single; Text: PChar);
  69   // Converts samples in combination with sampleRate to milliseconds.
  70
  71 function gapSmallValue(Value, MaxValue: double): double;
  72   // Converts value (between 0 and 1) to an unevenly spread representation
  73   // between 0 and maxValue. Unevenly spread means lower values take longer
  74   // to change while higher values change quicker.
  75
  76 function invGapSmallValue(Value, MaxValue: double): double;
  77   // This is the inverse operation of gapSmallValue. When you have altered
  78   // the value internally with gapSmallValue and Cubase requests this value,
  79   // use this function to return the representation between 0 and 1 from
  80   // a range of 0 to maxValue.
  81
  82   // Tobybear's functions:
  83 function GetDLLFilename: string;
  84
  85 function GetDLLDirectory: string;
  86
  87 function f_limit(v, l, u: single): single;
  88 function dB_to_Amp(g: single): single;
  89 function Amp_to_dB(v: single): single;
  90 function linear_interpolation(f, a, b: single): single;
  91 function cubic_interpolation(fr, inm1, inp, inp1, inp2: single): single;
  92 function f_frac(x: single): single;
  93 function f_int(x: single): single;
  94 function f_trunc(f: single): integer;
  95 function f_round(f: single): integer;
  96 function f_exp(x: single): single;
  97
  98 const
  99   _pi = 3.1415926536;
 100 function f_ln2(f: single): single;
 101 function f_floorln2(f: single): longint;
 102 function f_abs(f: single): single;
 103 function f_neg(f: single): single;
 104 function f_root(i: single; n: integer): single;
 105 function f_power(i: single; n: integer): single;
 106 function f_log2(val: single): single;
 107 function f_arctan(fValue: single): single;
 108 function f_sin(fAngle: single): single;
 109 function f_cos(fAngle: single): single;
 110 function f_sgn(f: single): longint;
 111 function f_clip(x, l, h: single): single;
 112 function f_cliplo(x, l: single): single;
 113 function f_cliphi(x, h: single): single;
 114
 115   // scale logarithmicly from 20 Hz to 20 kHz
 116 function FreqLinearToLog(Value: single): single;
 117 function FreqLogToLinear(Value: single): single;
 118 function OnOff(fvalue: single): boolean;
 119
 120
 121
 122   //Thaddy's functions
 123
 124 // This prevents the FPU from entering denormal mode on very small values
 125 // This precision is not necessary for Audio and can slow down the processing
 126 // by as much as 700% !! in some cases.(Both Intel and AMD processors suffer
 127 // from this problem)
 128 // You should always check your code for denormal numbers as it leads to
 129 // hickups and potentially crashes in realtime audio processing
 130 function undenormalize(fvalue: single): single;
 131
 132 // An alternative is to add a very small, but itself not a denormal, value
 133 // before you enter a calculation that can cause a denormal value
 134 // This cancels out in the audio, but is large enough to prevent the FPU
 135 // going haywire. see below
 136
 137 // You should choose your strategy based on your application, though.
 138 // Not any of the two methods is best:
 139 // The function is more accurate but is slower,
 140 // The addition is very fast but may propagate into the result.
 141 // A third way is adding a small amount of white noise to the audio signal
 142 // before processing.
 143 // If you do that from a buffer, the speed is very good, but you may pollute
 144 // the cache. If the processor cache is not important for your processing
 145 // type, or irrelevant, i.e. much different tasks going on to process one single
 146 // sample, this may be the best solution for pristine audioquality.
 147
 148 const
 149   kDenorm   = 1.0e-25;
 150
 151   //Converts 16 bit integers to 32 bit floating point
 152 procedure ConvertInt16toFloats(const Inbuffer: array of smallint;
 153   var Outbuffer: array of single; SampleCount: integer);
 154
 155   //Converts 32 bitfloating point to 16 bit integers
 156 procedure ConvertFloatsToInt16(const Inbuffer: array of single;
 157   var Outbuffer: array of smallint; SampleCount: integer);
 158
 159   //Splits a 16 bit interleaved stereo file into two 32 bit floating point channels
 160 procedure SplitChannels16ToFloatStereo(const Data: array of smallint; var ld: array of single;
 161   var RD: array of single; Samples: integer);
 162
 163   //Splits an interleaved 32 bit stereo file into two 32 bit floating point channels
 164 procedure SplitChannels32ToFloatStereo(const Data: array of single; var Ld: array of single;
 165   var Rd: array of single; Samples: integer);
 166
 167   //Two distortions
 168 function Distort(Value: single; Amount: single): single;
 169 function Distort2(Value: single; Amount: single): single;
 170
 171   // Tube-like Soft saturation
 172 function saturate(Value, t: single): single;
 173
 174   //BitCrusher, works on smallints
 175 function KeepBitsFrom16(input: smallint; keepBits: integer): smallint;
 176
 177
 178 implementation
 179
 180 uses kolmath, kol, windows;
 181
 182 //Value = input in [-1..1]
 183 //y = output
 184 function Distort(Value: single; Amount: single): single; register;
 185 var
 186   k: single;
 187 begin
 188   k := Undenormalize(2 * amount / (1 - amount));
 189   Result := (1 + k) * Value / (1 + Value * f_abs(Value))
 190 end;
 191
 192 function Distort2(Value: single; Amount: single): single; register;
 193 var
 194   z, s, b: single;
 195 begin
 196   z := pi * amount;
 197   s := 1 / sin(z);
 198   b := 1 / amount;
 199   if Value > b then
 200     Result := 1
 201   else
 202     Result := sin(Value * z) * s;
 203 end;
 204
 205 function saturate(Value, t: single): single; register;
 206 begin
 207   //This can be looped from unknown source, so den. Value
 208   //Threshold T is under our control
 209   Value:=Undenormalize(Value);
 210   if f_abs(Value) < t then
 211     Result := Value
 212   else
 213   begin
 214     if (Value > 0) then
 215       Result := t + (1 - t) * tanh((Value - t) / (1 - t))
 216     else
 217       Result := -(t + (1 - t) * tanh((-Value - t) / (1 - t)));
 218   end;
 219 end;
 220
 221 function KeepBitsFrom16(input: smallint; keepBits: integer): smallint;
 222 begin
 223   Result := (input and (-1 shl (16 - keepBits)));
 224 end;
 225
 226 procedure ConvertInt16toFloats(const Inbuffer: array of smallint;
 227   var Outbuffer: array of single; SampleCount: integer);
 228 var
 229   i: integer;
 230 begin
 231   for i := 0 to Samplecount - 1 do
 232     Outbuffer[i] := Inbuffer[i] * (1.0 / 32767.0);
 233 end;
 234
 235 procedure ConvertFloatsToInt16(const Inbuffer: array of single;
 236   var Outbuffer: array of smallint; SampleCount: integer);
 237 var
 238   i: integer;
 239 begin
 240   for i := 0 to SampleCount - 1 do
 241     Outbuffer[i] := f_trunc(Inbuffer[i] * 32767);
 242 end;
 243
 244 procedure SplitChannels16ToFloatStereo(const Data: array of smallint; var ld: array of single;
 245   var RD: array of single; Samples: integer);
 246 var
 247   Tempdata: array of single;
 248   i, j: integer;
 249 begin
 250   setlength(Tempdata, samples * 2);
 251   ConvertInt16ToFloats(Data, tempdata, samples);
 252   j := 0;
 253   for i := 0 to samples - 1 do
 254   begin
 255     ld[i] := Tempdata[j];
 256     inc(j);
 257     Rd[i] := Tempdata[j];
 258     inc(j);
 259   end;
 260   setlength(Tempdata, 0);
 261 end;
 262
 263 procedure SplitChannels32ToFloatStereo(const Data: array of single; var Ld: array of single;
 264   var Rd: array of single; Samples: integer);
 265 var
 266   i, j: integer;
 267 begin
 268   j := 0;
 269   for i := 0 to (Samples div 2) - 1 do
 270   begin
 271     Ld[i] := Data[j];
 272     inc(j);
 273     Rd[i] := Data[j];
 274     inc(j);
 275   end;
 276 end;
 277
 278
 279 function FourCharToLong(C1, C2, C3, C4: char): longint;
 280 begin
 281   Result := Ord(C4) + (Ord(C3) shl 8) + (Ord(C2) shl 16) + (Ord(C1) shl 24);
 282 end;
 283
 284 function FMod(d1, d2: double): double;
 285 var
 286   i: integer;
 287 begin
 288   if d2 = 0 then
 289     Result := High(longint)
 290   else
 291   begin
 292     Result := f_Trunc(d1 / d2);
 293     Result := d1 - (Result * d2);
 294   end;
 295 end;
 296
 297 function DbtoFloat(Value: single): single;
 298 begin
 299   if Value <= 0 then Value := 0.1;
 300   Result := 20 * Log10(Value);
 301 end;
 302
 303 procedure dB2string(Value: single; Text: PChar);
 304 begin
 305   if (Value <= 0) then StrCopy(Text, '   -oo  ')
 306   else
 307     float2string(20 * log10(Value), Text);
 308 end;
 309
 310 procedure dB2stringRound(Value: single; Text: PChar);
 311 begin
 312   if (Value <= 0) then StrCopy(Text, '    -96 ')
 313   else
 314     long2string(Round(20 * log10(Value)), Text);
 315 end;
 316
 317 procedure float2string(const Value: single; Text: PChar);
 318 begin
 319   if Value < 0 then
 320     StrCopy(Text, PChar(Format('%s', ['-' + Num2Bytes(f_abs(Value))])))
 321   else
 322     StrCopy(Text, PChar(Format('%s', [Num2Bytes(Value)])))
 323 end;
 324
 325 procedure long2string(Value: longint; Text: PChar);
 326 begin
 327   if (Value >= 100000000) then
 328   begin
 329     StrCopy(Text, ' Huge!  ');
 330     Exit;
 331   end;
 332   StrCopy(Text, PChar(Format('%7d', [Value])));
 333 end;
 334
 335 procedure float2stringAsLong(Value: single; Text: PChar);
 336 begin
 337   if (Value >= 100000000) then
 338   begin
 339     StrCopy(Text, ' Huge!  ');
 340     Exit;
 341   end;
 342   StrCopy(Text, PChar(Format('%7.0f', [Value])));
 343 end;
 344
 345 procedure Hz2string(samples, sampleRate: single; Text: PChar);
 346 begin
 347   if (samples = 0) then float2string(0, Text)
 348   else
 349     float2string(sampleRate / samples, Text);
 350 end;
 351
 352 procedure ms2string(samples, sampleRate: single; Text: PChar);
 353 begin
 354   float2string(samples * 1000 / sampleRate, Text);
 355 end;
 356
 357 function gapSmallValue(Value, MaxValue: double): double;
 358 begin
 359   Result := Power(MaxValue, Value);
 360 end;
 361
 362 function invGapSmallValue(Value, MaxValue: double): double;
 363 begin
 364   Result := 0;
 365   if (Value <> 0) then Result := logN(MaxValue, Value);
 366 end;
 367
 368 function GetDLLFilename: string;
 369 var
 370   st: string;
 371 begin
 372   setlength(st, 1500);
 373   getmodulefilename(hinstance, PChar(st), 1500);
 374   Result := extractfilename(trim(st));
 375 end;
 376
 377 function GetDLLDirectory: string;
 378 var
 379   st: string;
 380 begin
 381   setlength(st, 1500);
 382   getmodulefilename(hinstance, PChar(st), 1500);
 383   Result := ExtractFilepath(trim(st));
 384 end;
 385
 386 const
 387   LN2R = 1.442695041;
 388
 389   // Limit a value to be l<=v<=u
 390 function f_limit(v, l, u: single): single;
 391 begin
 392   if v < l then Result := l
 393   else if v > u then Result := u
 394   else
 395     Result := v;
 396 end;
 397
 398 // Convert a value in dB's to a linear amplitude
 399 function dB_to_Amp(g: single): single;
 400 begin
 401   if (g>-90.0) then Result := power(10,g * 0.05)
 402   else
 403     Result := 0;
 404 end;
 405
 406 function Amp_to_dB(v: single): single;
 407 begin
 408   Result := (20 * log10(v));
 409 end;
 410
 411 function linear_interpolation(f, a, b: single): single;
 412 begin
 413   Result := (1 - f) * a + f * b;
 414 end;
 415
 416 function cubic_interpolation(fr, inm1, inp, inp1, inp2: single): single;
 417 begin
 418   Result := inp + 0.5 * fr * (inp1 - inm1 + fr *
 419     (4 * inp1 + 2 * inm1 - 5 * inp - inp2 + fr * (3 * (inp - inp1) - inm1 + inp2)));
 420 end;
 421
 422 const
 423   half: double = 0.5;
 424
 425 function f_trunc(f: single): integer;
 426 asm
 427   fld f
 428   fsub half
 429   fistp result
 430 end;
 431
 432 function f_frac(x: single): single;
 433 begin
 434   Result := x - f_trunc(x);
 435 end;
 436
 437 function f_int(x: single): single;
 438 begin
 439   Result := f_trunc(x);
 440 end;
 441
 442 function f_round(f: single): integer;
 443 begin
 444   Result := round(f);
 445 end;
 446
 447 function f_exp(x: single): single;
 448 begin
 449   Result := power(2,x * LN2R);
 450 end;
 451
 452 function f_Sin(fAngle: single): single;
 453 var
 454   fASqr, fres: single;
 455 begin
 456   fASqr := fAngle * fAngle;
 457   fRes := 7.61e-03;
 458   fRes := fRes * fASqr;
 459   fRes := fRes - 1.6605e-01;
 460   fRes := fRes * fASqr;
 461   fRes := fRes + 1;
 462   fRes := fRes * fAngle;
 463   Result := fRes;
 464 end;
 465
 466 function f_Cos(fAngle: single): single;
 467 var
 468   fASqr, fRes: single;
 469 begin
 470   fASqr := fAngle * fAngle;
 471   fRes := 3.705e-02;
 472   fRes := fRes * fASqr;
 473   fRes := fRes - 4.967e-01;
 474   fRes := fRes * fASqr;
 475   fRes := fRes + 1;
 476   fRes := fRes * fAngle;
 477   Result := fRes;
 478 end;
 479
 480 function f_arctan(fValue: single): single;
 481 var
 482   fVSqr, fRes: single;
 483 begin
 484   fVSqr := fValue * fValue;
 485   fRes := 0.0208351;
 486   fRes := fRes * fVSqr;
 487   fRes := fRes - 0.085133;
 488   fRes := fRes * fVSqr;
 489   fRes := fRes + 0.180141;
 490   fRes := fRes * fVSqr;
 491   fRes := fRes - 0.3302995;
 492   fRes := fRes * fVSqr;
 493   fRes := fRes + 0.999866;
 494   fRes := fRes * fValue;
 495   Result := fRes;
 496 end;
 497
 498 function f_ln2(f: single): single;
 499 begin
 500   Result := (((longint((@f)^) and $7f800000) shr 23) - $7f) +
 501     (longint((@f)^) and $007fffff) / $800000;
 502 end;
 503
 504
 505 function f_floorLn2(f: single): longint; assembler;
 506 asm
 507   mov eax,f
 508   and eax,$7F800000
 509   shr eax,23
 510   sub eax,$7f
 511 end;
 512
 513 function f_abs(f: single): single; assembler;
 514 asm
 515   mov eax,f
 516   and eax, $7FFFFFFF;
 517   mov @result,eax;
 518 end;
 519
 520 function f_neg(f: single): single; assembler;
 521 asm
 522   mov eax,f
 523   xor eax,$80000000
 524   mov @result,eax;
 525 end;
 526
 527 function f_sgn(f: single): longint; assembler;
 528 asm
 529   mov edx, f
 530   shr edx, 31
 531   add edx, edx
 532   xor eax, eax     //faster than mov eax,1
 533   inc eax          //
 534   sub eax, edx
 535 end;
 536
 537 //here the compiler did a better job, TdK
 538 function f_log2(val: single): single;
 539 var
 540   log2, x: longint;
 541 begin
 542   x := longint((@val)^);
 543   log2 := ((x shr 23) and 255) - 128;
 544   x := x and (not (255 shl 23));
 545   x := x + 127 shl 23;
 546   Result := single((@x)^) + log2;
 547 end;
 548
 549 //Tiny bit faster
 550 //If you rewrite this in external assembler you must push ecx!!
 551 function f_power(i: single; n: integer): single; assembler;
 552 asm
 553   sub i, $3f800000
 554   mov ecx,n
 555   dec ecx
 556   shl i, cl
 557   add i,$3F800000
 558   mov eax,i
 559   mov @result, eax;
 560 end;
 561
 562 //Tiny bit faster, do not move to eax, because of sign
 563 //If you rewrite this in external assembler you must push ecx!!
 564
 565 function f_root(i: single; n: integer): single; assembler;
 566 asm
 567   sub i, $3F800000
 568   mov ecx, n
 569   dec ecx
 570   shr i, cl
 571   add i, $3f800000
 572   mov eax,i
 573   mov @result,eax
 574 end;
 575
 576 //Change geberates more efficient code
 577 //Can't improve on the compiler generated code, TdK
 578 function f_cliplo(x, l: single): single;
 579 begin
 580   x := X - l;
 581   Result := (x + f_abs(x)) * 0.5 + l;
 582 end;
 583
 584 //Change geberates more efficient code
 585 //Can't improve on the compiler generated code, TdK
 586 function f_cliphi(x, h: single): single;
 587 begin
 588   x := h - x;
 589   Result := h - (x + f_abs(x)) * 0.5;
 590 end;
 591
 592 //idem
 593 //Can't improve on the compiler generated code, TdK
 594 function f_clip(x, l, h: single): single;
 595 var
 596   x1, x2: single;
 597 begin
 598   Result := (f_abs(x - l) + (l + h) - (f_abs(x - h))) * 0.5;
 599 end;
 600
 601 // scale logarithmicly from 20 Hz to 20 kHz
 602 function FreqLinearToLog(Value: single): single;
 603 begin
 604   Result := (20.0 * power(2.0,Value * 9.965784284662088765571752446703612804412841796875));
 605 end;
 606
 607 function FreqLogToLinear(Value: single): single;
 608 begin
 609   Result := (ln(Value / 20) / ln(2)) / 9.965784284662088765571752446703612804412841796875;
 610 end;
 611
 612 function OnOff(fvalue: single): boolean;
 613 begin
 614   Result := fvalue > 0.5
 615 end;
 616
 617 // Much faster than even a C style float to int cast and more secure
 618 function undenormalize(fValue: single): single; assembler;
 619 asm
 620   mov  eax, fvalue
 621   test eax, $7F800000
 622   jnz  @exit
 623   xor  eax, eax
 624 @exit:
 625   mov  @result,eax
 626 end;
 627
 628 end.
 629