#!/usr/local/bin/perl

#command line usage example:
#
# perl rhymidi.cgi rhythm=D---T---k-k-T---D---k-k-T---t-k- repeat=4 tempo=4 noheader=1 > foo1.mid

sub fix_quoted {
  local($v) = @_[0];
  while($v =~ s/\+/ /) {}
  while($v =~ s/%([0-9A-F][0-9A-F])/sprintf("%c",hex($1)&0x7F)/e) {}
  return $v;
}
sub writelong { local($v) = $_[0];
    return chr(($v / 0x01000000) & 0xff). chr(($v / 0x010000) & 0xff).
	   chr(($v / 0x0100) & 0xff). chr($v & 0xff);  }
sub writeshort {
    local($v) = $_[0];
    return chr(($v / 0x0100) & 0xff). chr($v & 0xff); }
sub writevar {
    local($v) = $_[0]; local($b) = $v & 0x7f | $_[1];
    $v >>=7; if($v > 0) { return &writevar($v,0x80).chr($b & 0xff); }
    return chr($b & 0xff);
}
sub writetrk {
    local($t) = $_[0]; return "MTrk" .
	&writelong(length($t)+3) . $t . chr(0xff) . chr(0x2f) . chr(0x00);
}
sub writesingletrkheader {
    local($t1) = $_[0]; local($t2) = $_[1];
    return "MThd" .
      &writelong(6)  .  #header length
      &writeshort(0) . #single-multi-channel
      &writeshort(1) . #one track
      chr($t1) . chr($t2); #division of quarter / resolution 4=standard-MIDI
}
sub strike {
    local($x) = $_[0];
    local($delay) = $_[1];
    local($k) = $keys{$x};
    if(!$k) { $k = 81; }
    return chr($k).chr(($x ge 'A' && $x le 'Z') ? 0x7f : 0x2f).&writevar(0x0).chr($k).chr(0x0).&writevar($delay);
}
%keys = ();
$keys{"D"} = 64;
$keys{"d"} = 64;
$keys{"T"} = 62;
$keys{"t"} = 62;
$keys{"K"} = 62;
$keys{"k"} = 62;
$keys{"G"} = 45;
$keys{"g"} = 45;
$keys{"S"} = 35;
$keys{"S"} = 35;
$keys{"m"} = 35;
$keys{"p"} = 63;
$keys{"P"} = 63;
#for chuck
$keys{"C"} = 45;
$keys{"c"} = 45;
$keys{"F"} = 64;
$keys{"f"} = 64;

sub writerhythm {
    local($x) = $_[0];
    local($qty) = $_[1];
    local($tempo) = $_[2];
    local($i);
    local($t) = '';
    local($k) = '';
    local($c) = 0;
    local($space) = 0;
    local($initial_space) = 0;
    for($i = 0; $i < length($x); $i++) {
	$c = substr($x,$i,1);
	if($c eq ' ' || $c eq '.' || $c eq '-') { $space++; } 
	elsif($c eq '<') { $space--; } 
        else {
	    if($k eq '') {
                $initial_space = $space; 
		#  $t .= &writevar($space).chr(0x99); 
                $k = $c; $space = 0;
	    } elsif($c eq '|') {
	    } elsif($c eq '3') {
	    } else {
		$t .= &strike($k,$space+1); $space = 0; $k = $c;
	    }
	}
    }
    $tt = &writevar($initial_space).chr(0x99); 
    while($qty > 0) { 
	$tt.=$t; $qty--; 
        if($qty > 0) { $tt .= &strike($k,$space+1+$intial_space);}
    }
    $tt .= &strike($k,$space+1);
    return &writesingletrkheader(0,$tempo) . &writetrk($tt);
}
$pathinfo = $ENV{'PATH_INFO'};
$pathtrans = $ENV{'PATH_TRANSLATED'};
$req = $ENV{'REQUEST_METHOD'};
$debug = 0;
if($debug) {
    print "Content-type: text/plain\n\n";
    while (($key,$value) = each %ENV) {
	print "$key=$value\n";
    }
    exit(0);
}
if($req eq 'POST' && $ctp eq 'application/x-www-form-urlencoded') {
#bytes of input
  $ilen = $ENV{"CONTENT_LENGTH"};
  $ival = "";
  $rlen = read(STDIN,$ival,$ilen);
  if($rlen < $ilen) {
    print "Content-type: text/plain\n\n";
    print 'Form Error: Could not read enough input.' . "\n";
    exit(0);
  } else {
    @keys = split('&',$ival);
    %keywords = ();
    foreach(@keys) {
      @av = split('=',$_);
      $keywords{$av[0]} = &fix_quoted($av[1]);
    }
  }
} else {
  %keywords = ();
  #process ARGS
  for($i = 0; $i<=$#ARGV; $i++) {
    @av = split('=',$ARGV[$i]);
    $keywords{$av[0]} = &fix_quoted($av[1]);
  }
  #process QUERY_STRING
  if(defined $ENV{'QUERY_STRING'}){
  @ARGV = split('&',$ENV{'QUERY_STRING'});
  for($i = 0; $i<=$#ARGV; $i++) {
    @av = split('=',$ARGV[$i]);
    $keywords{$av[0]} = &fix_quoted($av[1]);
}}
}

$download = $keywords{'download'};
$sequence = $keywords{'rhythm'};
$repeats  = $keywords{'repeat'};
$tempo  = $keywords{'tempo'};
$mime  = $keywords{'mime'};

if($download ne '') {

  unless ($keywords{'noheader'}) { print "Content-type: text/html\n\n"; }
  print 'Windows users: Right click on the link below and use "save link as" or "save target as" to save this file. (Do not forget to change the file name to end in ".mid").  Use the BACK button on your browser to return to the rhythm generator.';
      print '<P><A href="http://www.maya.com/local/senn/rhymidi.cgi?';
  print "rhythm=$sequence&repeat=$repeats&tempo=$tempo&mime=$mime&type=.mid";
      print '">';
  print "http://www.maya.com/local/senn/rhymidi.cgi?rhythm=$sequence&repeat=$repeats&tempo=$tempo&mime=$mime&type=.mid";
      print '</A>';

} else {

if(!defined($mime)) { $mime = "audio/mid"; }

unless ($keywords{'noheader'}) { print "Content-type: $mime\n\n"; }

#Content-Base: http://www.maya.com/foo/\nContent-Location: rhythm.mid\n\n";

if($repeats<1) { $repeats = 1; }
if($repeats>50) { $repeats = 50; }
if($tempo<1) { $tempo = 1; }
if($tempo>10) { $tempo = 10; }

print &writerhythm($sequence,$repeats,$tempo);

}
0;