├── .gitignore
├── COPYING.modifiedLGPL
├── COPYING.txt
├── LICENSES.txt
├── README.md
├── examples
├── encode2wav
│ ├── writewav.lpi
│ └── writewav.lpr
├── flac
│ ├── flac_decode.lpi
│ ├── flac_decode.lpr
│ ├── pa_flac_decode.lpi
│ └── pa_flac_decode.lpr
├── fpgui_player
│ ├── guiplayer.lpi
│ ├── guiplayer.lpr
│ └── main_frm.pas
├── noiseremoval
│ ├── noise.ogg
│ ├── noiseremoval.lpi
│ ├── noiseremoval.lpr
│ ├── noisestereo.ogg
│ ├── noisyaudio.ogg
│ └── noisyaudiostereo.ogg
├── noiseremoval2
│ ├── noiseremoval2.lpi
│ └── noiseremoval2.pas
├── playogg
│ ├── playogg.lpi
│ └── playogg.lpr
├── playopus
│ ├── playopus.lpi
│ └── playopus.lpr
└── smartplay
│ ├── smartplay.lpi
│ └── smartplay.lpr
├── pascalaudioio
├── audacity_noiseremoval.pas
├── audacity_realfftf.pas
├── bs2b.pas
├── flac_callbacks.inc
├── flac_classes.pas
├── flac_decode.inc
├── flac_encode.inc
├── flac_format.inc
├── flac_metadata.inc
├── ladspa.pas
├── ladspa_classes.pas
├── mp4codec.pas
├── mp4codec_mp4a.pas
├── noiseremovalmultichannel.pas
├── ogghfobject.pas
├── pa_ringbuffer.pas
├── paio_channelhelper.pas
├── paio_faad2.pas
├── paio_messagequeue.pas
├── paio_mmdevice.pas
├── paio_ogg_container.pas
├── paio_ogg_opus.pas
├── paio_opus.pas
├── paio_types.pas
├── paio_utils.pas
├── paio_vorbis_comment.pas
├── pascalaudioio.lpk
├── pascalaudioio.pas
├── quicktimeatoms.pas
├── quicktimecontainer.pas
├── resample.pas
└── samplerate.pas
└── pascalaudiosuite
├── pa_base.pas
├── pa_binaural.pas
├── pa_cdaudio.pas
├── pa_dec_oggvorbis.pas
├── pa_enc_oggvorbis.pas
├── pa_flac.pas
├── pa_ladspa.pas
├── pa_lists.pas
├── pa_m4a.pas
├── pa_mmdevice.pas
├── pa_noiseremoval.pas
├── pa_ogg_opus.pas
├── pa_process.pas
├── pa_pulse_simple.pas
├── pa_register.pas
├── pa_resample.pas
├── pa_samplerate.pas
├── pa_sox.pas
├── pa_stream.pas
├── pa_wav.pas
├── pascalaudiosuite.lpk
└── pascalaudiosuite.pas
/.gitignore:
--------------------------------------------------------------------------------
1 | # Lazarus compiler-generated binaries (safe to delete)
2 | *.exe
3 | *.dll
4 | *.so
5 | *.dylib
6 | *.lrs
7 | *.res
8 | *.compiled
9 | *.dbg
10 | *.ppu
11 | *.[oa]
12 | *.or
13 |
14 | # Lazarus autogenerated files (duplicated info)
15 | *.rst
16 | *.rsj
17 | *.lrt
18 |
19 | # Lazarus local files (user-specific info)
20 | *.lps
21 |
22 | # Lazarus backups and unit output folders.
23 | # These can be changed by user in Lazarus/project options.
24 | backup/
25 | *.bak*
26 | lib/
27 | units/
28 |
29 |
--------------------------------------------------------------------------------
/COPYING.modifiedLGPL:
--------------------------------------------------------------------------------
1 |
2 | This is the file COPYING.modifiedLGPL, it applies to all pascalaudio sources
3 | distributed with this file unless otherwise stated in each file. All files
4 | contains headers showing the appropriate license.
5 |
6 | See licenses.txt for an attempt to clarify which files are which license.
7 |
8 | These files are distributed under the GNU Library Public License
9 | (see the file COPYING.txt) with the following modification:
10 |
11 | As a special exception, the copyright holders of this library give you
12 | permission to link this library with independent modules to produce an
13 | executable, regardless of the license terms of these independent modules,
14 | and to copy and distribute the resulting executable under terms of your choice,
15 | provided that you also meet, for each linked independent module, the terms
16 | and conditions of the license of that module. An independent module is a
17 | module which is not derived from or based on this library. If you modify this
18 | library, you may extend this exception to your version of the library, but
19 | you are not obligated to do so. If you do not wish to do so, delete this
20 | exception statement from your version.
21 |
22 |
23 | If you didn't receive a copy of the file COPYING.txt, contact:
24 | Free Software Foundation, Inc.,
25 | 675 Mass Ave
26 | Cambridge, MA 02139
27 | USA
28 |
29 |
--------------------------------------------------------------------------------
/LICENSES.txt:
--------------------------------------------------------------------------------
1 | ladspa.pas - LGPL *
2 | ladspa_classes.pas - LGPL *
3 | samplerate.pas - LGPL **
4 | resample.pas - LGPL *
5 | audacity_noiseremoval.pas - GPL #
6 | audacity_realfft.pas - GPL #
7 | ogghfobject.pas - LGPL *
8 | bs2b.pas - LGPL ***
9 |
10 | Other files prefixed with pa_*.pas are modified LGPL with static linking exception
11 |
12 |
13 | * modified LGPL with static linking exception. this applies to the .o file made
14 | by the unit. To the best of my knowledge the libraries the .o files link to,
15 | if any, are LGPL libraries.
16 |
17 | ** modified LGPL with static linking exception. this applies to the .o file made
18 | by the unit. However the libraries they link to are GPL not LGPL.
19 |
20 | ***modified LGPL with static linking exception. this applies to the .o file made
21 | by the unit. b2sb - seems very open. http://bs2b.sourceforge.net/license.html
22 |
23 | # Audacity is GPL and the converted filter came from audacity's source. Might be
24 | considered LGPL but assume GPL. Find out.
25 |
26 |
27 |
28 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # Pascal Audio
2 |
3 | Audio classes to decode and encode various formats including Ogg, Opus, Flac,
4 | m4a made for use with the Free Pascal compiler. It's also possible to use other
5 | external programs such as Sox, mpg321 or ffplay to decode any other format.
6 | It can currently output audio to the _MM_ system of windows or _PulseAudio_ for
7 | linux.
8 |
9 | Also there can be effects applied to the audio such as resampling via
10 | _libresample_ or _libsamplerate_. LADSPA2 plugins are also possible to
11 | incorporate. As well as the noise removal filter from Audacity.
12 |
13 | It is divided into two packages: PascalAudioIO and PascalAudioSuite.
14 |
15 | ## PascalAudioIO
16 |
17 | This package contains the bindings and simple classes to directly use the
18 | libraries such as libogg or libflac etc. If you don't want to use the
19 | "Suite" which has a somewhat complicated threaded mechanism, then you need only
20 | this.
21 |
22 | ## PascalAudioSuite
23 |
24 | Using "Links" starting with a _Source_ link and ending with a _Destination_
25 | link it's possible to decode and audio file and convert/play it or using any
26 | links. If the final link in the chan is PulseAudio then the decoded file will
27 | play on the speakers. Each link in the chain operates inside it's own thread
28 | and processes the data before handing off it's buffer to be handled by the next
29 | link.
30 |
31 | To apply some effect to the decoded audio just insert some links into the
32 | middle of the chain. See the examples folder to see how simple this is.
33 |
34 | ## Adding new codecs or sources and destinations
35 |
36 | Adding new codecs is really not that hard and can be done in a few minutes or
37 | hours as long as the binding already exists.
38 |
39 |
40 |
--------------------------------------------------------------------------------
/examples/encode2wav/writewav.lpi:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/examples/encode2wav/writewav.lpr:
--------------------------------------------------------------------------------
1 | program writewav;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | {$IFDEF UNIX}
7 | cthreads,
8 | {$ENDIF}
9 | Classes, sysutils, pa_wav, pa_dec_oggvorbis;
10 |
11 | var
12 | Ogg: TPAOggVorbisDecoderSource;
13 | Wav: TPAWavDest;
14 |
15 | const
16 | InFile = '../noiseremoval/noisyaudio.ogg';
17 | OutFile = 'writewav.wav';
18 |
19 | procedure CreateObjects;
20 | begin
21 | Ogg := TPAOggVorbisDecoderSource.Create;
22 | Ogg.Stream := TFileStream.Create(InFile, fmOpenRead);
23 | Ogg.InitValues;
24 | Wav := TPAWavDest.Create(TFileStream.Create(OutFile, fmOpenWrite or fmCreate), True);
25 | Wav.DataSource := Ogg;
26 | end;
27 |
28 | procedure Encode;
29 | begin
30 | Ogg.StartData;
31 |
32 | while Ogg.Working or Wav.Working do
33 | CheckSynchronize(1);
34 | end;
35 |
36 | procedure FreeObjects;
37 | begin
38 | Ogg.Stream.Free;
39 | Ogg.Free;
40 | Wav.Free;
41 | end;
42 |
43 |
44 | begin
45 | CreateObjects;
46 | Encode;
47 | FreeObjects;
48 | end.
49 |
50 |
--------------------------------------------------------------------------------
/examples/flac/flac_decode.lpi:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/examples/flac/flac_decode.lpr:
--------------------------------------------------------------------------------
1 | program flac_decode;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | {$IFDEF UNIX}{$IFDEF UseCThreads}
7 | cthreads,
8 | {$ENDIF}{$ENDIF}
9 | Classes, flac_classes, paio_channelhelper;
10 |
11 | type
12 | TDecode = class
13 | private
14 | Decoder: TFlacStreamDecoder;
15 | OutputStream: TStream;
16 | function DataEvent(Sender: TFlacStreamDecoder; Samples: Integer; Channels: Integer; ChannelData: PPLongInt): Boolean;
17 | procedure MetadataEvent(Sender: TFlacStreamDecoder; Metadata: TFlacStreamMetadata);
18 | public
19 | constructor Create(AFile: String);
20 | end;
21 | var
22 | Decode: TDecode;
23 |
24 | { TDecode }
25 |
26 | constructor TDecode.Create(AFile: String);
27 | var
28 | InputStream: TFileStream;
29 | begin
30 | // create input and output streams
31 | InputStream := TFileStream.Create(AFile, fmOpenRead);
32 | OutputStream := THandleStream.Create(StdOutputHandle); // :)
33 | // create the decoder object and set callbacks
34 | Decoder := TFlacStreamDecoder.Create(InputStream, False);
35 | Decoder.OnOutput:=@DataEvent;
36 | Decoder.OnMetadata:=@MetadataEvent;
37 |
38 | // process metadata to fill channels, samplerate and bitspersample
39 | Decoder.ProcessUntilEndOfMetadata;
40 |
41 | // write some info to stderr since stdout will contain raw audio data
42 | WriteLn(StdErr, 'Channels: ', Decoder.Channels);
43 | WriteLn(StdErr, 'SampleRate: ', Decoder.SampleRate);
44 | WriteLn(StdErr, 'BitsPerSample: ', Decoder.BitsPerSample);
45 |
46 | // process the audio data
47 | Decoder.ProcessUntilEndOfStream;
48 | Decoder.Flush;
49 |
50 | // free stuff
51 | Decoder.Free;
52 | OutputStream.Free;
53 | InputStream.Free;
54 | end;
55 |
56 | function TDecode.DataEvent(Sender: TFlacStreamDecoder; Samples: Integer; Channels: Integer; ChannelData: PPLongInt): Boolean;
57 | var
58 | i, j: Integer;
59 | DataSize: Integer;
60 | begin
61 | // write the output plexing the channels
62 | DataSize:=Sender.BitsPerSample div 8;
63 | for i := 0 to Samples-1 do
64 | for j := 0 to Channels-1 do
65 | OutputStream.Write(ChannelData[j][i], DataSize);
66 | Result := True;
67 | end;
68 |
69 | procedure TDecode.MetadataEvent(Sender: TFlacStreamDecoder; Metadata: TFlacStreamMetadata);
70 | begin
71 | WriteLn(Stderr, 'Metadata: ', Metadata.ClassName);
72 | end;
73 |
74 | begin
75 | Decode := TDecode.Create(ParamStr(1));
76 | Decode.Free;
77 | end.
78 |
79 |
--------------------------------------------------------------------------------
/examples/flac/pa_flac_decode.lpi:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/examples/flac/pa_flac_decode.lpr:
--------------------------------------------------------------------------------
1 | program pa_flac_decode;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | {$IFDEF UNIX}
7 | cthreads,
8 | {$ENDIF}
9 | Classes, pa_flac, pa_stream;
10 |
11 | var
12 | SourceFlac: TPAFlacSource;
13 | DestStream: TPAStreamDestination;
14 | procedure CreateObjects;
15 | var
16 | InputStream: TFileStream;
17 | OutputStream: THandleStream;
18 | begin
19 |
20 | InputStream := TFileStream.Create(ParamStr(1), fmOpenRead);
21 | OutputStream := THandleStream.Create(StdOutputHandle); // :)
22 |
23 | SourceFlac := TPAFlacSource.Create(InputStream, True);
24 | DestStream := TPAStreamDestination.Create(OutputStream, True);
25 | DestStream.DataSource := SourceFlac;
26 |
27 | // write some info to stderr since stdout will contain raw audio data
28 | WriteLn(StdErr, 'Channels: ', SourceFlac.Channels);
29 | WriteLn(StdErr, 'SampleRate: ', SourceFlac.SamplesPerSecond);
30 | WriteLn(StdErr, 'Format: ', SourceFlac.Format);
31 | end;
32 |
33 | procedure FreeObjects;
34 | begin
35 | SourceFlac.Free;
36 | DestStream.Free;
37 | end;
38 |
39 | procedure Decode;
40 | begin
41 | SourceFlac.StartData;
42 |
43 | while SourceFlac.Working or DestStream.Working do
44 | CheckSynchronize(1);
45 | end;
46 |
47 | begin
48 | CreateObjects;
49 | Decode;
50 | FreeObjects;
51 | end.
52 |
53 |
--------------------------------------------------------------------------------
/examples/fpgui_player/guiplayer.lpi:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/examples/fpgui_player/guiplayer.lpr:
--------------------------------------------------------------------------------
1 | program guiplayer;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | {$IFDEF UNIX}
7 | cthreads,
8 | {$ENDIF}
9 | Classes, SysUtils, fpg_main,
10 | main_frm;
11 |
12 |
13 | procedure MainProc;
14 | var
15 | frm: TMainForm;
16 | begin
17 | fpgApplication.Initialize;
18 | fpgApplication.CreateForm(TMainForm, frm);
19 | try
20 | frm.Show;
21 | fpgApplication.Run;
22 | finally
23 | frm.Free;
24 | end;
25 | end;
26 |
27 | begin
28 | MainProc;
29 | end.
30 |
31 |
--------------------------------------------------------------------------------
/examples/fpgui_player/main_frm.pas:
--------------------------------------------------------------------------------
1 | unit main_frm;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | Classes, SysUtils,
9 | fpg_base, fpg_main, fpg_form, fpg_label, fpg_progressbar, fpg_button, pa_base, pa_stream;
10 |
11 | type
12 |
13 | TMainForm = class(TfpgForm)
14 | private
15 | {@VFD_HEAD_BEGIN: MainForm}
16 | Label1: TfpgLabel;
17 | btnOpen: TfpgButton;
18 | ProgressBar1: TfpgProgressBar;
19 | lblPosition: TfpgLabel;
20 | lblTotal: TfpgLabel;
21 | {@VFD_HEAD_END: MainForm}
22 | ProgTimer: TfpgTimer;
23 | FSource: TPAStreamSource;
24 | FDest: TPAAudioDestination;
25 | FFileName: String;
26 |
27 | procedure btnOpenClick(Sender: TObject);
28 | procedure ProgressMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
29 | procedure ProgTimerTimer(Sender: TObject);
30 | function GetFilter: String;
31 | procedure OpenFile(AFileName: String);
32 | public
33 | procedure AfterCreate; override;
34 | procedure BeforeDestruction; override;
35 | end;
36 |
37 | {@VFD_NEWFORM_DECL}
38 |
39 | implementation
40 |
41 | uses
42 | pa_dec_oggvorbis,
43 | pa_flac,
44 | pa_wav,
45 | pa_m4a,
46 | pa_register,
47 | pa_pulse_simple,
48 | fpg_dialogs;
49 |
50 | {@VFD_NEWFORM_IMPL}
51 |
52 | function SecondsToTime(ASeconds: Double): String;
53 | var
54 | Hours,
55 | Minutes,
56 | Seconds: Integer;
57 | function Pad(AInteger: Integer): String;
58 | begin
59 | Result := IntToStr(AInteger);
60 | if Length(Result) < 2 then
61 | Result := '0'+Result;
62 | end;
63 |
64 | begin
65 | Hours := Trunc(ASeconds) div 3600;
66 | Minutes := Trunc(ASeconds) div 60 mod 60;
67 | Seconds:= Trunc(ASeconds) mod 60;
68 |
69 | if Hours > 0 then
70 | Result := Pad(Hours)+':'
71 | else
72 | Result := '';
73 |
74 | Result := Result + Pad(Minutes)+':'+Pad(Seconds);
75 |
76 |
77 | end;
78 |
79 | procedure TMainForm.ProgTimerTimer(Sender: TObject);
80 | var
81 | Playable: IPAPlayable;
82 | PosMax,
83 | PosCurrent: Double;
84 | begin
85 | if Assigned(FSource) then
86 | if FSource.GetInterface('IPAPlayable', Playable) then
87 | begin
88 | PosMax := Playable.GetMaxPosition;
89 | PosCurrent:=Playable.GetPosition;
90 | ProgressBar1.Max:=Trunc(PosMax*100);
91 | ProgressBar1.Position:=Trunc(PosCurrent*100);
92 |
93 | lblPosition.Text := SecondsToTime(PosCurrent);
94 | lblTotal.Text:=SecondsToTime(PosMax);
95 | end;
96 | end;
97 |
98 | function TMainForm.GetFilter: String;
99 | var
100 | Items: TStrings;
101 | Extentions: TStrings;
102 | i: Integer;
103 | AllAudioFilter: String;
104 | EachFilter: String;
105 | begin
106 | Extentions := TStringList.Create;
107 | Items := PARegisteredGetList(partDecoder, Extentions);
108 |
109 | if Assigned(Items) then
110 | begin
111 | for i := 0 to Items.Count-1 do
112 | begin
113 | if i > 0 then
114 | AllAudioFilter := AllAudioFilter +';';
115 | AllAudioFilter := AllAudioFilter + '*'+Extentions[i];
116 | EachFilter:=EachFilter+'|'+Items[I]+'|*'+Extentions[i];
117 |
118 | end;
119 | Items.Free;
120 | end;
121 | Extentions.Free;
122 |
123 | Result := 'Audio files|'+AllAudioFilter+EachFilter+'|All files|*';
124 |
125 | end;
126 |
127 | procedure TMainForm.OpenFile(AFileName: String);
128 | begin
129 | if Assigned(FSource) then
130 | begin
131 | FSource.Free;
132 | //FDest.Free;
133 | end;
134 |
135 | FSource := PARegisteredGetDecoderClass(AFileName, False).Create(TFileStream.Create(AFileName, fmOpenRead));
136 |
137 | if not Assigned(FDest) then
138 | FDest := PARegisteredGetDeviceOut('').Create;
139 | FDest.DataSource := FSource;
140 | FSource.StartData;
141 | ProgTimer.Enabled:=True;
142 | end;
143 |
144 | procedure TMainForm.btnOpenClick(Sender: TObject);
145 | var
146 | dlg: TfpgFileDialog;
147 | begin
148 | dlg := TfpgFileDialog.Create(Self);
149 | if FFileName <> '' then
150 | dlg.InitialDir := ExtractFileDir(FFileName)
151 | else
152 | dlg.InitialDir:=GetUserDir;
153 | dlg.Filter:=GetFilter;
154 |
155 | if dlg.RunOpenFile then
156 | begin
157 | dlg.Close;
158 | FFileName:=dlg.FileName;
159 | OpenFile(dlg.FileName);
160 | Label1.Text:=dlg.FileName;
161 | end;
162 |
163 | dlg.Free;
164 |
165 | end;
166 |
167 | procedure TMainForm.ProgressMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
168 | var
169 | Percent: Double;
170 | Playable: IPAPlayable;
171 | begin
172 | if Assigned(FSource) then
173 | if FSource.GetInterface('IPAPlayable', Playable) then
174 | begin
175 | Percent:=AMousePos.x / ProgressBar1.Width;
176 | Playable.SetPosition(Playable.GetMaxPosition*Percent);
177 | end;
178 | end;
179 |
180 | procedure TMainForm.AfterCreate;
181 | begin
182 | {%region 'Auto-generated GUI code' -fold}
183 | {@VFD_BODY_BEGIN: MainForm}
184 | Name := 'MainForm';
185 | SetPosition(960, 231, 380, 211);
186 | WindowTitle := 'MainForm';
187 | Hint := '';
188 | IconName := '';
189 |
190 | Label1 := TfpgLabel.Create(self);
191 | with Label1 do
192 | begin
193 | Name := 'Label1';
194 | SetPosition(20, 55, 345, 15);
195 | Anchors := [anLeft,anRight,anTop];
196 | FontDesc := '#Label1';
197 | Hint := '';
198 | Text := 'Label';
199 | end;
200 |
201 | btnOpen := TfpgButton.Create(self);
202 | with btnOpen do
203 | begin
204 | Name := 'btnOpen';
205 | SetPosition(285, 20, 80, 23);
206 | Anchors := [anRight,anTop];
207 | Text := 'Open File';
208 | FontDesc := '#Label1';
209 | Hint := '';
210 | ImageName := '';
211 | TabOrder := 3;
212 | OnClick:=@btnOpenClick;
213 | end;
214 |
215 | ProgressBar1 := TfpgProgressBar.Create(self);
216 | with ProgressBar1 do
217 | begin
218 | Name := 'ProgressBar1';
219 | SetPosition(20, 80, 345, 22);
220 | Anchors := [anLeft,anRight,anTop];
221 | Hint := 'Click to seek';
222 | ParentShowHint := False;
223 | ShowHint := True;
224 | OnMouseDown:=@ProgressMouseDown;
225 | end;
226 |
227 | lblPosition := TfpgLabel.Create(self);
228 | with lblPosition do
229 | begin
230 | Name := 'lblPosition';
231 | SetPosition(20, 110, 80, 15);
232 | FontDesc := '#Label1';
233 | Hint := '';
234 | Text := 'CurPos';
235 | end;
236 |
237 | lblTotal := TfpgLabel.Create(self);
238 | with lblTotal do
239 | begin
240 | Name := 'lblTotal';
241 | SetPosition(285, 110, 80, 15);
242 | Anchors := [anRight,anTop];
243 | Alignment := taRightJustify;
244 | FontDesc := '#Label1';
245 | Hint := '';
246 | Text := 'Total';
247 | end;
248 |
249 | {@VFD_BODY_END: MainForm}
250 | {%endregion}
251 | ProgTimer := TfpgTimer.Create(100);
252 | ProgTimer.OnTimer:=@ProgTimerTimer;
253 | end;
254 |
255 | procedure TMainForm.BeforeDestruction;
256 | begin
257 | inherited BeforeDestruction;
258 | if Assigned(FSource) then
259 | FreeAndNil(FSource);
260 | if Assigned(FDest) then
261 | FreeAndNil(FDest);
262 | end;
263 |
264 | end.
265 |
266 |
--------------------------------------------------------------------------------
/examples/noiseremoval/noise.ogg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/andrewd207/PascalAudio/5a9a73576dfc9eb96451ee5c0b132ba77c7d8002/examples/noiseremoval/noise.ogg
--------------------------------------------------------------------------------
/examples/noiseremoval/noiseremoval.lpi:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/examples/noiseremoval/noiseremoval.lpr:
--------------------------------------------------------------------------------
1 | program noiseremoval;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | {$DEFINE USE_STEREO}
6 |
7 | uses
8 | {$IFDEF UNIX}
9 | cmem,
10 | cthreads,
11 | {$ENDIF}
12 | Classes, pa_noiseremoval, pa_pulse_simple, pa_dec_oggvorbis, pa_stream, pa_base, sysutils;
13 |
14 | const
15 | {$IFDEF USE_STEREO}
16 | NoiseSampleFile = 'noisestereo.ogg';
17 | FileName = 'noisyaudiostereo.ogg';
18 | {$ELSE}
19 | NoiseSampleFile = 'noise.ogg';
20 | FileName = 'noisyaudio.ogg';
21 | {$ENDIF}
22 |
23 | function GetNoiseStream(out ChannelCount: Integer): TMemoryStream;
24 | var
25 | StreamDest: TPAStreamDestination;
26 | ogg: TPAOggVorbisDecoderSource;
27 |
28 | begin
29 | ogg := TPAOggVorbisDecoderSource.Create;
30 | ogg.Stream := TFileStream.Create(NoiseSampleFile, fmOpenRead or fmShareDenyNone);
31 |
32 | Result := TMemoryStream.Create;
33 | StreamDest := TPAStreamDestination.Create(Result);
34 | StreamDest.DataSource := ogg;
35 |
36 | // first extract audiodata.
37 | ogg.StartData;
38 | //while ogg.Working do
39 | // sleep(0);
40 | sleep(1000);
41 |
42 | ChannelCount:=ogg.Channels;
43 | ogg.Stream.Free;
44 | ogg.Free;
45 |
46 | while StreamDest.Working do
47 | sleep(1);
48 |
49 | StreamDest.Free;
50 |
51 | Result.Position:=0;
52 | end;
53 |
54 | var
55 | RawNoiseStream: TMemoryStream;
56 | ogg: TPAOggVorbisDecoderSource;
57 | noise: TPANoiseRemovalLink;
58 | pulse: TPAPulseDestination;
59 | Channels: TChannelArray;
60 | ChanCount: Integer;
61 | i: Integer;
62 | begin
63 | // open ogg file to be cleaned
64 | ogg := TPAOggVorbisDecoderSource.Create;
65 | ogg.Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
66 |
67 | // create pulse destination to listen to audio
68 | pulse := TPAPulseDestination.Create;
69 | pulse.DataSource := ogg;
70 |
71 | // play unfiltered audio
72 | ogg.StartData;
73 |
74 | //wait to finish
75 | while pulse.Working do
76 | sleep(1);
77 |
78 | pulse.free;
79 | ogg.Free;
80 | // sleep(1000);
81 | ogg := TPAOggVorbisDecoderSource.Create;
82 | ogg.Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
83 | ogg.InitValues; // important! sets channels etc for when noise profile requests it
84 |
85 | // create noise filter
86 | noise := TPaNoiseRemovalLink.Create;
87 | noise.DataSource := ogg;
88 |
89 | pulse := TPAPulseDestination.Create;
90 | pulse.DataSource := noise;
91 |
92 | // set the noise profile
93 | RawNoiseStream := GetNoiseStream(ChanCount);
94 |
95 | Channels := SplitChannels(PSingle(RawNoiseStream.Memory), RawNoiseStream.Size div SizeOf(Single), ChanCount);
96 | RawNoiseStream.Free;
97 | for i := 0 to Length(Channels)-1 do
98 | noise.SetNoiseProfile(i, @Channels[i][0], Length(Channels[i]));
99 |
100 | // filter audio and play to pulse
101 | ogg.StartData;
102 |
103 | //wait to finish
104 | while ogg.Working or pulse.Working do
105 | sleep(1);
106 |
107 | pulse.DataSource := ogg;
108 |
109 | pulse.free;
110 | noise.free;
111 | ogg.Free;
112 | end.
113 |
114 |
--------------------------------------------------------------------------------
/examples/noiseremoval/noisestereo.ogg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/andrewd207/PascalAudio/5a9a73576dfc9eb96451ee5c0b132ba77c7d8002/examples/noiseremoval/noisestereo.ogg
--------------------------------------------------------------------------------
/examples/noiseremoval/noisyaudio.ogg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/andrewd207/PascalAudio/5a9a73576dfc9eb96451ee5c0b132ba77c7d8002/examples/noiseremoval/noisyaudio.ogg
--------------------------------------------------------------------------------
/examples/noiseremoval/noisyaudiostereo.ogg:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/andrewd207/PascalAudio/5a9a73576dfc9eb96451ee5c0b132ba77c7d8002/examples/noiseremoval/noisyaudiostereo.ogg
--------------------------------------------------------------------------------
/examples/noiseremoval2/noiseremoval2.lpi:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/examples/noiseremoval2/noiseremoval2.pas:
--------------------------------------------------------------------------------
1 | program noiseremoval2;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | {$IFDEF UNIX} cthreads, cmem,{$ENDIF}
7 | Classes, sysutils, noiseremovalmultichannel,
8 | pa_base, pa_dec_oggvorbis, pa_stream, pa_pulse_simple;
9 |
10 | const
11 | NoiseSampleFile = '../noiseremoval/noisestereo.ogg';
12 | NoisyFile = '../noiseremoval/noisyaudiostereo.ogg';
13 |
14 | function GetRawAudio(AFile: String): TMemoryStream;
15 | var
16 | StreamDest: TPAStreamDestination;
17 | ogg: TPAOggVorbisDecoderSource;
18 | begin
19 | // extract raw float32 data from
20 | ogg := TPAOggVorbisDecoderSource.Create;
21 | ogg.Stream := TFileStream.Create(AFile, fmOpenRead or fmShareDenyNone);
22 | Result := TMemoryStream.Create;
23 | StreamDest := TPAStreamDestination.Create(Result);
24 | StreamDest.DataSource := ogg;
25 | ogg.StartData;
26 | sleep(1000);
27 | ogg.Stream.Free;
28 | ogg.Free;
29 | while StreamDest.Working do
30 | sleep(1);
31 | StreamDest.Free;
32 | Result.Position:=0;
33 | end;
34 |
35 | procedure PlayAudio(AData: PSingle; ASamplesCount: Integer);
36 | var
37 | pulse: TPAPulseDestination;
38 | streamsource: TPAStreamSource;
39 | mem: TMemoryStream;
40 | begin
41 | Mem := TMemoryStream.Create;
42 | Mem.Write(AData^, ASamplesCount*SizeOf(Single));
43 | Mem.Position:=0;
44 |
45 | streamsource:=TPAStreamSource.Create;
46 | streamsource.Stream := Mem;
47 | streamsource.Channels:=2;
48 | streamsource.Format:=afFloat32;
49 | streamsource.SamplesPerSecond:=44100;
50 |
51 | pulse := TPAPulseDestination.Create;
52 | pulse.DataSource := streamsource;
53 |
54 | streamsource.StartData;
55 |
56 | while pulse.Working do
57 | Sleep(1);
58 |
59 | streamsource.Free;
60 | pulse.Free;
61 | mem.Free;
62 | end;
63 |
64 | var
65 | RawNoise: TMemoryStream;
66 | RawAudio: TMemoryStream;
67 | FilteredAudio: PSingle;
68 | FilteredSamples: Integer;
69 |
70 | type
71 |
72 | { TFooNoiseRemoval }
73 |
74 | TFooNoiseRemoval = class(TNoiseRemovalMultiChannel)
75 | OutStream: TStream;
76 | procedure WriteData(ASender: TObject; AData: PSingle; ASampleCount: Integer) ;
77 | end;
78 |
79 |
80 | function FilterNoise(ANoiseSample, ANoisyAudio: TMemoryStream; out Samples: Integer): PSingle;
81 | var
82 | NoiseRemoval: TFooNoiseRemoval;
83 | begin
84 | Result := nil;
85 | NoiseRemoval := TFooNoiseRemoval.Create(2, 44100);
86 | NoiseRemoval.OutStream := TMemoryStream.Create;
87 | NoiseRemoval.WriteProc := @NoiseRemoval.WriteData;
88 |
89 | NoiseRemoval.ReadNoiseProfile(PSingle(ANoiseSample.Memory), ANoiseSample.Size div SizeOf(Single));
90 |
91 | // while not out of data do
92 | // begin
93 | { we'll process the whole stream in one go.}
94 | NoiseRemoval.ProcessNoise(PSingle(ANoisyAudio.Memory), ANoisyAudio.Size div SizeOf(Single));
95 | // end;
96 | NoiseRemoval.Flush; // output any remaining data
97 |
98 | Result:=GetMem(NoiseRemoval.OutStream.Size);
99 | Samples := NoiseRemoval.OutStream.Size div SizeOf(Single);
100 | NoiseRemoval.OutStream.Position:=0;
101 | NoiseRemoval.OutStream.Read(Result^, NoiseRemoval.OutStream.Size);
102 | NoiseRemoval.OutStream.Free;
103 | end;
104 |
105 | { TFooNoiseRemoval }
106 |
107 | procedure TFooNoiseRemoval.WriteData(ASender: TObject; AData: PSingle;
108 | ASampleCount: Integer);
109 | begin
110 | OutStream.Write(AData^, ASampleCount*SizeOf(Single));
111 | end;
112 |
113 | begin
114 | RawNoise := GetRawAudio(NoiseSampleFile);
115 | RawAudio := GetRawAudio(NoisyFile);
116 |
117 | FilteredAudio:=FilterNoise(RawNoise, RawAudio, FilteredSamples);
118 | RawNoise.Free;
119 | RawAudio.Free;
120 |
121 | PlayAudio(FilteredAudio, FilteredSamples);
122 | Freemem(FilteredAudio);
123 | end.
124 |
125 |
--------------------------------------------------------------------------------
/examples/playogg/playogg.lpi:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/examples/playogg/playogg.lpr:
--------------------------------------------------------------------------------
1 | program playogg;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | {$IFDEF UNIX}
7 | cthreads,
8 | {$ENDIF}
9 | Classes, pa_dec_oggvorbis,
10 | pa_base,
11 | {$IFDEF UNIX}
12 | pa_pulse_simple,
13 | {$else}
14 | pa_mmdevice,
15 | {$ENDIF}
16 | sysutils;
17 |
18 | var
19 | ogg: TPAOggVorbisDecoderSource;
20 | Dest : TPAAudioDestination;
21 | FileName: String;
22 | begin
23 | FileName := ParamStr(1);
24 | if (FileName = '') or not FileExists(FileName) then
25 | begin
26 | WriteLn(' Usage: ',ExtractFileName(ParamStr(0)),' ''file.ogg''');
27 | Exit;
28 | end;
29 | // create ogg decoder
30 | ogg := TPAOggVorbisDecoderSource.Create(TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone), True);
31 |
32 | // create audio out destination
33 | {$IFDEF UNIX}
34 | Dest := TPAPulseDestination.Create;
35 | {$else}
36 | Dest := TPAMMDestination.Create;
37 | {$ENDIF}
38 |
39 | // assign ogg as source of data
40 | Dest.DataSource := ogg;
41 |
42 | // start the chain from the first link.
43 | ogg.StartData;
44 |
45 | sleep(1000);
46 | //ogg.Position:=222;
47 | // while decoding sleep
48 | while Dest.Working do
49 | Sleep(1);
50 | Dest.Terminate;
51 | Dest.WaitFor;
52 | Dest.free;
53 | ogg.free;
54 | end.
55 |
56 |
--------------------------------------------------------------------------------
/examples/playopus/playopus.lpi:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 | -
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 |
--------------------------------------------------------------------------------
/examples/playopus/playopus.lpr:
--------------------------------------------------------------------------------
1 | program playopus;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | {$IFDEF UNIX}
7 | cthreads,
8 | {$ENDIF}
9 | Classes, pa_ogg_opus,
10 | pa_base,
11 | {$IFDEF UNIX}
12 | pa_pulse_simple,
13 | {$else}
14 | pa_mmdevice,
15 | {$ENDIF}
16 | sysutils;
17 |
18 | var
19 | opus: TPAOggOpusDecoderSource;
20 | Dest : TPAAudioDestination;
21 | FileName: String;
22 | lPos: Integer;
23 | lMaxPos: Int64;
24 | begin
25 | FileName := ParamStr(1);
26 | if (FileName = '') or not FileExists(FileName) then
27 | begin
28 | WriteLn(' Usage: ',ExtractFileName(ParamStr(0)),' ''file.opus''');
29 | Exit;
30 | end;
31 | // create opus decoder
32 | opus := TPAOggOpusDecoderSource.Create(TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone), True);
33 |
34 | // create audio out destination
35 | {$IFDEF UNIX}
36 | Dest := TPAPulseDestination.Create;
37 | {$else}
38 | Dest := TPAMMDestination.Create;
39 | {$ENDIF}
40 |
41 | // assign ogg/opus as source of data
42 | Dest.DataSource := opus;
43 |
44 | // start the chain from the first link.
45 | opus.StartData;
46 |
47 | sleep(1000);
48 | // while decoding sleep
49 |
50 |
51 | lMaxPos := Trunc(opus.MaxPosition);
52 | lPos := 0;
53 |
54 | opus.Position := 44;
55 |
56 | while Dest.Working do
57 | begin
58 | Sleep(100);
59 | if Trunc(opus.Position) <> lPos then
60 | begin
61 |
62 | lPos := Trunc(opus.Position);
63 | Write(#13); // output next on the same line..
64 | Write(Format('%d:%.2d / %d:%.2d', [lPos div 60, lpos mod 60, lMaxPos div 60, lMaxPos mod 60]));
65 |
66 |
67 |
68 | //WriteLn(lPos,'/',lMaxPos);
69 | end;
70 | end;
71 | WriteLn;
72 | Dest.Terminate;
73 | Dest.WaitFor;
74 | Dest.free;
75 | opus.free;
76 | end.
77 |
78 |
--------------------------------------------------------------------------------
/examples/smartplay/smartplay.lpi:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/examples/smartplay/smartplay.lpr:
--------------------------------------------------------------------------------
1 | program smartplay;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | uses
6 | {$IFDEF UNIX}
7 | cthreads,
8 | {$ENDIF}
9 | Classes,
10 | pa_base,
11 | pa_register,
12 | pa_stream,
13 | pa_pulse_simple,
14 | pa_flac,
15 | pa_dec_oggvorbis,
16 | pa_wav;
17 |
18 | var
19 | ReaderClass: TPAStreamSourceClass;
20 | Reader: TPAStreamSource;
21 | DevOutClass: TPAAudioDestinationClass;
22 | DevOut: TPAAudioDestination;
23 |
24 | begin
25 | ReaderClass := PARegisteredGetDecoderClass(ParamStr(1), False);
26 | DevOutClass := PARegisteredGetDeviceOut(''); // empty name just gets first device
27 |
28 | Reader := ReaderClass.Create(TFileStream.Create(ParamStr(1), fmOpenRead), True);
29 | DevOut := DevOutClass.Create;
30 | DevOut.DataSource := Reader;
31 |
32 | WriteLn('ReaderClassname = ', Reader.ClassName);
33 | WriteLn('DevOutClassname = ', DevOutClass.ClassName);
34 |
35 | Reader.StartData;
36 |
37 | while Reader.Working or DevOut.Working do
38 | CheckSynchronize;
39 | end.
40 |
41 |
--------------------------------------------------------------------------------
/pascalaudioio/flac_callbacks.inc:
--------------------------------------------------------------------------------
1 | {%mainunit flac_classes.inc}
2 |
3 | {* libFLAC - Free Lossless Audio Codec library
4 | * Copyright (C) 2000-2009 Josh Coalson
5 | * Copyright (C) 2011-2013 Xiph.Org Foundation
6 | *
7 | * Redistribution and use in source and binary forms, with or without
8 | * modification, are permitted provided that the following conditions
9 | * are met:
10 | *
11 | * - Redistributions of source code must retain the above copyright
12 | * notice, this list of conditions and the following disclaimer.
13 | *
14 | * - Redistributions in binary form must reproduce the above copyright
15 | * notice, this list of conditions and the following disclaimer in the
16 | * documentation and/or other materials provided with the distribution.
17 | *
18 | * - Neither the name of the Xiph.org Foundation nor the names of its
19 | * contributors may be used to endorse or promote products derived from
20 | * this software without specific prior written permission.
21 | *
22 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23 | * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
25 | * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE FOUNDATION OR
26 | * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
27 | * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
28 | * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
29 | * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
30 | * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
31 | * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
32 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
33 | *}
34 | {$IFDEF FLAC_INTF_TYPES}
35 | type
36 | PFlacIOHandle = pointer;
37 |
38 | TFlacIOCallbackRead = function (ptr: Pointer; size, num_elems: csize_t; handle: PFlacIOHandle): csize_t; cdecl;
39 | TFlacIOCallbackWrite = function (ptr: Pointer; size, num_elems: csize_t; handle: PFlacIOHandle): csize_t; cdecl;
40 | TFlacIOCallbackSeek = function (handle: PFlacIOHandle; offset: Int64; whence: cint): cint; cdecl;
41 | TFlacIOCallbackTell = function (handle: PFlacIOHandle): Int64; cdecl;
42 | TFlacIOCallbackEof = function (handle: PFlacIOHandle): cint; cdecl;
43 | TFlacIOCallbackClose = TFlacIOCallbackEof;
44 |
45 | PFlacIOCallbacks = ^TFlacIOCallbacks;
46 | TFlacIOCallbacks = record
47 | read: TFlacIOCallbackRead;
48 | write: TFlacIOCallbackWrite;
49 | seek: TFlacIOCallbackSeek;
50 | tell: TFlacIOCallbackTell;
51 | eof: TFlacIOCallbackEof;
52 | close: TFlacIOCallbackClose;
53 | end;
54 |
55 | {$ENDIF}
56 |
57 | {$IFDEF FLAC_INTF}
58 | const
59 | SEEK_SET = 0;
60 | SEEK_CUR = 1;
61 | SEEK_END = 2;
62 |
63 | {$ENDIF}
64 |
65 |
66 | {$IFDEF FLAC_IMPL}
67 |
68 |
69 |
70 | {$ENDIF}
71 |
72 |
73 |
--------------------------------------------------------------------------------
/pascalaudioio/flac_decode.inc:
--------------------------------------------------------------------------------
1 | {%mainuint flac_classes.pas}
2 |
3 | {* libFLAC - Free Lossless Audio Codec library
4 | * Copyright (C) 2000-2009 Josh Coalson
5 | * Copyright (C) 2011-2013 Xiph.Org Foundation
6 | *
7 | * Redistribution and use in source and binary forms, with or without
8 | * modification, are permitted provided that the following conditions
9 | * are met:
10 | *
11 | * - Redistributions of source code must retain the above copyright
12 | * notice, this list of conditions and the following disclaimer.
13 | *
14 | * - Redistributions in binary form must reproduce the above copyright
15 | * notice, this list of conditions and the following disclaimer in the
16 | * documentation and/or other materials provided with the distribution.
17 | *
18 | * - Neither the name of the Xiph.org Foundation nor the names of its
19 | * contributors may be used to endorse or promote products derived from
20 | * this software without specific prior written permission.
21 | *
22 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23 | * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24 | * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
25 | * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE FOUNDATION OR
26 | * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
27 | * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
28 | * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
29 | * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
30 | * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
31 | * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
32 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
33 | *}
34 | {$IFDEF FLAC_INTF_TYPES}
35 |
36 | type
37 | TFlacStreamDecoderState = (
38 | fsdsSearchForMetadata = 0,
39 | fsdsReadMetadata,
40 | fsdsSearchForFrameSync,
41 | fsdsReadFrame,
42 | fsdsEndOfStream,
43 | fsdsOggError,
44 | fsdsSeekError,
45 | fsdsDecoderAborted,
46 | fsdsMemoryAllocationError,
47 | fsdsUninitialized
48 | );
49 |
50 | TFlacStreamDecoderInitStatus = (
51 | fsdisOk,
52 | fsdisUnsupportedContainer,
53 | fsdisInvalidCallbacks,
54 | fsdisMemoryAllocationError,
55 | fsdisErrorOpeningFile,
56 | fsdisAlreadyInitialized
57 | );
58 |
59 | TFlacStreamDecoderReadStatus = (
60 | fsdrsContinue = 0,
61 | fsdrsEndOfStream,
62 | fsdrsReadAbort
63 | );
64 |
65 | TFlacStreamDecoderSeekStatus = (
66 | fsdssOk,
67 | fsdssError,
68 | fsdssUnsupported
69 | );
70 |
71 | TFlacStreamDecoderTellStatus = (
72 | fsdtsOK,
73 | fsdtsError,
74 | fsdtsUnsupported
75 | );
76 |
77 | TFlacStreamDecoderLengthStatus = (
78 | fsdlsOk,
79 | fsdlsError,
80 | fsdlsUnsupported
81 | );
82 |
83 | TFlacStreamDecoderWriteStatus = (
84 | fsdwsContinue,
85 | fsdwsAbort
86 | );
87 |
88 | TFlacStreamDecoderErrorStatus = (
89 | fsdesLostSync,
90 | fsdesBadHeader,
91 | fsdesFrameCrcMismatch,
92 | fsdesUnparseableStream
93 | );
94 | {$ENDIF}
95 |
96 | {$IFDEF FLAC_INTF}
97 | type
98 | PFlacStreamDecoderStruct = ^TFlacStreamDecoderStruct;
99 | TFlacStreamDecoderStruct = record
100 | prot: pointer;
101 | priv: pointer;
102 | end;
103 |
104 | TFlacStreamDecoderReadCB = function (Decoder: PFlacStreamDecoderStruct; Buffer: PByte; bytes: pcsize_t; client_data: pointer): TFlacStreamDecoderReadStatus; cdecl;
105 | TFlacStreamDecoderSeekCB = function (Decoder: PFlacStreamDecoderStruct; abs_byte_offset: QWord; client_data: pointer): TFlacStreamDecoderSeekStatus; cdecl;
106 | TFlacStreamDecoderTellCB = function (Decoder: PFlacStreamDecoderStruct; abs_byte_offset: PQWord; client_data: pointer): TFlacStreamDecoderTellStatus; cdecl;
107 | TFlacStreamDecoderLengthCB = function (Decoder: PFlacStreamDecoderStruct; stream_length: PQWord; client_data: pointer): TFlacStreamDecoderLengthStatus; cdecl;
108 | TFlacStreamDecoderEofCB = function (Decoder: PFlacStreamDecoderStruct; client_data: pointer): TFlacBool; cdecl;
109 | TFlacStreamDecoderWriteCB = function (Decoder: PFlacStreamDecoderStruct; frame: PFlacFrame; buffer: PPLongInt; client_data: pointer): TFlacStreamDecoderWriteStatus; cdecl;
110 | TFlacStreamDecoderMetadataCB = procedure (Decoder: PFlacStreamDecoderStruct; metadata: PFlacStreamMetadataStruct; client_data: pointer); cdecl;
111 | TFlacStreamDecoderErrorCB = procedure (Decoder: PFlacStreamDecoderStruct; status: TFlacStreamDecoderErrorStatus; client_data: pointer); cdecl;
112 |
113 | function FLAC__stream_decoder_new: PFlacStreamDecoderStruct; cdecl; external;
114 | procedure FLAC__stream_decoder_delete(decoder: PFlacStreamDecoderStruct); cdecl; external;
115 | function FLAC__stream_decoder_set_ogg_serial_number(decoder: PFlacStreamDecoderStruct; serial_number: clong): TFlacBool; cdecl; external;
116 | function FLAC__stream_decoder_set_md5_checking(decoder: PFlacStreamDecoderStruct; AValue: TFlacBool): TFlacBool; cdecl; external;
117 | function FLAC__stream_decoder_set_metadata_respond(decoder: PFlacStreamDecoderStruct; AType: TFlacMetadataType): TFlacBool; cdecl; external;
118 | //function FLAC__stream_decoder_set_metadata_respond_application(decoder: PFlacStreamDecoderStruct; id: array[0..3] of Byte): TFlacBool; cdecl; external;
119 | function FLAC__stream_decoder_set_metadata_ignore(decoder: PFlacStreamDecoderStruct; AType: TFlacMetadataType): TFlacBool; cdecl; external;
120 | //function FLAC__stream_decoder_set_metadata_ignore_application(decoder: PFlacStreamDecoderStruct; id: array[0..3] of Byte): TFlacBool; cdecl; external;
121 | function FLAC__stream_decoder_set_metadata_ignore_all(decoder: PFlacStreamDecoderStruct): TFlacBool; cdecl; external;
122 | function FLAC__stream_decoder_get_state(decoder: PFlacStreamDecoderStruct): TFlacStreamDecoderState; cdecl; external;
123 | function FLAC__stream_decoder_get_resolved_state_string(decoder: PFlacStreamDecoderStruct): PChar; cdecl; external;
124 | function FLAC__stream_decoder_get_md5_checking(decoder: PFlacStreamDecoderStruct): TFlacBool; cdecl; external;
125 | function FLAC__stream_decoder_get_total_samples(decoder: PFlacStreamDecoderStruct): QWord; cdecl; external;
126 | function FLAC__stream_decoder_get_channels(decoder: PFlacStreamDecoderStruct): cunsigned; cdecl; external;
127 | function FLAC__stream_decoder_get_channel_assignment(decoder: PFlacStreamDecoderStruct): TFlacChannelAssignment; cdecl; external;
128 | function FLAC__stream_decoder_get_bits_per_sample(decoder: PFlacStreamDecoderStruct): cunsigned; cdecl; external;
129 | function FLAC__stream_decoder_get_sample_rate(decoder: PFlacStreamDecoderStruct): cunsigned; cdecl; external;
130 | function FLAC__stream_decoder_get_blocksize(decoder: PFlacStreamDecoderStruct): cunsigned; cdecl; external;
131 | function FLAC__stream_decoder_get_decode_position(decoder: PFlacStreamDecoderStruct; position: PQword): TFlacBool; cdecl; external;
132 | function FLAC__stream_decoder_init_stream(
133 | decoder: PFlacStreamDecoderStruct;
134 | read_cb: TFlacStreamDecoderReadCB;
135 | seek_cb: TFlacStreamDecoderSeekCB;
136 | tell_cb: TFlacStreamDecoderTellCB;
137 | length_cb: TFlacStreamDecoderLengthCB;
138 | eof_cb: TFlacStreamDecoderEofCB;
139 | write_cb: TFlacStreamDecoderWriteCB;
140 | metadata_cb: TFlacStreamDecoderMetadataCB;
141 | error_cb: TFlacStreamDecoderErrorCB;
142 | userdata: pointer
143 | ): TFlacStreamDecoderInitStatus; cdecl; external;
144 |
145 | function FLAC__stream_decoder_init_ogg_stream(decoder: PFlacStreamDecoderStruct;
146 | read_cb: TFlacStreamDecoderReadCB;
147 | seek_cb: TFlacStreamDecoderSeekCB;
148 | tell_cb: TFlacStreamDecoderTellCB;
149 | length_cb: TFlacStreamDecoderLengthCB;
150 | eof_cb: TFlacStreamDecoderEofCB;
151 | write_cb: TFlacStreamDecoderWriteCB;
152 | metadata_cb: TFlacStreamDecoderMetadataCB;
153 | error_cb: TFlacStreamDecoderErrorCB;
154 | userdata: pointer
155 | ): TFlacStreamDecoderInitStatus; cdecl; external;
156 | // skipped a bunch of variants of decoder_init_X. for FILE and filename
157 |
158 | function FLAC__stream_decoder_flush(decoder: PFlacStreamDecoderStruct): TFlacBool; cdecl; external;
159 | function FLAC__stream_decoder_reset(decoder: PFlacStreamDecoderStruct): TFlacBool; cdecl; external;
160 | function FLAC__stream_decoder_process_single(decoder: PFlacStreamDecoderStruct): TFlacBool; cdecl; external;
161 | function FLAC__stream_decoder_process_until_end_of_metadata(decoder: PFlacStreamDecoderStruct): TFlacBool; cdecl; external;
162 | function FLAC__stream_decoder_process_until_end_of_stream(decoder: PFlacStreamDecoderStruct): TFlacBool; cdecl; external;
163 | function FLAC__stream_decoder_skip_single_frame(decoder: PFlacStreamDecoderStruct): TFlacBool; cdecl; external;
164 | function FLAC__stream_decoder_seek_absolute(decoder: PFlacStreamDecoderStruct; sample: QWord): TFlacBool; cdecl external;
165 |
166 |
167 |
168 |
169 | {$ENDIF}
170 |
171 | {$IFDEF FLAC_IMPL}
172 | {$ENDIF}
173 |
--------------------------------------------------------------------------------
/pascalaudioio/ladspa.pas:
--------------------------------------------------------------------------------
1 | {* ladspa.pas
2 |
3 | Linux Audio Developer's Simple Plugin API Version 1.1[LGPL].
4 | Copyright (C) 2000-2002 Richard W.E. Furse, Paul Barton-Davis,
5 | Stefan Westerfeld.
6 |
7 | This library is free software; you can redistribute it and/or
8 | modify it under the terms of the GNU Lesser General Public License
9 | as published by the Free Software Foundation; either version 2.1 of
10 | the License, or (at your option) any later version.
11 |
12 | This library is distributed in the hope that it will be useful, but
13 | WITHOUT ANY WARRANTY; without even the implied warranty of
14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 | Lesser General Public License for more details.
16 |
17 | You should have received a copy of the GNU Lesser General Public
18 | License along with this library; if not, write to the Free Software
19 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
20 | USA. *}
21 | unit ladspa;
22 |
23 | {$mode objfpc}{$H+}
24 | {$packrecords c}
25 | {$calling c}
26 |
27 | interface
28 |
29 | uses
30 | Classes, SysUtils, ctypes;
31 |
32 | type
33 |
34 | PLADSPA_Data = ^LADSPA_Data;
35 | LADSPA_Data = cfloat;
36 |
37 | LADSPA_Properties = cint;
38 | const
39 | LADSPA_PROPERTY_REALTIME = $1;
40 | LADSPA_PROPERTY_INPLACE_BROKEN = $2;
41 | LADSPA_PROPERTY_HARD_RT_CAPABLE = $4;
42 |
43 | //#define LADSPA_IS_REALTIME(x) ((x) & LADSPA_PROPERTY_REALTIME)
44 | //#define LADSPA_IS_INPLACE_BROKEN(x) ((x) & LADSPA_PROPERTY_INPLACE_BROKEN)
45 | //#define LADSPA_IS_HARD_RT_CAPABLE(x) ((x) & LADSPA_PROPERTY_HARD_RT_CAPABLE)
46 |
47 | type
48 | PLADSPA_PortDescriptor = ^LADSPA_PortDescriptor;
49 | LADSPA_PortDescriptor = cint;
50 | const
51 | LADSPA_PORT_INPUT = $1;
52 | LADSPA_PORT_OUTPUT = $2;
53 | LADSPA_PORT_CONTROL = $4;
54 | LADSPA_PORT_AUDIO = $8;
55 | //#define LADSPA_IS_PORT_INPUT(x) ((x) & LADSPA_PORT_INPUT)
56 | //#define LADSPA_IS_PORT_OUTPUT(x) ((x) & LADSPA_PORT_OUTPUT)
57 | //#define LADSPA_IS_PORT_CONTROL(x) ((x) & LADSPA_PORT_CONTROL)
58 | //#define LADSPA_IS_PORT_AUDIO(x) ((x) & LADSPA_PORT_AUDIO)
59 |
60 | type
61 | LADSPA_PortRangeHintDescriptor = cint;
62 | const
63 | LADSPA_HINT_BOUNDED_BELOW = $1;
64 | LADSPA_HINT_BOUNDED_ABOVE = $2;
65 | LADSPA_HINT_TOGGLED = $4;
66 | LADSPA_HINT_SAMPLE_RATE = $8;
67 | LADSPA_HINT_LOGARITHMIC = $10;
68 | LADSPA_HINT_INTEGER = $20;
69 | LADSPA_HINT_DEFAULT_MASK = $3C0;
70 | LADSPA_HINT_DEFAULT_NONE = 0;
71 | LADSPA_HINT_DEFAULT_MINIMUM = $40;
72 | LADSPA_HINT_DEFAULT_LOW = $80;
73 | LADSPA_HINT_DEFAULT_MIDDLE = $C0;
74 | LADSPA_HINT_DEFAULT_HIGH = $100;
75 | LADSPA_HINT_DEFAULT_MAXIMUM = $140;
76 | LADSPA_HINT_DEFAULT_0 = $200;
77 | LADSPA_HINT_DEFAULT_1 = $240;
78 | LADSPA_HINT_DEFAULT_100 = $280;
79 | LADSPA_HINT_DEFAULT_440 = $2C0;
80 | {
81 | #define LADSPA_IS_HINT_BOUNDED_BELOW(x) ((x) & LADSPA_HINT_BOUNDED_BELOW)
82 | #define LADSPA_IS_HINT_BOUNDED_ABOVE(x) ((x) & LADSPA_HINT_BOUNDED_ABOVE)
83 | #define LADSPA_IS_HINT_TOGGLED(x) ((x) & LADSPA_HINT_TOGGLED)
84 | #define LADSPA_IS_HINT_SAMPLE_RATE(x) ((x) & LADSPA_HINT_SAMPLE_RATE)
85 | #define LADSPA_IS_HINT_LOGARITHMIC(x) ((x) & LADSPA_HINT_LOGARITHMIC)
86 | #define LADSPA_IS_HINT_INTEGER(x) ((x) & LADSPA_HINT_INTEGER)
87 |
88 | #define LADSPA_IS_HINT_HAS_DEFAULT(x) ((x) & LADSPA_HINT_DEFAULT_MASK)
89 | #define LADSPA_IS_HINT_DEFAULT_MINIMUM(x) (((x) & LADSPA_HINT_DEFAULT_MASK) \
90 | == LADSPA_HINT_DEFAULT_MINIMUM)
91 | #define LADSPA_IS_HINT_DEFAULT_LOW(x) (((x) & LADSPA_HINT_DEFAULT_MASK) \
92 | == LADSPA_HINT_DEFAULT_LOW)
93 | #define LADSPA_IS_HINT_DEFAULT_MIDDLE(x) (((x) & LADSPA_HINT_DEFAULT_MASK) \
94 | == LADSPA_HINT_DEFAULT_MIDDLE)
95 | #define LADSPA_IS_HINT_DEFAULT_HIGH(x) (((x) & LADSPA_HINT_DEFAULT_MASK) \
96 | == LADSPA_HINT_DEFAULT_HIGH)
97 | #define LADSPA_IS_HINT_DEFAULT_MAXIMUM(x) (((x) & LADSPA_HINT_DEFAULT_MASK) \
98 | == LADSPA_HINT_DEFAULT_MAXIMUM)
99 | #define LADSPA_IS_HINT_DEFAULT_0(x) (((x) & LADSPA_HINT_DEFAULT_MASK) \
100 | == LADSPA_HINT_DEFAULT_0)
101 | #define LADSPA_IS_HINT_DEFAULT_1(x) (((x) & LADSPA_HINT_DEFAULT_MASK) \
102 | == LADSPA_HINT_DEFAULT_1)
103 | #define LADSPA_IS_HINT_DEFAULT_100(x) (((x) & LADSPA_HINT_DEFAULT_MASK) \
104 | == LADSPA_HINT_DEFAULT_100)
105 | #define LADSPA_IS_HINT_DEFAULT_440(x) (((x) & LADSPA_HINT_DEFAULT_MASK) \
106 | == LADSPA_HINT_DEFAULT_440)
107 | }
108 |
109 | type
110 | PLADSPA_PortRangeHint = ^LADSPA_PortRangeHint;
111 | LADSPA_PortRangeHint = record
112 | HintDescriptor: LADSPA_PortRangeHintDescriptor;
113 | LowerBound: LADSPA_Data;
114 | UpperBound: LADSPA_Data;
115 | end;
116 |
117 | LADSPA_Handle = pointer;
118 | PLADSPA_Descriptor = ^LADSPA_Descriptor;
119 | LADSPA_Descriptor = record
120 | UniqueID: cunsigned;
121 | Label_: PChar;
122 | Properties: LADSPA_Properties; //count
123 | Name: PChar;
124 | Maker: PChar;
125 | Copyright: PChar;
126 | PortCount: cunsigned;
127 | PortDescriptors: PLADSPA_PortDescriptor;
128 | PortNames: PPChar;
129 | PortRangeHints: PLADSPA_PortRangeHint;
130 | ImplementationData: Pointer;
131 | instantiate: function (Descriptor: PLADSPA_Descriptor; SampleRate: cunsigned): LADSPA_Handle;
132 | connect_port: procedure (Instance: LADSPA_Handle; Port: cunsigned; DataLocation: PLADSPA_Data);
133 | activate: procedure (Instance: LADSPA_Handle);
134 | run: procedure (Instance: LADSPA_Handle; SampleCount: cunsigned);
135 | run_adding: procedure (Instance: LADSPA_Handle; SampleCount: cunsigned);
136 | set_run_adding_gain: procedure (Instance: LADSPA_Handle; Gain: LADSPA_Data);
137 | deactivate: procedure (Instance: LADSPA_Handle);
138 | cleanup: procedure (Instance: LADSPA_Handle);
139 | end;
140 |
141 |
142 | LADSPA_DescriptorFunction = function(Index : cunsigned) : PLADSPA_Descriptor;
143 | const
144 | LADSPA_DescriptorExport = 'ladspa_descriptor';
145 |
146 |
147 |
148 | implementation
149 |
150 | end.
151 |
152 |
--------------------------------------------------------------------------------
/pascalaudioio/mp4codec.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of the PascalAudio project.
3 |
4 | Copyright (c) 2020 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and license.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit mp4codec;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils, quicktimeatoms;
22 |
23 | type
24 | TFourCC = quicktimeatoms.TAtomName;
25 |
26 | TMP4CodecClass = class of TMP4Codec;
27 |
28 | { TMP4Codec }
29 |
30 | TMP4Codec = class
31 | protected
32 | FAtom: TAtom;
33 | public
34 | procedure Filter(AData: PByte; ASize: Integer); virtual;
35 | constructor Create(AAtom: TAtom); virtual;
36 | property Atom: TAtom read FAtom;
37 |
38 | end;
39 |
40 | procedure MP4RegisterCodec(ACodec: TMP4CodecClass; AFourCC: TFourCC);
41 | function MP4LookupCodec(AFourCC: TFourCC; out ACodecClass: TMP4CodecClass): Boolean;
42 |
43 | operator := (const A: String): TFourCC;
44 |
45 | implementation
46 | uses
47 | fgl;
48 |
49 | type
50 | TMP4CodecMap = specialize TFPGMap;
51 |
52 | var
53 | gCodecList: TMP4CodecMap;
54 |
55 | procedure MP4RegisterCodec(ACodec: TMP4CodecClass; AFourCC: TFourCC);
56 | begin
57 | gCodecList.AddOrSetData(AFourCC, ACodec);
58 | end;
59 |
60 | function MP4LookupCodec(AFourCC: TFourCC; out ACodecClass: TMP4CodecClass): Boolean;
61 | var
62 | lIndex: Integer;
63 | begin
64 | Result := gCodecList.Find(AFourCC, lIndex);
65 | if Result then
66 | ACodecClass:=gCodecList.Data[lIndex];
67 | end;
68 |
69 | // this already exists for TAtomName but this is duplicated so quicktimeatoms doesn't have to be used
70 | operator:=(const A: String): TFourCC;
71 | begin
72 | if Length(A) <> 4 then
73 | raise Exception.Create('FourCC codes are 4 chars long!');
74 | Result.Chars := A;
75 | end;
76 |
77 | { TMP4Codec }
78 |
79 | procedure TMP4Codec.Filter(AData: PByte; ASize: Integer);
80 | begin
81 | // does nothing.
82 | end;
83 |
84 | constructor TMP4Codec.Create(AAtom: TAtom);
85 | begin
86 | FAtom := AAtom;
87 | end;
88 |
89 | initialization
90 | gCodecList := TMP4CodecMap.Create;
91 | gCodecList.Sorted:=True;
92 |
93 | finalization
94 | gCodecList.Free;
95 |
96 | end.
97 |
98 |
--------------------------------------------------------------------------------
/pascalaudioio/mp4codec_mp4a.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of the PascalAudio project.
3 |
4 | Copyright (c) 2020 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and license.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit mp4codec_mp4a;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils, mp4codec;
22 |
23 | type
24 |
25 | { Tmp4aCodec }
26 |
27 | Tmp4aCodec = class(TMP4Codec)
28 | procedure Filter(AData: PByte; ASize: Integer); override;
29 |
30 | end;
31 |
32 | implementation
33 |
34 | { Tmp4aCodec }
35 |
36 | procedure Tmp4aCodec.Filter(AData: PByte; ASize: Integer);
37 | begin
38 | // do nothing atm. maybe decode data here
39 | end;
40 |
41 | initialization
42 | MP4RegisterCodec(Tmp4aCodec, 'mp4a');
43 |
44 | end.
45 |
46 |
--------------------------------------------------------------------------------
/pascalaudioio/noiseremovalmultichannel.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of Pascal Audio IO package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the file COPYING.modifiedLGPL, included in this distribution,
7 | for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 |
15 | unit noiseremovalmultichannel;
16 |
17 | {$mode objfpc}{$H+}
18 |
19 | interface
20 |
21 | uses
22 | Classes, SysUtils, paio_channelhelper, audacity_noiseremoval;
23 |
24 | type
25 |
26 | TNoiseWriteProc = audacity_noiseremoval.TNoiseWriteProc;
27 |
28 | { TNoiseRemovalChannel }
29 |
30 | TNoiseRemovalChannel = class(TNoiseRemoval, IPAIODataIOInterface)
31 | HasProfile: Boolean;
32 | ProfileComplete: Boolean;
33 | procedure WriteDataIO(ASender: IPAIODataIOInterface; AData: PSingle; ASamples: Integer);
34 | end;
35 |
36 | { TNoiseRemovalMultiChannel }
37 |
38 | TNoiseRemovalMultiChannel = class(IPAIODataIOInterface)
39 | private
40 | FChannels,
41 | FSampleRate: Integer;
42 | FHelper: TPAIOChannelHelper;
43 | FNoise: array of TNoiseRemovalChannel;
44 | FWriteProc: TNoiseWriteProc;
45 | //IPAIODataIOInterface
46 | procedure WriteDataIO(ASender: IPAIODataIOInterface; AData: PSingle; ASamples: Integer);
47 | procedure DataWrite(ASender: TObject; AData: PSingle; ASampleCount: Integer);
48 | public
49 | constructor Create(AChannels: Integer; ASampleRate: Integer);
50 | destructor Destroy; override;
51 | procedure ReadNoiseProfile(AData: PSingle; ASamples: Integer);
52 | procedure ProcessNoise(AData: PSingle; ASamples: Integer);
53 | procedure Flush;
54 | property WriteProc: TNoiseWriteProc read FWriteProc write FWriteProc;
55 | end;
56 |
57 | implementation
58 |
59 | { TMultiChannelNoiseRemoval }
60 |
61 | procedure TNoiseRemovalMultiChannel.WriteDataIO(ASender: IPAIODataIOInterface; AData: PSingle; ASamples: Integer);
62 | begin
63 | if Assigned(FWriteProc) then
64 | FWriteProc(Self, AData, ASamples);
65 | end;
66 |
67 | procedure TNoiseRemovalMultiChannel.DataWrite(ASender: TObject; AData: PSingle; ASampleCount: Integer);
68 | begin
69 | (FHelper as IPAIODataIOInterface).WriteDataIO(ASender as IPAIODataIOInterface, AData, ASampleCount);
70 | end;
71 |
72 | constructor TNoiseRemovalMultiChannel.Create(AChannels: Integer;
73 | ASampleRate: Integer);
74 | var
75 | i: Integer;
76 | begin
77 | FChannels:=AChannels;
78 | FSampleRate:=ASampleRate;
79 | FHelper := TPAIOChannelHelper.Create(Self);
80 | SetLength(FNoise, AChannels);
81 | for i := 0 to High(FNoise) do
82 | begin
83 | FNoise[i] := TNoiseRemovalChannel.Create;
84 | FNoise[i].WriteProc:=@DataWrite;
85 | FNoise[i].Init(ASampleRate);
86 | FHelper.Outputs.Add(FNoise[i] as IPAIODataIOInterface);
87 | end;
88 | end;
89 |
90 | destructor TNoiseRemovalMultiChannel.Destroy;
91 | var
92 | i: Integer;
93 | begin
94 | for i := 0 to High(FNoise) do
95 | begin
96 | FNoise[i].Free;
97 | end;
98 | SetLength(FNoise, 0);
99 | FHelper.Free;
100 | end;
101 |
102 | procedure TNoiseRemovalMultiChannel.ReadNoiseProfile(AData: PSingle;
103 | ASamples: Integer);
104 | var
105 | i: Integer;
106 | begin
107 | FHelper.Write(AData, ASamples);
108 | for i := 0 to High(FNoise) do
109 | begin
110 | FNoise[i].ProfileComplete:=True;
111 | FNoise[i].Process(nil, 0, True, False);
112 | FNoise[i].HasProfile:=True;
113 | FNoise[i].Init(FSampleRate);
114 | end;
115 | end;
116 |
117 | procedure TNoiseRemovalMultiChannel.ProcessNoise(AData: PSingle;
118 | ASamples: Integer);
119 | begin
120 | FHelper.Write(AData, ASamples);
121 | end;
122 |
123 | procedure TNoiseRemovalMultiChannel.Flush;
124 | var
125 | i: Integer;
126 | begin
127 | for i := 0 to High(FNoise) do
128 | FNoise[i].Flush;
129 | end;
130 |
131 | procedure TNoiseRemovalChannel.WriteDataIO(ASender: IPAIODataIOInterface;
132 | AData: PSingle; ASamples: Integer);
133 | begin
134 | Process(AData, ASamples, not HasProfile, not HasProfile);
135 | end;
136 |
137 |
138 | end.
139 |
140 |
141 |
--------------------------------------------------------------------------------
/pascalaudioio/pa_ringbuffer.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of the PascalAudio project.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and license.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_ringbuffer;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils;
22 |
23 | type
24 |
25 | { TRingBuffer }
26 |
27 | TRingBuffer = class
28 | private
29 | FMem: PByte;
30 | FWritePos: Integer;
31 | FReadPos: Integer;
32 | FUsedSpace: Integer;
33 | FTotalSpace: Integer;
34 | function GetFreeSpace: Integer;
35 | public
36 | constructor Create(ASize: Integer);
37 | destructor Destroy; override;
38 | function Write(const ASource; ASize: Integer): Integer;
39 | function Read(var ADest; ASize: Integer): Integer;
40 | property FreeSpace: Integer read GetFreeSpace;
41 | property UsedSpace: Integer read FUsedSpace;
42 |
43 | end;
44 |
45 | implementation
46 |
47 | { TRingBuffer }
48 |
49 | function TRingBuffer.GetFreeSpace: Integer;
50 | begin
51 | Result := FTotalSpace-FUsedSpace;
52 | end;
53 |
54 | constructor TRingBuffer.Create(ASize: Integer);
55 | begin
56 | FMem:=Getmem(ASize);
57 | FTotalSpace:=ASize;
58 | end;
59 |
60 | destructor TRingBuffer.Destroy;
61 | begin
62 | Freemem(FMem);
63 | inherited Destroy;
64 | end;
65 |
66 | function Min(A,B: Integer): Integer;
67 | begin
68 | if A < B then Exit(A);
69 | Result := B;
70 | end;
71 |
72 | function TRingBuffer.Write(const ASource; ASize: Integer): Integer;
73 | var
74 | EOB: Integer; // end of buffer
75 | WSize: Integer;
76 | WTotal: Integer = 0;
77 | begin
78 | if FUsedSpace = 0 then
79 | begin
80 | // give the best chance of not splitting the data at buffer end.
81 | FWritePos:=0;
82 | FReadPos:=0;
83 | end;
84 | if ASize > FreeSpace then
85 | raise Exception.Create('Ring buffer overflow');
86 | Result := ASize;
87 | Inc(FUsedSpace, ASize);
88 | while ASize > 0 do
89 | begin
90 | EOB := FTotalSpace - FWritePos;
91 | WSize := Min(ASize, EOB);
92 | Move(PByte(@ASource)[WTotal], FMem[FWritePos], WSize);
93 | Inc(FWritePos, WSize);
94 | Dec(ASize, WSize);
95 |
96 | if FWritePos >= FTotalSpace then
97 | FWritePos:= 0;
98 | end;
99 | end;
100 |
101 | function TRingBuffer.Read(var ADest; ASize: Integer): Integer;
102 | var
103 | EOB: Integer; // end of buffer
104 | RSize: Integer;
105 | RTotal: Integer = 0;
106 | begin
107 | if ASize > UsedSpace then
108 | raise Exception.Create('Ring buffer underflow');
109 | ASize := Min(ASize, UsedSpace);
110 | Result := ASize;
111 |
112 | Dec(FUsedSpace, ASize);
113 | while ASize > 0 do
114 | begin
115 | EOB := FTotalSpace - FReadPos;
116 | RSize := Min(EOB, ASize);
117 | Move(FMem[FReadPos], PByte(@ADest)[RTotal],RSize);
118 | Dec(ASize, RSize);
119 | Inc(FReadPos, RSize);
120 | if FReadPos >= FTotalSpace then
121 | FReadPos:=0;
122 | end;
123 | end;
124 |
125 | end.
126 |
127 |
--------------------------------------------------------------------------------
/pascalaudioio/paio_channelhelper.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of Pascal Audio IO package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the file COPYING.modifiedLGPL, included in this distribution,
7 | for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit paio_channelhelper;
15 |
16 | {$mode objfpc}{$H+}
17 | {$interfaces corba}
18 |
19 | interface
20 |
21 | uses
22 | Classes, SysUtils, paio_types, pa_ringbuffer;
23 |
24 | type
25 | IPAIODataIOInterface = interface
26 | ['IPAIODataIOInterface']
27 | procedure WriteDataIO(ASender: IPAIODataIOInterface; AData: PSingle; ASamples: Integer);
28 | end;
29 |
30 | { TPAIOChannelHelper }
31 |
32 | TPAIOChannelHelper = class(IPAIODataIOInterface)
33 | private
34 | FOutputs: TList;
35 | FTarget: IPAIODataIOInterface; // where we will send plexed data.
36 | FBuffers: TChannelArray;
37 | FPos: array of Integer;
38 | // called by the individual channel objects.
39 | procedure WriteDataIO(ASender: IPAIODataIOInterface; AData: PSingle; ASamples: Integer);
40 | procedure AllocateBuffers;
41 | procedure SendDataToTarget;
42 | public
43 | constructor Create(APlexedTarget: IPAIODataIOInterface);
44 | destructor Destroy; override;
45 | property Outputs: TList read FOutputs;// of IPAIOSplitterJoinerInterface. Each is a channel in order.
46 | procedure Write(AData: PSingle; ASamples: Integer); // this expects interleaved data.
47 | end;
48 |
49 |
50 | implementation
51 | uses
52 | paio_utils;
53 |
54 | { TPAIOChannelHelper }
55 |
56 | procedure TPAIOChannelHelper.WriteDataIO(ASender: IPAIODataIOInterface; AData: PSingle; ASamples: Integer);
57 | var
58 | BufIndex: Integer;
59 | BufSize, WCount: Integer;
60 | Written: Integer = 0;
61 | begin
62 | BufIndex := FOutputs.IndexOf(Pointer(ASender));
63 |
64 | if BufIndex = -1 then
65 | raise Exception.Create('Trying to write data from an unknown instance');
66 |
67 | AllocateBuffers;
68 |
69 | BufSize := Length(FBuffers[0]);
70 |
71 | While ASamples > 0 do
72 | begin
73 | WCount := Min(BufSize-FPos[BufIndex], ASamples);
74 | Move(AData[Written], FBuffers[BufIndex][0], WCount*SizeOf(Single));
75 | Inc(Written, WCount);
76 | Dec(ASamples, WCount);
77 | Inc(FPos[BufIndex], WCount);
78 |
79 | if BufIndex = High(FBuffers) then
80 | SendDataToTarget;
81 | end;
82 | end;
83 |
84 | procedure TPAIOChannelHelper.AllocateBuffers;
85 | begin
86 | if Length(FBuffers) <> FOutputs.Count then
87 | begin
88 | SetLength(FBuffers, 0);
89 | FBuffers := NewChannelArray(FOutputs.Count, AUDIO_BUFFER_SIZE*2);
90 | SetLength(FPos, FOutputs.Count);
91 | end;
92 | end;
93 |
94 | procedure TPAIOChannelHelper.SendDataToTarget;
95 | var
96 | Plexed: TSingleArray;
97 | HighestCount: Integer = 0;
98 | i: Integer;
99 | begin
100 | for i := 0 to High(FPos) do
101 | if FPos[i] > HighestCount then
102 | HighestCount:=FPos[i];
103 | Plexed := JoinChannels(FBuffers, HighestCount);
104 |
105 | FTarget.WriteDataIO(Self, @Plexed[0], Length(Plexed));
106 |
107 | for i := 0 to High(FPos) do
108 | Dec(FPos[i], HighestCount);
109 | end;
110 |
111 | constructor TPAIOChannelHelper.Create(APlexedTarget: IPAIODataIOInterface);
112 | begin
113 | FOutputs := TList.Create;
114 | FTarget := APlexedTarget;
115 | end;
116 |
117 | destructor TPAIOChannelHelper.Destroy;
118 | begin
119 | FOutputs.Free;
120 | inherited Destroy;
121 | end;
122 |
123 | procedure TPAIOChannelHelper.Write(AData: PSingle; ASamples: Integer);
124 | var
125 | Channels: TChannelArray;
126 | i: Integer;
127 | Pos: Integer = 0;
128 | WCount: Integer;
129 | begin
130 | AllocateBuffers;
131 | Channels := SplitChannels(AData, ASamples, Outputs.Count);
132 | while ASamples > 0 do
133 | begin
134 | WCount := Min(1024, ASamples div Outputs.Count);
135 | for i := 0 to Outputs.Count-1 do
136 | begin
137 | IPAIODataIOInterface(Outputs.Items[i]).WriteDataIO(Self, @Channels[i][Pos], WCount);
138 | end;
139 | Dec(ASamples, WCount * Outputs.Count);
140 | Inc(Pos, WCount);
141 | end;
142 | end;
143 |
144 | end.
145 |
146 |
--------------------------------------------------------------------------------
/pascalaudioio/paio_messagequeue.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of Pascal Audio IO package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 |
15 | {
16 | This implements a threadsafe message queue using a critical section and a
17 | TSimpleEvent. It's pretty generic and could be used in most anything. The
18 | messages are class based so data in a message can be freed easily.
19 | }
20 |
21 | unit paio_messagequeue;
22 |
23 | {$mode objfpc}{$H+}
24 |
25 | interface
26 |
27 | uses
28 | Classes, SysUtils, syncobjs;
29 |
30 | type
31 | TPAIOMessage = class
32 | private
33 | FNext: TPAIOMessage;
34 | FMsg: Integer;
35 | FSimpleData: Variant;
36 | public
37 | constructor Create(AMsg: Integer);
38 | property Message: Integer read FMsg;
39 | property Data: Variant read FSimpleData write FSimpleData;
40 | end;
41 |
42 |
43 | // A threadsafe message queue
44 | TPAIOMessageQueue = class
45 | private
46 | FLock: TRTLCriticalSection;
47 | FFirst: TPAIOMessage;
48 | FLast: TPAIOMessage;
49 | FHasMessage: TSimpleEvent;
50 | procedure FreeMessages;
51 | public
52 | constructor Create;
53 | destructor Destroy; override;
54 | procedure PostMessage(AMessage: TPAIOMessage); // append message to end of the queue
55 | procedure PostMessage(AMsg: Integer; AData: Variant);
56 | procedure PostMessage(AMsg: Integer);
57 | function PopMessage: TPAIOMessage; // remove message from start of the queue
58 | function HasMessage: Boolean;
59 | procedure InsertMessage(AMsg: Integer); // inserts message to the start of the queue to be used in the queue
60 | procedure InsertMessage(AMsg: TPAIOMessage); // inserts message to the start of the queue to be used in the queue
61 | procedure InsertBefore(AMessages: array of Integer; AMsgObject: TPAIOMessage); // message will be inserted before messages of [types]
62 | function WaitMessage(ATimeout: Integer; var AMsg: TPAIOMessage): TWaitResult;
63 | function WaitMessage(ATimeout: Integer): TWaitResult;
64 | end;
65 |
66 | implementation
67 |
68 | { TPAIOMessage }
69 |
70 | constructor TPAIOMessage.Create(AMsg: Integer);
71 | begin
72 | FMsg:=AMsg;
73 | end;
74 |
75 | { TPAIOMessageQueue }
76 |
77 | procedure TPAIOMessageQueue.FreeMessages;
78 | var
79 | Tmp: TPAIOMessage;
80 | begin
81 | EnterCriticalsection(FLock);
82 | try
83 | while Assigned(FFirst) do
84 | begin
85 | Tmp := FFirst;
86 | FFirst := FFirst.FNext;
87 | Tmp.Free;
88 | end;
89 | finally
90 | LeaveCriticalsection(FLock);
91 | end;
92 | end;
93 |
94 | constructor TPAIOMessageQueue.Create;
95 | begin
96 | InitCriticalSection(FLock);
97 | FHasMessage := TSimpleEvent.Create;
98 | end;
99 |
100 | destructor TPAIOMessageQueue.Destroy;
101 | begin
102 | FreeMessages;
103 | FHasMessage.Free;
104 | DoneCriticalsection(FLock);
105 | inherited Destroy;
106 | end;
107 |
108 | procedure TPAIOMessageQueue.PostMessage(AMessage: TPAIOMessage);
109 | begin
110 | EnterCriticalsection(FLock);
111 | try
112 | if not Assigned(FLast) then
113 | begin
114 | FFirst := AMessage;
115 | FLast := AMessage;
116 | end
117 | else
118 | begin
119 | FLast.FNext := AMessage;
120 | FLast := AMessage;
121 | end;
122 |
123 | finally
124 | FHasMessage.SetEvent;
125 | LeaveCriticalsection(FLock);
126 | end;
127 | end;
128 |
129 | procedure TPAIOMessageQueue.PostMessage(AMsg: Integer; AData: Variant);
130 | var
131 | Msg: TPAIOMessage;
132 | begin
133 | Msg := TPAIOMessage.Create(AMsg);
134 | MSg.Data:=AData;
135 | PostMessage(Msg);
136 | end;
137 |
138 | procedure TPAIOMessageQueue.PostMessage(AMsg: Integer);
139 | var
140 | Msg: TPAIOMessage;
141 | begin
142 | Msg := TPAIOMessage.Create(AMsg);
143 | PostMessage(Msg);
144 | end;
145 |
146 |
147 | function TPAIOMessageQueue.PopMessage: TPAIOMessage;
148 | begin
149 | Result := nil;
150 | EnterCriticalsection(FLock);
151 | try
152 | if Assigned(FFirst) then
153 | begin
154 | Result := FFirst;
155 | FFirst := FFirst.FNext;
156 | Result.FNext := nil;
157 | if FFirst = nil then
158 | begin
159 | FLast := nil;
160 | FHasMessage.ResetEvent;
161 | end;
162 | end;
163 | finally
164 | LeaveCriticalsection(FLock);
165 | end;
166 | end;
167 |
168 | function TPAIOMessageQueue.HasMessage: Boolean;
169 | begin
170 | Result := FFirst <> nil;
171 | end;
172 |
173 | procedure TPAIOMessageQueue.InsertMessage(AMsg: Integer);
174 | begin
175 | InsertMessage(TPAIOMessage.Create(AMsg));
176 | end;
177 |
178 | procedure TPAIOMessageQueue.InsertMessage(AMsg: TPAIOMessage);
179 | begin
180 | EnterCriticalsection(FLock);
181 | try
182 | if not Assigned(FFirst) then
183 | begin
184 | FFirst := AMsg;
185 | FLast := AMsg;
186 | end
187 | else
188 | begin
189 | AMsg.FNext := FFirst;
190 | FFirst := AMsg;
191 | end;
192 | finally
193 | FHasMessage.SetEvent;
194 | LeaveCriticalsection(FLock);
195 | end;
196 | end;
197 |
198 | operator in (A: Integer; L: Array of Integer): Boolean;
199 | var
200 | i: Integer;
201 | begin
202 | Result := False;
203 | for i in L do
204 | if i = A then
205 | Exit(True);
206 |
207 | end;
208 |
209 | procedure TPAIOMessageQueue.InsertBefore(AMessages: array of Integer; AMsgObject: TPAIOMessage);
210 | var
211 | Prev: TPAIOMessage = nil;
212 | Current: TPAIOMessage;
213 | begin
214 | if not Assigned(FFirst) then
215 | begin
216 | PostMessage(AMsgObject);
217 | Exit;
218 | end;
219 | EnterCriticalsection(FLock);
220 | try
221 | Current := FFirst;
222 | repeat
223 | if Current.Message in AMessages then
224 | begin
225 | AMsgObject.FNext := Current;
226 | if Assigned(Prev) then
227 | Prev.FNext := AMsgObject
228 | else
229 | FFirst := AMsgObject;
230 | Exit;
231 | end;
232 | Prev := Current;
233 | Current := Current.FNext;
234 | until Current = nil;
235 | if Assigned(FLast) then
236 | FLast.FNext := AMsgObject
237 | else
238 | begin
239 | FFirst := AMsgObject;
240 | FLast := AMsgObject;
241 | end;
242 | finally
243 | LeaveCriticalsection(FLock);
244 | end;
245 | end;
246 |
247 | function TPAIOMessageQueue.WaitMessage(ATimeout: Integer; var AMsg: TPAIOMessage): TWaitResult;
248 | begin
249 | Result := FHasMessage.WaitFor(ATimeout);
250 | if Result = wrSignaled then
251 | AMsg := PopMessage
252 | else
253 | AMsg := nil;
254 | end;
255 |
256 | function TPAIOMessageQueue.WaitMessage(ATimeout: Integer): TWaitResult;
257 | begin
258 | Result := FHasMessage.WaitFor(ATimeout);
259 | end;
260 |
261 | end.
262 |
263 |
--------------------------------------------------------------------------------
/pascalaudioio/paio_ogg_container.pas:
--------------------------------------------------------------------------------
1 | unit paio_ogg_container;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | Classes, SysUtils;
9 |
10 | type
11 |
12 |
13 | { TOggPageHeader }
14 |
15 | POggPageHeader = ^TOggPageHeader;
16 | TOggPageHeader = object
17 | private
18 | function GetisFirstOfLogicalBitstream: Boolean;
19 | function GetisFreshPacket: Boolean;
20 | function GetisLastPageOfLogicalBitstream: Boolean;
21 | public
22 | Signature: array[0..3] of Char; // OggS
23 | Version: Byte;
24 | Flags: Byte;
25 | Position: Int64; // The position after the page has been processed. The page end sample
26 | Serial: DWord;
27 | PageIndex: DWord;
28 | Checksum: DWord;
29 | SegmentsCount: Byte;
30 | SegmentSize: array of Byte; // dynamic. max 255
31 | // The Following are not stored in the header but are determined when the header is read.
32 | _PacketCount: Integer;
33 | _DataSize: Integer;
34 | _LastPacketNeedsNextPage: Boolean;
35 | constructor ReadFromStream(AStream: TStream; AFillOtherData: Boolean);
36 | property isFreshPacket: Boolean read GetisFreshPacket;
37 | property isFirstPageOfLogicalBitstream: Boolean read GetisFirstOfLogicalBitstream;
38 | property isLastPageOfLogicalBitstream: Boolean read GetisLastPageOfLogicalBitstream;
39 | function HeaderSize: Integer;
40 | function SegmentDataSize(out PacketCount: Integer): Integer; // total size of all segment data
41 | function SegmentDataSize: Integer;
42 | function Size: Integer; // header + data size
43 | end;
44 |
45 |
46 |
47 | implementation
48 |
49 | { TOggPageHeader }
50 |
51 | function TOggPageHeader.GetisFirstOfLogicalBitstream: Boolean;
52 | begin
53 | Result := Flags and 2 = 2;
54 | end;
55 |
56 | function TOggPageHeader.GetisFreshPacket: Boolean;
57 | begin
58 | Result := Flags and 1 = 0;
59 | end;
60 |
61 | function TOggPageHeader.GetisLastPageOfLogicalBitstream: Boolean;
62 | begin
63 | Result := Flags and 4 = 4;
64 | end;
65 |
66 | constructor TOggPageHeader.ReadFromStream(AStream: TStream;
67 | AFillOtherData: Boolean);
68 | var
69 | i: Byte;
70 | begin
71 | AStream.Read(Signature, 4);
72 | Version :=AStream.ReadByte;
73 | Flags := AStream.ReadByte;
74 | Position:=LEtoN(AStream.ReadQWord);
75 | Serial:=LEtoN(AStream.ReadDWord);
76 | PageIndex:=LEtoN(AStream.ReadDWord);
77 | Checksum:=LEtoN(AStream.ReadDWord);
78 | SegmentsCount := AStream.ReadByte;
79 | SetLength(SegmentSize, SegmentsCount);
80 | AStream.Read(SegmentSize[0], SegmentsCount);
81 |
82 | _PacketCount := 0;
83 | _DataSize := 0;
84 | _LastPacketNeedsNextPage := False;
85 |
86 | if AFillOtherData then
87 | begin
88 | _LastPacketNeedsNextPage:= ((SegmentsCount > 0) and (SegmentSize[SegmentsCount-1] = 255));
89 | for i := 0 to SegmentsCount-1 do
90 | begin
91 | _DataSize+=SegmentSize[i];
92 | if SegmentSize[i] < 255 then
93 | Inc(_PacketCount);
94 | end;
95 | // packets are not otherwise counted if they don't have a value < 255.
96 | if _LastPacketNeedsNextPage then
97 | Inc(_PacketCount);
98 | end;
99 | end;
100 |
101 | function TOggPageHeader.HeaderSize: Integer;
102 | begin
103 | Result := 26 + (Length(SegmentSize));
104 | end;
105 |
106 | function TOggPageHeader.SegmentDataSize(out PacketCount: Integer): Integer;
107 | var
108 | i: Integer;
109 | begin
110 | Result := 0;
111 | PacketCount:=0;
112 |
113 | for i := 0 to SegmentsCount-1 do
114 | begin
115 | Result += SegmentSize[i];
116 | if SegmentSize[i] < 255 then
117 | Inc(PacketCount);
118 | end;
119 | end;
120 |
121 | function TOggPageHeader.SegmentDataSize: Integer;
122 | var
123 | lDummy: Integer;
124 | begin
125 | Result := SegmentDataSize(lDummy);
126 | end;
127 |
128 | function TOggPageHeader.Size: Integer;
129 | var
130 | lDummy: Integer;
131 | begin
132 | Result := HeaderSize + SegmentDataSize(lDummy);
133 | end;
134 |
135 | end.
136 |
137 |
--------------------------------------------------------------------------------
/pascalaudioio/paio_types.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of Pascal Audio IO package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the file COPYING.modifiedLGPL, included in this distribution,
7 | for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit paio_types;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils;
22 |
23 | const
24 | AUDIO_BUFFER_SIZE = 8192;
25 | AUDIO_BUFFER_FLOAT_SAMPLES = AUDIO_BUFFER_SIZE div 4;
26 |
27 | type
28 | PPSingle = ^PSingle;
29 | TSingleArray = array of Single;
30 | TChannelArray = array of TSingleArray;
31 |
32 | implementation
33 |
34 | end.
35 |
36 |
--------------------------------------------------------------------------------
/pascalaudioio/paio_utils.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of Pascal Audio IO package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the file COPYING.modifiedLGPL, included in this distribution,
7 | for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit paio_utils;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils, paio_types;
22 |
23 |
24 |
25 | function NewChannelArray(AChannels: Integer; ASamplesPerChannel: Integer): TChannelArray;
26 | function SplitChannels(AData: PSingle; ASamples: Integer; AChannels: Integer): TChannelArray;
27 | function JoinChannels(AChannelData: TChannelArray; ASamples: Integer = -1): TSingleArray;
28 | function JoinChannels(AChannelData: PPSingle; AChannels: Integer; ASamples: Integer): TSingleArray;
29 |
30 | function Min(A,B: Integer): Integer;
31 | function Max(A,B: Integer): Integer;
32 |
33 | implementation
34 |
35 | function Min(A,B: Integer): Integer;
36 | begin
37 | if A < B then Exit(A);
38 | Result := B;
39 | end;
40 |
41 | function Max(A,B: Integer): Integer;
42 | begin
43 | if A > B then Exit(A);
44 | Result := B;
45 | end;
46 |
47 | function NewChannelArray(AChannels: Integer; ASamplesPerChannel: Integer): TChannelArray;
48 | var
49 | i: Integer;
50 | begin
51 | SetLength(Result, AChannels);
52 | for i := 0 to AChannels-1 do
53 | SetLength(Result[i], ASamplesPerChannel);
54 | end;
55 |
56 | // Samples is total samples not samples per channel.
57 | // So Samples = 1000 if 2 Channels have 500 each
58 | function SplitChannels(AData: PSingle; ASamples: Integer; AChannels: Integer): TChannelArray;
59 | var
60 | SamplesPerChannel: Integer;
61 | i, j: Integer;
62 | begin
63 | SamplesPerChannel:=ASamples div AChannels;
64 | //SetLength(Result, AChannels);
65 | Result := NewChannelArray(AChannels, SamplesPerChannel);
66 | for i := 0 to AChannels-1 do
67 | begin
68 | //SetLength(Result[i], SamplesPerChannel);
69 | for j := 0 to SamplesPerChannel-1 do
70 | begin
71 | Result[i][j] := AData[j*AChannels+i];
72 | end;
73 | end;
74 | end;
75 |
76 | function JoinChannels(AChannelData: TChannelArray; ASamples: Integer): TSingleArray;
77 | var
78 | i: Integer;
79 | j: Integer;
80 | Samples: Integer;
81 | begin
82 | if Length(AChannelData) > 0 then
83 | begin
84 | if ASamples <> -1 then
85 | Samples := ASamples
86 | else
87 | Samples := Length(AChannelData[0]);
88 |
89 | SetLength(Result, Length(AChannelData) * Samples);
90 | for i := 0 to High(AChannelData) do
91 | for j := 0 to Samples-1 do
92 | Result[j*Length(AChannelData)+i] := AChannelData[i][j];
93 | end
94 | else
95 | SetLength(Result, 0);
96 | end;
97 |
98 | function JoinChannels(AChannelData: PPSingle; AChannels: Integer;
99 | ASamples: Integer): TSingleArray;
100 | var
101 | i: Integer;
102 | j: Integer;
103 | begin
104 | if ASamples > 0 then
105 | begin
106 | SetLength(Result, AChannels * ASamples);
107 | for i := 0 to AChannels-1 do
108 | for j := 0 to ASamples-1 do
109 | Result[j*AChannels+i] := AChannelData[i][j];
110 | end
111 | else
112 | SetLength(Result, 0);
113 |
114 | end;
115 |
116 |
117 | end.
118 |
119 |
--------------------------------------------------------------------------------
/pascalaudioio/paio_vorbis_comment.pas:
--------------------------------------------------------------------------------
1 | unit paio_vorbis_comment;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | Classes, SysUtils;
9 |
10 | type
11 |
12 | { TVorbisComments }
13 |
14 | TVorbisComments = class
15 | private
16 | FUserComments: TStrings;
17 | FVendor: String;
18 | public
19 | constructor Create;
20 | destructor Destroy; override;
21 | procedure LoadFromStream(AStream: TStream);
22 | procedure SaveToStream(AStream: TStream);
23 | published
24 | property Vendor: String read FVendor write FVendor;
25 | property UserComments: TStrings read FUserComments;
26 | end;
27 |
28 | implementation
29 |
30 | { TVorbisComments }
31 |
32 | constructor TVorbisComments.Create;
33 | begin
34 | FUserComments := TStringList.Create;
35 | end;
36 |
37 | destructor TVorbisComments.Destroy;
38 | begin
39 | FUserComments.Free;
40 | inherited Destroy;
41 | end;
42 |
43 | procedure TVorbisComments.SaveToStream(AStream: TStream);
44 | var
45 | s: String;
46 | begin
47 | AStream.WriteDWord(NtoLE(DWord(Length(FVendor))));
48 | AStream.Write(FVendor[1], Length(FVendor));
49 | AStream.WriteDWord(NtoLE(DWord(FUserComments.Count)));
50 | for s in FUserComments do
51 | begin
52 | AStream.WriteDWord(NtoLE(DWord(Length(s))));
53 | AStream.Write(s[1], Length(s));
54 | end;
55 | end;
56 |
57 | procedure TVorbisComments.LoadFromStream(AStream: TStream);
58 | var
59 | lLength, lCount: DWord;
60 | lItem: String;
61 | begin
62 | lLength := LEtoN(AStream.ReadDWord);
63 | SetLength(FVendor, lLength);
64 | AStream.Read(FVendor[1], lLength);
65 |
66 | lCount := LEtoN(AStream.ReadDWord);
67 | while lCount > 0 do
68 | begin
69 | lLength := LEtoN(AStream.ReadDWord);
70 | SetLength(lItem, lLength);
71 | AStream.Read(lItem[1], lLength);
72 | FUserComments.Add(lItem);
73 | Dec(lCount);
74 | end;
75 | // possibly a framing bit after that but we don't try to read it here.
76 | end;
77 |
78 | end.
79 |
80 |
--------------------------------------------------------------------------------
/pascalaudioio/pascalaudioio.lpk:
--------------------------------------------------------------------------------
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 |
--------------------------------------------------------------------------------
/pascalaudioio/pascalaudioio.pas:
--------------------------------------------------------------------------------
1 | { This file was automatically created by Lazarus. Do not edit!
2 | This source is only used to compile and install the package.
3 | }
4 |
5 | unit PascalAudioIO;
6 |
7 | {$warn 5023 off : no warning about unused units}
8 | interface
9 |
10 | uses
11 | ladspa, samplerate, resample, pa_ringbuffer, ladspa_classes,
12 | audacity_noiseremoval, audacity_realfftf, OggHfObject, flac_classes,
13 | paio_types, bs2b, paio_channelhelper, paio_utils, noiseremovalmultichannel,
14 | paio_messagequeue, paio_faad2, paio_mmdevice, mp4codec, mp4codec_mp4a,
15 | quicktimeatoms, quicktimecontainer, paio_opus, paio_ogg_container,
16 | paio_vorbis_comment, paio_ogg_opus, LazarusPackageIntf;
17 |
18 | implementation
19 |
20 | procedure Register;
21 | begin
22 | end;
23 |
24 | initialization
25 | RegisterPackage('PascalAudioIO', @Register);
26 | end.
27 |
--------------------------------------------------------------------------------
/pascalaudioio/quicktimecontainer.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of the PascalAudio project.
3 |
4 | Copyright (c) 2020 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and license.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit quicktimecontainer;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils, quicktimeatoms;
22 |
23 | type
24 |
25 |
26 | TTopLevelAtoms = set of (tla_ftyp, tla_moov, tla_mdat);
27 |
28 | { TQuicktimeContainer }
29 |
30 | TQuicktimeContainer = class
31 | function AtomLoaded(Sender: TAtomList; AAtom: TAtom): Boolean;
32 | private
33 | FPresentAtoms: TTopLevelAtoms;
34 | FAtoms: TAtomList;
35 | FOwnsStream: Boolean;
36 | FStream: TStream;
37 | function GetIsValidFile: Boolean;
38 | procedure LoadTopLevelAtoms;
39 | public
40 | constructor Create(AFilename: String);
41 | constructor Create(AStream: TStream; AOwnsStream: Boolean);
42 | property Atoms: TAtomList read FAtoms;
43 | property Stream: TStream read FStream;
44 | destructor Destroy; override;
45 | property IsValidFile: Boolean read GetIsValidFile;
46 | end;
47 |
48 | // audiodata: 'moov/trak/mdia/mdhd' // samplerate and other stuff too. not channels
49 | // audiodata: 'moov/trak:%d/mdia/minf/stbl/stsd'
50 | // chaptrak: 'moov/trak/tref/chap'
51 | // tags: 'moov/udta/meta/ilst'
52 | // chapframes:'moov/trak:%d/mdia/minf/stbl/stts' // %d is the trak from chaptrak in track 1
53 | // chapters: 'moov/trak:%d/udta/meta/ilst' // %d is the trak from chaptrak in track 1
54 | //
55 |
56 |
57 | implementation
58 |
59 | { TQuicktimeContainer }
60 |
61 | function TQuicktimeContainer.AtomLoaded(Sender: TAtomList; AAtom: TAtom): Boolean;
62 | begin
63 | Result := True;
64 | if FPresentAtoms <> [tla_ftyp, tla_moov, tla_mdat] then
65 | begin
66 | if AAtom.AtomName = 'ftyp' then
67 | Include(FPresentAtoms, tla_ftyp)
68 | else if AAtom.AtomName = 'moov' then
69 | Include(FPresentAtoms, tla_moov)
70 | else if AAtom.AtomName = 'mdat' then
71 | Include(FPresentAtoms, tla_mdat);
72 | if (Sender.Count = 0) and not (tla_ftyp in FPresentAtoms) then
73 | Result := False;
74 | end;
75 | end;
76 |
77 | procedure TQuicktimeContainer.LoadTopLevelAtoms;
78 | var
79 | Atom: TAtom;
80 | begin
81 | FStream.Position:=0;
82 | FAtoms.LoadAtoms(FStream, @AtomLoaded, FStream.Size);
83 | end;
84 |
85 | function TQuicktimeContainer.GetIsValidFile: Boolean;
86 | begin
87 | Result := FPresentAtoms = [tla_ftyp, tla_moov, tla_mdat];
88 | end;
89 |
90 | constructor TQuicktimeContainer.Create(AFilename: String);
91 | var
92 | F: TFileStream;
93 | begin
94 | F := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone);
95 | Create(F, True);
96 | end;
97 |
98 | constructor TQuicktimeContainer.Create(AStream: TStream; AOwnsStream: Boolean);
99 | begin
100 | FOwnsStream := AOwnsStream;
101 | FStream := AStream;
102 |
103 | FAtoms := TAtomList.Create(nil, Self);
104 | LoadTopLevelAtoms;
105 | end;
106 |
107 | destructor TQuicktimeContainer.Destroy;
108 | begin
109 | if FOwnsStream then
110 | FStream.Free;
111 | if Assigned(FAtoms) then
112 | FAtoms.Free;
113 | inherited Destroy;
114 | end;
115 |
116 | end.
117 |
118 |
119 |
--------------------------------------------------------------------------------
/pascalaudioio/resample.pas:
--------------------------------------------------------------------------------
1 | { libresample which this file links to is LGPLv2.1 }
2 | {
3 | This unit is part of the PascalAudio project.
4 |
5 | Copyright (c) 2016 by Andrew Haines.
6 |
7 | See the files COPYING.modifiedLGPL and license.txt, included in this
8 | distribution, for details about the license.
9 |
10 | This program is distributed in the hope that it will be useful,
11 | but WITHOUT ANY WARRANTY; without even the implied warranty of
12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13 | }
14 |
15 | unit resample;
16 |
17 | {$mode objfpc}{$H+}
18 |
19 | {$linklib resample}
20 |
21 | interface
22 |
23 | uses
24 | ctypes, pa_ringbuffer, paio_types;
25 |
26 | type
27 | { TResampleChannel }
28 |
29 | TResampleChannel = class
30 | private
31 | FResample: Pointer;
32 | FOutBuffer: TRingBuffer;
33 | public
34 | constructor Create;
35 | destructor Destroy; override;
36 | function WriteData(AData: PSingle; ASampleCount: Integer; AFactor: Double; AIsLastData: Boolean): Integer;
37 | function ReadData(var ADest; ASize: Integer): Integer;
38 | function ReadSingle: Single;
39 | end;
40 |
41 | { TResampleHelper }
42 |
43 | TResampleHelper = class
44 | Channels: array of TResampleChannel;
45 | //function PlexOutBuffers(out ASamples: Integer): PSingle; // the caller frees this result
46 | function Write(const AData: PSingle; ASampleCount: Integer; AFactor: Double; AIsLastData: Boolean): TSingleArray;
47 |
48 | constructor Create(AChannels: Integer);
49 | destructor Destroy; override;
50 |
51 | end;
52 |
53 | // libresample functions. LGPL
54 | function resample_open(highQuality: cint; minFactor, maxFactor: cdouble): Pointer cdecl; external;
55 |
56 | function resample_dup(handle: pointer): Pointer cdecl; external;
57 |
58 | function resample_get_filter_width(handle: pointer): cint cdecl; external;
59 |
60 | function resample_process(handle: pointer;
61 | factor: cdouble;
62 | inBuffer: pcfloat;
63 | inBufferLen: cint;
64 | lastFlag: cint;
65 | inBufferUsed: pcint;
66 | outBuffer: pcfloat;
67 | outBufferLen: cint): cint cdecl; external;
68 |
69 | procedure resample_close(handle: pointer) cdecl; external;
70 |
71 |
72 |
73 | implementation
74 | uses
75 | sysutils;
76 |
77 | { TResampleChannel }
78 |
79 | constructor TResampleChannel.Create;
80 | begin
81 | FResample := resample_open(1, 0.1, 7.0);
82 | FOutBuffer := TRingBuffer.Create(AUDIO_BUFFER_SIZE*7);
83 | end;
84 |
85 | destructor TResampleChannel.Destroy;
86 | begin
87 | inherited Destroy;
88 | FOutBuffer.Free;
89 | resample_close(FResample);
90 | end;
91 |
92 | function TResampleChannel.WriteData(AData: PSingle; ASampleCount: Integer;
93 | AFactor: Double; AIsLastData: Boolean): Integer;
94 | var
95 | WrittenSamples: cint;
96 | InPos: Integer;
97 | InBufUsed: cint;
98 | OutPos: Integer;
99 | OutBuffer: array[0..AUDIO_BUFFER_SIZE*5] of Single;
100 | begin
101 | InPos := 0;
102 | OutPos := 0;
103 | Result := 0;
104 | repeat
105 | WrittenSamples := resample_process(FResample,
106 | AFactor,
107 | @AData[InPos],
108 | ASampleCount-InPos,
109 | Ord(AIsLastData),
110 | @InBufUsed,
111 | @OutBuffer[0],
112 | Length(OutBuffer));
113 | Inc(InPos, InBufUsed);
114 | //WriteLn('InnerLoop InPos = ', InPos, ' InUsed = ' , InBufUsed, ' Written = ', WrittenSamples, ' SampleCount = ', ASampleCount);
115 | if WrittenSamples > 0 then
116 | begin
117 | Inc(OutPos, WrittenSamples);
118 |
119 | Inc(Result, FOutBuffer.Write(OutBuffer[0], WrittenSamples*SizeOf(Single))div 4);
120 | end;
121 |
122 | until (WrittenSamples = 0) or (InPos = ASampleCount);
123 | //Result := OutPos
124 | end;
125 |
126 | function TResampleChannel.ReadData(var ADest; ASize: Integer): Integer;
127 | begin
128 | Result := FOutBuffer.Read(ADest, ASize);
129 | end;
130 |
131 | function TResampleChannel.ReadSingle: Single;
132 | begin
133 | FOutBuffer.Read(Result, SizeOf(Single));
134 | end;
135 |
136 |
137 | {function TResampleHelper.PlexOutBuffers(out ASamples: Integer): PSingle;
138 | var
139 | i: Integer;
140 | j: Integer;
141 | begin
142 | ASize := Sizeof(Single) * OutBuffersLength[0] ;
143 | Result := GetMem(ASize);
144 | for i := 0 to OutBuffersLength[0]-1 do
145 | begin
146 | for j := 0 to ChannelCount-1 do
147 | Result[i*j] := OutBuffers[j][i];
148 | end;
149 | end;}
150 |
151 | function TResampleHelper.Write(const AData: PSingle; ASampleCount: Integer;
152 | AFactor: Double; AIsLastData: Boolean): TSingleArray;
153 | var
154 | i: Integer;
155 | j: Integer;
156 | OutChannel: array of Single;
157 | SamplesPerChannel: Integer;
158 | WrittenSamples: Integer;
159 | MaxSamples: Integer; // data available across all channels
160 | begin
161 | Result := nil;
162 | MaxSamples := 0;
163 | SamplesPerChannel := ASampleCount div Length(Channels);
164 | SetLength(OutChannel, SamplesPerChannel);
165 | for i := 0 to High(Channels) do begin
166 | for j := 0 to SamplesPerChannel -1 do // BytesPerSample(2) / AChannels
167 | OutChannel[j] := AData[j*Length(Channels)+i]; // to float
168 | WrittenSamples := Channels[i].WriteData(@OutChannel[0], SamplesPerChannel, AFactor, AIsLastData);
169 | //WriteLn(Format('Channel(%d) Wrote %d samples ',[i+1, WrittenSamples]));
170 | if (MaxSamples = 0) or (WrittenSamples < MaxSamples) then
171 | MaxSamples := WrittenSamples;
172 | end;
173 |
174 | SetLength(Result, MaxSamples*Length(Channels));
175 | //Result := Getmem(SizeOf(Single)*MaxSamples*Length(Channels));
176 | for i := 0 to High(Channels) do
177 | for j := 0 to MaxSamples-1 do
178 | Result[j*Length(Channels)+i] := Channels[i].ReadSingle;
179 |
180 | end;
181 |
182 | constructor TResampleHelper.Create(AChannels: Integer);
183 | var
184 | i: Integer;
185 | begin
186 | SetLength(Channels, AChannels);
187 | for i := 0 to High(Channels) do
188 | Channels[i] := TResampleChannel(TResampleChannel.Create);
189 | end;
190 |
191 | destructor TResampleHelper.Destroy;
192 | var
193 | i: Integer;
194 | begin
195 | for i := 0 to High(Channels) do
196 | begin
197 | Channels[i].Free;
198 | end;
199 | inherited Destroy;
200 | end;
201 |
202 | end.
203 |
204 |
--------------------------------------------------------------------------------
/pascalaudioio/samplerate.pas:
--------------------------------------------------------------------------------
1 | {libsamplerate which this file links to is GPL}
2 | (*
3 | ** Copyright (C) 2002-2011 Erik de Castro Lopo
4 | **
5 | ** This program is free software; you can redistribute it and/or modify
6 | ** it under the terms of the GNU General Public License as published by
7 | ** the Free Software Foundation; either version 2 of the License, or
8 | ** (at your option) any later version.
9 | **
10 | ** This program is distributed in the hope that it will be useful,
11 | ** but WITHOUT ANY WARRANTY; without even the implied warranty of
12 | ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 | ** GNU General Public License for more details.
14 | **
15 | ** You should have received a copy of the GNU General Public License
16 | ** along with this program; if not, write to the Free Software
17 | ** Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
18 | */
19 |
20 | /*
21 | ** This code is part of Secret Rabbit Code aka libsamplerate. A commercial
22 | ** use license for this code is available, please see:
23 | ** http://www.mega-nerd.com/SRC/procedure.html
24 | *)
25 |
26 | (*
27 | ** API documentation is available here:
28 | ** http://www.mega-nerd.com/SRC/api.html
29 | *)
30 |
31 | unit samplerate;
32 |
33 | {$mode objfpc}{$H+}
34 | {$packrecords c}
35 | {$linklib samplerate}
36 |
37 | interface
38 |
39 | uses
40 | ctypes;
41 |
42 | type
43 |
44 | //* Opaque data type SRC_STATE. */
45 | PSRC_STATE = ^SRC_STATE;
46 | SRC_STATE = record
47 | end;
48 |
49 | //* SRC_DATA is used to pass data to src_simple() and src_process(). */
50 | PSRC_DATA = ^SRC_DATA;
51 | SRC_DATA = record
52 | data_in,
53 | data_out: pcfloat;
54 |
55 | input_frames,
56 | output_frames: clong;
57 | input_frames_used,
58 | output_frames_gen: clong;
59 |
60 | end_of_input: cint;
61 |
62 | src_ratio: cdouble;
63 | end;
64 |
65 |
66 | //* SRC_CB_DATA is used with callback based API. */
67 | SRC_CB_DATA = record
68 | frames : clong;
69 | data_in: pcfloat;
70 | end;
71 |
72 | (*
73 | ** User supplied callback function type for use with src_callback_new()
74 | ** and src_callback_read(). First parameter is the same pointer that was
75 | ** passed into src_callback_new(). Second parameter is pointer to a
76 | ** pointer. The user supplied callback function must modify *data to
77 | ** point to the start of the user supplied float array. The user supplied
78 | ** function must return the number of frames that **data points to.
79 | *)
80 | ppcfloat = ^pcfloat;
81 | src_callback_t = function(cb_data: pointer; data: ppcfloat): clong; cdecl;
82 |
83 | (*
84 | ** Standard initialisation function : return an anonymous pointer to the
85 | ** internal state of the converter. Choose a converter from the enums below.
86 | ** Error returned in *error.
87 | *)
88 |
89 | function src_new (converter_type: cint; channels: cint; error: pcint): PSRC_STATE; cdecl; external;
90 |
91 | (*
92 | ** Initilisation for callback based API : return an anonymous pointer to the
93 | ** internal state of the converter. Choose a converter from the enums below.
94 | ** The cb_data pointer can point to any data or be set to NULL. Whatever the
95 | ** value, when processing, user supplied function "func" gets called with
96 | ** cb_data as first parameter.
97 | *)
98 |
99 | function src_callback_new (func: src_callback_t; converter_type: cint; channels: cint;
100 | error: pcint;cb_data: pointer): PSRC_STATE; cdecl; external;
101 |
102 | (*
103 | ** Cleanup all internal allocations.
104 | ** Always returns NULL.
105 | *)
106 |
107 | function src_delete (state: PSRC_STATE): PSRC_STATE; cdecl; external;
108 |
109 | (*
110 | ** Standard processing function.
111 | ** Returns non zero on error.
112 | *)
113 |
114 | function src_process (state: PSRC_STATE; data: PSRC_DATA): cint; cdecl; external;
115 |
116 | (*
117 | ** Callback based processing function. Read up to frames worth of data from
118 | ** the converter int *data and return frames read or -1 on error.
119 | *)
120 | function src_callback_read (state: PSRC_STATE; src_ratio: cdouble; frames: clong; data: pcfloat): clong; cdecl; external;
121 |
122 | (*
123 | ** Simple interface for performing a single conversion from input buffer to
124 | ** output buffer at a fixed conversion ratio.
125 | ** Simple interface does not require initialisation as it can only operate on
126 | ** a single buffer worth of audio.
127 | *)
128 | function src_simple (data: PSRC_DATA; converter_type: cint; channels: cint ): cint; cdecl; external;
129 |
130 | (*
131 | ** This library contains a number of different sample rate converters,
132 | ** numbered 0 through N.
133 | **
134 | ** Return a string giving either a name or a more full description of each
135 | ** sample rate converter or NULL if no sample rate converter exists for
136 | ** the given value. The converters are sequentially numbered from 0 to N.
137 | *)
138 |
139 | function src_get_name (converter_type: cint): PChar; cdecl; external;
140 | function src_get_description (converter_type: cint): PChar; cdecl; external;
141 | function src_get_version: PChar; cdecl; external;
142 |
143 | (*
144 | ** Set a new SRC ratio. This allows step responses
145 | ** in the conversion ratio.
146 | ** Returns non zero on error.
147 | *)
148 |
149 | function src_set_ratio (state: PSRC_STATE; new_ratio: cdouble): cint; cdecl; external;
150 |
151 | (*
152 | ** Reset the internal SRC state.
153 | ** Does not modify the quality settings.
154 | ** Does not free any memory allocations.
155 | ** Returns non zero on error.
156 | *)
157 |
158 | function src_reset (state: PSRC_STATE): cint; cdecl; external;
159 |
160 | (*
161 | ** Return TRUE if ratio is a valid conversion ratio, FALSE
162 | ** otherwise.
163 | *)
164 |
165 | function src_is_valid_ratio (ratio: cdouble ): cint; cdecl; external;
166 |
167 | (*
168 | ** Return an error number.
169 | *)
170 |
171 | function src_error (state: PSRC_STATE): cint; cdecl; external;
172 |
173 | (*
174 | ** Convert the error number into a string.
175 | *)
176 | function src_strerror (error: cint): PChar; cdecl; external;
177 |
178 | (*
179 | ** The following enums can be used to set the interpolator type
180 | ** using the function src_set_converter().
181 | *)
182 |
183 | const
184 | SRC_SINC_BEST_QUALITY = 0;
185 | SRC_SINC_MEDIUM_QUALITY = 1;
186 | SRC_SINC_FASTEST = 2;
187 | SRC_ZERO_ORDER_HOLD = 3;
188 | SRC_LINEAR = 4;
189 |
190 |
191 | (*
192 | ** Extra helper functions for converting from short to float and
193 | ** back again.
194 | *)
195 |
196 | procedure src_short_to_float_array (const_in: pcshort; out_data: pcfloat; len: cint) cdecl; external;
197 | procedure src_float_to_short_array (const_in: pcfloat; out_data: pcshort; len: cint); cdecl; external;
198 |
199 | procedure src_int_to_float_array (const_in: pcint; out_data: pcfloat; len: cint); cdecl; external;
200 | procedure src_float_to_int_array (const_in: pcfloat; out_data: pcint; len: cint); cdecl; external;
201 |
202 |
203 | implementation
204 |
205 | end.
206 |
207 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_binaural.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_binaural;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils, pa_base, bs2b;
22 |
23 | type
24 | { TPABinauralLink }
25 |
26 | TPABinauralLink = class(TPAAudioLink, IPAAudioInformation)
27 | private
28 | Fbs2bLevel: LongWord;
29 | Fbs2bLevelCutFreq: LongWord;
30 | Fbs2bLevelFeed: LongWord;
31 | FInstance: Pbs2bd;
32 | FInited: Boolean;
33 | procedure InitData;
34 | protected
35 | function InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64; override;
36 | procedure SignalDestinationsDone; override;
37 | function GetFormat: TPAAudioFormat; override;
38 | public
39 | constructor Create; override;
40 | destructor Destroy; override;
41 | property Level: LongWord read Fbs2bLevel write Fbs2bLevel;
42 | property LevelCutFreq: LongWord read Fbs2bLevelCutFreq write Fbs2bLevelCutFreq;
43 | property LeveLFeed: LongWord read Fbs2bLevelFeed write Fbs2bLevelFeed;
44 | end;
45 |
46 | implementation
47 |
48 | { TPABinauralLink }
49 |
50 | procedure TPABinauralLink.InitData;
51 | begin
52 | FInstance:=Tbs2bd.Open;
53 | FInstance^.SampleRate:=SamplesPerSecond;
54 | FInstance^.Level:=Level;
55 | FInstance^.LevelCutFreq:=LevelCutFreq;
56 | FInstance^.LevelFeed:=LeveLFeed;
57 | end;
58 |
59 | function TPABinauralLink.InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64;
60 | var
61 | Data: PSingle;
62 | Samples: Integer;
63 | B: PAudioBuffer;
64 | begin
65 | if not FInited then
66 | InitData;
67 |
68 | Samples := SizeOf(Single) div ACount div 2;
69 |
70 | B := BufferPool.GetBufferFromPool(True);
71 |
72 | B^.Format:=Format;
73 | Move(AData, B^.Data, ACount);
74 | B^.UsedData:=ACount;
75 | B^.IsEndOfData:=AIsLastData;
76 |
77 |
78 |
79 | FInstance^.CrossFeed_f(@B^.Data, Samples);
80 | WriteToDestinations(B);//}
81 | {
82 |
83 | FInstance^.CrossFeed_f(PSingle(@Data), Samples);
84 | WriteToBuffer(Data, ACount, AIsLastData);//}
85 |
86 |
87 |
88 | Result := ACount;
89 |
90 | if AIsLastData then FInstance^.Clear;
91 | end;
92 |
93 | procedure TPABinauralLink.SignalDestinationsDone;
94 | begin
95 | inherited SignalDestinationsDone;
96 | end;
97 |
98 | function TPABinauralLink.GetFormat: TPAAudioFormat;
99 | begin
100 | Result := afFloat32;
101 | end;
102 |
103 | constructor TPABinauralLink.Create;
104 | begin
105 | inherited Create;
106 | end;
107 |
108 | destructor TPABinauralLink.Destroy;
109 | begin
110 | if FInited then
111 | FInstance^.Close;
112 | inherited Destroy;
113 | end;
114 |
115 | end.
116 |
117 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_cdaudio.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_cdaudio;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 | {$IFDEF UNIX}
20 | uses
21 | Classes, SysUtils,
22 | pa_base,
23 | lincd, cdrom,
24 | discid
25 | ;
26 |
27 | type
28 |
29 | { TPAAudioCDSource }
30 |
31 | TPAAudioCDSource = class(TPAAudioSource)
32 | public
33 | type
34 | TTrackInfo = TTocEntry;
35 | TTracks = array of TTrackInfo;
36 | private
37 | FDevice: String;
38 | FFirstTrack: Integer;
39 | FHandle: Integer;
40 | FInited: Boolean;
41 | FLastTrack: Integer;
42 | FTrackCount: Integer;
43 | FTracks: TTracks;
44 | FFirstFrame: Integer;
45 | FFrameIndex: Integer;
46 | FLastFrame: Integer;
47 | function GetCDDBId: Integer;
48 | function GetTrack(AIndex: Integer): TTrackInfo;
49 | function Inited: Boolean;
50 | procedure DeInit;
51 | procedure SetFirstTrack(AValue: Integer);
52 | procedure SetLastTrack(AValue: Integer);
53 | procedure SetTrackCount(AValue: Integer);
54 | protected
55 | function InternalOutputToDestination: Boolean; override;
56 | public
57 | constructor Create; override;
58 | destructor Destroy; override;
59 | property Device: String read FDevice write FDevice;
60 | property Track[AIndex: Integer]: TTrackInfo read GetTrack;
61 | property TrackCount: Integer read FTrackCount write SetTrackCount;
62 | property FirstTrack: Integer read FFirstTrack write SetFirstTrack;
63 | property LastTrack: Integer read FLastTrack write SetLastTrack;
64 | property CDDBId: Integer read GetCDDBId;
65 | end;
66 |
67 | {$ENDIF}
68 |
69 | implementation
70 | {$IFDEF UNIX}
71 | uses
72 | BaseUnix, Unix;
73 |
74 | { TPAAudioCDSource }
75 |
76 | function TPAAudioCDSource.Inited: Boolean;
77 | var
78 | TocHeader: Tcdrom_tochdr;
79 | TocEntry: Tcdrom_tocentry;
80 | i: Integer;
81 | t: Integer=0;
82 | begin
83 | if FInited then
84 | Exit(True);
85 |
86 | Result := False;
87 |
88 | // check if device not set or device doesn't exist
89 | if not ((FDevice <> '') and FileExists(FDevice)) then
90 | Exit;
91 |
92 | FHandle := FpOpen(FDevice, Open_RdOnly or Open_NonBlock);
93 | if FHandle < 0 then
94 | Exit;
95 |
96 | if FpIOCtl(FHandle, CDROMREADTOCHDR, @TocHeader)<>0 then
97 | Exit;
98 |
99 | if TocHeader.cdth_trk1-TocHeader.cdth_trk0 > 0 then
100 | begin
101 | SetLength(FTracks, TocHeader.cdth_trk1-TocHeader.cdth_trk0 +1);
102 | for i := TocHeader.cdth_trk0 to TocHeader.cdth_trk1 do
103 | begin
104 | TocEntry.cdte_track := i;
105 | TocEntry.cdte_format := CDROM_MSF;
106 | FpIOCtl(FHandle, CDROMREADTOCENTRY, @TocEntry);
107 | FTracks[t].min:=TocEntry.cdte_addr.msf.minute;
108 | FTracks[t].sec:=TocEntry.cdte_addr.msf.second;
109 | FTracks[t].frame:=((TocEntry.cdte_addr.msf.minute*60) + TocEntry.cdte_addr.msf.second) * 75 + TocEntry.cdte_addr.msf.frame;
110 | if i = TocHeader.cdth_trk0 then
111 | FFirstFrame:=FTracks[t].frame;
112 | Inc(t);
113 | end;
114 | // now set the last tracks end position as the end of the cd
115 | TocEntry.cdte_track := $AA;
116 | TocEntry.cdte_format := CDROM_MSF;
117 | FpIOCtl(FHandle, CDROMREADTOCENTRY, @TocEntry);
118 | FTracks[t].min:=TocEntry.cdte_addr.msf.minute;
119 | FTracks[t].sec:=TocEntry.cdte_addr.msf.second;
120 | FTracks[t].frame:=((TocEntry.cdte_addr.msf.minute*60) + TocEntry.cdte_addr.msf.second) * 75 + TocEntry.cdte_addr.msf.frame;
121 | FLastFrame := FTracks[t].frame;
122 | end;
123 |
124 | FFrameIndex:=FFirstFrame;
125 |
126 | FInited:=True;
127 |
128 | Channels:=2;
129 | Format:=afS16;
130 | SamplesPerSecond:=44100;
131 |
132 | if FirstTrack = 0 then
133 | FirstTrack:=1;
134 | if LastTrack = 0 then
135 | LastTrack :=TrackCount;
136 |
137 | FirstTrack:=FFirstTrack;
138 | LastTrack:=FLastTrack;
139 |
140 |
141 | Result := True;
142 | end;
143 |
144 | procedure TPAAudioCDSource.DeInit;
145 | begin
146 | if not FInited then
147 | Exit;
148 | FInited:=False;
149 | if FHandle >= 0 then
150 | FpClose(FHandle);
151 | FHandle:=-1;
152 | SetLength(FTracks, 0);
153 | end;
154 |
155 | procedure TPAAudioCDSource.SetFirstTrack(AValue: Integer);
156 | begin
157 | FFirstTrack:=AValue;
158 | if not Inited then
159 | Exit;
160 | FFirstFrame:=FTracks[AValue-1].frame;
161 | FFrameIndex:=FFirstFrame;
162 | end;
163 |
164 | procedure TPAAudioCDSource.SetLastTrack(AValue: Integer);
165 | begin
166 | FLastTrack:=AValue;
167 | if not Inited then
168 | Exit;
169 |
170 | FLastFrame:=FTracks[AValue].frame;
171 | end;
172 |
173 | procedure TPAAudioCDSource.SetTrackCount(AValue: Integer);
174 | begin
175 | if FTrackCount=AValue then Exit;
176 | FTrackCount:=Length(FTracks);
177 | end;
178 |
179 | function TPAAudioCDSource.GetTrack(AIndex: Integer): TTrackInfo;
180 | begin
181 | if not Inited then
182 | Exit;
183 | Result := FTracks[AIndex];
184 | end;
185 |
186 | function TPAAudioCDSource.GetCDDBId: Integer;
187 | begin
188 | Result := 0;
189 | if not Inited then
190 | Exit;
191 |
192 | Result := CDDBDiscID(FTracks, Length(FTracks));
193 | end;
194 |
195 | function FrameToCDAddr(AFrame: Integer): Tcdrom_addr;
196 | var
197 | Secs: Integer;
198 | begin
199 | Secs := AFrame div 75;
200 | with Result.msf do
201 | begin
202 | frame:= AFrame mod 75;
203 | minute:= Secs div 60;
204 | second:= Secs mod 60;
205 |
206 | WriteLn(Format('%d:%d.%d',[minute,second,frame]));
207 | end;
208 | end;
209 |
210 | function Min(A,B: Integer): Integer;
211 | begin
212 | if A < B then
213 | Exit(A);
214 | Result := B;
215 | end;
216 |
217 | function TPAAudioCDSource.InternalOutputToDestination: Boolean;
218 | const
219 | FRAME_SIZE = 2352;
220 | var
221 | ra: Tcdrom_read_audio;
222 | buffer: array[0..3] of array [0..FRAME_SIZE-1] of byte;
223 | RCount: Integer;
224 | res: BaseUnix.cint;
225 | begin
226 | Result := False;
227 | if not Inited then
228 | Exit;
229 |
230 | RCount := Min(FLastFrame-FFrameIndex, 4);
231 |
232 | ra.addr := FrameToCDAddr(FFrameIndex);
233 | ra.addr_format:=CDROM_MSF;
234 | ra.nframes:=RCount;
235 | ra.buf:=@buffer;
236 |
237 | if RCount > 0 then
238 | begin
239 | res := FpIOCtl(FHandle,CDROMREADAUDIO,@ra);
240 | if Res = 0 then
241 | begin
242 | Inc(FFrameIndex, ra.nframes);
243 | WriteToBuffer(buffer[0], ra.nframes*FRAME_SIZE, FFrameIndex < FLastFrame);
244 | Result := True;
245 | end;
246 |
247 | end;
248 |
249 |
250 | end;
251 |
252 | constructor TPAAudioCDSource.Create;
253 | begin
254 | inherited Create;
255 | FHandle:=-1;
256 | end;
257 |
258 | destructor TPAAudioCDSource.Destroy;
259 | begin
260 | DeInit;
261 | inherited Destroy;
262 | end;
263 | {$ENDIF}
264 | end.
265 |
266 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_dec_oggvorbis.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_dec_oggvorbis;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils,
22 | pa_base,
23 | pa_register,
24 | pa_stream,
25 | paio_messagequeue,
26 | ctypes,
27 | OggHfObject;
28 |
29 | type
30 | { TPAOggVorbisDecoderSource }
31 |
32 | TPAOggVorbisDecoderSource = class(TPAStreamSource, IPAPlayable, IPAStream)
33 | private
34 | FInited: Boolean;
35 | Fogg: TOggDecFloat;
36 | function InitOgg: Boolean;
37 | procedure DeInitOgg;
38 | protected
39 | procedure SetStream(AValue: TStream); override;
40 | function InternalOutputToDestination: Boolean; override;
41 | procedure SignalDestinationsDone; override;
42 | procedure HandleMessage(var AMsg: TPAIOMessage); override;
43 | // IPAPlayable
44 | function CanSeek: Boolean;
45 | function GetPosition: Double;
46 | procedure SetPosition(AValue: Double);
47 | function GetMaxPosition: Double;
48 |
49 | public
50 | constructor Create(AStream: TStream; AOwnsStream: Boolean); override;
51 | procedure InitValues;
52 | //IPAPlayable
53 | procedure Play;
54 | procedure Pause;
55 | procedure Stop;
56 | //IStreamSource
57 | property Stream;
58 | //IPAPlayable
59 | property Position: Double read GetPosition write SetPosition;
60 | property MaxPosition: Double read GetMaxPosition;
61 | end;
62 |
63 | implementation
64 |
65 | { TPAOggVorbisDecoderSource }
66 |
67 | procedure TPAOggVorbisDecoderSource.SetStream(AValue: TStream);
68 | begin
69 | if FStream=AValue then Exit;
70 | if FStream <> nil then
71 | begin
72 | StopData;
73 | DeInitOgg;
74 | end;
75 | inherited SetStream(AValue);
76 |
77 | end;
78 |
79 | function TPAOggVorbisDecoderSource.InitOgg: Boolean;
80 | begin
81 | Result := False;
82 | if FStream = nil then
83 | Exit;
84 |
85 | if FInited then
86 | Exit;
87 |
88 | Fogg := TOggDecFloat.TryCreate(FStream, False);
89 | Channels:=Fogg.Info^.channels;
90 | SamplesPerSecond:=FOgg.Info^.rate;
91 | Format:=afFloat32;
92 | FInited:=True;
93 | Result := True;
94 | end;
95 |
96 | procedure TPAOggVorbisDecoderSource.DeInitOgg;
97 | begin
98 | if not FInited then
99 | Exit;
100 | FInited := False;
101 | FreeAndNil(FOgg);
102 | end;
103 |
104 | function TPAOggVorbisDecoderSource.InternalOutputToDestination: Boolean;
105 | var
106 | ChannelData: PPSingle;
107 | ReadSamples: Integer;
108 | PlexedData: TSingleArray;
109 | BitStream: Integer = 0;
110 | begin
111 | Result := False;
112 | if not FInited then
113 | if not InitOgg then
114 | Exit;
115 |
116 | ReadSamples := FOgg.ReadFloat(ChannelData, AUDIO_BUFFER_FLOAT_SAMPLES div FChannels, @BitStream);
117 |
118 | Result := ReadSamples > 0;
119 |
120 | if Result then
121 | begin
122 | PlexedData := JoinChannels(ChannelData, FChannels, ReadSamples);
123 | WriteToBuffer(PlexedData[0], Length(PlexedData)*SizeOf(Single), ReadSamples<=0);
124 | end
125 | else
126 | SignalDestinationsDone;
127 | end;
128 |
129 | procedure TPAOggVorbisDecoderSource.SignalDestinationsDone;
130 | begin
131 | inherited SignalDestinationsDone;
132 | end;
133 |
134 | procedure TPAOggVorbisDecoderSource.HandleMessage(var AMsg: TPAIOMessage);
135 | begin
136 | case AMsg.Message of
137 | PAM_Seek:
138 | if FInited then
139 | Fogg.TimePosition:=AMsg.Data;
140 | end;
141 | end;
142 |
143 | function TPAOggVorbisDecoderSource.CanSeek: Boolean;
144 | begin
145 | Result := True;
146 | end;
147 |
148 | function TPAOggVorbisDecoderSource.GetPosition: Double;
149 | begin
150 | if not FInited then
151 | Exit(0);
152 | Result := Fogg.TimePosition;
153 |
154 | end;
155 |
156 | procedure TPAOggVorbisDecoderSource.SetPosition(AValue: Double);
157 | begin
158 | if not FInited then
159 | Exit;
160 |
161 | FMsgQueue.PostMessage(PAM_Seek, AValue);
162 | end;
163 |
164 | function TPAOggVorbisDecoderSource.GetMaxPosition: Double;
165 | begin
166 | if not FInited then
167 | Exit(0);
168 |
169 | Result := Fogg.TimeLength;
170 | end;
171 |
172 | constructor TPAOggVorbisDecoderSource.Create(AStream: TStream; AOwnsStream: Boolean);
173 | begin
174 | inherited Create(AStream, AOwnsStream);
175 | Format:=afFloat32;
176 | end;
177 |
178 | procedure TPAOggVorbisDecoderSource.InitValues;
179 | var
180 | Tmp: TOggDecFloat;
181 | begin
182 | Tmp := TOggDecFloat.TryCreate(FStream, False);
183 | Channels:=Tmp.Info^.channels;
184 | SamplesPerSecond:=Tmp.Info^.rate;
185 | Format:=afFloat32;
186 | Tmp.Free;
187 | FStream.Position:=0;
188 | end;
189 |
190 | procedure TPAOggVorbisDecoderSource.Play;
191 | begin
192 |
193 | end;
194 |
195 | procedure TPAOggVorbisDecoderSource.Pause;
196 | begin
197 |
198 | end;
199 |
200 | procedure TPAOggVorbisDecoderSource.Stop;
201 | begin
202 |
203 | end;
204 |
205 | initialization
206 | PARegister(partDecoder, TPAOggVorbisDecoderSource, 'OGG/Vorbis', '.ogg', 'OggS', 4);
207 |
208 | end.
209 |
210 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_enc_oggvorbis.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_enc_oggvorbis;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils,
22 | pa_base,
23 | pa_stream,
24 | pa_register,
25 | ogg, vorbis,
26 | ctypes;
27 |
28 | type
29 |
30 | { TPAOggVorbisEncoderLink }
31 |
32 | TPAOggVorbisEncoderLink = class(TPAStreamDestination)
33 | private
34 | FBigEndian: Boolean;
35 | FOggStream: ogg_stream_state;
36 | FInfo: vorbis_info;
37 | FDSPState: vorbis_dsp_state;
38 | FComment: vorbis_comment;
39 | FBlock: vorbis_block;
40 | FInited: Boolean;
41 | FQuality: cfloat;
42 | FSerialNumber: cint;
43 | FWrittenBytes: Qword;
44 | procedure InitEncoder;
45 | procedure WritePage(ForceFlush: Boolean);
46 | procedure FinishEncode;
47 | protected
48 | function InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64; override;
49 | procedure EndOfData; override;
50 | procedure SetStream(AValue: TStream); override;
51 |
52 | public
53 | constructor Create(AStream: TStream; AOwnsStream: Boolean); override;
54 | function GetWrittenSeconds: QWord;
55 | procedure AddComment(TagName: Utf8String; Content: Utf8String);
56 | property Quality: cfloat read FQuality write FQuality;
57 | property SerialNumber: cint read FSerialNumber write FSerialNumber;
58 | property BigEndian: Boolean read FBigEndian write FBigEndian;
59 | end;
60 |
61 | implementation
62 |
63 | { TPAOggVorbisEncoderLink }
64 |
65 | procedure TPAOggVorbisEncoderLink.InitEncoder;
66 | var
67 | Pkt: ogg_packet;
68 | PktComment: ogg_packet;
69 | PktCode: ogg_packet;
70 | begin
71 | if FInited then
72 | Exit;
73 |
74 | vorbis_info_init(FInfo);
75 | vorbis_encode_setup_vbr(FInfo, Channels, SamplesPerSecond, 1 / Quality);
76 | vorbis_encode_setup_init(FInfo);
77 | vorbis_analysis_init(FDSPState, FInfo);
78 | vorbis_block_init(FDSPState, FBlock);
79 | ogg_stream_init(FOggStream, SerialNumber);
80 |
81 | vorbis_analysis_headerout(FDSPState, FComment, Pkt, PktComment, PktCode);
82 | ogg_stream_packetin(FOggStream, Pkt);
83 | ogg_stream_packetin(FOggStream, PktComment);
84 | ogg_stream_packetin(FOggStream, PktCode);
85 |
86 | WritePage(True);
87 | FInited:=True;
88 | end;
89 |
90 | procedure TPAOggVorbisEncoderLink.WritePage(ForceFlush: Boolean);
91 | var
92 | Page: ogg_page;
93 | w: Boolean;
94 | begin
95 | repeat
96 | if ForceFlush then
97 | w := ogg_stream_flush(FOggStream, Page) <> 0
98 | else
99 | w := ogg_stream_pageout(FOggStream, Page) <> 0;
100 | if w then
101 | begin
102 | //WriteLn('ogg writing to destinations');
103 | //WriteToBuffer(Page.header^,Page.header_len, False);
104 | //WriteToBuffer(Page.body^,Page.body_len, False);
105 | FStream.Write(Page.header^,Page.header_len);
106 | FStream.Write(Page.body^,Page.body_len);
107 | //WriteLn('ogg wrote to destinations');
108 | end
109 | else
110 | break;
111 | until False;
112 | end;
113 |
114 | type
115 | Tvorbis_analysisHack = function(var block: vorbis_block; op: pOgg_packet): cint; cdecl;
116 |
117 |
118 | procedure TPAOggVorbisEncoderLink.FinishEncode;
119 | var
120 | op: ogg_packet;
121 | begin
122 | //WriteLn('Finishing encode');
123 | vorbis_analysis_wrote(FDSPState, 0);
124 | while vorbis_analysis_blockout(FDSPState, FBlock) = 1 do
125 | begin
126 | if Tvorbis_analysisHack(@vorbis_analysis)(FBlock, @op) = 0 then
127 | ogg_stream_packetin(FOggStream, op);
128 | end;
129 | // Flush ogg data to Destinations
130 | WritePage(True);
131 |
132 | ogg_stream_clear(FOggStream);
133 | vorbis_block_clear(FBlock);
134 | vorbis_dsp_clear(FDSPState);
135 | vorbis_info_clear(FInfo);
136 | vorbis_comment_clear(FComment);
137 |
138 | FInited:=False;
139 | end;
140 |
141 | function TPAOggVorbisEncoderLink.InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64;
142 | var
143 | buffer: ppcfloat;
144 | i: Integer;
145 | j: Integer;
146 | samples: Integer;
147 | op: ogg_packet;
148 | res: Integer;
149 | begin
150 | if not FInited then
151 | InitEncoder;
152 | //WriteLn('ogg process data. Ended=',FDataIsEnded);
153 | // move to end;
154 | Result := ACount;
155 |
156 | Inc(FWrittenBytes, ACount);
157 |
158 | Samples := ACount div (BytesPerSample(afFloat32) * Channels);
159 | if samples > 0 then
160 | begin
161 | // split the channels into contigous data from interleaved.
162 | buffer := vorbis_analysis_buffer(FDSPState, samples);
163 | for j := 0 to Channels-1 do
164 | for i := 0 to samples-1 do
165 | buffer[j][i] := PSingle(@AData)[i*channels+j];
166 |
167 | vorbis_analysis_wrote(FDSPState, samples);
168 |
169 | while vorbis_analysis_blockout(FDSPState, FBlock) = 1 do
170 | begin
171 | Tvorbis_analysisHack(@vorbis_analysis)(FBlock, nil);
172 | vorbis_bitrate_addblock(FBlock);
173 | while vorbis_bitrate_flushpacket(FDSPState, op) > 0 do
174 | ogg_stream_packetin(FOggStream, op);
175 | end;
176 |
177 | end;
178 | WritePage(False or AIsLastData);
179 | {if AIsLastData then
180 | FinishEncode;}
181 | end;
182 |
183 | procedure TPAOggVorbisEncoderLink.EndOfData;
184 | begin
185 | FinishEncode;
186 | inherited EndOfData;
187 | end;
188 |
189 | procedure TPAOggVorbisEncoderLink.SetStream(AValue: TStream);
190 | begin
191 | inherited SetStream(AValue);
192 | if Assigned(AValue) then
193 | begin
194 | FSerialNumber:=1;
195 | vorbis_comment_init(FComment);
196 | end;
197 | end;
198 |
199 | constructor TPAOggVorbisEncoderLink.Create(AStream: TStream; AOwnsStream: Boolean);
200 | begin
201 | inherited Create(AStream, AOwnsStream);
202 | FFormat:=afRaw;
203 | end;
204 |
205 | function TPAOggVorbisEncoderLink.GetWrittenSeconds: QWord;
206 | begin
207 | if FWrittenBytes = 0 then
208 | Exit(0);
209 | Result := FWrittenBytes div BytesPerSample(DefaultAudioFormat) div Channels div SamplesPerSecond;
210 | end;
211 |
212 | procedure TPAOggVorbisEncoderLink.AddComment(TagName: Utf8String; Content: Utf8String);
213 | begin
214 | vorbis_comment_add_tag(FComment,PChar(TagName),PChar(Content));
215 | end;
216 |
217 | initialization
218 | PARegister(partEncoder, TPAOggVorbisEncoderLink, 'OGG/Vorbis', '.ogg', 'OggS');
219 | end.
220 |
221 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_flac.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_flac;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils, pa_base, flac_classes, pa_register, pa_stream, paio_messagequeue;
22 |
23 | type
24 | TPAFlacSource = class (TPAStreamSource, IPAStream, IPAPlayable)
25 | protected
26 | procedure SetStream(AValue: TStream); override;
27 | procedure HandleMessage(var AMsg: TPAIOMessage); override;
28 | private
29 | FFlac: TFlacStreamDecoder;
30 | FIgnore: Boolean;
31 | function HandleData(Sender: TFlacStreamDecoder; ASamples: Integer; AChannels: Integer; AChannelData: PPLongInt): Boolean;
32 | // IPAPlayable
33 | function CanSeek: Boolean;
34 | function GetPosition: Double;
35 | procedure SetPosition(AValue: Double);
36 | function GetMaxPosition: Double;
37 |
38 | procedure InternalSetPosition(APosition: Double);
39 | protected
40 | function InternalOutputToDestination: Boolean; override;
41 | public
42 | procedure Play;
43 | procedure Pause;
44 | procedure Stop;
45 | property Position: Double read GetPosition write SetPosition;
46 | property MaxPosition: Double read GetMaxPosition;
47 | property Stream;
48 | end;
49 |
50 | implementation
51 |
52 | uses
53 | paio_types;
54 |
55 | { TPAFlacSource }
56 |
57 | procedure TPAFlacSource.SetStream(AValue: TStream);
58 | begin
59 | if Assigned(FFlac) then
60 | FreeAndNil(FFlac);
61 |
62 | inherited SetStream(AValue);
63 |
64 | if not Assigned(FStream) then
65 | Exit;
66 |
67 | FFlac := TFlacStreamDecoder.Create(FStream, False);
68 | FFlac.OnOutput:=@HandleData;
69 | FFlac.ProcessUntilEndOfMetadata;
70 |
71 | Channels:=FFlac.Channels;
72 | SamplesPerSecond:=FFlac.SampleRate;
73 | case FFlac.BitsPerSample of
74 | 16: Format:=afS16;
75 | else
76 | raise Exception.Create('unsupported flac data type');
77 | end;
78 | end;
79 |
80 | procedure TPAFlacSource.HandleMessage(var AMsg: TPAIOMessage);
81 | begin
82 | case AMsg.Message of
83 | PAM_Seek:
84 | begin
85 | InternalSetPosition(AMsg.Data);
86 | end;
87 | end;
88 | end;
89 |
90 | function TPAFlacSource.HandleData(Sender: TFlacStreamDecoder; ASamples: Integer; AChannels: Integer; AChannelData: PPLongInt): Boolean;
91 | var
92 | ChannelsData: array[0..7] of SmallInt; // 16 bit signed. max 8 channels
93 | i, j: Integer;
94 | Msg: TPAIOMessage;
95 | begin
96 | Result := True;
97 | if FIgnore then
98 | Exit;
99 | if FMsgQueue.HasMessage then
100 | begin
101 | Msg := FMsgQueue.PopMessage;
102 |
103 | case Msg.Message of
104 | PAM_Seek:
105 | begin
106 | InternalSetPosition(Msg.Data);
107 | Msg.Free;
108 | end
109 | else
110 | FMsgQueue.InsertBefore([Msg.Message], Msg);
111 | end;
112 |
113 | end;
114 |
115 | for i := 0 to ASamples-1 do
116 | begin
117 | // plex channels
118 | for j := 0 to AChannels-1 do
119 | begin
120 | ChannelsData[j] := AChannelData[j][i];
121 | end;
122 | WriteToBuffer(ChannelsData[0],SizeOf(Smallint)*AChannels, False);
123 | end;
124 | end;
125 |
126 | function TPAFlacSource.CanSeek: Boolean;
127 | begin
128 | Result := True;
129 | end;
130 |
131 | function TPAFlacSource.GetPosition: Double;
132 | begin
133 | if not Assigned(FFlac) then
134 | Exit(0);
135 | Result := FFlac.DecodedSamplePosition / SamplesPerSecond;
136 | end;
137 |
138 | procedure TPAFlacSource.SetPosition(AValue: Double);
139 | begin
140 | FMsgQueue.PostMessage(PAM_Seek, AValue);
141 | end;
142 |
143 | function TPAFlacSource.GetMaxPosition: Double;
144 | begin
145 | REsult := FFlac.TotalSamples / SamplesPerSecond;
146 | end;
147 |
148 | procedure TPAFlacSource.InternalSetPosition(APosition: Double);
149 | begin
150 | FIgnore:=True;
151 | try
152 | FFlac.Flush;
153 | FFlac.SeekAbsolute(Trunc(APosition * SamplesPerSecond));
154 | finally
155 | FIgnore:=False;
156 | end;
157 | end;
158 |
159 | function TPAFlacSource.InternalOutputToDestination: Boolean;
160 | begin
161 | Result := FFlac.ProcessSingle;
162 | if not Result or (FFlac.State = fsdsEndOfStream) then
163 | begin
164 | Result := False;
165 | FFlac.Flush;
166 | SignalDestinationsDone;
167 | end;
168 | end;
169 |
170 | procedure TPAFlacSource.Play;
171 | begin
172 |
173 | end;
174 |
175 | procedure TPAFlacSource.Pause;
176 | begin
177 |
178 | end;
179 |
180 | procedure TPAFlacSource.Stop;
181 | begin
182 |
183 | end;
184 |
185 | initialization
186 | PARegister(partDecoder, TPAFlacSource, 'FLAC', '.flac', 'fLaC', 4);
187 | end.
188 |
189 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_ladspa.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_ladspa;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils,
22 | pa_base, ladspa_classes;
23 |
24 | type
25 |
26 | { TPALADSPALink }
27 |
28 | TPALADSPALink = class(TPAAudioLink, IPAAudioInformation)
29 | private
30 | FInstance: TLADSPAInstance;
31 | FInited: Boolean;
32 | procedure InitData;
33 | protected
34 | function InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64; override;
35 | procedure SignalDestinationsDone; override;
36 | public
37 | constructor Create(AInstance: TLADSPAInstance);
38 | destructor Destroy; override;
39 | property LADSPA: TLADSPAInstance read FInstance;
40 | end;
41 |
42 | implementation
43 |
44 | { TPALADSPALink }
45 |
46 | procedure TPALADSPALink.InitData;
47 | begin
48 | FInited:=True;
49 | FInstance.Reset; // starting new data stream
50 | end;
51 |
52 | function TPALADSPALink.InternalProcessData(const AData; ACount: Int64;
53 | AIsLastData: Boolean): Int64;
54 | var
55 | ChannelData: TChannelArray;
56 | InputPorts: TLADSPAInstance.TPortArray;
57 | OutputPorts: TLADSPAInstance.TPortArray;
58 | i: Integer;
59 | OutputData: TChannelArray;
60 | PlexedData: TSingleArray;
61 | SamplesPerChannel: Integer;
62 | begin
63 | if not FInited then
64 | InitData;
65 |
66 | ChannelData := SplitChannels(PSingle(@AData), ACount div SizeOf(Single), Channels);
67 | SamplesPerChannel := Length(ChannelData[0]);
68 | InputPorts := FInstance.AudioInputs;
69 | OutputPorts := FInstance.AudioOutputs;
70 |
71 | SetLength(OutputData, Channels);
72 |
73 | for i := 0 to High(InputPorts) do
74 | InputPorts[i].SetValue(@ChannelData[i][0]);
75 |
76 | for i := 0 to High(OutputPorts) do
77 | begin
78 | // allocate output data the same size
79 | SetLength(OutputData[i], SamplesPerChannel);
80 | OutputPorts[i].SetValue(@OutputData[i][0]);
81 | end;
82 |
83 | FInstance.Run(SamplesPerChannel);
84 |
85 | PlexedData := JoinChannels(OutputData);
86 |
87 | WriteToBuffer(PlexedData[0], Length(PlexedData)*SizeOf(Single), AIsLastData);
88 | end;
89 |
90 | procedure TPALADSPALink.SignalDestinationsDone;
91 | begin
92 | inherited SignalDestinationsDone;
93 | end;
94 |
95 | constructor TPALADSPALink.Create(AInstance: TLADSPAInstance);
96 | begin
97 | Inherited Create;
98 | FInstance := AInstance;
99 | end;
100 |
101 | destructor TPALADSPALink.Destroy;
102 | begin
103 | inherited Destroy;
104 | end;
105 |
106 | end.
107 |
108 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_lists.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_lists;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils;
22 |
23 | type
24 | PPAFifoItem = ^TPAFifoItem;
25 | TPAFifoItem = record
26 | Item: Pointer;
27 | Next: PPAFifoItem;
28 | end;
29 |
30 | { TPAFifoList }
31 |
32 | TPAFifoList = class
33 | private
34 | FCrit: TRTLCriticalSection;
35 | FFirst: PPAFifoItem;
36 | FLast: PPAFifoItem;
37 | FCount: Integer;
38 | public
39 | procedure AddObject(AObject: TObject);
40 | function GetObject: TObject;
41 | procedure AddItem(AItem: Pointer);
42 | function GetItem: Pointer;
43 | function Count: Integer;
44 | function Contains(AItem: Pointer): Boolean;
45 | constructor Create;
46 | destructor Destroy; override;
47 | end;
48 |
49 | implementation
50 |
51 | { TPAFifoList }
52 |
53 | procedure TPAFifoList.AddObject(AObject: TObject);
54 | begin
55 | AddItem(Pointer(AObject));
56 | end;
57 |
58 | function TPAFifoList.GetObject: TObject;
59 | begin
60 | Result:= TObject(GetItem);
61 | end;
62 |
63 | procedure TPAFifoList.AddItem(AItem: Pointer);
64 | var
65 | Tmp: PPAFifoItem;
66 | begin
67 | if AItem = nil then
68 | begin
69 | WriteLn('Added nil item to list!');
70 | Exit;
71 | end;
72 | New(Tmp);
73 | Tmp^.Item:=AItem;
74 | Tmp^.Next:=nil;
75 | try
76 | EnterCriticalsection(FCrit);
77 | if FFirst = nil then
78 | FFirst := Tmp
79 | else
80 | FLast^.Next := Tmp;
81 | FLast := Tmp;
82 | Inc(FCount);
83 | finally
84 | LeaveCriticalsection(FCrit);
85 | end;
86 | end;
87 |
88 | function TPAFifoList.GetItem: Pointer;
89 | var
90 | Tmp: PPAFifoItem;
91 | begin
92 | Result := nil;
93 | try
94 | EnterCriticalsection(FCrit);
95 | if FFirst <> nil then
96 | begin
97 | Tmp := FFirst;
98 | Result := Tmp^.Item;
99 | FFirst := Tmp^.Next;
100 |
101 | // check if we just used the last item in the list
102 | if Tmp = FLast then
103 | FLast := nil;
104 | Dec(FCount);
105 | Dispose(Tmp);
106 |
107 | end;
108 | finally
109 | LeaveCriticalsection(FCrit);
110 | end;
111 | end;
112 |
113 | function TPAFifoList.Count: Integer;
114 | begin
115 | Result := FCount;
116 | end;
117 |
118 | function TPAFifoList.Contains(AItem: Pointer): Boolean;
119 | var
120 | Tmp: PPAFifoItem;
121 | begin
122 | Result := False;
123 | EnterCriticalsection(FCrit);
124 | try
125 | Tmp := FFirst;
126 | while Tmp <> nil do
127 | begin
128 | if Tmp^.Item = AItem then
129 | Exit(True);
130 | Tmp := Tmp^.Next;
131 | end;
132 | finally
133 | LeaveCriticalsection(FCrit);
134 | end;
135 | end;
136 |
137 | constructor TPAFifoList.Create;
138 | begin
139 | InitCriticalSection(FCrit);
140 | FFirst:=nil;
141 | FLast:=nil;
142 | end;
143 |
144 | destructor TPAFifoList.Destroy;
145 | var
146 | Tmp: PPAFifoItem;
147 | begin
148 | FLast:=nil;
149 | while FFirst <> nil do
150 | begin
151 | Tmp := FFirst^.Next;
152 | Dispose(FFirst);
153 | FFirst:=Tmp;
154 | end;
155 |
156 | DoneCriticalsection(FCrit);
157 | inherited Destroy;
158 | end;
159 |
160 | end.
161 |
162 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_m4a.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2019 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_m4a;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils,
22 | pa_base,
23 | pa_register,
24 | pa_stream,
25 | paio_faad2,
26 | paio_messagequeue,
27 | quicktimecontainer,
28 | quicktimeatoms,
29 | mp4codec;
30 |
31 | type
32 |
33 | { TPAM4ADecoderSource }
34 |
35 | TPAM4ADecoderSource = class(TPAStreamSource, IPAPlayable, IPAStream)
36 | private
37 | FInited: Boolean;
38 | FDecoder: TAACDecoder;
39 | FContainer: TQuicktimeContainer;
40 | FSampleIndex: Integer;
41 | FSampleTable: array of LongWord;
42 | FChunkOffset: array of LongWord;
43 | FChunkTable: TstscAtom;
44 | FTimeToSample: TsttsAtom;
45 | FFrame: TNeAACDecFrameInfo;
46 | FBuffer: array[0..1023] of Byte;
47 | FSampleSize: Integer;
48 | FCodec: TMP4Codec;
49 | function ReadNextSample: Boolean;
50 | procedure InitAudio;
51 | procedure DeInitAudio;
52 | protected
53 | procedure SetStream(AValue: TStream); override;
54 | function InternalOutputToDestination: Boolean; override;
55 | procedure HandleMessage(var AMsg: TPAIOMessage); override;
56 | function GetPosition: Double;
57 | procedure SetPosition(AValue: Double);
58 | function GetMaxPosition: Double;
59 | public
60 | function CanSeek: Boolean;
61 | procedure Play;
62 | procedure Pause;
63 | procedure Stop;
64 | property Position: Double read GetPosition write SetPosition;
65 | property MaxPosition: Double read GetMaxPosition;
66 | constructor Create(AStream: TStream; AOwnsStream: Boolean=True); override;
67 | end;
68 |
69 | implementation
70 |
71 | { TPAM4ADecoderSource }
72 |
73 | function TPAM4ADecoderSource.ReadNextSample: Boolean;
74 | var
75 | i: Integer;
76 | lFirstIndex, lChunkIndex: DWord;
77 | lSamplesOffset: DWord = 0;
78 | begin
79 | Result := FSampleIndex < Length(FSampleTable);
80 | if not Result then
81 | Exit;
82 | //WriteLn('Sample index: ', FSampleIndex);
83 | FSampleSize := FSampleTable[FSampleIndex];
84 | //WriteLn('Sample Size: ', FSampleSize);
85 |
86 | lChunkIndex := FChunkTable.SampleIndexToChunkIndex(1, FSampleIndex, lFirstIndex);
87 |
88 | for i := lFirstIndex to FSampleIndex-1 do
89 | Inc(lSamplesOffset, FSampleTable[i]);
90 |
91 | FContainer.Stream.Position:=FChunkOffset[lChunkIndex] + lSamplesOffset;
92 | FContainer.Stream.Read(FBuffer[0], FSampleSize);
93 |
94 | if Assigned(FCodec) then
95 | FCodec.Filter(@FBuffer[0], FSampleSize);
96 | Inc(FSampleIndex);
97 | {Write(Pred(FSampleIndex), ': ');
98 | for i := 0 to 7 do
99 | Write('0x'+HexStr(FBuffer[i], 2)+' ');
100 | WriteLn;}
101 | end;
102 |
103 | procedure TPAM4ADecoderSource.InitAudio;
104 | var
105 | lmp4aAtom: TSoundSampleDecriptionAtom;
106 | lesds: TesdsAtom;
107 |
108 | lBuf: Array[0..254] of Byte;
109 | lConfig: Word;
110 | lSize: Integer;
111 | lSampleTable: TstszAtom;
112 | lSampleOffSet: TstcoAtom;
113 | lDecoderConfig: PNeAACDecConfiguration;
114 | lmp4ASC: Tmp4AudioSpecificConfig;
115 | lstsdAtom: TstsdAtom;
116 | lCodecClass: TMP4CodecClass;
117 | begin
118 | if FInited then
119 | Exit;
120 | FInited:=True;
121 | FContainer := TQuicktimeContainer.Create(FStream, False);
122 | if not FContainer.IsValidFile then
123 | begin
124 | DeInitAudio;
125 | Exit;
126 | end;
127 |
128 | FChunkTable := TstscAtom(FContainer.Atoms.FindAtom('moov/trak/mdia/minf/stbl/stsc'));
129 | FTimeToSample := TsttsAtom(FContainer.Atoms.FindAtom('moov/trak/mdia/minf/stbl/stts'));
130 |
131 | lSampleTable := TstszAtom(FContainer.Atoms.FindAtom('moov/trak/mdia/minf/stbl/stsz'));
132 | SetLength(FSampleTable, lSampleTable.SampleCount);
133 | //Writeln(Length(FSampleTable), ' samples');
134 | lSampleTable.CopySampleTable(@FSampleTable[0]);
135 |
136 | lSampleOffSet := TstcoAtom(FContainer.Atoms.FindAtom('moov/trak/mdia/minf/stbl/stco'));
137 | SetLength(FChunkOffset, lSampleOffSet.Count);
138 | lSampleOffSet.CopyTable(@FChunkOffset[0]);
139 |
140 | lstsdAtom := TstsdAtom(FContainer.Atoms.FindAtom('moov/trak/mdia/minf/stbl/stsd'));
141 |
142 |
143 | lmp4aAtom := TSoundSampleDecriptionAtom(lstsdAtom.Atoms.Atom[0]);
144 | //WriteLn(lmp4aAtom.ClassName);
145 | //WriteLn(lmp4aAtom.AtomName.Chars);
146 |
147 | if MP4LookupCodec(lmp4aAtom.AtomName, lCodecClass) then
148 | begin
149 | FCodec := lCodecClass.Create(lmp4aAtom);
150 | end;
151 |
152 | if lmp4aAtom = nil then
153 | begin
154 | DeInitAudio;
155 | Exit;
156 | end;
157 |
158 | lesds := TesdsAtom(lmp4aAtom.Atoms.FindAtom('esds'));
159 | lConfig:=lesds.DecoderConfig;
160 |
161 |
162 |
163 | FDecoder := TAACDecoder.Create;
164 | lDecoderConfig := FDecoder.Config;
165 | //WriteLn(FDecoder.GetErroMessage(FDecoder.LastResult));;
166 | lDecoderConfig^.outputFormat:=ord(FAAD_FMT_FLOAT);
167 | FDecoder.Config := lDecoderConfig;
168 |
169 | FDecoder.Init2(@lConfig, 2);
170 |
171 | FDecoder.AudioSpecificConfig(@lConfig, 2, @lmp4ASC);
172 |
173 | //WriteLn(FDecoder.Channels);
174 | Channels:=FDecoder.Channels;
175 | SamplesPerSecond:=FDecoder.SampleRate;
176 |
177 | end;
178 |
179 | procedure TPAM4ADecoderSource.DeInitAudio;
180 | begin
181 | if not FInited then
182 | Exit;
183 | FInited:=False;
184 | if Assigned(FContainer) then
185 | begin
186 | Freeandnil(FContainer);
187 | FreeAndNil(FDecoder);
188 | end;
189 | end;
190 |
191 | procedure TPAM4ADecoderSource.SetStream(AValue: TStream);
192 | begin
193 | if FStream=AValue then Exit;
194 | if FStream <> nil then
195 | begin
196 | StopData;
197 | DeInitAudio;
198 | end;
199 | inherited SetStream(AValue);
200 | end;
201 |
202 | function TPAM4ADecoderSource.InternalOutputToDestination: Boolean;
203 | var
204 | lRes: Pointer;
205 | lSampleBuffer: array[0..2047] of Byte;
206 | begin
207 | if not FInited then
208 | InitAudio;
209 |
210 |
211 | Result := ReadNextSample;
212 |
213 | if Result then
214 | begin
215 | lRes := FDecoder.Decode(@FFrame, @FBuffer[0], FSampleSize);
216 | if FFrame.error <> 0 then
217 | WriteLn('Error: ', FDecoder.GetErroMessage(FFrame.error));
218 |
219 | if (FFrame.samples > 0) then
220 | begin
221 | WriteToBuffer(lRes^,FFrame.samples*4, False);
222 | end;
223 | {
224 |
225 | WriteLn(SysUtils.Format('Dec Bytes: %d, data := 0x%s Samples: %d', [FFrame.bytesconsumed, Hexstr(PtrUint(lRes), 16), FFrame.samples]));
226 | //if FFrame.;
227 | if (FFrame.error > 0) or (FFrame.bytesconsumed > 0) or (lRes <> nil) then
228 | begin
229 |
230 | writeln;
231 | end; }
232 | end;
233 |
234 | //sleep(1000);
235 |
236 |
237 |
238 |
239 |
240 | end;
241 |
242 | procedure TPAM4ADecoderSource.HandleMessage(var AMsg: TPAIOMessage);
243 | var
244 | lSample, lSampleIndex: Int64;
245 | lOffset: Integer;
246 | begin
247 | case AMsg.Message of
248 | PAM_Seek:
249 | if FInited then
250 | begin
251 | lSample := Trunc((SamplesPerSecond / Channels) * AMsg.Data);
252 | lSampleIndex := FTimeToSample.FindSampleIndex(lSample, lOffset);
253 | FSampleIndex:=lSampleIndex;
254 | end;
255 | end;
256 | end;
257 |
258 | function TPAM4ADecoderSource.GetPosition: Double;
259 | begin
260 | if not FInited then
261 | Exit(0);
262 | Result := FTimeToSample.FindSampleFromIndex(FSampleIndex) / SamplesPerSecond;
263 | end;
264 |
265 | procedure TPAM4ADecoderSource.SetPosition(AValue: Double);
266 | begin
267 | if not FInited then
268 | Exit;
269 |
270 | FMsgQueue.PostMessage(PAM_Seek, AValue);
271 | end;
272 |
273 | function TPAM4ADecoderSource.GetMaxPosition: Double;
274 | begin
275 | Result := FTimeToSample.TotalSamples / SamplesPerSecond;
276 | WriteLn('Channels: ', Channels, ' SPS: ', SamplesPerSecond);
277 | end;
278 |
279 | function TPAM4ADecoderSource.CanSeek: Boolean;
280 | begin
281 | Result := True;
282 | end;
283 |
284 | procedure TPAM4ADecoderSource.Play;
285 | begin
286 |
287 | end;
288 |
289 | procedure TPAM4ADecoderSource.Pause;
290 | begin
291 |
292 | end;
293 |
294 | procedure TPAM4ADecoderSource.Stop;
295 | begin
296 |
297 | end;
298 |
299 | constructor TPAM4ADecoderSource.Create(AStream: TStream; AOwnsStream: Boolean);
300 | begin
301 | inherited Create(AStream, AOwnsStream);
302 | Format:=afFloat32;
303 | end;
304 |
305 | initialization
306 | PARegister(partDecoder, TPAM4ADecoderSource, 'MP4audio', '.m4a', 'ftyp', 4, 4); // ftyp is at 4 offset
307 |
308 | end.
309 |
310 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_mmdevice.pas:
--------------------------------------------------------------------------------
1 | unit pa_mmdevice;
2 |
3 | {$mode objfpc}{$H+}
4 | {$ifdef windows}
5 |
6 | interface
7 |
8 | uses
9 | Classes, windows, SysUtils, paio_mmdevice, pa_base, pa_register;
10 |
11 |
12 | type
13 |
14 | { TPAMMDestination }
15 |
16 | TPAMMDestination = class(TPAAudioDestination)
17 | private
18 | FEnum: TMMDeviceEnumerator;
19 | FDevice: TMMDevice;
20 | FClient: TAudioClient;
21 | FRender: TAudioRenderClient;
22 | FMixFormat: PWaveFormatEx;
23 | FBufferSize: Integer;
24 | procedure Init;
25 | procedure DeInit;
26 | protected
27 | function InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64; override;
28 |
29 | public
30 | constructor Create; override;
31 | destructor Destroy; override;
32 | end;
33 |
34 | implementation
35 |
36 | { TPAMMDestination }
37 |
38 | procedure TPAMMDestination.Init;
39 | var
40 | lFormat: TWaveFormatEx;
41 | begin
42 | if Assigned(FRender) then
43 | Exit;
44 | WriteLn('init');
45 |
46 | FClient := FDevice.ActivateClient;
47 | FClient.Initialize(AUDCLNT_SHAREMODE_SHARED, 0, 10000000, 0, FMixFormat);
48 | FBufferSize := FClient.BufferSize;
49 |
50 | FRender := FClient.GetRenderClient;
51 | WriteLn('init end');
52 | end;
53 |
54 | procedure TPAMMDestination.DeInit;
55 | begin
56 | if not Assigned(FRender) then
57 | Exit;
58 |
59 | FClient.Stop;
60 | FreeAndNil(FRender);
61 |
62 | end;
63 |
64 | function TPAMMDestination.InternalProcessData(const AData; ACount: Int64;
65 | AIsLastData: Boolean): Int64;
66 | var
67 | lmmData: PByte;
68 | lFrameCount, lDuration: Integer;
69 | lSpaceAvailable, lGetAmount: DWORD;
70 | lDataSize: DWORD;
71 | lData: PByte;
72 | lStart: Boolean;
73 | begin
74 | Result := ACount;
75 |
76 | if not Assigned(FDevice) then
77 | Exit;
78 |
79 | lStart:=False;
80 | if not Assigned(FRender) then
81 | begin
82 | lStart := True;
83 | Init;
84 | end;
85 |
86 | lData := @AData;
87 |
88 |
89 | // WriteLn('loop');
90 | while ACount > 0 do
91 | begin
92 | lFrameCount := ACount div BytesPerSample(Format) div Channels;
93 | if lStart then
94 | lSpaceAvailable:=FBufferSize
95 | else
96 | lSpaceAvailable := FClient.CurrentPadding;
97 |
98 | lGetAmount := lSpaceAvailable;
99 | if lSpaceAvailable > lFrameCount then
100 | lGetAmount := lFrameCount;
101 |
102 | if FRender.GetBuffer(lGetAmount, @lmmData) then
103 | begin
104 | lDataSize := lGetAmount * Channels * BytesPerSample(Format);
105 | Move(lData^, lmmData^, lDataSize);
106 | FRender.ReleaseBuffer(lGetAmount, 0);
107 | Inc(lData, lDataSize);
108 | Dec(ACount, lDataSize);
109 | if lStart then
110 | begin
111 | WriteLn('start');
112 | FClient.start;
113 | lStart:=False;
114 | end;
115 | lDuration := lGetAmount * (1000 div SamplesPerSecond);
116 | Sleep(1);//lDuration div 2);
117 | end;
118 | end;
119 | //sleep(100);
120 | // WriteLn('loop end');
121 |
122 | if AIsLastData then
123 | DeInit;
124 | end;
125 |
126 | constructor TPAMMDestination.Create;
127 | begin
128 | inherited Create;
129 | FEnum := TMMDeviceEnumerator.Create;
130 | FDevice := FEnum.GetDefaultAudioEndpoint(eRender, eMultimedia);
131 | FClient := FDevice.ActivateClient;
132 | FClient.GetMixFormat(FMixFormat);
133 | Channels := FMixFormat^.nChannels;
134 | SamplesPerSecond := FMixFormat^.nSamplesPerSec;
135 | Format:= afFloat32;
136 | end;
137 |
138 | destructor TPAMMDestination.Destroy;
139 | begin
140 | DeInit;
141 | FreeAndNil(FClient);
142 | FreeAndNil(FDevice);
143 | FreeAndNil(FEnum);
144 | inherited Destroy;
145 | Writeln('Destroyed Device');
146 | end;
147 |
148 | initialization
149 | PARegister(partDeviceOut, TPAMMDestination, 'MMDevice');
150 |
151 | {$else}
152 | interface
153 | implementation
154 | {$endif}
155 | end.
156 |
157 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_noiseremoval.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_noiseremoval;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils, pa_base, audacity_noiseremoval, paio_channelhelper;
22 |
23 | type
24 | { TPANoiseRemovalLink }
25 |
26 | TPANoiseRemovalLink = class(TPAAudioLink, IPAAudioInformation, IPAIODataIOInterface)
27 | private
28 | FInited: Boolean;
29 | FNoise: array of TNoiseRemoval;
30 | FHelper: TPAIOChannelHelper;
31 | FIsLast: Boolean;
32 | procedure InitData;
33 | procedure NoiseRemovalDone(ASender: TObject; AData: PSingle; ASampleCount: Integer);
34 | procedure WriteDataIO(ASender: IPAIODataIOInterface; AData: PSingle; ASamples: Integer);
35 | protected
36 | function InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64; override;
37 | procedure SignalDestinationsDone; override;
38 | function GetFormat: TPAAudioFormat; override;
39 | public
40 | constructor Create; override;
41 | destructor Destroy; override;
42 |
43 | // set this before we staret processing but after datasource is assigned.
44 | procedure SetNoiseProfile(AChannel: Integer; AData: PSingle; ASampleCount: Integer);
45 | end;
46 |
47 | implementation
48 |
49 | type
50 |
51 | { TPANoiseRemval }
52 |
53 | TPANoiseRemoval = class(TNoiseRemoval, IPAIODataIOInterface)
54 | procedure WriteDataIO(ASender: IPAIODataIOInterface; AData: PSingle; ASamples: Integer);
55 | end;
56 |
57 | { TPANoiseRemval }
58 |
59 | procedure TPANoiseRemoval.WriteDataIO(ASender: IPAIODataIOInterface; AData: PSingle; ASamples: Integer);
60 | begin
61 | Process(AData, ASamples, False);
62 | end;
63 |
64 | { TPANoiseRemovalLink }
65 |
66 | procedure TPANoiseRemovalLink.InitData;
67 | var
68 | i: Integer;
69 | begin
70 | if FInited then
71 | Exit;
72 |
73 | FInited := True;
74 | if Assigned(FHelper) then
75 | FreeAndNil(FHelper);
76 | FHelper := TPAIOChannelHelper.Create(Self);
77 |
78 | SetLength(FNoise, Channels);
79 | for i := 0 to Channels-1 do
80 | begin
81 | FNoise[i] := TPANoiseRemoval.Create;
82 | FHelper.Outputs.Add(FNoise[i] as IPAIODataIOInterface);
83 | //FNoise[i].Level:=30; //does nothing!
84 | //FNoise[i].Sensitivity:=20;//3.95;
85 | //FNoise[i].Sensitivity:=9.95;
86 | // FNoise[i].Gain:=-48;
87 | // FNoise[i].AttackDecayTime:=1000;
88 | FNoise[i].Init(SamplesPerSecond);
89 | FNoise[i].WriteProc:=@NoiseRemovalDone;
90 | end;
91 |
92 | end;
93 |
94 | procedure TPANoiseRemovalLink.NoiseRemovalDone(ASender: TObject; AData: PSingle; ASampleCount: Integer);
95 | begin
96 | (FHelper as IPAIODataIOInterface).WriteDataIO(ASender as IPAIODataIOInterface, AData, ASampleCount);
97 | end;
98 |
99 | procedure TPANoiseRemovalLink.WriteDataIO(ASender: IPAIODataIOInterface; AData: PSingle; ASamples: Integer);
100 | begin
101 | // write plexed output from FHelper to buffer.
102 | WriteToBuffer(AData^, ASamples*SizeOf(Single), FIsLast);
103 | end;
104 |
105 | function TPANoiseRemovalLink.InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64;
106 | var
107 | i: Integer;
108 | begin
109 | FHelper.Write(PSingle(@AData), ACount div SizeOf(Single));
110 | FIsLast:=AIsLastData;
111 | if FIsLast then
112 | for i := Low(FNoise) to High(FNoise) do
113 | FNoise[i].Flush;
114 | end;
115 |
116 | procedure TPANoiseRemovalLink.SignalDestinationsDone;
117 | begin
118 | inherited SignalDestinationsDone;
119 | end;
120 |
121 | function TPANoiseRemovalLink.GetFormat: TPAAudioFormat;
122 | begin
123 | Result:=afFloat32;
124 | end;
125 |
126 | constructor TPANoiseRemovalLink.Create;
127 | begin
128 | inherited Create;
129 | Format := afFloat32;
130 | end;
131 |
132 | destructor TPANoiseRemovalLink.Destroy;
133 | begin
134 | FHelper.Free;
135 | inherited Destroy;
136 | end;
137 |
138 | procedure TPANoiseRemovalLink.SetNoiseProfile(AChannel: Integer; AData: PSingle;
139 | ASampleCount: Integer);
140 | var
141 | Profile: TSingleArray;
142 | begin
143 | InitData;
144 | FNoise[AChannel].Process(AData, ASampleCount, True);
145 |
146 | Profile := FNoise[AChannel].NoiseProfile;
147 | // call init again because inited is false after Setting the noise profile.
148 | FNoise[AChannel].Init(SamplesPerSecond);
149 | end;
150 |
151 | end.
152 |
153 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_ogg_opus.pas:
--------------------------------------------------------------------------------
1 | unit pa_ogg_opus;
2 |
3 | {$mode objfpc}{$H+}
4 |
5 | interface
6 |
7 | uses
8 | Classes, SysUtils,
9 | pa_base,
10 | pa_register,
11 | pa_stream,
12 | paio_messagequeue,
13 | paio_ogg_opus;
14 | type
15 |
16 | { TPAOggOpusDecoderSource }
17 |
18 | TPAOggOpusDecoderSource = class(TPAStreamSource, IPAPlayable, IPAStream)
19 | private
20 | FInited: Boolean;
21 | FOpus: TOggOpusDecoder;
22 | FBuffer: array of Byte;
23 | function InitOpus: Boolean;
24 | procedure DeInitOpus;
25 | protected
26 | procedure SetStream(AValue: TStream); override;
27 | function InternalOutputToDestination: Boolean; override;
28 | procedure SignalDestinationsDone; override;
29 | procedure HandleMessage(var AMsg: TPAIOMessage); override;
30 | // IPAPlayable
31 | function CanSeek: Boolean;
32 | function GetPosition: Double;
33 | procedure SetPosition(AValue: Double);
34 | function GetMaxPosition: Double;
35 | function GetSamplesPerSecond: Integer; override;
36 | public
37 | constructor Create(AStream: TStream; AOwnsStream: Boolean); override;
38 | procedure InitValues;
39 | //IPAPlayable
40 | procedure Play;
41 | procedure Pause;
42 | procedure Stop;
43 | //IStreamSource
44 | property Stream;
45 | //IPAPlayable
46 | property Position: Double read GetPosition write SetPosition;
47 | property MaxPosition: Double read GetMaxPosition;
48 |
49 | end;
50 |
51 | implementation
52 |
53 | uses paio_opus;
54 |
55 | { TPAOggOpusDecoderSource }
56 |
57 | function TPAOggOpusDecoderSource.InitOpus: Boolean;
58 | begin
59 | Result := False;
60 | if FStream = nil then
61 | Exit;
62 |
63 | if FInited then
64 | Exit;
65 |
66 | try
67 | FOpus := TOggOpusDecoder.Create(FStream);
68 | except
69 | // invalid file
70 | FInited := False;
71 | FOpus := nil; // shouldn't be set...just to be clear
72 | end;
73 | FOpus.InitDecoder;
74 | Channels:=FOpus.Channels;
75 |
76 | SetLength(FBuffer, TOpusDecoder.GetSize(Channels));
77 |
78 | SamplesPerSecond:=48000;
79 | Format:=afFloat32;
80 | FInited:=True;
81 | Result := True;
82 | end;
83 |
84 | procedure TPAOggOpusDecoderSource.DeInitOpus;
85 | begin
86 | if not FInited then
87 | Exit;
88 | FInited:=False;
89 | SetLength(FBuffer, 0);
90 | FreeAndNil(FOpus);
91 | end;
92 |
93 | procedure TPAOggOpusDecoderSource.SetStream(AValue: TStream);
94 | begin
95 | inherited SetStream(AValue);
96 | end;
97 |
98 | function TPAOggOpusDecoderSource.InternalOutputToDestination: Boolean;
99 | var
100 | ReadSamples: Integer;
101 | begin
102 | Result := False;
103 | if not FInited then
104 | if not InitOpus then
105 | Exit;
106 |
107 | ReadSamples := FOpus.DecodePacket(@FBuffer[0], Length(FBuffer), True);
108 |
109 | Result := ReadSamples > 0;
110 |
111 | if Result then
112 | begin
113 | WriteToBuffer(FBuffer[0], ReadSamples * SizeOf(Single) * Channels , ReadSamples<=0);
114 | end
115 | else
116 | SignalDestinationsDone;
117 | end;
118 |
119 | procedure TPAOggOpusDecoderSource.SignalDestinationsDone;
120 | begin
121 | inherited SignalDestinationsDone;
122 | end;
123 |
124 | procedure TPAOggOpusDecoderSource.HandleMessage(var AMsg: TPAIOMessage);
125 | var
126 | lPosition: QWord;
127 | begin
128 | case AMsg.Message of
129 | PAM_Seek:
130 | begin
131 | if FInited then
132 | begin
133 | lPosition:=QWord(AMsg.Data);
134 | // will constrain it
135 | FOpus.SamplePosition:=lPosition;
136 | end;
137 | end;
138 | end;
139 | end;
140 |
141 | function TPAOggOpusDecoderSource.CanSeek: Boolean;
142 | begin
143 | Result := True;
144 | end;
145 |
146 | function TPAOggOpusDecoderSource.GetPosition: Double;
147 | begin
148 | if not FInited then
149 | Result := 0.0
150 | else
151 | Result := FOpus.SamplePosition / SamplesPerSecond;
152 | end;
153 |
154 | procedure TPAOggOpusDecoderSource.SetPosition(AValue: Double);
155 | begin
156 | if not FInited then
157 | Exit;
158 | FMsgQueue.PostMessage(PAM_Seek, Trunc(AValue*SamplesPerSecond));
159 | end;
160 |
161 | function TPAOggOpusDecoderSource.GetMaxPosition: Double;
162 | begin
163 | if not FInited then
164 | Result := 0.0
165 | else
166 | Result := FOpus.TotalSamples / SamplesPerSecond;
167 | end;
168 |
169 | function TPAOggOpusDecoderSource.GetSamplesPerSecond: Integer;
170 | begin
171 | // technically this can be multiple things. 48000, 24000, 12000 etc.
172 | Result:=48000;
173 | end;
174 |
175 | constructor TPAOggOpusDecoderSource.Create(AStream: TStream;
176 | AOwnsStream: Boolean);
177 | begin
178 | inherited Create(AStream, AOwnsStream);
179 | Format := afFloat32
180 | end;
181 |
182 | procedure TPAOggOpusDecoderSource.InitValues;
183 | var
184 | Tmp: TOggOpusDecoder;
185 | begin
186 | Tmp := TOggOpusDecoder.Create(Stream);
187 | try
188 | FChannels:=Tmp.Channels;
189 | Format:=afFloat32;
190 | finally
191 | Tmp.Free;
192 | end;
193 | end;
194 |
195 | procedure TPAOggOpusDecoderSource.Play;
196 | begin
197 |
198 | end;
199 |
200 | procedure TPAOggOpusDecoderSource.Pause;
201 | begin
202 |
203 | end;
204 |
205 | procedure TPAOggOpusDecoderSource.Stop;
206 | begin
207 |
208 | end;
209 |
210 | end.
211 |
212 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_process.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_process;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils, pa_base, process;
22 |
23 | type
24 |
25 | { TPAProcessSource }
26 |
27 | TPAProcessSource = class;
28 |
29 | //useful to continue generating data for output from multiple commands
30 | TPAProcessEndedEvent = procedure (ASource: TPAProcessSource; var ARunAgain: Boolean)of Object;
31 |
32 | TPAProcessSource = class(TPAAudioSource, IPAAudioInformation)
33 | protected
34 | FProcess: TProcess;
35 | //used by DoProcessEnded;
36 | FRunAgain: Boolean;
37 | FAllowProcessAccess: Boolean;
38 | procedure RunProcess;
39 | procedure BeforeExecuteLoop; override;
40 | function InternalOutputToDestination: Boolean; override;
41 | private
42 | FOnProcessEnded: TPAProcessEndedEvent;
43 | function GetProcess: TProcess;
44 | // IPAAudioInformation
45 | procedure DoProcessEnded;
46 | public
47 | constructor Create; override;
48 | destructor Destroy; override;
49 | property Process: TProcess read GetProcess; // returns nil once started
50 | property OnProcessEnded: TPAProcessEndedEvent read FOnProcessEnded write FOnProcessEnded;
51 | end;
52 |
53 | implementation
54 |
55 | { TPAProcessSource }
56 |
57 | procedure TPAProcessSource.RunProcess;
58 | begin
59 | //WriteLn('Running Process');
60 | FProcess.Execute;
61 | end;
62 |
63 | procedure TPAProcessSource.BeforeExecuteLoop;
64 | begin
65 | inherited BeforeExecuteLoop;
66 | RunProcess;
67 | end;
68 |
69 | function TPAProcessSource.InternalOutputToDestination: Boolean;
70 | var
71 | Buf: array[0..AUDIO_BUFFER_SIZE-1] of byte;
72 | RCount: Integer;
73 | begin
74 | while (FProcess.Stderr.NumBytesAvailable > 0) do
75 | begin
76 | // clear stderr
77 | RCount := FProcess.Stderr.NumBytesAvailable;
78 | if RCount > SizeOf(Buf) then
79 | RCount := SizeOf(Buf);
80 | FProcess.Stderr.Read(Buf, RCount);
81 | Write(StdErr,Copy(PChar(@Buf),0,RCount));
82 | end;
83 |
84 | if FProcess.Running or (FProcess.Output.NumBytesAvailable > 0) then
85 | begin
86 | RCount := FProcess.Output.NumBytesAvailable;
87 | //WriteLn('Read ', RCount);
88 | if RCount > SizeOf(Buf) then
89 | RCount := SizeOf(Buf);
90 | RCount := FProcess.Output.Read(Buf, SizeOf(Buf));
91 | if RCount > 0 then
92 | WriteToBuffer(Buf, RCount, False);
93 | end;
94 |
95 | // still data left so call again
96 | if (FProcess.Output.NumBytesAvailable > 0) then
97 | Exit(True);
98 |
99 | // process is still running so there might be more data
100 | if FProcess.Running then
101 | Exit(True)
102 | else
103 | ;//WriteLn('Exit Status = ', FProcess.ExitStatus);
104 |
105 | // last chance for more data. check to run process again
106 | if Assigned(FOnProcessEnded) then
107 | begin
108 | Synchronize(@DoProcessEnded);
109 | if FRunAgain then
110 | begin
111 | // if the callback want's us to run the process again with possibly new
112 | // commands, do it to keep generating data
113 | RunProcess;
114 | Exit(True);
115 | end;
116 | end;
117 |
118 | // there is no data and no running process so we're done
119 | Result := False;
120 | SignalDestinationsDone;
121 | end;
122 |
123 | function TPAProcessSource.GetProcess: TProcess;
124 | begin
125 | // FAllowProcessAccess is set and unset in DoProcessEnded to allow access safely when syncing
126 |
127 | if Working and (not FAllowProcessAccess) then
128 | Exit(nil);
129 | Result := FProcess;
130 | end;
131 |
132 | procedure TPAProcessSource.DoProcessEnded;
133 | begin
134 | // run from synchronize
135 | //WriteLn('Checking want more');
136 | FAllowProcessAccess:=True;
137 | FRunAgain:=False;
138 | if Assigned(FOnProcessEnded) then
139 | FOnProcessEnded(Self, FRunAgain);
140 | FAllowProcessAccess:=False;
141 | end;
142 |
143 | constructor TPAProcessSource.Create;
144 | begin
145 | inherited Create;
146 | FProcess := TProcess.Create(nil);
147 | FProcess.Options:=[poUsePipes, poNoConsole];
148 | end;
149 |
150 | destructor TPAProcessSource.Destroy;
151 | begin
152 | if FProcess.Running then
153 | FProcess.Terminate(0);
154 | FProcess.Free;
155 | inherited Destroy;
156 | end;
157 |
158 | end.
159 |
160 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_pulse_simple.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_pulse_simple;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 | {$IFDEF USEPULSE}
20 | uses
21 | Classes, SysUtils, pa_base, pa_register, pulse_simple;
22 |
23 |
24 | type
25 | { TPAPulseDestination }
26 |
27 | TPAPulseDestination = class(TPAAudioDestination)
28 | private
29 | FPulse: PPASimple;
30 | FInited: Boolean;
31 | procedure Init;
32 | procedure DeInit;
33 | protected
34 | function InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64; override;
35 | public
36 | constructor Create; override;
37 | destructor Destroy; override;
38 | end;
39 | {$ENDIF}
40 |
41 | implementation
42 | {$IFDEF USEPULSE}
43 | uses
44 | pulse_error, pulse_def, pulse_sample, ctypes;
45 |
46 |
47 | { TPAPulseDestination }
48 |
49 | procedure TPAPulseDestination.Init;
50 | var
51 | SS: TPASampleSpec;
52 | Info: IPAAudioInformation;
53 | error: cint;
54 | begin
55 | FInited:=True;
56 | Info := DataSource.GetSourceObject as IPAAudioInformation;
57 | SS.Init;
58 | SS.Channels:=Info.Channels;
59 | SS.Rate:=Info.SamplesPerSecond;
60 | SS.Format:=sfFloat32LE;
61 |
62 | //WriteLn('Pulse Channels = ', SS.Channels);
63 | //Writeln('Pulse Rate = ', SS.Rate);
64 |
65 | FPulse:=TPASimple.New(nil,PChar(ParamStr(0)),sdPLAYBACK, nil, 'test', @SS, nil, nil, @error);
66 | if error < 0 then
67 | WriteLn('Error initing pulse data ',pa_strerror(error));
68 | end;
69 |
70 | procedure TPAPulseDestination.DeInit;
71 | begin
72 | FPulse^.Drain(nil);
73 | FPulse^.Free;
74 | FPulse := nil;
75 | FInited:=False;
76 | EndOfData;
77 | end;
78 |
79 | function TPAPulseDestination.InternalProcessData(const AData; ACount: Int64;
80 | AIsLastData: Boolean): Int64;
81 | var
82 | Error: cint;
83 | begin
84 | if not FInited then
85 | Init;
86 | Result := ACount;
87 | //WriteLn('Writing to pulse');
88 | FPulse^.Write(@AData, ACount, @error);
89 | if error < 0 then
90 | WriteLn('Error Writin pulse data ',pa_strerror(error));
91 | if AIsLastData then
92 | DeInit;
93 | end;
94 |
95 | constructor TPAPulseDestination.Create;
96 | begin
97 | BufferPool.AllocateBuffers(4);
98 | inherited Create;
99 | Format := afFloat32;
100 | end;
101 |
102 |
103 | destructor TPAPulseDestination.Destroy;
104 | begin
105 | inherited Destroy;
106 | end;
107 | initialization
108 | PARegister(partDeviceOut, TPAPulseDestination, 'PulseAudio');
109 | {$ENDIF}
110 | end.
111 |
112 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_register.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_register;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils, pa_base, pa_stream;
22 |
23 | type
24 | TPARegisterType = (
25 | partDecoder,
26 | partEncoder,
27 | partDeviceIn,
28 | partDeviceOut,
29 | partFilter
30 | );
31 |
32 | TFileMagic = array of char;
33 | const
34 | cPAFileMagicEmpty = #0#0#0#0;
35 |
36 | // generic register
37 | procedure PARegister(AType: TPARegisterType; AClass: TClass; AName: String; AExtension: String = ''; AMagic: String = cPAFileMagicEmpty; AMagicLen: Integer = 4; AMagicOffset: Integer = 0);
38 | function PARegisteredGet(AType: TPARegisterType; AName: String): TClass;
39 |
40 | // enumerate
41 | function PARegisteredGetList(AType: TPARegisterType; const AExtentions: TStrings = nil): TStrings;
42 |
43 | // specific registers. can be used instead of PARegister
44 | procedure PARegisterDecoder(ASource: TPAStreamSourceClass; AName: String; AExtension: String; AMagic: TFileMagic);
45 | procedure PARegisterEncoder(ASource: TPAStreamDestinationClass; AName: String; AExtension: String; AMagic: TFileMagic);
46 | procedure PARegisterDeviceOut(AOutput: TPAAudioDestinationClass; AName: String);
47 | procedure PARegisterDeviceIn(AInput: TPAAudioDestinationClass; AName: String);
48 | procedure PARegisterFilter(AFilter: TPAAudioLinkClass; AName: String);
49 |
50 | // decoders
51 | //function PARegisteredGetDecoderClass(AExtention: String): TPAStreamSourceClass;
52 | function PARegisteredGetDecoderClass(AMagic: TFileMagic): TPAStreamSourceClass;
53 | function PARegisteredGetDecoderClass(AStream: TStream): TPAStreamSourceClass;
54 | function PARegisteredGetDecoderClass(AFileName: String; AOnlyUseExtention: Boolean): TPAStreamSourceClass;
55 |
56 | // encoders
57 | function PARegisteredGetEncoderClass(AExtention: String): TPAStreamDestinationClass;
58 | function PARegisteredGetEncoderClass(AMagic: TFileMagic): TPAStreamDestinationClass;
59 |
60 | // devices
61 | function PARegisteredGetDeviceOut(AName: String): TPAAudioDestinationClass;
62 | function PARegisteredGetDeviceIn(AName: String): TPAAudioSourceClass;
63 |
64 | // filters
65 | function PARegisteredGetFilter(AName: String): TPAAudioLinkClass;
66 |
67 | implementation
68 |
69 | uses
70 | fgl;
71 |
72 | type
73 | TAudioClassEntry = class
74 | AudioClass: TClass;
75 | Name: String;
76 | Extention: String;
77 | Magic: TFileMagic;
78 | MagicLen: Integer;
79 | MagicOffset: Integer;
80 | end;
81 |
82 | TAudioClassList = specialize TFPGObjectList;
83 |
84 | var
85 | EncoderList: TAudioClassList;
86 | DecoderList: TAudioClassList;
87 | DeviceOutList: TAudioClassList;
88 | DeviceInList: TAudioClassList;
89 | FilterList: TAudioClassList;
90 |
91 | procedure PARegisterDecoder(ASource: TPAStreamSourceClass; AName: String; AExtension: String; AMagic: TFileMagic);
92 | var
93 | lSource: TAudioClassEntry;
94 | begin
95 | lSource := TAudioClassEntry.Create;
96 | lSource.Name:=AName;
97 | lSource.Extention:=AExtension;
98 | lSource.Magic := AMagic;
99 | lSource.AudioClass:=ASource;
100 | DecoderList.Add(lSource);
101 | end;
102 |
103 | procedure PARegisterEncoder(ASource: TPAStreamDestinationClass; AName: String; AExtension: String; AMagic: TFileMagic);
104 | var
105 | lDest: TAudioClassEntry;
106 | begin
107 | lDest := TAudioClassEntry.Create;
108 | lDest.Name:=AName;
109 | lDest.Extention:=AExtension;
110 | lDest.Magic := AMagic;
111 | lDest.AudioClass:=ASource;
112 | EncoderList.Add(lDest);
113 | end;
114 |
115 | procedure PARegister(AType: TPARegisterType; AClass: TClass; AName: String;
116 | AExtension: String; AMagic: String; AMagicLen: Integer; AMagicOffset: Integer
117 | );
118 | var
119 | Entry: TAudioClassEntry;
120 | List: TAudioClassList;
121 | begin
122 | case AType of
123 | partDecoder : List := DecoderList;
124 | partEncoder : List := EncoderList;
125 | partDeviceIn : List := DeviceInList;
126 | partDeviceOut : List := DeviceOutList;
127 | partFilter : List := FilterList;
128 | end;
129 |
130 | Entry := TAudioClassEntry.Create;
131 | Entry.Name:=AName;
132 | Entry.AudioClass:=AClass;
133 | Entry.Extention:=AExtension;
134 | Entry.Magic := @AMagic[1];
135 | Entry.MagicLen:=AMagicLen;
136 | Entry.MagicOffset:=AMagicOffset;
137 | List.Add(Entry);
138 | end;
139 |
140 | procedure PARegisterDeviceOut(AOutput: TPAAudioDestinationClass; AName: String);
141 | begin
142 | PARegister(partDeviceOut, AOutput, AName);
143 | end;
144 |
145 | procedure PARegisterDeviceIn(AInput: TPAAudioDestinationClass; AName: String);
146 | begin
147 | PARegister(partDeviceIn, AInput, AName);
148 | end;
149 |
150 | procedure PARegisterFilter(AFilter: TPAAudioLinkClass; AName: String);
151 | begin
152 | PARegister(partFilter, AFilter, AName);
153 | end;
154 |
155 | function PARegisteredGetDecoderClass(AExtention: String): TPAStreamSourceClass;
156 | var
157 | i: TAudioClassEntry;
158 | begin
159 | for i in DecoderList do
160 | if CompareStr(i.Extention, AExtention) = 0 then
161 | Exit(TPAStreamSourceClass(i.AudioClass));
162 |
163 | Result := nil;
164 | end;
165 |
166 | function PARegisteredGetDecoderClass(AMagic: TFileMagic): TPAStreamSourceClass;
167 | var
168 | i: TAudioClassEntry;
169 | begin
170 | for i in DecoderList do
171 | begin
172 | if CompareMem(@i.Magic[0], @AMagic[i.MagicOffset], i.MagicLen) then
173 | Exit(TPAStreamSourceClass(i.AudioClass));
174 | end;
175 |
176 | Result := nil;
177 | end;
178 |
179 | function PARegisteredGetDecoderClass(AStream: TStream): TPAStreamSourceClass;
180 | var
181 | lSavedPos: Int64;
182 | lMagic: TFileMagic;
183 | begin
184 | Result := nil;
185 | lSavedPos := AStream.Position;
186 | AStream.Position:=0;
187 | SetLength(lMagic, 8);
188 | if AStream.Read(lMagic[0], SizeOf(lMagic)) = SizeOf(lMagic) then
189 | Result := PARegisteredGetDecoderClass(lMagic);
190 |
191 | AStream.Position:=lSavedPos;
192 | end;
193 |
194 | function PARegisteredGetDecoderClass(AFileName: String; AOnlyUseExtention: Boolean): TPAStreamSourceClass;
195 | var
196 | lFile: TFileStream;
197 | begin
198 | if AOnlyUseExtention then
199 | Exit(PARegisteredGetDecoderClass(ExtractFileExt(AFileName)));
200 |
201 | Result := nil;
202 |
203 | lFile := TFileStream.Create(AFileName, fmOpenRead);
204 | try
205 | Result := PARegisteredGetDecoderClass(lFile);
206 | finally
207 | lFile.Free;
208 | end;
209 | end;
210 |
211 | function PARegisteredGetEncoderClass(AExtention: String): TPAStreamDestinationClass;
212 | var
213 | i: TAudioClassEntry;
214 | begin
215 | for i in EncoderList do
216 | if i.Name = AExtention then
217 | Exit(TPAStreamDestinationClass(i.AudioClass));
218 |
219 | Result := nil;
220 | end;
221 |
222 | function PARegisteredGetEncoderClass(AMagic: TFileMagic): TPAStreamDestinationClass;
223 | var
224 | i: TAudioClassEntry;
225 | begin
226 | for i in EncoderList do
227 | if i.Magic = AMagic then
228 | Exit(TPAStreamDestinationClass(i.AudioClass));
229 |
230 | Result := nil;
231 | end;
232 |
233 | function PARegisteredGetDeviceOut(AName: String): TPAAudioDestinationClass;
234 | begin
235 | if AName = '' then
236 | Exit(TPAAudioDestinationClass(DeviceOutList.Items[0].AudioClass));
237 |
238 | Result := TPAAudioDestinationClass(PARegisteredGet(partDeviceOut, AName));
239 | end;
240 |
241 | function PARegisteredGetDeviceIn(AName: String): TPAAudioSourceClass;
242 | begin
243 | Result := TPAAudioSourceClass(PARegisteredGet(partDeviceOut, AName));
244 | end;
245 |
246 | function PARegisteredGetFilter(AName: String): TPAAudioLinkClass;
247 | begin
248 | Result := TPAAudioLinkClass(PARegisteredGet(partFilter, AName));
249 | end;
250 |
251 | function PARegisteredGet(AType: TPARegisterType; AName: String): TClass;
252 | var
253 | i: TAudioClassEntry;
254 | List: TAudioClassList;
255 | begin
256 | case AType of
257 | partDecoder : List := DecoderList;
258 | partEncoder : List := EncoderList;
259 | partDeviceIn : List := DeviceInList;
260 | partDeviceOut : List := DeviceOutList;
261 | partFilter : List := FilterList;
262 | end;
263 | for i in List do
264 | if i.Name = AName then
265 | Exit(i.AudioClass);
266 |
267 | Result := nil;
268 | end;
269 |
270 | function PARegisteredGetList(AType: TPARegisterType; const AExtentions: TStrings): TStrings;
271 | var
272 | i: TAudioClassEntry;
273 | List: TAudioClassList;
274 | begin
275 | case AType of
276 | partDecoder : List := DecoderList;
277 | partEncoder : List := EncoderList;
278 | partDeviceIn : List := DeviceInList;
279 | partDeviceOut : List := DeviceOutList;
280 | partFilter : List := FilterList;
281 | end;
282 |
283 | Result := TStringList.Create;
284 |
285 | for i in List do
286 | begin
287 | Result.AddObject(i.Name, TObject(i.AudioClass));
288 | if Assigned(AExtentions) then
289 | AExtentions.Add(i.Extention);
290 | end;
291 |
292 | if Result.Count = 0 then
293 | FreeAndNil(Result);
294 |
295 | end;
296 |
297 | initialization
298 | EncoderList := TAudioClassList.Create;
299 | DecoderList := TAudioClassList.Create;
300 | DeviceOutList := TAudioClassList.Create;
301 | DeviceInList := TAudioClassList.Create;
302 | FilterList := TAudioClassList.Create;
303 | finalization
304 | EncoderList.Free;
305 | DecoderList.Free;
306 | DeviceOutList.Free;
307 | DeviceInList.Free;
308 | FilterList.Free;
309 | end.
310 |
311 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_resample.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_resample;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | {$IFDEF UNIX}
21 |
22 | uses
23 | Classes, SysUtils, unixtype, pa_base, resample;
24 |
25 | type
26 |
27 | { TPAResampleLink }
28 |
29 | TPAResampleLink = class(TPAAudioLink, IPAAudioInformation)
30 | private
31 | FResampleHelper: TResampleHelper;
32 | FOutSamplesPerSecond: Integer;
33 | FInited: Boolean;
34 | SourceSamplesPS: Integer;
35 | procedure InitData;
36 | procedure FinishConvert;
37 | protected
38 | function GetSamplesPerSecond: Integer; override;
39 | procedure SetSamplesPerSecond(AValue: Integer); override;
40 | function InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64; override;
41 | procedure SignalDestinationsDone; override;
42 | public
43 | constructor Create; override;
44 | destructor Destroy; override;
45 | end;
46 |
47 | implementation
48 |
49 | uses
50 | ctypes, pa_ringbuffer;
51 |
52 | procedure TPAResampleLink.InitData;
53 | begin
54 | FInited:=True;
55 | with (DataSource.GetSourceObject as IPAAudioInformation) do
56 | begin
57 | SourceSamplesPS:=SamplesPerSecond;
58 | end;
59 | FResampleHelper := TResampleHelper.Create(Channels);
60 | //WriteLn('done Init data');
61 | end;
62 |
63 | procedure TPAResampleLink.FinishConvert;
64 | begin
65 | FreeAndNil(FResampleHelper);
66 | end;
67 |
68 | function TPAResampleLink.GetSamplesPerSecond: Integer;
69 | begin
70 | Result:=FOutSamplesPerSecond;
71 | end;
72 |
73 | procedure TPAResampleLink.SetSamplesPerSecond(AValue: Integer);
74 | begin
75 | FOutSamplesPerSecond:=AValue;
76 | end;
77 |
78 | function TPAResampleLink.InternalProcessData(const AData; ACount: Int64;
79 | AIsLastData: Boolean): Int64;
80 | var
81 | i: Integer;
82 | InBufUsed: cint;
83 | ConvertedData: TSingleArray;
84 | ConvertedSize: Integer;
85 | Count: Integer;
86 | InPos: Integer;
87 | OutPos: Integer;
88 | begin
89 | if not FInited then
90 | InitData;
91 |
92 | // check if sample is the same and just pass the data forward if it is. No need to process it
93 | if (SourceSamplesPS = FOutSamplesPerSecond)
94 | then
95 | begin
96 | Result := WriteToBuffer(AData, ACount, AIsLastData);
97 | Exit;
98 | end;
99 |
100 | {Helper:= TResampleHelper.Create(AData, ACount, Channels, FOutSamplesPerSecond / SourceSamplesPS);
101 |
102 | for i := 0 to High(Channels) do
103 | begin
104 | InPos := 0;
105 | OutPos := 0;
106 | repeat
107 |
108 | Count := resample_process(FResample,
109 | FOutSamplesPerSecond / SourceSamplesPS,
110 | @Helper.InBuffers[i][InPos],
111 | Helper.InSamplesCount-InPos,
112 | 1,//1,//Ord(AIsLastData),//0, // IsLastData
113 | @InBufUsed,
114 | @Helper.OutBuffers[i][OutPos],
115 | Helper.OutBufferLength - OutPos);
116 | Inc(InPos, InBufUsed);
117 | //WriteLn('InnerLoop InPos = ', InPos, ' InUsed = ' , InBufUsed);
118 | if Count > 0 then
119 | Inc(OutPos, Count);
120 |
121 |
122 | until (Count < 0) or ((Count = 0) and (InPos = Helper.InSamplesCount));
123 | Helper.OutBuffersLength[i] := OutPos;
124 | //WriteLn('Channel ', i, ' BufferOutCount = ',Helper.OutBuffersLength[i], ' Orig Length = ', Helper.InSamplesCount);
125 | end;
126 |
127 | ConvertedData := Helper.PlexOutBuffers(ConvertedSize);}
128 |
129 | ConvertedData := FResampleHelper.Write(PSingle(@AData), ACount div SizeOf(Single), FOutSamplesPerSecond / SourceSamplesPS, AIsLastData);
130 |
131 |
132 | Result := WriteToBuffer(ConvertedData[0], Length(ConvertedData)*SizeOf(Single), AIsLastData);
133 | //Result := WriteToBuffer(AData, ACount, AIsLastData);
134 |
135 | //FreeMem(ConvertedData);
136 | SetLength(ConvertedData, 0);
137 | //Helper.Free;
138 |
139 | end;
140 |
141 | procedure TPAResampleLink.SignalDestinationsDone;
142 | begin
143 | inherited SignalDestinationsDone;
144 | end;
145 |
146 | constructor TPAResampleLink.Create;
147 | begin
148 | inherited Create;
149 | FOutSamplesPerSecond:=44100;
150 | FFormat:=afFloat32;
151 | end;
152 |
153 | destructor TPAResampleLink.Destroy;
154 | begin
155 | inherited Destroy;
156 | end;
157 |
158 | { TStereoFloat }
159 |
160 | {$ELSE}
161 | implementation
162 | {$ENDIF}
163 |
164 | end.
165 |
166 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_samplerate.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | libsamplerate upon which this depends is GPL
14 |
15 | }
16 | unit pa_samplerate;
17 |
18 | {$mode objfpc}{$H+}
19 | {$packrecords c}
20 |
21 | interface
22 |
23 | uses
24 | Classes, SysUtils, pa_base, samplerate;
25 |
26 |
27 | type
28 |
29 | { TPASampleRateLink }
30 |
31 | TPASampleRateLink = class(TPAAudioLink)
32 | private
33 | FSrc: PSRC_STATE;
34 | FOutSamplesPerSecond: Integer;
35 | FOutChannels: Integer;
36 | FInited: Boolean;
37 | procedure InitData;
38 | procedure FinishConvert;
39 | protected
40 | function GetSamplesPerSecond: Integer; override;
41 | procedure SetSamplesPerSecond(AValue: Integer); override;
42 | function GetChannels: Integer; override;
43 | procedure SetChannels(AValue: Integer); override;
44 | function InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64; override;
45 | procedure SignalDestinationsDone; override;
46 | public
47 | constructor Create; override;
48 | destructor Destroy; override;
49 |
50 | end;
51 |
52 | implementation
53 | uses
54 | ctypes, math;
55 |
56 |
57 |
58 |
59 |
60 |
61 | { TPASampleRateLink }
62 |
63 | procedure TPASampleRateLink.InitData;
64 | var
65 | error: cint;
66 | begin
67 | //WriteLn('Init data');
68 | FInited:=True;
69 | FSrc:= src_new(SRC_SINC_FASTEST, FOutChannels, @error);
70 | if error <> 0 then
71 | WriteLn('ProcessResult: ',src_strerror(error));
72 | src_set_ratio(FSrc, SamplesPerSecond / (DataSource.GetSourceObject as IPAAudioInformation).SamplesPerSecond);
73 | //WriteLn(src_is_valid_ratio(SamplesPerSecond / (DataSource.GetSourceObject as IPAAudioInformation).SamplesPerSecond));
74 | //WriteLn('done Init data');
75 | end;
76 |
77 | procedure TPASampleRateLink.FinishConvert;
78 | begin
79 | src_delete(FSrc);
80 | FInited:=False;
81 | end;
82 |
83 | function TPASampleRateLink.GetSamplesPerSecond: Integer;
84 | begin
85 | Result:=FOutSamplesPerSecond;
86 | end;
87 |
88 | procedure TPASampleRateLink.SetSamplesPerSecond(AValue: Integer);
89 | begin
90 | FOutSamplesPerSecond:=AValue;
91 | end;
92 |
93 | function TPASampleRateLink.GetChannels: Integer;
94 | begin
95 | Result := FOutChannels;
96 | end;
97 |
98 | procedure TPASampleRateLink.SetChannels(AValue: Integer);
99 | begin
100 | FOutChannels:=AValue;
101 | end;
102 |
103 |
104 |
105 |
106 | //function StereoShortToFloatArrays
107 |
108 |
109 | function TPASampleRateLink.InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64;
110 | var
111 | sdata: SRC_DATA;
112 | Converted: Pointer;
113 | ConvertedToFloat: pcfloat absolute Converted;
114 | ConvertedToShort: pcshort absolute Converted;
115 | OutData: pointer;
116 | OutDataSize: Integer;
117 | Ratio: Single;
118 | SourceSamplesPS: Integer;
119 | SourceFormat: TPAAudioFormat;
120 | SourceChannels: Integer;
121 | res: cint;
122 | begin
123 | WriteLn('samplerate process');
124 | if not FInited then
125 | InitData;
126 |
127 | with (DataSource.GetSourceObject as IPAAudioInformation) do
128 | begin
129 | SourceSamplesPS:=SamplesPerSecond;
130 | SourceFormat:=Format;
131 | SourceChannels:=Channels;
132 | end;
133 |
134 | sdata.src_ratio:=SamplesPerSecond / SourceSamplesPS;
135 |
136 | //Converted := Getmem(Max(ACount, Trunc(ACount * 4{sdata.src_ratio})+1)+4);
137 |
138 | // alloc enough memory for before and after frames. whichever is greater
139 | OutDataSize := Max(ACount, Trunc(ACount * sdata.src_ratio))+100;
140 | OutDataSize := ACount * 4 + 4;
141 | WriteLn('DataSize : ', OutDataSize, ' : ', ACount * 4 + 4);
142 | OutData := GetMem(OutDataSize);
143 |
144 | //src_short_to_float_array(pcshort(@AData), ConvertedToFloat, ACount div BytesPerSample(Format));
145 | //ConvertShortIntsToFloat(PShortInt(@AData), ConvertedToFloat, ACount div BytesPerSample);
146 |
147 | // sdata.data_in:=ConvertedToFloat;
148 | sdata.data_in:=@AData;
149 | sdata.data_out:=pcfloat(OutData);
150 | sdata.input_frames:=ACount div BytesPerSample(Format) div SourceChannels;
151 |
152 | //sdata.input_frames:=(ACount div ((SourceSamplesPS div SourceBytesPerSample) div SourceChannels));
153 | //sdata.output_frames:= OutDataSize div 2 div SourceChannels;
154 | sdata.output_frames:= OutDataSize div 2 div SourceChannels;
155 | sdata.end_of_input:=0;//ord(FDataIsEnded and FBufferManager.Empty);
156 |
157 | { WriteLn('input frames avail: ', sdata.input_frames);
158 |
159 | WriteLn('Processing Data:', ACount);}
160 |
161 | res:=src_process(FSrc, @sdata);
162 | if Res <> 0 then
163 | WriteLn('ProcessResult: ',src_strerror(res));
164 | {
165 | WriteLn('input frames avail: ', sdata.input_frames);
166 | WriteLn('input frames used: ', sdata.input_frames_used);
167 | WriteLn('output frames generated: ', sdata.output_frames_gen);
168 | }
169 |
170 | //src_float_to_short_array(sdata.data_out, ConvertedToShort, sdata.output_frames_gen * FOutChannels);
171 | //WriteToBuffer(ConvertedToShort^, sdata.output_frames_gen * FOutChannels * FOutBytesPerSample, AIsLastData);
172 |
173 | WriteToBuffer(sdata.data_out^, sdata.output_frames_gen * FOutChannels * BytesPerSample(afFloat32), AIsLastData);
174 |
175 | //Freemem(Converted);
176 | FreeMem(OutData);
177 |
178 | end;
179 |
180 | procedure TPASampleRateLink.SignalDestinationsDone;
181 | begin
182 | inherited SignalDestinationsDone;
183 | end;
184 |
185 | constructor TPASampleRateLink.Create;
186 | begin
187 | inherited Create;
188 | FOutSamplesPerSecond:=44100;
189 | FFormat:=afFloat32;
190 | end;
191 |
192 | destructor TPASampleRateLink.Destroy;
193 | begin
194 | inherited Destroy;
195 | end;
196 |
197 |
198 |
199 | end.
200 |
201 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_sox.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_sox;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils, pa_base, pa_process;
22 |
23 | type
24 |
25 | { TPASoxSource }
26 |
27 | TPASoxSource = class(TPAProcessSource)
28 | private
29 | FFileName: String;
30 | procedure SetFileName(AValue: String);
31 | protected
32 | procedure BeforeExecuteLoop; override;
33 | public
34 | constructor Create; override;
35 | property FileName: String read FFileName write SetFileName;
36 | end;
37 |
38 | implementation
39 |
40 | { TPASoxSource }
41 |
42 | procedure TPASoxSource.SetFileName(AValue: String);
43 | begin
44 | if FFileName=AValue then Exit;
45 | FFileName:=AValue;
46 | end;
47 |
48 | procedure TPASoxSource.BeforeExecuteLoop;
49 | begin
50 | FProcess.Parameters.AddStrings([FFileName, '-t', 'raw', '--bits', '32', '--encoding', 'float']);
51 | FProcess.Parameters.AddStrings(['-r', IntToStr(SamplesPerSecond), '-c', IntToStr(Channels), '-']);
52 | inherited BeforeExecuteLoop;
53 | end;
54 |
55 | constructor TPASoxSource.Create;
56 | begin
57 | inherited Create;
58 | FProcess.Executable:='sox';
59 | Format:=afFloat32;
60 | end;
61 |
62 | end.
63 |
64 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_stream.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_stream;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils, pa_base;
22 |
23 | type
24 |
25 | { TPAStreamSource }
26 |
27 | TPAStreamSourceClass = class of TPAStreamSource;
28 | TPAStreamSource = class(TPAAudioSource, IPAStream)
29 | protected
30 | FStream: TStream;
31 | FOwnsStream: Boolean;
32 | procedure SetStream(AValue: TStream); virtual;
33 | function GetStream: TStream; virtual;
34 | private
35 | function GetOwnsStream: Boolean;
36 | procedure SetOwnsStream(AValue: Boolean);
37 |
38 | protected
39 | function InternalOutputToDestination: Boolean; override;
40 | public
41 | constructor Create; override; // you must set ownsstream and stream
42 | constructor Create(AStream: TStream; AOwnsStream: Boolean = True); virtual;
43 | destructor Destroy; override;
44 | property Stream: TStream read GetStream write SetStream;
45 | property OwnsStream: Boolean read GetOwnsStream write SetOwnsStream;
46 | end;
47 |
48 | { TPAStreamDestination }
49 |
50 | TPAStreamDestinationClass = class of TPAStreamDestination;
51 | TPAStreamDestination = class(TPAAudioDestination, IPAStream)
52 | private
53 | FOwnsStream: Boolean;
54 | function GetOwnsStream: Boolean;
55 | procedure SetOwnsStream(AValue: Boolean);
56 | protected
57 | FStream: TStream;
58 | function GetStream: TStream; virtual;
59 | procedure SetStream(AValue: TStream); virtual;
60 | function InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64; override;
61 | procedure EndOfData; override;
62 | public
63 | constructor Create(AStream: TStream; AOwnsStream: Boolean); virtual;
64 | destructor Destroy; override;
65 | property Stream: TStream read GetStream write SetStream;
66 | property OwnsStream: Boolean read GetOwnsStream write SetOwnsStream;
67 | end;
68 |
69 | implementation
70 |
71 | { TPAStreamSource }
72 |
73 | function TPAStreamSource.GetStream: TStream;
74 | begin
75 | Result := FStream;
76 | end;
77 |
78 | function TPAStreamSource.GetOwnsStream: Boolean;
79 | begin
80 | Result := FOwnsStream;
81 | end;
82 |
83 | procedure TPAStreamSource.SetOwnsStream(AValue: Boolean);
84 | begin
85 | FOwnsStream := AValue;
86 | end;
87 |
88 | procedure TPAStreamSource.SetStream(AValue: TStream);
89 | begin
90 | if Assigned(FStream) and (AValue <> FStream) and FOwnsStream then
91 | FreeAndNil(FStream);
92 | FStream := AValue;
93 | end;
94 |
95 | function TPAStreamSource.InternalOutputToDestination: Boolean;
96 | var
97 | Buffer: PAudioBuffer;
98 | begin
99 |
100 | Buffer := BufferPool.GetBufferFromPool(True);
101 | Buffer^.UsedData := FStream.Read(Buffer^.Data, AUDIO_BUFFER_SIZE);
102 | Buffer^.IsEndOfData:= Buffer^.UsedData < AUDIO_BUFFER_SIZE;
103 |
104 | Result := Buffer^.UsedData > 0;
105 | WriteToDestinations(Buffer);
106 | if Not Result then
107 | SignalDestinationsDone;
108 |
109 | end;
110 |
111 | constructor TPAStreamSource.Create;
112 | begin
113 | Create(nil, True);
114 | end;
115 |
116 | constructor TPAStreamSource.Create(AStream: TStream; AOwnsStream: Boolean);
117 | begin
118 | inherited Create;
119 | OwnsStream := AOwnsStream;
120 | Stream := AStream;
121 | end;
122 |
123 | destructor TPAStreamSource.Destroy;
124 | begin
125 | DestroyWaitSync;
126 | if FOwnsStream and Assigned(FStream) then
127 | FreeAndNil(FStream);
128 | inherited Destroy;
129 | end;
130 |
131 | { TPAStreamDestination }
132 |
133 | function TPAStreamDestination.GetStream: TStream;
134 | begin
135 | Result := FStream;
136 | end;
137 |
138 | function TPAStreamDestination.GetOwnsStream: Boolean;
139 | begin
140 | Result := FOwnsStream;
141 | end;
142 |
143 | procedure TPAStreamDestination.SetOwnsStream(AValue: Boolean);
144 | begin
145 | FOwnsStream := AValue;
146 | end;
147 |
148 | procedure TPAStreamDestination.SetStream(AValue: TStream);
149 | begin
150 | if Assigned(FStream) and FOwnsStream then
151 | FreeAndNil(FStream);
152 | FStream := AValue;
153 | end;
154 |
155 | function TPAStreamDestination.InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64;
156 | begin
157 | if Assigned(FStream) then
158 | Result := FStream.Write(AData, ACount);
159 |
160 | if AIsLastData then
161 | EndOfData;
162 |
163 | end;
164 |
165 | procedure TPAStreamDestination.EndOfData;
166 | begin
167 | inherited EndOfData;
168 | //WriteLn('StreamDEstination EndOf Data;');
169 | FBufferManager.Flush;
170 | end;
171 |
172 | constructor TPAStreamDestination.Create(AStream: TStream; AOwnsStream: Boolean);
173 | begin
174 | FStream := AStream;
175 | inherited Create;
176 | Format := afRaw;
177 | end;
178 |
179 | destructor TPAStreamDestination.Destroy;
180 | begin
181 | Stream := nil; // this will free the stream if we own it.
182 | inherited Destroy;
183 | end;
184 |
185 | { TPAStreamSource }
186 |
187 |
188 |
189 | end.
190 |
191 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pa_wav.pas:
--------------------------------------------------------------------------------
1 | {
2 | This unit is part of PascalAudioSuite package.
3 |
4 | Copyright (c) 2016 by Andrew Haines.
5 |
6 | See the files COPYING.modifiedLGPL and LICENSES.txt, included in this
7 | distribution, for details about the license.
8 |
9 | This program is distributed in the hope that it will be useful,
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12 |
13 | }
14 | unit pa_wav;
15 |
16 | {$mode objfpc}{$H+}
17 |
18 | interface
19 |
20 | uses
21 | Classes, SysUtils, pa_base, pa_stream, pa_register, fpwavformat;
22 |
23 | type
24 |
25 | { TPAWavSource }
26 |
27 | TPAWavSource = class(TPAStreamSource, IPAStream)
28 | private
29 | FWavFormat: TWaveFormat;
30 | FValid: Boolean;
31 | FCurrentChunk: TChunkHeader;
32 | procedure ReadHeader;
33 | function LoadNextChunk: Boolean;
34 | protected
35 | procedure SetStream(AValue: TStream); override;
36 | function InternalOutputToDestination: Boolean; override;
37 | end;
38 |
39 | TPAWavDest = class(TPAStreamDestination, IPAStream)
40 | private
41 | const
42 | cFileSizeOff = 4;
43 | cDataSizeOff = 40;
44 | private
45 | FInited: Boolean;
46 | FFinished: Boolean;
47 | FDataSize: DWord;
48 | procedure InitStream;
49 | procedure FinishStream;
50 | protected
51 | function InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64; override;
52 | public
53 | constructor Create(AStream: TStream; AOwnsStream: Boolean); override;
54 | property Stream;
55 | end;
56 |
57 | implementation
58 |
59 | { TPAWavSource }
60 |
61 | procedure LEtoN(var fmt: TWaveFormat); overload;
62 | begin
63 | // from fpwavreader
64 | with fmt, ChunkHeader do begin
65 | Size := LEtoN(Size);
66 | Format := LEtoN(Format);
67 | Channels := LEtoN(Channels);
68 | SampleRate := LEtoN(SampleRate);
69 | ByteRate := LEtoN(ByteRate);
70 | BlockAlign := LEtoN(BlockAlign);
71 | BitsPerSample := LEtoN(BitsPerSample);
72 | end;
73 | end;
74 |
75 |
76 | procedure NtoLE(var fmt: TWaveFormat); overload;
77 | begin
78 | // from fpwavreader
79 | with fmt, ChunkHeader do begin
80 | Size := NtoLE(Size);
81 | Format := NtoLE(Format);
82 | Channels := NtoLE(Channels);
83 | SampleRate := NtoLE(SampleRate);
84 | ByteRate := NtoLE(ByteRate);
85 | BlockAlign := NtoLE(BlockAlign);
86 | BitsPerSample := NtoLE(BitsPerSample);
87 | end;
88 | end;
89 |
90 | { TPAWavDest }
91 |
92 | procedure TPAWavDest.InitStream;
93 | var
94 | Riff: TRiffHeader;
95 | WavChunk: TWaveFormat;
96 | DataChunk: TChunkHeader;
97 | begin
98 | FInited := True;
99 |
100 | Riff.ChunkHeader.ID := AUDIO_CHUNK_ID_RIFF;
101 | Riff.Format := AUDIO_CHUNK_ID_WAVE;
102 | Riff.ChunkHeader.Size:=0; // fill in later
103 |
104 | WavChunk.ChunkHeader.ID := AUDIO_CHUNK_ID_fmt;
105 | WavChunk.ChunkHeader.Size:=16;
106 | WavChunk.Format := AUDIO_FORMAT_PCM;
107 |
108 | WavChunk.BitsPerSample := 16;
109 | WavChunk.Channels:=Channels;
110 | WavChunk.SampleRate:= SamplesPerSecond div Channels;
111 | WavChunk.ByteRate:=(WavChunk.BitsPerSample * Channels) div 8;
112 | NtoLE(WavChunk);
113 |
114 | DataChunk.ID := AUDIO_CHUNK_ID_data;
115 | DataChunk.Size:=0; // fill in later
116 |
117 | FStream.Write(Riff, SizeOf(Riff));
118 | FStream.Write(WavChunk, SizeOf(WavChunk));
119 | FStream.Write(DataChunk, SizeOf(DataChunk));
120 | //That's it.
121 | end;
122 |
123 | procedure TPAWavDest.FinishStream;
124 | begin
125 | if FFinished then
126 | Exit;
127 |
128 | FFinished:= True;
129 |
130 | // write total size -1
131 | FStream.Position:=cFileSizeOff;
132 | FStream.WriteDWord(NtoLE(DWord(FStream.Size-SizeOf(TChunkHeader))));
133 |
134 | // write raw data size
135 | FStream.Position:=cDataSizeOff;
136 | FStream.WriteDWord(NtoLE(FDataSize));
137 | FStream.Seek(0, soEnd);
138 | end;
139 |
140 | function TPAWavDest.InternalProcessData(const AData; ACount: Int64; AIsLastData: Boolean): Int64;
141 | begin
142 | if not FInited then
143 | InitStream;
144 |
145 | Result := FStream.Write(AData, ACount);
146 | Inc(FDataSize, Result);
147 |
148 | if AIsLastData then
149 | begin
150 | FinishStream;
151 | end;
152 | end;
153 |
154 | constructor TPAWavDest.Create(AStream: TStream; AOwnsStream: Boolean);
155 | begin
156 | Inherited Create(AStream, AOwnsStream);
157 | Format:= afS16;
158 | end;
159 |
160 | procedure TPAWavSource.ReadHeader;
161 | var
162 | Riff: TRiffHeader;
163 | RCount: Integer;
164 | begin
165 | FValid := False;
166 |
167 | if not Assigned(FStream) then
168 | Exit;
169 | FStream.Seek(0, soBeginning);
170 | RCount := FStream.Read(Riff, SizeOf(Riff));
171 | if RCount <> SizeOf(Riff) then
172 | Exit;
173 | Riff.ChunkHeader.Size:=LEtoN(Riff.ChunkHeader.Size);
174 | FValid := (Riff.ChunkHeader.ID = AUDIO_CHUNK_ID_RIFF)
175 | and (Riff.Format = AUDIO_CHUNK_ID_WAVE);
176 | if not FValid then
177 | Exit;
178 | FStream.Read(FWavFormat, SizeOf(FWavFormat));
179 | LEtoN(FWavFormat);
180 | FValid := (FWavFormat.ChunkHeader.ID = AUDIO_CHUNK_ID_fmt)
181 | and (FWavFormat.Format = AUDIO_FORMAT_PCM);
182 |
183 | Channels:=FWavFormat.Channels;
184 | SamplesPerSecond:=FWavFormat.SampleRate;
185 | Format:=afS16;
186 | end;
187 |
188 | function TPAWavSource.LoadNextChunk: Boolean;
189 | var
190 | RCount: LongInt;
191 | begin
192 | Result := False;
193 | RCount := FStream.Read(FCurrentChunk, SizeOf(FCurrentChunk));
194 | if RCount < SizeOf(FCurrentChunk) then
195 | begin
196 | FCurrentChunk.Size:=0;
197 | FCurrentChunk.ID := ' ';
198 | Exit;
199 | end;
200 | FCurrentChunk.Size:=LeToN(FCurrentChunk.Size);
201 |
202 | // fix datasize for illformed wav files.
203 | if (FCurrentChunk.ID = AUDIO_CHUNK_ID_data) and (FCurrentChunk.Size = 0) then
204 | FCurrentChunk.Size:=FStream.Size-FStream.Position;
205 |
206 | Result := True;
207 | end;
208 |
209 | procedure TPAWavSource.SetStream(AValue: TStream);
210 | begin
211 | inherited SetStream(AValue);
212 | if Assigned(AValue) then
213 | ReadHeader
214 | else
215 | FValid := False;
216 | end;
217 |
218 | function TPAWavSource.InternalOutputToDestination: Boolean;
219 | var
220 | Buf: array[0..AUDIO_BUFFER_SIZE-1] of byte;
221 | RCount: Integer;
222 | WSize: Integer = 0;
223 | OutOfChunks: Boolean = False;
224 | begin
225 | Result := False;
226 | if not FValid then
227 | Exit;
228 | while (WSize < SizeOf(Buf)) and not OutOfChunks do
229 | begin
230 | if FCurrentChunk.Size = 0 then
231 | repeat
232 | OutOfChunks := not LoadNextChunk;
233 | if OutOfChunks then
234 | Break;
235 | until FCurrentChunk.ID = AUDIO_CHUNK_ID_data;
236 |
237 | RCount := FStream.Read(Buf[WSize], Min(SizeOf(Buf)-WSize, FCurrentChunk.Size));
238 | Dec(FCurrentChunk.Size, RCount);
239 | Inc(WSize, RCount);
240 | end;
241 |
242 | Result := FStream.Position < FStream.Size;
243 |
244 | if WSize > 0 then
245 | WriteToBuffer(Buf, WSize, not Result);
246 | end;
247 |
248 | initialization
249 | PARegister(partEncoder, TPAWavDest, 'Wave/PCM', '.wav' ,'RIFF', 4);
250 | PARegister(partDecoder, TPAWavSource, 'Wave/PCM', '.wav');
251 | end.
252 |
253 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pascalaudiosuite.lpk:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
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 |
--------------------------------------------------------------------------------
/pascalaudiosuite/pascalaudiosuite.pas:
--------------------------------------------------------------------------------
1 | { This file was automatically created by Lazarus. Do not edit!
2 | This source is only used to compile and install the package.
3 | }
4 |
5 | unit PascalAudioSuite;
6 |
7 | {$warn 5023 off : no warning about unused units}
8 | interface
9 |
10 | uses
11 | pa_base, pa_lists, pa_resample, pa_enc_oggvorbis, pa_stream, pa_ladspa,
12 | pa_dec_oggvorbis, pa_noiseremoval, pa_cdaudio, pa_process, pa_wav,
13 | pa_binaural, pa_samplerate, pa_pulse_simple, pa_sox, pa_flac, pa_register,
14 | pa_mmdevice, pa_m4a, pa_ogg_opus, LazarusPackageIntf;
15 |
16 | implementation
17 |
18 | procedure Register;
19 | begin
20 | end;
21 |
22 | initialization
23 | RegisterPackage('PascalAudioSuite', @Register);
24 | end.
25 |
--------------------------------------------------------------------------------