| 1 |
#!/usr/bin/perl |
| 2 |
|
| 3 |
#use blib; |
| 4 |
use PDL; |
| 5 |
use PDL::Audio; |
| 6 |
#use PDL::Graphics::PGPLOT; |
| 7 |
use PDL::Audio::Pitches; |
| 8 |
use PDL::Dbg; |
| 9 |
use PDL::Complex; |
| 10 |
|
| 11 |
$|=1; |
| 12 |
|
| 13 |
*_dur2time = *PDL::Audio::_dur2time; |
| 14 |
sub HZ (){ 22050 }; |
| 15 |
|
| 16 |
sub freqz { |
| 17 |
my ($a, $b, $w) = @_; |
| 18 |
$w = 512 unless defined $w; |
| 19 |
$w = zeroes($w)->xlinvals(0,M_PI*($w-1)/$w) unless ref $w; |
| 20 |
$w = exp i * r2C $w; |
| 21 |
|
| 22 |
Cabs(Cdiv($a->rCpolynomial($w),$b->rCpolynomial($w))); |
| 23 |
} |
| 24 |
|
| 25 |
sub play { |
| 26 |
my $pdl = shift; |
| 27 |
#line $pdl; |
| 28 |
$pdl->scale2short->playaudio(rate => HZ, @_); |
| 29 |
} |
| 30 |
|
| 31 |
$pdl = raudio "kongas.wav"; |
| 32 |
|
| 33 |
print describe_audio($pdl), "\n"; |
| 34 |
|
| 35 |
$pdl = $pdl->float->filter_src($pdl->rate / HZ); |
| 36 |
$pdl = $pdl->filter_center; |
| 37 |
|
| 38 |
my @stdenv = (pdl(0,0.1,0.2,0.9,1), pdl(0,1,0.6,0.6,0)); |
| 39 |
$env = gen_env $pdl, @stdenv; |
| 40 |
|
| 41 |
sub tst($$) { |
| 42 |
push @tests, [$_[0], $_[1]]; |
| 43 |
} |
| 44 |
|
| 45 |
tst src, sub { |
| 46 |
for (qw(22050 11025 8000)) { |
| 47 |
print " $_"; play $pdl->filter_src(44100 / $_), rate => $_; |
| 48 |
} |
| 49 |
}; |
| 50 |
|
| 51 |
tst contrast_enhance, sub { |
| 52 |
for (qw(0.1 0.2 0.3 0.6 1)) { |
| 53 |
print " $_"; play $pdl->filter_contrast_enhance($_); |
| 54 |
} |
| 55 |
}; |
| 56 |
|
| 57 |
tst granulate, sub { |
| 58 |
for (qw(1.5 1.3 1.1 1.0 0.8 0.6 0.5)) { |
| 59 |
print " $_"; play $pdl->filter_granulate($_); |
| 60 |
} |
| 61 |
print " +SRC:"; |
| 62 |
for (qw(1.5 1.3 1.1 1.0 0.8 0.6 0.5)) { |
| 63 |
print " $_"; play $pdl->filter_granulate($_)->filter_src($_), rate => 44100; |
| 64 |
} |
| 65 |
}; |
| 66 |
|
| 67 |
tst modulated_src, sub { |
| 68 |
print " 2 hz 0.7 sine..."; |
| 69 |
play $pdl->filter_src(1, 5, 0.7 * gen_oscil $pdl, 2/HZ); |
| 70 |
print " 5 hz 0.3 sine..."; |
| 71 |
play $pdl->filter_src(1, 5, 0.3 * gen_oscil $pdl, 20/HZ); |
| 72 |
print " 90 hz 0.5 sine..."; |
| 73 |
play $pdl->filter_src(1, 5, 0.5 * gen_oscil $pdl, 90/HZ); |
| 74 |
print " 300 hz 0.8 sine..."; |
| 75 |
play $pdl->filter_src(1, 5, 0.8 * gen_oscil $pdl, 300/HZ); |
| 76 |
}; |
| 77 |
|
| 78 |
tst 'ring_modulate', sub { |
| 79 |
print " ring modulated with 20 hz sine"; |
| 80 |
play $pdl->ring_modulate(gen_oscil $pdl, 20 / HZ); |
| 81 |
print " ring modulated with 1000 hz sine"; |
| 82 |
play $pdl->ring_modulate(gen_oscil $pdl, 1000 / HZ); |
| 83 |
}; |
| 84 |
|
| 85 |
tst 'touchtones', sub { |
| 86 |
my @h = ( 697, 697, 697, 770, 770, 770, 852, 852, 852, 941, 941, 941); |
| 87 |
my @v = (1209,1336,1477,1209,1336,1477,1209,1336,1477,1209,1336,1477); |
| 88 |
my $dur = HZ*0.22; |
| 89 |
my $env = gen_env $dur, pdl(0,1,2,9,10), pdl(0,1,0.9,0.9,0); |
| 90 |
my @mix; |
| 91 |
for (0..$#h) { |
| 92 |
my ($h, $v) = ($h[$_], $v[$_]); |
| 93 |
$h = $env * gen_oscil $dur, $h/HZ; |
| 94 |
$v = $env * gen_oscil $dur, $v/HZ; |
| 95 |
push @mix, ($_*$dur, $h, $_*$dur, $v); |
| 96 |
}; |
| 97 |
play audiomix @mix; |
| 98 |
}; |
| 99 |
|
| 100 |
tst noise_fm, sub { |
| 101 |
my $pdl; |
| 102 |
print " 100 hz"; |
| 103 |
$pdl = gen_rand 2*HZ, 100/HZ; |
| 104 |
$pdl = gen_oscil $pdl, 880/HZ, 0, $pdl * $pdl->xlinvals(0.001,0.1); |
| 105 |
play $pdl * gen_env $pdl, @stdenv; |
| 106 |
print " 6000 hz"; |
| 107 |
$pdl = gen_rand 2*HZ, 6000/HZ; |
| 108 |
$pdl = gen_oscil $pdl, 880/HZ, 0, $pdl * $pdl->xlinvals(0.001,0.1); |
| 109 |
play $pdl * gen_env $pdl, @stdenv; |
| 110 |
}; |
| 111 |
|
| 112 |
tst simple_fm, sub { |
| 113 |
my $fm = gen_triangle $pdl, 16/HZ; |
| 114 |
$fm *= $fm->xlinvals(0,0.1); |
| 115 |
print " 900 hz sine + vibrato"; play $env * gen_oscil $pdl, 900/HZ, 0, $fm; |
| 116 |
print " 900 hz sine + sound"; play $env * gen_oscil $pdl, 1/HZ, 0, $pdl * 0.08; |
| 117 |
}; |
| 118 |
|
| 119 |
tst filters, sub { |
| 120 |
print " filter_lir(<0.05s echo>)"; play $pdl->filter_lir(pdl(0),pdl(0.5), pdl(HZ*0.05), pdl(0.5)); |
| 121 |
print " ppolar(0.8,220)"; play $pdl->filter_ppolar(0.8,220); |
| 122 |
print " zpolar(0.8,220)"; play $pdl->filter_zpolar(0.8,220); |
| 123 |
}; |
| 124 |
|
| 125 |
tst 'waveshaping', sub { |
| 126 |
# this is the spectrum of a cello playing as3 |
| 127 |
my @i = (1.01, 1.99, 2.99, 4.00, 5.00, 6.00, 6.99, 8.00, 9.00, 9.98, |
| 128 |
10.99, 11.99, 13.00, 14.01, 14.99, 16.02, 17.00, 17.98, 19.00, 20.01, |
| 129 |
21.02, 22.02, 22.22, 22.93, 24.05, 25.04, 25.99, 27.00, 29.03); |
| 130 |
|
| 131 |
my @a = (.0839, .0414, .1265, .0196, .0377, .0117, .0111, .0151, .0207, |
| 132 |
.0033, .0090, .0039, .0039, .0031, .0038, .0023, .0026, .0069, .0020, |
| 133 |
.0017, .0007, .0006, .0002, .0001, .0003, .0002, .0003, .0003, .0003); |
| 134 |
|
| 135 |
# add a slight vibrato |
| 136 |
my $tri = gen_triangle 4*HZ, 1.5/HZ; |
| 137 |
my $pdl = gen_from_partials (4*HZ, as3/HZ, \@i, \@a, 0, 16/HZ*$tri); |
| 138 |
|
| 139 |
play $pdl * gen_env $pdl, @stdenv; |
| 140 |
}; |
| 141 |
|
| 142 |
0&&tst simple_generators, sub { |
| 143 |
print " 1/f noise"; play $env * gen_rand_1f $pdl; |
| 144 |
print " 900 hz sine"; play $env * gen_oscil $pdl, 900/HZ; |
| 145 |
print " 900 hz triangle"; play $env * gen_triangle $pdl, 900/HZ; |
| 146 |
print " 900 hz asyfm"; play $env * gen_asymmetric_fm $pdl, 900/HZ; |
| 147 |
print " 900 hz sine summation"; play $env * gen_sine_summation $pdl, 900/HZ, 0, 5; |
| 148 |
print " 900 hz sum of cosines"; play $env * gen_sum_of_cosines $pdl, 900/HZ, 0, 5; |
| 149 |
}; |
| 150 |
|
| 151 |
tst noise_filtering, sub { |
| 152 |
my $pdl = gen_rand 2*HZ, 1; |
| 153 |
$pdl = $pdl->filter_ppolar(0.97, 440/HZ); |
| 154 |
$pdl = $pdl->filter_lir(pdl(0),pdl(0.1), pdl(HZ/440),pdl(0.99)); |
| 155 |
play $pdl * gen_env $pdl, @stdenv; |
| 156 |
}; |
| 157 |
|
| 158 |
tst 'spectrum', sub { |
| 159 |
$pdl = gen_fft_window(100, KAISER, -1.0); |
| 160 |
#line spectrum $pdl, 'db'; |
| 161 |
#line spectrum $pdl, db', KAISER; |
| 162 |
#line spectrum $pdl, 'db'; |
| 163 |
exit; |
| 164 |
} if 0; |
| 165 |
|
| 166 |
tst 'karplus', sub { |
| 167 |
my $pdl = concat gen_rand(0.4*HZ, 1), zeroes(5.0*HZ); |
| 168 |
|
| 169 |
my $dur = 2*HZ; |
| 170 |
my $freq = 440/HZ; |
| 171 |
my $damping = -0.5/HZ; |
| 172 |
|
| 173 |
$freq *= M_2PI; |
| 174 |
|
| 175 |
my $e = exp $damping; |
| 176 |
my $c1 = 2 * $e * cos $freq; |
| 177 |
my $c2 = $e * $e; |
| 178 |
my $tm = atan2 ($freq, $damping) / $freq; |
| 179 |
my $scale = sqrt ($damping*$damping + $freq*$freq) * exp (-$damping*$tm) * HZ / 750000; |
| 180 |
print "$scale, $c1, $c2\n"; |
| 181 |
$pdl = $pdl->filter_lir(pdl(1), pdl($scale), |
| 182 |
pdl(1, 2, int(1/$freq+6)), pdl(-$c1, $c2, -$scale*0.1)); |
| 183 |
line $pdl; |
| 184 |
play $pdl * gen_env $pdl, @stdenv; |
| 185 |
|
| 186 |
} if 0; |
| 187 |
|
| 188 |
tst 'karplus2', sub { |
| 189 |
my $pdl = concat gen_rand(1.*HZ, 1), zeroes(5.0*HZ); |
| 190 |
|
| 191 |
my $dur = 2*HZ; |
| 192 |
my $freq = 440/HZ; |
| 193 |
my $freq2 = 88/HZ; |
| 194 |
my $reson = 0.05; |
| 195 |
|
| 196 |
$pdl = $pdl->filter_lir( |
| 197 |
pdl(1, 2, 1,2), |
| 198 |
pdl(-$reson*$reson, 2*$reson*cos(M_2PI*$freq), |
| 199 |
-$reson*$reson, 2*$reson*cos(M_2PI*$freq2)), |
| 200 |
pdl(int(1/$freq),int(1/$freq2)), pdl(0.49, 0.499)); |
| 201 |
line $pdl; |
| 202 |
play $pdl; # * gen_env $pdl, @stdenv; |
| 203 |
} if 0; |
| 204 |
|
| 205 |
tst 'vibro', sub { |
| 206 |
my $pdl; |
| 207 |
$pdl = gen_oscil 2*HZ, 40/HZ; |
| 208 |
#$pdl = gen_oscil 2*HZ, 40/HZ, 0, $pdl->xlinvals(0,80/HZ); |
| 209 |
#$pdl = $pdl->filter_zpolar(0.9, 80/HZ); |
| 210 |
#line $pdl->slice("0:30000"); |
| 211 |
$pdl = pdl(1,1)->partials2polynomial(1)->polynomial($pdl); |
| 212 |
line $pdl; |
| 213 |
play $pdl; |
| 214 |
exit; |
| 215 |
} if 0; |
| 216 |
|
| 217 |
tst chorus, sub { |
| 218 |
play $pdl; |
| 219 |
my $lfo = $osc = 0.02 * gen_rand $pdl, 30/HZ; |
| 220 |
my $dly = $pdl->filter_src(1, undef, $lfo); |
| 221 |
play $dly->rshift(0.030*HZ) + $pdl; |
| 222 |
}; |
| 223 |
|
| 224 |
tst phazor, sub { |
| 225 |
play $pdl; |
| 226 |
print "rfft..."; |
| 227 |
my $fft = rfft($pdl)->Cr2p; |
| 228 |
my $im = im $fft; $im .= $im->rshift(-10000); |
| 229 |
print "irfft..."; |
| 230 |
my $fft = irfft($fft->Cp2r); |
| 231 |
play $fft; |
| 232 |
} if 0; |
| 233 |
|
| 234 |
tst strong, sub { |
| 235 |
# as done originally by Alex Strong |
| 236 |
my $pdl = zeroes HZ*5; |
| 237 |
my $freq = int (HZ/220); |
| 238 |
my $x = $pdl->slice("0:".($freq-1)); $x .= gen_rand $x, 1; |
| 239 |
|
| 240 |
$pdl = $pdl->filter_lir(pdl(0),pdl(1),pdl($freq,$freq+1),pdl(0.5,0.5)); |
| 241 |
play $pdl; |
| 242 |
}; |
| 243 |
|
| 244 |
#print "original version..."; play $pdl; print "\n"; |
| 245 |
|
| 246 |
for (reverse @tests) { |
| 247 |
my ($name, $sub) = @$_; |
| 248 |
print "$name..."; |
| 249 |
&$sub; |
| 250 |
print "\n"; |
| 251 |
} |
| 252 |
|
| 253 |
exit; |
| 254 |
|
| 255 |
#$pdl2 = filter_granulate $pdl, 0.8, rate => 44100; |
| 256 |
$pdl2 = filter_contrast_enhance $pdl, 0.1; |
| 257 |
#$pdl->scale2short->playaudio(rate => 44100); |
| 258 |
$pdl2->scale2short->playaudio(rate => 44100); |
| 259 |
exit; |
| 260 |
|
| 261 |
$pdl = zeroes(4096); |
| 262 |
$pdl = sin $pdl->xlinvals(0,20) + sin $pdl->xlinvals(0,50); |
| 263 |
$pz = zeroes(40960); |
| 264 |
$pdl2 = filter_src ($pdl, 0.5, 80, $pz); |
| 265 |
#line $pdl2; |
| 266 |
$pdl2->scale2short->playaudio; |
| 267 |
|
| 268 |
|
| 269 |
|
| 270 |
|
