Category: Audio
Author/Contact Info true
Description: Handy combination of Flash and Perl used to generate wav patterns, write a wav file, then convert the wav into a swf format all from a linux server perl script. To use, click in the red box from left to right and a numbered array will appear. These numbers generate a wav pattern pitched off the values you enter. In addition, text may be used in place of number array. Right now the script doesn't deal with mixed numbers and words. So just enter words or just enter numbers. You can add several sounds onto the stage and adjust their volume and pan while you mix your way to velvetta heaven. Right now the program's sound capacity is 8 bit mono. Flash fakes the pan.

You can download this code at:
http://perl.to/lib/sequencercgi.txt

and here's a web-based demo.
http://perl.to/lib/sequencer.cgi This script outputs a raw swf file. You can call it inside of flash or run it from your browser. in a flash object tag. On win2k i can run it directly from the browser.
#!/usr/bin/perl
$key = 33;
$marker = 32;
$marker_limit = $marker;
if ($ENV{'QUERY_STRING'} eq ""){$ENV{'QUERY_STRING'} = "action=help";}
&readGet;
&readPost;
if ($action eq "help"){&help;}
if ($swf){&output_swf;}
if ($vector2swf){&vector2swf($vector2swf);}
exit;
###########################
###########################
sub help{
print "Content-type:text/html\n\n";
print <<EOM;
<h1>Howdy</h1>
Sound Sequencer.
Enter a series of numbers seperated by commas.<br>
22,34,76,45,98,189,215<br>

<form>
<input type=text name=vector2swf value="" size=23>
<input type=submit value="GO">
</form>
<br>
If you want to use this script be sure <br>
to grab the swf template too.<br>
<a href="http://perl.to/lib/sequenceloop.swf">sequenceloop.swf</a><br>
Your server will also need suexec enabled if it isn't already.
EOM
}#################################### end output_text

sub readTemplate{
$stream = "";
if ($template eq ""){$template = "sequenceloop.swf";}
open (FILE,"$template");
binmode FILE;
while ($line = <FILE>){
$stream=$stream.$line;
}close FILE;
@streamz = split(//,$stream);
$c=0;
@swf_header = ();
@swf_footer = ();


$z = 0;
$headPoint = 0;
foreach $of(@streamz){
####00 BF 03
$chkA = unpack("H*",$streamz[$z-2]);
$chkB = unpack("H*",$streamz[$z-1]);
$chkC = unpack("H*",$streamz[$z]);
if (($chkA =~ /^.*$/i)&&($chkB =~ /^BF$/i)&&($chkC =~ /^03$/i)){$fd = 
+$z;$headPoint = $z+13;}
$z++;
}
$sizC = unpack("H*",$streamz[$headPoint-3]);
$sizB = unpack("H*",$streamz[$headPoint-4]);
$sizA = unpack("H*",$streamz[$headPoint-5]);
$ji = $sizC.$sizB.$sizA;
$siz = hex($ji);

$z=0;
foreach $of(@streamz){
$chkA = unpack("H*",$streamz[$z-10]);
$chkB = unpack("H*",$streamz[$z-9]);
$chkC = unpack("H*",$streamz[$z-8]);
$chkD = unpack("H*",$streamz[$z-7]);
$chkE = unpack("H*",$streamz[$z-6]);
$chkF = unpack("H*",$streamz[$z-5]);
$chkG = unpack("H*",$streamz[$z-4]);
$chkH = unpack("H*",$streamz[$z-3]);
$chkI = unpack("H*",$streamz[$z-2]);
$chkJ = unpack("H*",$streamz[$z-1]);
$chkK = unpack("H*",$streamz[$z]);
$chkL = unpack("H*",$streamz[$z+1]);
$chkM = unpack("H*",$streamz[$z+2]);
$chkN = unpack("H*",$streamz[$z+3]);
#746F74616C427974657300
if (($chkA =~ /^74$/i)&&($chkB =~ /^6F$/i)&&($chkC =~ /^74$/i)&&($chkD
+ =~ /^61$/i)&&($chkE =~ /^6C$/i)&&($chkF =~ /^42$/i)&&($chkG =~ /^79$
+/i)&&($chkH =~ /^74$/i)&&($chkI =~ /^65$/i)&&($chkJ =~ /^73$/i)&&($ch
+kL =~ /^31$/i)&&($chkM =~ /^32$/i)&&($chkN =~ /^33$/i)){
$totalBytesPoint = $z+1;
}
$z++;
}

$c=0;
foreach $of(@streamz){
$c++;
if ($c < $headPoint){
$ofa = unpack("H*",$of);
$ofH = hex($ofa);
$ofb = sprintf("%lX",$ofH);
if ($ofb =~ /^.$/){$ofb = '0'.$ofb;}
push (@swf_header,$ofb);
}
if ($c >= ($headPoint+$siz)){
$ofa = unpack("H*",$of);
$ofH = hex($ofa);
$ofb = sprintf("%lX",$ofH);
$ofb =~ s/^(.)$/0$1/;
push (@swf_footer,$ofb);
}
}
}################################ end readTemplate
sub vector2swf{
local $vector2swf = $_[0];
if($debug){print "Content-type:text/html\n\n";}
if ($vector2swf =~ /[a-zA-Z]/){
$isPhrase = "y";
$isVector = "";
}else{
$isVector = "y";
$isPhrase = "";
}
print "Content-type: application/x-shockwave-flash\n\n";
binmode STDOUT;
&readTemplate;
@swf_body=();
if ($isVector){
@vector2swf = split(/\,/,$vector2swf);
for($z=0;$z<=$loopCount;$z++){
foreach $key(@vector2swf){
$pi = ( 22 / 7 ) * 2;
for($x=0;$x<=2485;$x++){
$mySin = sin $pi * $x/$key;
$val = int(($mySin*1242/12));
if ($val < $lowest){$lowest = $val;}
if ($val > $highest){$highest = $val;}
$val = $val+(1242/12);
$usex = sprintf("%X",$val);
$usex =~ s/^(.)$/0$1/;
push (@wav_body,$usex);
}
}
}
}
if ($isPhrase){
$phrase =~ tr/[A-Z]/[a-z]/;
$phrase =~ s/(\w)([\.\,])/$1 $2/g;
$phrase =~ s/([\.\,])(\w)/$2 $1/g;
$phrase_cnt = 1;
@say_phrase = split(/\s+/,$vector2swf);
foreach $say_word(@say_phrase){
#print "phrase=$say_word<hr>";
@temp = ();
$defLetter = $say_word;
$defLetter =~ s/^(.).*/$1/;
open (FILE,"wavs/$defLetter/$say_word.wav");
binmode FILE;
while ($line = <FILE>){chomp $line;
@li = split(//,$line);
foreach $li(@li){
$ofb = unpack("C",$li);
$ofb = sprintf("%lx",$ofb);
if ($ofb =~ /^.$/){$ofb = '0'.$ofb;}
push (@temp,$ofb);
}
}close FILE;
@tempb = ();
$begin = "";$silence = "";
$row_cnt = 0;
#print "$#temp<hr>";
foreach $bi(@temp){
$cd = $row_cnt-8;
#print "$row_cnt $stream[$row_cnt]<hr>";
if (($temp[$cd] =~ /^64$/)&&($temp[$cd+1] =~ /^61$/)&&($temp[$cd+2] =~
+ /^74$/)&&($temp[$cd+3] =~ /^61$/)){
$silence = "".$stream[$cd+8];
@tis = split(//,$silence);
$silence = $tis[0].$tis[1].$tis[2];
$silence_dec = hex($silence);
$begin = "y";
}
if ($begin){push (@tempb,$bi);
#print "$bi<br>\n";
}
$row_cnt++;
}
foreach $bi(@tempb){
push (@wav_body,$bi);
}
$phrase_cnt++;
}#### end buildPhrase
}
##########################################

@wav_body = &filterWavBody(@wav_body);
if ($debug){foreach $li(@wav_body){print "$li<br>\n";}}
###make pulseValues File
$pc=0;
open (PULSE,">cuef.txt");
print PULSE "pulseValues=";
foreach $bi(@wav_body){
if ($pc > 111){$pc=0;
$biX = hex($bi);
print PULSE "$biX,";
}
$pc++;
}
print PULSE "100&\n&vars_loaded=yes&";
close PULSE;
####################
foreach $bi(@wav_body){push (@swf_body,$bi);}
open (SAVE,">me.swf");
binmode SAVE;
@swf = ();
$fileLength=0;
$rawLength=0;
foreach $of(@swf_header){$fileLength++;push (@swf,$of);}
foreach $of(@swf_body){$fileLength++;$rawLength++;push (@swf,$of);}
foreach $of(@swf_footer){$fileLength++;push (@swf,$of);}
$kk = sprintf("00000%lX",$fileLength);
$kk =~ s/.*(......)$/$1/;
@kk = split(//,$kk);
$swf[4] = $kk[4].$kk[5];
$swf[5] = $kk[2].$kk[3];
$swf[6] = $kk[0].$kk[1];
$kk = sprintf("00000%lX",($rawLength+7));
$kk =~ s/.*(......)$/$1/;
@kk = split(//,$kk);
#$swf[171] = $kk[4].$kk[5];
#$swf[172] = $kk[2].$kk[3];
#$swf[173] = $kk[0].$kk[1];
$swf[($headPoint - 12)] = $kk[4].$kk[5];
$swf[($headPoint - 11)] = $kk[2].$kk[3];
$swf[($headPoint - 10)] = $kk[0].$kk[1];
$kk = sprintf("%X",$fileLengthC);
$kk = sprintf("00000%lX",$rawLength);
$kk =~ s/.*(......)$/$1/;
@kk = split(//,$kk);
#$swf[178] = $kk[4].$kk[5];
#$swf[179] = $kk[2].$kk[3];
#$swf[180] = $kk[0].$kk[1];
$swf[($headPoint - 5)] = $kk[4].$kk[5];
$swf[($headPoint - 4)] = $kk[2].$kk[3];
$swf[($headPoint - 3)] = $kk[0].$kk[1];


#1234567890
if ($totalBytesPoint){
$me = '00000000000000000000'.$rawLength;
$me =~ s/.*(\d\d\d\d\d\d\d\d\d\d)$/$1/;
@val = split(//,$me);
$ws=0;
foreach $num(@val){
$kk = sprintf("%lX",$num);
$kk =~ s/^(.)$/0$1/;
$bita = hex($num);
$bitp = pack("C*",$num);
$bitup = unpack("C*",$num);
$bitupz = sprintf("%lX",$bitup);

$kk =~ s/^(.)$/0$1/;
$swf[($totalBytesPoint+$ws)] = $bitupz;
$ws++;
#print "$ws...$num==$kk==$bita==$bitp==$bitup==$bitupz<br>\n";
}

}

foreach $bit(@swf){
$bita = hex($bit);
$bita = pack("C*",$bita);
print SAVE $bita;
print $bita;
}
close SAVE;
}#################################### end vector2swf

sub filterWavBody{
local @wav = @_;
if ($filter =~ /reverse/i){@wav = reverse @wav;}
if ($filter =~ /double/i){
@temp = ();
for($z = 0;$z <= $#wav;$z++){
if ($go){push (@temp,$wav[$z]);$go = "";}else{$go = "y";}
}
@wav = reverse @temp;
foreach $li(@temp){
push (@wav,$li);
}
@wav = reverse @wav;
}########################## end double
if ($filter =~ /triple/i){
@temp = ();
$go = 0;
for($z = 0;$z <= $#wav;$z++){
if ($go > 1){push (@temp,$wav[$z]);$go = 0;}
$go++;
}
@wav = reverse @temp;
foreach $li(@temp){
push (@wav,$li);
}
@wav = reverse @wav;
@temp = reverse @temp;
foreach $li(@temp){
push (@wav,$li);
}
}########################## end triple
if ($filter =~ /fall/i){
@temp1 = ();
@temp2 = ();
@temp3 = ();
@temp4 = ();
@temp5 = ();
@temp = ();
@add = ();
$go = 1;
for($z = 0;$z <= $#wav;$z++){
if ($go > 5){$go = 1;}
$mine = "temp".$go;
push (@$mine,$wav[$z]);
$go++;
}
@temp2 = reverse @temp2;
@temp4 = reverse @temp4;
foreach $li(@temp1){push (@temp,$li);}
foreach $li(@temp2){push (@temp,$li);}
foreach $li(@temp3){push (@temp,$li);}
foreach $li(@temp4){push (@temp,$li);}
foreach $li(@temp5){push (@temp,$li);}

$dc=0;
foreach $li(@temp){
$lix = hex($li);
$wavx = hex($wav[$dc]);
$add = ($lix*.2)+($wavx * .7);
$add = int($add);
$addx = sprintf("%X",$add);
$addx =~ s/^(.)$/0$1/;
#print "$li($lix) + $wav[$dc]($wavx) = $add($addx)<br>\n";
push (@add,$add);
$dc++;
}
@wav = @add;
}########################## end fall
if ($filter =~ /addWave/){
@addWave = ();
$pi = ( 22 / 7 ) * 2;
for($x=0;$x<=2485;$x++){
$mySin = sin $pi * $x/($key/3);
$val = int(($mySin*1242/12));
#$val = $val;
if ($val < $lowest){$lowest = $val;}
if ($val > $highest){$highest = $val;}
$val = $val+(1242/12);
#print "$mySin = $val<br>\n";
$usex = sprintf("%X",$val);
$usex =~ s/^(.)$/0$1/;
push (@addWave,$usex);
}
$z=0;
@keep = ();
foreach $li(@wav){
if ($z > $#addWave){$z=0;}
$wav = $addWave[$z];
####$wavH = unpack("H*",$wav);
$wavX = hex($wav);
$wavZ = sprintf("%lX",$wavX);
$add = $li;
$addX = hex($add);
$fini = int((($wavX * .7) + ($addX*1)/2));
$finiX = sprintf("%lX",$fini);
$finiX =~ s/^(.)$/0$1/;
#print "$z...$wav($wavX) + $add($addX) == $fini($finiX)<br>\n";
push (@keep,$finiX);
##push (@swf_header,$ofb);

$lix = 0;
$z++;
}
@wav = @keep;
    
}
return @wav;
}#################################### end filterWavBody
sub generateCurve{
local $height = $_[0];
local $ttlFrames = $_[1];
local $key = 20;
local $curve = "";
for($r=0;$r<$ttlFrames;$r=$r+4){
$pr = $r;
$curve = $curve.$r.",";
}
for($r=$ttlFrames;$r>0;$r=$r-4){
$pr = $r;
$curve = $curve.$r.",";
}
for($r=$ttlFrames;$r>0;$r=$r-4){
$pr = -$r;
$curve = $curve.$pr.",";
}
for($r=0;$r<$ttlFrames;$r=$r+4){
$pr = -$r;
$curve = $curve.$pr.",";
}
$newCurve = "";
@cur = split(/\,/,$curve);
foreach $cur(@cur){
$cur  =$cur+30;
$newCurve = $newCurve.$cur.",";
}
return $newCurve;
}#################################### end generateCurve
sub add_sine {
my $hz = shift;
my $length = shift;
my $pi = ( 22 / 7 ) * 2;
$length *= $sample_rate;
my $max_no =  ( 2 ** $bits_sample ) / 2;
for my $pos ( 0 .. $length ) {
$time = $pos / $sample_rate;
$time *= $hz;
my $val = sin $pi * $time;
my $samp = $val * $max_no;
#$samp = int($samp);
#$samp =~ s/\-//;
$samp = hex($samp);
$ee = pack("H*",$samp);
##print SAVE "$samp=$ee\n";
print $ee;
}
}########################################### end add_sine
sub convert{
local $dec_number = $_[0];
$dec_number = int($dec_number);
local $value = sprintf("%x",$dec_number);
$pvalue = pack("H*",$value);
return $pvalue;
}####################### end drawWAV
sub readGet{
$qstring="$ENV{'QUERY_STRING'}";
@get = split(/\&/,$qstring);
foreach $qof(@get){
($qname,$qvalue)=split(/=/,$qof);
$qvalue =~ tr/+/ /;
$qvalue =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$$qname = $qvalue;
}
if ($q){
$qhex = $ENV{'QUERY_STRING'};
$qhex =~ s/.*q=//;
$qhex =~ s/&.*//;
}

}#################################### end readGet
sub readPost{
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);
foreach $pair (@pairs){
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/<!--(.|\n)*-->//g;
push (@inputs,"$name"."|"."$value");
$FORM{$name} = $value;
}
}#############################end readPost
sub numAscii{
$num=$numAscii;##1B60
$kk = sprintf("%x",$num);
@kk=split(//,$kk);
$numAscii = $kk[2].$kk[3].$kk[0].$kk[1];
}##################### end numAscii

sub readContent{@content=();
$contentCNT = 0;
if (!-d $content){
open (FILE,"$content");
while ($line = <FILE>){chomp $line;
$contentCNT++;
push (@content,"$line");
}close FILE;
}else{
opendir Tdir, "$content";
$dir = readdir(Tdir);
while($dir = readdir(Tdir)){chomp $dir;
if ($dir eq ".."){}else{push (@content,"$dir");}
}close Tdir;
}
}##################################### end readContent
Replies are listed 'Best First'.
Re: Perl Mixer Sequencer Sound Generator
by broquaint (Abbot) on Oct 14, 2002 at 10:02 UTC