#!/usr/bin/perl

# Sysexy MIDI Librarian:
# The sexy sysex librarian that Linux needs.
#
# Author:
# Brent Busby <brent@keycorner.org>
#
# Sysexy is in large part based on Yamaha RM50 Manager by
# LinuxTECH.NET, but rewritten as a general purpose sysex librarian
# rather than a device-specialized editor for the RM50.  Thanks to
# LinuxTECH.NET for creating an application using both PERL/TK and
# MIDI::ALSA in the same program, which gives me something to
# shamelessly plagiarize.  ;)  Also, thanks to Peter Billam for
# MIDI::ALSA itself.
#
# License:
# This program is free software: you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# version 2 as published by the Free Software Foundation.
#
# 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, see <http://www.gnu.org/licenses/>.

# Modules:
require 5.14.0;
use warnings;
use strict 'vars';
use Cwd;
use Tk;
use Tk::DialogBox;
use Tk::BrowseEntry;
use Tk::ProgressBar;
use Config::Simple;
use Data::Dumper;
use Storable                'dclone';
use List::MoreUtils         'first_index';
use File::Path              'make_path';
use File::Spec::Functions   qw/rel2abs splitpath/;
use IO::Compress::Bzip2     qw/bzip2   $Bzip2Error/;
use IO::Uncompress::Bunzip2 qw/bunzip2 $Bunzip2Error/;
use MIDI::ALSA qw(SND_SEQ_EVENT_PORT_UNSUBSCRIBED
    SND_SEQ_EVENT_SYSEX SND_SEQ_EVENT_CONTROLLER
    SND_SEQ_EVENT_PGMCHANGE SND_SEQ_QUEUE_DIRECT);

# Variables:
my $version      = '0.8.8';
my $reltag       = 'I Hear Drums';
my $relyear      = 2026;
my $savecfg      = 0;
my $f7total      = 1;
my $f7seen       = 0;
my $message      = '';
my $dialogstatus = '';
my $filetype     = '';
my $wanttype     = '';
my $cfgdir       = "$ENV{'HOME'}/.config/sysexy";
my $cfgfile      = "$cfgdir/sysexyrc";
my $listboxWidth = 50;
my $dialogClr    = 'AntiqueWhite3';
my $btnDumpClr   = 'gray20';
my $btnNormClr   = 'LemonChiffon4';
my $btnDmpActClr = '#3d0e2c';
my $btnBusyClr   = 'firebrick1';
my $chanClr      = 'LightBlue';
my $offClr       = 'gray30';
my $LCDclr       = 'PaleGreen4';
my $errClr       = 'pink4';
my $txtfieldFont = '-adobe-times-medium-r-normal--14-*-iso8859-1';
my $wizardFont   = '-misc-fixed-medium-r-normal--14-*-iso8859-1';
my $bigtimesFont = '-adobe-times-medium-r-normal--24-*-iso8859-1';
my $boldFont     = '-adobe-helvetica-bold-r-normal--14-*-iso8859-1';
my $listboxFont  = '-misc-fixed-medium-r-normal--14-*-iso8859-1';
my $labelFont    = '-misc-fixed-medium-r-*-11-*-iso8859-1';
my $requestFont  = '-adobe-times-medium-r-normal-*-14-*-iso8859-1';
my $msgFont      = '-adobe-courier-medium-r-normal--11-*-iso8859-1';
my $entryFont    = '-adobe-courier-medium-r-normal--18-*-iso8859-1';
my $smallFont    = '-adobe-helvetica-medium-r-normal--10-*-iso8859-1';
my $adviceFnt    = '-misc-fixed-medium-r-normal--13-*-iso8859-1';
my $drpdnLgtFnt  = '-misc-fixed-bold-r-normal--13-*-iso8859-1';
my $drpdownFont  = 'Helvetica -12 bold';
my $filexts      = [ ['Sysex dumps', ['.syx', '.SYX']],
		     ['All files',    '*'], ];
my ($rxwin, $txwin, $reqbutton, $handler, $watchdog, $dumpsize, $devDrpdown,
    $typeDrpdown, $retryDrpdwn, $dropdwnMidiPort, $dropdwnMidiChan, $vfyDrpdwn,
    $spinPgm, $btnPgm, $txprogwin, $txprogbar, $dlgStatWin, $dbmod, $wizFrame,
    $wizText, $wizEntry, $wizSpinbox, $entrytext, $wizDrpdwn, $wizAdvice,
    $question, $testedBtns1, $testedBtns2, $adviceBtn, $icon, @machines,
    @alsaevent, @syxfrags, @sysexfiles, @sysexdisp, @types, @pseudobank,
    %disptbl, %devspecs, %devdb, %editdb, %typemap);

# Config files are such a chore, but PERL has object-oriented modules to do
# just about anything for you.  Drag me, drop me, treat me like an object.
my $cfg = new Config::Simple(syntax=>'ini');
$cfg->read("$cfgfile") if -r "$cfgfile";

# Due to an unfortunate side effect of PERL autovivification, using
# param() to look for settings in config file blocks that aren't there
# makes an empty block exist automatically, which then crashes
# Config::Simple when the program loads on the next run, because it
# doesn't like empty blocks.  So we create a hash here, which is safe
# to examine without making things spring into being just because we
# looked at them.
my %cfghash = $cfg->vars();

# Working directory is either supplied on command line, retrieved from a
# parameter in config file, or whatever folder we're in, if none of those.
my $keepdir           =  '';
my $datadir           = cwd;
if ($ARGV[0]) {
    $datadir          = rel2abs($ARGV[0]);
} elsif ($cfg->param('main.datadir')) {
    $datadir          = $cfg->param('main.datadir');
}

# We're PERL.  We're MIDI.  We're PERL that can talk to MIDI.
MIDI::ALSA::client("Sysexy",1,1,1);
MIDI::ALSA::start();
my @midi_outports     = MidiPortList('out');
my @midi_inports      = MidiPortList('in');
my $midi_outport_prev =        '';
my $midi_inport_prev  =        '';
my $midi_outport      =        '';
my $midi_inport       =        '';
my $midichan          =         1;
my $dumpcmd           =        '';
my $pgmnum            =         0;
my $pmax              =         0;
my $pbyte             =         0;
my $pseudo            =         0;
my $preferpseudo      =    'none';
my $pbanksize         =         0;
my $sysex_dump        =        '';
my $rx_check          =        '';
my $tx_check          =        '';
my $binsize           =         0;
my $sentsize          =         0;
my $percent           =         0;
my $fragsent          =        -1;
my $fragsize          =       256;
my $rxwait            =         1;
my $txwait            =        50;
my $stallwait         =      4000;
my $longwait          =      1750;
my $shortwait         =        50;
my $msgwait           = $longwait;
my $verify            =   'Never';
my $retries           =         0;
my $rx_retry          =        -1;
my $rx_rnlvl          =        -1;
my $tx_retry          =         0;
my $tx_retries        =         0;
my $tx_rnlvl          =        -1;

#  Load the gear database:
my $genericdev        =        'Generic MIDI Device';
{
    my $loaddb;
    bunzip2 "$cfgdir/geardb" => \$loaddb
	or die "FATAL: Load gear database failed: $Bunzip2Error\n";
    eval $loaddb or die "FATAL: Cannot parse gear database.";
}
# Load last used MIDI machine from config file if possible,
# but only if there's a machine in our database by that name.
# Otherwise, last used MIDI device defaults to Generic/Unknown.
my $lastdev = $genericdev;
$lastdev    = $cfg->param('main.lastdev') if
    ($cfg->param('main.lastdev') and
     exists $devspecs{$cfg->param('main.lastdev')});

# Create the machine-optimized version of the database:
&gendb;


#  Main program       #
#  Initial GUI setup: #

my $mw = MainWindow->new(
    -title            => 'Sysexy MIDI Librarian',
    -background       => 'gray30');

my $topCtrls = $mw->Frame(
    -borderwidth      => 1,
    -background       => 'SlateGray4',
    -relief           => 'raised')->grid(
    -sticky           => 'nsew');

my $dirdisplay = $topCtrls->Label(
    -relief           => 'sunken',
    -borderwidth      => 6,
    -width            => $listboxWidth,
    -font             => $txtfieldFont,
    -foreground       => 'white',
    -background       => '#06345b',
    -textvariable     => \$datadir)->grid(
    -row              => 0,
    -column           => 0,
    -columnspan       => 3,
    -padx             => 2,
    -pady             => 2);

my $brwsBitmap = $topCtrls->Bitmap(
    -data             => &browsebtn,
    -background       => 'gray10',
    -foreground       => 'white');
my $brwsButton = $topCtrls->Button(
    -relief           => 'groove',
    -background       => 'SkyBlue2',
    -image            => $brwsBitmap,
    -command          => \&changeFldr)->grid(
    -row              => 0,
    -column           => 3);

my $lb = $mw->Scrolled('Listbox',
    -background       => 'black',
    -foreground       => 'cyan',
    -font             => $listboxFont,
    -width            => $listboxWidth,
    -height           => 28,
    -selectbackground => 'IndianRed4',
    -selectforeground => 'white',
    -takefocus        => 1,
    -scrollbars       => 'osoe')->grid(
    -row              => 1,
    -column           => 0);
#  Load the scrolling list with sysex filenames, if the
#  folder we're in when the program starts has any in it.
loadlb();

my $btmCtrls = $mw->Frame(
    -borderwidth      => 1,
    -background       => 'gray30',
    -relief           => 'raised')->grid(
    -row              => 2,
    -column           => 0,
    -sticky           => 'we');
$btmCtrls->gridColumnconfigure(5, -weight => 1);

my $aboutBtn = $btmCtrls->Button(
    -text             => 'About',
    -relief           => 'groove',
    -foreground       => 'gray70',
    -background       => 'gray20',
    -activebackground => 'gray',
    -activeforeground => 'black',
    -font             => $smallFont,
    -command          => \&About)->grid(
    -sticky           => 'ns',
    -row              => 0,
    -column           => 0);

my $editBtn = $btmCtrls->Button(
    -text             => 'DBEdit',
    -relief           => 'groove',
    -background       => '#18000c',
    -foreground       => 'gray70',
    -activebackground => 'red',
    -activeforeground => 'black',
    -font             => $smallFont,
    -command          => \&dbedit)->grid(
    -sticky           => 'ns',
    -row              => 0,
    -column           => 1);

my $txbtn = $btmCtrls->Button(
    -text             => 'Tx',
    -relief           => 'groove',
    -foreground       => 'black',
    -background       => $btnNormClr,
    -activebackground => 'yellow',
    -activeforeground => 'black',
    -command          => \&transmit)->grid(
    -sticky           => 'ns',
    -row              => 0,
    -column           => 2);

my $rxbtn = $btmCtrls->Button(
    -text             => 'Rx',
    -relief           => 'groove',
    -foreground       => 'black',
    -background       => $btnNormClr,
    -activebackground => 'yellow',
    -activeforeground => 'black',
    -command          => \&receive)->grid(
    -sticky           => 'ns',
    -row              => 0,
    -column           => 3);

$btmCtrls->Button(
    -text             => 'Quit',
    -relief           => 'groove',
    -foreground       => 'white',
    -background       => 'IndianRed4',
    -activebackground => 'red',
    -activeforeground => 'white',
    -command          => \&progquit)->grid(
    -sticky           => 'ns',
    -row              => 0,
    -column           => 4);

my $msgarea = $btmCtrls->Label(
    -background       => 'black',
    -foreground       => 'green',
    -relief           => 'sunken',
    -borderwidth      => 6,
    -anchor           => 'w',
    -font             => $msgFont,
    -textvariable     => \$message)->grid(
    -sticky           => 'nsew',
    -row              => 0,
    -column           => 5);

# Catch users pressing the window close button, and keep user
# from resizing window because we aren't handling that.
$mw->resizable(0,0);
$mw->protocol(WM_DELETE_WINDOW   => \&progquit);

# Keyboard bindings:
$mw->bind($mw, "<Control-r>"     => \&receive );
$mw->bind($mw, "<Control-t>"     => \&transmit);
$mw->bind($mw, "<Control-q>"     => \&progquit);
# Easy transmit:
$mw->bind($mw, "<Key-Return>"    => \&transmit);
$mw->bind($mw, "<KP_Enter>"      => \&transmit);

# Program icon:
if ($icon = $mw->Pixmap(-file => "$cfgdir/sysexy.xpm")) {
    $mw->iconimage($icon);
}

# PERL/TK's deep GUI magic takes it from here, providing UI monitoring
# so you don't have to scan mouse and keyboard somehow yourself.
MainLoop;


# SUBROUTINES/FUNCTIONS:

sub gendb {
    # An array with all the machine names is useful for pulldown menus.
    @machines = sort keys %devspecs;
    #
    # Here we build %devdb, a machine-optimized version of %devspecs,
    # using filesize as top-of-hierarchy to speed searches, since that
    # attribute is fairly unique to each kind of dump, and can be seen in
    # directory listings without having to even read the file.
    foreach my $machine (keys %devspecs) {
	foreach my $dumptype (keys %{$devspecs{$machine}}) {
	    foreach my $field (keys %{$devspecs{$machine}{$dumptype}}) {
		# %devdb is created with %devspecs' filesize field as its
		# top-of-hierarchy.  When we get to populating the bottom,
		# filesize is skipped since we already did that one at the top.
		$devdb{$devspecs{$machine}{$dumptype}{size}}{$machine}{$dumptype}{$field} =
		    $devspecs{$machine}{$dumptype}{$field} unless $field eq 'size';
	    }
	}
    }
}
sub MidiPortList {
    my $dir     = $_[0];
    my @portlist;
    my %clients = MIDI::ALSA::listclients();
    my %portnrs = MIDI::ALSA::listnumports();
    my $tmp     = 0;
    while (my ($key, $value) = each(%clients)){
	if ($key > 15 && $key < 128) {
	    for (my $i = 0; $i < ($portnrs{$key}); $i++) {
		$portlist[$tmp] = $value . ":" . $i;
		$tmp++;
	    }
	}
    }
    return sort @portlist;
}
sub MidiConSetup {
    my $dir = $_[0];
    MIDI::ALSA::stop();
    if ($dir eq 'out') {
	if ($midi_outport_prev ne '') {
	    MIDI::ALSA::disconnectto(1, "$midi_outport_prev");
	}
	$midi_outport_prev = $midi_outport;
	MIDI::ALSA::connectto(1, "$midi_outport");
    } elsif ($dir eq 'in') {
	if ($midi_inport_prev ne '') {
	    MIDI::ALSA::disconnectfrom(0, "$midi_inport_prev");
	}
	$midi_inport_prev = $midi_inport;
	MIDI::ALSA::connectfrom(0, "$midi_inport");
    }
    MIDI::ALSA::start();
}
sub changeFldr {
    my $folder   = $mw->chooseDirectory(
	-initialdir => $datadir);
    if ($folder) {
	$savecfg = 1;
	$datadir = $folder;
	loadlb();
    }
}
sub loadlb {
    chdir $datadir;
    @sysexfiles = glob qq("*.syx" "*.SYX");
    my $index   = $_[0] ? first_index {$_ eq "$_[0]"} @sysexfiles : 0;
    s/\.syx$//i for @sysexdisp = @sysexfiles;
    $lb->delete(0, 'end');
    $lb->insert('end', @sysexdisp);
    $lb->focus;
    $lb->see($index);
    $lb->activate($index);
    $lb->selectionSet($index);
    $lb->bind('<<ListboxSelect>>' => \&idFileType);
    if (scalar @sysexfiles) {
	&idFileType;
    } else {
	$message = 'Choose a folder.';
    }
}
sub idFileType {
    return unless $lb->curselection;
    my $selFile = $sysexfiles[$lb->curselection->[0]];
    my $selSize = -s $selFile;
    my ($foundmult, $foundpseudo);
    foreach my $dbFileSize (keys %devdb) {
	if ($dbFileSize != 0 and ($dbFileSize == $selSize or
				  $selSize > $dbFileSize and $selSize % $dbFileSize == 0)) {
	    $foundmult   = $dbFileSize != $selSize ? 1 : 0;
	    open my $fh, '<:raw', $selFile;
	    foreach my $machine (keys %{$devdb{$dbFileSize}}) {
		foreach my $dumptype (keys %{$devdb{$dbFileSize}{$machine}}) {
		    if ($devdb{$dbFileSize}{$machine}{$dumptype}{header}) {
			read $fh, my $hdrChk, $devdb{$dbFileSize}{$machine}{$dumptype}{hdrlen};
			# Raw binary regex check of header against database ("/saa"):
			if ($hdrChk =~ /$devdb{$dbFileSize}{$machine}{$dumptype}{header}/saa) {
			    # Display the verified filetype in the message window immediately,
			    # and also store in $filetype for use elsewhere in the program.
			    $dumpcmd         = $devdb{$dbFileSize}{$machine}{$dumptype}{dumpcmd};
			    if (not $foundmult) {
				$message     = $filetype = $devdb{$dbFileSize}{$machine}{$dumptype}{tag};
				return;
			    } elsif ($dumptype eq 'Patch' and $devdb{$dbFileSize}{$machine}{Patch}{pbyte}) {
				$message     = $filetype = $devdb{$dbFileSize}{$machine}{Patch}{tag} =~ s/\S*?\z/pseudo/r;
				$foundpseudo = 1;
			    }
			}
		    }
		}
	    }
	    close $fh;
	}
    }
    return if $foundpseudo;
    # Checking by filesize failed above, so we do a second pass now
    # checking for header signatures of dumps known to have variable
    # size, which are in the database with size "0".  Since we can't
    # use filesize as a cheat anymore, at this point, filehandle open
    # is unavoidable to check headers.
    open my $fh, '<:raw', $selFile;
    foreach my $machine (keys %{$devdb{0}}) {
	next if $machine eq $genericdev;
	foreach my $dumptype (keys %{$devdb{0}{$machine}}) {
	    if ($devdb{0}{$machine}{$dumptype}{header}) {
		read $fh, my $hdrChk, $devdb{0}{$machine}{$dumptype}{hdrlen};
		if ($hdrChk =~ /$devdb{'0'}{$machine}{$dumptype}{header}/saa) {
		    $message = $filetype = $devdb{0}{$machine}{$dumptype}{tag};
		    $dumpcmd = $devdb{0}{$machine}{$dumptype}{dumpcmd};
		    return;
		}
	    }
	}
    }
    close $fh;
    #
    # I suppose we don't know what kind of file this is then.
    $message = $filetype = 'Generic/Unknown';
    $dumpcmd = '';
}
sub whatfrom {
    # This function does a reverse lookup on %devspecs to get
    # the machine and dump type from the current $filetype.
    # We presume there are no duplicates (so make the GUI
    # that edits the hardware database ensure there aren't.)

    if ($filetype eq 'Generic/Unknown') {
	$lastdev  = $genericdev;
	$wanttype = 'Generic auto';
	return;
    } else {
	my ($realtag, $fixedtag);
	foreach my $machine (keys %devspecs) {
	    next if $machine eq $genericdev;
	    foreach my $dumptype (keys %{$devspecs{$machine}}) {
		$realtag         = $devspecs{$machine}{$dumptype}{tag};
		$fixedtag        = $realtag =~ s/patch\z/pseudo/r;
		if ($filetype  eq $realtag or
		    ($filetype eq $fixedtag and $filetype =~ /pseudo\z/)) {
		    $lastdev     = $machine;
		    $wanttype    = $dumptype;
		    # Be very, very careful about not auto-vivifying database elements!
		    # Use ref() to see where you're going before you try to go there!
		    if (($preferpseudo ne 'none' or $filetype =~ /pseudo\z/) and
			($dumptype eq 'Patch' or $dumptype eq 'Bank') and
			ref $devspecs{$machine}{Patch} eq 'HASH' and
			$devspecs{$machine}{Patch}{pbyte}) {
			$msgwait = $shortwait if $devspecs{$machine}{Patch}{size} < 4096;
			$pseudo  = 1;
		    } else {
			$msgwait = $longwait;
			$pseudo  = 0;
		    }
		    return;
		}
	    }
	}
    }
}
sub browsetypes {
    my $rxtx                                  = $_[0];
    $wanttype                                 = ''
	if $rxtx eq 'rx';
    %typemap                                  = ();
    unless ($lastdev eq $genericdev) {
	@types                                = ();
	foreach my $t (keys %{$devspecs{$lastdev}}) {
	    push @types, $t;
	    $typemap{$t}                      = $t;
	    $wanttype                         = 'Bank'
		if $t eq 'Bank' and $rxtx eq 'rx' and not $wanttype;
	    if ($t eq 'Patch' and $devspecs{$lastdev}{Patch}{pbyte}) {
		push @types, 'Pseudobank folder', 'Pseudobank file';
		$typemap{'Pseudobank folder'} = 'Patch';
		$typemap{'Pseudobank file'}   = 'Patch';
		if ($rxtx eq 'rx') {
		    if ($preferpseudo eq 'file') {
			$wanttype             = 'Pseudobank file';
			$pseudo               = 1;
		    } elsif ($preferpseudo eq 'folder') {
			$wanttype             = 'Pseudobank folder';
			$pseudo               = 1;
		    } else {
			$pseudo               = 0;
		    }
		}
	    }
	}
	@types                                = sort @types;
	$wanttype                             = $types[0]
	    unless $rxtx eq 'tx' or $wanttype =~ /^Bank$|Pseudobank/;
    } else {
	@types                                = ('Generic manual',
						 'Generic auto');
	$typemap{'Generic manual'}            =  'Generic manual';
	$typemap{'Generic auto'}              =  'Generic auto';
	$wanttype                             =  $types[0] if $rxtx eq 'rx';
    }
}
sub initports {
    # If the last used MIDI machine wasn't a generic we don't keep
    # info for, set our ALSA IN/OUT ports and MIDI channel to whatever
    # we last used with it.
    #
    # We test existence with the %cfghash instead of the $cfg->param()
    # object itself, because Config::Simple makes block sections in
    # the config file spring into existence even if you just read them
    # without writing (how annoying).
    if ($lastdev ne $genericdev) {
	$midi_outport = $cfg->param("$lastdev.outport") if
	    $cfghash{"$lastdev.outport"};
	$midi_inport  = $cfg->param("$lastdev.inport") if
	    $cfghash{"$lastdev.inport"};
	$midichan     = $cfg->param("$lastdev.midichan") if
	    $cfghash{"$lastdev.midichan"};
	$fragsize     = $cfg->param("$lastdev.fragsize") if
	    $cfghash{"$lastdev.fragsize"};
	$txwait       = $cfg->param("$lastdev.txwait") if
	    $cfghash{"$lastdev.txwait"};
	$verify       = $cfg->param("$lastdev.verify") if
	    $cfghash{"$lastdev.verify"};
	$retries      = $cfg->param("$lastdev.retries") if
	    $cfghash{"$lastdev.retries"};
	$preferpseudo = $cfg->param("$lastdev.pseudo") if
	    $cfghash{"$lastdev.pseudo"};
    }
    # If that leaves us still with no MIDI ports, whether it's
    # a generic device or not, we'd better get some MIDI ports.
    # And if this machine doesn't have any, what were you
    # planning to do with a sysex librarian anyway?
    if ((! $midi_outport or ! $midi_inport) and scalar @midi_outports) {
	$midi_outport = $midi_outports[0];
	$midi_inport  = $midi_inports[0];
    } elsif (! scalar @midi_outports) {
	return 0;
    }
    # Setup ALSA MIDI connections to whatever we found.
    MidiConSetup('out');
    MidiConSetup('in');
    return 1;
}
sub alltoggle {
    if ($_[0]) {
	$devDrpdown->configure(     -disabledforeground => $chanClr,
						 -state => 'readonly');
	$typeDrpdown->configure(    -disabledforeground => $chanClr,
						 -state => 'readonly');
	$dropdwnMidiPort->configure(-disabledforeground => $chanClr,
						 -state => 'readonly');
	$vfyDrpdwn->configure(      -disabledforeground => $chanClr,
						 -state => 'readonly');
	needchan('rx');
	needretrylite();
	needpatch(1);
    } else {
	$devDrpdown->configure(     -disabledforeground => $offClr,
						 -state => 'disabled');
	$typeDrpdown->configure(    -disabledforeground => $offClr,
						 -state => 'disabled');
	$dropdwnMidiPort->configure(-disabledforeground => $offClr,
						 -state => 'disabled');
	$dropdwnMidiChan->configure(             -state => 'disabled');
	$vfyDrpdwn->configure(      -disabledforeground => $offClr,
						 -state => 'disabled');
	$retryDrpdwn->configure(                 -state => 'disabled');
	$spinPgm->configure(                     -state => 'disabled');
	$btnPgm->configure(                      -state => 'disabled');
    }
}
sub needchan {
    my $rxtx = $_[0];
    if ($lastdev ne $genericdev and
	($devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd} =~ /n|cc/ or
	 ($rxtx eq 'tx' and
	  $devspecs{$lastdev}{$typemap{$wanttype}}{header} =~ /\Q[\xB0-\xBF]\E/)
	 or
	 (not $pseudo and $wanttype eq 'Patch' and
	  $devspecs{$lastdev}{Patch}{pbyte}))) {
	$dropdwnMidiChan->configure(
	    -state              => 'readonly',
	    -disabledforeground => $chanClr);
	# Synths which embed their MIDI channel in the high nybble cannot have
	# a MIDI channel higher than 8.  There's some weird hardware out there,
	# so we take care of this here just in case there is such a thing.
	# The Oberheim OB-8 can only use channels 1-8, though it doesn't do
	# any sysex channel embedding, so it's not quite a real life case of
	# this situation.  Still, just in case there is gear that does this:
	if (index($devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd} =~
		  tr/ //dr, 'n') % 2 == 0) {
	    $dropdwnMidiChan->configure(
		-choices        => [1..8],
		-listheight     => 8);
	    $midichan = 0 if $midichan > 7;
	} else {
	    $dropdwnMidiChan->configure(
		-choices        => [1..16],
		-listheight     => 16);
	}
	return 1;
    } else {
	$dropdwnMidiChan->configure(
	    -disabledforeground => $offClr,
	    -state              => 'disabled');
	return 0;
    }
}
sub needpatch {
    my $gui = $_[0];

    # Be very, very careful about not auto-vivifying database elements!
    # Use ref() to see where you're going before you try to go there!
    $pbyte  = (ref     $devspecs{$lastdev}{Patch} eq 'HASH') ?
		       $devspecs{$lastdev}{Patch}{pbyte} : 0;

    $pmax   = $pbyte ? $devspecs{$lastdev}{Patch}{pmax}  : 0;

    #  Is it appropriate for the Pseudobank button to be usable?
    if ($pseudo and $pbyte and
	($typemap{$wanttype} eq 'Patch' or $typemap{$wanttype} eq 'Bank')) {
	$msgwait            = $devspecs{$lastdev}{Patch}{size} < 4096 ?
			      $shortwait : $longwait;
	$typemap{$wanttype} = 'Patch';
    } else {
	$typemap{$wanttype} = 'Bank' if $wanttype eq 'Bank';
	$msgwait            = $longwait;
	$pseudo             = 0;
    }
    if ($pbyte and $typemap{$wanttype} eq 'Patch') {
	# We're using this function to manipulate widgets if $gui is true.
	# Otherwise, we're calling the function just to see if the above
	# conditional test passes or not and return the answer.
	if ($gui) {
	    if ($wanttype eq 'Patch' and not $pseudo) {
		$spinPgm->configure(
		    -state => 'normal',
		    -to    => $pmax);
		$btnPgm->configure(-state  => 'normal');
	    } else {
		$spinPgm->configure(-state => 'disabled');
		$btnPgm->configure(-state  => 'disabled');
	    }
	}
	return 1;
    } else {
	if ($gui) {
	    $spinPgm->configure(-state     => 'disabled');
	    $btnPgm->configure(-state      => 'disabled');
	}
	return 0;
    }
}
sub needretry {
    my $rxtx = $_[0];
    if ($lastdev ne $genericdev) {
	$verify  = $cfg->param("$lastdev.verify") if
	    $cfghash{"$lastdev.verify"};
	$retries = $cfg->param("$lastdev.retries") if
	    $cfghash{"$lastdev.retries"};
    }
    if ($wanttype eq 'Generic manual') {
	$vfyDrpdwn->configure(-disabledforeground => $offClr,
			      -state              => 'disabled');
    } else {
	$vfyDrpdwn->configure(-disabledforeground => $chanClr,
			      -state              => 'readonly');
    }
    if ($wanttype ne 'Generic manual' and
	($verify eq 'Always' or
	 $rxtx eq 'rx' and $verify eq 'Receive')) {
	$retryDrpdwn->configure(-state => 'normal');
	$retries = 1 if $retries < 1;
	return 1;
    } else {
	$retryDrpdwn->configure(-state => 'disabled');
	return 0;
    }
}
sub needretrylite {
    if ($verify eq 'Never') {
	$retryDrpdwn->configure(-state => 'disabled');
    } else {
	$retryDrpdwn->configure(-state => 'normal');
	$retries = 1 if $retries < 1;
    }
}
sub needadvice {
    if ($lastdev ne $genericdev and
	$devspecs{$lastdev}{$typemap{$wanttype}}{advice}) {
	$adviceBtn->configure(-state => 'normal');
    } else {
	$adviceBtn->configure(-state => 'disabled');
    }
}
sub giveadvice {
    my $advicewin = $mw->DialogBox(
	-title                   => "$lastdev advice",
	-buttons                 => [ 'Ok' ],
	-default_button          => 'Ok',
	-bg                      => 'SteelBlue4',
	-fg                      => 'black');
    $advicewin->resizable(0,0);
    my $textbox = $advicewin->Scrolled('Text',
	-scrollbars              => 'oe',
	-height                  => 20,
	-wrap                    => 'word',
	-font                    => $adviceFnt,
	-background              => $dialogClr,
	-foreground              => 'black',
	-relief                  => 'sunken',
	-borderwidth             => 4,
	-insertbackground        => 'black')->grid(
	-sticky                  => 'we');
    $textbox->Subwidget('yscrollbar')->configure(-background => 'black');
    $textbox->insert('end', $devspecs{$lastdev}{$typemap{$wanttype}}{advice});
    $textbox->bindtags(undef);
    $advicewin->Show(
	-popover                 => $mw,
	-overanchor              => 'c',
	-popanchor               => 'c');
}
sub channelize {
    my $chNybblePos   = index($dumpcmd =~ tr/ //dr, 'n');
    if ($chNybblePos != -1) {
	$chNybblePos  = $chNybblePos - 2;
	my $filler    = $chNybblePos % 2 == 0 ? qr/./ : '';
	my $chanhex   = sprintf("%x", $midichan - 1);
	my $rawhex    = unpack 'H*', $sysex_dump;
	my $bakedhex  = $rawhex =~ s/\G(?:..)*?\K(f0(?:.){$chNybblePos}).($filler)/$1$chanhex$2/gr;
	$sysex_dump   = pack 'H*', $bakedhex;
    }
}
sub pgmchg {
    {
	if ($pgmnum =~ /^\d+\.\d+\z/) {
	    $pgmnum = int($pgmnum);
	    last;
	}
	if ($pgmnum =~ /\D/) {
	    $pgmnum = 0;
	    last;
	}
	$pgmnum     = $pmax if $pgmnum > $pmax;
	$pgmnum     = 0 if $pgmnum < 0;
    }
    MIDI::ALSA::output( MIDI::ALSA::pgmchangeevent( $midichan - 1, $pgmnum ) );
}
sub verify {
    my $vfyon                = ($wanttype ne 'Generic manual' and
				($verify eq 'Always' or
				 $tx_rnlvl == -1 and
				 $verify eq 'Receive')) ? 1 : 0;
    if ($lastdev ne $genericdev) {
	if ($dumpsize        == $devspecs{$lastdev}{$typemap{$wanttype}}{size} or
	    $devspecs{$lastdev}{$typemap{$wanttype}}{size} == 0) {
	    my $hdr          = qr/$devspecs{$lastdev}{$typemap{$wanttype}}{header}/saa;
	    if ($sysex_dump  =~ /^$hdr/saa) {
		my $prefix;
		if ($pseudo) {
		    $prefix  = "PSEUDO (p$pgmnum): ";
		    $message = "(p$pgmnum)";
		} else {
		    $prefix  = "";
		}
		return vfycmpr($vfyon, "${prefix}Verified valid $devspecs{$lastdev}{$typemap{$wanttype}}{tag}!",
			       "${prefix}Verified $devspecs{$lastdev}{$typemap{$wanttype}}{tag} after $rx_retry tries!",
			       "${prefix}Received valid $devspecs{$lastdev}{$typemap{$wanttype}}{tag}!");
	    } else {
		return vfymeta($vfyon, "Unrecognized sysex, retrying ($rx_retry)...",
			       "Unrecognizable after $rx_retry tries!",
			       "Unrecognizable dump -- what is it?");
		$message     = "(p$pgmnum)" if $pseudo;
	    }
	} else {
	    return vfymeta($vfyon, "Got wrong size dump, retrying ($rx_retry)...",
			   "Got wrong size dump after $rx_retry tries!",
			   "Got wrong size dump, likely corrupt!");
	    $message         = "(p$pgmnum)" if $pseudo;
	}
    } else {
	return vfycmpr($vfyon, "Verified $dumpsize byte sysex dump!",
		       "Verified dump after $rx_retry tries!",
		       "Received $dumpsize byte sysex dump!");
    }
}
sub passfail {
    my ($msg,   $pass ) = @_;
    my ($bgclr, $fgclr) = $pass ? ($LCDclr, 'black') : ($errClr, 'white');
    $handler->cancel;
    $dlgStatWin->configure(
	-background     => $bgclr,
	-foreground     => $fgclr);
    $dialogstatus       = $msg;
    $message            = "(p$pgmnum)" if $pseudo;
    $rxwin->Subwidget('B_Done')->configure(-state => 'normal') if $pass;
}
sub runagain {
    $sysex_dump         = '';
    $rx_rnlvl           = 1;
    $dialogstatus       = $_[0];
    $message            = "(p$pgmnum)" if $pseudo;
    $handler->time($msgwait);
}
sub loadpseudo {
    if ($pseudo) {
	unless ($devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd}) {
	    $pgmnum          = ord(substr($sysex_dump, $pbyte, 1));
	    $rxwin->Subwidget('B_Done')->configure(-state => 'normal');
	}
	$pseudobank[$pgmnum] = $sysex_dump;
    }
}
sub vfymeta {
    my $vfyon         = $_[0];
    if ($vfyon and $rx_retry < $retries) {
	runagain($_[1]);
	return 1;
    } else {
	if ($tx_rnlvl == -1) {
	    passfail($vfyon ? $_[2] : $_[3], 0);
	} else {
	    $tx_retry++;
	    $tx_rnlvl = 4;
	}
	$rx_retry     = -1;
	return 0;
    }
}
sub vfycmpr {
    my $vfyon                           = $_[0];
    if ($vfyon) {
	if ($rx_retry                   == 0) {
	    $rx_check                   = $sysex_dump;
	    runagain("Received $dumpsize bytes, will verify...");
	    return 1;
	} elsif ($sysex_dump eq $rx_check) {
	    if ($tx_rnlvl               == -1) {
		&loadpseudo;
		if (not $pseudo or
		    $devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd}
		    and $pgmnum         == $pmax) {
		    passfail( $rx_retry == 1 ? $_[1] : $_[2], 1 );
		} else {
		    $pgmnum++ if
			$devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd};
		    runagain( $rx_retry == 1 ? $_[1] : $_[2] );
		    $rx_retry           = -1;
		    return 1;
		}
	    } else {
		$tx_retry++;
		$tx_rnlvl               = 4;
	    }
	    $rx_retry                   = -1;
	} elsif ($rx_retry < $retries) {
	    if ($rx_check) {
		$rx_check               = $sysex_dump;
		runagain("FAILED on retry ($rx_retry), repeating...");
	    } else {
		$rx_check               = $sysex_dump;
		runagain("GOOD once on retry ($rx_retry), verifying...");
	    }
	    return 1;
	} else {
	    if ($tx_rnlvl               == -1) {
		$pgmnum                 = ord(substr($sysex_dump, $pbyte, 1))
		    if $pseudo and not
		    $devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd};
		passfail("RECEIVE FAILED, retried $rx_retry times.", 0);
	    } else {
		$tx_retry++;
		$tx_rnlvl               = 5;
	    }
	    $rx_retry                   = -1;
	}
    } else {
	&loadpseudo;
	if (not $pseudo or
	    $devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd}
	    and $pgmnum                 == $pmax) {
	    passfail($_[3], 1);
	} else {
	    $pgmnum++ if $devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd};
	    runagain($_[3]);
	    $rx_retry                   = -1;
	    return 1;
	}
	$rx_retry                       = -1;
    }
    return 0;
}
sub deadman {
    $rx_retry++;
    if ($verify ne 'Never') {
	if ($rx_retry < $retries) {
	    $f7seen       = 0;
	    runagain("Rx: stalled/partial ($rx_retry), retrying...");
	} else {
	    if ($tx_rnlvl == -1) {
		$pgmnum   = ord(substr($sysex_dump, $pbyte, 1))
		    if $pseudo and not
		    $devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd};
		passfail("STALLED/PARTIAL ($rx_retry), failed.", 0);
		alltoggle(1);
	    } else {
		$tx_retry++;
		$tx_rnlvl = 5;
	    }
	    $rx_retry     = -1;
	}
    } else {
	$pgmnum           = ord(substr($sysex_dump, $pbyte, 1))
	    if $pseudo and not
	    $devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd};
	passfail("STALLED/PARTIAL, failed.", 0);
	$rx_retry         = -1;
	alltoggle(1);
    }
}
sub receive {
    $chanClr         = 'LightBlue';
    $sysex_dump      = '';
    my $globCfgMod   = 0;
    my $devCfgMod    = 0;
    unless (initports()) {
	Error(\$mw, "Why are you running a MIDI librarian\n" .
	      "program on a computer with no MIDI ports?");
	return;
    }
    $rxbtn->configure(-background => $btnBusyClr);
    browsetypes('rx');
    $percent         = 0;
    $dialogstatus    = 'Ready.';

    $rxwin = $mw->DialogBox(
	-title                  => 'RECEIVE DUMP',
	-buttons                => [ 'Done', 'Cancel' ],
	-default_button         => 'Done',
	-cancel_button          => 'Cancel',
	-bg                     => 'gray50');
    $rxwin->Subwidget('B_Done')->configure(
	-foreground             => 'white',
	-background             => 'RosyBrown4',
	-activebackground       => '#4b0000',
	-activeforeground       => 'white');
    $rxwin->Subwidget('B_Cancel')->configure(
	-foreground             => 'white',
	-background             => $btnNormClr,
	-activebackground       => 'LemonChiffon3',
	-activeforeground       => 'black');
    $rxwin->resizable(0,0);

    $rxwin->add('Label',
	-text =>
	"Select your MIDI machine, the type of dump, the computer\n" .
	"port it\'s connected to, and, if relevant, the MIDI channel,\n" .
	"then click REQUEST/LISTEN.  These settings will be saved\n" .
	"for future transfers you do from the same equipment.\n\n" .
	"Your device will be commanded remotely via MIDI to send.\n\n" .
	"Or, if on \"Generic MIDI Device\", click REQUEST/LISTEN,\n" .
	"and manually send from your MIDI machine\'s own controls.",
	-justify                => 'left',
	-font                   => $msgFont,
	-background             => 'gray10',
	-foreground             => 'gray90',
	-borderwidth            => 4,
	-relief                 => 'sunken',
	-padx                   => 15,
	-pady                   => 2)->grid(
	-pady                   => 15,
	-row                    => 0,
	-column                 => 0,
	-columnspan             => 3);

    my $progFrame = $rxwin->add('Frame',
	-borderwidth            => 1,
	-background             => '#3b0010',
	-pady                   => 2,
	-relief                 => 'raised')->grid(
	-sticky                 => 'nsew',
	-padx                   => 22,
	-row                    => 1,
	-column                 => 0,
	-columnspan             => 3);
    $progFrame->ProgressBar(
	-length                 => 400,
	-width                  => 30,
	-blocks                 => 50,
	-colors                 => [ 0, 'red' ],
	-troughcolor            => '#00000b',
	-variable               => \$percent)->grid(
	-sticky                 => 's');

    $dlgStatWin = $rxwin->add('Label',
	-textvariable           => \$dialogstatus,
	-borderwidth            => 4,
	-relief                 => 'sunken',
	-padx                   => 15,
	-pady                   => 5,
	-font                   => $listboxFont,
	-foreground             => 'black',
	-background             => $LCDclr)->grid(
	-row                    => 2,
	-column                 => 0,
	-columnspan             => 3,
	-padx                   => 25,
	-pady                   => 10,
	-sticky                 => 'we');

    my $labelFrame = $rxwin->add('Frame',
	-borderwidth            => 1,
	-background             => 'black',
	-relief                 => 'raised')->grid(
	-row                    => 3,
	-column                 => 0,
	-columnspan             => 1);
    my $pldnFrame = $rxwin->add('Frame',
	-borderwidth            => 1,
	-background             => 'black',
	-relief                 => 'raised')->grid(
	-sticky                 => 'w',
	-row                    => 3,
	-column                 => 1,
	-columnspan             => 2);

    $labelFrame->Label(
	-text                   => 'Hardware device:',
	-foreground             => 'gray70',
	-background             => 'gray10',
	-font                   => $labelFont)->grid(
	-sticky                 => 'we',
	-pady                   => 2,
	-row                    => 0,
	-column                 => 0);

    $devDrpdown = $pldnFrame->BrowseEntry(
	-choices                => \@machines,
	-state                  => 'readonly',
	-variable               => \$lastdev,
	-browsecmd              => sub {
	    $globCfgMod = 1;
	    browsetypes('rx');
	    $typeDrpdown->configure(-choices => \@types);
	    if ($lastdev ne $genericdev) {
		    if ($cfghash{"$lastdev.outport"}) {
			$midi_outport = $cfg->param("$lastdev.outport");
			MidiConSetup('out');
		    }
		    if ($cfghash{"$lastdev.inport"}) {
			$midi_inport = $cfg->param("$lastdev.inport");
			MidiConSetup('in');
		    }
		    if (needchan('rx') and $cfghash{"$lastdev.midichan"})
		    { $midichan = $cfg->param("$lastdev.midichan"); }
	    } else {
		$dropdwnMidiChan->configure(
		    -disabledforeground      => $offClr,
		    -state                   => 'disabled');
	    }
	    needretry('rx');
	    needpatch(1);
	    &needadvice;
	},
	-font                   => $drpdnLgtFnt,
	-disabledbackground     => 'black',
	-disabledforeground     => $chanClr)->grid(
	-row                    => 0,
	-column                 => 0,
	-columnspan             => 2);
    $devDrpdown->Subwidget('entry')->configure(
	-width                  => 30);
    $devDrpdown->Subwidget('slistbox')->configure(
	-selectbackground       => 'IndianRed4',
	-selectforeground       => 'white',
	-bg                     => 'black',
	-fg                     => $chanClr);

    $labelFrame->Label(
	-text                   => 'Dump type:',
	-foreground             => 'gray70',
	-background             => 'gray10',
	-font                   => $labelFont)->grid(
	-sticky                 => 'we',
	-pady                   => 2,
	-row                    => 1,
	-column                 => 0);

    $typeDrpdown = $pldnFrame->BrowseEntry(
	-autolimitheight        => 8,
	-choices                => \@types,
	-state                  => 'readonly',
	-variable               => \$wanttype,
	-font                   => $drpdnLgtFnt,
	-disabledbackground     => 'black',
	-disabledforeground     => $chanClr,
	-browsecmd              => sub {
	    $devCfgMod = 1;
	    if ($wanttype eq 'Pseudobank file') {
		$preferpseudo   = 'file';
		$pseudo         = 1;
	    } elsif ($wanttype eq 'Pseudobank folder') {
		$preferpseudo   = 'folder';
		$pseudo         = 1;
	    } else {
		$preferpseudo   = 'none';
		$pseudo         = 0;
	    }
	    if (needchan('rx') and $cfghash{"$lastdev.midichan"})
	    { $midichan = $cfg->param("$lastdev.midichan"); }
	    needretry('rx') if $lastdev eq $genericdev;
	    needpatch(1);
	    &needadvice;
	})->grid(
	-column                 => 0,
	-row                    => 1);
    $typeDrpdown->Subwidget('entry')->configure(
	-width                  => 22);
    $typeDrpdown->Subwidget('slistbox')->configure(
	-selectbackground       => 'IndianRed4',
	-selectforeground       => 'white',
	-bg                     => 'black',
	-fg                     => $chanClr);
    my $adviceBitmap = $pldnFrame->Bitmap(
	-data                   => &advicebtn,
	-foreground             => 'white',
	-background             => '#00005b');
    $adviceBtn = $pldnFrame->Button(
	-background             => 'black',
	-image                  => $adviceBitmap,
	-command                => \&giveadvice)->grid(
	-column                 => 1,
	-row                    => 1);
    &needadvice;

    $labelFrame->Label(
	-text                   => 'MIDI Port / Channel:',
	-foreground             => 'gray70',
	-background             => 'gray10',
	-font                   => $labelFont)->grid(
	-sticky                 => 'we',
	-pady                   => 2,
	-row                    => 2,
	-column                 => 0);

    $dropdwnMidiPort = $pldnFrame->BrowseEntry(
	-choices                => \@midi_outports,
	-listheight             => scalar @midi_outports,
	-state                  => 'readonly',
	-variable               => \$midi_outport,
	-browsecmd              => sub { $devCfgMod   = 1;
					 $midi_inport = $midi_outport;
					 MidiConSetup('out');
					 MidiConSetup('in');
				    },
	-font                   => $drpdownFont,
	-disabledbackground     => 'black',
	-disabledforeground     => $chanClr)->grid(
	-row                    => 2,
	-column                 => 0,
	-sticky                 => 'e');
    $dropdwnMidiPort->Subwidget('entry')->configure(
	-width                  => 22);
    $dropdwnMidiPort->Subwidget('slistbox')->configure(
	-selectbackground       => 'IndianRed4',
	-selectforeground       => 'white',
	-bg                     => 'black',
	-fg                     => $chanClr);

    $dropdwnMidiChan = $pldnFrame->BrowseEntry(
	-variable               => \$midichan,
	-justify                => 'center',
	-browsecmd              => sub { $devCfgMod = 1; },
	-font                   => $drpdownFont,
	-disabledbackground     => 'black')->grid(
	-row                    => 2,
	-column                 => 1,
	-sticky                 => 'w');
    $dropdwnMidiChan->Subwidget('entry')->configure(
	-width                  => 4);
    $dropdwnMidiChan->Subwidget('slistbox')->configure(
	-width                  => 4,
	-selectbackground       => 'IndianRed4',
	-selectforeground       => 'white',
	-bg                     => 'black',
	-fg                     => $chanClr);
    # Most sysex dumps have no use for a MIDI channel, since they're
    # broadcast messages that target manufactuer code and product ID,
    # not channel (by MIDI standards anyway).  The only exceptions
    # will be for boards that use manufacturer-concocted schemes for
    # overwriting the channel as a nybble inside the dump; those that
    # use CC's during the dump (even weirder); and for some patch
    # dumps, because Sysexy can send program change commands to help
    # you choose the patch on the actual synth that you want to
    # overwrite, and program change commands happen on a particular
    # channel number.  Here we find out if any of the above things are
    # the case right now, and disable the channel selector if not.
    needchan('rx');

    $labelFrame->Label(
	-text                   => 'Verify / retries:',
	-foreground             => 'gray70',
	-background             => 'gray10',
	-font                   => $labelFont)->grid(
	-sticky                 => 'we',
	-pady                   => 2,
	-row                    => 3,
	-column                 => 0);

    $vfyDrpdwn = $pldnFrame->BrowseEntry(
	-choices                => [qw/Never Receive Always/],
	-listheight             => 3,
	-state                  => 'readonly',
	-variable               => \$verify,
	-browsecmd              => sub {
	    $devCfgMod = 1;
	    needretrylite();
	},
	-font                   => $drpdownFont,
	-disabledbackground     => 'black')->grid(
	-row                    => 3,
	-column                 => 0,
	-sticky                 => 'e');
    $vfyDrpdwn->Subwidget('entry')->configure(
	-width                  => 22);
    $vfyDrpdwn->Subwidget('slistbox')->configure(
	-selectbackground       => 'IndianRed4',
	-selectforeground       => 'white',
	-bg                     => 'black',
	-fg                     => $chanClr);

    $retryDrpdwn = $pldnFrame->BrowseEntry(
	-choices                => [1..10],
	-listheight             => 10,
	-variable               => \$retries,
	-justify                => 'center',
	-browsecmd              => sub { $devCfgMod = 1; },
	-font                   => $drpdownFont,
	-foreground             => $chanClr,
	-background             => 'black',
	-disabledforeground     => $offClr,
	-disabledbackground     => 'black')->grid(
	-row                    => 3,
	-column                 => 1,
	-sticky                 => 'w');
    $retryDrpdwn->Subwidget('entry')->configure(
	-width                  => 4);
    $retryDrpdwn->Subwidget('slistbox')->configure(
	-width                  => 4,
	-selectbackground       => 'IndianRed4',
	-selectforeground       => 'white',
	-bg                     => 'black',
	-fg                     => $chanClr);
    needretry('rx');

    $labelFrame->Label(
	-text                   => 'Patch # / PgmChg send:',
	-foreground             => 'gray70',
	-background             => 'gray10',
	-font                   => $labelFont)->grid(
	-sticky                 => 'we',
	-pady                   => 2,
	-row                    => 4,
	-column                 => 0);

    $spinPgm = $pldnFrame->Spinbox(
	-textvariable           => \$pgmnum,
	-from                   => 0,
	-increment              => 1,
	-wrap                   => 1,
	-background             => 'black',
	-foreground             => 'white',
	-disabledbackground     => 'gray10',
	-disabledforeground     => $offClr,
	-buttonbackground       => 'black')->grid(
	-row                    => 4,
	-column                 => 0,
	-sticky                 => 'we');
    my $pgmchgBitmap = $pldnFrame->Bitmap(
	-data                   => &pgmchgbtn,
	-foreground             => 'white',
	-background             => '#00005b');
    $btnPgm = $pldnFrame->Button(
	-background             => 'black',
	-image                  => $pgmchgBitmap,
	-command                => \&pgmchg)->grid(
	-row                    => 4,
	-column                 => 1);
    needpatch(1);

    $labelFrame->Label(
	-text                   => "Click Done when finished,\nor Cancel to abort.",
	-justify                => 'left',
	-padx                   => 15,
	-background             => 'gray50')->grid(
	-pady                   => 5,
	-row                    => 5,
	-column                 => 0);

    $reqbutton = $pldnFrame->Button(
	-text                   => '* REQUEST / LISTEN *',
	-relief                 => 'groove',
	-font                   => $requestFont,
	-foreground             => 'white',
	-background             => $btnDumpClr,
	-activebackground       => $btnDmpActClr,
	-activeforeground       => 'white',
	-command                => sub {
	    # Deactivate some widgets, because it's too late to be changing
	    # your mind about what kind of dump you want after you've clicked
	    # the Request/Listen button to actually start receiving.  We
	    # leave the Cancel button active, because we'll let you do that.
	    alltoggle(0);
	    $rxwin->Subwidget('B_Done')->configure(-state => 'disabled')
		if $wanttype ne 'Generic manual';
	    $dlgStatWin->configure(
		-background => $LCDclr,
		-foreground => 'black');
	    @pseudobank = ();
	    $rx_rnlvl   = -1;
	    $rx_check   = '';
	    &rxinit;
	    # Tell the device to dump to us, if we know its request
	    # command.  If the pulldown is set for Generic, then we
	    # don't know much of anything, and the user will need to
	    # send the dump from their instrument's own control panel.
	    if ($lastdev ne $genericdev and
		$devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd}) {
		$pgmnum       =  0 if $pseudo;
		$dialogstatus = "LISTENING: Received 0 bytes.";
		txcmd($devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd});
		$watchdog     = $mw->after($stallwait, \&deadman);
	    } else {
		$dialogstatus = "Send MANUALLY from your machine!";
	    }
	    # Now we listen for a dump...
	    # Our magic repeat handler runs rxsysex() over and over.  (Thanks,
	    # Tk!)  It comes back here after each run to keep GUI responsive.
	    # So, your Cancel button still works, so you can abort the dump.
	    # $handler saves a reference we can use to stop the handler later.
	    #
	    # $watchdog saves a second handler to make sure we don't stall.
	    # We don't do it for unassisted (generic) receives, since if we're
	    # waiting for you to manually send, we're not going to rush you
	    # with a deadline timer that kills you because you took too long.
	    $handler = $rxwin->repeat($rxwait, \&rxsysex);
	})->grid(
		-sticky         => 'we',
		-pady           => 5,
		-row            => 5,
		-column         => 0,
		-columnspan     => 2);

    my $rxwin_ans = $rxwin->Show(
	-popover                => $mw,
	-overanchor             => 'c',
	-popanchor              => 'c');
    if ($rxwin_ans eq 'Done') {
	$handler->cancel if $handler;
	if ($globCfgMod or $devCfgMod) {
	    $cfg->param("$lastdev.outport",  $midi_outport);
	    $cfg->param("$lastdev.inport",   $midi_inport);
	    $cfg->param("$lastdev.midichan", $midichan) unless
		$dropdwnMidiChan->cget(-state) eq 'disabled';
	    $cfg->param("$lastdev.verify",   $verify);
	    $cfg->param("$lastdev.retries",  $retries);
	    $cfg->param("$lastdev.pseudo",   $preferpseudo);
	    %cfghash = $cfg->vars();
	    $savecfg = 1;
	}
	if ($sysex_dump or $pseudo and scalar @pseudobank) {
	    # If you've made it this far, you should have a valid
	    # sysex dump that you presumably want to save to disk.
	    my $savefile = $rxwin->getSaveFile(
		-title              => 'SAVE SYSEX DUMP',
		-filetypes          => $filexts,
		-defaultextension   => '.syx',
		-initialdir         => $datadir);
	    if ($savefile) {
		# If the user changed folder while they were in the save file
		# dialog, then we've got a new working directory, which should
		# be saved in the config file.  The listbox needs to be updated
		# even if they didn't change folders though, to show the file
		# you just saved.
		my (undef, $savedir, $basefile) = splitpath("$savefile");
		$savedir =~ s|/\z||;
		unless ($datadir eq $savedir) {
		    $datadir = $savedir;
		    $savecfg = 1;
		}
		my ($fh, $p, $i, $w, $pfile);
		if ($wanttype ne 'Pseudobank folder') {
		    if ($wanttype eq 'Pseudobank file') {
			$sysex_dump = '';
			foreach $p (@pseudobank) {
			    $sysex_dump .= $p if $p;
			}
		    }
		    open $fh, '>:raw', $savefile
			or Error(\$mw, "Error writing file!");
		    print $fh $sysex_dump;
		    close $fh;
		} else {
		    $basefile =~ s|\.syx\z||i;
		    chdir $savedir;
		    my @existing = glob qq("${basefile}???.syx");
		    if (not @existing) {
			$w = 0;
			while (($i, $p) = each @pseudobank) {
			    next unless $p;
			    $pfile = $basefile . sprintf("%03u", $i) . '.syx';
			    open $fh, '>:raw', $pfile;
			    print $fh $p;
			    close $fh;
			    $w++;
			    $message = "Wrote patch $i";
			}
			$message = "Wrote $w.";
		    } else {
			Error(\$mw, "Files matching save name template already exist!");
		    }
		}
		loadlb("$basefile");
	    }
	}
    } elsif ($rxwin_ans eq 'Cancel') {
	$watchdog->cancel if $watchdog;
	$handler->cancel  if $handler;
    }
    $rxbtn->configure(-background => $btnNormClr);
}
sub bufferreset {
    # ALSA's MIDI buffer is only 4kB, and it's easy to overflow.  :(
    # inputpending() becomes negative on overflow, but merely querying
    # the function clears the error condition.  A positive value just
    # means there's some data in the buffer, which we can throw away.
    my $bufferstate = MIDI::ALSA::inputpending();
    if ($bufferstate > 0) {
	(undef) = MIDI::ALSA::input() while MIDI::ALSA::inputpending();
    } elsif ($bufferstate < 0) {
	warn "MIDI buffer overflowed on last read!\n";
    }
}
sub rxinit {
    # First, some buffer hygiene, as recommended by doctors:
    &bufferreset;
    # Prepare now for receive/verify run:
    $sysex_dump  = '';
    $rx_retry    = -1;
    $percent     =  0;
    $f7seen      =  0;
    if ($lastdev ne $genericdev) {
	$f7total = $devspecs{$lastdev}{$typemap{$wanttype}}{f7total};
	$binsize = $devspecs{$lastdev}{$typemap{$wanttype}}{size};
    } else {
	$f7total = 1 if $tx_rnlvl == -1;
	$binsize = 0;
    }
}
sub rxsysex {
    # If we slept on the last run, no more sleeping.  Restore the
    # repeat handler to full speed, and we need a new watchdog because
    # somebody killed our dog (poor dog).  (Tk does not let you change
    # the timeout on an existing after() handler like we can for
    # repeat(), because it will not run again.  We must destroy it and
    # create a new watchdog each time.)
    if ($rx_rnlvl == 1) {
	#&bufferreset;
	$watchdog = $mw->after($stallwait, \&deadman)
	    if $devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd};
	$handler->time($rxwait);
	$rx_rnlvl = 2;
	return;
	# If you just went to full speed, you're at the start of a new sysex.
	# Send a dump request command if we know it for the current synth.
    } elsif ($rx_rnlvl == 2) {
	txcmd($devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd})
	    if ($devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd});
	$rx_rnlvl = 0; # normal mode
    }
    # If nothing is coming in, we skip the whole subroutine and go back to GUI:
    while (1) {
	return unless MIDI::ALSA::inputpending();

	# If there was data, we'll actually read the port and get it.
	# MIDI::ALSA serves it to you in a data structure like this:
	@alsaevent      = MIDI::ALSA::input();
	my ($type, $flags, $tag, $queue, $time) = @alsaevent;
	my @source      = @{ $alsaevent[5] };
	my @destination = @{ $alsaevent[6] };
	my @data        = @{ $alsaevent[7] };

	# Since this is a librarian program, most likely it will be sysex.
	# We tally 0xF7 occurrences in case we're doing pseudobanks.
	if ($type       == SND_SEQ_EVENT_SYSEX()) {
	    $sysex_dump .= $data[0];
	    my $f7found  = $data[0] =~ tr/\xF7//;
	    $f7seen      = $f7seen + $f7found;

	    # Or, some really bizarre synthesizers use CC's as
	    # part of their process of doing sysex dumps (DK600).
	} elsif ($type == SND_SEQ_EVENT_CONTROLLER()) {
	    my ($channel, undef, undef, undef, $param, $value) = @data;
	    # Add the CC to the end of whatever we have in $sysex_dump:
	    # First byte  = decimal 176 plus the MIDI channel numbered from zero
	    # Second byte = CC type
	    # Third byte  = CC value
	    $sysex_dump  .= chr(176 + $channel) . chr($param) . chr($value);

	    # Or -- oops!  The janitor must have tripped on the MIDI cable.
	} elsif ($type == SND_SEQ_EVENT_PORT_UNSUBSCRIBED()) {
	    $dlgStatWin->configure(
		-background => $errClr,
		-foreground => 'white');
	    $dialogstatus = "Error: MIDI connection dropped.";
	    $watchdog->cancel if $watchdog;
	    $handler->cancel;
	    return;
	}
	# We actually finished a chunk (or maybe the whole thing, see below).
	# Update the progress meter, and kill the watchdog that was going to
	# handle stalls.  Yeah, we're so mean that we actually kill dogs.
	$watchdog->cancel if $watchdog;
	$dumpsize     = bytes::length($sysex_dump);
	$dialogstatus = "LISTENING (${f7seen}): Received ${dumpsize} bytes.";
	$message      = "(p$pgmnum)" if $pseudo;
	$percent      = $dumpsize / $binsize * 100 if $binsize;

	# Check to see if this is the end of the sysex dump.
	# The last sysex, that is, since this might be a pseudobank
	# containing lots of 0xF7 "end of sysex" markers.
	# If this dump is generic manual, we don't know when it will end.
	if (not ($tx_rnlvl == -1 and $wanttype eq 'Generic manual') and
	    (substr($sysex_dump, -1) eq chr(247) and $f7seen >= $f7total)) {
	    $f7seen = 0;
	    $rx_retry++;
	    # Do any verifying we're supposed to do.
	    return if verify();
	    # Restore your pulldown menus if we really are done.
	    alltoggle(1) if $tx_rnlvl == -1;
	} elsif ($devspecs{$lastdev}{$typemap{$wanttype}}{dumpcmd}) {
	    # There's more?  And we have a $dumpcmd?
	    # Then we need to create a new dog.
	    $watchdog = $mw->after($stallwait, \&deadman);
	}
    }
}
sub transmit {
    return unless $lb->curselection;
    my $selFile = $sysexfiles[$lb->curselection->[0]];
    $chanClr = 'white';
    my $globCfgMod = 0;
    my $devCfgMod  = 0;
    unless (initports()) {
	Error(\$mw, "Why are you running a MIDI librarian\n" .
	      "program on a computer with no MIDI ports?");
	return;
    }
    $txbtn->configure(-background => $btnBusyClr);
    &whatfrom;
    browsetypes('tx');

    $txwin = $mw->DialogBox(
	-title                  => 'TRANSMIT DUMP',
	-buttons                => [ 'Xmit', 'Cancel' ],
	-default_button         => 'Xmit',
	-cancel_button          => 'Cancel',
	-bg                     => 'PaleVioletRed4');
    $txwin->Subwidget('B_Xmit')->configure(
	-foreground             => 'white',
	-background             => 'RosyBrown4',
	-activebackground       => '#4b0000',
	-activeforeground       => 'white');
    $txwin->Subwidget('B_Cancel')->configure(
	-foreground             => 'white',
	-background             => $btnNormClr,
	-activebackground       => $btnDmpActClr,
	-activeforeground       => 'white');
    $txwin->resizable(0,0);

    $txwin->add('Label',
		-text           => "Confirm send selected sysex file:",
		-font           => $boldFont,
		-justify        => 'left',
		-foreground     => 'black',
		-background     => $dialogClr)->grid(
		-column         => 0,
		-columnspan     => 4,
		-row            => 0,
		-sticky         => 'we');
    my $adviceBitmap = $txwin->add('Bitmap',
		-data           => &advicebtn,
		-foreground     => 'white',
		-background     => '#00005b');
    $adviceBtn = $txwin->add('Button',
		-background     => 'black',
		-image          => $adviceBitmap,
		-command        => \&giveadvice)->grid(
		-sticky         => 'e',
		-column         => 3,
		-row            => 0);
    &needadvice;
    $txwin->add('Label',
		-text           => "$selFile ?",
		-font           => $bigtimesFont,
		-borderwidth    => 2,
		-relief         => 'sunken',
		-padx           => 15,
		-pady           => 30,
		-justify        => 'left',
		-foreground     => 'black',
		-background     => 'ivory4')->grid(
		-columnspan     => 4,
		-row            => 1,
		-sticky         => 'we');

    $txwin->add('Label',
		-text           => 'Port:',
		-anchor         => 'e',
		-foreground     => 'yellow',
		-background     => 'gray12',
		-font           => $labelFont)->grid(
		-column         => 0,
		-row            => 2,
		-sticky         => 'we');
    $dropdwnMidiPort = $txwin->add('BrowseEntry',
	-choices                => \@midi_outports,
	-listheight             => scalar @midi_outports,
	-state                  => 'readonly',
	-variable               => \$midi_outport,
	-browsecmd              => sub { $devCfgMod = 1;
					 $midi_inport = $midi_outport;
					 MidiConSetup('out');
					 MidiConSetup('in');
				    },
	-font                   => $drpdownFont,
	-disabledbackground     => 'black',
	-disabledforeground     => 'white')->grid(
	-column                 => 1,
	-row                    => 2);
    $dropdwnMidiPort->Subwidget('slistbox')->configure(
	-selectbackground       => 'IndianRed4',
	-selectforeground       => 'white',
	-bg                     => 'black',
	-fg                     => 'white');
    $txwin->add('Label',
		-text           => 'Channel:',
		-anchor         => 'e',
		-foreground     => 'yellow',
		-background     => 'gray12',
		-font           => $labelFont)->grid(
		-column         => 2,
		-row            => 2,
		-sticky         => 'we');
    $dropdwnMidiChan = $txwin->add('BrowseEntry',
	-variable               => \$midichan,
	-justify                => 'center',
	-browsecmd              => sub { $devCfgMod = 1; },
	-font                   => $drpdownFont,
	-disabledbackground     => 'black')->grid(
	-column                 => 3,
	-row                    => 2,
	-sticky                 => 'we');
    $dropdwnMidiChan->Subwidget('slistbox')->configure(
	-selectbackground       => 'IndianRed4',
	-selectforeground       => 'white',
	-bg                     => 'black',
	-fg                     => $chanClr);
    # Set MIDI channel pulldown disabled if it's irrelevant:
    my $useschan = needchan('tx');

    $txwin->add('Label',
		-text           => 'Buffer (bytes):',
		-anchor         => 'e',
		-foreground     => 'yellow',
		-background     => 'gray12',
		-font           => $labelFont)->grid(
		-column         => 0,
		-row            => 3,
		-sticky         => 'we');
    my $sizeDropdwn = $txwin->add('BrowseEntry',
		-choices        => [ 128, 256, 512, 1024, 2048, 3072, 4096 ],
		-listheight     => 7,
		-state          => 'normal',
		-variable       => \$fragsize,
		-justify        => 'center',
		-browsecmd      => sub { $devCfgMod = 1; },
		-font           => $drpdownFont,
		-background	=> 'black',
		-foreground	=> 'white',
		-disabledbackground => 'black',
		-disabledforeground => 'white')->grid(
		-column         => 1,
		-row            => 3,
		-pady           => 2,
		-sticky         => 'we');
    $sizeDropdwn->Subwidget('entry')->configure(
		-width          => 6);
    $sizeDropdwn->Subwidget('slistbox')->configure(
		-selectbackground => 'IndianRed4',
		-selectforeground => 'white',
		-bg             => 'black',
		-fg             => 'white',
		-width          => 4);
    $txwin->add('Label',
		-text           => 'Delay (ms):',
		-anchor         => 'e',
		-foreground     => 'yellow',
		-background     => 'gray12',
		-font           => $labelFont)->grid(
		-column         => 2,
		-row            => 3,
		-sticky         => 'we');
    my $waitDropdwn = $txwin->add('BrowseEntry',
		-choices        => [ 40, 50, 75, 100, 150, 200, 250, 300 ],
		-listheight     => 8,
		-state          => 'normal',
		-variable       => \$txwait,
		-justify        => 'center',
		-browsecmd      => sub { $devCfgMod = 1; },
		-font           => $drpdownFont,
		-background	=> 'black',
		-foreground	=> 'white',
		-disabledbackground => 'black',
		-disabledforeground => 'white')->grid(
		-column         => 3,
		-row            => 3,
		-pady           => 2,
		-sticky         => 'w');
    $waitDropdwn->Subwidget('entry')->configure(
		-width          => 6);
    $waitDropdwn->Subwidget('slistbox')->configure(
		-width          => 6,
		-selectbackground => 'IndianRed4',
		-selectforeground => 'white',
		-bg             => 'black',
		-fg             => 'white');

    $txwin->Checkbutton(
	      -text             => 'Pseudobank',
	      -variable         => \$pseudo,
	      -command          => sub {
		  $devCfgMod = 1;
		  needpatch(1);
		  $useschan  = needchan('tx');},
	      -foreground       => 'white',
	      -background       => 'black',
	      -activeforeground => 'white',
	      -activebackground => 'black')->grid(
	      -column           => 3,
	      -row              => 3,
	      -sticky           => 'e');

    $txwin->add('Label',
		-text           => 'Verify / tries:',
		-anchor         => 'e',
		-foreground     => 'yellow',
		-background     => 'gray12',
		-font           => $labelFont)->grid(
		-column         => 0,
		-row            => 4,
		-sticky         => 'we');
    $vfyDrpdwn = $txwin->BrowseEntry(
	-choices                => [qw/Never Receive Always/],
	-listheight             => 3,
	-state                  => 'readonly',
	-variable               => \$verify,
	-browsecmd              => sub {
	    $devCfgMod = 1;
	    if ($verify ne 'Always') {
		$retryDrpdwn->configure(-state => 'disabled');
	    } else {
		$retryDrpdwn->configure(-state => 'normal');
		$retries = 1 if $retries < 1;
	    }
	},
	-font                   => $drpdownFont,
	-disabledbackground     => 'black')->grid(
	-column                 => 1,
	-row                    => 4,
	-sticky                 => 'w');
    $vfyDrpdwn->Subwidget('entry')->configure(
	-width                  => 11);
    $vfyDrpdwn->Subwidget('slistbox')->configure(
	-width                  => 11,
	-selectbackground       => 'IndianRed4',
	-selectforeground       => 'white',
	-bg                     => 'black',
	-fg                     => $chanClr);
    $retryDrpdwn = $txwin->BrowseEntry(
	-choices                => [1..10],
	-listheight             => 10,
	-variable               => \$retries,
	-justify                => 'center',
	-browsecmd              => sub { $devCfgMod = 1; },
	-font                   => $drpdownFont,
	-foreground             => $chanClr,
	-background             => 'black',
	-disabledforeground     => $offClr,
	-disabledbackground     => 'black')->grid(
	-column                 => 1,
	-row                    => 4,
	-sticky                 => 'e');
    $retryDrpdwn->Subwidget('entry')->configure(
	-width                  => 4);
    $retryDrpdwn->Subwidget('slistbox')->configure(
	-width                  => 4,
	-selectbackground       => 'IndianRed4',
	-selectforeground       => 'white',
	-bg                     => 'black',
	-fg                     => $chanClr);
    needretry('tx');

    $txwin->add('Label',
		-text           => 'Patch #:',
		-anchor         => 'e',
		-foreground     => 'yellow',
		-background     => 'gray12',
		-font           => $labelFont)->grid(
		-column         => 2,
		-row            => 4,
		-sticky         => 'we');
    $spinPgm = $txwin->Spinbox(
	-textvariable           => \$pgmnum,
	-from                   => 0,
	-increment              => 1,
	-wrap                   => 1,
	-width                  => 12,
	-background             => 'black',
	-foreground             => 'white',
	-disabledbackground     => 'gray10',
	-disabledforeground     => $offClr,
	-buttonbackground       => 'black')->grid(
	-column                 => 3,
	-row                    => 4,
	-sticky                 => 'w');
    my $pgmchgBitmap = $txwin->Bitmap(
	-data                   => &pgmchgbtn,
	-foreground             => 'white',
	-background             => '#00005b');
    $btnPgm = $txwin->Button(
	-background             => 'black',
	-image                  => $pgmchgBitmap,
	-command                => \&pgmchg)->grid(
	-column                 => 3,
	-row                    => 4,
	-sticky                 => 'e');
    needpatch(1);

    my $txwin_ans = $txwin->Show(
	-popover                => $mw,
	-overanchor             => 'c',
	-popanchor              => 'c');
    if ($txwin_ans eq 'Xmit') {

	if ($pseudo) { # the Pseudobank button is on
	    my ($fh, $p, $i);
	    $pgmnum      = 0;
	    @pseudobank  = ();
	    if ($selFile =~ /\d{3}\.syx\z/) { # numbered files from pseudobank
		$preferpseudo = 'folder';
		my $template  = $selFile =~ s/(.*)\d{3}\.syx\z/$1/r;
		my @existing  = glob qq("${template}[0-9][0-9][0-9].syx");
		foreach $p (@existing) {
		    $p =~ /(\d{3})\.syx\z/;
		    $i = $1;
		    open $fh, '<:raw', $p
			or Error(\$mw, "Error reading file!");
		    {
			local $/;
			$pseudobank[$i] = <$fh>;
		    }
		    close $fh;
		}
	    } else { # single file amalgamated pseudobank (we presume)
		$preferpseudo = 'file';
		open $fh, '<:raw', $selFile
		    or Error(\$mw, "Error reading file!");
		{
		    local $/;
		    $p = <$fh>;
		}
		close $fh;
		while ($p =~ /\G((?:.){$pbyte}(.).*?\xF7)/gcsaa) {
		    $pseudobank[ord($2)] = $1;
		}
	    }
	    $pgmnum++ until $pseudobank[$pgmnum];
	    $sysex_dump   = $pseudobank[$pgmnum];
	    $pbanksize    = scalar @pseudobank;
	} else { # normal sysex transmit, no pseudo
	    $preferpseudo = 'none';
	    open my $fh, '<:raw', $selFile
		or Error(\$mw, "Error reading file!");
	    {
		local $/;
		$sysex_dump = <$fh>;
	    }
	    close $fh;
	    substr($sysex_dump, $pbyte, 1) = chr($pgmnum) if needpatch(0);
	}
	&channelize;

	if ($globCfgMod or $devCfgMod) {
	    $cfg->param("$lastdev.outport",  $midi_outport);
	    $cfg->param("$lastdev.inport",   $midi_inport);
	    $cfg->param("$lastdev.midichan", $midichan) if $useschan;
	    $cfg->param("$lastdev.fragsize", $fragsize);
	    $cfg->param("$lastdev.txwait",   $txwait);
	    $cfg->param("$lastdev.verify",   $verify);
	    $cfg->param("$lastdev.retries",  $retries);
	    $cfg->param("$lastdev.pseudo",   $preferpseudo);
	    %cfghash = $cfg->vars();
	    $savecfg = 1;
	}
	$txprogwin = $mw->DialogBox(
	    -title              => 'TRANSMIT PROGRESS',
	    -buttons            => [ 'DONE', 'ABORT' ],
	    -default_button     => 'DONE',
	    -cancel_button      => 'ABORT',
	    -bg                 => $dialogClr);
	# We're not DONE until we're DONE.
	$txprogwin->Subwidget('B_DONE')->configure(
	    -background => '#000040',
	    -foreground => 'white',
	    -state      => 'disabled');
	$txprogwin->Subwidget('B_ABORT')->configure(
	    -background => 'firebrick4',
	    -foreground => 'white');
	$txprogwin->resizable(0,0);

	$txprogwin->add('ProgressBar',
	    -foreground         => 'black',
	    -length             => 400,
	    -width              => 30,
	    -blocks             => 50,
	    -variable           => \$percent)->grid;
	$dlgStatWin = $txprogwin->add('Label',
	    -textvariable       => \$dialogstatus,
	    -borderwidth        => 2,
	    -relief             => 'sunken',
	    -font               => $listboxFont,
	    -background         => 'white',
	    -foreground         => 'black')->grid(
	    -sticky             => 'we');

	# Get ready for the transmit loop below.
	$dialogstatus  = "TRANSMITTING: Sent 0 bytes.";
	$tx_retries    = $verify eq 'Always' ? $retries : 0;
	$tx_retry      = 0;
	$tx_rnlvl      = 0;

	# We let Tk do the heavy lifting here again.  A Tk repeat
	# handler is setup to run txsysex() over and over, to push
	# chunks of sysex data out each $txwait milliseconds.  A
	# reference is saved in $handler to let us stop it later.
	# Since our PERL program is not multithreaded and we're
	# not forking a subprocess, doing it this way is needed to
	# keep the ABORT button responsive during the transmit.
	$handler = $txprogwin->repeat($txwait, \&txsysex);

	my $txprogwin_ans = $txprogwin->Show(
	    -popover            => $mw,
	    -overanchor         => 'c',
	    -popanchor          => 'c');
	if ($txprogwin_ans eq 'ABORT') {
	    $watchdog->cancel if $watchdog;
	    $handler->cancel  if $handler;
	    $message = 'Transmit aborted.';
	}
	MIDI::ALSA::syncoutput();
    }
    $txbtn->configure(-background => $btnNormClr);
}
sub txcmd {

    $_  = $_[0];
    pos = 0;

  TOKEN: while (pos() < length) {
      /\G\s+/gc and next;
      if (/\G(F0 .*? F7)/gc) { # Sysex command deteced:
	  my $chanhex   = sprintf("%X",  $midichan - 1);
	  my $patchhex  = sprintf("%02X", $pgmnum);
	  my $truncated = $1 =~ s/n/$chanhex/gr =~ s/pp/$patchhex/gr =~
	      s/^F0 | F7$//gr =~ tr/ //dr;
	  MIDI::ALSA::output( MIDI::ALSA::sysex( $midichan - 1, pack('H*', $truncated) ) );
      } elsif (/\Gcc ([0-9A-F]{2}) ([0-9A-F]{2})/gc) { # CC command detected:
	  MIDI::ALSA::output( MIDI::ALSA::controllerevent( $midichan - 1, hex($1), hex($2) ) );
      } else {
	  last TOKEN;
      }
  }
}
sub txsysex {
    if ($tx_rnlvl == 0) { # tx init
	$handler->time($txwait);
	$binsize         = bytes::length($sysex_dump);
	$sentsize        = 0;
	$percent         = 0;
	pos($sysex_dump) = 0;
	$tx_rnlvl        = 1;
	$f7seen          = 0;
	if ($lastdev eq $genericdev) {
	    $f7total     = $sysex_dump =~ tr/\xF7//;
	    $wanttype    = 'Generic manual' if $f7total > 1;
	} else {
	    $f7total     = $devspecs{$lastdev}{$typemap{$wanttype}}{f7total};
	}
    } elsif ($tx_rnlvl == 1) { # tx run
	if ($sysex_dump =~ /\G(\xF0.*?\xF7)/gcsaa) { # Sysex dump detected:
	    # In case we're doing pseudobanks with multiple 0xF0/0xF7 chunks:
	    my $chunk = $1;
	    # Because MIDI::ALSA::sysex() wants the bumper bytes peeled off:
	    my $chunksize = bytes::length($chunk);
	    my $truncated = $chunk =~ s/^\xF0|\xF7$//grsaa;
	    # Make an array containing what MIDI::ALSA::sysex() would have
	    # sent, even if that would be too big for the ALSA 4kB buffer:
	    @alsaevent    = MIDI::ALSA::sysex( $midichan - 1, $truncated );
	    # If this is less than 4kB, send it all at once.  We can handle it.
	    if ($chunksize < 4096) {
		MIDI::ALSA::output(@alsaevent);
		MIDI::ALSA::syncoutput();
		$sentsize = $sentsize + $chunksize;
		$percent  = $sentsize / $binsize * 100;
		$f7seen++;
	    } else {
		# Ok, so it's not so easy then -- a fragmenting loop!  :(
		#
		# $fragsent == -1 means if there was any fragmenting of any
		# chunks going on previously, that's done now, and you can
		# put new stuff in @syxfrags for a new fragmentation if
		# you want to -- or maybe this is the first time we've
		# done any this program run?  In other words, -1 means we
		# are not midway through a fragmentation.
		#
		# This could all be done more simply if we didn't have to
		# keep the GUI responsive during the transfer, so you can
		# click ABORT.  We run in chunks, and keep returning to
		# transmit() to keep the GUI alive after each one.

		# We don't want the regex match to move yet.  In fact,
		# we'll have to come back here over and over and over, so
		# you'd better save your place:
		my $matchpos = pos($sysex_dump);

		# When I think about unpack(), I break into little pieces,
		# each $fragsize long, unless there's a smaller one left
		# over at the end.  That one can be smaller.  And it all
		# goes into an array, because that's how it make me feel.
		# Like an array.
		if ($fragsent == -1) {
		    $fragsent = 0;
		    @syxfrags = unpack("(a$fragsize)*", $chunk);
		}
		$alsaevent[7][0] = $syxfrags[$fragsent];
		MIDI::ALSA::output(@alsaevent);
		MIDI::ALSA::syncoutput();
		$sentsize = $sentsize + bytes::length($syxfrags[$fragsent]);
		$percent  = $sentsize / $binsize * 100;
		# Is this the last fragment?
		unless ($fragsent + 1 == scalar @syxfrags) {
		    $fragsent++;
		    pos($sysex_dump) = $matchpos - $chunksize;
		} else {
		    # I suppose we're done.  Regex matches can proceed forward now.
		    # $fragsent == -1 means we are not midway through a fragmentation,
		    # and @syxfrags is free to be reused again.
		    $fragsent = -1;
		    $f7seen++;
		}
	    }
	} elsif ($sysex_dump =~ /\G([\xB0-\xBF][\x00-\x7F][\x00-\x7F])/gcsaa) {
	    # We found a CC, and unlike with sysex, a CC is a true channel
	    # message -- which means when we put the MIDI channel in it,
	    # this time we're not just making stuff up that's not part of
	    # the MIDI spec (thanks, Ensoniq, Korg, Yamaha, et al).  And
	    # while it's also true that CC's don't really belong in sysex
	    # dumps at all, don't tell that to the DK600 (thanks, Siel).
	    my (undef, $param, $value) = unpack("C3", $1);
	    MIDI::ALSA::output( MIDI::ALSA::controllerevent( $midichan - 1, $param, $value ) );
	    $sentsize = $sentsize + 3;
	    $percent  = $sentsize / $binsize * 100;
	} else {
	    warn "Unknown data found in dump!\n" if pos($sysex_dump) != $binsize;
	    $message = 'Transmitted.';
	    if ($verify eq 'Always') {
		$tx_check = $rx_check = $sysex_dump;
		$sysex_dump           = '';
		$handler->time($msgwait);
		$tx_rnlvl             = 2;
		$dialogstatus         = "DONE: Sent $sentsize bytes, will verify...";
	    # If we're not doing verify or pseudobank, we can stop here.
	    } elsif (not $pseudo or $pseudo and $pgmnum >= $#pseudobank) {
		$tx_rnlvl     = -1;
		$dialogstatus = $pseudo ?
		    "PSEUDO: Sent all $pbanksize patches in pseudobank." :
		    "DONE (${f7seen}): Sent ${sentsize} bytes.";
		$handler->cancel;
		$txprogwin->Subwidget('B_DONE')->configure(-state  => 'normal');
		$txprogwin->Subwidget('B_ABORT')->configure(-state => 'disabled');
	    } else { # yes, pseudo, and we're not done...
		do {$pgmnum++;} until $pseudobank[$pgmnum] or $pgmnum == $#pseudobank;
		$sysex_dump = $pseudobank[$pgmnum];
		$tx_retry   = 0;
		txrestart("PSEUDO: Sent patch (p${pgmnum})...");
	    }
	    return;
	}
	$dialogstatus = "TRANSMITTING (${f7seen}): Sent ${sentsize} bytes."
	    unless $pseudo;
    } elsif ($tx_rnlvl == 2) { # verify init
	&rxinit;
	$rx_rnlvl = 1;
	$tx_rnlvl = 3;
    } elsif ($tx_rnlvl == 3) { # verify run (and run, and run...)
	&rxsysex;
    } elsif ($tx_rnlvl == 4) { # verify good
	&channelize;
	substr($sysex_dump, $pbyte, 1) = chr($pgmnum)
	    if not $pseudo and needpatch(0);
	# We verified what we got, and that was what we sent:
	if ($sysex_dump eq $tx_check) { # Grand success!
	    # Ended well normally with no pseudobanking, or,
	    # we did pseudo successfully and that's all done now:
	    if (not $pseudo or $pseudo and $pgmnum >= $#pseudobank) {
		txdone($LCDclr,
		       'white',
		       "Send verified.",
		       "VERIFY: Sent $sentsize bytes, compare good.");
		# Or, yes, pseudobank, and there's more -- queue next patch!
	    } else {
		do {$pgmnum++;} until $pseudobank[$pgmnum] or $pgmnum >= $#pseudobank;
		$sysex_dump = $pseudobank[$pgmnum];
		$tx_retry   = 0;
		txrestart("PSEUDO: Sent/verified patch (p${pgmnum})...");
	    }
	} elsif ($tx_retry < $tx_retries) { # Can we try again?
	    $sysex_dump = $tx_check;
	    txrestart("VERIFY: Tx/Rx fail try $tx_retry, resending...");
	} else { # out of tries (rx doesn't match tx)
	    txdone($errClr,
		   'white',
		   "Transmit failed.",
		   "VERIFY: Send failure after $tx_retry tries.");
	}
    } else { # $tx_rnlvl == 5, verify fail (successive rx runs don't match)
	txdone($errClr,
	       'white',
	       "MIDI Rx/Tx fail.",
	       "FAILED reload $rx_retry times, aborting.");
    }
}
sub txdone {
    $tx_rnlvl        = -1;
    $dlgStatWin->configure(
	-background => $_[0],
	-foreground => $_[1]);
    $message         = $_[2];
    $dialogstatus    = $_[3];
    $handler->cancel;
    $txprogwin->Subwidget('B_DONE')->configure(-state  => 'normal');
    $txprogwin->Subwidget('B_ABORT')->configure(-state => 'disabled');
}
sub txrestart {
    $dialogstatus = $_[0];
    $handler->time($msgwait);
    $tx_rnlvl     = 0;
}
sub dbedit {
    $aboutBtn->configure  (-text       => 'EXIT',
			   -command    => \&endEdit            );
    $editBtn->configure   (-text       => 'EDIT',
			   -background => '#500000',
			   -command    => [ \&editDlg, 'edit' ]);
    $txbtn->configure     (-text       => '+',
			   -font       => $boldFont,
			   -background => 'SteelBlue4',
		     -activebackground => 'CadetBlue',
			   -command    => [ \&editDlg, 'add'  ]);
    $rxbtn->configure     (-text       => '-',
			   -font       => $boldFont,
			   -background => 'SteelBlue4',
		     -activebackground => 'CadetBlue',
			   -command    => \&rmDlg              );
    $brwsButton->configure(-state      => 'disabled'           );
    $dirdisplay->configure(-background => '#300000'            );
    $dbmod    = 0;
    $keepdir  = $datadir;
    $datadir  = 'SELECT A MACHINE PROFILE TO EDIT:';
    $message  = 'database edit mode...';
    &lbdevs;
    $lb->bind('<<ListboxSelect>>'      => ''                   );
    $mw->bind($mw, "<Key-Return>"      => [ \&editDlg, 'edit' ]);
    $mw->bind($mw, "<KP_Enter>"        => [ \&editDlg, 'edit' ]);
}
sub editDlg {
    my $edmode  = $_[0];
    my $selMach = $machines[$lb->curselection->[0]];
    if ($selMach eq $genericdev and $edmode eq 'edit') {
	Error(\$mw, "Generic device cannot be changed.");
    } else {
	return if confirm("Editing your gear database may cause Sysexy\n" .
			  "to function incorrectly.  Your dog will hate you,\n" .
			  "you\'ll be diagnosed with cancer, and you will\n" .
			  "worship Satan in grocery stores.  Continue?") eq 'No';
	my $editwin;
	my @answers   = ();
	my $defans    = '';
	$question     = 0;
	$answers[1]   = '';
	$entrytext    = '';
	%editdb       = ();
	%editdb       = %{dclone \%devspecs};
	$editBtn->configure(-background => $btnBusyClr);
	#
	# Dispatch table for wizard questions:
	%disptbl = (
	    0  => sub { # machine name
		$wizDrpdwn->destroy if Tk::Exists($wizDrpdwn);
		$wizText->configure(-text =>
		   "What machine/instrument/device is this for?\n\n" .
		   "Don\'t be overly specific.  Usually, a given type of sysex dump will work on more than\n" .
		   "one variation of a product.  For example, the keyboard, rackmount, basic, and super-\n" .
		   "duper-expanded-wow-so-many-features version of a given MIDI machine are all usually\n" .
		   "the same sysex dump format, so pick a name that describes the compatibility family.");
		if ($edmode eq 'edit') {
		    $defans = $answers[0] || $selMach;
		} else {
		    $defans = $answers[0] || '';
		}
		$entrytext  = $defans;
		wizenter() unless Tk::Exists($wizEntry);
		$wizEntry->icursor('end');
	    },
	    1  => sub { # dump type
		$wizEntry->destroy;
		$wizText->configure(-text =>
		   "What type of dump is this?\n\n" .
		   "The most common types are suggested in the dropdown below, with \"Bank\" being\n" .
		   "the most typical -- a complete memory bank of patches.  Also common are \"Patch\",\n" .
		   "\"Config\" (for machines that can send their configuration separate from the actual\n" .
		   "sounds), and \"All\" (for machines that can send absolutely everything all at once).\n\n" .
		   "Type in the entry field itself if your device has some dump type other than these,\n" .
		   "but be aware that Sysexy has special understanding of \"Bank\" and \"Patch\" types,\n" .
		   "whereas any other types are more generically handled (like a black box).\n\n" .
		   "Each machine profile can have as many dump types as you want (including ones\n" .
		   "beyond the four suggested types), but you can only create/edit one at a time here.\n" .
		   "If you need to set up more, run the profile editor again after this one is saved.");
		my @havetypes;
		@types = qw/All Config Bank Patch/;
		if ($edmode eq 'edit') {
		    @havetypes = sort keys %{$editdb{$selMach}};
		    foreach my $t (@havetypes) {
			push @types, $t unless grep {$_ eq $t} @types;
		    }
		}
		if ($answers[1]) {
		    push @types, $answers[1] unless grep {$_ eq $answers[1]} @types;
		    $defans = $answers[1];
		} elsif ($edmode eq 'add' or grep {$_ eq 'Bank'} @havetypes) {
		    $defans = 'Bank';
		} else {
		    $defans = $havetypes[0];
		}
		$entrytext  = $defans;
		$wizDrpdwn  = $wizFrame->BrowseEntry(
		    -background       => 'black',
		    -foreground       => 'cyan',
		    -insertbackground => 'red',
		    -listheight       => scalar @types,
		    -font             => $entryFont,
		    -justify          => 'left',
		    -browsecmd        => sub { $wizDrpdwn->icursor('end'); },
		    -choices          => \@types,
		    -variable         => \$entrytext)->grid(
		    -column           => 0,
		    -columnspan       => 2,
		    -row              => 1,
		    -sticky           => 'we');
		$wizDrpdwn->Subwidget('slistbox')->configure(
		    -bg               => 'black',
		    -fg               => 'cyan',
		    -selectbackground => 'IndianRed4',
		    -selectforeground => 'white');
		$wizDrpdwn->icursor('end');
	    },
	    2  => sub { # tag
		$wizDrpdwn->destroy if Tk::Exists($wizDrpdwn);
		$wizText->configure(-text =>
		   "Make a brief, descriptive tag.\n\n" .
		   "Sysexy\'s message status area (in the lower right of the main window) likes to show\n" .
		   "the type of file it thinks you\'re highlighting, and it also uses this same description\n" .
		   "tag internally as a filetype or label for particular recognized types of files.\n\n" .
		   "You should now specify the tag you would like to use for this type of sysex dump\n" .
		   "(or optionally, modify the one displayed below, if you\'re editing an existing entry).\n\n" .
		   "Entering the recognizable name of the instrument followed by the dump type as\n" .
		   "tersely as possible (no superfluous punctuation, etc.) is recommended, example:\n" .
		   "\"ESQ1 bank\", or \"SY99 all\".  This will need to be unique in the entire database,\n" .
		   "and the tag will be rejected if the name you enter is already present.",
		   -font => $wizardFont);
		if ($edmode eq 'edit') {
		    $defans = $answers[2] || $editdb{$selMach}{$answers[1]}{tag} || '';
		} else {
		    $defans = $answers[2] || '';
		}
		$entrytext  = $defans;
		wizenter() unless Tk::Exists($wizEntry);
		$wizEntry->icursor('end');
	    },
	    3  => sub { # request command
		$wizText->configure(-text =>
		   "Do you have your machine\'s manual handy?\n\n" .
		   "Enter the dump request command for this type of dump, in all caps hexadecimal, each byte\n" .
		   "separated by spaces.  Use \"n\" (lowercase) to represent a nybble (half a byte) that should\n" .
		   "be replaced with the MIDI channel when it is transmitted.  For machines like Ensoniqs that\n" .
		   "give a whole byte to the embedded channel, enter \"0n\", since that is what not using the high\n" .
		   "nybble amounts to.  For weird machines that want a CC in the request command, enter\n" .
		   "\"cc\" (lowercase) to represent the status byte, which will be sent by Sysexy with the correct\n" .
		   "MIDI channel.  Don\'t omit the F0 and F7 bytes at begin and end of sysex.\n\n" .
		   "If your device is from the 80\'s, chances are good that this information is in manual, toward\n" .
		   "the end, in the appendix.  If it\'s from the 90\'s, the manufacturer probably assumed that no\n" .
		   "musician really wants that information, but you could send away back then by postal mail\n" .
		   "to get a copy, usually titled \"MIDI Implementation\" or something similar.  (You can almost\n" .
		   "always dig such old supplements up with Google these days.)  If your machine is from the\n" .
		   "2000\'s, the manufacturer will send a Yakuza with automatic weapons to bury you in your\n" .
		   "back yard if they even suspect you have seen their sysex codes.\n\n" .
		   "Some unusual machines with very poor MIDI do not have any dump request commands.\n" .
		   "For such a device, leave this field blank.  We can still support this device, but it will be\n" .
		   "awkward (e.g., Siel DK600).\n\n" .
		   "If this is a patch dump request, it\'s possible this synthesizer may want the preset/patch\n" .
		   "number to be embedded at a particular byte in the request command.  Indicate with \"pp\".\n\n" .
		   "Here\'s a contrived example of a dump request code that uses a CC, and embeds the\n" .
		   "MIDI channel, and has an embedded patch preset location.  In other words, it\'s fake,\n" .
		   "but it puts all three forms of weird on display in one demonstrative command:\n\n" .
		   "cc 57 7F F0 21 5n 01 pp F7",
		   -font => $listboxFont);
		if ($edmode eq 'edit') {
		    $defans = $answers[3] || $editdb{$selMach}{$answers[1]}{dumpcmd} || '';
		} else {
		    $defans = $answers[3] || '';
		}
		$entrytext  = $defans;
		$wizEntry->icursor('end');
	    },
	    4  => sub { # header
		$wizSpinbox->destroy if Tk::Exists($wizSpinbox);
		$wizText->configure(-text =>
		   "Load a dump of this type, from this synth, into a binary editor of your choice.\n\n" .
		   "We want to see raw hexadecimal.  Now, compare it to other dump types from the same\n" .
		   "synthesizer, and note the differences in the first few bytes.  We\'re looking for the binary\n" .
		   "signature of this type of dump, and it\'s important to get this right so Sysexy does not\n" .
		   "misidentify files.\n\n" .
		   "Don\'t provide too many bytes though.  At some point, the bytes will begin to be specific\n" .
		   "to the data in that particular dump, rather than common to any dump of that type.  You\n" .
		   "will have to be careful to get just enough of the front of the file to disambiguate it from\n" .
		   "other TYPES of files, without making it look for THIS SPECIFIC file.\n\n" .
		   "This will go into the database as this dump type\'s \"header,\" and Sysexy will use it to let\n" .
		   "you know what kinds of files you\'re seeing in the scrolling list even if their filenames give\n" .
		   "no clue.\n\n" .
		   "Once you have this information, you\'ll have to enter it below in regular expression format\n" .
		   "(\"regex\").  There is an example below of what this may look like for illustrative purposes,\n" .
		   "but if you\'re editing an existing profile, probably the existing header data for this profile\n" .
		   "is already displayed below in the actual edit field.\n\n" .
		   "Though regex is a vastly expressive language, please be limited for Sysexy\'s sake in the\n" .
		   "way you enter this information, and do not try clever regex tricks.  Every byte should be\n" .
		   "in the format \"\\xHH\", where \"HH\" is the actual hexadecimal byte in caps.  Use regex\n" .
		   "ranges to specify a possible embedded MIDI channel at a particular byte offset in a dump.\n" .
		   "For example, this means the high nybble is 0x5, but the low nybble is unknown because\n" .
		   "it may contain an embedded MIDI channel (note the brackets): \[\\x50-\\x5F\]\n\n" .
		   "Thanks to the fact that a CC status byte always has a high nybble of \"B\" in hex, you can\n" .
		   "express that a CC is embedded in the dump with an unknown MIDI channel as: \[\\xB0-\\xBF\]\n\n" .
		   "For illustrative purposes, here\'s a Frankenstein header that contains a CC and the\n" .
		   "MIDI channel, though probably you won\'t see very many that are quite this strange:\n\n" .
		   "\[\\xB0-\\xBF\]\\x57\\x7F\\xF0\\x21\[\\x20-\\x2F\]\\x01");
		if ($edmode eq 'edit') {
		    $defans = $answers[4] || $editdb{$selMach}{$answers[1]}{header} || '';
		} else {
		    $defans = $answers[4] || '';
		}
		$entrytext  = $defans;
		wizenter() unless Tk::Exists($wizEntry);
		$wizEntry->icursor('end');
	    },
	    5  => sub { # header length
		$wizEntry->destroy if Tk::Exists($wizEntry);
		$wizText->configure(-text =>
		   "How many real bytes were in the header you entered?\n\n" .
		   "Don\'t count the characters in the regular expression.  How many actual bytes\n" .
		   "of sysex file header does it represent?  It\'s okay to click back to the previous\n" .
		   "question to see what you entered, then come back.",
		   -font => $wizardFont);
		if ($edmode eq 'edit') {
		    $defans = $answers[5] || $editdb{$selMach}{$answers[1]}{hdrlen} || 1;
		} else {
		    $defans = $answers[5] || 1;
		}
		$entrytext  = $defans;
		wizspin() unless Tk::Exists($wizSpinbox);
		$wizSpinbox->configure(
		    -from              => 1,
		    -to                => 32);
	    },
	    6  => sub { # dump size
		$wizText->configure(-text =>
		   "If it is possible to know, what is the byte size of this type of dump?\n\n" .
		   "Most MIDI devices produce sysex dumps that are, per dump type, the same\n" .
		   "number of bytes every time.  Sysexy will use this to detect incomplete dumps.\n" .
		   "However, some instruments\' dumps vary size with the data contained in them.\n" .
		   "For machines like this, enter \"0\" for the size.");
		if ($edmode eq 'edit') {
		    $defans = $answers[6] || $editdb{$selMach}{$answers[1]}{size} || 0;
		} else {
		    $defans = $answers[6] || 0;
		}
		$entrytext  = $defans;
		$wizSpinbox->configure(
		    -from              => 0,
		    -to                => 1048576);
	    },
	    7  => sub { # F7 total
		if (Tk::Exists($testedBtns1)) {
		    $testedBtns1->destroy;
		    $testedBtns2->destroy;
		}
		$wizText->configure(-text =>
		   "How many 0xF7 bytes are in this type of dump file?\n\n" .
		   "Typically, a sysex dump file starts with a 0xF0 byte to signal the start\n" .
		   "of a sysex message, and ends with a 0xF7 byte to signal the end.\n\n" .
		   "However, when some synthesizers do a \"bank\" type dump, a dump of\n" .
		   "all the sounds in memory all in one dump, instead of packaging all the\n" .
		   "patches into one conventional file with the expected F0 at the start and\n" .
		   "F7 at the end, they serially send individual patch dumps of every sound\n" .
		   "with separate F0/F7\'s, without pauses between patches -- a sort of fake\n" .
		   "bank dump.  If this device doesn\'t do that, the answer to this question\n" .
		   "will be \"1\", for the single expected F7 at the end.  However, if this is a\n" .
		   "synth that strings together many dumps with separate F7\'s at the end of\n" .
		   "each one to make a \"bank,\" we will need the count of how many to\n" .
		   "expect.  Examine a dump file of this type, and find out how many 0xF7\n" .
		   "bytes there are.  Usually, there is only one, at the end of file.\n\n" .
		   "If this is not a bank type dump, presumably, F7 counts higher than\n" .
		   "one would serve no purpose, and will not be seen (though this is music\n" .
		   "equipment, so anything could happen).");
		if ($edmode eq 'edit') {
		    $defans = $answers[7] || $editdb{$selMach}{$answers[1]}{f7total} || 1;
		} else {
		    $defans = $answers[7] || 1;
		}
		$entrytext  = $defans;
		wizspin() unless Tk::Exists($wizSpinbox);
		$wizSpinbox->configure(
		    -from              => 1,
		    -to                => 2048);
	    },
	    8  => sub { # patch byte
		if (Tk::Exists($testedBtns1)) {
		    $testedBtns1->destroy;
		    $testedBtns2->destroy;
		}
		$wizText->configure(-text =>
		   "Does this synth expect a destination location for patch dumps?\n\n" .
		   "Many synthesizers don\'t need a destination location for patch dumps\n" .
		   "because as soon as they receive the dump, they put the new sound into\n" .
		   "the same \"edit buffer\" in the synth that would be used for modified\n" .
		   "patches that haven\'t been saved yet.  For example, say you\'re making\n" .
		   "a new sound on your synth, so the sound you\'re playing isn\'t really\n" .
		   "saved anywhere yet.  It\'s in a sort of limbo called the edit buffer.  When\n" .
		   "you finish creating it, you may save it to an actual location, but the\n" .
		   "edit buffer is where it is for now.\n\n" .
		   "Some synthesizers put any incoming patch dump into this same buffer,\n" .
		   "and you can then use the synth\'s own menus to save it somewhere.  For\n" .
		   "synths that handle an incoming patch dump this way, enter \"0\" here.\n\n" .
		   "However, there are synths which save an incoming patch immediately,\n" .
		   "and even expect the destination location to be encoded in the dump.\n\n" .
		   "At what byte offset into the dump is the byte which represents the\n" .
		   "destination location to save incoming patch dumps?  (If there are any\n" .
		   "devices that expect a location that is more than one byte, we do not\n" .
		   "support patch dumps for those devices -- sorry.)",
		   -font => $listboxFont);
		if ($edmode eq 'edit') {
		    $defans = $answers[8] || $editdb{$selMach}{Patch}{pbyte} || 0;
		} else {
		    $defans = $answers[8] || 0;
		}
		$entrytext  = $defans;
		wizspin() unless Tk::Exists($wizSpinbox);
		$wizSpinbox->configure(
		    -from              => 0,
		    -to                => 32);
	    },
	    9  => sub { # highest patch
		if (Tk::Exists($testedBtns1)) {
		    $testedBtns1->destroy;
		    $testedBtns2->destroy;
		}
		$wizText->configure(-text =>
		   "What is the highest numbered patch (counting from zero)?\n\n" .
		   "Because you entered that this synth needs a byte to be embedded in a\n" .
		   "single-patch dump to tell it where an incoming patch should be saved,\n" .
		   "we now need to know what is the highest possible value to expect there.\n" .
		   "It cannot be more than 127, since MIDI data is 7-bit.",
		   -font => $wizardFont);
		if ($edmode eq 'edit') {
		    $defans = $answers[9] || $editdb{$selMach}{Patch}{pmax} || 127;
		} else {
		    $defans = $answers[9] || 127;
		}
		$entrytext  = $defans;
		wizspin() unless Tk::Exists($wizSpinbox);
		$wizSpinbox->configure(
		    -from              => 1,
		    -to                => 127);
	    },
	    10 => sub { # tested?
		$wizSpinbox->destroy if Tk::Exists($wizSpinbox);
		$wizAdvice->destroy  if Tk::Exists($wizAdvice);
		$wizText->configure(-text =>
		   "Be honest:  Did you really test to see if this config works?\n\n" .
		   "It\'s helpful to distinguish between setups which ought to work based on some\n" .
		   "manuals you\'ve been able to obtain, versus setups that you know work because\n" .
		   "you\'ve tried it on the machine, expecially if you distribute your Sysexy gear\n" .
		   "setups on the Internet.  You can update this later if you don\'t know yet.",
		   -font => $wizardFont);
		if (not defined $answers[10]) {
		    if ($edmode eq 'edit' and
			exists $editdb{$selMach}{$answers[1]}{tested}) {
			$answers[10] = $editdb{$selMach}{$answers[1]}{tested};
		    } else {
			$answers[10] = 0;
		    }
		}
		$testedBtns1 = $wizFrame->Radiobutton(
		    -background        => $dialogClr,
		    -foreground        => 'black',
		    -font              => $txtfieldFont,
		    -variable          => \$answers[10],
		    -text              => "Some ancient manuals say it\'s possible.",
		    -value             => 0)->grid(
		    -ipadx             => 10,
		    -padx              => 2,
		    -column            => 0,
		    -row               => 1,
		    -sticky            => 'e');
		$testedBtns2 = $wizFrame->Radiobutton(
		    -background        => $dialogClr,
		    -foreground        => 'black',
		    -font              => $txtfieldFont,
		    -variable          => \$answers[10],
		    -text              => "I have checked this on real equipment.",
		    -value             => 1)->grid(
		    -ipadx             => 10,
		    -padx              => 2,
		    -column            => 1,
		    -row               => 1,
		    -sticky            => 'w');
		$editwin->geometry("");
	    },
	    11 => sub { # usage advice
		$testedBtns1->destroy;
		$testedBtns2->destroy;
		$wizText->configure(-text =>
		   "This is optional, and usually should be left blank.\n\n" .
		   "If this machine has idiosyncrasies, especially regarding getting a successful\n" .
		   "sysex dump out of it, you may want to document these here for other users.\n\n" .
		   "In the history of MIDI equipment, there have been machines which require a\n" .
		   "pagan blood sacrifice on a night when the planets are aligned.\n\n" .
		   "Click \"Prev\" to go back and change your answers, or \"Save\" to finish.");
		$editwin->Subwidget('B_Save')->configure(-state => 'normal');
		$wizAdvice = $wizFrame->Scrolled('Text',
		    -scrollbars        => 'oe',
		    -height            => 8,
		    -wrap              => 'word',
		    -font              => $msgFont,
		    -background        => $dialogClr,
		    -foreground        => 'black',
		    -relief            => 'sunken',
		    -borderwidth       => 4,
		    -insertbackground  => 'black')->grid(
		    -sticky            => 'we');
		$wizAdvice->Subwidget('yscrollbar')->configure(-background => 'black');
		if ($edmode eq 'edit') {
		    $answers[11] = $answers[11] || $editdb{$selMach}{$answers[1]}{advice} || '';
		} else {
		    $answers[11] = $answers[11] || '';
		}
		$wizAdvice->insert('end', $answers[11]) if $answers[11];
		# Debian Tk kludge:
		$editwin->geometry("715x400");
		#
		$wizAdvice->focus;
	    } );

	$editwin = $mw->DialogBox(
	    -title                     => 'MIDI MACHINE PROFILE',
	    -buttons                   => [ 'Save', 'Cancel' ],
	    -default_button            => 'Cancel',
	    -cancel_button             => 'Cancel',
	    -bg                        => '#495165');
	$editwin->Subwidget('B_Save')->configure(
	    -font                      => $drpdnLgtFnt,
	    -foreground                => 'white',
	    -background                => 'RosyBrown4',
	    -activebackground          => '#4b0000',
	    -activeforeground          => 'white',
	    -state                     => 'disabled');
	$editwin->Subwidget('B_Cancel')->configure(
	    -font                      => $drpdnLgtFnt,
	    -foreground                => 'white',
	    -background                => $btnNormClr,
	    -activebackground          => $btnDmpActClr,
	    -activeforeground          => 'white');
	# We don't want hitting Enter in the usage advice
	# question page to exit the whole dialog as "Cancel".
	$editwin->bind(
	    $editwin, "<Key-Return>"   => '');

	$wizFrame = $editwin->add('Frame',
	    -background                => '#000056',
	    -relief                    => 'raised')->grid(
	    -sticky                    => 'nsew',
	    -padx                      => 5,
	    -column                    => 0,
	    -row                       => 0,
	    -rowspan                   => 2);
	my $pnFrame = $editwin->add('Frame',
	    -background                => 'black',
	    -relief                    => 'raised')->grid(
	    -padx                      => 5,
	    -column                    => 1,
	    -row                       => 0,
	    -rowspan                   => 2);

	$wizText = $wizFrame->Label(
	    -background                => 'AntiqueWhite4',
	    -foreground                => 'black',
	    -borderwidth               => 4,
	    -relief                    => 'sunken',
	    -justify                   => 'left',
	    -font                      => $wizardFont)->grid(
	    -column                    => 0,
	    -columnspan                => 2,
	    -row                       => 0,
	    -ipadx                     => 32,
	    -ipady                     => 32);
	wizenter();
	$disptbl{0}->();

	$pnFrame->Button(
	    -text                      => '< Prev',
	    -font                      => $requestFont,
	    -background                => 'CadetBlue4',
	    -foreground                => 'black',
	    -activebackground          => 'black',
	    -activeforeground          => 'white',
	    -command                   => sub {
		my @inputcheck = wizvalid($edmode, $defans);
		unless ($inputcheck[0]) {
		    Error(\$mw, $inputcheck[1]);
		    return;
		}
		$answers[$question] = $entrytext if
		    Tk::Exists($wizEntry) or
		    Tk::Exists($wizDrpdwn) or
		    Tk::Exists($wizSpinbox);
		if ($question == 10 and $answers[1] ne 'Patch') {
		    $question = 7;
		    $disptbl{$question}->();
		} elsif ($question == 10 and not $answers[8]) {
		    $question = 8;
		    $disptbl{$question}->();
		} elsif ($question > 0) {
		    if ($question == 11) {
			my $advice   = $wizAdvice->get('1.0', 'end');
			$answers[11] = $advice if $advice =~ /\S/;
		    }
		    $question--;
		    $disptbl{$question}->();
		}
	    })->grid(
	    -ipadx                     => 5);
	$pnFrame->Button(
	    -text                      => 'Next >',
	    -font                      => $requestFont,
	    -background                => 'CadetBlue4',
	    -foreground                => 'black',
	    -activebackground          => 'black',
	    -activeforeground          => 'white',
	    -command                   => sub {
		my @inputcheck = wizvalid($edmode, $defans);
		unless ($inputcheck[0]) {
		    Error(\$mw, $inputcheck[1]);
		    return;
		}
		if ($question == 1 and $answers[1] ne $entrytext) {
		    # If you changed dump type, all your later answers
		    # are now inapplicable and should be thrown out:
		    my $i;
		    for ($i=2; $i<12; $i++) {
			undef $answers[$i];
		    }
		}
		$answers[$question] = $entrytext if
		    Tk::Exists($wizEntry) or
		    Tk::Exists($wizDrpdwn) or
		    Tk::Exists($wizSpinbox);
		if ($question == 7 and $answers[1] ne 'Patch' or
		    $question == 8 and not $answers[8]) {
		    $question = 10;
		    $disptbl{$question}->();
		} elsif ($question < 11) {
		    $question++;
		    $disptbl{$question}->();
		}
	    })->grid(
	    -ipadx                     => 5);

	my $editwin_ans = $editwin->Show(
	    -popover                   => $mw,
	    -overanchor                => 'c',
	    -popanchor                 => 'c');

	if ($editwin_ans eq 'Save') {
	    if ($question              == 11) {
		my $advice             = $wizAdvice->get('1.0', 'end');
		$answers[11]           = $advice if $advice =~ /\S/;
	    }
	    if ($edmode eq 'edit') {
		$devspecs{$answers[0]} = delete $devspecs{$selMach} unless
		    $answers[0] eq $selMach;
		rmobj($answers[0], $answers[1]);
		%devspecs              = ();
		%devspecs              = %{dclone \%editdb};
	    }
	    $devspecs{$answers[0]}{$answers[1]}{tag}     = $answers[2];
	    $devspecs{$answers[0]}{$answers[1]}{dumpcmd} = $answers[3];
	    $devspecs{$answers[0]}{$answers[1]}{header}  = $answers[4];
	    $devspecs{$answers[0]}{$answers[1]}{hdrlen}  = $answers[5];
	    $devspecs{$answers[0]}{$answers[1]}{size}    = $answers[6];
	    $devspecs{$answers[0]}{$answers[1]}{f7total} = $answers[7];
	    $devspecs{$answers[0]}{Patch}{pbyte}         = $answers[8]
		if $answers[1] eq 'Patch';
	    $devspecs{$answers[0]}{Patch}{pmax}          = $answers[9]
		if $answers[8];
	    $devspecs{$answers[0]}{$answers[1]}{tested}  = $answers[10];
	    $devspecs{$answers[0]}{$answers[1]}{advice}  = $answers[11]
		if $answers[11];
	    &gendb;
	    &lbdevs;
	    $dbmod = 1;
	}
	$editBtn->configure(-background => '#500000');
    }
}
sub endEdit {
    # We're done with DBEdit.  Putting things back to normal now...
    if ($dbmod and confirm("Save database changes to disk?") eq 'Yes') {
	my $geardump =
	    Data::Dumper->Dump([\%devspecs], ["\*devspecs"]) . "\n1;\n";
	bzip2 \$geardump => "$cfgdir/geardb" or
	    Error(\$mw, "ERROR: writing gear database to disk.");
    }
    $datadir = $keepdir;
    loadlb();
    $aboutBtn->configure  (-text       => 'About',
			   -command    => \&About   );
    $editBtn->configure   (-text       => 'DBEdit',
			   -background => '#18000c',
			   -command    => \&dbedit  );
    $txbtn->configure     (-text       => 'Tx',
			   -font       => $drpdownFont,
			   -background => $btnNormClr,
		     -activebackground => 'yellow',
			   -command    => \&transmit);
    $rxbtn->configure     (-text       => 'Rx',
			   -font       => $drpdownFont,
			   -background => $btnNormClr,
		     -activebackground => 'yellow',
			   -command    => \&receive );
    $brwsButton->configure(-state      => 'normal'  );
    $dirdisplay->configure(-background => '#06345b' );
    $mw->bind($mw, "<Key-Return>"      => \&transmit);
    $mw->bind($mw, "<KP_Enter>"        => \&transmit);
}
sub rmDlg {
    my $selMach = $machines[$lb->curselection->[0]];
    if ($selMach eq $genericdev) {
	Error(\$mw, "Generic device cannot be deleted.");
    } else {
	$rxbtn->configure(-background  => $btnBusyClr);
	my $rmwin = $mw->DialogBox(
	    -title                     => 'DELETE ELEMENTS',
	    -buttons                   => [ 'MACHINE', 'DUMPTYPE', 'CANCEL' ],
	    -default_button            => 'CANCEL',
	    -cancel_button             => 'CANCEL',
	    -bg                        => 'maroon');
	$rmwin->Subwidget('B_MACHINE')->configure(
	    -font                      => $drpdnLgtFnt,
	    -foreground                => 'white',
	    -background                => 'RosyBrown4',
	    -activebackground          => '#4b0000',
	    -activeforeground          => 'white');
	$rmwin->Subwidget('B_DUMPTYPE')->configure(
	    -font                      => $drpdnLgtFnt,
	    -foreground                => 'white',
	    -background                => 'RosyBrown4',
	    -activebackground          => '#4b0000',
	    -activeforeground          => 'white');
	$rmwin->Subwidget('B_CANCEL')->configure(
	    -font                      => $drpdnLgtFnt,
	    -foreground                => 'white',
	    -background                => $btnNormClr,
	    -activebackground          => $btnDmpActClr,
	    -activeforeground          => 'white');

	my @typeslist = sort keys %{$devspecs{$selMach}};
	my $typesgui  = $rmwin->Scrolled('Listbox',
	    -background                => 'black',
	    -foreground                => 'cyan',
	    -font                      => $listboxFont,
	    -height                    => 5,
	    -selectbackground          => 'IndianRed4',
	    -selectforeground          => 'white',
	    -takefocus                 => 1,
	    -scrollbars                => 'osoe')->grid(
	    -column                    => 0,
	    -row                       => 0);
	$typesgui->insert('end', @typeslist);
	$rmwin->add('Label',
	    -text                      => "Select the dump type to delete and\n" .
					  "click DUMPTYPE, or click MACHINE\n" .
					  "to delete all types for this machine.",
	    -background                => 'AntiqueWhite4',
	    -foreground                => 'black',
	    -borderwidth               => 4,
	    -relief                    => 'sunken',
	    -justify                   => 'left',
	    -font                      => $wizardFont)->grid(
	    -column                    => 1,
	    -row                       => 0,
	    -padx                      => 5,
	    -pady                      => 5,
	    -ipadx                     => 32,
	    -ipady                     => 16);

	$rmwin->resizable(0,0);
	my $rmwin_ans = $rmwin->Show(
	    -popover                   => $mw,
	    -overanchor                => 'c',
	    -popanchor                 => 'c');

	if ($rmwin_ans eq 'MACHINE') {
	    rmobj($selMach);
	    %devspecs = ();
	    %devspecs = %{dclone \%editdb};
	    &gendb;
	    &lbdevs;
	} elsif ($rmwin_ans eq 'DUMPTYPE') {
	    if ($typesgui->curselection) {
		my $selType = $typeslist[$typesgui->curselection->[0]];
		rmobj($selMach, $selType);
		%devspecs = ();
		%devspecs = %{dclone \%editdb};
		&gendb;
		&lbdevs;
	    }
	}
	$rxbtn->configure(-background  => $btnNormClr);
    }
}
sub rmobj {
    my ($killmach, $killtype) = @_;
    %editdb                   = ();
    %devdb                    = ();
    foreach my $machine (keys %devspecs) {
	if (not $killtype and $killmach eq $machine) {
	    $dbmod            = 1;
	    next;
	}
	if ($machine eq $genericdev) {
	    $editdb{$machine} = '';
	    next;
	}
	foreach my $dumptype (keys %{$devspecs{$machine}}) {
	    if ($killtype and
		$killtype eq $dumptype and
		$killmach eq $machine) {
		$dbmod        = 1;
		next;
	    }
	    foreach my $field (keys %{$devspecs{$machine}{$dumptype}}) {
		$editdb{$machine}{$dumptype}{$field} =
		    $devspecs{$machine}{$dumptype}{$field};
	    }
	}
    }
}
sub wizenter {
    $wizEntry = $wizFrame->Entry(
	-background       => 'black',
	-foreground       => 'cyan',
	-insertbackground => 'red',
	-takefocus        => 1,
	-font             => $entryFont,
	-justify          => 'left',
	-textvariable     => \$entrytext)->grid(
	-column           => 0,
	-columnspan       => 2,
	-row              => 1,
	-sticky           => 'we');
    $wizEntry->focus;
}
sub wizspin {
    $wizSpinbox = $wizFrame->Spinbox(
	-textvariable      => \$entrytext,
	-font              => $entryFont,
	-justify           => 'center',
	-increment         => 1,
	-background        => 'black',
	-foreground        => 'white',
	-insertbackground  => 'red',
	-buttonbackground  => 'black')->grid(
	-column            => 0,
	-columnspan        => 2,
	-row               => 1,
	-sticky            => 'we');
}
sub wizvalid {
    my ($edmode, $defans)              = @_;
    my $good                           = 1;
    my $errmsg                         = "";

    if ($question                      == 0) {
	if (not $entrytext) {
	    ($good, $errmsg)           = (0, "Machine name is required.");
	} elsif ($entrytext            =~ /[\[\]]/) {
	    ($good, $errmsg)           = (0, "Brackets are not allowed.");
	} elsif ($edmode eq 'add' and
		 $entrytext ne $defans and
		 grep {$_ eq $entrytext} keys %editdb) {
	    ($good, $errmsg)           = (0, "Machine already exists in database.");
	}
    } elsif ($question                 == 1
	     and not $entrytext) {
	($good, $errmsg)               = (0, "Dump type is required.");
    } elsif ($question                 == 2) {
	if (not $entrytext) {
	    ($good, $errmsg)           = (0, "Filetype tag is required.");
	} elsif (length($entrytext)    > 16) {
	    ($good, $errmsg)           = (0, "Cannot be over 16 characters.");
	} elsif ($entrytext ne $defans) {
	  SCAN: foreach my $m (keys %editdb) {
	      foreach my $d (keys %{$editdb{$m}}) {
		  if (defined $editdb{$m}{$d}{tag} and
		      $editdb{$m}{$d}{tag} eq $entrytext) {
		      ($good, $errmsg) = (0, "Tag already exists.");
		      last SCAN;
		  }
	      }
	  }
	}
    } elsif ($question                 == 3 and $entrytext =~ /[^0-9A-F cnp]/) {
	($good, $errmsg)               = (0, "Illegal characters in string.");
    } elsif ($question                 == 4) {
	if (not $entrytext) {
	    ($good, $errmsg)           =
		(0, "File header required for non-generic devices.");
	} elsif ($entrytext            =~ /[^0-9A-Fx\\\[\]-]/) {
	    ($good, $errmsg)           = (0, "Illegal characters in string.");
	}
    }
    return $good, $errmsg;
}
sub lbdevs {
    my $index    = first_index {$_ eq "$lastdev"} @machines;
    if ($index  == -1) {
	$index   = 0;
	$lastdev = $genericdev;
    }
    $lb->delete(0, 'end');
    $lb->insert('end', @machines);
    $lb->focus;
    $lb->see($index);
    $lb->activate($index);
    $lb->selectionSet($index);
}
sub progquit {
    if ($savecfg and confirm("Save configuration changes\nbefore quitting?") eq 'Yes') {
	$cfg->param('main.datadir', "$datadir");
	$cfg->param('main.lastdev', "$lastdev");
	make_path "$cfgdir" unless -d "$cfgdir";
	$cfg->save("$cfgfile") or Error(\$mw, "Error writing configuration,\ncheck permissions.");
    }
    exit;
}
sub About {
    my $aboutwin = $mw->DialogBox(
	-title                   => 'About',
	-buttons                 => [ 'Ok' ],
	-default_button          => 'Ok',
	-bg                      => $dialogClr);
    $aboutwin->resizable(0,0);
    $aboutwin->add('Label',
		   -image        => $icon)->grid(
		   -row          => 0,
		   -column       => 0) if $icon;
    $aboutwin->add('Label',
		   -text         =>
		   "Sysexy MIDI Librarian\nversion $version\n" .
		   "\x{00A9} $relyear, Brent Busby\n" .
		   "\{$reltag release\}\n\n" .
		   "GNU General Public License version 2",
		   -justify      => 'left',
		   -padx         => 15,
		   -pady         => 15,
		   -font         => $txtfieldFont,
		   -foreground   => 'black',
		   -background   => $dialogClr)->grid(
		   -row          => 0,
		   -column       => 1);
    $aboutwin->Show(
	-popover                 => $mw,
	-overanchor              => 'c',
	-popanchor               => 'c');
}
sub confirm {
    my $confirmwin = $mw->DialogBox(
	-title                   => 'CONFIRM',
	-buttons                 => [ 'Yes', 'No' ],
	-default_button          => 'No',
	-bg                      => 'moccasin');
    $confirmwin->Subwidget('B_Yes')->configure(
	-foreground              => 'black');
    $confirmwin->Subwidget('B_No')->configure(
	-foreground              => 'black');
    $confirmwin->resizable(0,0);
    $confirmwin->add('Label',
		     -text       => $_[0],
		     -justify    => 'left',
		     -padx       => 15,
		     -pady       => 15,
		     -font       => $txtfieldFont,
		     -foreground => 'black',
		     -background => $dialogClr)->pack;
    my $ans = $confirmwin->Show(
	-popover                 => $mw,
	-overanchor              => 'c',
	-popanchor               => 'c');
    return $ans;
}
sub Error {
    my ($win, $msg) = @_;
    my $errorwin    = $mw->DialogBox(
	-title                   => 'Error',
	-buttons                 => [ 'Ok' ],
	-default_button          => 'Ok',
	-bg                      => 'maroon',
	-fg                      => 'white');
    $errorwin->resizable(0,0);
    $errorwin->add('Label',
		     -text       => $msg,
		     -justify    => 'left',
		     -padx       => 15,
		     -pady       => 15,
		     -font       => $txtfieldFont,
		     -background => 'maroon',
		     -foreground => 'white')->pack;
    $errorwin->Show(
	-popover                 => $mw,
	-overanchor              => 'c',
	-popanchor               => 'c');
}
sub browsebtn {
    <<'end-of-x11-data';
#define browse_width 64
#define browse_height 32
static unsigned char browse_bits[] = {
   0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff, 0x40, 0x00, 0x00, 0xc0,
   0xff, 0xff, 0xff, 0xff, 0xe8, 0x01, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff,
   0x00, 0x1e, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff, 0x70, 0x00, 0x00, 0xc0,
   0xff, 0xff, 0xff, 0xff, 0xd0, 0x1e, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff,
   0x0c, 0x10, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff, 0x0c, 0x30, 0x00, 0xc0,
   0xff, 0xff, 0xff, 0xff, 0x04, 0x30, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff,
   0x08, 0x20, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff, 0x08, 0x10, 0x10, 0xc0,
   0xff, 0xff, 0xff, 0xff, 0xb8, 0x17, 0x70, 0xc2, 0xff, 0xff, 0xff, 0xff,
   0x00, 0x00, 0x84, 0xc5, 0x18, 0x67, 0xe9, 0xc0, 0x80, 0x01, 0xb8, 0xc3,
   0x56, 0x5b, 0x69, 0xf6, 0x80, 0xde, 0x05, 0xc4, 0x90, 0xdb, 0xf4, 0xc4,
   0x00, 0x40, 0x04, 0xc4, 0x56, 0xdb, 0xf2, 0xf3, 0x00, 0x40, 0x04, 0xc4,
   0x58, 0xe7, 0x76, 0xc0, 0x00, 0x40, 0x04, 0xc4, 0xff, 0xff, 0xff, 0xff,
   0x00, 0x40, 0x74, 0xc2, 0xff, 0xff, 0xff, 0xff, 0x00, 0x40, 0xd0, 0xc1,
   0xff, 0xff, 0xff, 0xff, 0x00, 0x40, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff,
   0x00, 0x40, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff, 0x00, 0x40, 0x38, 0xc0,
   0xff, 0xff, 0xff, 0xff, 0x00, 0x40, 0x84, 0xc7, 0xff, 0xff, 0xff, 0xff,
   0x00, 0x40, 0x44, 0xc5, 0xff, 0xff, 0xff, 0xff, 0x00, 0x40, 0xec, 0xc5,
   0xff, 0xff, 0xff, 0xff, 0x00, 0x40, 0x04, 0xc4, 0xff, 0xff, 0xff, 0xff,
   0x00, 0xc0, 0x04, 0xc4, 0xff, 0xff, 0xff, 0xff, 0x00, 0x00, 0x04, 0xc4,
   0xff, 0xff, 0xff, 0xff, 0x00, 0x00, 0x04, 0xc4, 0xff, 0xff, 0xff, 0xff,
   0x00, 0x00, 0xb8, 0xc3, 0xff, 0xff, 0xff, 0xff, 0x00, 0x00, 0x00, 0xc0,
   0xff, 0xff, 0xff, 0xff };
end-of-x11-data
}
sub pgmchgbtn {
    <<'end-of-x11-data';
#define pgmchg_width 50
#define pgmchg_height 20
static unsigned char pgmchg_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x10, 0x00, 0x00,
   0x00, 0x00, 0x30, 0x00, 0x14, 0x00, 0x00, 0x00, 0x00, 0x60, 0x00, 0x14,
   0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x14, 0x00, 0x00, 0x00, 0x00, 0x80,
   0x00, 0x14, 0x3c, 0x00, 0x30, 0x01, 0x80, 0x00, 0x14, 0x4c, 0x00, 0x48,
   0x01, 0x80, 0x00, 0x14, 0x4c, 0xb7, 0x04, 0xe7, 0x80, 0x00, 0x14, 0xbc,
   0x54, 0x05, 0x99, 0x80, 0x00, 0x14, 0x8c, 0x54, 0x49, 0x99, 0x80, 0x00,
   0x14, 0x0c, 0x57, 0x31, 0xe9, 0x80, 0x00, 0x14, 0x00, 0x04, 0x00, 0x80,
   0x80, 0x00, 0x14, 0x00, 0x03, 0x00, 0x70, 0x80, 0x00, 0x14, 0x00, 0x00,
   0x00, 0x00, 0x80, 0x00, 0x14, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 0xf4,
   0xff, 0xff, 0xff, 0xff, 0xff, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0x3f, 0x00 };
end-of-x11-data
}
sub advicebtn {
    <<'end-of-x11-data';
#define advice_width 50
#define advice_height 20
static unsigned char advice_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x10, 0x00, 0x00,
   0x00, 0x00, 0x30, 0x00, 0x14, 0x00, 0x00, 0x00, 0x00, 0x60, 0x00, 0x14,
   0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x14, 0x04, 0x08, 0x08, 0x00, 0x80,
   0x00, 0x14, 0x0a, 0x08, 0x00, 0x00, 0x80, 0x00, 0x14, 0x8a, 0x2f, 0x8a,
   0xe3, 0x80, 0x00, 0x14, 0x8a, 0x28, 0x4a, 0x16, 0x81, 0x00, 0x14, 0x91,
   0x48, 0x49, 0x10, 0x81, 0x00, 0x14, 0x9f, 0x48, 0x49, 0xf0, 0x81, 0x00,
   0x14, 0x91, 0x48, 0x49, 0x10, 0x80, 0x00, 0x94, 0xb1, 0x48, 0x49, 0x16,
   0x81, 0x00, 0x94, 0xa0, 0x8f, 0x88, 0xe3, 0x80, 0x00, 0x14, 0x00, 0x00,
   0x00, 0x00, 0x80, 0x00, 0x14, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 0xf4,
   0xff, 0xff, 0xff, 0xff, 0xff, 0x00, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0xfc, 0xff, 0xff, 0xff, 0xff, 0x3f, 0x00 };
end-of-x11-data
}

#   All things must end.  :(
#   This block runs no matter how the program ended,
#   either by graceful quit, or because of an error.
END { MIDI::ALSA::stop(); }
