Listing of ascii2morsemidi.cgi

#!/usr/local/bin/perl5
#
# CGI ascii-to-MIDI-file-with-morse 
# © Jens Johansson <jens@panix.com> Thu Mar 09 23:16:44 2000
#
# no external modules or oop! self-documenting code! :)
#

$version = "made by ascii2morsemidi.cgi v0.95, jens johansson. visit http://www.panix.com/~jens/";

%morse = (
   "a", "01", "b", "1000", "c", "1010", "d", "100", "e", "0", "f", "0010", "g", 
   "110", "h", "0000", "i", "00", "j", "0111", "k", "101", "l", "0100", "m", "11", 
   "n", "10", "o", "111", "p", "0110", "q", "1101", "r", "010", "s", "000", "t", "1",
   "u", "001", "v", "0001", "w", "011", "x", "1001", "y", "1011", "z", "1100", 
   "0", "11111", "1", "01111", "2", "00111", "3", "00011", "4", "00001", 
   "5", "00000", "6", "10000", "7", "11000", "8", "11100", "9"
);

read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
foreach (split(/&/, $buffer)) {
   ($name, $value) = split(/=/); $value =~ tr/+/ /;
   $value =~ s/%([a-f0-9]{2})/pack("C", hex($1))/egi; $F{$name} = $value;
}

$input = $F{'input'}; $mediatype = $F{'mediatype'}; $tempo = $F{'tempo'};
$prog = $F{'prog'}; $note = $F{'note'};
defined($input) || ($input = "hello world?");  
defined($mediatype) || ($mediatype = "audio/x-midi");
defined($tempo) || ($tempo = 140);
defined($prog) || ($prog = 74); # GM "Recorder" patch
defined ($note) || ($note = 82);

binmode (STDOUT); print "Content-type: $mediatype\n\n";
# + something like "\nContent-transfer-encoding: 8-bit; filename=morse.mid" ??

# encode the ASCII to intermediate code
foreach ($input) {
   tr/A-ZÅÄÖÁÉÑÜ/a-zåäöáéñü/; 
   s/([a-z0-9])/$morse{$1}."Q"/eg;
   s/ /P/g; s/å/01101Q/; s/ä/0101Q/g; s/ö/1110Q/g; # bleörgh. why did this break all of a sudden?
   s/á/10010Q/g; s/é/11011Q/g; s/ñ/00100Q/g; s/ü/0011Q/g;
   s/\|/000101Q/g; s/\\/00000000Q/g; s/\@/011010Q/g; s/\&/1111Q/g; s/"/010010Q/g;
   s/[)(]/101101Q/g; s/\?/001100Q/g; s/\//10010Q/g; s/\+/01010Q/g; s/\?/001100Q/g;
   s/\./010101Q/g; s/\,/110011Q/g; s/\:/111000Q/g; s/\-/100001Q/g; s/\'/011110Q/g;
   s/\$/0001001Q/g; s/_/001101Q/g; s/;/101010Q/g; s/=/10001Q/g; s/\]/10001Q/g;
}

# I think i kno why, I think I have to use locale; :)

# set tempo, notes, lengths &c. $unit=12.. triplet feel irt quarter notes..
# may tweak the code "groove" here! (but keep lengths lower than 0x7F)
$t = 1000000 * 60 / $tempo; $vel = 63; 
$unit = 12; $dot = $unit; $dash = 3*$unit; $postdot = $postdash = $unit;
$interletter = 3*$unit; $interword = 7*$unit;

# start making raw track: text, tempo meta events
$track = pack('C4', 0, 0xFF, 1, length($version)) . $version .
   pack('C7', 0, 0xFF, 0x51, 3, ($t>>16)&0xFF, ($t>>8)&0xFF, $t&0xFF);

# add delta times and on/off events to $track, and EOT.
# (delta times are smaller than 0x7F so we don't even screw with SMF varlength encoding... 
# cf perl dox under pack('w'))

$time = 0;  $track .= pack('C3', $time, 0xC0, $prog);
foreach (split(//, $input)) {
   /0/ && ($track .= pack('C8', $time, 0x90, $note, $vel, $dot, 0x80, $note, 0),
           $time = $postdot);
   /1/ && ($track .= pack('C8', $time, 0x90, $note, $vel, $dash, 0x80, $note, 0),
           $time = $postdash);
   /Q/ && ($time = $interletter);
   /P/ && ($time = $interword); 
}

$track .= pack('C4', $interword, 0xFF, 0x2f, 0); 
   
# write header, len 6, format 0, 1 track, 96 ppqn, track header, raw track
print "MThd", pack('Nn3', 6, 0, 1, 96), "MTrk", pack('N', length($track)), $track;