aboutsummaryrefslogtreecommitdiffstats
path: root/Game/Code/Classes/URecord.pas
blob: 6faac2b63833b0a60387192221ab3316d0c2be2a (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
unit URecord;

interface

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

{$I switches.inc}

uses Classes,
     Math,
     SysUtils,
     UCommon,
     UMusic,
     UIni;

const
  BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz)
  NumHalftones = 36; // C2-B4 (for Whitney and my high voice)

type
  TCaptureBuffer = class
    private
      BufferNew:    TMemoryStream; // buffer for newest samples

      function GetToneString: string; // converts a tone to its string represenatation;
    public
      BufferArray:  array[0..4095] of smallint; // newest 4096 samples
      BufferLong:   TMemoryStream;              // full buffer
      AnalysisBufferSize: integer; // number of samples of BufferArray to analyze

      AudioFormat: TAudioFormatInfo;

      // pitch detection
      ToneValid:    boolean;    // true if Tone contains a valid value (otherwise it contains noise)
      Tone:         integer;    // tone relative to one octave (e.g. C2=C3=C4). Range: 0-11
      ToneAbs:      integer;    // absolute (full range) tone (e.g. C2<>C3). Range: 0..NumHalftones-1

      // methods
      constructor Create;
      destructor Destroy; override;

      procedure Clear;

      procedure ProcessNewBuffer;
      // use to analyze sound from buffers to get new pitch
      procedure AnalyzeBuffer;
      // we call it to analyze sound by checking Autocorrelation
      procedure AnalyzeByAutocorrelation;
      // use this to check one frequency by Autocorrelation
      function AnalyzeAutocorrelationFreq(Freq: real): real;
      function MaxSampleVolume: Single;

      property ToneString: string READ GetToneString;
  end;

  TAudioInputDeviceSource = record
    Name:   string;
  end;

  // soundcard input-devices information
  TAudioInputDevice = class
    public
      CfgIndex:        integer;   // index of this device in Ini.InputDeviceConfig
      Description:     string;    // soundcard name/description
      Source:          array of TAudioInputDeviceSource; // soundcard input(-source)s
      SourceSelected:  integer;  // unused. What is this good for?
      MicSource:       integer;  // unused. What is this good for?

      AudioFormat:     TAudioFormatInfo; // capture format info (e.g. 44.1kHz SInt16 stereo)
      CaptureChannel:  array of TCaptureBuffer; // sound-buffer references used for mono or stereo channel's capture data

      destructor Destroy; override;

      procedure LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer);
      
      function Start(): boolean; virtual; abstract;
      procedure Stop();  virtual; abstract;
  end;

  TAudioInputProcessor = class
    public
      Sound:  array of TCaptureBuffer; // sound-buffers for every player
      Device: array of TAudioInputDevice;

      constructor Create;

      // handle microphone input
      procedure HandleMicrophoneData(Buffer: Pointer; Size: Cardinal;
                                     InputDevice: TAudioInputDevice);
  end;

  TAudioInputBase = class( TInterfacedObject, IAudioInput )
    private
      Started: boolean;
    protected
      function UnifyDeviceName(const name: string; deviceIndex: integer): string;
      function UnifyDeviceSourceName(const name: string; const deviceName: string): string;
    public
      function GetName: String;           virtual; abstract;
      function InitializeRecord: boolean; virtual; abstract;

      procedure CaptureStart;
      procedure CaptureStop;
  end;


  SmallIntArray = array [0..maxInt shr 1-1] of smallInt;
  PSmallIntArray = ^SmallIntArray;

  function AudioInputProcessor(): TAudioInputProcessor;

implementation

uses
  ULog,
  UMain;

var
  singleton_AudioInputProcessor : TAudioInputProcessor = nil;


// FIXME: Race-Conditions between Callback-thread and main-thread
//        on BufferArray (maybe BufferNew also).
//        Use SDL-mutexes to solve this problem.


{ Global }

function AudioInputProcessor(): TAudioInputProcessor;
begin
  if singleton_AudioInputProcessor = nil then
    singleton_AudioInputProcessor := TAudioInputProcessor.create();

  result := singleton_AudioInputProcessor;
end;


{ TAudioInputDevice }

destructor TAudioInputDevice.Destroy;
//var
// i: integer; // Auto Removed, Unused Variable
begin
  Stop();
  Source := nil;
  CaptureChannel := nil;
  FreeAndNil(AudioFormat);
  inherited Destroy;
end;

procedure TAudioInputDevice.LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer);
begin
  // check bounds
  if ((ChannelIndex < 0) or (ChannelIndex > High(CaptureChannel))) then
    Exit;

  // reset audio-format of old capture-buffer
  if (CaptureChannel[ChannelIndex] <> nil) then
    CaptureChannel[ChannelIndex].AudioFormat := nil;

  // set audio-format of new capture-buffer
  if (Sound <> nil) then
    Sound.AudioFormat := AudioFormat;

  // replace old with new buffer
  CaptureChannel[ChannelIndex] := Sound;
end;

{ TSound }

constructor TCaptureBuffer.Create;
begin
  inherited;
  BufferNew := TMemoryStream.Create;
  BufferLong := TMemoryStream.Create;
  AnalysisBufferSize := Min(4*1024, Length(BufferArray));
end;

destructor TCaptureBuffer.Destroy;
begin
  AudioFormat := nil;
  FreeAndNil(BufferNew);
  FreeAndNil(BufferLong);
  inherited;
end;

procedure TCaptureBuffer.Clear;
begin
  if assigned(BufferNew) then
    BufferNew.Clear;
  if assigned(BufferLong) then
    BufferLong.Clear;
  FillChar(BufferArray[0], Length(BufferArray) * SizeOf(SmallInt), 0);
end;

procedure TCaptureBuffer.ProcessNewBuffer;
var
  SkipCount:   integer;
  NumSamples:  integer;
  SampleIndex: integer;
begin
  // process BufferArray
  SkipCount := 0;
  NumSamples := BufferNew.Size div 2;

  // check if we have more new samples than we can store
  if (NumSamples > Length(BufferArray)) then
  begin
    // discard the oldest of the new samples
    SkipCount := NumSamples - Length(BufferArray);
    NumSamples := Length(BufferArray);
  end;

  // move old samples to the beginning of the array (if necessary)
  for SampleIndex := NumSamples to High(BufferArray) do
    BufferArray[SampleIndex-NumSamples] := BufferArray[SampleIndex];

  // skip samples if necessary
  BufferNew.Seek(2*SkipCount, soBeginning);
  // copy samples
  BufferNew.ReadBuffer(BufferArray[Length(BufferArray)-NumSamples], 2*NumSamples);

  // save capture-data to BufferLong if neccessary
  if (Ini.SavePlayback = 1) then
  begin
    BufferNew.Seek(0, soBeginning);
    BufferLong.CopyFrom(BufferNew, BufferNew.Size);
  end;
end;

procedure TCaptureBuffer.AnalyzeBuffer;
var
  Volume:    real;
  MaxVolume: real;
  SampleIndex: integer;
  Threshold: real;
begin
  ToneValid := false;
  ToneAbs := -1;
  Tone    := -1;

  // find maximum volume of first 1024 samples
  MaxVolume := 0;
  for SampleIndex := 0 to 1023 do
  begin
    Volume := Abs(BufferArray[SampleIndex]) / -Low(Smallint);
    if Volume > MaxVolume then
       MaxVolume := Volume;
  end;

  case Ini.Threshold of
    0:   Threshold := 0.05;
    1:   Threshold := 0.1;
    2:   Threshold := 0.15;
    3:   Threshold := 0.2;
    else Threshold := 0.1;
  end;

  // check if signal has an acceptable volume (ignore background-noise)
  if MaxVolume >= Threshold then
  begin
    // analyse the current voice pitch
    AnalyzeByAutocorrelation;
    ToneValid := true;
  end;
end;

procedure TCaptureBuffer.AnalyzeByAutocorrelation;
var
  ToneIndex: integer;
  CurFreq:   real;
  CurWeight: real;
  MaxWeight: real;
  MaxTone:   integer;
const
  HalftoneBase = 1.05946309436; // 2^(1/12) -> HalftoneBase^12 = 2 (one octave)
begin
  // prepare to analyze
  MaxWeight := -1;

  // analyze halftones
  // Note: at the lowest tone (~65Hz) and a buffer-size of 4096
  // at 44.1 (or 48kHz) only 6 (or 5) samples are compared, this might be
  // too few samples -> use a bigger buffer-size
  for ToneIndex := 0 to NumHalftones-1 do
  begin
    CurFreq := BaseToneFreq * Power(HalftoneBase, ToneIndex);
    CurWeight := AnalyzeAutocorrelationFreq(CurFreq);

    // TODO: prefer higher frequencies (use >= or use downto)
    if (CurWeight > MaxWeight) then
    begin
      // this frequency has a higher weight
      MaxWeight := CurWeight;
      MaxTone   := ToneIndex;
    end;
  end;

  ToneAbs := MaxTone;
  Tone    := MaxTone mod 12;
end;

// result medium difference
function TCaptureBuffer.AnalyzeAutocorrelationFreq(Freq: real): real;
var
  Dist:                   real;    // distance (0=equal .. 1=totally different) between correlated samples
  AccumDist:              real;    // accumulated distances
  SampleIndex:            integer; // index of sample to analyze
  CorrelatingSampleIndex: integer; // index of sample one period ahead
  SamplesPerPeriod:       integer; // samples in one period
begin
  SampleIndex := 0;
  SamplesPerPeriod := Round(AudioFormat.SampleRate/Freq);
  CorrelatingSampleIndex := SampleIndex + SamplesPerPeriod;

  AccumDist := 0;

  // compare correlating samples
  while (CorrelatingSampleIndex < AnalysisBufferSize) do
  begin
    // calc distance (correlation: 1-dist) to corresponding sample in next period
    Dist := Abs(BufferArray[SampleIndex] - BufferArray[CorrelatingSampleIndex]) /
            High(Word);
    AccumDist := AccumDist + Dist;
    Inc(SampleIndex);
    Inc(CorrelatingSampleIndex);
  end;

  // return "inverse" average distance (=correlation)
  Result := 1 - AccumDist / AnalysisBufferSize;
end;

function TCaptureBuffer.MaxSampleVolume: Single;
var
  lSampleIndex: Integer;
  lMaxVol : Longint;
begin;
  // FIXME: lock buffer to avoid race-conditions
  lMaxVol := 0;
  for lSampleIndex := 0 to High(BufferArray) do
  begin
    if Abs(BufferArray[lSampleIndex]) > lMaxVol then
      lMaxVol := Abs(BufferArray[lSampleIndex]);
  end;

  result := lMaxVol / -Low(Smallint);
end;

const
  ToneStrings: array[0..11] of string = (
    'C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B'
  );

function TCaptureBuffer.GetToneString: string;
begin
  if (ToneValid) then
    Result := ToneStrings[Tone] + IntToStr(ToneAbs div 12 + 2)
  else
    Result := '-';
end;


{ TAudioInputProcessor }

constructor TAudioInputProcessor.Create;
var
  i:        integer;
begin
  inherited;
  SetLength(Sound, 6 {max players});//Ini.Players+1);
  for i := 0 to High(Sound) do
  begin
    Sound[i] := TCaptureBuffer.Create;
  end;
end;

{*
 * Handle captured microphone input data.
 * Params:
 *   Buffer - buffer of signed 16bit interleaved stereo PCM-samples.
 *     Interleaved means that a right-channel sample follows a left-
 *     channel sample and vice versa (0:left[0],1:right[0],2:left[1],...).
 *   Length - number of bytes in Buffer
 *   Input - Soundcard-Input used for capture
 *}
procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: Pointer; Size: Cardinal; InputDevice: TAudioInputDevice);
var
  Value:        integer;
  ChannelBuffer: PChar;         // buffer handled as array of bytes (offset relative to channel)
  SampleBuffer: PSmallIntArray; // buffer handled as array of samples
  Boost:  byte;
// ChannelCount: integer; // Auto Removed, Unused Variable
  ChannelIndex: integer;
// ChannelOffset: integer; // Auto Removed, Unused Variable
  CaptureChannel: TCaptureBuffer;
  AudioFormat: TAudioFormatInfo;
  FrameSize: integer;
  NumSamples: integer;
  NumFrames: integer; // number of frames (stereo: 2xsamples)
  i: integer;
begin
  // set boost
  case Ini.MicBoost of
    0:   Boost := 1;
    1:   Boost := 2;
    2:   Boost := 4;
    3:   Boost := 8;
    else Boost := 1;
  end;

  AudioFormat := InputDevice.AudioFormat;

  // FIXME: At the moment we assume a SInt16 format
  // TODO:  use SDL_AudioConvert to convert to SInt16 but do NOT change the
  // samplerate (SDL does not convert 44.1kHz to 48kHz so we might get wrong
  // results in the analysis phase otherwise)
  if (AudioFormat.Format <> asfS16) then
  begin
    // this only occurs if a developer choosed a wrong input sample-format
    Log.CriticalError('TAudioInputProcessor.HandleMicrophoneData: Wrong sample-format');
    Exit;
  end;

  // interpret buffer as buffer of bytes
  SampleBuffer := Buffer;

  NumSamples := Size div SizeOf(Smallint);

  // boost buffer
  // TODO: remove this senseless stuff - adjust the threshold instead
  for i := 0 to NumSamples-1 do
  begin
    Value := SampleBuffer^[i] * Boost;

    // TODO :  JB -  This will clip the audio... cant we reduce the "Boost" if the data clips ??
    if Value > High(Smallint) then
      Value := High(Smallint);

    if Value < Low(Smallint) then
      Value := Low(Smallint);

    SampleBuffer^[i] := Value;
  end;

  // samples per channel
  FrameSize := AudioFormat.Channels * SizeOf(SmallInt);
  NumFrames := Size div FrameSize;

  // process channels
  for ChannelIndex := 0 to High(InputDevice.CaptureChannel) do
  begin
    CaptureChannel := InputDevice.CaptureChannel[ChannelIndex];
    if (CaptureChannel <> nil) then
    begin
      // set offset according to channel index
      ChannelBuffer := @PChar(Buffer)[ChannelIndex * SizeOf(SmallInt)];

      // TODO: remove BufferNew and write to BufferArray directly

      CaptureChannel.BufferNew.Clear;
      for i := 0 to NumFrames-1 do
      begin
        CaptureChannel.BufferNew.Write(ChannelBuffer[i*FrameSize], SizeOf(SmallInt));
      end;
      CaptureChannel.ProcessNewBuffer();
    end;
  end;
end;


{ TAudioInputBase }

{*
 * Start capturing on all used input-device.
 *}
procedure TAudioInputBase.CaptureStart;
var
  S:  integer;
  DeviceIndex: integer;
  ChannelIndex: integer;
  Device: TAudioInputDevice;
  DeviceCfg: PInputDeviceConfig;
  DeviceUsed: boolean;
  Player: integer;
begin
  if (Started) then
    CaptureStop();

  // reset buffers
  for S := 0 to High(AudioInputProcessor.Sound) do
    AudioInputProcessor.Sound[S].Clear;

  // start capturing on each used device
  for DeviceIndex := 0 to High(AudioInputProcessor.Device) do
  begin
    Device := AudioInputProcessor.Device[DeviceIndex];
    if not assigned(Device) then
      continue;
    DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex];

    DeviceUsed := false;

    // check if device is used
    for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do
    begin
      Player := DeviceCfg.ChannelToPlayerMap[ChannelIndex]-1;
      if (Player < 0) or (Player >= PlayersPlay) then
      begin
        Device.LinkCaptureBuffer(ChannelIndex, nil);
      end
      else
      begin
        Device.LinkCaptureBuffer(ChannelIndex, AudioInputProcessor.Sound[Player]);
        DeviceUsed := true;
      end;
    end;

    // start device if used
    if (DeviceUsed) then
    begin
      //Log.BenchmarkStart(2);
      Device.Start();
      //Log.BenchmarkEnd(2);
      //Log.LogBenchmark('Device.Start', 2) ;
    end;
  end;

  Started := true;
end;

{*
 * Stop input-capturing on all soundcards.
 *}
procedure TAudioInputBase.CaptureStop;
var
  DeviceIndex: integer;
// Player:  integer; // Auto Removed, Unused Variable
  Device: TAudioInputDevice;
// DeviceCfg: PInputDeviceConfig; // Auto Removed, Unused Variable
begin
  for DeviceIndex := 0 to High(AudioInputProcessor.Device) do
  begin
    Device := AudioInputProcessor.Device[DeviceIndex];
    if not assigned(Device) then
      continue;
    Device.Stop();
  end;

  Started := false;
end;

function TAudioInputBase.UnifyDeviceName(const name: string; deviceIndex: integer): string;
var
  count: integer; // count of devices with this name

  function IsDuplicate(const name: string): boolean;
  var
    i: integer;
  begin
    Result := False;
    // search devices with same description
    For i := 0 to deviceIndex-1 do
    begin
      if (AudioInputProcessor.Device[i].Description = name) then
      begin
        Result := True;
        Break;
      end;
    end;
  end;
begin
  count := 1;
  result := name;

  // if there is another device with the same ID, search for an available name
  while (IsDuplicate(result)) do
  begin
    Inc(count);
    // set description
    result := name + ' ('+IntToStr(count)+')';
  end;
end;

{*
 * Unifies an input-device's source name.
 * Note: the description member of the device must already be set when
 * calling this function.
 *}
function TAudioInputBase.UnifyDeviceSourceName(const name: string; const deviceName: string): string;
//var
// Descr: string; // Auto Removed, Unused Variable
begin
  result := name;

  {$IFDEF DARWIN}
    // Under MacOSX the SingStar Mics have an empty
    // InputName. So, we have to add a hard coded
    // Workaround for this problem
    if (name = '') and (Pos( 'USBMIC Serial#', deviceName) > 0) then
    begin
      result := 'Microphone';
    end;
  {$ENDIF}
end;

end.