#$Id: VL.pl,v 1.16 1999/06/01 03:04:52 rocky Exp $
#  Common utility routines for programs which work with the Yamaha VL
#  "patches" or voices or voice libraries.
#
#    Copyright (C) 1999 R. Bernstein
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software Foundation,
#    Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

sub usage {
    warn "
$prog version 0.98, $timestamp
Copyright (C) 1998,99 Rocky Bernstein

$prog comes with ABSOLUTELY NO WARRANTY; 
This is free software, and you are welcome to redistribute it
under certain conditions.

usage: 
  $prog [options] [-WX] VL1-file [VL-file]...
  $prog -version
  $prog -help

synopsis:
   decodes/displays parts of the contents of Yamaha
   VL1 file(s) which may be a single voice, a bank of 16 voices or a
   set of banks.  This code handles only $VL_ver files.

   All switches below can be abbreviated to to the minimum value that
   makes them unique. However -v is -verbose, not -version.


switches:
  -warn:  Give warnings. 
      Things like which parameters set but have no effect: such
      as a controller set for something whose level is set to zero, or
      a level set for something requiring a controller which has been 
      turned off. Warning messages begin with the string **** Warning
  -enhanced:  Give an enhanced listing. 
      Print additional conversion information. Things
      like turning a pitch offset into a note value, or a depth level
      into a percentage. Enhanced listing text is enclosed in brackets 
      [like this].
  -terse: Give a terse listing. 
      Displays only parameters that are set. Normally various
      parameters are listed even if for some reason they can have no effect.
      For example, if a controlling volume level of 0, or they are
      controlled by a controller that is off or can't be used.
      See also -WX
  -toc-only: Only print the voice table of contents
  -notoc   : Don't print the voice table of contents
  -debug n: Produce debug output.
      The hex offsets in the file where various parameters are associated 
      with the listing are printed if n is odd (n & 1 != 0)
      If (n & 2 != 0) then values of parameters before conversion,
      such as to \"Hz\", or \"oct\" is printed in parenthesis. 
      This is useful in debugging \"off by a little\" errors in the 
      this program or another program which is creating such as file.
      If (n & 4 != 0) then hex offset are printed in decimal.
      If (n & 8 != 0) then more parameters are shown than would
      normally appear on a display, e.g. *both* value and depth+curve
      on a controller.
  -WX: Controller inputs include a WX controller.
  -modwheel: Controller inputs include a modulation wheel (01)
  -cs1:      Controller inputs include a channel select 1 (16)
  -cs2:      Controller inputs include a change select 1 (17)
  -cc=*n*:   Controller inputs include a control change *n* where *n*
             is an integer. This option can be given several times.
  -vnum=*n*  print only voice number *n* where *n* is an integer.
             This option can be given several times. This makes
             sense only in a bank of voices and of course, the voice number
             should be less than the number of voices in the file.
  -vloc=*n*  like above but use bank and location in bank instead of 
             absolute integer number. For example A01 is 1; H16 is 255.
  -help: Print this help and exit.
  -version:  print version information and exit.

";
exit; 
}

# Parse the command-line options and process the simple ones (like -help and 
# -version).
sub process_options {
  # Deal with the f*cking options....
  use Getopt::Long;
  $Getopt::Long::autoabbrev = 1;
  
  $result = &GetOptions
    (
     'terse'      => \$terse,
     'toc-only'   => \$toc,
     'notoc'      => \$notoc,
     'warn'       => \$warn,
     'WX'         => \$WX,
     'modwheel'   => \$modwheel,
     'cs1'        => \$cs1,
     'cs2'        => \$cs2,
     'cc=n'       => \@cc,
     'voice=s'    => \@voice,
     'vnum=n'     => \@vnum,
     'vloc=s'     => \@vloc,
     'debug=n'    => \$debug,
     'enhanced'   => \$enhanced,
     'version'    => \$show_version,
     'help'       => \$help
    );
  
  usage if !$result || $help;          # 'help' requested
  if (@ARGV == 0) {
    print "$prog: Need to specify at least one VL1 file.\n";
    usage();
  };
  
  # Don't know what we got---assume everything
  $all_controls = 1;
  
  if ($WX) {
    $CONTROLLER{'Breath Controller'}  = 1;
    $CONTROLLER{'Pitch Bend'}         = 1;
    $CONTROLLER{'Velocity'}           = 1;
    $all_controls                     = 0;
  }
  if ($modwheel) {
    $CONTROLLER{'Modulation wheel'}   = 1;
    $all_controls                     = 0;
  }
  if ($cc16) {
    $CONTROLLER{'CS1'}                = 1;
    $all_controls                     = 0;
  }
  if ($cc17) {
    $CONTROLLER{'CS2'}                = 1;
    $all_controls                     = 0;
  }

  foreach $cc (@cc) {
    $CONTROLLER{$cc}                  = 1;
    $all_controls                     = 0;
  }

  $all_voices = 1;
  foreach $voice (@voice) {
    $show_name{$voice} = 1;
    $all_voices        = 0;
  }
  
  foreach $vnum (@vnum) {
    $show_num{$vnum} = 1;
    $all_voices      = 0;
  }
  
  foreach $vloc (@vloc) {
    if ($vloc =~ /^([a-h])(\d\d?)$/i) {
      my($bank) = index('abcdefgh', lc($1))*16;
      my($vnum)  = $bank + $2;
      $show_num{$vnum} = 1;
      $all_voices      = 0;
    } else {
      warn_msg("Sorry, couldn't parse $vloc\n");
    }
  }
  
  show_version() if $show_version;
}

#
# Reads $vl1_file into global buffer $buf.
#
sub read_vl1_file {
  my($vl1_file) = @_;
  die "Expecting a .1vc, .1bk .all, .avc, or .lib file, got $vl1_file instead"
    if ( $vl1_file !~ /\.(1vc|1bk|all|lib|avc)$/i );
  
  my($globbed_vl1_file) = glob($vl1_file);
  open(VL1_M, "<$globbed_vl1_file") || 
    die "Can't open $vl1_file for reading, status $?. Error message was:\n$!\n";
  if ($vl1_file =~ /\.1vc$/i) {
    $bytes_needed = $one_voice_size;
    $num_voices = 1;
  } elsif ($vl1_file =~ /\.1bk$/i) {
    $bytes_needed = $one_bank_size;
    $num_voices = 16;
  } elsif ($vl1_file =~ /\.all|\.avc$/i) {
    $bytes_needed = $all_bank_size;
    $num_voices = 128;
  } elsif ($vl1_file =~ /\.lib$/i) {
    $bytes_needed = 102272;
    $num_voices = 128;
  }
  $read_size = read(VL1_M, $buf, $bytes_needed);
  
  if ( $read_size != $bytes_needed) {
    if ($read_size == 101376) {
      $num_voices = 32;
    } elsif ($read_size == $one_bank_size) {
      $num_voices = 16;
    } else {
      die "Did not read $bytes_needed bytes. Got $read_size bytes instead
while in reading $vl1_file";
    }
  }
  close(VL1_M);
  return $num_voices;
}

sub high_cvt {
  my($high) = @_;
  return($high+1)/10.0;
} 

sub convert_QED_assign {
  # Todo: need to check that what's returned is "on"
  # Quick Editing something that's off doesn't do anything.
  my($assign, $element, $debugstr) = @_;
  my($ret);
  if ($assign >= 0 && $assign <= 150) {
    $ret = sprintf "%s : $debugstr%s", 
                    $element, $QED_assign_element_cvt[$assign];
  } else {
    $ret = sprintf "%s : **invalid (%d)", $element, $assign;
  }
  return $ret;
}

sub print_header {
  my($handled_vl_version) = @_;
  print "\n", $voice_separator;
  $rc = print_signature($handled_vl_version);
  exit $rc if $rc;
  printf "Version   : '%s'\n", get_str(0x0010, 32);
  my($greeting) = get_str(0x0040, 20);
  if (unpack("c", $greeting) != 0) {
    printf "Greeting  : '%s'\n", $greeting;
  }
  printf $parm_separator;
}

sub print_signature {
  my($handled_vl_version) = @_;
  my($vl_header) = get_str(0x0000, 16);
  my($rc) = 0;
  if ( $vl_header =~ /$LM  0117/ ) {
    $vl1_version = 'VL1 Version 1 format';
  } elsif ( $vl_header =~ /$LM 20117/ ) {
    $vl1_version = 'VL1 Version 2 format';
  } elsif ( $vl_header =~ /$LM  0268/ ) {
    $vl1_version = 'VL70 Version 2 format';
  } else {
    print "****Warning***** Perhaps $vl_file is not a VL file!\n";
    $rc = 1;
  }
  if ($vl1_version ne $handled_vl_version) {
    print "****Warning***** $vl_file is not in $handled_vl_version!\n";
    $rc = 2;
  }
  printf "Header    : ";
  if ( $opt_v || $rc ) {
    printf "'%s' ($vl1_version)\n", $vl_header;
  } else {
    printf "$vl1_version\n";
  }
  return $rc;
}

sub print_bank {
  my($address) = 0x400;
  $address = get_voices($num_voices, $address, $voice_name_len);
  my($i) = 1;
  my($j) = 1;
  my($bank) = ord($num_voices > 16 ? 'A' : ' ');
  
  foreach (@voice_name) {
    if ($i > 16) {
      $i = 1;
      $bank++;
    }
    $voice_loc[$j] = sprintf "%c%02d", $bank, $i++;
    
    # Test and set to show if voice was requested
    if ($show_name{$_}) {
	$show_num{$j} = 1;
    }
    printf "Voice %s", $voice_loc[$j];
    printf " (%2d)", $j if $enhanced;
    printf ": '%s'\n", $_;
    $voice_name{$_}++;
    $j++;
  }
  print $parm_separator;
}

# Print everything known about a voice. (A voice is an instrument setting.)
sub print_voice {
  local(*where, $voice_num)=@_;
  print_initial_edit_page(*where, $voice_num);
  print_common(*where);
  $num_elts = ($voice_mode eq 'Dual') ? 2 : 1;
  for $i (1..$num_elts) {
    next if $terse && !$element_level[$i];
    $elt_num="E$i";
    print_elt_controller($elt_num, *where);
    print_elt_miscellaneous($elt_num, *where);
    print_elt_modifier ($elt_num, *where);
    print_elt_envelope ($elt_num, *where);
  }
  print $voice_separator;
}


sub print_pitch_change {
    my($side, $pitch, $fine, $output) = @_;
    printf "%s Pitch     = %3d         Fine = %4d\n", $side, $pitch, $fine;
    printf "%s Output    = %3d%%\n",   $side, $output;
}

# Page 40 of FR Version 1
sub print_misc_portamento {
  # Don't print anything if in terse mode and no portamento is turned
  # on. Element 2 is only relevant in this calculation if we have a 
  # dual voice.
  if ( !$terse || $elt_1_portamento eq 'on' 
       || ($elt_2_portamento eq 'on' && $voice_mode eq 'Dual')	) {
    print "COM/MISC/PORTAMENTO\n";
    print "Portamento Mode   = ";

    # If the "Key Mode" parameter is set to "Poly" or "Unison" the
    # "Portamento Mode" parameter is fixed at "Full Time" and cannot
    # be changed.
    if ($key_mode ne 'Mono' || $portamento_mode == 0) {
      print "Full Time\n";
      if ($portamento_mode != 0) {
	info_msg("Portamento Mode is $portamento_mode but forced Full Time,"
		 . " because key mode is Mono.\n");
	info_msg("It would be clearer to set Portamento Mode to Full Time.\n");
      }
    } elsif ($portamento_mode == 1) {
      print "Fingered\n";
    } else {
      printf $unknown_str, $portamento_mode;
    }
    printf "Time MIDI Control = $portamento_time_MIDI_ctrl\n";

    # The time parameter becomes active only when the "Time MIDI Control"
    # is turned off.
    print  enhanced("Time              = %3d", $portamento_time, 127), "\n"
      if ($portamento_time_MIDI_ctrl eq 'off');
    printf "Element1          = $elt_1_portamento\n";
    printf "Element2          = $elt_2_portamento\n"
      if $voice_mode eq 'Dual';
    print $parm_separator;
  }
}

# Page 51-52
sub print_effect_distortion {
    local(*address, $e1_onoff, $e2_onoff) = @_;
    debugaddr($address);
    my($dist_overdrive)   = get_unsigned_byte(*address);
    $address += 2;
    my($dist_device)      = get_unsigned_byte(*address);
    my($dist_speaker)     = get_unsigned_byte(*address);
    my($dist_presence)    = get_signed_16_value(*address);
    my($dist_outputlvl)   = get_unsigned_byte(*address);
    $address += 3;

    my($all_off) = ($e1_onoff eq "off") && 
	           (($voice_mode ne 'Dual') || ($e2_onoff eq "off"));
    if ($all_off) {
      warn_msg("All elements are off. You may as well turn off Modulation Effect.\n");
      return if $terse;
    }

    printf "Element on/off          E1: %s", $e1_onoff;
    if ($voice_mode eq 'Dual') {
	printf "    E2: %s\n", $e2_onoff;
    } else {
	print "\n";
    }
    printf "Overdrive    = %3d%%\n", $dist_overdrive;
    print  "Device       = ";
    if ($dist_device==0) {
	print "Transistor\n";
    } elsif ($dist_device==1) {
	print "Vintage Tube\n";
    } elsif ($dist_device==2) {
	print "Distortion 1\n";
    } elsif ($dist_device==3) {
	print "Distortion 2\n";
    } elsif ($dist_device==4) {
	print "Fuzz\n";
    } else {
	printf "unknown %d\n", $dist_device;
    }
    printf "Output Level = %3d%%\n", $dist_outputlvl;
    printf "Speaker      = ";
    if ($dist_speaker==0) {
	print "Flat\n";
    } elsif ($dist_speaker==1) {
	print "Stack\n";
    } elsif ($dist_speaker==2) { 
	print "Combo\n";
    } elsif ($dist_speaker==3) {
	print "Twin\n";
    } elsif ($dist_speaker==4) {
	print "Radio\n";
    } elsif ($dist_speaker==5) {
	print "Megaphone\n";
    } else {
	printf "unknown %d\n", $dist_speaker;
    }
    printf "Presence     = %3d\n", $dist_presence;
    
}

sub print_feedback_delay {
  local(*address) = @_;
  debugaddr($address);
  my($fbd_reverb_mode)    = get_signed_byte(*address);
  my($fbd_type)    = get_signed_byte(*address);
  my($fbd_return)  = get_unsigned_byte_range(*address, 100);
  if (nontersed($fbd_type)) {
    print ("COM/EFFECT/FEEDBACK DELAY\n");
    printf "%-17s= %3d%%\n",  'Return', $fbd_return;
    printf "%-17s= ", 'Delay Type';
  }
  if ($fbd_type == 0) {
    $address += 18;
    if (!$terse) {
      print "off\n";
    } else {
      return;
    }
  } elsif ($fbd_type == 1) {
    print "Mono\n";
    print_feedback_delay_mono(*address);
  } elsif ($fbd_type == 2) {
    print "L,R\n";
    print_feedback_delay_lr(*address);
  } elsif ($fbd_type == 3) {
    print "L,C,R\n";
    print_feedback_delay_lcr(*address);
  } else  {
    printf "unknown %d\n", $fbd_type;
    $address += 18;
  }
  print $parm_separator;
}

# Page 53-54 of FR version 1
sub print_feedback_delay_mono {
    local(*address) = @_;
    debugaddr($address);
    $address += 6;
    my($fbd_delay_time)    = get_short_word(*address);
    my($fbd_level)         = get_signed_byte(*address);
    my($fbd_fb_delay_time) = get_short_word(*address);
    my($fbd_fb_gain)       = get_signed_byte(*address);
    my($fbd_fb_high)       = get_signed_byte(*address);
    print_feedback_gain_high('', $fbd_fb_gain, $fbd_fb_high);
    print_feedback_time_level('', 
			      $fbd_delay_time, $fbd_level);
			      
    $address += 5;
}

# Page 55-56 of FR version 1
sub print_feedback_delay_lr {
    local(*address) = @_;
    debugaddr($address);
    my($fbd_left_channel_delay_time)   = get_short_word(*address);
    my($fbd_left_channel_fb_gain)      = get_signed_byte(*address);
    my($fbd_left_channel_high)         = get_signed_byte(*address);
    my($fbd_left_channel_level)        = get_signed_byte(*address);
    my($fbd_right_channel_delay_time)  = get_short_word(*address);
    my($fbd_right_channel_fb_gain)     = get_signed_byte(*address);
    my($fbd_right_channel_high)        = get_signed_byte(*address);
    my($fbd_right_channel_level)       = get_signed_byte(*address);
    $address += 8;
    print_feedback_time_level('Lch ', 
			      $fbd_left_channel_delay_time, 
			      $fbd_left_channel_level);
    print_feedback_gain_high ('Lch ', 
			      $fbd_left_channel_fb_gain, 
			      $fbd_left_channel_high);
    print_feedback_time_level('Rch ', 
			      $fbd_right_channel_delay_time, 
			      $fbd_right_channel_level);
    print_feedback_gain_high ('Rch ', 
			      $fbd_right_channel_fb_gain, 
			      $fbd_right_channel_high);
}

# Page 57-58 of FR version 1
sub print_feedback_delay_lcr {
  local(*address) = @_;
  debugaddr($address);
  my($fbd_left_channel_delay_time)    = get_short_word(*address);
  my($fbd_left_channel_level)         = get_signed_byte(*address);
  my($fbd_right_channel_delay_time)   = get_short_word(*address);
  my($fbd_right_channel_level)        = get_signed_byte(*address);
  my($fbd_center_channel_delay_time)  = get_short_word(*address);
  my($fbd_center_channel_level)       = get_signed_byte(*address);
  my($fbd_fb_delaytime)               = get_short_word(*address);
  my($fbd_fb_gain)                    = get_signed_byte(*address);
  my($fbd_fb_high)                    = get_signed_byte(*address);
  $address += 5;
  print_feedback_gain_high ('', 
			    $fbd_fb_gain, 
			    $fbd_fb_high);
  print_feedback_time_level('Lch ', 
			    $fbd_left_channel_delay_time, 
			    $fbd_left_channel_level);
  print_feedback_time_level('Cch ', 
			    $fbd_center_channel_delay_time, 
			    $fbd_center_channel_level);
  print_feedback_time_level('Rch ', 
			    $fbd_right_channel_delay_time, 
			    $fbd_right_channel_level);
}

# Page 60 of FR Version 1 
# Global reverb_type is set.
sub print_reverberation {
  local(*address) = @_;
  debugaddr($address);
  $reverb_type    = get_signed_byte(*address);
  if (nontersed($reverb_type)) {
    print ("COM/EFFECT/REVERBERATION\n");
    printf "%-18s= ", 'Reverb Type';
  }
  if ($reverb_type == 0) {
    if (!$terse) {
      print "off\n";
    } else {
      return;
    }
  } elsif ($reverb_type == 1) {
    print "Hall 1\n";
  } elsif ($reverb_type == 2) {
    print "Hall 2\n";
  } elsif ($reverb_type == 3) {
    print "Room 1\n";
  } elsif ($reverb_type == 4) {
    print "Room 2\n";
  } elsif ($reverb_type == 5) {
    print "Studio\n";
  } elsif ($reverb_type == 6) {
    print "Plate\n";
  } elsif ($reverb_type == 7) {
    print "Space\n";
  } elsif ($reverb_type == 8) {
    print "Reverse\n";
  } else  {
    printf "unknown %d\n", $reverb_type;
  }
  $reverb_return = get_signed_byte(*address);
  # Need work here
  $reverb_time = get_signed_byte(*address);
  $reverb_high_ctrl = get_signed_byte(*address);
  $reverb_diffusion = get_unsigned_byte_range(*address, 10);
  $reverb_init_delay = get_short_word(*address);
  $reverb_treble = get_signed_32_value(*address);
  $reverb_bass   = get_signed_32_value(*address);
  $reverb_feel   = get_unsigned_byte_range(*address, 3);
  $reverb_time_boost = get_unsigned_byte_range(*address, 10);
  
  printf "%-18s= %3d%%\n",  'Return', $reverb_return;
  printf "%-18s= %s sec\n", 'Reverb Time', 
  check_cvt(*reverb_time_cvt, $reverb_time, "%s", $illegal_set_str);
  printf "%-18s= %3d\n",    'Reverb Time Boost', $reverb_time_boost;
  printf "%-18s= %2.1f\n",  'High Control', high_cvt($reverb_high_ctrl);
  printf "%-18s= %3d\n",    'Diffusion', $reverb_diffusion;
  printf "%-18s= %3d ms\n", 'Initial Delay', $reverb_init_delay;
  printf "%-18s= %3d\n",    'Feel', $reverb_feel;
  printf "Bass = %3d        Treble = %3d\n", $reverb_bass, $reverb_treble;
  print  $parm_separator;
}

# Section starting on page 104 of FR Version 1 
sub print_elt_misc_amplitude {
  local($message, *where)=@_;
  debugaddr($where);
  my($amplitude_level)= get_unsigned_byte_range(*where, 127);
  my(@amp_brks)       = get_brkpts(*where, *get_signed_64_value, 8);
  
  print "$message\n";
  print enhanced("Amplitude Level     = %3d", $amplitude_level, 127), "\n";
  print_brks("", $amplitude_level, 127, @amp_brks); 
  print $parm_separator;
  
}


# Section starting on page 122 of FR Version 1
sub print_elt_mod_equalizer_band {
  local($message, *where)=@_;
  debugaddr($where);
  
  my($i);
  local(@EQ_Band_Freq);
  local(@EQ_Band_Q);
  local(@EQ_Band_Level);
  for (1..5) {
    push(@EQ_Band_Freq,  get_cutoff(*where, *equalizer_band));
    push(@EQ_Band_Q,     get_unsigned_byte(*where));
    push(@EQ_Band_Level, get_signed_64_value(*where));
  }
  print  "$message\n";
  
  for $i (0..4) {
    printf "Band%d Freq= %s  Q=%s  Level=%s\n", 
    $i+1, $EQ_Band_Freq[$i*3], 
    check_cvt(*Q_cvt, $EQ_Band_Q[$i], "%s", $illegal_set_str),
    check_level($EQ_Band_Level[$i]);
  }
  print $parm_separator;
}

#  Section starting on page 143 of Version 1 FR.
sub print_env_amp_filter {
  local($message, *address) = @_;
  debugaddr($address);

  $af_vel_sens_to_level  = get_unsigned_byte_range(*address, 16);
  $af_vel_sens_to_rate   = get_unsigned_byte_range(*address, 16);
  $af_attack_rate1       = get_unsigned_byte_range(*address, 127);
  local(@af_ar1_brk)     = get_brkpts(*address, *get_unsigned_byte, 2);
  $af_attack_level1      = get_unsigned_byte_range(*address, 127);
  local(@af_al1_brk)     = get_brkpts(*address, *get_unsigned_byte, 2);
  $af_attack_rate2       = get_unsigned_byte_range(*address, 127);
  local(@af_ar2_brk)     = get_brkpts(*address, *get_unsigned_byte, 2);
  $af_decay_rate         = get_unsigned_byte_range(*address, 127);
  local(@af_decay_brk)   = get_brkpts(*address, *get_unsigned_byte, 2);
  $af_sustain_level      = get_unsigned_byte_range(*address, 127);
  local(@af_sustain_brk) = get_brkpts(*address, *get_unsigned_byte, 2);
  $af_release_rate       = get_unsigned_byte_range(*address, 127);
  local(@af_release_brk) = get_brkpts(*address, *get_unsigned_byte, 2);
  $af_depth_to_amp       = get_unsigned_byte_range(*address, 127);
  $af_depth_to_filter    = get_signed_127_value(*address);

  print "$message\n";

  print enhanced("Velocity Sens to level = %3d", $af_sens_to_level, 16),
        "\n";
  print enhanced("              to rate  = %3d", $af_sens_to_rate, 16),
        "\n";

  print enhanced("Depth to amplitude     = %3d", $af_depth_to_amp, 127),
        "\n";
  print enhanced("      to filter        = %3d", $af_depth_to_filter, 127),
        "\n";

  print "Rate\n";
  if (nontersed($af_attack_rate1)) {
    print enhanced("  Attack1 = %d", $af_attack_rate1, 127), "\n";
    print_brks("", $af_attack_rate1, 127, @af_ar1_brk);
  }

  # When $af_attack_level1 is set to 127 the attack 1 level
  # becomes the same as the maximum level, therefore the second
  # portion of the attack $af_attack_rate2 will not be produced.
  if (nontersed($af_attack_rate2 && $af_attack_level1 != 127)) {
    print enhanced("  Attack2 = %d", $af_attack_rate2, 127), "\n";
    print_brks("", $af_attack_rate2, 127, @af_ar2_brk);
  }

  # When $af_sustain_level is set to 127 the sustain level
  # becomes the same as the maximum level, therefore the decay
  # portion of the envelope $af_decay_rate will not be produced.
  if (nontersed($af_decay_rate && $af_sustain_level != 127)) {
    print enhanced("  Decay   = %d", $af_decay_rate, 127), "\n";
    print_brks("", $af_decay_rate, 127, @af_decay_brk);
  }
  if (nontersed($af_release_rate)) {
    print enhanced("  Release = %d", $af_release_rate, 127), "\n";
    print_brks("", $af_release_rate, 127, @af_release_brk);
  }
  
  print "Level\n";
  if (nontersed($af_attack_level1)) {
    print enhanced("  Attack1 = %d", $af_attack_level1, 127), "\n";
    print_brks("", $af_attack_level1, 127, @af_al1_brk);
  }
  
  if (nontersed($af_sustain_level)) {
    print enhanced("  Sustain = %d", $af_sustain_level, 127), "\n";
    print_brks("", $af_sustain_level, 127, @af_sustain_brk);
  }
  
  print $parm_separator;
}

sub print_he_common {
  local($car_or_mod, $signal, *hpf, *HPF_brks, $overdrive, 
	*od_brks, $index_level, *level_brks,
	$balance, *bal_brks, $phase) = @_;
  
  print  "$car_or_mod:\n";
  print  "   Signal Select   : ";
  print check_cvt(*signal_select_cvt, $signal, "%s\n", $illegal_set_str);
  print_breaks("   HPF Cutoff Freq.",  $hpf[2], 127, 
	       *format_hpf_cutoff_val, @HPF_brks);

  print_breaks("   Over Drive      ",   $overdrive, 127, 
	       *format_overdrive_val, @od_brks);
  
  if ($car_or_mod eq 'Modulator') {
    printf "   Phase           : %d degrees\n", 
      round(rescale($phase, 127, 360));
    print_brks("   Index           ",  $index_level, 127, @level_brks);
    print_brks("   Balance         ", $balance, 127, @bal_brks);
  } else {
    print_brks("   Level           ", $index_level, 127,  @level_brks);
    print "-----\n";
  }
}

sub print_freq {
  my($freq) = @_;
  my($str) = raw_val($freq);
  printf "Freq. = ${str}%s Hz", $freq_time_cvt[$freq]; 
}

sub print_feedback_time_level {
  local($hdr, $dtime, $dlevel) = @_;
  $hdr .= 'Delay Time';
  printf "%-17s=%5d ms%-7s=%3d%%\n", 
	 $hdr, $dtime, ' Level', $dlevel;
} 

sub print_feedback_gain_high {
  my($hdr, $gain, $high) = @_;
  $hdr .= 'FB Gain';
  printf "%-17s=%5d%%   %-6s= %2.1f\n", $hdr, $gain, 'High', high_cvt($high);
} 

sub print_depth_delay {
  my($depth, $delay) = @_;
  printf "Depth = %3d%%            Delay = %s ms\n",  
  $depth, $delay_cvt[$delay];
}

# Print High- and Low-pass filters. Warn if it's all filtered out...
sub print_filters {
  local(*hpf, *lpf, *hpf_brks, *lpf_brks) = @_;
  my($all_filtered) = $hpf[1] > $lpf[1];
  print_breaks("HPF Cutoff Freq.  ",  $hpf[2], 127, 
	       *format_lpf_cutoff_val, @hpf_brks);
  print_breaks("LPF Cutoff Freq.  ",  $lpf[2], 127, 
	       *format_lpf_cutoff_val, @lpf_brks);
  info_msg("HPF is greater than LPF.\n")
    if $all_filtered;
}

# Print a single High- or Low-pass filters.
sub print_cutoff {
  my($low_or_high, $text) = @_;
  my($width) = $enhanced ? 18 : 10;
  printf "${low_or_high}PF Cutoff Freq. = %${width}s\n", $text;
}

# Prints a VL1 controller page
# Parameters: message and format strings
# Global variable $ret is read.
sub print_ctrl_page {
  my($message)          = shift;  # Need to use shift here since variable 
  my($warn_if_no_depth) = shift;  #   number of parameters;
  my($depth_count)      = shift;  # How many depth values?
  my($cont)    = $ret[0];
  if (nontersed($cont)) {
    printf $message;
    printf "Controller: $cont\n";
    return if stop_if_no_ctrl($cont, "", 1);
    if ($ret[1] == 0 && $warn_if_no_depth) {
      warn_msg("Depth is 0. You may as well turn off the controller.\n")
	if $cont ne 'off';
      if ($terse) {
	print $parm_separator;
	return;
      }
    }

    # Normally, when a controller is turned off "depth" values are not
    # displayed. But we have an option to show everything.
    if ( $debug & 8 || ($cont ne 'off') ) {
      $all_zero = 1;
      $i = 1;
      foreach (@_) {
	printf $_, $ret[$i] if nontersed($ret[$i]);
	$all_zero &&= !$ret[$i] if $i <= $depth_count;
	$i++;
      }
      warn_msg("All depth values zero. No effect.\n")
	if $all_zero;
    }
    printf $parm_separator;
  }
}

# Prints a VL1 controller page in which the controller is off 
# which means that the value field is in effect.
#
# Parameters: message 
# Global variable $ret is read.
sub print_ctrl_value_page {
  my($message) = shift;
  my($cont) = $ret[0];
  my($val)  = $ret[3];

  return if !nontersed($val);
  printf $message;

  printf "Controller: $cont\n";
  printf "Value      = %3d", $val;
  printf " [%3.1f%%]", val_to_pct($val, 127) if $enhanced;
  print "\n";
  print  "$parm_separator";
}

#
# Print a Controller/Depth/Curve/Value page.
# Parameters: message and address to look at.
# Side effect: the passed address is updated.
#
# The way the VL1 works, if Controller is 'off', 'Value' is used.
# Otherwise, 'Curve' and 'Depth' are used. However if we want a verbose
# listing, 'Controller', 'Curve', 'Depth' *and* 'Value' are printed.
#
sub print_dynamic_range_value {
  local($message, *address, *controller) = @_;
  debugaddr($address);
  get_dynamic_gauge_value(*address);

  # Normally, when a controller is turned off only a "value" parameter
  # is displayed, and when a controller is set the "depth" and "curve"
  # are displayed. But we have an option to show everything.
  $controller = $ret[0];
  if ($debug & 8) {
    print_ctrl_page ( $message, 1, 2,
		      enhanced_depth("Depth      = %3d", $ret[1]),
		      "Curve      = %3d\n",
		      "Value      = %3d\n" );
  } elsif ($controller eq 'off') {
    print_ctrl_value_page ( $message ) if nontersed($ret[3]);
  } else {
    print_ctrl_page ( $message,  1, 1,
		      enhanced_depth("Depth      = %3d", $ret[1]),
		      "Curve      = %3d\n");
  }
  return $controller;
}

sub print_embouchure {
  local($message, *address) = @_;
  debugaddr($address);
  $emb_ctrl = get_controller(*address);
  @ret  = ( $emb_ctrl );
  $mode = get_unsigned_byte_range(*address, 1);
  push (@ret, get_signed_127_value(*address));
  push (@ret, get_signed_127_value(*address));
  push (@ret, $mode == 0 ? 'Center Base' : 'Minimum Base');

  print_ctrl_page ( $message, 0, 2, 
		    enhanced_depth("Upper Depth = %4d", $ret[1]),
		    enhanced_depth("Lower Depth = %4d", $ret[2]),
		    "Mode        = %s\n" );
}

sub print_pitch {
  local($message, *address) = @_;
  debugaddr($address);
  $pitch_ctrl = get_controller(*address);
  @ret  = ( $pitch_ctrl );
  $mode = get_unsigned_byte_range(*address, 1);
  push (@ret, get_signed_16_value(*address));
  push (@ret, get_signed_16_value(*address));
  push (@ret, $mode == 0 ? 'Center Base' : 'Minimum Base');
  print_ctrl_page ( $message, 0, 2,
		    enhanced_pitch("Upper Depth = %4d", $ret[1], 1),
		    enhanced_pitch("Lower Depth = %4d", $ret[2], 1),
		    "Mode        = %s\n" );
  if (($ret[1] == 0) && ($ret[2] == 0)) {
    warn_msg("Upper and Lower Depth set to zero. No pitch bending possible.\n");
    return if $terse;
  }
}

sub print_vibrato {
  local($message, *address) = @_;
  debugaddr($address);
  $vib_ctrl = get_controller(*address);
  $where++;   # Padding? 
  @ret = ($vib_ctrl, get_signed_127_value(*address));
  print_ctrl_page ( $message, 0, 1,
		    enhanced_depth("Depth       = %4d", $ret[1]) );
}

sub print_dynamic_range {
  local($message, *address) = @_;
  debugaddr($address);
  get_dynamic_gauge(*address);
  print_ctrl_page ( $message, 1, 1,
		    enhanced_depth("Depth       = %4d", $ret[1]),
		    "Curve       = %4d\n" );
  return $ret[0];
}

### TEMPORARY. Should replace with routine below.. 
sub print_breakpoints {
  my($message, @brks) = @_;
  my($pitch_str); 
  my($i) = 0; 
  my($curr_pitch, $might_warn);

  return if !@brks;

  my($ref)=$brk[0];
  my($prev_pitch)  = $ref->[0];
  my($prev_offset) = $ref->[1];

  print "$message\n" if $message;

  # Check to see if the levels are all the same. 
  if ($terse) {
    my($ref)=$brk[0];
    $prev_offset = $ref->[1];
    foreach $brk (@brks) {
      goto not_flat if $prev_offset != $brk->[1];
    }
    # Yep they are the same. I thought so. 
    # If the offset zero then this doesn't add/subtract to the 
    # overall level, so since we're tersed, don't add to the clutter.
    return if $prev_offset == 0;
    printf "  all brkpt values: %3d\n", $prev_offset;
    return;
  not_flat: 
    
  }
  
  $prev_pitch  = -9999; 
  $prev_offset = -9999;
  foreach $brk (@brks) {
    $i++;
    $curr_pitch  = $brk->[0];
    $curr_offset = $brk->[1];
    $pitch_str = note_offset_to_note($curr_pitch);
    my($same) = $prev_offset == $curr_offset && $prev_pitch == $curr_pitch;
    if (nontersed( ($i > $#brks && !$same)
		   || $prev_pitch != $curr_pitch)) {
      $might_warn = $prev_pitch > $curr_pitch;
      # If we've got a breakpoint that's has the same offset
      # value as the ones around it and we want a terse listing,
      # we don't have to print this one. The effect is the same
      # as whatever was around it.
      if (nontersed($i > $#brks || 
		    (($curr_offset != $prev_offset
		      || $curr_offset != $brks[$i]->[1]))
		    && !$might_warn)) {
	printf "   %2d: %-5s, %3d\n", $i, $pitch_str, $curr_offset;
      }
      warn_msg("this breakpoint not larger than previous one.\n")
	if ($might_warn && $warn);
    }
    $prev_pitch  = $curr_pitch;
    $prev_offset = $curr_offset;
  }
}

sub print_brks {
  my($message, $level, $max, @brks) = @_;
  print_breaks($message, $level, $max, undef, @brks);
}

# Main routine to output level and breakpoint level.
# $message: message to prefix $level output with 
# $level  : the base value for which breakpoints are relative to
# $max    : the maximum value allowed for $level
# *routine: a routine used to convert/format $level and values in @brks
# @brks   : breakpoints consisting of pitch name, value for pitch.
sub print_breaks {
  local($message, $level, $max, *routine, @brks) = @_;
  my($pitch_str); 
  my($curr_pitch, $might_warn);

  return if !@brks;

  my($ref)=$brk[0];
  my($prev_pitch)  = $ref->[0];
  my($prev_offset) = $ref->[1];

  # Check to see if the levels are all the same. 
  if ($terse) {
    my($ref)=$brk[0];
    $prev_offset = $ref->[1];
    foreach $brk (@brks) {
      goto not_flat if $prev_offset != $brk->[1];
    }

    # All breakpoint values are the same, so just print out the 
    # level and value if we have been given $message.
    # If not, we assume the level has been printed out beforehand
    # so we just return.

    my($effective_level) = $level + $prev_offset;
    if ($level + $prev_offset > $max) {
      warn_msg("value + offset ($effective_level) > max value ($max). "
	       . "$max used.\n");
      $effective_level = $max;
    }
    if ($message) {
      print "$message:";
      if (defined(&routine)) {
	printf " %s", routine($effective_level);
      } else {
	printf " %3d", $effective_level;
	printf " [%3d%%]", val_to_pct($effective_level, $max) if ($enhanced);
      }
      printf "\n";
    } 
    return;
  not_flat: 
  }

  # Not all values are the same. 

  # First give the level for which breakpoints are relative to.
  if ($message) {
    print "$message:";
    if (!$terse) {
      if (defined(&routine)) {
	printf " %s", routine($level);
      } else {
	printf " %3d", $level;
	printf " [%3d%%]", val_to_pct($level, $max) if ($enhanced);
      }
    }
    printf "\n";
  }
  
  # Now print breakpoints.
  $prev_pitch  = -9999; 
  $prev_offset = -9999;
  my($i) = 0; 
  foreach $brk (@brks) {
    $i++;
    $curr_pitch  = $brk->[0];
    $curr_offset = $brk->[1];
    $pitch_str = note_offset_to_note($curr_pitch);

    # The below logic is a mess and should be cleaned up.

    my($same) = $prev_offset == $curr_offset && $prev_pitch == $curr_pitch;
    if (nontersed( ($i > $#brks && !$same) 
		   || $prev_pitch != $curr_pitch)) {
      $might_warn = $prev_pitch > $curr_pitch;
      my($sum) = $level + $curr_offset;
      # If we've got a breakpoint that's has the same offset
      # value as the ones around it and we want a terse listing,
      # we don't have to print this one. The effect is the same
      # as whatever was around it.
      if (nontersed(($i > $#brks) || 
		    ( (($curr_offset != $prev_offset && $i != 1)
		      || $curr_offset != $brks[$i]->[1])))) {
	printf "   %2d: %-5s, ", $i, $pitch_str;
	printf "(%3d)", $curr_offset if !$terse;
	my($val) = ($sum > $max) ? $max : $sum;
	if (defined(&routine)) {
	  printf "    : %s", routine($val);
	} else {
	  printf " %3d", $val;
	  printf " [%3d%%]", val_to_pct($val, $max) if ($enhanced);
	}
	printf "\n";
	# Update prev_offset inside condition to handle ensure that if
	# we skip because $i==1)
	# on subsequent iterations print.
	$prev_offset = $curr_offset; 
      }
      if ($sum > $max) {
	warn_msg("value + offset ($sum) > max value ($max). $max used.\n")
      }
      warn_msg("this breakpoint not larger than previous one.\n")
	if $might_warn;

    }
    $prev_pitch  = $curr_pitch;
  }
}

# Covert a number in -num...+num to a degree value in -180..+180 and 
# returns this. The # of divisions ($parts) in -180..+180 is also passed.
sub phase_to_degrees {
  my($num, $parts) = @_;
  return rescale($num, $parts, 180.0);
}

# Convert a number in -num...+num to an octave -2.00 oct ... 2.00oct
# returns this. 
sub val_to_oct {
  my($num) = @_;
  my($absnum)=$num;
  my($str, $signum);
  return "invalid value: $num" 
    if $num < -128 || $num > 127;
  if ($num >= 0) {
    $absnum = 127-$num;
    $signum = ' ';
  } else {
    $absnum = 127+$num;
    $signum = '-';
  }
  my($str)=raw_val($num);
  $str  = "${str}${signum}$fmt_pitch_cvt[$absnum] oct";
  $str  = sprintf "%s [%4d]", $str, $num if $enhanced && !$terse;
  return $str;
}

# Convert a number in 0..num to a percentage 0..100% and 
# returns this. The # of divisions ($parts) in is also passed.
sub val_to_pct {
  my($num, $parts) = @_;
  return rescale($num, $parts, 100.0);
}

sub rescale {
  my($num, $parts, $max) = @_;
  return ($num * ($max / $parts));
}

# Check to see if $value is in within the bounds of array cvt_table
# (assumed lower-bound offset is 0). If not, return a formatted 
# error message specified by a supplied $errmsg with $value substituted in. 
# If in range, return a formatted message specified by $msg supplied and
# substitute in the value of the array.
sub check_cvt {
  local(*cvt_table, $value, $msg, $errmsg) = @_;
  if ($value > $#cvt_table || $value < 0) {
    return sprintf($errmsg, $value);
  } else {
    my($str)=raw_val($value);
    return sprintf($msg, "${str}$cvt_table[$value]");
  }
}

sub check_level {
  my($level) = @_;
  my($signum) = 1;
  if ($level < 0) {
    $signum = -1;
    $level = -$level;
  }
  if ($level > $#level_cvt || $value < 0) {
    return "**Illegal setting ($level)";
  } else {
    return sprintf("%5.1f", $signum*$level_cvt[$level]);
  }
}

# Convert a note offset 0..127 into a note name like C-2..G8.
sub note_offset_to_note {
  use integer;
  my($note_offset) = @_;
  my($octave) = ($note_offset / 12) - 2;
  my($note)   = ($note_offset % 12);
  return (sprintf "%-2s %2d", $scale_str[$note], $octave);
}

# Convert a Hz value into an equal-temperment note offset, where 
# note offset C-2 is 0.
sub hz_to_pitch {
  my($hz) = @_;
  my($ratio) = $hz/$c_minus_2;
  return round(log_base($ratio, $root_12_of_2));
}

# Return the log of ARG1 base ARG2.
sub log_base {
  my($num, $base) = @_;
  return log($num) / log($base);
}

# Return ARG1 rounded to the nearest integer.
sub round {
  my($num) = @_;
  return $num > 0 ? int($num+0.5) : int($num-0.5);
}

sub get_brkpts {
  local(*where, *routine, $num) = @_;
  my(@offset);
  my(@brks);
  for (1..$num) {
    $bkpt = get_unsigned_byte(*where);
    @offset = &routine(*where);
    push(@brks, [$bkpt, @offset]);
  }
  return(@brks);
}

# read/return an "fixed/keytrack" tracking value.
sub get_tracking {
  local(*address) = @_;
  debugaddr($address);
  my($tracking) = get_unsigned_byte(*address);
  if ($tracking == 0) {
    return "Fixed";
  } elsif ($tracking == 1) {
    return "KeyTrack";
  } else {
    return sprintf $unknown_str, $tracking;
  }
}

# read/return an "on/off" value.
sub get_on_off {
  local(*address) = @_;
  debugaddr($address);
  my($on_off) = get_unsigned_byte(*address);
  if ($on_off == 0) {
    return "off";
  } elsif ($on_off == 1) {
    return "on";
  } else {
    return sprintf $unknown_str, $on_off;
  }
}

# read/return an "on/off" value.
sub get_choice {
  local(*address, @choices) = @_;
  debugaddr($address);
  my($choice) = get_unsigned_byte(*address);
  if ($choice <= $#choices) {
    return $choices[$choice];
  } else {
    return sprintf $unknown_str, $choice;
  }
}

sub get_voice_mode {
    local(*where) = @_;
    my($code) = unpack("x$where H2", $buf);
    $where++;
    if ( $code == '00' ) {
	return "Single";
    } elsif ( $code == '01' ) { 
	return "Dual";
    } else {
	return "Unknown ($code)";
    }
}

sub get_tap_setting {
    local(*where) = @_;
    my($code) = get_unsigned_byte(*where);
    return check_cvt(*tap_setting_cvt, $code, "%s", $illegal_set_str);
}

sub get_key_mode {
    local(*where) = @_;
    my($type) = unpack("x$where H2", $buf);
    $where++;
    if ( $type == '00' ) {
	return 'Mono';
    } elsif ( $type == '01' ) { 
	return 'Poly';
    } elsif ( $type == '02') { 
	return 'Unison';
    } elsif ( $type == '03' && $vl1_version =~ /^Version 2/) { 
	return 'Part';
    } else {
	return "Unknown ($type)";
    }
}

# Page 28 FR VL-1 verson 2
sub get_part_setting {
  local(*where) = @_;
  # Split mode
  my($code) = unpack("x$where H2", $buf);
  $where++;
  if ( $code == '00' ) {
    $split_mode = "off";
  } elsif ( $code == '01' ) { 
    $split_mode = "Static";
  } elsif ( $code == '02' ) { 
    $split_setting =  "Dynamic";
    
  } else {
    $split_setting  = "Unknown ($code)";
  }
  
  # Split Point
  $split_point = get_signed_byte(*where);
  # Convert to C2..G8
  
  # Split Interval
  $split_interval    = get_signed_byte(*where);
  
  $Elem1_MIDI_Rch    = get_signed_byte(*where);
  $Elem2_MIDI_Rch    = get_signed_byte(*where);
  $Poly_Expand_Mode  = get_signed_byte(*where);
  $Poly_Expand_No    = get_signed_byte(*where);
  $PB_AT_MOD_Mode    = get_signed_byte(*where);
  $Polyphony_Control = get_controller(*where);
  $Sustain           = get_on_off(*where);
  $Pitch_Bend_Mode   = get_signed_byte(*where);
  
}

sub get_voices {
  my($n, $address, $len) = @_;
  my($name_len) = ($len <= 10) ? $len : 10;
  @voice_name = ();
  for (1..$n) {
    push(@voice_name, get_name($address, $name_len));
    $address += $len;
  }
  return $address;
}

sub get_dynamic_gauge_value {
  local(*where) = @_;
  my($curve, $val);
  
  @ret   = ( get_controller(*where) );
  $val   = get_signed_byte(*where);
  $curve = get_signed_16_value(*where);
  push (@ret, get_signed_127_value(*where));
  push (@ret, $curve);
  push (@ret, $val);
}

sub get_dynamic_gauge {
  local(*where) = @_;
  my($curve);
  
  @ret = ( get_controller(*where) );
  $curve = get_signed_16_value(*where);
  push (@ret, get_signed_127_value(*where));
  push (@ret, $curve);
}

sub get_name {
  my($address, $len) = @_;
  return get_str($address, $len);
}

# Read a noise value from global $buf and return this.
# Parameters : location in buf to read
# Returns    : noise name
# Side effect: location is incremented past point read
sub get_noise {
  local(*where) = @_;
  my($code) = get_unsigned_byte(*where);
  if ($code > $#noise_cvt) {
    return("**Illegal noise value: $code");
  } else {
    return($noise_cvt[$code]);
  }
}

sub get_cutoff {
  local(*where, *cvt) = @_;
  my($cutoff) = get_unsigned_byte(*where);
  return format_cutoff($cutoff, *cvt);
}

sub format_cutoff {
  local($cutoff, *cvt) = @_;
  if ($cutoff > $#cvt) {
    return( ("**Illegal cutoff value $cutoff"), -1, -1 );
  } else {
    my($hz) = $cvt[$cutoff];
    my($str) = raw_val($cutoff);
    $str .= "$cvt[$cutoff] Hz";
    if ($hz =~ /(\d+\.\d+) k/) {
      $hz = $1 * 1000;
    }
    if ($enhanced) {
      my($pitch) = note_offset_to_note(hz_to_pitch($hz));
      return( ("$str [$pitch]", $hz, $cutoff) )
    } else {
      return( ($str, $hz, $cutoff) );
    }
  }
}

sub format_hpf_cutoff_val {
  my($cutoff) = @_;
  my(@result) = format_cutoff($cutoff, *hpf_cutoff_cvt);
  return sprintf("%17s", $result[0]);
}

sub format_lpf_cutoff_val {
  my($cutoff) = @_;
  my(@result) = format_cutoff($cutoff, *lpf_cutoff_cvt);
  return sprintf("%17s", $result[0]);
}

sub format_overdrive_val {
  my($val) = @_;
  return format_cvt($val, *overdrive_cvt, 64);
}

sub format_rez {
  my($val) = @_;
  return format_cvt($val, *rez_cvt, 0);
}

sub format_tap {
  my($val) = @_;
  return format_cvt($val, *tap_cvt, 0, " secs");
}

sub format_cvt {
  local($val, *cvt, $offset, $suffix, $val_width) = @_;
  my($str) = check_cvt(*cvt, $val+$offset, "%s$suffix", "$illegal_set_str");
  if ($enhanced & !$terse) {
    my($format) = defined($val_width) ? "%${val_width}d %s" : "%d %s";
    $str = sprintf $format, $val, $str;
  }
  return $str;
}

# Read a controller value from global $buf and return this.
# Parameters : location in buf to read
# Returns    : controller name
# Side effect: location is incremented past point read
sub get_controller {
  local(*where) = @_;
  $type = unpack("x$where H2", $buf);
  $where++;
  if ( $type eq '00' ) {
    return "off";
  } elsif ( $type eq '01' ) { 
    return "Modulation wheel";
  } elsif ( $type eq '02') { 
    return "Breath Controller";
  } elsif ( $type eq '04') { 
    return "Foot Controller";
  } elsif ( $type eq '05') { 
    return "Portamento time";
  } elsif ( $type eq '07') { 
    return "Main Volume";
  } elsif ( $type eq '16') { 
    return "CS1";
  } elsif ( $type eq '17') { 
    return "CS2";
  } elsif ( $type eq '40') { 
    return "Sustain";
  } elsif ( $type eq '41') { 
    return "Portamento";
  } elsif ( $type eq '78') { 
    return "After Touch";
  } elsif ( $type eq '79') { 
    return "Pitch Bend";
  } elsif ( $type eq '7a') { 
    return "Velocity";
  } elsif ( $type eq '7b') { 
    return "Breath Attack";
  } elsif ( $type eq '7c') { 
    return "Touch EG";
  } else {
    return sprintf("%03d", eval("0x$type"));
  }
}

sub get_attack_time {
  local(*address) = @_;
  local($val) = get_signed_byte(*address);
  
  # The table below is to get around the problem of determining what
  # non-linear function is used to convert values from 0..127 to times.

  my($str) = raw_val($val);
  return sprintf("${str}%s %ssec",
		 $time_cvt[$val], $val >= 123 ? '' : 'm');
  
}

# Get a value from global $buf in the range -127..127 and return this.
# Parameters : location in buf to read
# Returns    : value in +127..127
# Side effect: location is incremented past point read
sub get_signed_127_value {
  local(*where) = @_;
  my($val) = unpack("x$where s", $buf);
  $where += 2;
  return signed_cvt($val, 127, 0x7f);
}

# Get a value from global $buf in the range -64..63 and return this.
# Parameters : location in $buf to read
# Returns    : value in -64..64
# Side effect: location is incremented past point read
sub get_signed_64_value {
  local(*where) = @_;
  return get_signed_byte_value(*where, 63, 0x3f);
}

# Get a value from global $buf in the range -32..31 and return this.
# Parameters : location in $buf to read
# Returns    : value in -32..31
# Side effect: location is incremented past point read
sub get_signed_32_value {
  local(*where) = @_;
  return get_signed_byte_value(*where, 31, 0x1f);
}

# Get a value from global $buf in the range -16..16 and return this.
# Parameters : location in buf to read
# Returns    : value in -16..+16
# Side effect: location is incremented past point read
sub get_signed_16_value {
  local(*where) = @_;
  return get_signed_byte_value(*where, 16, 0x0f);
}

# Get a value from global $buf in the range -x..y and return this.
# $mask should be a power of 2 minus 1 and <= 127.
# Parameters : location in $buf to read
# Returns    : value 
# Side effect: location is incremented past point read
sub get_signed_byte_value {
  local(*where, $max_val, $mask) = @_;
  my($val) = get_signed_byte(*where);
  return signed_cvt($val, $max_val, $mask);
}

sub signed_cvt {
  my($val, $max_val, $mask) = @_;
   $val = -((~$val&$mask)+1) if $val > $max_val;
  return $val;
}

# Get a signed byte from global $buf 
# Parameters : location in buf to read
# Returns    : value 
# Side effect: location is incremented past point read
sub get_signed_byte {
  local(*where) = @_;
  my($val) = unpack("x$where c", $buf);
  $where++;
  return $val;
}

# Get an unsigned byte from global $buf 
# Parameters : location in buf to read
# Returns    : value 
# Side effect: location is incremented past point read
sub get_unsigned_byte {
  local(*where) = @_;
  my($val) = unpack("x$where C", $buf);
  $where++;
  return $val;
}

# Get an unsigned byte from global $buf and check that it less than $upper
# Parameters : location in buf to read
# Returns    : value 
# Side effect: location is incremented past point read
sub get_unsigned_byte_range {
  local(*where, $upper) = @_;
  my($val) = unpack("x$where C", $buf);
  $where++;
  if ($val > $upper) {
    warn_msg("Read value $val is larger than valid maximum $upper.\n");
  }
  return $val;
}

# Get a value from global $buf in the range 0..255 and return this.
# Parameters : location in buf to read
# Returns    : value in 0..127
# Side effect: location is incremented 2 bytes!
sub get_unsigned_255_value {
  local(*where) = @_;
  my($val) = unpack("x$where S", $buf);
  $where += 2;
  $val -= 128 if $val > 127;
  return $val;
}

sub get_signed_255_value {
  local(*where) = @_;
  my($val) = unpack("x$where s", $buf);
  $where += 2;
  if ($val > 256) {
    $val -= 128;
  }
  $val = -((~$val&0x7f)+1) if $val > 127; 
  return $val;
}

# Get a 2-byte integer from global $buf 
# Parameters : location in buf to read
# Returns    : value 
# Side effect: location is incremented past point read
sub get_short_word {
  local(*where) = @_;
  my($val) = unpack("x$where s", $buf);
  $where += 2;
  return $val;
}

sub get_short_word_range {
  local(*where, $upper) = @_;
  my($val) = unpack("x$where s", $buf);
  $where += 2;
  if ($val > $upper) {
    warn_msg("Read value $val is larger than valid maximum $upper.\n");
  }
  return $val;
}

# Get a 4-byte integer from global $buf 
# Parameters : location in buf to read
# Returns    : value 
# Side effect: location is incremented past point read
sub get_long_word {
  local(*where) = @_;
  my($val) = unpack("x$where l", $buf);
  $where += 4;
  return $val;
}

sub get_str {
  my($where, $count) = @_;
  my($str) = unpack("x$where a$count", $buf);
  return $str;
}

# Common routine for deciding whether or not to print a 
# paramter value. 
# To be general, a bit more testing is done that is 
# absolutely necessary because we don't know if the
# parameter passed is a numeric or string value, so both are tested.
sub nontersed {
  my($parm) = @_;
  return (!$terse || ($parm && $parm ne 'off'));
}

sub raw_val {
  my($val)=@_;
  return ($debug & 2) ? "($val) " : "";
}

sub warn_msg {
  my($msg) = @_;
  return if !$warn;
  print("**** Warning: $msg");
}

sub info_msg {
  my($msg) = @_;
  return if !$warn;
  print("**** Info: $msg");
}

sub debugaddr {
  my($addr)=@_;
  printf("address: %x\n", $addr) if $debug & 1;
  printf("address: %d\n", $addr) if $debug & 4;
}

# If the "enhanced" parameter is set, return a percentage value.
sub enhanced_depth {
  my($str, $val) = @_;
  return "$str\n" if !$enhanced;
  $str = sprintf "%s [%d%%]\n", $str, val_to_pct($val, 127);
}

# If the "enhanced" parameter is set, return semitone/octave units.
# $str is string, $val is numeric value, and $need_nl indicates whether
# or not to add \n to the end.
sub enhanced_pitch {
  my($str, $val, $need_nl) = @_;
  $str = sprintf $str, $val; 
  if ($enhanced) {
    my($units);
    if (abs($val) == 1) {
      $units = 'semitone';
    } elsif (abs($val) == 12) {
      $units = sprintf 'semitones (%d octave)', $val / 12;
    } elsif (abs($val) % 12 == 0) {
      $units = sprintf 'semitones (%d octaves)', $val / 12;
    } else {
      $units = 'semitones';
    }
    $str = "$str $units";
  }
  $str .= "\n" if $need_nl;
  return $str;
}

# If the "enhanced" parameter is set, return a value in cents; $mul
# indicates the number of cents in a unit increment.
sub enhanced_cents {
  my($str, $val, $mul) = @_;
  $str = sprintf $str, $val;
  return "$str" if !$enhanced;
  $str = sprintf "%s [%2.1f cents]\n", $str, $val * $mul;
}

# If the "enhanced" parameter is set, return a percentage value.
sub enhanced {
  my($str, $val, $max) = @_;
  $str = sprintf $str, $val;
  return "$str" if !$enhanced;
  $str = sprintf "%s [%3d%%]", $str, val_to_pct($val, $max);
}

# Print a warning with $msg if $ctrl is off or there is 
# there the is no controller for $ctrl. Return 1 if we should
# stop after giving the warnings. 
sub stop_if_no_ctrl {
  my($ctrl, $msg, $print_sep) = @_;
  if ( ($ctrl eq 'off')
    || (!$all_controls && !defined($CONTROLLER{$ctrl}))) {
    if ($ctrl ne 'off') {
      warn_msg("${msg}Your instrument doesn't send this controller signal.\n");
    } else {
      warn_msg("${msg}Controller turned off.\n") if $msg;
    }
    if ($terse) {
      print $parm_separator if $print_sep;
      return 1;
    }
  }
  return 0;
}

# Does whatever's supposed to be done for a given 
# command-line argument = VL-file. 
sub process_command_args {
  foreach $vl_file (@ARGV) {
    $num_voices = read_vl1_file($vl_file);
    
    print_header($VL_ver);
    print_bank() if $num_voices > 1 && !$no_toc;
    next if $toc;  # Just wanted the table of contents.
    
    $b_address = 0x0000;
    for $voice_num (1..$num_voices) {
      $b_address += 0x0c00;
      $where = $b_address;
      next if (!$all_voices && !$show_num{$voice_num});
      print_voice(*where, $voice_num);
    }
  }
}

sub vl_init {
  $voice_separator  = '=' x 60 . "\n";
  $parm_separator   = '-' x 60 . "\n";

  # Some useful constants
  $one_voice_size   =   6144; 
  $one_bank_size    =  52224; 
  $all_bank_size    = 396288;

  $root_12_of_2 =  1.0594631;  # 12th root of 2.0; an equal-temperment semitone
  $c_minus_2    = 65.4065;     # C-2 in Hertz
  # $c_minus_4 = 16.351625; # C-4 in Hertz

  @scale_str = 
    ('C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B');
  
  $voice_name_len   = 16;
  $unknown_str      = "Unknown (%d) -- **error**\n";
  $illegal_set_str  = "**Illegal setting (%s)";

  # Could cut this table down. The bottom 64 values are the top ones
  # minus 1.
  @fmt_pitch_cvt = (
    '2.00', '1.98', '1.97', '1.95', '1.94', '1.92', '1.91', '1.89', 
    '1.88', '1.86', '1.84', '1.83', '1.80', '1.78', '1.77', '1.75', 
    '1.73', '1.72', '1.70', '1.69', '1.67', '1.66', '1.64', '1.63', 
    '1.61', '1.59', '1.58', '1.56', '1.55', '1.53', '1.52', '1.50', 
    '1.48', '1.47', '1.45', '1.44', '1.42', '1.41', '1.39', '1.38', 
    '1.36', '1.34', '1.33', '1.31', '1.30', '1.28', '1.27', '1.25', 
    '1.23', '1.22', '1.20', '1.19', '1.17', '1.16', '1.14', '1.13', 
    '1.11', '1.09', '1.08', '1.06', '1.05', '1.03', '1.02', '1.00', 
    '0.98', '0.97', '0.95', '0.94', '0.92', '0.91', '0.89', '0.88',
    '0.86', '0.84', '0.83', '0.81', '0.80', '0.78', '0.77', '0.75', 
    '0.73', '0.72', '0.70', '0.69', '0.67', '0.66', '0.64', '0.63', 
    '0.61', '0.59', '0.58', '0.56', '0.55', '0.53', '0.52', '0.50',
    '0.48', '0.47', '0.45', '0.44', '0.42', '0.41', '0.39', '0.38', 
    '0.36', '0.34', '0.33', '0.31', '0.30', '0.28', '0.27', '0.25', 
    '0.23', '0.22', '0.20', '0.19', '0.17', '0.16', '0.14', '0.13', 
    '0.11', '0.09', '0.08', '0.06', '0.05', '0.03', '0.02', '0.00');

  @lpf_cutoff_cvt = 
	          (  '31.1',  '32.7',  '34.5',   '36.3',  '38.3',  '40.4',  
		     '42.5',  '44.8',  '47.2',   '49.8',  '52.5',  '55.3',  
		     '58.2',  '61.4',  '64.7',   '68.1',  '71.8',  '75.7',
		     '79.7',  '84.0',  '88.5',   '93.3',  '98.3', '103.0', 
		     '109.0', '115.0', '121.0', '127.0', '134.0', '141.0', 
		     '149.0', '157.0', '165.0', '174.0', '184.0', '194.0',
		     '204.0', '215.0', '227.0', '239.0', '252.0', '265.0', 
		     '280.0', '295.0', '311.0', '327.0', '345.0', '363.0', 
		     '383.0', '404.0', '425.0', '448.0', '472.0', '498.0',
		     '525.0', '553.0', '583.0', '614.0', '647.0', '682.0', 
		     '718.0', '757.0', '798.0', '841.0', '886.0', '934.0', 
		     '984.0', '1.04 k','1.09 k','1.15 k','1.21 k','1.28 k',
		    '1.35 k','1.42 k','1.50 k','1.58 k','1.66 k','1.75 k',
		    '1.84 k','1.94 k','2.05 k','2.15 k','2.27 k','2.40 k',
		    '2.53 k','2.66 k','2.80 k','2.96 k','3.11 k','3.28 k',
		    '3.46 k','3.54 k','3.84 k','4.05 k','4.26 k','4.49 k',
		    '4.73 k','4.99 k','5.26 k','5.54 k','5.84 k','6.15 k',
		    '6.48 k','6.83 k','7.20 k','7.58 k','7.99 k','8.42 k',
		    '8.87 k','9.35 k','9.85 k','10.4 k','10.9 k','11.5 k',
		    '12.2 k','12.8 k','13.5 k','14.2 k','15.0 k','15.8 k',
		    '16.6 k','17.5 k','18.5 k','19.5 k','20.5 k','21.6 k',
		    '22.8 k','24.0 k',
		   );

  @hpf_cutoff_cvt = (  
		    '17.0',  '17.7',  '18.7',  '19.4',  '20.3',  '21.2',  
		    '22.4',  '23.3',  '24.5',  '25.7',  '26.9',  '28.3',  
		    '29.4',  '30.8',  '32.5',  '33.9',  '35.5',  '37.2',
		    '39.0',  '40.9',  '42.8',  '44.7',  '47.0',  '40.1', 
		    '51.5',  '53.8',  '56.4',  '59.2',  '61.8',  '64.9', 
		    '67.9',  '71.2',  '74.5',  '78.0',  '81.8',  '85.6',
		    '89.6',  '94.1',  '98.3', '103.0', '108.0', '113.0', 
		   '118.0', '124.0', '130.0', '136.0', '142.0', '149.0', 
		   '156.0', '164.0', '171.0', '179.0', '188.0', '197.0',
		   '207.0', '217.0', '227.0', '238.0', '249.0', '261.0', 
		   '274.0', '287.0', '301.0', '315.0', '330.0', '346.0', 
		   '363.0', '381.0', '399.0', '419.0', '439.0', '460.0',
		   '483.0', '506.0', '531.0', '557.0', '584.0', '613.0',
		   '643.0', '674.0', '708.0', '743.0', '780.0', '818.0',
		   '859.0', '902.0', '948.0', '995.0','1.05 k','1.10 k',
		   '1.16 k','1.21 k','1.28 k','1.34 k','1.41 k','1.48 k',
		   '1.56 k','1.64 k','1.73 k','1.82 k','1.92 k','2.02 k',
		   '2.13 k','2.25 k','2.38 k','2.51 k','2.65 k','2.80 k',
		   '2.96 k','3.13 k','3.32 k','3.52 k','3.73 k','3.96 k',
		   '4.21 k','4.48 k','4.77 k','5.09 k','5.44 k','5.82 k',
		   '6.24 k','6.71 k','7.24 k','7.83 k','8.50 k','9.27 k',
		   '10.2 k','11.2 k',
		   );
}

1;