2016/12/09 @ YAPC::Hokkaido 2016 SAPPORO前夜祭
Created by @techno_neko
矩形波のグラフとWAVファイルを出力するスクリプト
use v5.16;
use strict;
use warnings;
use constant X_MAX => 2048;
use constant Y_MAX => 512;
use constant Y_MIN => -512;
use constant VALUE_MAX => 256;
use constant VALUE_MIN => -256;
use constant X_STEP => 4;
use Cassis;
use Imager;
use List::Util qw/sum/;
use Math::Trig qw/pi/;
my $marginX = 20;
my $marginY = 120;
my $width = $marginX + (X_MAX + 1) + $marginX;
my $height = $marginY + (Y_MAX - Y_MIN + 1) + $marginY;
my ( $x0, $y0 ) = ( $marginX, $marginY + (Y_MAX + 1) );
my $fs = X_MAX / X_STEP;
my $freq = 1.0;
my $dt = $freq / $fs;
write_graph( 'pulse.png', [
{ color => 'orange' , samples => gen_samples($fs + 1, $dt, 2) },
{ color => 'purple' , samples => gen_samples($fs + 1, $dt, 4) },
{ color => 'green' , samples => gen_samples($fs + 1, $dt, 12) },
{ color => 'red' , samples => gen_samples($fs + 1, $dt,128) }
] );
$dt = 0.005;
Cassis::File::write(
file => 'pulse.wav',
fs => 44100,
channels => [ gen_samples(44100 * 5, $dt, 50, 1.0) ]
);
sub get_osc {
my $k = shift;
my @wk = map { (2 * $_) - 1; } 1..$k;
return sub {
my $t = shift;
return (4.0 / pi()) * sum( map {
(1.0 / $_) * sin(2.0 * pi() * $t * $_);
} @wk );
};
}
sub gen_samples {
my ( $n, $dt, $k, $gain ) = @_;
$gain //= VALUE_MAX;
say 'max dt = ', $dt * ((2 * $k) - 1);
my $osc = get_osc( $k );
my @samples = map {
$gain * $osc->($_ * $dt);
} 0..($n - 1);
return \@samples;
}
sub write_graph {
my ( $dst_file, $waves ) = @_;
my $img = Imager->new(
xsize => $width, ysize => $height, channels => 4 );
$img->box( filled => 1, color => 'white' );
draw_graduation( $img, Imager::Color->new(192, 192, 192) );
my %pallete = (
orange => { hue => 45, v => 1.0, s => 1.0, opacity => 1.0 },
purple => { hue => 300, v => 1.0, s => 1.0, opacity => 1.0 },
green => { hue => 130, v => 0.7, s => 1.0, opacity => 1.0 },
red => { hue => 0, v => 1.0, s => 1.0, opacity => 1.0 }
);
foreach my $wave ( @{$waves} ) {
my $x = 0;
my @tmp = ();
foreach ( @{$wave->{samples}} ) {
push @tmp, [ $x, $_ ];
$x += X_STEP;
}
my $color = $pallete{$wave->{color}};
if ( not $color ) {
warn 'not found! -> ', $wave->{color};
next;
}
my $c = Imager::Color->new( %{$color} );
my ( $rr, $gg, $bb, undef ) = $c->rgba();
say 'Color = ', sprintf('#%02X%02X%02X', $rr, $gg, $bb);
my $o = $color->{opacity};
draw_polyline( $img, \@tmp, $c, $o * 0.7 );
plot_points( $img, \@tmp, $c, $o * 0.3, 1 );
plot_points( $img, \@tmp, $c, $o * 0.5 );
}
$img->write( file => $dst_file ) or die $img->errstr;
}
sub draw_graduation {
my ( $img, $color ) = @_;
{
my $gray = Imager::Color->new( 192, 192, 192 );
my $x = (X_MAX / 8);
while ( $x <= X_MAX ) {
$img->line( color => $gray,
x1 => $x0 + $x, y1 => $y0 + Y_MIN,
x2 => $x0 + $x, y2 => $y0 + Y_MAX );
$x += (X_MAX / 8);
}
my $y = (Y_MAX / 2);
while ( $y <= Y_MAX ) {
$img->line( color => $gray,
x1 => $x0 + 0, y1 => $y0 - $y,
x2 => $x0 + X_MAX, y2 => $y0 - $y );
$img->line( color => $gray,
x1 => $x0 + 0, y1 => $y0 + $y,
x2 => $x0 + X_MAX, y2 => $y0 + $y );
$y += (Y_MAX / 2);
}
}
{
$img->line( color => 'black',
x1 => $x0, y1 => $y0 + Y_MIN,
x2 => $x0, y2 => $y0 + Y_MAX );
$img->line( color => 'black',
x1 => $x0 + 0, y1 => $y0,
x2 => $x0 + X_MAX, y2 => $y0 );
}
}
sub plot_points {
my ( $img, $data, $color, $opacity, $filled ) = @_;
$filled //= 0;
my $n = 2;
my $img_dst = $img;
if ( defined($opacity) and $opacity < 1.0 ) {
$img_dst = Imager->new(
xsize => $img->getwidth(), ysize => $img->getheight(), channels => 4 );
}
foreach my $pt ( @{$data} ) {
my ( $x, $y ) = ( $pt->[0], $pt->[1] );
$y /= (VALUE_MAX / Y_MAX);
$y = ( $y < .0 ) ? int($y - .5) : int($y + .5);
#printf( "%6.3f, %6.3f\n", $x, $y );
$img_dst->box(
xmin => $x0 + $x - $n, ymin => $y0 - $y - $n,
xmax => $x0 + $x + $n, ymax => $y0 - $y + $n,
color => $color, filled => $filled );
}
if ( $img != $img_dst ) {
$img->compose(
src => $img_dst, opacity => $opacity );
}
}
sub draw_polyline {
my ( $img, $data, $color, $opacity ) = @_;
my $img_dst = $img;
if ( defined($opacity) and $opacity < 1.0 ) {
$img_dst = Imager->new(
xsize => $img->getwidth(), ysize => $img->getheight(), channels => 4 );
}
my @points = map {
my ( $x, $y ) = ( $_->[0], $_->[1] );
$y /= (VALUE_MAX / Y_MAX);
$y = ( $y < .0 ) ? int($y - .5) : int($y + .5);
[ $x0 + $x, $y0 - $y ];
} @{$data};
$img_dst->polyline( points => \@points, color => $color );
if ( $img != $img_dst ) {
$img->compose(
src => $img_dst, opacity => $opacity );
}
}
矩形波のWAVファイルを出力するスクリプト
use v5.16;
use strict;
use warnings;
use List::Util qw/sum/;
use Math::Trig qw/pi/;
use Cassis;
my $freq = 440.0;
# gain を指定してクリップされないようにすること！
my $samples = gen_samples(
44100 * 5, $freq / 44100, 5, 0.8 );
Cassis::File::write(
file => 'sample3.wav',
fs => 44100,
channels => [ $samples ]
);
sub get_osc {
my $k = shift;
my @wk = map { (2 * $_) - 1; } 1..$k;
return sub {
my $t = shift;
return (4.0 / pi()) * sum( map {
(1.0 / $_) * sin(2.0 * pi() * $t * $_);
} @wk );
};
}
sub gen_samples {
my ( $n, $dt, $k, $gain ) = @_;
say 'max dt = ', $dt * ((2 * $k) - 1);
my $osc = get_osc( $k );
my @samples = map {
$gain * $osc->($_ * $dt);
} 0..($n - 1);
return \@samples;
}
バタワース特性を描画するスクリプト
use v5.16;
use strict;
use warnings;
use constant X_MAX => 480;
use constant Y_MAX => 240;
use constant Y_MIN => 0;
use constant VALUE_MAX => 256;
use constant VALUE_MIN => 0;
use constant X_STEP => 3;
use Imager;
use List::Util qw/sum/;
use Math::Trig qw/pi/;
my $marginX = 16;
my $marginY = 16;
my $width = $marginX + (X_MAX + 1) + $marginX;
my $height = $marginY + (Y_MAX - Y_MIN + 1) + $marginY;
my ( $x0, $y0 ) = ( $marginX, $marginY + (Y_MAX + 1) );
my $fc = 0.35;
write_graph( 'alias-filter.png', [
{ color => 'blue', func => get_func(22.0, $fc) }
] );
sub get_func {
my ( $m, $fc ) = @_;
return sub {
my $t = shift;
return 1.0 / sqrt(1.0 + (($t / $fc) ** (2.0 * $m)));
};
}
sub write_graph {
my ( $dst_file, $filters ) = @_;
my $img = Imager->new(
xsize => $width, ysize => $height, channels => 4 );
$img->box( filled => 1, color => 'white' );
draw_graduation( $img, Imager::Color->new(192, 192, 192) );
my %pallete = (
orange => { hue => 45, v => 1.0, s => 1.0, opacity => 1.0 },
purple => { hue => 300, v => 1.0, s => 1.0, opacity => 1.0 },
green => { hue => 130, v => 0.7, s => 1.0, opacity => 1.0 },
red => { hue => 0, v => 1.0, s => 1.0, opacity => 1.0 },
blue => { hue => 240, v => 1.0, s => 1.0, opacity => 1.0 },
);
foreach my $f ( @{$filters} ) {
my $func = $f->{func};
my @tmp = ();
for (my $i=0; $i<=X_MAX; $i+=X_STEP) {
my $x = $i / X_MAX;
push @tmp, [ $i, $func->($x) * VALUE_MAX ];
}
my $color = $pallete{$f->{color}};
if ( not $color ) {
warn 'not found! -> ', $f->{color};
next;
}
my $c = Imager::Color->new( %{$color} );
my ( $rr, $gg, $bb, undef ) = $c->rgba();
say 'Color = ', sprintf('#%02X%02X%02X', $rr, $gg, $bb);
my $o = $color->{opacity};
draw_spectrum( $img, \@tmp, $c, $o * 0.3, 1 );
#draw_polyline( $img, \@tmp, $c, $o * 0.7 );
#plot_points( $img, \@tmp, $c, $o * 0.3, 1 );
plot_points( $img, \@tmp, $c, $o * 0.5 );
}
$img->write( file => $dst_file ) or die $img->errstr;
}
sub draw_graduation {
my ( $img, $color ) = @_;
{
my $gray = Imager::Color->new( 192, 192, 192 );
my $x = (X_MAX / 4);
while ( $x <= X_MAX ) {
$img->line( color => $gray,
x1 => $x0 + $x, y1 => $y0 - Y_MIN,
x2 => $x0 + $x, y2 => $y0 - Y_MAX );
$x += (X_MAX / 4);
}
my $y = Y_MIN;
while ( $y <= Y_MAX ) {
$img->line( color => $gray,
x1 => $x0 + 0, y1 => $y0 - $y,
x2 => $x0 + X_MAX, y2 => $y0 - $y );
$y += (Y_MAX / 2);
}
}
# 原点じゃない側の軸線を端まで伸ばすバージョン
{
$img->line( color => 'black',
x1 => $x0, y1 => $y0 - Y_MIN,
#x2 => $x0, y2 => $y0 - Y_MAX );
x2 => $x0, y2 => 0 );
$img->line( color => 'black',
x1 => $x0 + 0, y1 => $y0,
#x2 => $x0 + X_MAX, y2 => $y0 );
x2 => $img->getwidth() - 1, y2 => $y0 );
}
}
sub plot_points {
my ( $img, $data, $color, $opacity, $filled ) = @_;
$filled //= 0;
my $n = 1;
my $img_dst = $img;
if ( defined($opacity) and $opacity < 1.0 ) {
$img_dst = Imager->new(
xsize => $img->getwidth(), ysize => $img->getheight(), channels => 4 );
}
foreach my $pt ( @{$data} ) {
my ( $x, $y ) = ( $pt->[0], $pt->[1] );
$y /= (VALUE_MAX / Y_MAX);
$y = ( $y < .0 ) ? int($y - .5) : int($y + .5);
#printf( "%6.3f, %6.3f\n", $x, $y );
$img_dst->box(
xmin => $x0 + $x - $n, ymin => $y0 - $y - $n,
xmax => $x0 + $x + $n, ymax => $y0 - $y + $n,
color => $color, filled => $filled );
}
if ( $img != $img_dst ) {
$img->compose(
src => $img_dst, opacity => $opacity );
}
}
sub draw_polyline {
my ( $img, $data, $color, $opacity ) = @_;
my $img_dst = $img;
if ( defined($opacity) and $opacity < 1.0 ) {
$img_dst = Imager->new(
xsize => $img->getwidth(), ysize => $img->getheight(), channels => 4 );
}
my @points = map {
my ( $x, $y ) = ( $_->[0], $_->[1] );
$y /= (VALUE_MAX / Y_MAX);
$y = ( $y < .0 ) ? int($y - .5) : int($y + .5);
[ $x0 + $x, $y0 - $y ];
} @{$data};
$img_dst->polyline( points => \@points, color => $color );
if ( $img != $img_dst ) {
$img->compose(
src => $img_dst, opacity => $opacity );
}
}
sub draw_spectrum {
my ( $img, $data, $color, $opacity, $with_box ) = @_;
$with_box //= 0;
my $n = 1;
my $img_dst = $img;
if ( defined($opacity) and $opacity < 1.0 ) {
$img_dst = Imager->new(
xsize => $img->getwidth(), ysize => $img->getheight(), channels => 4 );
}
foreach my $pt ( @{$data} ) {
my ( $x, $y ) = ( $pt->[0], $pt->[1] );
$y /= (VALUE_MAX / Y_MAX);
$y = ( $y < .0 ) ? int($y - .5) : int($y + .5);
$img_dst->line(
x1 => ($x0 + $x), y1 => $y0,
x2 => ($x0 + $x), y2 => ($y0 - $y),
color => $color );
if ( $with_box ) {
$img_dst->box(
xmin => $x0 + $x - $n, ymin => $y0 - $y - $n,
xmax => $x0 + $x + $n, ymax => $y0 - $y + $n,
color => $color, filled => 1 );
}
}
if ( $img != $img_dst ) {
$img->compose(
src => $img_dst, opacity => $opacity );
}
}