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