Delphi: Mixing two audio streams - delphi

I am trying to add support for conference chat in an already up and running single mic chat application (in which only one person can talk at a time). The streaming for both clients and everything is done and the voice is recording and playing well on both the computers that are using the mic but when a third person receives the packets then the audio is in a really weird way, I searched around and found out that I need to mix the two streams and then play them as one. I tried a few algorithms I found on the internet but I am not getting the result I need.
I am using speex as the encoder/decoder after decoding the incoming stream on the client side I tried mixing the two byte arrays/streams through the following algorithms.
Var Buffer1, Buffer2, MixedBuf: TIdBytes;
Begin
For I := 0 To Length(Buffer1) - 1 Do Begin
If Length(Buffer2) >= I Then
MixedBuf[I] := (Buffer1[I] + Buffer2[I]) / 2
Else
MixedBuf[I] := Buffer1[I];
End;
End;
The received buffer are either 492 or 462 bytes so I check if the Buffer2 is smaller than the Buffer1 then mix the first 462 bytes and leave the rest of the bytes unaltered and just add them to MixedBuff.
This algorithm when used have a lot of noise and distortion and only part of the voice can be heard.
Another algorithm which I found on here on stackoverflow submitted by Mark Heath is to first convert the bytes to floating point values.
Var Buffer1, Buffer2, MixedBuf: TIdBytes;
samplef1, samplef2, Mixed: Extended;
Begin
For I := 0 To Length(Buffer1) - 1 Do Begin
If Length(Buffer2) >= I Then Begin
samplef1 := Buffer1[I] / 65535;
samplef2 := Buffer2[I] / 65535;
Mixed := samplef1 + samplef2;
if (Mixed > 1.0) Then Mixed := 1.0;
if (Mixed < -1.0) Then Mixed := -1.0;
MixedBuf[I] := Round(Mixed * 65535);
End Else
MixedBuf[I] := Buffer1[I];
End;
End;
The value never goes below 0 but still I left the check for if the value goes below -1.0 as it was in the algorithm. This method works a lot better but still there is noise and distortion and the voice from the second stream is always really faint while the voice from the first stream is loud as its supposed to be, even if the first person is not talking the second voice is faint.
P.S: Oh and some details about the audio stream:
The details of the tWAVEFORMATEX record for the audio recording playback are as follows:
FWaveFormat.wFormatTag := WAVE_FORMAT_PCM;
FWaveFormat.nChannels := 1;
FWaveFormat.nSamplesPerSec := WAVESAMPLERATE; // i.e WAVESAMPLERATE = 16000
FWaveFormat.nAvgBytesPerSec := WAVESAMPLERATE*2;
FWaveFormat.nBlockAlign := 2;
FWaveFormat.wBitsPerSample := 16;
FWaveFormat.cbSize := SizeOf(tWAVEFORMATEX);
I hope I am providing all the information needed.

FWaveFormat.wBitsPerSample := 16;
You need to respect the fact that your samples are 16 bits wide. Your code operates on 8 bits at a time. You could write it something like this:
function MixAudioStreams(const strm1, strm2: TBytes): TBytes;
// assumes 16 bit samples, single channel, common sample rate
var
i: Integer;
n1, n2, nRes: Integer;
p1, p2, pRes: PSmallInt;
samp1, samp2: Integer;
begin
Assert(Length(strm1) mod 2 = 0);
Assert(Length(strm2) mod 2 = 0);
n1 := Length(strm1) div 2;
n2 := Length(strm2) div 2;
nRes := Max(n1, n2);
SetLength(Result, nRes*2);
p1 := PSmallInt(strm1);
p2 := PSmallInt(strm2);
pRes := PSmallInt(Result);
for i := 0 to nRes-1 do begin
if i < n1 then begin
samp1 := p1^;
inc(p1);
end else begin
samp1 := 0;
end;
if i < n2 then begin
samp2 := p2^;
inc(p2);
end else begin
samp2 := 0;
end;
pRes^ := EnsureRange(
(samp1+samp2) div 2,
low(pRes^),
high(pRes^)
);
inc(pRes);
end;
end;
Some people recommend scaling by sqrt(2) to maintain the combined power of the two signals. That would look like this:
pRes^ := EnsureRange(
Round((samp1+samp2) / Sqrt(2.0)),
low(pRes^),
high(pRes^)
);

Related

How can I distinguish between polylines and curved lines in MapInfo files read by mitab?

I'm using the mitab.dll to read MapInfo files (*.tab + friends). These files may contain simple polylines and also curved lines. So far, I have been unable to distinguish between these two and read everything as polylines. Is there any mitab-API call that allows me to determine which of these two line types I am reading?
(simplified) code:
procedure HandlePolyline(_Feature: mitab_Feature);
var
i, j: LongInt;
pointCount: LongInt;
partCount: LongInt;
X, Y: array of Double;
begin
partCount := FMitabDll.get_parts(_Feature);
for i := 0 to partCount - 1 do begin
pointCount := FMitabDll.get_vertex_count(_Feature, i);
SetLength(X, pointCount);
SetLength(Y, pointCount);
for j := 0 to pointCount - 1 do begin
X[j] := FMitabDll.get_vertex_x(_Feature, i, j);
Y[j] := FMitabDll.get_vertex_y(_Feature, i, j);
end;
// -> Here I have got a polyline, but it might be a curved line, how do I know?
end;
end;
i := 1;
repeat
feature := FMitabDll.read_feature(FTabHandle, i);
FeatureType := FMitabDll.get_type(feature);
case FeatureType of
TABFC_Polyline: HandlePolyline(feature);
end;
i := FMitabDll.next_feature_id(FTabHandle, i);
FMitabDll.destroy_feature(feature);
until i = -1;
(This is with Delphi 2077, but I take any other solution that uses mitab.)
Do both line types exist?
Since you posted your question on several sites and apparently got no responses and since online documentation for Mitab does not mention curved polygons, nor even splines, I wonder whether there is a curve characteristic for polylines.

Sort several arrays together and return the ranking number in the all-arrays combined score

I have 2 tables like this
As you can see, if you look at Total you can see the score of each player in 3 rounds. I have to do a list (from the 1st to the 12th) indicating the highest score.
Here the player with 28 points, must have the number 1 (instead of that 8 which is generated by default), the player with 22 must have the number 2 instead of 11... So I have to sort the TOTAL columns and return the position in the correct label.
When I click the button I underlined, the procedure is called:
var vettore:array[1..12] of integer;
indici:array[1..12] of integer;
i:smallint;
begin
for i := 1 to 6 do
begin
vettore[i]:= StrToInt(StringGrid1.Cells[5,i]); //col,row
indici[i] := i;
end;
for i := 6 to 12 do
begin
vettore[i]:= StrToInt(StringGrid2.Cells[5,i]); //col,row
indici[i] := i;
end;
In this way I load inside vettore all the TOTAL numbers in the rows of both tables, and in indici you can find the number of the label on the right of the table (they indicates the position). Now I thought I could use any sorting method since I have only 12 elements (like the Quick Sort).
My problem is this: how can I change the labels texts (the ones on right of the tables) according with the sorted array? It's like the picture above shows.
Every label is called (starting from 1) mvp1, mvp2, mvp3, mvp4... I think this can be helpful because if (maybe) I will have to do a for loop for change the text of each label, I can use a TFindComponent.
If it could be helpful, here there is the function I wrote with javascript on my website (it works):
var totals = [], //array with the scores
indices = []; //array with the indices
for (var i=0; i<6; i++) {
totals[i] = parseInt(document.getElementById('p'+i).value, 10);
indices[i] = i;
}
for (var i=6; i<12; i++) {
totals[i] = parseInt(document.getElementById('p'+i).value, 10);
indices[i] = i;
}
indices.sort(function(a, b) {
return totals[b]- totals[a];
});
for (var i=0; i<indices.length; i++) {
document.getElementById('mvp'+(indices[i]+1)).value = (i+1);
}
AS. Since only delphi is listed in tags, that means that any Delphi version is okay. I'd refer to delphi-xe2.
1st we would use Advanced Records to hold the data for a single participant. Some links are below, google for more.
http://docwiki.embarcadero.com/RADStudio/XE5/en/Structured_Types#Records_.28advanced.29
http://delphi.about.com/od/adptips2006/qt/newdelphirecord.htm
http://sergworks.wordpress.com/2012/03/13/record-constructors-in-delphi/
.
type
TClanResults = record
public
type All_GPs = 1..3;
var GP: array [All_GPs] of Cardinal;
var Players: string;
var Clan_ID: integer;
private
function CalcTotal: Cardinal;
function CalcAverage: single; inline;
public
property Total: Cardinal read CalcTotal;
property AVG: single read CalcAverage;
end;
{ TClanResults }
function TClanResults.CalcAverage: single;
begin
Result := Self.Total * ( 1.0 / Length(GP) );
end;
function TClanResults.CalcTotal: Cardinal;
var score: cardinal;
begin
Result := 0;
for score in GP do
Inc(Result, score);
end;
The expression Self.Total * ( 1.0 / Length(GP) ); can be also written as Self.Total / Length(GP). However i'd like to highlight some Delphi quirks here.
in Pascal there are two division operators: float and integer; 3 div 2 = 1 and 3 / 2 = 1.5. Choosing wrong one causes compilation errors at best and data precision losses at worst.
I'd prefer explicit typecast from integer Length to float, but Delphi does not support it. So i multiply by 1.0 to cast. Or i may add 0.0.
Division takes a lot longer than multiplication - just do it with pen and paper to see. When you have a data-crunching loop, where all elements are divided by the same number, it is good idea to cache 1 / value into a temp variable, and then mutiply each element by it instead. Since GP is of fixed size, it is compiler that calculates (1.0 / Length(GP)) and substitutes this constant. If you would allow different clans to have different amount of games - and turn GP into being dynamic arrays of different sizes - you would be to explicitly add a variable inside the function and to calc coeff := 1.0 / Length(GP); before loop started.
Now we should make a container to hold results and sort them. There can be several approaches, but we'd use generics-based TList<T>.
http://docwiki.embarcadero.com/Libraries/XE5/en/System.Generics.Collections.TList
http://docwiki.embarcadero.com/Libraries/XE5/en/System.Generics.Collections.TList.Sort
http://docwiki.embarcadero.com/Libraries/XE5/en/System.Generics.Defaults.TComparer.Construct
http://docwiki.embarcadero.com/Libraries/XE5/en/System.Generics.Defaults.TComparison
The TList is an object, so you would have to CREATE it and to FREE it. I think you can make it a PUBLIC property of your MainForm, then create the list in TMainForm.OnCreate event and free it in TMainForm.OnDestroy event.
Another, lazier approach, would be using a regular dynamic array and its extensions.
http://docwiki.embarcadero.com/RADStudio/XE5/en/Structured_Types#Dynamic_Arrays
http://docwiki.embarcadero.com/Libraries/XE5/en/System.TArray
http://docwiki.embarcadero.com/Libraries/XE5/en/System.SetLength
http://docwiki.embarcadero.com/Libraries/XE5/en/System.Generics.Collections.TArray.Sort
http://docwiki.embarcadero.com/CodeExamples/XE5/en/Generics_Collections_TArray_(Delphi)
However, i'll use TList below. Again, i assume that other routines in you program already and correctly create and destroy the given var ClanData: TList<TClanResults>; object instance.
type
TClansTable = TList<TClanResults>;
procedure TMainForm.Input;
var row: TClanResults
begin
Self.ClanData.Clear;
row.Clan_ID := 1;
row.Players := JclStringList.Add(['John', 'James', 'Jenny']).Join(' and ');
row.GP[1] := 2;
row.GP[1] := 5;
row.GP[1] := 7;
Self.ClanData.Add(row);
row.Clan_ID := 2;
row.Players := JclStringList.Add(['Mary', 'Mark', 'Marge']).Join(' and ');
row.GP[1] := 3;
row.GP[1] := 6;
row.GP[1] := 2;
Self.ClanData.Add(row);
...
end;
procedure SortOnTotal(const Table: TClansTable);
begin
Table.Sort(
TComparer<TClanResults>.Construct(
function(const Left, Right: TClanResults): Integer
begin Result := - (Left.Total - Right.Total) end
// negating since we need reversed order: large to little
)
);
end;
Now finally we need to know how to show that table on the screen. I would use typical TStringGrid as the most simplistic widget. I suggest you to look some advanced string grid from JediVCL or something from Torry.net so you would be able to specify columns styles. It is obvious that integers should be right-aligned on the screen and averages should be comma-aligned. However stock TStringGrid does not have kind of GetCellStyle event, so you would need some advanced grid derivative to add it. It is left as your home-task.
http://docwiki.embarcadero.com/RADStudio/XE5/en/String_Grids
http://docwiki.embarcadero.com/Libraries/XE5/en/Vcl.Grids.TStringGrid_Properties
Delphi TStringGrid Flicker - remains as your homework too.
.
procedure TMainForm.DumpTableToGrid(const Data: TClansTable; const grid: TStringGrid);
const TableFields = 8;
var row: integer;
ss: array of string;
res: TClanResults;
procedure DumpTheRow; var col: integer;
begin
for col := 0 to TableFields - 1 do begin
grid.Cells[ col, row ] := ss[ col ];
end;
begin
grid.Options := [ goFixedVertLine, goVertLine, goHorzLine, goColSizing, goColMoving, goThumbTracking ];
grid.ColCount := TableFields;
SetLength( ss, TableFields );
grid.RowCount := 1 + Data.Count;
grid.FixedRows := 1;
grid.FixedColumns := 1;
row := 0; // headers
ss[0] := ''; // number in the row, self-evident
ss[1] := 'Players';
ss[2] := 'GP 1';
....
ss[7] := 'Clan ID';
DumpTheRow;
for res in Data do begin // we assume Data already sorted before calling this
Inc(row);
ss[0] := IntToStr( row );
ss[1] := res.Players;
ss[2] := IntToStr( res.GP[1] );
...
ss[6] := FloatToStrF( res.AVG, ffFixed, 4, 2);
ss[7] := IntToStr( res.Clan_ID );
DumpTheRow;
end;
end;
Now, it is unclear what you mean by those labels. I can guess, that you want to show there ranks according to both your two clans combined positions. The externals labels are a bad idea for few reasons.
FindComponent is not too fast. Okay, you may find them once, cache in array of TLabel and be done. But why bother with extra workarounds?
user may resize the window, making it taller or shorter. Now there are 3 labels visible, in a minute there would be 30 labels visible, in a minute there will be 10 labels... How would you re-generate them in runtime ? So there would be enough of those always and in proper positions ? Actually just put them into the grid itself.
VCL sucks at form scaling. Now that Winodws 8.1 is out the fonts resolution might be different on different displays. There would be usually 96DPI on you main display, but as you would drag the window onto your secondary display there would be 120DPI, and on your mate's laptop (examples: Lenovo ThinkPad Yoga Pro and Lenovo IdeaPad Yoga 2) there might be like 200DPI or Retina-grade 300DPI. Still you would have to control your labels so their text would be shown exactly to the right of grid rows text, no matter what value would be rows of each height and each font.
So, i think they should be INSIDE the row. If you want to highlight them - use bold font, or coloured, or large, or whatever inside the grid.
TRanks = record min, max: word; end;
TClanResults = record
...
RanksCombined: TRanks;
...
end;
You correctly shown that some clans might have the same results and share the rank.
Before continuing you, as a JS user, have to notice a basis difference between record and class datatypes. record is operated by value while class is operated by reference. That means for class instances and variables you have to manually allocate memory for new elements and to dispose it for no longer used ones. Since class variable is a reference to some anonymous class instance(data). Hence the different containers of class-type elements can point to the single real element(data, instance), providing for easy data changing and cheaper sorting. Then for record instances (and record variable IS record data) you don't care about memory allocation and life times, yet would have copying data between different record instances, and if you change the one instance, to apply it to other containers you would have to copy it back. This difference is very visible in for element in container loops, whether we can change element.field or not.
http://docwiki.embarcadero.com/Libraries/XE2/en/System.Generics.Collections.TObjectList.Create
So let us have few more data structures for sorting and calculating. For example
TAvgAndRanks = class
avg: single; rank: TRanks;
table: TClansTable; idx: integer;
end;
We'll have then modification for the data dumper:
procedure TMainForm.DumpTableToGrid(const Data: TClansTable; const grid: TStringGrid);
const TableFields = 9;
...
row := 0; // headers
....
ss[7] := 'Clan ID';
ss[8] := 'Rank';
DumpTheRow;
...
ss[7] := IntToStr( res.Clan_ID );
with res.RanksCombined do
if min = max
then ss[9] := IntToStr(min)
else ss[9] := IntToStr(min) + ' - ' + IntToStr(max);
DumpTheRow;
Another approach would be to keep ranks externally using something like
TClanPtr = record table: TClansTable; idx: integer; end;
TClanSortData = record avg: single; rank: TRanks; end;
TClanRanksCombined = TDictionary<TClanPtr, TClanSortData>;
This approach is more extensible (allows in different window "attach" different extended data to the clans), but would require much more boilerplate. If you liek it more, your homework would be to implement it.
procedure MakeRanks(const clans: array of TClansTable);
var tab: TClansTable; idx: integer;
total: TObjectList<TAvgAndRanks>;
ar : TAvgAndRanks;
res: TClanResults;
// for spanning ranks with same avg
r_curr, r_min: word;
r_span, r_idx: integer;
r_avg: single;
r_chg: boolean;
begin
total := TObjectList<TAvgAndRanks>.Create( True ); // auto-free by container
try
for tab in clans do
for idx := 0 to tab.Count - 1 do begin
res := tab[ idx ];
ar := TAvgAndRanks.Create; // but creation is still manual
ar.table := tab;
ar.idx := idx;
ar.avg := res.AVG;
total.Add(ar);
end;
if total.Count <= 0 then Abort;
if total.Count = 1 then begin
ar := total[0];
res := ar.table[ ar.idx ];
res.RanksCombined.min := 1;
res.RanksCombined.max := 1;
ar.table[ ar.idx ] := res; // copying back updated data
Exit; // from procedure - nothing to do
end;
total.Sort(
TComparer<TAvgAndRanks>.Construct(
function(const Left, Right: TAvgAndRanks): Integer
begin Result := - (Left.avg - Right.avg) end
// negating since we need reversed order: large to little
)
);
(***** calculating ranks with spans ****)
r_curr := 1;
r_min := 1;
r_span := 0;
r_idx := 0;
r_avg := total[0].avg;
for idx := 1 to total.Count - 1 do begin
ar := total[ idx ];
inc(r_curr);
if r_avg = ar.avg then inc(r_span);
if (r_avg <> ar.avg) or (idx = total.Count - 1) then begin
for r_idx := r_idx to r_idx + r_span do begin
with total[ r_idx ] do begin // class == reference, can update directly
rank.min := r_min;
rank.max := r_min + r_span;
end;
end;
Assert( (r_curr = r_min + r_span + 1) or ( r_avg = ar.avg ) );
r_min := r_curr;
r_span := 0;
r_idx := idx;
r_avg := ar.avg;
end;
end;
(*** saving calculated ranks ***)
for ar in total do begin
res := ar.table[ ar.idx ];
res.RanksCombined := ar.ranks;
ar.table[ ar.idx ] := res; // copying back updated data
end;
finally
Total.Destroy;
end;
end;

Integration of values in a buffer with Delphi

Following on from my question on differentiation:
Differentiation of a buffer with Delphi
I'm now looking at doing the integration. I can't quite get my head around this one. The situation is that I receive a buffer of data periodically that contains a number of values that are a fixed distance in time apart. I need to differentiate them. It is soo long since I did calculus at school ....
What I have come up with is this:
procedure IntegrateBuffer(ABuffer: TDoubleDynArray;
var AOutBuffer: TDoubleDynArray;
AVPS: integer);
const
SumSum: double = 0.0;
LastValue: double = NaN;
var
i: integer;
dt, aa, hl, hr: double;
begin
// protect from divide by zero
if (AVPS < 1) then exit;
dt := 1 / AVPS;
for i := 0 to high(ABuffer) do begin
if (i = 0) then begin
if (IsNaN(LastValue)) then begin
hl := ABuffer[0];
hr := ABuffer[0];
end else begin
hl := LastValue;
hr := ABuffer[i];
end;
end else begin
hl := ABuffer[i -1];
hr := ABuffer[i];
end;
aa := 0.5 * dt * (hl + hr);
SumSum := SumSum + aa;
AOutBuffer[i] := SumSum;
end;
// remember the last value for next time
LastValue := ABuffer[high(ABuffer)];
end;
I'm using the trapezium rule, hl and hr ar the left and right heights of the trapezium. dt is the base.
AVPS is values per second. A typical value for this would be between 10 and 100. The length of the buffers would typically be 500 to 1000 values.
I call the buffer time after time with new data which is continuous with the previous block of data, hence keeping the last value of the block for next time.
Is what I have done correct? ie, will it integrate the values properly?
Thank you.
Looks like you need some help with testing the code. Here, as discussed in comments, is a very simple test.
{$APPTYPE CONSOLE}
uses
SysUtils, Math;
type
TDoubleDynArray = array of Double;
var
SumSum: double;
LastValue: double;
procedure Clear;
begin
SumSum := 0.0;
LastValue := NaN;
end;
procedure IntegrateBuffer(
ABuffer: TDoubleDynArray;
var AOutBuffer: TDoubleDynArray;
AVPS: integer
);
var
i: integer;
dt, aa, hl, hr: double;
begin
// protect from divide by zero
if (AVPS < 1) then exit;
dt := 1 / AVPS;
for i := 0 to high(ABuffer) do begin
if (i = 0) then begin
if (IsNaN(LastValue)) then begin
hl := ABuffer[0];
hr := ABuffer[0];
end else begin
hl := LastValue;
hr := ABuffer[i];
end;
end else begin
hl := ABuffer[i -1];
hr := ABuffer[i];
end;
aa := 0.5 * dt * (hl + hr);
SumSum := SumSum + aa;
AOutBuffer[i] := SumSum;
end;
// remember the last value for next time
LastValue := ABuffer[high(ABuffer)];
end;
var
Buffer: TDoubleDynArray;
OutBuffer: TDoubleDynArray;
begin
// test y = 1 for a single call, expected output = 1, actual output = 2
Clear;
Buffer := TDoubleDynArray.Create(1.0, 1.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Writeln(OutBuffer[high(OutBuffer)]);
Readln;
end.
I'm integrating the function y(x) = 1 over the range [0..1]. So, the expected output is 1. But the actual output is 2.
So, what's wrong? You can work it out in the debugger, but it's easy enough to see by inspecting the code. You are summing a triangle on the very first sample. When IsNaN(LastValue) is true then you should not make a contribution to the integral. At that point you've not covered any distance on the x axis.
So to fix the code, let's try this:
....
if (IsNaN(LastValue)) then begin
hl := 0.0;//no contribution to sum
hr := 0.0;
end else begin
hl := LastValue;
hr := ABuffer[i];
end;
....
That fixes the problem.
Now let's extend the test a little and test y(x) = x:
// test y = x, expected output = 12.5
Clear;
Buffer := TDoubleDynArray.Create(0.0, 1.0, 2.0, 3.0, 4.0, 5.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Writeln(OutBuffer[high(OutBuffer)]);
So, that looks good.
OK, what about multiple calls:
// test y = x for multiple calls, expected output = 18
Clear;
Buffer := TDoubleDynArray.Create(0.0, 1.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Buffer := TDoubleDynArray.Create(2.0, 3.0, 4.0, 5.0, 6.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Writeln(OutBuffer[high(OutBuffer)]);
And how about one value at a time?
// test y = x for multiple calls, one value at a time, expected 0.5
Clear;
Buffer := TDoubleDynArray.Create(0.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Buffer := TDoubleDynArray.Create(1.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Writeln(OutBuffer[high(OutBuffer)]);
What about passing an empty array?
// test y = x for multiple calls, some empty arrays, expected 0.5
Clear;
Buffer := TDoubleDynArray.Create(0.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Buffer := nil;
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Buffer := TDoubleDynArray.Create(1.0);
SetLength(OutBuffer, Length(Buffer));
IntegrateBuffer(Buffer, OutBuffer, 1);
Writeln(OutBuffer[high(OutBuffer)]);
Uh, oh, access violation. Better protect that by simply skipping the function at the start if the buffer is empty:
if (AVPS < 1) then exit;
if (Length(ABuffer) = 0) then exit;
OK, now that last test passes
Hopefully you get the idea now. I've just used noddy Writeln based testing but that does not scale. Get yourself a unit test framework (I recommend DUnitX) and build proper test cases. This will also force you to factor your code so that it is well designed. One of the often unexpected benefits of making code testable is that it usually results in the design of the interface being improved.
For your next question, I request that you supply an SSCCE with the test code! ;-)
Some comments on the code:
Pass dynamic arrays by const or by var. In your case you want to pass the input buffer by const.
Don't use writeable typed constants. Use either parameters, or some other more sane state management.
Again, as I said in the previous question, write tests to prove code, as well as checking it by eye. The key to writing tests is to start with the very simplest thing you can possibly think of. Something so simple that you know for 100% sure the answer. Then, once you get that to work, expand the testing to more complex cases.

How can I generate continuous tones of varying frequencies?

I want to generate and play a continuous sound with specific frequencies and amplitudes that change over time. I don't want to have a delay between sounds. How can I do this with Delphi or C++ Builder?
This very simple example should get you started.
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows, MMSystem;
type
TWaveformSample = integer; // signed 32-bit; -2147483648..2147483647
TWaveformSamples = packed array of TWaveformSample; // one channel
var
Samples: TWaveformSamples;
fmt: TWaveFormatEx;
procedure InitAudioSys;
begin
with fmt do
begin
wFormatTag := WAVE_FORMAT_PCM;
nChannels := 1;
nSamplesPerSec := 44100;
wBitsPerSample := 32;
nAvgBytesPerSec := nChannels * nSamplesPerSec * wBitsPerSample div 8;
nBlockAlign := nChannels * wBitsPerSample div 8;
cbSize := 0;
end;
end;
// Hz // msec
procedure CreatePureSineTone(const AFreq: integer; const ADuration: integer;
const AVolume: double { in [0, 1] });
var
i: Integer;
omega,
dt, t: double;
vol: double;
begin
omega := 2*Pi*AFreq;
dt := 1/fmt.nSamplesPerSec;
t := 0;
vol := MaxInt * AVolume;
SetLength(Samples, Round((ADuration / 1000) * fmt.nSamplesPerSec));
for i := 0 to high(Samples) do
begin
Samples[i] := round(vol*sin(omega*t));
t := t + dt;
end;
end;
procedure PlaySound;
var
wo: integer;
hdr: TWaveHdr;
begin
if Length(samples) = 0 then
begin
Writeln('Error: No audio has been created yet.');
Exit;
end;
if waveOutOpen(#wo, WAVE_MAPPER, #fmt, 0, 0, CALLBACK_NULL) = MMSYSERR_NOERROR then
try
ZeroMemory(#hdr, sizeof(hdr));
with hdr do
begin
lpData := #samples[0];
dwBufferLength := fmt.nChannels * Length(Samples) * sizeof(TWaveformSample);
dwFlags := 0;
end;
waveOutPrepareHeader(wo, #hdr, sizeof(hdr));
waveOutWrite(wo, #hdr, sizeof(hdr));
sleep(500);
while waveOutUnprepareHeader(wo, #hdr, sizeof(hdr)) = WAVERR_STILLPLAYING do
sleep(100);
finally
waveOutClose(wo);
end;
end;
begin
try
InitAudioSys;
CreatePureSineTone(400, 1000, 0.7);
PlaySound;
except
on E: Exception do
begin
Writeln(E.Classname, ': ', E.Message);
Readln;
end;
end;
end.
Notice in particular the neat interface you get:
InitAudioSys;
CreatePureSineTone(400, 1000, 0.7);
PlaySound;
By using WaveAudio library it's possible to generate a continous cosinus wave.
I was gonna post some code but I can't figure out how to do it properly so I won't.
But all you need to do is use TLiveAudioPlayer and then override the OnData event.
And also set Async to true if there is no message pump.
Update in dec 2021, I just came across my answer by chance... so I would like to update it, I used this ASIO library in 2009 I think and later, great library below:*
I would recommend ASIO library for Delphi !
https://sourceforge.net/projects/delphiasiovst/
Using this is super easy, not all files have to be included, start with the main one and add the rest from there, also see the examples.
Ultimately it's as easy as OnSomeEvent/OnSomeBuffer
and then simply filling an array with floating point values.
Don't remember the exact name of the OnEvent but you'll find it easily in the examples.
Another thing to do is set some component to active/true and voila.
The nice thing about ASIO is very low latency, it's even possible to get it down to 50 microseconds or even lower.
It does require an ASIO driver for your sound chip.
ASIO = audio stream input output
API designed by audio engineers !
It probably doesn't get any better than this ! ;)

How to speed up algorithm (Binarization, integral image)

I wrote this procedure based on integral image algorithm described at this url
http://people.scs.carleton.ca/~roth/iit-publications-iti/docs/gerh-50002.pdf
Is there any way to do this code faster?
Pointers are much faster as dynamic arrays?
procedure TForm1.bBinarizationClick(Sender: TObject);
var
iX1, iY1,
iX2, iY2,
ii, jj,
s, s2,
iSum, iCount, index,
iHeight, iWidth : Integer;
iSize: Integer;
row : ^TRGBTriple;
black : TRGBTriple;
aIntegralIm: array of Integer;
aGrays : array of Byte;
startTime : Cardinal;
begin
iWidth := bBitmap.Width;
iHeight := bBitmap.Height;
iSize := iWidth * iHeight;
SetLength(aGrays, iSize);
SetLength(aIntegralIm, iSize);
black.rgbtRed := (clBlack and $0000FF);
black.rgbtGreen := (clBlack and $00FF00) shr 8;
black.rgbtBlue := (clBlack and $FF0000) shr 16;
bBitmap2.Canvas.Brush.Color := clWhite;
bBitmap2.Canvas.FillRect(Rect(0, 0, bBitmap2.Width, bBitmap2.Height));
s := Round(iWidth / TrackBar2.Position);
s2 := Round(s / 2);
startTime := GetTickCount();
index := 0;
for ii := 0 to iHeight - 1 do begin
row := bBitmap.ScanLine[ii];
for jj := 0 to iWidth - 1 do begin
aGrays[index] := ((row.rgbtRed * 77 + row.rgbtGreen * 150 + row.rgbtBlue * 29) shr 8);
inc(index);
inc(row);
end;
end;
for ii := 0 to iWidth - 1 do begin
iSum := 0;
for jj := 0 to iHeight - 1 do begin
index := jj*iWidth+ii;
iSum := iSum + aGrays[index];
if ii = 0 then aIntegralIm[index] := iSum
else aIntegralIm[index] := aIntegralIm[index - 1] + iSum;
end;
end;
for jj := 0 to iHeight - 1 do begin
row := bBitmap2.ScanLine[jj];
for ii := 0 to iWidth - 1 do begin
index := jj*iWidth+ii;
iX1 := ii-s2;
iX2 := ii+s2;
iY1 := jj-s2;
iY2 := jj+s2;
if (iX1 < 0) then iX1 := 0;
if (iX2 >= iWidth) then iX2 := iWidth-1;
if (iY1 < 0) then iY1 := 0;
if (iY2 >= iHeight) then iY2 := iHeight-1;
iCount := (iX2 - iX1) * (iY2 - iY1);
iSum := aIntegralIm[iY2*iWidth+iX2]
- aIntegralIm[iY1*iWidth+iX2]
- aIntegralIm[iY2*iWidth+iX1]
+ aIntegralIm[iY1*iWidth+iX1];
if (aGrays[index] * iCount) < (iSum * (100 - TrackBar1.Position) / 100) then row^ := black;
inc(row);
end;
end;
ePath.Text := 'Time: ' + inttostr(GetTickCount() - startTime) + ' ms';
imgOryginal.Picture.Bitmap.Assign(bBitmap2);
end;
You can at least do a few simple things:
precalculate (100 - TrackBar1.Position) into a variable
Instead of division: / 100 use * 100 on the other side. You might not need any floating point values.
Use lookup tables for the following (care to explain the identation btw?):
Code:
if (iX1 < 0) then iX1 := 0;
if (iX2 >= iWidth) then iX2 := iWidth-1;
if (iY1 < 0) then iY1 := 0;
if (iY2 >= iHeight) then iY2 := iHeight-1;
Try to keep the index and icremnet, decrement istead of multiplication: index := jj*iWidth+ii;
My guess is that the second loop is the slow bit.
The trick would be to avoid to recalculate everything in the second loop all the time
If S is constant (relative to the loop I mean, not absolute)
iy1,iy2 only change with the main(jj) loop and so do iy1*width (and iy2*width).
Precalculate them, or optimize them away in the same way you do with row. (precalculate once per line, increment inbetween)
change the ii loop into three loops:
the first bit where ix1=0
the second where ix1=ii-s ix2=ii+s;
the third where ix1=ii-s and ix2=iwidth-1
this removes a lot of checks out of the loops, to be done only once.
make a dedicated loop for the condition if (aGrays[index] * iCount) < (iSum * (100 - TrackBar1.Position) / 100) then row^ := black; so that it isn't evaluated for each pixel, since you can precalculate the area's where this happens ?
introduce pointers into the gray calculating loop so that you don't have to recalculate the index each pixel (but e.g. only for the row loop, incrementing a ptr per pixel)
If you are hardy, you can also precalculate the jump between lines. Keep in mind that abs(scanline[j]-scanline[i])-width is a metric for the number of alignment bytes per row.
Even more advanced is optimizing for cache effects on the level of your algorithm. See
rotating bitmaps. In code
to get an idea how this works. Some pointer tricks are demonstrated there too (but only for 8-bit elements)
I would first use a profiler to find out the CPU usage repartition, to figure out the smallest part(s) of code that would benefit the most from optimisation.
Then I would adapt the effort according to the results. If some code represents 90% of the CPU load and is executed zillions of times, even extreme measures (recoding a few sequences using inline assembly language) might make sense.
Use the excellent and free SamplingProfiler to find out the bottleneck in your code. Then optimize and run the profiler again to find the next bottleneck. This approach is much better than guessing what's need to be optimized because even experts are often wrong about that.

Resources