pinknoise.psgi

#!/usr/bin/env perl

use strict;
use warnings;
use Plack::Request;

# run `plackup pinknoise.psgi` and access to http://0:5000/?s=<second> via browser

my $app = sub {
    my $req = Plack::Request->new(shift);
    my $wav = pinknoise($req->param('s'));
    return [
        200,
        [
            'Content-Type'   => 'audio/x-wav',
            'Content-Length' => length($wav) + 44,
        ],
        [
            riff_header(length $wav),
            $wav,
        ],
    ];
};

sub pinknoise {
    my $sec = shift || 1;
    my $sound = '';
    my $size = 1000;
    for (1 .. (44100 * $sec)) {
        my $prob;
        my $diffmag;
        my $diff;
        do {
            $diff = int(rand(2 * $size) - $size);
            $diffmag = abs($diff);
            $prob = rand($size);
        } while ($diffmag < $prob);
        my $val += $diff;
        if ($val > 32767) {
            $val = 32767;
        }
        elsif ($val < -32767) {
            $val = -32767;
        }
        $sound .= pack 'v', $val;
    }
    return $sound;
}

sub riff_header {
    my $size = shift;
    my $header = 'RIFF';
    $header .= pack 'V', $size + 36;
    $header .= 'WAVE';
    $header .= 'fmt ';
    $header .= pack 'V', 16;
    $header .= pack 'v', 1;
    $header .= pack 'v', 1;
    $header .= pack 'V', 44100;
    $header .= pack 'V', 44100 * 2;
    $header .= pack 'v', 2;
    $header .= pack 'v', 16;
    $header .= 'data';
    $header .= pack 'V', $size;
    return $header;
}