#!/usr/bin/perl # midi3.cgi: A PERL script to generate a "multi-part" MIDI files from # ----------- a text description on an HTML Form # Latest update: v3 (dec 2004) # Written 2001 by Jean Vaucher, http://www.iro.umontreal.ca/~vaucher/ # WWW Directory of files: http://www-perso.iro.umontreal.ca/~vaucher/SCRIPTS/ # Source : midi.pl (alias that points to midi3.cgi) # Interface : rhythm2.html that calls "midi3.cgi" # DOCUMENTATION: midi2.txt # Dec 2004: implemented Flams f & F notes # May 2002: added "Lead" parameter to make one part stand out # May 2003: added Content-Length HTTP param to allow Netscape 7.0 to work # OLDER Versions: # midi2.pl : alias for midi2.cgi # Derived from previous single part generator: "midi.cgi" & "rhythm.html" # July 2001, itself adapted from a script by Jeff Senn & interface by N. Gray # URL: http://www-perso.iro.umontreal.ca/~vaucher/SCRIPTS/rhythm.html # #command line usage example: # # % perl midi3.cgi part1=Bo.oB-C-B-o-B-C debug=1 # % midi3.cgi part1=Bo.oB-C-B-o-B-C > X.mid # or test with @ARGV = ('part1=Bo.oB-C-B-o-B-C','repeat=2'); # ======================================================================== 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,$mask) = @_; $mask = 0 unless $mask; local($b) = $v & 0x7f | $mask ; $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 writeTrkheader { local($ntks) = $_[0]; return "MThd" . &writelong(6) . #header length &writeshort(0) . #single-multi-channel &writeshort( $ntks) . #one track &writeshort( $clks * $npb ); # PPQN: pulses (clicks) per Quarter Note } sub writebpm { local($bpm) = $_[0]; use integer; # local($tt) = ( $npb == 3 ? 40000000 : 60000000) /$bpm; local($tt) = 60000000 /$bpm; return chr(0).chr(0xff).chr(0x51).chr(3) .chr($tt>>16 ) .chr($tt>>8 & 0xFF) .chr($tt & 0xFF); } sub writetempo { return chr(0).chr(0xff).chr(0x58).chr(4) .( $npb == 3 ? chr(6).chr(3) : chr(4).chr(2) ) .chr(24).chr(8); } # =================== Sound design functions grouped here ========================== sub initVoices { local($s)=""; $s = chr(0).chr(0xc0).chr(117) # Channel 1 = melodic Tom Left .chr(0).chr(0xb0).chr(0x0A).chr(30) if $chan[0]; $s .= chr(0).chr(0xc1).chr(116) # chan 2 = Taiko .chr(0).chr(0xb1).chr(0x0A).chr(90) if $chan[1]; $s .= chr(0).chr(0xc2).chr(32) # chan 3 = Electric Bass .chr(0).chr(0xb2).chr(0x0A).chr(75) if $chan[2]; $s .= chr(0).chr(0xc3).chr(37) # chan 4 = Slap Bass .chr(0).chr(0xb3).chr(0x0A).chr(40) if $chan[3]; $s .= chr(0).chr(0xc4).chr(115) # chan 5 = Woodblock .chr(0).chr(0xb4).chr(0x0A).chr(100) if $chan[4]; $s .= chr(0).chr(0xc5).chr(114) # chan 6 = Steel drums .chr(0).chr(0xb5).chr(0x0A).chr(0) if $chan[5]; return $s; # .chr(0).chr(0xba).chr( 0).chr(0x7f) # for XG, set channel 11 # .chr(0).chr(0xba).chr(32).chr(0x00) # to Drums # .chr(0).chr(0xca).chr(0) ; # to Standard Drum Set } sub doNote { local($dt, $code, $note, $vol) = @_ ; if ( $note>99 ) { $ch = int($note/100)-1; $nn1= $note%100; $chan[$ch] = 1; return &doEvent( $dt, 0x90+$ch, $nn1, $vol); } elsif ( $note>25 ) { return &doEvent( $dt, 0x99, $note, $vol); } elsif ( $note == 1 ) { return &doEvent( $dt, 0x99, 36, $vol) . &doEvent( 0, 0x99, 43, int(2*$vol/3)) . &doEvent( 0, 0x99, 54, int(0.4*$vol)) ; } elsif ( $note == 2 ) # DunDun B/C with CowBell { return &doEvent( $dt, 0x99, 41, int(0.8*$vol)) . &doEvent( 0, 0x99, 35, int(0.5*$vol)) . &doEvent( 0, 0x99, 56, int(0.6*$vol)) ; } elsif ( $note == 3 ) # DunDun O with Bell { return &doEvent( $dt, 0x99, 43, $vol) . &doEvent( 0, 0x99, 56, int(0.7*$vol)) ; } elsif ( $note == 4 ) # Sangban B/C with Bell { return &doEvent( $dt, 0x99, 36, $vol) . &doEvent( 0, 0x99, 68, int($vol/2)) ; } elsif ( $note == 5 ) # Sangban O with Bell { return &doEvent( $dt, 0x99, 45, $vol) . &doEvent( 0, 0x99, 68, int($vol/2)) ; } elsif ( $note == 6 ) # Kenkeni B/C with Bell { return &doEvent( $dt, 0x99, 64, int(0.8*$vol)) . &doEvent( 0, 0x99, 67, int($vol/2)) ; } elsif ( $note == 7 ) # Kenkeni O with Bell { return &doEvent( $dt, 0x99, 47, $vol) . &doEvent( 0, 0x99, 66, int(0.3*$vol)) . &doEvent( 0, 0x99, 67, int($vol/2)) ; } elsif ( $note == 8 ) # Djembe1 C with Bell { return &doEvent( $dt, 0x99, 50, $vol) . &doEvent( 0, 0x99, 65, int(0.2*$vol)) . &doEvent( 0, 0x99, 54, int(0.4*$vol)) ; } else { return ""; } } $voice{"DunDun"} = "B:3,C:2,O:3,X:56:70" ; $voice{"Sangban"} = "B:5,C:4,O:5,X:68:50" ; $voice{"Kenkeni"} = "B:7,C:6,O:7,X:67:50" ; $voice{"Djembe1"} = "B:64,O:63,C:61,S:37"; $voice{"Djembe2"} = "B:1,O:64,C:8,S:60"; $voice{"Djembe3"} = "B:36,O:48,C:65:80,S:61"; $voice{"Bell"} = "L:56,X:68:85,M:67,H:80,S:53,B:56,O:68:85,C:53" ; $voice{"Conga"} = "H:62,T:62:40,B:36:110,O:63,S:60,C:60"; $voice{"Shaker"} = "X:82,L:69,M:70,H:54,S:39,C:42" ; # $voice{"Wood"} = "X:555,B:555,L:77,M:76,C:37,S:31" ; $voice{"Wood"} = "B:37,O:77,M:77,C:75,L:555,H:76,X:31" ; # $voice{"Metal"} = "X:75,L:86,M:66,H:65,C:87,S:50" ; $voice{"Tumba"} = "H:36,T:36:40,B:41,O:64,S:37,C:37"; $voice{"Quinto"} = "H:35,T:35:40,B:63,O:61,S:60,C:60"; # $voice{"Bass"} = "X:333:50,B:328:50,O:333:50,C:336:50" ; # ================================================================================ # GLOBAL VARIABLES $flam = ""; $clks = 6; # clicks per note; with $npb (notes/beat) gives PPQN $npb = 4; $dt = 0; $pad = $clks-2; # interval between 2 notes $song1 = ""; $gap = 0; # time gap to next end piece.... must be put in front of next # segment $leadn = -1; # part to emphasize sub writerhythm { local($rep, $bpm) = @_ ; local($i, $dt); local($c,$tt); local($t) =''; $t = $song1 ; $tt = &genMidi() ; for($i = 0; $i < $rep ; $i++) { $t .= $tt ; } $t .= &writevar($gap); $t = &writetempo(). &writebpm($bpm). &initVoices(). $t ; return &writeTrkheader( 1 ) . &writetrk($t); } sub genMidi # INPUT from globals: @notes, $n_notes & $gap { local( $dt, $chord, $note, $vol, $t, $s, @ns); # if($debug) { print " GenMIDI: $flam\n" ; } $dt=$gap; foreach $chord (@notes) { if( substr( $flam,0,1) eq "f" && $dt > 3) { $t .= &doNote( $dt-2, 0x99, 61, 100) . &doNote( 1, 0x99, 61, 0); $dt = 1; } $flam = substr( $flam,1); @ns = split(',',$chord); foreach $s (@ns) { if($debug) { print " ** $s\n" ; } ($note, $vol) = split(':',$s); $t .= &doNote( $dt, 0x99, $note,$vol); $dt = 0; } $dt += 2; foreach $s (@ns) { ($note, $vol) = split(':',$s); $t .= &doNote( $dt, 0x99, $note, 0); $dt = 0; } $dt += $clks-2; } $gap = $dt; if ( $gap > $pad) { $t .= &doEvent( $gap-$pad, 0x99, 16, 1 ) . &doEvent( 0, 0x99, 16, 0); ; $gap = $pad; } return $t; } sub genIntro { local( $t, $i); for($i = 0; $i < $npb-1 ; $i++) { $t .= &doEvent( $gap, 0x99, 56, 60 ) . &doEvent( 2, 0x99, 56, 0 ); $gap = $npb*$clks - 2; } $t .= &doEvent( $gap, 0x99, 37, 40 ) . &doEvent( 2, 0x99, 37, 0 ); local($signal) = $keywords{'signal'}; $signal =~ s/[\s|]//g ; $n_notes = length($signal); $flam = '-' x $n_notes; doPart( $signal, "Djembe1", 1.2); $t .= &genMidi(); @notes = () ; $n_notes = 0 ; $flam = "" ; return $t; } # ------------------------------------------------------------- # Generator algorithm version 2 # ------------------------------------------------------------- @parts=(); $n_notes = 0; sub addPart { local($drumname, $partname) = @_; local($part, $drum); $part = $keywords{$partname}; return unless $part; $part =~ s/[\s|]//g ; $drum = $keywords{$drumname}; push(@parts, $part); push(@voices, ($drum ? $drum: "Conga")); if ($drumname eq $lead) { $leadn = $#parts; } } sub evenParts { local($i, $t, $k, $n); $n_notes = 0; foreach $t (@parts) { $n = length($t); if ($n_notes < $n) { $n_notes=$n;} } for ($i=0; $i< @parts ; $i++) { $t = $parts[$i]; $k = $n = length( $t ); while ( $k < $n_notes ) { $parts[$i] .= $t; $k += $n; } } $flam = "-" x $n_notes; } sub printParts { local($t); foreach $t (@parts) { print "==> $t \n"; } print "\n"; } sub doParts { local( $i); local($minv) = ($lead ? 0.7 : 1.0); for ($i= 0; $i< @parts; $i++) { $dv = ($i == $leadn ? 1.1 : $minv); &doPart( $parts[$i], $voices[$i], $dv); } } sub doPart { local($t, $inst, $dv) = @_; local($j, $c, $ns ) ; &initSounds( $voice{ $inst } ); for ($j=0; $j< $n_notes; $j++) { $ns = $notes[$j]; $c = substr($t,$j,1); if ($c ne '-') { $ns .= "," if $ns; if ($c eq "F" || $c eq "f") { substr($flam,$j,1) = "f"; $c =~ tr/fF/OC/; } $ns .= addNote( $c, $dv ); } $notes[$j] = $ns; } } sub addNote { local($x, $dv) = @_ ; # note letter local($xx); local($k) = $keys{$x}; if(!$k) { local($xx) = $x; $xx =~ tr/a-z/A-Z/; $k = $keys{$xx}; if(!$k) { $k = 75; } #Clave } local($v) = $volm{$x} ; if( !defined($v) ){ $v = ( $x =~ /[A-Z]/ ? $hivol : $lowvol ) ; } $v = $dv * $v; $v = ( $v > 127 ? 127 : $v); return $k . ":" . $v ; } sub printNotes { local($i, $n); $i=0; foreach $n (@notes) { print "$i: $n \n"; $i++; } } sub mergeNotes # Works on the "notes" array { local($i, $n, $delta, $t); local($name, $v1, $v2); local(@ns); local(%vals); $i=0; foreach $delta (@notes) { unless ($delta) { push(@ns,""); next; } %vals=(); @hits = split(',', $delta); foreach $t (@hits) { ($name, $v1) = split(':',$t); $v2 = $vals{ $name }; if ($v2) { $vals{"$name"} = $v2 + int( $v1 - $v1*$v2/128 ); # $vals{"$name"} = $v2 + int( ($v1 - $v1*$v2/128)/2 ); } else { $vals{"$name"} = $v1; } } $t = ""; $i=0; while (($name,$v1) = each(%vals)) { if ($t) { $t .= ",$name:$v1"; } else { $t = "$name:$v1"; } } push(@ns, $t); $i++; } @notes = @ns; } $oldcode = 0 ; sub doEvent { local($dt, $code, $note, $vol) = @_ ; if($debug) { if ($vol==0) { print "---- dt: $dt off: $note \n"; } else {print "---- dt: $dt ON : $note \@ $vol \n"; } } if ($code != $oldcode) { $oldcode=$code; return &writevar($dt) . chr($code) .chr($note) . chr($vol); } else { return &writevar($dt) . chr($note).chr($vol); } } sub hexDump { local($s)=@_; local($offset, $len, $data, @array); $offset = 0; $len = length($s); while ($len-$offset >= 16) { $data = substr($s,$offset,16); @array = unpack('N4', $data); $data =~tr/\0-\37\177-\377/./; printf "%8.08x %8.08x %8.08x %8.08x %8.08x %s\n",$offset, @array, $data; $offset += 16; } # Now finish up the end a byte at a time. $data = substr($s,$offset); $len = length($data); if ($len) { @array = unpack('C*', $data); $data =~y/\0-\37\177-\377/./; for (@array) { $_ = sprintf('%2.2x', $_); } push(@array, ' ') while $len++ < 16; $data =~ s/[^ -~]/./g; printf "%8.08x ",$offset; printf "%s%s%s%s %s%s%s%s %s%s%s%s %s%s%s%s %s\n",@array, $data; } } # ------------------------------------------------------------- %keys = () ; %volm = () ; # NOTE: Volume parameters must be in [1..127] $hivol = 100 ; # BEWARE, 128 is same as 0 !!! $lowvol = 80 ; $keys{"B"} = 64; # lo conga - djembe Ti $keys{"C"} = 61; # Lo Bongo - djembe Ta $keys{"O"} = 63; # Open tone $keys{"."} = 35; # kick2 - ghost note $volm{"."} = 45; sub initSounds { local($sounds)=@_; local($i,$name,$value,$vol); $sounds =~ s/\s//g; local(@tones) = split(',',$sounds); for($i = 0; $i<=$#tones; $i++) { ($name, $value, $vol) = split(':',$tones[$i]); $vol = $hivol unless defined $vol; $keys{$name} = $value; $volm{$name} = $vol; if ($name =~ /[A-Z]/) { $name =~ tr/[A-Z]/[a-z]/ ; $keys{$name} = $value; $volm{ $name } = ($vol>40 ? $vol-20 : int($vol/2)); } } } # ------------------------------------------------------------ # Start of Main program if(defined $ENV{'REQUEST_METHOD'}) { $req = $ENV{'REQUEST_METHOD'}; $req =~ tr/a-z/A-Z/; if ($req eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $buffer = $ENV{'QUERY_STRING'}; } @ARGV = split('&',$buffer); } else { $noheader = 1 ; } for($i = 0; $i<=$#ARGV; $i++) { ($name, $value) = split('=',$ARGV[$i]); $value =~ tr/+/ /; $value =~ s/%(..)/pack("C", hex($1))/eg; $keywords{$name} = $value; } # Implement a use counter # if (open (COUNT, '+; # $counter++; # seek (COUNT, 0, 0) or print $!; # print COUNT $counter . "\n"; # close (COUNT); # } # Trace info #if (open (COUNT, '>>ATrace')) #{ # $host = $ENV{'HTTP_REFERER'}; # $t = time(); # print COUNT "midi4: $t, $host \n"; # close (COUNT); #} # -------------------------------------- # Parameters: $repeats = $keywords{'repeat'}; # 1-50 (default=1) $bpm = $keywords{'bpm'}; # 40-240 (default=120) $mime = $keywords{'mime'}; # (default="audio/mid") $npb = $keywords{'npb'}; # notes / beat (usu. 3 or 4) $debug = $keywords{'debug'}; $lead = $keywords{'Lead'}; if(!defined($repeats)) { $repeats = 2; } if(!defined($bpm)) { $bpm = 90; } if(!defined($mime)) { $mime = "audio/mid"; } if(!defined($npb) || $npb !~ /^\d+$/) { $npb = 4; } if($repeats<1) { $repeats = 1; } if($repeats>50) { $repeats = 50; } if($bpm<40) { $bpm = 40; } if($bpm>300) { $bpm = 300; } if($npb>8) { $npb = 8; } if($npb<2) { $npb = 2; } if($debug) { print "Content-type: text/plain\n\n"; print "PARAMS:\n"; while (($key,$value) = each %keywords) { print "$key=$value\n"; } print "\nVALUES:\n"; print " repeats = $repeats\n"; print " bpm = $bpm\n"; print " mime = $mime\n"; print " noheader= $noheader\n"; print " lead = $lead\n\n"; } $voice{"Custom"} = $keywords{'sounds'}; $song1 = &genIntro(); &addPart('drum1','part1') unless $keywords{'mute1'}; &addPart('drum2','part2') unless $keywords{'mute2'}; &addPart('drum3','part3') unless $keywords{'mute3'}; &addPart('drum4','part4') unless $keywords{'mute4'}; &addPart('drum5','part5') unless $keywords{'mute5'}; &addPart('drum6','part6') unless $keywords{'mute6'}; unless (@parts) { @parts=( "b", ".cb" ); @voices=( "Conga", "DunDun"); } if($debug) { &printParts(); &evenParts(); &printParts(); &doParts(); &mergeNotes(); &printNotes(); $song = &writerhythm($repeats,$bpm); &hexDump( $song ); exit(0); } &evenParts(); &doParts(); &mergeNotes(); $song = &writerhythm($repeats,$bpm); $slen = length($song) ; unless ($noheader) { print "Content-Length: $slen\n"; } unless ($noheader) { print "Content-type: $mime\n\n"; } print $song; 0;