1#!/usr/bin/perl
2
3# TiMidity++ -- MIDI to WAVE converter and player
4# Copyright (C) 1999-2004 Masanao Izumo <iz@onicos.co.jp>
5# Copyright (C) 1995 Tuukka Toivonen <tt@cgs.fi>
6#
7# This program is free software; you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation; either version 2 of the License, or
10# (at your option) any later version.
11#
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program; if not, write to the Free Software
19# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20#
21# lspatch.pl
22#
23# List the entire instrument configuration
24
25my (@tonebank, @drumset);
26my (@pathlist, @patch_ext_list);
27my $rcf_count;
28my $def_instr_name;
29my ($cfg, $cfgroot);
30my $MAX_AMPLIFICATION;
31
32@pathlist = ( '.' );
33@patch_ext_list = ( '', '.pat', '.shn', '.pat.shn', '.gz', '.pat.gz' );
34$rcf_count = 0;
35$MAX_AMPLIFICATION = 800;
36if (@ARGV != 1) {
37	print STDERR "Usage: $0 cfg-file\n";
38	exit 1;
39}
40$cfgroot = $cfg = $ARGV[0];
41if ($cfgroot =~ s/\/[^\/]+$//) {
42	unshift(@pathlist, $cfgroot);
43}
44! &read_config_file($cfg) or exit 1;
45$rcf_count++;
46&lspatch('bank', @tonebank);
47&lspatch('drumset', @drumset);
48exit 0;
49
50sub read_config_file
51{
52	my ($name) = @_;
53	local *CFG;
54	my ($status, $i, $x, $y, $k);
55	my (@args, $bank, $orig_name, $line, $patch, @options);
56
57	if ($rcf_count > 50) {
58		print STDERR "Probable source loop in configuration files";
59		return -1;
60	}
61	$orig_name = $name;
62	undef $_;
63	$name = &open_file(*CFG, $name) or return -1;
64	undef $_;
65	$line = 0;
66	while (<CFG>) {
67		$line++;
68		s/^\s+|\r?\n$//;
69		@args = split(/[ \t\r\n\240]+/, $_);
70		next if @args == 0 || $args[0] =~ /^$|^#/;
71		if ($args[0] eq 'dir') {
72			if (@args < 2) {
73				print STDERR "$name: line $line: No directory given\n";
74				return -2;
75			}
76			shift @args;
77			map(s/\/+$//, @args);
78			unshift(@pathlist, reverse(@args));
79		} elsif ($args[0] eq 'source') {
80			if (@args < 2) {
81				print STDERR "$name: line $line: No file name given\n";
82				return -2;
83			}
84			shift @args;
85			for (@args) {
86				$rcf_count++;
87				print "source $_\n";
88				$status = &read_config_file($_);
89				$rcf_count--;
90				return $status if $status;
91			}
92		} elsif ($args[0] eq 'progbase') {
93			;
94		} elsif ($args[0] eq 'bank') {
95			if (@args < 2) {
96				print STDERR "$name: line $line: No bank number given\n";
97				return -2;
98			}
99			$i = $args[1];
100			if ($i < 0 || $i > 127) {
101				print STDERR "$name: line $line: ";
102				print STDERR "Tone bank must be between 0 and 127\n";
103				return -2;
104			}
105			$tonebank[$i] = [] if ! defined $tonebank[$i];
106			$bank = $tonebank[$i];
107		} elsif ($args[0] eq 'drumset') {
108			if (@args < 2) {
109				print STDERR "$name: line $line: No drum set number given\n";
110				return -2;
111			}
112			$i = $args[1];
113			if ($i < 0 || $i > 127) {
114				print STDERR "$name: line $line: ";
115				print STDERR "Drum set must be between 0 and 127\n";
116				return -2;
117			}
118			$drumset[$i] = [] if ! defined $drumset[$i];
119			$bank = $drumset[$i];
120		} elsif ($args[0] eq 'default') {
121			if (@args < 2) {
122				print STDERR "$name: line $line: ";
123				print STDERR "Must specify exactly one patch name\n";
124				return -2;
125			}
126			$def_instr_name = $args[1];
127		} elsif ($args[0] eq 'map') {
128			;
129		} elsif ($args[0] eq 'soundfont') {
130			;
131		} elsif ($args[0] eq 'font') {
132			;
133		} else {
134			if (@args < 2 || $args[0] !~ /^[0-9]/) {
135				print STDERR "$name: line $line: syntax error\n";
136				return -2;
137			}
138			$i = shift @args;
139			$patch = shift @args;
140			if ($i < 0 || $i > 127) {
141				printf STDERR "$name: line $line: ";
142				printf STDERR "Program must be between 0 and 127\n";
143				return -2;
144			}
145			if (! defined $bank) {
146				print STDERR "$name: line $line: ";
147				print STDERR "Must specify tone bank or drum set ";
148				print STDERR "before assignment\n";
149				return -2;
150			}
151			@options = ( );
152			for (@args) {
153				last if $_ =~ /^#/;
154				($x, $y) = split(/=/, $_, 2);
155				if ($x eq 'amp') {
156					if ($y < 0 || $y > $MAX_AMPLIFICATION || $y !~ /^[0-9]/) {
157						print STDERR "$name: line $line: ";
158						print STDERR "amplification must be ";
159						print STDERR "between 0 and $MAX_AMPLIFICATION\n";
160						return -2;
161					}
162				} elsif ($x eq 'note') {
163					if ($y < 0 || $y > 127 || $y !~ /^[0-9]/) {
164						print STDERR "$name: line $line: ";
165						print STDERR "note must be between 0 and 127\n";
166						return -2;
167					}
168				} elsif ($x eq 'pan') {
169					if ($y eq 'center') {
170						$k = 64;
171					} elsif ($y eq 'left') {
172						$k = 0;
173					} elsif ($y eq 'right') {
174						$k = 127;
175					} else {
176						$k = int(($y + 100) * 100 / 157);
177					}
178					if ($k < 0 || $k > 127 || ($k == 0 && $y !~ /^[0-9\-]/)) {
179						print STDERR "$name: line $line: ";
180						print STDERR "panning must be left, right, center, ";
181						print STDERR "or between -100 and 100\n";
182						return -2;
183					}
184				} elsif ($x eq 'tune') {
185					;
186				} elsif ($x eq 'rate') {
187					;
188				} elsif ($x eq 'offset') {
189					;
190				} elsif ($x eq 'keep') {
191					if ($y ne 'env' && $y ne 'loop') {
192						print STDERR "$name: line $line: ";
193						print STDERR "keep must be env or loop\n";
194						return -2;
195					}
196				} elsif ($x eq 'strip') {
197					if ($y ne 'env' && $y ne 'loop' && $y ne 'tail') {
198						print STDERR "$name: line $line: ";
199						print STDERR "strip must be env, loop, or tail\n";
200						return -2;
201					}
202				} elsif ($x eq 'tremolo') {
203					;
204				} elsif ($x eq 'vibrato') {
205					;
206				} elsif ($x eq 'sclnote') {
207					;
208				} elsif ($x eq 'scltune') {
209					;
210				} elsif ($x eq 'comm') {
211					;
212				} elsif ($x eq 'modrate') {
213					;
214				} elsif ($x eq 'modoffset') {
215					;
216				} elsif ($x eq 'envkeyf') {
217					;
218				} elsif ($x eq 'envvelf') {
219					;
220				} elsif ($x eq 'modkeyf') {
221					;
222				} elsif ($x eq 'modvelf') {
223					;
224				} elsif ($x eq 'trempitch') {
225					;
226				} elsif ($x eq 'tremfc') {
227					;
228				} elsif ($x eq 'modpitch') {
229					;
230				} elsif ($x eq 'modfc') {
231					;
232				} elsif ($x eq 'fc') {
233					;
234				} elsif ($x eq 'q') {
235					;
236				} elsif ($x eq 'fckeyf') {
237					;
238				} elsif ($x eq 'fcvelf') {
239					;
240				} elsif ($x eq 'qvelf') {
241					;
242				} else {
243					print STDERR "$name: line $line: bad patch option\n";
244					return -2;
245				}
246				push(@options, $_);
247			}
248			$bank->[$i] = ["$name:$line", $patch, @options];
249		}
250	}
251	close CFG;
252	return 0;
253}
254
255sub open_file
256{
257	local (*fiz) = shift;
258	my ($fname) = shift;
259
260	if ($fname =~ /^\//) {
261		return $fname if open(*fiz, $fname);
262		return 0;
263	}
264	for (@pathlist) {
265		return "$_/$fname" if open(*fiz, "$_/$fname");
266	}
267	print STDERR "$fname: $!\n" if $rcf_count == 0;
268	return 0;
269}
270
271sub lspatch
272{
273	my ($tag, @insts) = @_;
274	my ($i, $j, $bank, $p, @inst, $pos);
275
276	for ($i = 0; $i < 128; $i++) {
277		next if ! defined $insts[$i];
278		$bank = $insts[$i];
279		for ($j = 0; $j < 128; $j++) {
280			next if ! defined $bank->[$j];
281			$p = $bank->[$j];
282			@inst = @$p;
283			$pos = shift @inst;
284#			$p = $bank->[$j]->[1];
285			print "$tag $i $pos: $j @inst ", &find_patch($inst[0]), "\n";
286		}
287	}
288}
289
290sub find_patch
291{
292	my ($f) = @_;
293	local *FIZ;
294	my $realpath;
295
296	for (@patch_ext_list) {
297		$realpath = &open_file(*FIZ, "$f$_");
298		return $realpath if $realpath;
299	}
300	return "-";
301}
302
303