#!/usr/bin/perl -T

#David Faden, dfaden@iastate.edu
#July 22, 2002

#ISU's server refuses to run this script if warnings are turned on
#or if the strict module is used. I believe these may be
#causing problems by increasing the response time of the script.
#I have not directly verified that this is the cause.
  
#use strict;
use CGI;

#Lessen the chances of a successful Denial of Service attack.
$CGI::POST_MAX = 200*1024;
$CGI::DISABLE_UPLOADS = 1;

$| = 1; #Turn off buffering.

my %instruments = ( #Patches 0 to 127
0 => 'Acoustic Grand',
1 => 'Bright Acoustic',
2 => 'Electric Grand',
3 => 'Honky-Tonk',
4 => 'Electric Piano 1',
5 => 'Electric Piano 2',
6 => 'Harpsichord',
7 => 'Clav',
8 => 'Celesta',
9 => 'Glockenspiel',
10 => 'Music Box',
11 => 'Vibraphone',
12 => 'Marimba',
13 => 'Xylophone',
14 => 'Tubular Bells',
15 => 'Dulcimer',
16 => 'Drawbar Organ',
17 => 'Percussive Organ',
18 => 'Rock Organ',
19 => 'Church Organ',
20 => 'Reed Organ',
21 => 'Accordion',
22 => 'Harmonica',
23 => 'Tango Accordion',
24 => 'Acoustic Guitar(nylon)',
25 => 'Acoustic Guitar(steel)',
26 => 'Electric Guitar(jazz)',
27 => 'Electric Guitar(clean)',
28 => 'Electric Guitar(muted)',
29 => 'Overdriven Guitar',
30 => 'Distortion Guitar',
31 => 'Guitar Harmonics',
32 => 'Acoustic Bass',
33 => 'Electric Bass(finger)',
34 => 'Electric Bass(pick)',
35 => 'Fretless Bass',
36 => 'Slap Bass 1',
37 => 'Slap Bass 2',
38 => 'Synth Bass 1',
39 => 'Synth Bass 2',
40 => 'Violin',
41 => 'Viola',
42 => 'Cello',
43 => 'Contrabass',
44 => 'Tremolo Strings',
45 => 'Orchestral Strings',
46 => 'Orchestral Strings',
47 => 'Timpani',
48 => 'String Ensemble 1',
49 => 'String Ensemble 2',
50 => 'SynthStrings 1',
51 => 'SynthStrings 2',
52 => 'Choir Aahs',
53 => 'Voice Oohs',
54 => 'Synth Voice',
55 => 'Orchestra Hit',
56 => 'Trumpet',
57 => 'Trombone',
58 => 'Tuba',
59 => 'Muted Trumpet',
60 => 'French Horn',
61 => 'Brass Section',
62 => 'SynthBrass 1',
63 => 'SynthBrass 2',
64 => 'Soprano Sax',
65 => 'Alto Sax',
66 => 'Tenor Sax',
67 => 'Baritone Sax',
68 => 'Oboe',
69 => 'English Horn',
70 => 'Bassoon',
71 => 'Clarinet',
72 => 'Piccolo',
73 => 'Flute',
74 => 'Recorder',
75 => 'Pan Flute',
76 => 'Blown Bottle',
77 => 'Skakuhachi',
78 => 'Whistle',
79 => 'Ocarina',
80 => 'Lead 1 (square)',
81 => 'Lead 2 (sawtooth)',
82 => 'Lead 3 (calliope)',
83 => 'Lead 4 (chiff)',
84 => 'Lead 5 (charang)',
85 => 'Lead 6 (voice)',
86 => 'Lead 7 (fifths)',
87 => 'Lead 8 (bass+lead)',
88 => 'Pad 1 (new age)',
89 => 'Pad 2 (warm)',
90 => 'Pad 3 (polysynth)',
91 => 'Pad 4 (choir)',
92 => 'Pad 5 (bowed)',
93 => 'Pad 6 (metallic)',
94 => 'Pad 7 (halo)',
95 => 'Pad 8 (sweep)',
96 => 'FX 1 (rain)',
97 => 'FX 2 (soundtrack)',
98 => 'FX 3 (crystal)',
99 => 'FX 4 (atmosphere)',
100 => 'FX 5 (brightness)',
101 => 'FX 6 (goblins)',
102 => 'FX 7 (echoes)',
103 => 'FX 8 (sci-fi)',
104 => 'Sitar',
105 => 'Banjo',
106 => 'Shamisen',
107 => 'Koto',
108 => 'Kalimba',
109 => 'Bagpipe',
110 => 'Fiddle',
111 => 'Shanai',
112 => 'Tinkle Bell',
113 => 'Agogo',
114 => 'Steel Drums',
115 => 'Woodblock',
116 => 'Taiko Drum',
117 => 'Melodic Tom',
118 => 'Synth Drum',
119 => 'Reverse Cymbal',
120 => 'Guitar Fret Noise',
121 => 'Breath Noise',
122 => 'Seashore',
123 => 'Bird Tweet',
124 => 'Telephone Ring',
125 => 'Helicopter',
126 => 'Applause',
127 => 'Gunshot');

#Apparently, \(keys %instruments) isn't an array ref.
my @instrument_keys = keys %instruments;

my $cgi = new CGI;

if (! $cgi->param()) {
	print 	$cgi->header('text/html'),
			$cgi->start_html('Compose a MIDI'),
			$cgi->h1('Compose a MIDI'),
			$cgi->start_form(),
			$cgi->popup_menu(	-name=>'instrument',
								-values=>(\@instrument_keys),
								-default=>'0',
								-labels=>\%instruments),
			$cgi->br,
			$cgi->textarea(	-name=>'song',
							-default=>'',
							-rows=>3,
							-columns=>80),
			$cgi->br,
			$cgi->submit('submit','Generate MIDI'),
			$cgi->end_form;
			
print <<INFO;
<p>
The following musical commands are available:
</p>
<ul>
	<li>Duration: set the length of the following notes and rests. Use 'sn' for a sixteenth note, 'en' for an eighth note, 'qn' for a quarter note, etc. To get a dotted note, add a 'd' to the front of the duration command. For example, 'dwn' yields a dotted whole note. To get a doubly dotted time, append 'dd' to the front, e.g., 'ddwn'. To get a triplet, add a 't' prefix, e.g., a 'tsn' is a triple sixteenth note. 
	<li>Rest: rest --'r'.
	<li>Note: play a note. This command has the following format: a letter, 'A'-'G', followed by an 'f' or 's' if the note is to be flat or sharp. Optionally, you may append a number 0-10 to specify the octave of the note or '_u[N]' or '_d[N]' to specify that the octave should be [N] octaves up or down from the previous note's octave. The octave set by one note carries onto the notes following it. 'C5' is middle C apparently.
	<li>Octave: set the octave of the next note -- 'o[N]', 0 &lt;= [N] &lt;= 10.
	<li>Volume: set the volume of the next note -- 'v[N]', (quiet) 0 &lt;= [N] &lt;= 127 (loud!). The volume may also be set using 'ppp', 'pp', 'p', 'mp', 'm', 'mf', 'f', 'ff', and 'fff'.
</ul>
<p>
Notes normally play one after the other. To play a chord, join the notes that are to play at the same time with '-'.
</p>
<p>
This program relies heavily on <a href="http://www.speech.cs.cmu.edu/~sburke/">Sean Burke</a>'s CPAN MIDI module. In fact, this program is basically just a wrapper for the methods provided by the MIDI module.
</p>
<p>
<em>Fantasia (with errors introduced by the transcriber)</em>
<br>
<em>by Carl Philipp Emanuel Bach</em>
<br>
mf qn-D3-sn-A5 Bf A G qn-D4-sn-A5 F E D A Bf A G qn-D3-sn-A5 F E D qn-Cs3-en-A5 A4 D3 A3-A4 en Cs4 Cs-sn-A Gs A B Cs5 D E D Cs D qn-A2-sn-E5 F G F qn-B2-sn-E4 D Cs B4 qn-Cs3-sn-A4 G F E qn-D3-wn-F4 D E F qn-D2-sn-G4 A B Cs5 D E F G A F E D Cs D E F qn-A2-sn-G5 F E D qn-A3-sn-Cs5 D E D qn-A2-sn-Cs5 B4 A G D3-F4 D4-D5 C4-C5 Bf3-Bf4 A3-A4 G3-G4 F3-F4 E3-E4 en D3-D4 sn A5 G F E D C en Bf4 sn Bf3-D5 A3-C5 G3-Bf4 F3-A4 E3-G4 D3-F4 en C3-E4 sn G5 F E D C Bf4 en A4 sn A3-C5 G3-Bf4 F3-A4 E3-G4 D3-F4 C3-E4 en Bf2-D4 sn F5 E D C Bf4 A en G sn G3-Bf4 F3-A4 D3-G4 D3-F4 Cs3-E4 B2-D4 dwn-A2-en-Cs4 E5 Cs G4 F sn F5 E D C Bf4 A en G G5 E Cs hn-A2-en-A4 sn A5 G F E D C dwn-Bf2-qn-Bf4 D5 F Gs D6 Gs3 dqn-A2 ddhn-A2-tsn-A4 B4 Cs5 D E hn-Cs3-E-G-E5 qn-D3-F-D5
</p>
<p>
<em>Fred Likes Cake</em>
<br>
<em>by Ludwig von Beethoven</em>
<br>
qn o5 C D E C D E D E F G r G F E F E D F E D C
</p>
<p>
<em>Ah Ah Ah Ah</em>
<br>
<em>by that woman who likes to scream, or is she a cat?</em>
<br>
wn A2 A3 A4 A5
</p>
INFO
	print	$cgi->end_html;
}
else {
	use lib ('.');
	use MIDI::Simple;

	my $instrument = 0;
	
	my $tainted_instrument = $cgi->param('instrument') || 0;
	if ($tainted_instrument =~ /^(\d{1,3})$/) {
		$instrument = $1;
		if ($instrument < 0 || $instrument > 127) {
			exit_with_error('Invalid instrument! Invalid instrument!');
		}
	}
	else {
		exit_with_error('Invalid instrument! Invalid instrument!');
	}
	
	my $song_data = '';
	
	my $tainted_song = $cgi->param('song') || '';
	
	if ($tainted_song =~ /^([a-zA-Z0-9\s_\-]+)$/) {
		$song_data = $1;
	}
	else {
		exit_with_error('Your song is in error!');
	}
	
	new_score;
	
	my $time = scalar time;
	text_event "Generated: $time";
	
	set_tempo 500000;  # 1 qn => .5 seconds (500,000 microseconds)
	patch_change 1, $instrument;
	noop qw(c1 f o2); #Set up
	
	my @tokens = split /\s/, $song_data;
	
	my @non_note_buffer = ();
	for my $token (@tokens) {
		if ($token eq 'r') { #rest
			if ($#non_note_buffer >= 0) {
				r @non_note_buffer;
				$#non_note_buffer = -1;
			}
			else {
				r;
			}
		}
		elsif ($token =~ /-/) { #chord
			if ($#non_note_buffer >= 0) {
				noop @non_note_buffer;
				$#non_note_buffer = -1;
			}
			
			n (split /-/, $token);
		}
		elsif (is_note_spec $token) { #note
			push @non_note_buffer, $token;
			n @non_note_buffer;
			$#non_note_buffer = -1;
		}
		else {
			push @non_note_buffer, $token;
		}
	}
	
	noop @non_note_buffer if $#non_note_buffer >= 0;
	
	print $cgi->header('audio/midi');
	write_score *STDOUT{IO};
}

sub exit_with_error {
	print $cgi->header('text/plain');
	print shift @_;
	print "\n";
	exit 1;
}