1#!/usr/bin/perl 2 3my(@tonebank, @drumset); 4my(@pathlist, @patch_ext_list); 5my($rcf_count); 6my($def_instr_name); 7my($cfg, $cfgroot); 8my($MAX_AMPLIFICATION); 9 10@pathlist = ('.'); 11@patch_ext_list = ('', '.pat', '.shn', '.pat.shn', '.gz', '.pat.gz'); 12$rcf_count = 0; 13$MAX_AMPLIFICATION = 800; 14 15if(@ARGV != 1) 16{ 17 print STDERR "Usage: $0 cfg-file\n"; 18 exit 1; 19} 20 21$cfgroot = $cfg = $ARGV[0]; 22if($cfgroot =~ s/\/[^\/]+$//) 23{ 24 unshift(@pathlist, $cfgroot); 25} 26 27if(&read_config_file($cfg) != 0) 28{ 29 exit 1; 30} 31$rcf_count++; 32&lspatch('bank', @tonebank); 33&lspatch('drumset', @drumset); 34exit 0; 35 36sub read_config_file 37{ 38 my($name) = @_; 39 local(*CFG); 40 my(@args, $bank, $line, $orig_name); 41 42 if($rcf_count > 50) 43 { 44 print STDERR "Probable source loop in configuration files"; 45 return -1; 46 } 47 48 $orig_name = $name; 49 undef $_; 50 if(!($name = &open_file(*CFG, $name))) 51 { 52 return -1; 53 } 54 undef $_; 55 56 $line = 0; 57 while(<CFG>) 58 { 59 $line++; 60 61 s/^\s+|\r?\n$//; 62 63 @args = split(/[ \t\r\n\240]+/, $_); 64 next if @args == 0 || $args[0] =~ /^$|^#/; 65 66 if($args[0] eq 'dir') 67 { 68 if(@args < 2) 69 { 70 print STDERR "$name: line $line: No directory given\n"; 71 return -2; 72 } 73 shift @args; 74 map(s/\/+$//, @args); 75 unshift(@pathlist, reverse(@args)); 76 } 77 elsif($args[0] eq 'source') 78 { 79 if(@args < 2) 80 { 81 print STDERR "$name: line $line: No file name given\n"; 82 return -2; 83 } 84 shift @args; 85 for(@args) 86 { 87 my($status); 88 $rcf_count++; 89 print "source $_\n"; 90 $status = &read_config_file($_); 91 $rcf_count--; 92 if($status != 0) 93 { 94 return $status; 95 } 96 } 97 } 98 elsif($args[0] eq 'default') 99 { 100 if(@args < 2) 101 { 102 print STDERR "$name: line $line: Must specify exactly one patch name\n"; 103 return -2; 104 } 105 $def_instr_name = $args[1]; 106 } 107 elsif($args[0] eq 'drumset') 108 { 109 my($i); 110 111 if(@args < 2) 112 { 113 print STDERR "$name: line $line: No drum set number given\n"; 114 return -2; 115 } 116 $i = $args[1]; 117 if($i < 0 || $i > 127) 118 { 119 print STDERR "$name: line $line: Drum set must be between 0 and 127\n"; 120 return -2; 121 } 122 if(! defined $drumset[$i]) 123 { 124 $drumset[$i] = []; 125 } 126 $bank = $drumset[$i]; 127 } 128 elsif($args[0] eq 'bank') 129 { 130 my($i); 131 if(@args < 2) 132 { 133 print STDERR "$name: line $line: No bank number given\n"; 134 return -2; 135 } 136 $i = $args[1]; 137 if($i < 0 || $i > 127) 138 { 139 print STDERR "$name: line $line: Tone bank must be between 0 and 127\n"; 140 return -2; 141 } 142 if(! defined $tonebank[$i]) 143 { 144 $tonebank[$i] = []; 145 } 146 $bank = $tonebank[$i]; 147 } 148 else 149 { 150 my($i, $patch); 151 152 if(@args < 2 || $args[0] !~ /^[0-9]/) 153 { 154 print STDERR "$name: line $line: syntax error\n"; 155 return -2; 156 } 157 158 $i = shift @args; 159 $patch = shift @args; 160 if($i < 0 || $i > 127) 161 { 162 printf STDERR "$name: line $line: Program must be between 0 and 127\n"; 163 return -2; 164 } 165 166 if(! defined $bank) 167 { 168 print STDERR "$name: line $line: Must specify tone bank or drum set before assignment\n"; 169 return -2; 170 } 171 172 for(@args) 173 { 174 my($x, $y) = split(/=/, $_, 2); 175 176 if($x eq 'amp') 177 { 178 if($y < 0 || $y > $MAX_AMPLIFICATION || $y !~ /^[0-9]/) 179 { 180 print STDERR "$name: line $line: amplification must be between 0 and $MAX_AMPLIFICATION\n"; 181 return -2; 182 } 183 } 184 elsif($x eq 'note') 185 { 186 if($y < 0 || $y > 127 || $y !~ /^[0-9]/) 187 { 188 print STDERR "$name: line $line: note must be between 0 and 127\n"; 189 return -2; 190 } 191 } 192 elsif($x eq 'pan') 193 { 194 my($k); 195 if($y eq 'center') 196 { 197 $k = 64; 198 } 199 elsif($y eq 'left') 200 { 201 $k = 0; 202 } 203 elsif($y eq 'right') 204 { 205 $k = 127; 206 } 207 else 208 { 209 $k = int(($y + 100) * 100 / 157); 210 } 211 if($k < 0 || $k > 127 || 212 ($k == 0 && $y !~ /^[0-9\-]/)) 213 { 214 print STDERR "$name: line $line: panning must be left, right, center, or between -100 and 100\n"; 215 return -2; 216 } 217 } 218 elsif($x eq 'keep') 219 { 220 if($y ne 'env' && $y ne 'loop') 221 { 222 print STDERR "$name: line $line: keep must be env or loop\n"; 223 return -2; 224 } 225 } 226 elsif($x eq 'strip') 227 { 228 if($y ne 'env' && $y ne 'loop' && $y ne 'tail') 229 { 230 print STDERR "$name: line $line: strip must be env, loop, or tail\n"; 231 return -2; 232 } 233 } 234 elsif($x eq 'comm') 235 { 236 ; 237 } 238 else 239 { 240 print STDERR "$name: line $line: bad patch option\n"; 241 return -2; 242 } 243 } 244 245 $bank->[$i] = ["$name:$line", $patch, @args]; 246 } 247 } 248 249 close(CFG); 250 return 0; 251} 252 253sub open_file 254{ 255 local(*fiz) = shift; 256 my($fname) = shift; 257 258 if($fname =~ /^\//) 259 { 260 if(open(*fiz, $fname)) 261 { 262 return $fname; 263 } 264 return 0; 265 } 266 267 for(@pathlist) 268 { 269 return "$_/$fname" if open(*fiz, "$_/$fname"); 270 } 271 272 print STDERR "$fname: $!\n" if $rcf_count == 0; 273 return 0; 274} 275 276sub lspatch 277{ 278 my($tag, @insts) = @_; 279 my($i, $j, $bank, $p, @inst, $pos); 280 281 for($i = 0; $i < 128; $i++) 282 { 283 next if !defined $insts[$i]; 284 $bank = $insts[$i]; 285 286 for($j = 0; $j < 128; $j++) 287 { 288 next if !defined $bank->[$j]; 289 $p = $bank->[$j]; 290 @inst = @$p; 291 $pos = shift @inst; 292 293# $p = $bank->[$j]->[1]; 294 print "$tag $i $pos: $j @inst ", &find_patch($inst[0]), "\n"; 295 } 296 } 297} 298 299sub find_patch 300{ 301 my($f) = @_; 302 local(*FIZ); 303 my($realpath); 304 305 for(@patch_ext_list) 306 { 307 $realpath = &open_file(*FIZ, "$f$_"); 308 return $realpath if $realpath; 309 } 310 311 return "-"; 312} 313