source: trunk/Packages/uos/uos_dsp_utils.pas

Last change on this file was 664, checked in by chronos, 3 days ago
  • Added: Ability to play music in background in start screen and in-game. Used uos as audio library.
  • Property svn:executable set to *
File size: 7.9 KB
Line 
1{This unit is part of United Openlibraries of Sound (uos)}
2{
3 This unit uses part of Pascal Audio IO package.
4 (paio_channelhelper, pa_ringbuffer, pa_utils)
5 Copyright (c) 2016 by Andrew Haines.
6
7 Fred van Stappen fiens@hotmail.com
8}
9
10unit uos_dsp_utils;
11
12{$mode objfpc}{$H+}
13{$interfaces corba}
14
15interface
16
17uses
18 Classes, SysUtils;
19
20const
21 AUDIO_BUFFER_SIZE = 8192;
22 AUDIO_BUFFER_FLOAT_SAMPLES = AUDIO_BUFFER_SIZE div 4;
23
24type
25 PPSingle = ^PSingle;
26 TSingleArray = array of Single;
27 TChannelArray = array of TSingleArray;
28
29 { TRingBuffer }
30
31 TRingBuffer = class
32 private
33 FMem: PByte;
34 FWritePos: Integer;
35 FReadPos: Integer;
36 FUsedSpace: Integer;
37 FTotalSpace: Integer;
38 function GetFreeSpace: Integer;
39 public
40 constructor Create(ASize: Integer);
41 destructor Destroy; override;
42 function Write(const ASource; ASize: Integer): Integer;
43 function Read(var ADest; ASize: Integer): Integer;
44 property FreeSpace: Integer read GetFreeSpace;
45 property UsedSpace: Integer read FUsedSpace;
46
47 end;
48
49type
50 IPAIODataIOInterface = interface
51 ['IPAIODataIOInterface']
52 procedure WriteDataIO(ASender: IPAIODataIOInterface; AData: PSingle; ASamples: Integer);
53 end;
54
55 { TPAIOChannelHelper }
56
57 TPAIOChannelHelper = class(IPAIODataIOInterface)
58 private
59 FOutputs: TList;
60 FTarget: IPAIODataIOInterface; // where we will send plexed data.
61 FBuffers: TChannelArray;
62 FPos: array of Integer;
63 // called by the individual channel objects.
64 procedure WriteDataIO(ASender: IPAIODataIOInterface; AData: PSingle; ASamples: Integer);
65 procedure AllocateBuffers;
66 procedure SendDataToTarget;
67 public
68 constructor Create(APlexedTarget: IPAIODataIOInterface);
69 destructor Destroy; override;
70 property Outputs: TList read FOutputs;// of IPAIOSplitterJoinerInterface. Each is a channel in order.
71 procedure Write(AData: PSingle; ASamples: Integer); // this expects interleaved data.
72 end;
73
74function NewChannelArray(AChannels: Integer; ASamplesPerChannel: Integer): TChannelArray;
75function SplitChannels(AData: PSingle; ASamples: Integer; AChannels: Integer): TChannelArray;
76function JoinChannels(AChannelData: TChannelArray; ASamples: Integer = -1): TSingleArray;
77function JoinChannels(AChannelData: PPSingle; AChannels: Integer; ASamples: Integer): TSingleArray;
78
79function Min(A,B: Integer): Integer;
80function Max(A,B: Integer): Integer;
81
82implementation
83
84{ TPAIOChannelHelper }
85
86procedure TPAIOChannelHelper.WriteDataIO(ASender: IPAIODataIOInterface; AData: PSingle; ASamples: Integer);
87var
88 BufIndex: Integer;
89 BufSize, WCount: Integer;
90 Written: Integer = 0;
91begin
92 BufIndex := FOutputs.IndexOf(Pointer(ASender));
93
94 if BufIndex = -1 then
95 raise Exception.Create('Trying to write data from an unknown instance');
96
97 AllocateBuffers;
98
99 BufSize := Length(FBuffers[0]);
100
101 While ASamples > 0 do
102 begin
103 WCount := Min(BufSize-FPos[BufIndex], ASamples);
104 Move(AData[Written], FBuffers[BufIndex][0], WCount*SizeOf(Single));
105 Inc(Written, WCount);
106 Dec(ASamples, WCount);
107 Inc(FPos[BufIndex], WCount);
108
109 if BufIndex = High(FBuffers) then
110 SendDataToTarget;
111 end;
112end;
113
114procedure TPAIOChannelHelper.AllocateBuffers;
115begin
116 if Length(FBuffers) <> FOutputs.Count then
117 begin
118 SetLength(FBuffers, 0);
119 FBuffers := NewChannelArray(FOutputs.Count, AUDIO_BUFFER_SIZE*2);
120 SetLength(FPos, FOutputs.Count);
121 end;
122end;
123
124procedure TPAIOChannelHelper.SendDataToTarget;
125var
126 Plexed: TSingleArray;
127 HighestCount: Integer = 0;
128 i: Integer;
129begin
130 for i := 0 to High(FPos) do
131 if FPos[i] > HighestCount then
132 HighestCount:=FPos[i];
133 Plexed := JoinChannels(FBuffers, HighestCount);
134
135 FTarget.WriteDataIO(Self, @Plexed[0], Length(Plexed));
136
137 for i := 0 to High(FPos) do
138 Dec(FPos[i], HighestCount);
139end;
140
141constructor TPAIOChannelHelper.Create(APlexedTarget: IPAIODataIOInterface);
142begin
143 FOutputs := TList.Create;
144 FTarget := APlexedTarget;
145end;
146
147destructor TPAIOChannelHelper.Destroy;
148begin
149 FOutputs.Free;
150 inherited Destroy;
151end;
152
153procedure TPAIOChannelHelper.Write(AData: PSingle; ASamples: Integer);
154var
155 Channels: TChannelArray;
156 i: Integer;
157 Pos: Integer = 0;
158 WCount: Integer;
159begin
160 AllocateBuffers;
161 Channels := SplitChannels(AData, ASamples, Outputs.Count);
162 while ASamples > 0 do
163 begin
164 WCount := Min(1024, ASamples div Outputs.Count);
165 for i := 0 to Outputs.Count-1 do
166 begin
167 IPAIODataIOInterface(Outputs.Items[i]).WriteDataIO(Self, @Channels[i][Pos], WCount);
168 end;
169 Dec(ASamples, WCount * Outputs.Count);
170 Inc(Pos, WCount);
171 end;
172end;
173
174{ TRingBuffer }
175
176function TRingBuffer.GetFreeSpace: Integer;
177begin
178 Result := FTotalSpace-FUsedSpace;
179end;
180
181constructor TRingBuffer.Create(ASize: Integer);
182begin
183 FMem:=Getmem(ASize);
184 FTotalSpace:=ASize;
185end;
186
187destructor TRingBuffer.Destroy;
188begin
189 Freemem(FMem);
190 inherited Destroy;
191end;
192
193function TRingBuffer.Write(const ASource; ASize: Integer): Integer;
194var
195 EOB: Integer; // end of buffer
196 WSize: Integer;
197 WTotal: Integer = 0;
198begin
199 if FUsedSpace = 0 then
200 begin
201 // give the best chance of not splitting the data at buffer end.
202 FWritePos:=0;
203 FReadPos:=0;
204 end;
205 if ASize > FreeSpace then
206 raise Exception.Create('Ring buffer overflow');
207 Result := ASize;
208 Inc(FUsedSpace, ASize);
209 while ASize > 0 do
210 begin
211 EOB := FTotalSpace - FWritePos;
212 WSize := Min(ASize, EOB);
213 Move(PByte(@ASource)[WTotal], FMem[FWritePos], WSize);
214 Inc(FWritePos, WSize);
215 Dec(ASize, WSize);
216
217 if FWritePos >= FTotalSpace then
218 FWritePos:= 0;
219 end;
220end;
221
222function TRingBuffer.Read(var ADest; ASize: Integer): Integer;
223var
224 EOB: Integer; // end of buffer
225 RSize: Integer;
226 RTotal: Integer = 0;
227begin
228 if ASize > UsedSpace then
229 raise Exception.Create('Ring buffer underflow');
230 ASize := Min(ASize, UsedSpace);
231 Result := ASize;
232
233 Dec(FUsedSpace, ASize);
234 while ASize > 0 do
235 begin
236 EOB := FTotalSpace - FReadPos;
237 RSize := Min(EOB, ASize);
238 Move(FMem[FReadPos], PByte(@ADest)[RTotal],RSize);
239 Dec(ASize, RSize);
240 Inc(FReadPos, RSize);
241 if FReadPos >= FTotalSpace then
242 FReadPos:=0;
243 end;
244end;
245
246function Min(A,B: Integer): Integer;
247begin
248 if A < B then Exit(A);
249 Result := B;
250end;
251
252function Max(A,B: Integer): Integer;
253begin
254 if A > B then Exit(A);
255 Result := B;
256end;
257
258function NewChannelArray(AChannels: Integer; ASamplesPerChannel: Integer): TChannelArray;
259var
260 i: Integer;
261begin
262 SetLength(Result, AChannels);
263 for i := 0 to AChannels-1 do
264 SetLength(Result[i], ASamplesPerChannel);
265end;
266
267// Samples is total samples not samples per channel.
268// So Samples = 1000 if 2 Channels have 500 each
269function SplitChannels(AData: PSingle; ASamples: Integer; AChannels: Integer): TChannelArray;
270var
271 SamplesPerChannel: Integer;
272 i, j: Integer;
273begin
274 SamplesPerChannel:=ASamples div AChannels;
275 //SetLength(Result, AChannels);
276 Result := NewChannelArray(AChannels, SamplesPerChannel);
277 for i := 0 to AChannels-1 do
278 begin
279 //SetLength(Result[i], SamplesPerChannel);
280 for j := 0 to SamplesPerChannel-1 do
281 begin
282 Result[i][j] := AData[j*AChannels+i];
283 end;
284 end;
285end;
286
287function JoinChannels(AChannelData: TChannelArray; ASamples: Integer): TSingleArray;
288var
289 i: Integer;
290 j: Integer;
291 Samples: Integer;
292begin
293 if Length(AChannelData) > 0 then
294 begin
295 if ASamples <> -1 then
296 Samples := ASamples
297 else
298 Samples := Length(AChannelData[0]);
299
300 SetLength(Result, Length(AChannelData) * Samples);
301 for i := 0 to High(AChannelData) do
302 for j := 0 to Samples-1 do
303 Result[j*Length(AChannelData)+i] := AChannelData[i][j];
304 end
305 else
306 SetLength(Result, 0);
307end;
308
309function JoinChannels(AChannelData: PPSingle; AChannels: Integer;
310 ASamples: Integer): TSingleArray;
311var
312 i: Integer;
313 j: Integer;
314begin
315 if ASamples > 0 then
316 begin
317 SetLength(Result, AChannels * ASamples);
318 for i := 0 to AChannels-1 do
319 for j := 0 to ASamples-1 do
320 Result[j*AChannels+i] := AChannelData[i][j];
321 end
322 else
323 SetLength(Result, 0);
324
325end;
326
327end.
328
Note: See TracBrowser for help on using the repository browser.