ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/PDL-Audio/README
Revision: 1.2
Committed: Thu Mar 3 17:36:58 2005 UTC (19 years, 2 months ago) by root
Branch: MAIN
Changes since 1.1: +608 -4 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.2 NAME
2     PDL::Audio - Some PDL functions intended for audio processing.
3    
4     SYNOPSIS
5     use PDL;
6     use PDL::Audio;
7    
8     DESCRIPTION
9     Oh well ;) Not much "introductory documentation" has been written yet :(
10    
11     NOTATION
12     Brackets around parameters indicate that the respective parameter is
13     optional and will be replaced with some default value when absent (or
14     "undef", which might be different in other packages).
15    
16     The sampling frequency and duration are by default (see individual
17     descriptions) given in cycles/sample (or samples in case of a duration).
18     That means if you want to specify a duration of two seconds, you have to
19     multiply by the sampling frequency in HZ, and if you want to specify a
20     frequency of 440 Hz, you have to divide by the sampling frequency:
21    
22     # Syntax: gen_oscil duration*, frequency/
23     $signal = gen_oscil 2*HZ, 440/HZ;
24     # with a sampling frequency of 44100 Hertz:
25     $signal = gen_oscil 2*44100, 440/44100;
26    
27     To help you, the required unit is given as a type suffix in the
28     parameter name. A "/" means that you have to divide by the sampling
29     frequency (to convert from Hertz) and a suffix of "*" indicates that a
30     multiplication is required.
31    
32     Most parameters named "size", "duration" (or marked with "*") can be
33     replaced by a piddle, which is then used to give length and from
34     (mono/stereo).
35    
36     HEADER ATTRIBUTES
37     The following header attributes are stored and evaluated by most
38     functions. PDL::Audio provides mutator methods for all them (e.g.
39    
40     print "samplerate is ", $pdl->rate;
41     $pdl->comment("set the comment to this string");
42    
43     rate
44     The sampling rate in hz.
45    
46     filetype
47     The filetype (wav, au etc..). Must be one of:
48    
49     FILE_NEXT FILE_AIFC FILE_RIFF FILE_BICSF FILE_NIST FILE_INRS FILE_ESPS
50     FILE_SVX FILE_VOC FILE_SNDT FILE_RAW FILE_SMP FILE_SD2 FILE_AVR
51     FILE_IRCAM FILE_SD1 FILE_SPPACK FILE_MUS10 FILE_HCOM FILE_PSION
52     FILE_MAUD FILE_IEEE FILE_DESKMATE FILE_DESKMATE_2500 FILE_MATLAB
53     FILE_ADC FILE_SOUNDEDIT FILE_SOUNDEDIT_16 FILE_DVSM FILE_MIDI
54     FILE_ESIGNAL FILE_SOUNDFONT FILE_GRAVIS FILE_COMDISCO FILE_GOLDWAVE
55     FILE_SRFS FILE_MIDI_SAMPLE_DUMP FILE_DIAMONDWARE FILE_REALAUDIO
56     FILE_ADF FILE_SBSTUDIOII FILE_DELUSION FILE_FARANDOLE FILE_SAMPLE_DUMP
57     FILE_ULTRATRACKER FILE_YAMAHA_SY85 FILE_YAMAHA_TX16 FILE_DIGIPLAYER
58     FILE_COVOX FILE_SPL FILE_AVI FILE_OMF FILE_QUICKTIME FILE_ASF
59     FILE_YAMAHA_SY99 FILE_KURZWEIL_2000 FILE_AIFF FILE_AU
60    
61     path
62     The filename (or file specification) used to load or save a file.
63    
64     format
65     Specifies the type the underlying file format uses. The samples will
66     always be in short or long signed format.
67    
68     Must be one of
69    
70     FORMAT_NO_SND FORMAT_16_LINEAR FORMAT_8_MULAW FORMAT_8_LINEAR
71     FORMAT_32_FLOAT FORMAT_32_LINEAR FORMAT_8_ALAW FORMAT_8_UNSIGNED
72     FORMAT_24_LINEAR FORMAT_64_DOUBLE FORMAT_16_LINEAR_LITTLE_ENDIAN
73     FORMAT_32_LINEAR_LITTLE_ENDIAN FORMAT_32_FLOAT_LITTLE_ENDIAN
74     FORMAT_64_DOUBLE_LITTLE_ENDIAN FORMAT_16_UNSIGNED
75     FORMAT_16_UNSIGNED_LITTLE_ENDIAN FORMAT_24_LINEAR_LITTLE_ENDIAN
76     FORMAT_32_VAX_FLOAT FORMAT_12_LINEAR FORMAT_12_LINEAR_LITTLE_ENDIAN
77     FORMAT_12_UNSIGNED FORMAT_12_UNSIGNED_LITTLE_ENDIAN COMPATIBLE_FORMAT
78    
79     PDL::Audio conviniently defines the following aliases for the
80     following constants, that are already correct for the host
81     byteorder:
82    
83     FORMAT_ULAW_BYTE FORMAT_ALAW_BYTE FORMAT_LINEAR_BYTE
84     FORMAT_LINEAR_SHORT FORMAT_LINEAR_USHORT FORMAT_LINEAR_LONG
85     FORMAT_LINEAR_FLOAT FORMAT_LINEAR_DOUBLE
86    
87     comment
88     The file comment (if any).
89    
90     device
91     The device to output audio. One of:
92    
93     DEV_DEFAULT DEV_READ_WRITE DEV_ADAT_IN DEV_AES_IN DEV_LINE_OUT
94     DEV_LINE_IN DEV_MICROPHONE DEV_SPEAKERS DEV_DIGITAL_IN DEV_DIGITAL_OUT
95     DEV_DAC_OUT DEV_ADAT_OUT DEV_AES_OUT DEV_DAC_FILTER DEV_MIXER
96     DEV_LINE1 DEV_LINE2 DEV_LINE3 DEV_AUX_INPUT DEV_CD_IN DEV_AUX_OUTPUT
97     DEV_SPDIF_IN DEV_SPDIF_OUT
98    
99     EXPORTED CONSTANTS
100     In addition to the exported constants described above (and later in the
101     function descriptions), this module also exports the mathematical
102     constants M_PI and M_2PI, so watch out for clashes!
103    
104     FUNCTIONS
105     sound_format_name format_code
106     Return the human-readable name of the file format with code
107     "format_code".
108    
109     sound_type_name type_code
110     Return the human-readable name of the sample type with code "type_code".
111    
112     describe_audio piddle
113     Describe the audio stream contained in piddle and return it as a string.
114     A fresh piddle might return:
115    
116     mono sound with 27411 samples
117    
118     Whereas a freshly loaded soundfile might yield:
119    
120     stereo sound with 27411 samples, original name "kongas.wav", type 2 (RIFF),
121     rate 11025/s (duration 2.49s), format 7 (8-bit unsigned)
122    
123     raudio path, [option-hash], option => value, ...
124     Reads audio data into the piddle. Options can be anything, most useful
125     values are "filetype", "rate", "channels" and "format".
126    
127     # read any file
128     $pdl = raudio "file.wav";
129     # read a file. if it is a raw file preset values
130     $pdl = raudio "file.raw", filetype => FILE_RAW, rate => 44100, channels => 2;
131    
132     waudio pdl, [option-hash], option => value, ...
133     Writes a pdl as a file. The path is taken from the header (or the
134     options), e.g.:
135    
136     # write a file, using the header of another piddle
137     $pdl->waudio($orig_file->gethdr);
138     # write pdl as au file, take rate from the header
139     $pdl->waudio(path => "piddle.au", filetype => FILE_AU, format => FORMAT_16_LINEAR;
140    
141     cut_leading_silence pdl, level
142     Cuts the leading silence (i.e. all samples with absolute value < level)
143     and returns the resulting part.
144    
145     cut_trailing_silence pdl, level
146     Cuts the trailing silence.
147    
148     cut_silence pdl, level
149     Calls "cut_leading_silence" and "cut_trailing_silence" and returns the
150     result.
151    
152     playaudio pdl, [option-hash], option => value ...
153     Play the piddle as an audio file. Options can be supplied either through
154     the option hash (a hash-reference), through the pdl header or the
155     options:
156    
157     # play a piddle that has a valid header (e.g. from raudio)
158     $pdl->playaudio;
159     # play it with a different samplerate
160     $pdl->playaudio(rate => 22050);
161    
162     ulaw2linear
163     Signature: (byte u(n); short [o] s(n))
164    
165     conversion from (m)u-law into signed, linear, 16 bit samples (rather
166     slow)
167    
168     linear2ulaw
169     Signature: (short s(n); byte [o] u(n))
170    
171     conversion from signed, linear, 16 bit samples into (m)u-law (rather
172     slow)
173    
174     alaw2linear
175     Signature: (byte u(n); short [o] s(n))
176    
177     conversion from A-law into signed, linear, 16 bit samples (rather slow)
178    
179     linear2alaw
180     Signature: (short s(n); byte [o] u(n))
181    
182     conversion from signed, linear, 16 bit samples into A-law (rather slow)
183    
184     gen_oscil duration*, freq/, phase-mod, [fm-mod/]
185     gen_sawtooth duration*, freq/, phase-mod, [fm-mod/]
186     gen_square duration*, freq/, phase-mod, duty, [fm-mod/]
187     gen_triangle duration*, freq/, phase-mod, [fm-mod/]
188     gen_pulse_train duration*, freq/, phase-mod, [fm-mod/]
189     gen_rand duration*, freq/
190     gen_rand_1f duration*
191     All of these functions generate appropriate waveforms with frequency
192     "freq" (cycles/sample) and phase "phase" (0..1).
193    
194     The "duration" might be either a piddle (which gives the form of the
195     output) or the number of samples to generate.
196    
197     The output samples are between -1 and +1 (i.e. "-1 <= s <= +1").
198    
199     The "duty" parameter of the square generator influences the duty cycle
200     of the signal. Zero means 50%-50%, 0.5 means 75% on, 25% off, -0.8 means
201     10% on, 90% off etc... Of course, the "duty" parameter might also be a
202     vector of size "duration".
203    
204     gen_env duration*, xvals, yvals, [base]
205     Generates an interpolated envelope between the points given by xvals and
206     yvals. When base == 1 (the default) then the values will be linearly
207     interpolated, otherwise they follow an exponential curve that is bend
208     inwards (base < 1) or outwards (base > 1).
209    
210     # generate a linear envelope with attack in the first 10%
211     gen_env 5000, [0 1 2 9 10], [0 1 0.6 0.6 0];
212    
213     gen_adsr duration*, sustain-level, attack-time, decay-time, sustain-time, release-time
214     Simple ADSR envelope generator. The "sustain-level" is the amplitude (0
215     to 1) of the sustain level. The other for parameters give the relative
216     interval times, in any unit you like, only their relative ratios are
217     important. Any of these times might be zero, in which case the
218     corresponding part is omitted from the envelope.
219    
220     gen_asymmetric_fm duration*, freq/, phase, [r , [ratio]]
221     "gen_asymmetric_fm" provides a way around the symmetric spectra normally
222     produced by FM. See Palamin and Palamin, "A Method of Generating and
223     Controlling Asymmetrical Spectra" JAES vol 36, no 9, Sept 88, p671-685.
224    
225     gen_sum_of_cosines duration*, freq/, phase, ncosines, [fm_mod/]
226     Generates a sum of "n" cosines "(1 + 2(cos(x) + cos(2x) + ... cos(nx)) =
227     sin((n+.5)x) / sin(x/2))". Other arguments are similar to to
228     "gen_oscil".
229    
230     gen_sine_summation duration*, freq/, phase, [nsines, [a, [b_ratio, [fm_mod/]]]]
231     "gen_sine_summation" provides a kind of additive synthesis. See
232     J.A.Moorer, "Signal Processing Aspects of Computer Music" and "The
233     Synthesis of Complex Audio Spectra by means of Discrete Summation
234     Formulae" (Stan-M-5). The basic idea is very similar to that used in
235     gen_sum_of_cosines generator.
236    
237     The default value for "nsines" is 1 (but zero is a valid value), for "a"
238     is 0.5 and for "b_ratio" is 1.
239    
240     (btw, either my formula is broken or the output indeed does not lie
241     between -1 and +1, but rather -5 .. +5).
242    
243     gen_from_table duration*, frequency/, table, [phase], [fm_mod/]
244     "gen_from_table" generates a waveform by repeating a waveform given in
245     "table", linearly interpolating between successive points of the
246     "waveform".
247    
248     partials2waveshape size*, partials, amplitudes, [phase], [fm_mod/]
249     Take a (perl or pdl) list of (integer) "partials" and a list of
250     "amplitudes" and generate a single wave shape that results by adding
251     these partial sines.
252    
253     This could (and should) be used by the "gen_from_table" generator.
254    
255     gen_from_partials duration*, frequency/, partials, amplitudes, [phase], [fm_mod/]
256     Take a (perl list or pdl) list of (possibly noninteger) "partials" and a
257     list of "amplitudes" and generate the waveform resulting by summing up
258     all these partial sines.
259    
260     filter_one_zero
261     Signature: (in(n); [o] out(n); double a0; double a1)
262    
263     apply a one zero filter, y(n) = a0 x(n) + a1 x(n-1)
264    
265     filter_one_pole
266     Signature: (in(n); [o] out(n); double a0; double b1)
267    
268     apply a one pole filter, y(n) = a0 x(n) - b1 y(n-1)
269    
270     filter_two_zero
271     Signature: (in(n); [o] out(n); double a0; double a1; double a2)
272    
273     apply a two zero filter, y(n) = a0 x(n) + a1 x(n-1) + a2 x(n-2)
274    
275     filter_two_pole
276     Signature: (in(n); [o] out(n); double a0; double b1; double b2)
277    
278     apply a two pole filter, y(n) = a0 x(n) - b1 y(n-1) - b2 y(n-2)
279    
280     filter_formant
281     Signature: (in(n); [o] out(n); double radius; double frequency; double gain)
282    
283     apply a formant filter, y(n) = x(n) - r*x(n-2) +
284     2*r*cos(2*pi*frequency)*y(n-1) - r*r*y(n-2). A good value for "gain" is
285     1.
286    
287     filter_ppolar pdl, radius/, frequency/
288     apply a two pole filter (given in polar form). The filter has two poles,
289     one at (radius,frequency), the other at (radius,-frequency). Radius is
290     between 0 and 1 (but less than 1), and frequency is between 0 and 0.5.
291     This is the standard resonator form with poles specified by the polar
292     coordinates of one pole.
293    
294     filter_zpolar pdl, radius/, frequency/
295     apply a two zero filter (given in polar form). See "filter_ppolar".
296    
297     partials2polynomial partials, [kind]
298     "partials2polynomial" takes a list of harmonic amplitudes and returns a
299     list of Chebychev polynomial coefficients. The argument "kind"
300     determines which kind of Chebychev polynomial we are interested in, 1st
301     kind or 2nd kind. (default is 1).
302    
303     ring_modulate in1, in2
304     ring modulates in1 with in2 (this is just a multiply).
305    
306     amplitude_modulate am_carrier, in1, in2
307     amplitude modulates am_carrier and in2 with in1 (this calculates in1 *
308     (am_carrier + in2)).
309    
310     filter_sir
311     Signature: (x(n); a(an); b(bn); [o]y(n))
312    
313     Generic (short delay) impulse response filter. "x" is the input signal
314     (which is supposed to be zero for negative indices). "a" contains the
315     input (x) coefficients (a0, a1, .. an), whereas "b" contains the output
316     (y) coefficients (b0, b1, ... bn), i.e.:
317    
318     y(n) = a0 x(n) - b1 y(n-1) + a1 x(n-1) - b2 y(n-2) + a2 x(n-2) - b3 ...
319    
320     This can be used to generate fir and iir filters of any length, or even
321     more complicated constructs.
322    
323     "b0" (then first element of "b") is being ignored currently AND SHOULD
324     BE SPECIFIED AS ONE FOR FUTURE COMPATIBILITY
325    
326     filter_lir
327     Signature: (x(n); int a_x(an); a_y(an); int b_x(bn); b_y(bn); [o]y(n))
328    
329     Generic (long delay) impulse response filter. The difference to
330     "filter_sir" is that the filter coefficients need not be consecutive,
331     but instead their indices are given by the "a_x" and "b_x" (integer)
332     vectors, while the corresponding coefficients are in "a_y" and "b_y".
333     (All "a_x" must be >= 0, while all the "b_x" must be >= 1, as you should
334     expect).
335    
336     See "filter_sir" for more info.
337    
338     filter_fir input, xcoeffs
339     Apply a fir (finite impulse response) filter to "input". This is the
340     same as calling:
341    
342     filter_sir input, xcoeffs, pdl()
343    
344     filter_iir input, ycoeffs
345     Apply a iir (infinite impulse response) filter to "input". This is just
346     another way of saying:
347    
348     filter_sir input, pdl(1), ycoeffs
349    
350     That is, the first member of "ycoeffs" is being ignored AND SHOULD BE
351     SPECIFIED AS ONE FOR FUTURE COMPATIBILITY!
352    
353     filter_comb input, delay*, scaler
354     Apply a comb filter to the piddle "input". This is implemented using a
355     delay line of length "delay" (which must be 1 or larger and can be
356     non-integer) and a feedback scaler.
357    
358     y(n) = x(n-size-1) + scaler * y(n-size)
359    
360     cf. "filter_notch" and
361     http://www.harmony-central.com/Effects/Articles/Reverb/comb.html
362    
363     filter_notch input, delay*, scaler
364     Apply a comb filter to the piddle "input". This is implemented using a
365     delay line of length "delay" (which must be 1 or larger and can be
366     non-integer) and a feedforward scaler.
367    
368     y(n) = x(n-size-1) * scaler + y(n-size)
369    
370     As a rule of thumb, the decay time of the feedback part is
371     "7*delay/(1-scaler)" samples, so to get a decay of Dur seconds, "scaler
372     <= 1-7*delay/(Dur*Srate)". The peak gain is "1/(1-(abs scaler))". The
373     peaks (or valleys in notch's case) are evenly spaced at "srate/delay".
374     The height (or depth) thereof is determined by scaler -- the closer to
375     1.0, the more pronounced. See Julius Smith's "An Introduction to Digital
376     Filter Theory" in Strawn "Digital Audio Signal Processing", or Smith's
377     "Music Applications of Digital Waveguides"
378    
379     filter_allpass input, delay*, scaler-feedback, scaler-feedforward
380     "filter_allpass" or "moving average comb" is just like "filter_comb" but
381     with an added feedforward term. If "scaler-feedback == 0", we get a
382     moving average comb filter. If both scaler terms == 0, we get a pure
383     delay line.
384    
385     y(n) = feedforward*x(n-1) + x(n-size-1) + feedback*y(n-size)
386    
387     cf. http://www.harmony-central.com/Effects/Articles/Reverb/allpass.html
388    
389     design_remez_fir filter_size, bands(2,b), desired_gain(b), type, [weight(b)]
390     Calculates the optimal (in the Chebyshev/minimax sense) FIR filter
391     impulse response given a set of band edges, the desired reponse on those
392     bands, and the weight given to the error in those bands, using the
393     Parks-McClellan exchange algorithm.
394    
395     The first argument sets the filter size: "design_remez_fir" returns as
396     many coefficients as specified by this parameter.
397    
398     "bands" is a vector of band edge pairs (start - end), which specify the
399     start and end of the bands in the filter specification. These must be
400     non-overlapping and sorted in increasing order. Only values between 0 (0
401     Hz) and 0.5 (the Nyquist frequency) are allowed.
402    
403     "des" specifies the desired gain in these bands.
404    
405     "weight" can be used to give each band a different weight. If absent, a
406     vector of ones is used.
407    
408     "type" is any of the exported constants "BANDPASS", "DIFFERENTIATOR" or
409     "HILBERT" and can be used to select various design types (use "BANDPASS"
410     until this is documented ;)
411    
412     filter_src input, srate, [width], [sr-mod]
413     Generic sampling rate conversion, implemented by convoluting "input"
414     with a sinc function of size "width" (default when unspecified or zero:
415     5).
416    
417     "srate" determines the input rate / output rate ratio, i.e. values > 1
418     speed up, values < 1 slow down. Values < 0 are allowed and reverse the
419     signal.
420    
421     If "sr_mod" is omitted, the size of the output piddle is calculcated as
422     "length(input)/abs(srate)", e.g. it provides the full stretched or
423     shrinked input signal.
424    
425     If "sr_mod" is specified it must be as large as the desired output, i.e.
426     it's size determines the output size. Each value in "sr_mod" is added to
427     "srate" at the given point in "time", so it can be used to "modulate"
428     the sampling rate change.
429    
430     # create a sound effect in the style of "Forbidden Planet"
431     $osc = 0.3 * gen_oscil $osc, 30 / $pdl->rate;
432     $output = filter_src($input, 1, 0, $osc);
433    
434     filter_contrast_enhance input, enhancement
435     Contrast-enhancement phase-modulates a sound file. It's like audio MSG.
436     The actual algorithm is (applied to the normalised sound)
437     "sin(input*pi/2 + (enhancement*sin(input*2*pi)))". The result is to
438     brighten the sound, helping it cut through a huge mix.
439    
440     filter_granulate input, expansion, [option-hash], option => value...
441     "filter_granulate" "granulates" the sound file file. It is the poor
442     man's way to change the speed at which things happen in a recorded sound
443     without changing the pitches. It works by slicing the input file into
444     short pieces, then overlapping these slices to lengthen (or shorten) the
445     result; this process is sometimes known as granular synthesis, and is
446     similar to the "freeze" function. The duration of each slice is "length"
447     -- the longer, the more like reverb the effect. The portion of the
448     length (on a scale from 0 to 1.0) spent on each ramp (up or down) is
449     "ramp". This can control the smoothness of the result of the overlaps.
450     The more-or-less average time between successive segments is "hop". The
451     accuracy at which we handle this hopping is set by the float "jitter" --
452     if "jitter" is very small, you may get an annoying tremolo. The overall
453     amplitude scaler on each segment is "scaler" -- this is used to try to
454     to avoid overflows as we add all these zillions of segments together.
455     "expansion" determines the input hop in relation to the output hop; an
456     expansion-amount of 2.0 should more or less double the length of the
457     original, whereas an expansion-amount of 1.0 should return something
458     close to the original speed.
459    
460     The defaults for the arguments/options are:
461    
462     expansion 1.0
463     length(*) 0.15
464     scaler 0.6
465     hop(*) 0.05
466     ramp 0.4
467     jitter(*) 0.5
468     maxsize infinity
469    
470     The parameters/options marked with (*) actually depend on the sampling
471     rate, and are always multiplied by the "rate" attribute of the piddle
472     internally. If the piddle lacks that attribute, 44100 is assumed. NOTE:
473     This is different to most other filters, but should be ok since
474     "filter_granulate" only makes sense for audiofiles.
475    
476     audiomix pos1, data1, pos2, data2, ...
477     Generate a mix of all given piddles. The resulting piddle will contain
478     the sum of all data-piddles at their respective positions, so some
479     scaling will be necessary before or after the mixing operation (e.g.
480     scale2short).
481    
482     # mix the sound gong1 at position 0, the sound bass5 at position 22100
483     # and gong2 at position 44100. The resulting piddle will be large enough
484     # to accomodate all the sounds:
485     $mix = audiomix 0, $gong1, 44100, $gong2, 22100, $gong2
486    
487     filter_center piddle
488     Normalize the piddle so that it is centered around "y = 0" and has
489     maximal amplitude of 1.
490    
491     scale2short piddle
492     This method takes a sound in any format (preferably float or double) and
493     scales it to fit into a signed short value, suitable for playback using
494     "playudio" or similar functions.
495    
496     gen_fft_window size*, type, [$beta]
497     Creates and returns a specific fft window. The "type" is any of the
498     following. These are (case-insensitive) strings, so you might need to
499     quote them.
500    
501     RECTANGULAR just ones (the identity window)
502     HANNING 0.50 - 0.50 * cos (0 .. 2pi)
503     HAMMING 0.54 - 0.46 * cos (0 .. 2pi)
504     WELCH 1 - (-1 .. 1) ** 2
505     PARZEN the triangle window
506     BARTLETT the symmetric triangle window
507     BLACKMAN2 blackman-harris window of order 2
508     BLACKMAN3 blackman-harris window of order 3
509     BLACKMAN4 blackman-harris window of order 4
510     EXPONENTIAL the exponential window
511     KAISER the kaiser/bessel window (using the parameter C<beta>)
512     CAUCHY the cauchy window (using the parameter <beta>)
513     POISSON the poisson window (exponential using parameter C<beta>)
514     RIEMANN the riemann window (sinc)
515     GAUSSIAN the gaussian window of order C<beta>)
516     TUKEY the tukey window (C<beta> specifies how much of the window
517     consists of ones).
518     COSCOS the cosine-squared window (a partition of unity)
519     SINC same as RIEMANN
520     HANN same as HANNING (his name was Hann, not Hanning)
521    
522     LIST this "type" is special in that it returns a list of all types
523    
524     cplx(2,n) = rfft real(n)
525     Do a (complex fft) of "real" (extended to complex so that the imaginary
526     part is zero), and return the complex fft result. This function tries to
527     use PDL::FFTW (which is faster for large vectors) when available, and
528     falls back to PDL::FFT, which is likely to return different phase signs
529     (due to different kernel functions), so beware! In fact, since "rfft"
530     has to shuffle the data when using PDL::FFT, the fallback is always
531     slower.
532    
533     When using PDL::FFTW, a wisdom file ~/.pdl_wisdom is used and updated,
534     if possible.
535    
536     real(n) = irfft cplx(2,n)
537     The inverse transformation (see "rfft"). "irfft rfft $pdl == $pdl"
538     always holds.
539    
540     spectrum data, [norm], [window], [beta]
541     Returns the spectrum of a given pdl. If "norm" is absent (or "undef"),
542     it returns the magnitude of the fft of "data". When "norm" == 1 (or "eq
543     'NORM'", case-insensitive), it returns the magnitude, normalized to be
544     between zero and one. If "norm" == 0 (or "eq 'dB'", case-insensitive),
545     then it returns the magnitude in dB.
546    
547     "data" is multiplied with "window" (if not "undef") before calculating
548     the fft, and usually contains a window created with "gen_fft_window"
549     (using "beta"). If "window" is a string, it is handed over to
550     "gen_fft_window" (together with the beta parameter) to create a window
551     of suitable size.
552    
553     This function could be slightly faster.
554    
555     concat pdl, pdl...
556     This is not really an audio-related function. It simply takes all
557     piddles and concats them into a larger one. At the moment it only
558     supports single-dimensional piddles and is implemented quite slowly
559     using perl and data-copying, but that might change...
560    
561     filter_convolve
562     Signature: (input(n); kernel(m); int fftsize(); [o]output(n))
563    
564     info not available
565    
566     rshift
567     Signature: (x(n); int shift(); c(); [oca]y(n))
568    
569     Shift vector elements without wrap and fill the free space with a
570     constant. Flows data back & forth, for values that overlap.
571    
572     Positive values shift right, negative values shift left.
573    
574     polynomial
575     Signature: (coeffs(n); x(m); [o]out(m))
576    
577     evaluate the polynomial with coefficients "coeffs" at the position(s)
578     "x". "coeffs[0]" is the constant term.
579    
580     linear_interpolate
581     Signature: (x(); fx(n); fy(n); [o]y())
582    
583     Look up the ordinate "x" in the function given by "fx" and "fy" and
584     return a linearly interpolated value (somewhat optimized for many
585     lookups).
586    
587     "fx" specifies the ordinates (x-coordinates) of the function and most be
588     sorted in increasing order. "fy" are the y-coordinates of the function
589     in these points.
590    
591     bessi0
592     Signature: (a(); [o]b())
593    
594     calculate the (approximate) modified bessel function of the first kind
595    
596     fast_sin
597     Signature: (r(n); [o]s(n))
598    
599     fast sine function (inaccurate table lookup with ~12 bits precision)
600    
601     AUTHOR
602     Marc Lehmann <schmorp@schmorp.de>. The ideas were mostly taken from
603     common lisp music (CLM), by Bill Schottstaedt "bil@ccrma.stanford.edu".
604     I also borrowed many explanations (and references) from the clm docs and
605     some code from clm.c. Highly inspiring!
606    
607     SEE ALSO
608     perl(1), PDL.
609 root 1.1