aboutsummaryrefslogtreecommitdiffstats
path: root/Game/Code/Classes/URecord.pas
blob: 57919fe1caf1eaf3f828db8a13193de3a585968b (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
unit URecord;

interface
uses Classes, Math, SysUtils, {DXSounds, Wave, }UMusic, UIni, BASS;

type
  TSound = class
    BufferNew:    TMemoryStream; // buffer for newest sample
    BufferArray:  array[1..4096] of smallint; // (Signal) newest 4096 samples
    BufferLong:   array of TMemoryStream;     // full buffer

    Num:          integer;
    n:            integer; // length of Signal to analyze
//    Spectrum:     array[1..8192] of single;   // sound buffer from above as FFT
//    Spektogram:   array[0..100] of TSpekt;    // FFT(t)

    // pitch detection
    SzczytJest:   boolean;       // czy jest szczyt
    Szczyt:       integer;    // pozycja szczytu na osi poziomej
    TonDokl:      real;       // ton aktualnego szczytu
    Ton:          integer;    // ton bez ulamka
    TonGamy:      integer;    // ton w gamie. wartosci: 0-11
    Skala:        real;       // skala FFT

    // procedures
    procedure ProcessNewBuffer;
    procedure AnalizujBufor;    // use to analyze sound from buffers to get new pitch
    procedure AnalizujByAutocorrelation;    // we call it to analyze sound by checking Autocorrelation
    function  AnalyzeAutocorrelationFreq(Freq: real): real;   // use this to check one frequency by Autocorrelation
    function  GetToneString: string; //from usdx 1.1
  end;

  TSoundCardInput = record
    Name:   string;
  end;

  TSoundCard = record
    // here can be the soundcard information - whole database from which user will select recording source
    Description:    string;
    Input:          array of TSoundCardInput;
    InputSeleceted: integer;

    // bass record
    BassRecordStream: hStream;
  end;

  TRecord = class
    SoundCard:  array of TSoundCard;
    constructor Create;
  end;

  smallintarray = array [0..maxInt shr 1-1] of smallInt;
  psmallintarray = ^smallintarray;

  // procedures - bass record
  function GetMicrophone(handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD): boolean; stdcall;


var
  Sound:      array of TSound;
  SoundCard:  array of TSoundCard;
  Poz:        integer;
  Recording:  TRecord;

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

implementation
uses UMain, ULog;

// from usdx 1.1
function TSound.GetToneString: string;
begin
  if (SzczytJest) then
    Result := ToneStrings[TonGamy] + IntToStr(Ton div 12 + 2)
  else
    Result := '-';
end;

procedure TSound.ProcessNewBuffer;
var
  S:    integer;
  L:    integer;
  A:    integer;
begin
  // process BufferArray
  S := 0;
  L := BufferNew.Size div 2;
  if L > n then begin
    S := L - n;
    L := n;
  end;
  
  // copy to array
  for A := L+1 to n do
    BufferArray[A-L] := BufferArray[A];

  BufferNew.Seek(2*S, soBeginning);
  BufferNew.ReadBuffer(BufferArray[1+n-L], 2*L);

  // process BufferLong
  if Ini.SavePlayback = 1 then begin
    BufferNew.Seek(0, soBeginning);
    BufferLong[0].CopyFrom(BufferNew, BufferNew.Size);
  end;
end;

procedure TSound.AnalizujBufor;
begin
  AnalizujByAutocorrelation;
end;

procedure TSound.AnalizujByAutocorrelation;
var
  T:        integer;  // tone
  F:        real; // freq
  Wages:    array[0..35] of real; // wages
  MaxT:     integer; // max tone
  MaxW:     real; // max wage
  V:        real; // volume
  MaxV:     real; // max volume
  S:        integer; // Signal
  Threshold:  real; // threshold
begin
//  Log.LogAnalyze('[Analyze by Autocorrelation]');
  SzczytJest := false;

  // find maximum volume of first 1024 words of signal
  MaxV := 0;
  for S := 1 to 1024 do begin // 0.5.2: fix. was from 0 to 1023
//    Log.LogDebug('1');
//    Log.LogDebug(IntTostr(S));
    V := Abs(BufferArray[S]) / $10000;
//    Log.LogDebug('2');
//    Log.LogDebug(IntTostr(S) + ': ' + FloatToStr(V) + ', MaxV='+floattostr(maxv)+', buf='+inttostr(length(BufferArray)));
    if V > MaxV then MaxV := V;
//    Log.LogDebug('3');
//    Log.LogDebug(IntTostr(S) + ': ' + FloatToStr(V) + ', MaxV='+floattostr(maxv)+', buf='+inttostr(length(BufferArray)));
  end;


  // prepare to analyze
  MaxW := 0;
  MaxT := 0;

  // analyze all 12 halftones
  for T := 0 to 35 do begin // to 11, then 23, now 35 (for Whitney and my high voice)
    F := 130.81*Power(1.05946309436, T)/2; // let's analyze below 130.81
    Wages[T] := AnalyzeAutocorrelationFreq(F);

    if Wages[T] > MaxW then begin // this frequency has better wage
      MaxW := Wages[T];
      MaxT := T;
    end;
  end; // for T

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

  //Log.LogDebug('Sound -> AnalyzeByAutocorrelation: MaxV='+floattostr(maxv)+', Threshold='+floattostr(threshold));
  if MaxV >= Threshold then begin // found acceptable volume // 0.1
    SzczytJest := true;
    TonGamy := MaxT mod 12;
    Ton := MaxT;
  end;

//  Log.LogAnalyze('--> Weight: ')
//  Log.LogAnalyze('--> Selected: ' + BoolToStr(SzczytJest, true) +
//    ', TonGamy: ' + IntToStr(Ton) +
//    ', MaxV: ' + FloatToStr(MaxV));
//  Log.LogAnalyze('');


end;

function TSound.AnalyzeAutocorrelationFreq(Freq: real): real; // result medium difference
var
  Count:      real;
  Src:        integer;
  Dst:        integer;
  Move:       integer;
  Il:         integer; // how many counts were done
begin
  // we use Signal as source
  Count := 0;
  Il := 0;
  Src := 1;
  Move := Round(44100/Freq);
  Dst := Src + Move;

  // ver 1 - sample 1 and compare n-times
{  while (Src <= Move) do begin // process by moving Src by one
    while (Dst < n) do begin // process up to n (4KB) of Signal
      Count := Count + Abs(Signal[Src] - Signal[Dst]) / $10000;
      Inc(Dst, Move);
      Inc(Il);
    end;

    Inc(Src);
    Dst := Src + Move;
  end;}

  // ver 2 - compare in vertical
  while (Dst < n) do begin // process up to n (4KB) of Signal
    Count := Count + Abs(BufferArray[Src] - BufferArray[Dst]) / $10000;
    Inc(Src);
    Inc(Dst);
    Inc(Il);
  end;

  Result := 1 - Count / Il;
end;

function GetMicrophone(handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD): boolean; stdcall;
var
  L:    integer;
  S:    integer;
  PB:   pbytearray;
  PSI:  psmallintarray;
  I:    integer;
  Skip: integer;
  P1:   integer;
  P2:   integer;
  Boost:  byte;

begin
//  Log.LogDebug('Record -> GetMicrophone: len='+inttstr(len));
  // set boost
  case Ini.MicBoost of
    0:  Boost := 1;
    1:  Boost := 2;
    2:  Boost := 4;
    3:  Boost := 8;
    else Boost := 1;
  end;

  // boost buffer
  L := Len div 2; // number of samples
  PSI := Buffer;
  for S := 0 to L-1 do begin
    I := PSI^[S] * Boost;
    if I > 32767 then I := 32767; // 0.5.0: limit
    if I < -32768 then I := -32768; // 0.5.0: limit
    PSI^[S] := I;
  end;

  // decode user
  P1 := (user and 255) - 1;
  P2 := (user div 256) - 1;

//  Log.LogDebug('Record -> GetMicrophone: P1='+inttostr(p1)+', P2='+inttostr(p2));

  // 2 players USB mic, left channel
  if P1 >= 0 then begin
    L := Len div 4; // number of samples
    PB := Buffer;
//    Log.LogDebug('Record -> GetMicrophone -> Sound[P1].BufferNew.Clear');
    Sound[P1].BufferNew.Clear; // 0.5.2: problem on exiting
    for S := 1 to L do begin
      Sound[P1].BufferNew.Write(PB[(S-1)*4], 2);
    end;
    Sound[P1].ProcessNewBuffer;
  end;

  // 2 players USB mic, right channel
//  if Ini.Debug = 0 then Skip := 2
//  else Skip := 0;
  Skip := 2;

  if P2 >= 0 then begin
    L := Len div 4; // number of samples
    PB := Buffer;
    Sound[P2].BufferNew.Clear;
    for S := 1 to L do begin
      Sound[P2].BufferNew.Write(PB[Skip + (S-1)*4], 2);
    end;
    Sound[P2].ProcessNewBuffer;
  end;

//  Log.LogDebug('Record -> GetMicrophone -> Finish');

  Result := true;
end;

constructor TRecord.Create;
var
  Info:       BASS_DEVICEINFO;
  SC:         integer; // soundcard
  SCI:        integer; // soundcard input
  Descr:      string;
  InputName:  string;
  Flags:      integer;
  No:         integer;
  Proceed:    boolean;

  function isDuplicate(Desc: String): Boolean;
  var
    I: Integer;
  begin
    Result := False;
    //Check for Soundcard with same Description
    For I := 0 to SC-1 do
    begin
      if (SoundCard[I].Description = Desc) then
      begin
        Result := True;
        Break;
      end;
    end;
  end;

begin
  // checks for recording devices and puts them into array;
  //Log.LogError('Init recoding devices...');
  SetLength(SoundCard, 0);
  BASS_RecordFree;
  SC := 0;
  Proceed := BASS_RecordGetDeviceInfo(SC, &Info);

  while Proceed and not (info.flags and BASS_DEVICE_ENABLED=0) do
  begin
    Descr := Info.name;
    //If there is another SoundCard with the Same ID, Search an available Name
    if (IsDuplicate(Descr)) then
    begin
      No:= 1; //Count of SoundCards with  same Name
      Repeat
      Inc(No)
      Until not IsDuplicate(Descr + ' (' + InttoStr(No) + ')');
      //Set Description
      Descr := Descr + ' (' + InttoStr(No) + ')';
    end;

    SetLength(SoundCard, SC+1);
    //Log.LogError('Device #' + IntToStr(SC+1) + ': ' + Descr);
    SoundCard[SC].Description := Descr;

    //check for recording inputs
    SCI := 0;
    BASS_RecordInit(SC);
    Flags := BASS_RecordGetInput(SCI, PSingle(nil)^);
    InputName := BASS_RecordGetInputName(SCI);
    //Log.LogError('Input #' + IntToStr(SCI) + ' (' + IntToStr(Flags) + '): ' + InputName);

    SetLength(SoundCard[SC].Input, 1);
    SoundCard[SC].Input[SCI].Name := InputName;

    // process each input
    while (Flags <> -1) and (Flags and BASS_INPUT_OFF<>0) do
    begin
      if SCI >= 1 then
      begin
        SetLength(SoundCard[SC].Input, SCI+1);
        InputName := BASS_RecordGetInputName(SCI);
        SoundCard[SC].Input[SCI].Name := InputName;
        //Log.LogError('Input #' + IntToStr(SCI) + ' (' + IntToStr(Flags) + '): ' + InputName);
      end;

      Inc(SCI);
      Flags := BASS_RecordGetInput(SCI, PSingle(nil)^);
    end;

    BASS_RecordFree;

    Inc(SC);
    Proceed := BASS_RecordGetDeviceInfo(SC, &Info);
  end; // while
  //Log.LogError('End of Init recoding devices.');
end;
end.