#!/usr/bin/perl
use strict;
use warnings;
use Cwd;
use Fcntl;
use threads;
use Net::NNTP;
use Date::Parse;
use Date::Format;
use threads::shared;
use MLDBM qw(DB_File Storable);
use Convert::UU qw(uuencode);
use Convert::BulkDecoder;
$| = 1;

########################################################################Optional Modules
if ($^O eq 'MSWin32') {
  eval    { require Win32::Console; Win32::Console::Free() };
  if ($@) { warn "Win32::Console is not installed.\n$@";   }
}
########################################################################Declarations
my $VERSION = 3.00;
my($mw, %shash, %threads,);
########################################################################Threads
foreach my $TID (1) {
  share($shash{$TID}{article});   $shash{$TID}{article}   = 0;
  share($shash{$TID}{decode});    $shash{$TID}{decode}    = 0;
  share($shash{$TID}{post});      $shash{$TID}{post}      = 0;
  share($shash{$TID}{die});       $shash{$TID}{die}       = 0;
  share($shash{$TID}{return});    $shash{$TID}{return}    = 0;
  share($shash{$TID}{progress});  $shash{$TID}{progress}  = 0;
  share($shash{$TID}{optionCSV}); $shash{$TID}{optionCSV} = 0;
  warn "Launching thread $TID\n";
  $threads{$TID} = threads->new(\&worker, $TID);
  warn "Thread $TID is active\n";
}
########################################################################Main
use Tk::ResizeButton;
use Tk::ProgressBar;
use Tk::ItemStyle;
use Tk::ROText;
use Tk::HList;
use Tk::Pod;
use Tk;

open ('STDERR', '>', 'NewsSurfer.log')
  || warn "Cannot create NewsSurfer.log\n$!";
foreach (glob "part*.pt") {                                             #todo - recovery
  unlink $_ || warn "unable to delete part.\n$!";
}
$mw = MainWindow->new(
  -relief   => 'groove',
  -colormap => 'new',
  -bd       => 2,
);
&splash();
&news_gui();
&Tk::MainLoop();

foreach my $k (sort keys %threads) {
  warn "Destroying Thread [$k]\n";
  $shash{$k}{'die'} = 1;
  sleep(1);
}
warn "Exiting..\n";
close STDERR;
exit;
########################################################################Subroutines
sub splash #------------------------------------------------------------
{
  my ($image, $splash, $canvas,);
  $mw->gridPropagate(0);
  $mw->withdraw;
  
  {
    my $imagedata = &load_image(1);
    $image = $mw->Photo(
      -format => 'gif',
      -data   => $imagedata
    );
  }
  
  my $width  = $mw->screenwidth;
  my $height = $mw->screenheight;
  my $x = ($width - 500) / 2;
  my $y = ($height - 288) / 2;
  my $geometry = '500x288+'.$x.'+'.$y;
  
  $splash = $mw->Toplevel(-takefocus => 1,);
  $splash->overrideredirect(1);
  $splash->geometry($geometry);
  $splash->resizable(0, 0);
  $canvas = $splash->Canvas()->pack(
    -fill   => 'both',
    -expand => 1,
  );
  $canvas->createImage(0,0,
    -image  => $image,
    -anchor => 'nw',
  );
  
  $mw->after(12000, sub {
    $splash->destroy;
    $mw->GeometryRequest($width,$height);
    $mw->Post(-5,-5);
    $mw->update;
  });
  return(1);
}
sub news_gui #----------------------------------------------------------
{
  #Widget Initialization
  our $sort_cnt = 3;
  our $msglimitOption;
  my $sys_bg = $mw->cget(-background);
  my $sys_fg = $mw->cget(-foreground);
  dbmopen(my %OPT, 'settings', '0640')
    || die "Cannot create settings.\n$!";
  unless ($OPT{Mail}) { $OPT{Mail} = 'NewsSurfer@domain.invalid';  }
  unless ($OPT{DDir}) { $OPT{DDir} = '.';                          }
  unless (-e "$OPT{DDir}" and -d "$OPT{DDir}") { $OPT{DDir} = '.'; }
  dbmclose %OPT;
  $mw->gridRowconfigure(2,    -weight  => 1,);
  $mw->gridRowconfigure(4,    -minsize => 8,);
  $mw->gridColumnconfigure(1, -weight  => 1,);
  $mw->setPalette(
    background       => '#a1a1a1',
    activebackground => '#a1a1a1',
    activeforeground => '#000fff',
  );
  
  #create frames and panedwindow
  my($pw1, $f1_main, $f2_main, $f3_main,);
  {
    $f1_main = $mw->Frame(
      -relief => 'flat',
      -bd     => 2,
    )->grid(
      -in     => $mw,    -column => '1', -padx => '8',
      -sticky => 'news', -row    => '1', -pady => '0',
    );
    $f1_main->gridColumnconfigure(2,  -minsize => 8,);
    $f1_main->gridColumnconfigure(7,  -minsize => 8,);
    $f1_main->gridColumnconfigure(11, -minsize => 8,);
    $f1_main->gridColumnconfigure(14, -weight  => 1,);
    $f2_main = $mw->Frame(
      -relief => 'groove',
      -bd     => 4,
    )->grid(
      -in     => $mw,    -column => '1', -padx => '8',
      -sticky => 'news', -row    => '2', -pady => '0',
    );
    $f2_main->gridRowconfigure(1,     -weight  => 1,);
    $f2_main->gridColumnconfigure(1,  -weight  => 1,);
    $f3_main = $mw->Frame(
      -relief => 'groove',
      -bd     => 2,
    )->grid(
      -in     => $mw,    -column => '1', -padx => '8',
      -sticky => 'news', -row    => '3', -pady => '0',
    );
    $f3_main->gridRowconfigure(1,     -weight  => 1,);
    $f3_main->gridColumnconfigure(1,  -weight  => 1,);
    $pw1 = $f2_main->Panedwindow(
      -orient => 'vertical',
      -relief => 'groove',
      -bd     => 2,
    )->grid(
      -in     => $f2_main, -row    => '1',
      -sticky => 'news',   -column => '1',
    );
  }
  
  #frame 1 (toolbar frame)
  my $logo;
  our @buttons;
  {
    $logo = $mw->Label(
      -text => 'NewsSurfer',
      -font => '{Courier New} 16',
    )->grid(
      -in     => $f1_main, -column => '14',
      -sticky => 'news',   -row    => '1',
    );
    
    my $c = 1;
    foreach my $l qw(scan grab read_message post browse
                     group opt show_log help quit) {
      my $sub = \&{ $l; };
      my $w = $f1_main->Button(
        -bd                 => 0,
        -highlightthickness => 0,
        -activebackground   => '#a1a1a1',
        -command            => sub {
          &$sub();
        },
      )->grid(
        -in     => $f1_main, -column => $c,
        -sticky => 'news',   -row    => '1',
      );
      push (@buttons, $w);
      if ($c =~ m/^(1|6|10)$/) { $c++; }
      $c++;
    }
  }
  
  #frame 2 (main display frame)
  #upper HList (group subscriptions)
  our $lb1_grp;
  {
    $lb1_grp = $pw1->Scrolled(
      'HList',
      -highlightthickness => 1,
      -columns            => 3,
      -header             => 1,
      -height             => 3,
      -indicator          => 1,
      -indicatorcmd       => sub {},
      -font               => '{Ariel} 8',
      -highlightcolor     => '#000000',
      -scrollbars         => 'ose',
      -background         => '#ffffff',
      -foreground         => '#000000',
      -selectbackground   => '#000000',
      -selectforeground   => '#fff000',
      -selectmode         => 'single',
    );
    my $c = 0;
    foreach my $label ('Group', 'Last Scanned', '',) {
      my $w = $lb1_grp->ResizeButton(
        -widget           => \$lb1_grp,
        -column           => $c,
        -text             => "$label",
        -font             => '{Ariel} 8',
        -activebackground => '#a1a1a1',
        -activeforeground => '#000000',
        -relief           => 'flat',
        -anchor           => 'w',
        -borderwidth      => 0,
        -takefocus        => 0,
        -command          => sub {},
      );
      $lb1_grp->columnWidth($c, -char => '1');
      $lb1_grp->header(
        'create', $c,
        -itemtype         => 'window',
        -headerbackground => '#a1a1a1',
        -widget           => $w,
        -borderwidth      => 1,
      );
      $c++;
    }
    $lb1_grp->columnWidth (0, -char => '95');
    $lb1_grp->columnWidth (1, -char => '25');
    $lb1_grp->columnWidth (2, -char => '');
  }
  
  #lower HList
  our($lb2_msg,);
  {
    $lb2_msg = $pw1->Scrolled(
      'HList',
      -highlightthickness => 1,
      -columns            => 6,
      -header             => 1,
      -indicator          => 1,
      -indicatorcmd       => sub {},
      -separator          => '^',
      -scrollbars         => 'ose',
      -highlightcolor     => '#000000',
      -background         => '#ffffff',
      -foreground         => '#000000',
      -selectbackground   => '#000000',
      -selectforeground   => '#fff000',
      -selectmode         => 'extended',
    );
    #lower HList column headers
    my $c = 0;
    foreach my $label ('Headers', 'From', 'Parts',
                       'Bytes', 'Date', ' ',) {
      my $w = $lb2_msg->ResizeButton(
        -widget           => \$lb2_msg,
        -column           => $c,
        -text             => "$label",
        -font             => '{Ariel} 8',
        -activebackground => '#a1a1a1',
        -activeforeground => '#000fff',
        -relief           => 'flat',
        -anchor           => 'w',
        -borderwidth      => 0,
        -takefocus        => 0,
        -command          => sub {
          &lb2_msg_sort("$label")
      },);
      $lb2_msg->columnWidth($c, -char => '1');
      $lb2_msg->header(
        'create', $c,
        -itemtype         => 'window',
        -headerbackground => '#a1a1a1',
        -widget           => $w,
        -borderwidth      => 1,
      );
      $c++;
    }
    $lb2_msg->columnWidth (0, -char => '68');
    $lb2_msg->columnWidth (1, -char => '10');
    $lb2_msg->columnWidth (2, -char => '7');
    $lb2_msg->columnWidth (3, -char => '10');
    $lb2_msg->columnWidth (4, -char => '25');
    $lb2_msg->columnWidth (5, -char => '');
  }
  
  #frame 3 ('Statusbar frame')
  our($sb_lab,);
  our $sblabel = ' ';
  our $pb      = 0;
  {
    $sb_lab = $mw->Label(
      -text   => "  $sblabel",
      -anchor => 'w',
      -relief => 'sunken',
      -bd     => 2,
    )->grid(
      -in     => $f3_main, -column => '1',
      -sticky => 'ew',     -row    => '1',
    );
    $mw->ProgressBar(
      -length   => 270,
      -relief   => 'sunken',
      -bd       => 2,
      -from     => 0,
      -to       => 100,
      -blocks   => 50,
      -colors   => [0, 'green'],
      -variable => \$pb,
    )->grid(
      -in     => $f3_main, -column => '2',
      -sticky => 'news',   -row    => '1',
    );
  }
  
  #log window
  our($tl1, $txt_log,);
  {
    $tl1 = $mw->Toplevel(
      -relief => 'groove',
      -bd     => 2,
    );
    $tl1->title('View Log');
    $tl1->transient($mw);
    $tl1->withdraw;
    
    my $f = $tl1->Frame(
      -relief => 'sunken',
      -bd     => 2,
    )->grid(
      -in     => $tl1, -columnspan => '2',
      -column => '1',  -rowspan    => '1',
      -row    => '1',  -sticky     => 'news'
    );
    $txt_log = $f->Scrolled(
      'ROText',
      -scrollbars       => 'se',
      -foreground       => '#ffffff',
      -background       => '#000000',
      -selectforeground => '#fff000',
      -selectbackground => '#000000',
      -wrap             => 'none',
      -relief           => 'flat',
      -bd               => 0,
      -width            => 80,
      -height           => 30,
    )->grid(
      -in     => $f,  -columnspan => '1',
      -column => '1', -rowspan    => '1',
      -row    => '1', -sticky     => 'news'
    );
    $txt_log->tagConfigure('Red',    -foreground => '#ff0000');
    $txt_log->tagConfigure('Blue',   -foreground => '#000fff');
    $txt_log->tagConfigure('Yellow', -foreground => '#fff000');
    {
      my $menu = $txt_log->menu;
      $menu->configure(
        -bg               => $sys_bg,
        -fg               => $sys_fg,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
      );
      $menu->delete('File');
      $menu->delete('Search');
      $menu->delete('View');
    }
    my $c = 1;
    foreach my $label ('C l o s e', 'S a v e',) {
      my $s = 'w';
      if ($c > 1) { $s = 'e' };
      my $sublabel = $label;
      $sublabel =~ s/\s//g;
      my $sub = \&{ 'log_'.lc($sublabel); };
      my $w = $tl1->Button(
        -text             => $label,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
        -relief           => 'flat',
        -command          => sub {
          &$sub();
        },
      )->grid(
        -in     => $tl1, -column => $c,
        -sticky => $s,   -row    => '4',
      );
      &FlashButton($w, '#181830', $sys_fg);
      $c++;
    }
  }
  
  #post message window
  our($tl2, $txt_post, @post_entries,);
  {
    $tl2 = $mw->Toplevel(
      -relief => 'groove',
      -bd     => 2,
    );
    $tl2->title('Post Message');
    $tl2->resizable(0, 0);
    $tl2->transient($mw);
    $tl2->withdraw;
    $tl2->gridColumnconfigure(3, -weight => 1,);
    
    my $c = 1;
    foreach my $label ('From:  ', 'Subject:  ',) {
      $tl2->Label(
        -text => $label,
      )->grid(
        -in     => $tl2, -column => '1',
        -sticky => 'e',  -row    => $c,
      );
      my $w = $tl2->Entry(
        -width        => 60,
        -background   => '#ffffff',
        -foreground   => '#000000',
      )->grid(
        -in     => $tl2, -columnspan => '2',
        -column => '2',  -rowspan    => '1',
        -row    => $c,   -sticky     => 'w'
      );
      $c++;
      push (@post_entries, $w);
    }
    
    my $f = $tl2->Frame(
      -relief => 'sunken',
      -bd     => 2,
    )->grid(
      -in     => $tl2, -columnspan => '4',
      -column => '1',  -rowspan    => '1',
      -row    => '3',  -sticky     => 'nws'
    );
    $txt_post = $f->Scrolled(
      'Text',
      -scrollbars       => 'se',
      -background       => '#ffffff',
      -foreground       => '#000000',
      -selectforeground => '#fff000',
      -selectbackground => '#000000',
      -relief           => 'flat',
      -wrap             => 'none',
      -height           => 30,
      -width            => 80,
    )->grid(
      -in     => $f,    -column => '1',
      -sticky => 'nws', -row    => '1',
    );
    {
      my $post_menu = $txt_post->menu;
      $post_menu->delete('File');
      $post_menu->delete('Search');
      $post_menu->delete('View');
    }
    $c = 1;
    foreach my $label ('C a n c e l    ', 'P o s t    ',) {
                       #'A t t a c h  a n d  P o s t',) {               #temporarily disabled
      my $sublabel = $label;
      $sublabel =~ s/\s//g;
      my $sub = \&{ 'post_'.lc($sublabel); };
      my $w = $tl2->Button(
        -text             => $label,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
        -relief           => 'flat',
        -command          => sub { &$sub(); },
      )->grid(
        -in     => $tl2, -column => $c,
        -sticky => 'w',  -row    => '4',
      );
      &FlashButton($w, '#181830', $sys_fg);
      $c++;
    }
  }
  
  #groups subscription window
  our ($tl3, $lb_grp, $search,);
  {
    $tl3 = $mw->Toplevel(
      -relief => 'groove',
      -bd     => 2,
    );
    $tl3->title('Groups');
    $tl3->geometry("+90+35");
    $tl3->resizable(0, 0);
    $tl3->transient($mw);
    $tl3->withdraw;
    $tl3->gridColumnconfigure(5, -weight => 1,);
    
    my $f = $tl3->Frame(
      -relief => 'sunken',
      -bd     => 2,
    )->grid(
      -in     => $tl3, -columnspan => '5',
      -column => '1',  -rowspan    => '1',
      -row    => '2',  -sticky     => 'news'
    );
    $lb_grp = $f->Scrolled(
      'HList',
      -scrollbars         => 'ose',
      -background         => '#000000',
      -foreground         => '#ffffff',
      -selectbackground   => '#fff000',
      -selectforeground   => '#000000',
      -highlightthickness => 0,
      -selectmode         => 'extended',
      -relief             => 'flat',
      -takefocus          => 0,
      -header             => 1,
      -columns            => 2,
      -indicator          => 1,
      -height             => 30,
      -width              => 96,
      -indicatorcmd       => sub {}, #do nothing
    )->grid(
      -in     => $f,     -column => '1',
      -sticky => 'news', -row    => '1',
    );
    $lb_grp ->columnWidth (0, -char => '70');
    $lb_grp ->columnWidth (1, -char => '20');
    $lb_grp ->headerCreate(0, -text => "Newsgroups",);
    $lb_grp ->headerCreate(1, -text => "Message Count",);
    
    $f = $tl3->Frame(
      -relief => 'flat',
    )->grid(
        -in     => $tl3, -column => '1', -columnspan => '5',
        -sticky => 'ew', -row    => '1', -rowspan    => '1',
    );
    $f->gridColumnconfigure(3, -weight => 1,);
    my $e = $tl3->Entry(
      -background   => '#ffffff',
      -foreground   => '#000000',
      -textvariable => \$search,
      -width        => 40,
    )->grid(
      -in     => $f,   -column => '1',
      -sticky => 'ew', -row    => '1',
    );
    $e->bind('<Return>' => sub {
      &search($lb_grp);
    });
    my $c = 2;
    foreach my $label ('S e a r c h',
                       'S h o w   N e w s g r o u p s') {
      my $sublabel = $label;
      $sublabel =~ s/\s+//g;
      my $sub = \&{ 'grp_'.lc($sublabel); };
      my $w = $f->Button(
        -text             => $label,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
        -relief           => 'flat',
        -command          => sub{
          &$sub();
        }
      )->grid(
        -in     => $f,   -column => $c,
        -sticky => 'ew', -row    => '1',
      );
      &FlashButton($w, '#181830', $sys_fg);
      $c += 2;
    }
    $c = 1;
    foreach my $label ('C l o s e    ',
                       'U p d a t e    ',
                       'S u b s c r i b e    ',
                       'U n S u b s c r i b e',) {
      my $sublabel = $label;
      $sublabel =~ s/\s//g;
      my $sub = \&{ 'grp_'.lc($sublabel); };
      my $w = $tl3->Button(
        -text             => $label,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
        -relief           => 'flat',
        -command          => sub {
          &$sub();
        },
      )->grid(
        -in     => $tl3, -column => $c,
        -sticky => 'n',  -row    => '3',
      );
      &FlashButton($w, '#181830', $sys_fg);
      $c++;
    }
  }
  
  #read message window
  our($tl4, $txt_read,);
  {
    $tl4 = $mw->Toplevel(
      -relief => 'groove',
      -bd     => 2,
    );
    $tl4->title('Read Message');
    $tl4->transient($mw);
    $tl4->withdraw;
    my $f = $tl4->Frame(
      -relief => 'sunken',
      -bd     => 2,
    )->grid(
      -in     => $tl4, -columnspan => '2',
      -column => '1',  -rowspan    => '1',
      -row    => '1',  -sticky     => 'news'
    );
    $txt_read = $f->Scrolled(
      'ROText',
      -scrollbars       => 'se',
      -background       => '#ffffff',
      -foreground       => '#000000',
      -selectforeground => '#fff000',
      -selectbackground => '#000000',
      -wrap             => 'none',
      -relief           => 'flat',
      -width            => 80,
      -height           => 30,
    )->grid(
      -in     => $f,  -columnspan => '1',
      -column => '1', -rowspan    => '1',
      -row    => '1', -sticky     => 'news'
    );
    {
      my $read_menu = $txt_read->menu;
      $read_menu->configure(
        -bg               => $sys_bg,
        -fg               => $sys_fg,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
      );
      $read_menu->delete('File');
      $read_menu->delete('Search');
      $read_menu->delete('View');
    }
    my $c = 1;
    foreach my $label ('C l o s e', 'R e p l y',) {
      my $s = 'w';
      if ($c > 1) { $s = 'e' };
      my $sublabel = $label;
      $sublabel =~ s/\s//g;
      my $sub = \&{ 'read_'.lc($sublabel); };
      my $w = $tl4->Button(
        -text             => $label,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
        -relief           => 'flat',
        -command          => sub {
          &$sub();
        },
      )->grid(
        -in     => $tl4, -column => $c,
        -sticky => $s,   -row    => '4',
      );
      &FlashButton($w, '#181830', $sys_fg);
      $c++;
    }
  }
  
  #options window
  our($tl5, @OPT_entries,);
  {
    $tl5 = $mw->Toplevel(
      -relief    => 'groove',
      -bd        => 2,
      -takefocus => 1,
    );
    $tl5->title('Options');
    $tl5->geometry("+105+70");
    $tl5->resizable(0, 0);
    $tl5->transient($mw);
    $tl5->withdraw;
    
    my $f = $tl5->Frame(
      -bd     => 3,
      -relief => 'sunken',
      -bg     => '#000000',
    )->grid(
      -in     => $tl5, -column => '1',
      -sticky => 'e',  -row    => '1',
    );
    $f->gridRowconfigure(5,    -minsize => 8,);
    $f->gridRowconfigure(8,    -minsize => 96, -weight => 1,);
    $f->gridColumnconfigure(3, -minsize => 96,);
    
    my $c = 1;
    foreach my $label ('NNTP Server:  ', 'Username:  ',
                       'Password:  ', 'Email:  ',) {
      $f->Label(
        -text       => $label,
        -background => '#000000',
        -foreground => '#ffffff',
        -anchor     => 'e',
        -width      => 15,
      )->grid(
        -in     => $f,   -column => '1',
        -sticky => 'e',  -row    => $c,
      );
      $c++;
    }
    $c = 6;
    foreach my $label ('Download Dir:  ', 'Signature File:  ',) {
      $label =~ m/\b(\w+)\b/;
      my $sub = \&{ 'opt_'.lc($1); };
      my $w = $f->Button(
        -text             => $label,
        -anchor           => 'e',
        -relief           => 'flat',
        -bg               => '#000000',
        -fg               => '#ffffff',
        -activeforeground => '#fff000',
        -activebackground => '#000000',
        -width            => 15,
        -command          => sub { &$sub(); },
      )->grid(
        -in     => $f,  -column => '1',
        -sticky => 'e', -row    => $c,
      );
      &FlashButton($w, '#181830', $sys_fg);
      $c++;
    }
    undef $c;
    foreach my $row qw(1 2 3 4 6 7) {
      my $w = $f->Entry(
        -width        => 32,
        -background   => '#ffffff',
        -foreground   => '#000000',
      )->grid(
        -in     => $f,  -column => '2',
        -sticky => 'w', -row    => $row,
      );
      if ($row >= 3) {
        if    ($row == 3) { $w->configure(-show => '*',); }
        elsif ($row >= 6) { $w->configure(-width => 64,); }
      }
      push (@OPT_entries, $w);
    }
    my $w = $tl5->Button(
      -text             => 'C l o s e  &  S a v e',
      -relief           => 'flat',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -command          => sub { &opt_close(); }
    )->grid(
      -in     => $tl5, -column => '1',
      -sticky => 'w',  -row    => '2',
    );
    &FlashButton($w, '#181830', $sys_fg);
  }
  
  #help window
  our($tl6, $txt_help,);
  {
    $tl6 = $mw->Toplevel(
      -relief => 'groove',
      -bd     => 2,
    );
    $tl6->title('Help');
    $tl6->geometry("+93+70");
    $tl6->resizable(0, 0);
    $tl6->transient($mw);
    $tl6->withdraw;
    $tl6->gridColumnconfigure(2, -weight => 1,);
    
    my $f = $tl6->Frame(
      -relief => 'sunken',
      -bd     => 2,
    )->grid(
      -in     => $tl6,   -column => '1', -columnspan => '3',
      -sticky => 'news', -row    => '1',
    );
    $txt_help = $f->Scrolled(
      'ROText',
      -scrollbars       => 'oe',
      -background       => '#000000',
      -foreground       => '#ffffff',
      -selectbackground => '#000000',
      -selectforeground => '#fff000',
      -wrap             => 'none',
      -relief           => 'flat',
      -width            => 80,
      -height           => 20,
    )->grid(
      -in     => $f,     -column => '1',
      -sticky => 'news', -row    => '1',
    );
    $txt_help->menu(undef);
    
    my $c = 1;
    foreach my $label ('C l o s e', 'A b o u t',) {
      my $sublabel = $label;
      $sublabel =~ s/\s//g;
      my $sub = \&{ 'help_'.lc($sublabel); };
      my $w = $tl6->Button(
        -text             => $label,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
        -relief           => 'flat',
        -command          => sub { &$sub(); }
      )->grid(
        -in     => $tl6, -column => $c,
        -sticky => 'n',  -row    => '2',
      );
      &FlashButton($w, '#181830', $sys_fg);
      $c += 2;
    }
  }
  
  #group right click menu
  our($tl7,);
  {
    $tl7 = $mw->Toplevel(
      -title       => 'group_rc_menu',
      -relief      => 'raised',
      -borderwidth => 2.5,
    );
    $tl7->overrideredirect(1);
    $tl7->resizable(0, 0);
    $tl7->transient($mw);
    $tl7->withdraw;
    
    my $f = $tl7->Frame(
      -relief    => 'sunken',
      -bd        => '1.5',
      -takefocus => '1',
    )->grid(
      -in     => $tl7,   -column => '1',
      -sticky => 'news', -row    => '1',
    );
    $f->gridRowconfigure(3, -minsize => 2,);
    $f->gridRowconfigure(5, -minsize => 2,);
    #$f->bind('<FocusOut>' => sub {
    $f->bind('<Leave>' => sub {
      $tl7->withdraw;
    });
    $f->Frame(
      -relief    => 'groove',
      -bd        => '8',
    )->grid(
      -in     => $f,     -column => '1',
      -sticky => 'news', -row    => '3',
    );
    $f->Frame(
      -relief    => 'groove',
      -bd        => '2',
    )->grid(
      -in     => $f,     -column => '1',
      -sticky => 'news', -row    => '5',
    );
    $f->Button(
      -text             => 'Scan',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        &scan();
    })->grid(
      -in     => $f,  -column => '1',
      -sticky => 'n', -row    => '1',
    );
    $f->Button(
      -text             => 'Load',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        &message_load();
    })->grid(
      -in     => $f,  -column => '1',
      -sticky => 'n', -row    => '2',
    );
    $f->Button(
      -text             => 'Search',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          =>  sub {
        &search_popup();
    })->grid(
      -in     => $f,  -column => '1',
      -sticky => 'n', -row    => '4',
    );
    $f->Button(
      -text             => 'Clear',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        &message_clear();
    })->grid(
      -in     => $f,  -column => '1',
      -sticky => 'n', -row    => '6',
    );
    $f->Button(
      -text             => 'Reset',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        $lb1_grp->focus;
        &rset_cmd();
    })->grid(
      -in     => $f,  -column => '1',
      -sticky => 'n', -row    => '7',
    );
    $f->Button(
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -text             => 'Remove',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
      $lb1_grp->focus;
      &grp_unsubscribe('X');
    })->grid(
      -in     => $f,  -column => '1',
      -sticky => 'n', -row    => '8',
    );
  }
  
  #message right click menu
  our($tl8,);
  {
    $tl8 = $mw->Toplevel(
      -title       => 'message_rc_menu',
      -relief      => 'raised',
      -borderwidth => 2.5,
    );
    $tl8->overrideredirect(1);
    $tl8->resizable(0, 0);
    $tl8->transient($mw);
    $tl8->withdraw;
    
    my $f = $tl8->Frame(
      -relief    => 'sunken',
      -bd        => 1.5,
      -takefocus => 1,
    )->grid(
      -in     => $tl8,   -column => '1',
      -sticky => 'news', -row    => '1',
    );
    $f->bind('<Leave>' => sub {
      $tl8->withdraw;
    });
    $f->Button(
      -text             => 'Read',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        &read_message();
    })->grid(
      -in     => $f,  -column => '1',
      -sticky => 'n', -row    => '1',
    );
    $f->Button(
      -text             => 'Grab',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        &grab();
    })->grid(
      -in     => $f,  -column => '1',
      -sticky => 'n', -row    => '2',
    );
    $f->Button(
      -text             => 'Grab&Open',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        &grab(1);
    })->grid(
      -in     => $f,  -column => '1',
      -sticky => 'n', -row    => '3',
    );
    $f->Button(
      -text             => 'SelectAll',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        &lb2_msg_select_all();
    })->grid(
      -in     => $f,  -column => '1',
      -sticky => 'n', -row    => '4',
    );
    $f->Button(
      -text             => 'Delete',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -anchor           => 'w',
      -width            => 10,
      -command          => sub {
        $lb2_msg->focus;
        &message_delete();
    })->grid(
      -in     => $f,  -column => '1',
      -sticky => 'n', -row    => '5',
    );
  }
  
  #message download window
  our($tl9, $l1_msgs, $e1_msgs, $dlnew,);
  {
    $tl9 = $mw->Toplevel(
      -relief    => 'groove',
      -bd        => 2,
    );
    $tl9->title('Download Messages');
    $tl9->geometry("+220+160");
    $tl9->resizable(0, 0);
    $tl9->transient($mw);
    $tl9->withdraw;
    $tl9->gridColumnconfigure(4, -minsize => 64, -weight => 1,);
    
    my $f = $tl9->Frame(
      -bg     => '#000000',
      -relief => 'sunken',
      -bd     => 3,
    )->grid(
      -in     => $tl9, -columnspan => '4',
      -column => '1',  -rowspan    => '1',
      -row    => '1',  -sticky     => 'w',
    );
    $f->gridRowconfigure(4,    -minsize => 100,);
    $f->gridColumnconfigure(4, -minsize => 32, -weight  => 1,);
    $l1_msgs = $f->Label(
      -text => '',
      -bg     => '#000000',
      -fg     => '#ffffff',
    )->grid(
      -in     => $f,  -columnspan => '3',
      -column => '1', -rowspan    => '1',
      -row    => '1', -sticky     => 'w',
    );
    $f->Label(
      -text => 'Enter the number of messages to be downloaded:  ',
      -bg     => '#000000',
      -fg     => '#ffffff',
    )->grid(
      -in     => $f,  -padx   => '0', -columnspan => 2,
      -column => '1', -pady   => '8',
      -row    => '2', -sticky => 'w',
    );
    $f->Label(
      -text => 'Newest messages only (mark the rest read).',
      -bg     => '#000000',
      -fg     => '#ffffff',
    )->grid(
      -in     => $f,  -padx   => '0',
      -column => '2', -pady   => '0',
      -row    => '4', -sticky => 'nw',
    );
    $e1_msgs = $f->Entry(
      -bg               => '#ffffff',
      -fg               => '#000000',
      -selectbackground => '#000000',
      -selectforeground => '#fff000',
      -width            => 6,
    )->grid(
      -in     => $f,  -padx   => '0',
      -column => '3', -pady   => '8',
      -row    => '2', -sticky => 'w',
    );
    $f->Checkbutton(
      -variable         => \$dlnew,
      -activeforeground => '#000000',
      -activebackground => '#000000',
      -foreground       => '#000000',
      -background       => '#000000',
      -selectcolor      => '#ffffff',
    )->grid(
      -in     => $f,  -padx   => '0',
      -column => '1', -padx   => '0',
      -row    => '4', -sticky => 'ne',
    );
    my $c = 1; my $sticky = 'w';
    foreach my $label ('O k', 'C a n c e l',) {
      my $sublabel = $label;
      $sublabel =~ s/\s//g;
      my $w = $tl9->Button(
        -text             => $label,
        -activeforeground => '#000fff',
        -activebackground => '#a1a1a1',
        -relief           => 'flat',
        -command          => sub {
          $msglimitOption = uc($sublabel);
        },
      )->grid(
        -in     => $tl9, -column => $c,
        -sticky => 'e',   -row    => '2',
      );
      &FlashButton($w, '#181830', $sys_fg);
      $c += 3;
    }
  }
  
  #Search group popup
  our($tla,);
  {
    $tla = $mw->Toplevel();
    $tla->title('Search Group');
    $tla->geometry("+250+200");
    $tla->resizable(0, 0);
    $tla->transient($mw);
    $tla->withdraw;
    $tla->gridColumnconfigure(1, -weight  => 1,);
    
    my $f = $tla->Frame(
      -bd     => 3,
      -relief => 'sunken',
      -bg     => '#000000',
    )->grid(
      -in     => $tla,   -column => '1', -columnspan => '2',
      -sticky => 'news', -row    => '1', -rowspan    => '1',
    );
    $tla->Label(
      -text   => 'To clear previous search results, '.
                 'perform an empty search.'."\n\n\n\n",
      -bg     => '#000000',
      -fg     => '#ffffff',
    )->grid(
      -in     => $f,     -column => '1',
      -sticky => 'news', -row    => '1',
    );
    my $e = $tla->Entry(
      #$search is shared with the groups window
      -textvariable => \$search,
      -bg           => '#ffffff',
      -fg           => '#000000',
      -relief       => 'sunken',
      -bd           => 2,
    )->grid(
      -in     => $tla,   -column => '1',
      -sticky => 'news', -row    => '2',
    );
    $e->bind('<Return>' => sub {
      &search($lb2_msg);
    });
    my $w = $tla->Button(
      -text             => 'S e a r c h',
      -activeforeground => '#000fff',
      -activebackground => '#a1a1a1',
      -relief           => 'flat',
      -command => sub {
        &search($lb2_msg);
      }
    )->grid(
      -in     => $tla, -column => '2',
      -sticky => '',   -row    => '2',
    );
    &FlashButton($w, '#181830', $sys_fg);
  }
  $pw1->add($lb1_grp, $lb2_msg,);
  
  #Bindings
  $tl2->protocol(WM_DELETE_WINDOW => \&post_cancel);
  $tl3->protocol(WM_DELETE_WINDOW => \&grp_close);
  $tl4->protocol(WM_DELETE_WINDOW => \&read_close);
  $tl9->protocol(WM_DELETE_WINDOW => \&dlmsgs_cancel);
  $tl1->protocol(WM_DELETE_WINDOW => sub {$tl1->withdraw;});
  $tl5->protocol(WM_DELETE_WINDOW => sub {$tl5->withdraw;});
  $tl6->protocol(WM_DELETE_WINDOW => sub {$tl6->withdraw;});
  $tla->protocol(WM_DELETE_WINDOW => sub {$tla->withdraw;});
  $logo->bind('<ButtonPress-1>'   => sub {
    $logo->configure(-text=>'');$mw->update;$mw->after(200);
    $logo->configure(-text=>'N');$mw->update;$mw->after(180);
    $logo->configure(-text=>'Ne');$mw->update;$mw->after(130);
    $logo->configure(-text=>'New');$mw->update;$mw->after(120);
    $logo->configure(-text=>'News');$mw->update;$mw->after(160);
    $logo->configure(-text=>'NewsS');$mw->update;$mw->after(130);
    $logo->configure(-text=>'NewsSu');$mw->update;$mw->after(100);
    $logo->configure(-text=>'NewsSur');$mw->update;$mw->after(120);
    $logo->configure(-text=>'NewsSurf');$mw->update;$mw->after(130);
    $logo->configure(-text=>'NewsSurfe');$mw->update;$mw->after(110);
    $logo->configure(-text=>'NewsSurfer');$mw->update;$mw->after(100);
  });
  $lb1_grp ->bind('<ButtonPress-3>' => sub {
    &raise_rc_menu($tl7);
  });
  $lb1_grp->bind('<Delete>'=> sub {
    &b4_grp_unsubscribe('X');
  });
  $lb2_msg ->bind('<ButtonPress-3>' => sub {
    my @sel = $lb2_msg->selectionGet;
    if ($sel[1]) {
      &raise_rc_menu($tl8);
    }
    else {
      $lb2_msg->Tk::HList::ButtonRelease_1;
      &raise_rc_menu($tl8, $lb2_msg);
    }
  });
  $lb2_msg ->bind('<Control-Return>' => sub {
    &b2_grab_cmd(1);
  });
  $lb2_msg->bind('<Double-ButtonPress-1>' => \&read_message);
  $lb1_grp->bind('<Double-ButtonPress-1>' => \&message_load);
  $lb1_grp->bind('<Return>'     => \&scan);
  $lb1_grp->bind('<Control-c>'  => \&message_clear);
  $lb1_grp->bind('<Control-C>'  => \&message_clear);
  $lb1_grp->bind('<Control-x>'  => \&rset_cmd);
  $lb1_grp->bind('<Control-X>'  => \&rset_cmd);
  $lb2_msg->bind('<Delete>'     => \&message_delete);
  $lb2_msg->bind('<Return>'     => \&read_message);
  $lb2_msg->bind('<Control-a>'  => \&lb2_msg_select_all);
  $lb2_msg->bind('<Control-A>'  => \&lb2_msg_select_all);
  $lb2_msg->bind('<Shift-End>'  => \&lb2_msg_select_end);
  $lb2_msg->bind('<Shift-Home>' => \&lb2_msg_select_hom);
  $lb2_msg->bind('<Control-d>'  => \&message_delete);
  $lb2_msg->bind('<Control-D>'  => \&message_delete);
  {
    my $c = 10;
    foreach my $b (@buttons) {
      #bind images onto buttons
      &MainButtons($b, $c);
      $c++
    }
  }
  
  #Defaults
  warn 'Warning - NewsSurfer has started.  (' . localtime() . "}\n";
  $sblabel = 'Ready';
  $msglimitOption = 0;
  &display_groups();
  $lb1_grp->focus();
  
  #Callbacks
  sub nntpconnect #-----------------------------------------------------
  {
    #called whenever a connection to the server needs to be established
    my($nntp, $serv, $user, $pass,);
    eval { $nntp->quit() };
    {
      dbmopen(my %OPT, 'settings', '0640')
        || die "Cannot create settings.\n$!";
      $serv = $OPT{Serv};
      $user = $OPT{User};
      $pass = $OPT{Pass};
      dbmclose %OPT;
    }
    
    #connect
    $nntp = Net::NNTP->new(
      $serv,
      Debug   => 1,
      Timeout => 30,
    );
    unless ($nntp) {
      $nntp = Net::NNTP->new(
        $serv,
        Debug   => 1,
        Timeout => 30,
      );
      unless ($nntp) {
        warn 'Error - Server is '.$serv."\n";
        &error('connect');
        return(0);
      }
    }
    #login
    if ($user) {
      unless (defined $pass) {
        $pass = "\n";
      }
      eval {
        $nntp->authinfo($user, $pass);
      };
      if ($@) {
        &error('login');
        return(0);
      }
    }
    else {
      warn "Warning - No username / password pair specified.\n";
    }
    return(\$nntp);
  }
  sub scan #------------------------------------------------------------
  {
    #called from a button pressed in the main window or rc menu
    my ($dlmsg, @sel, $imagedata, $chek, $group,);
    &update_status('Connecting to server...');
    $mw->Busy(-recurse => 1);
    
    #clear old newsgroup's display
    $lb2_msg->focus;
    $lb2_msg->delete('all');
    $mw->update;
    
    #determine which newsgroup to scan
    @sel = $lb1_grp->selectionGet;
    if (defined $sel[0]) {
      $group = $lb1_grp->itemCget($sel[0], 0, -text);
    }
    else {
      &error('scan_1');
      goto scan_end;
    }
    
    #connect to nntp server
    &update_status('Connecting to NNTP server...');
    &update_status('4', 'PROGRESSBAR');
    my $nntpRef = &nntpconnect();
    unless($nntpRef) {
      goto scan_end;
    }
    
    #range
    my($totmsgs, $rng, @nfo,);
    &update_status('Scanning newsgroup...');
    &update_status('4', 'PROGRESSBAR');
    @nfo = $$nntpRef->group($group);
    shift @nfo;
    pop   @nfo;
    $totmsgs = $nfo[1] - $nfo[0]; $totmsgs++;
    $dlmsg   = $nfo[1] - $nfo[0]; $dlmsg++;
    
    #load group db and determine which headers to download next.
    if (-e "$group.grp") {
      &update_status('Removing expired articles...');
      &update_status('4', 'PROGRESSBAR');
      tie my %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
        or &error('MLDBM', 'DIE',);
      #remove expired articles
      my $tmp = $file{HEADERDB};
      while (my $k = each %$tmp) {
        #k is a message number of a previously downloaded message
        #remove messages that are no longer on the server
        if ($k < $nfo[0]) {
          delete $tmp->{$k};
        }
      }
      
      #determine the new article range
      my(@keys, $last,);
      &update_status('4', 'PROGRESSBAR');
      @keys = (keys %$tmp);
      @keys = sort {$b <=> $a} @keys;
      $last = $keys[0] || 0;
      warn "last messageID downloaded is:  [$last]\n";
      warn "first new messageID is:        [$nfo[1]]\n";
      $last++;
      
      #save to db
      $file{HEADERDB} = $tmp;
      undef $tmp;
      untie %file;
      
      if ($last <= $nfo[1]) {
        #there are new messages on the newsgroup
        undef $rng;
        unless($last == 1) {
          shift @nfo;
          unshift (@nfo, "$last");
        }
        $totmsgs = $nfo[1] - $nfo[0]; $totmsgs++;
        $dlmsg   = $nfo[1] - $nfo[0]; $dlmsg++;
        warn "There are $totmsgs new messages on the server\n";
        
        unless($totmsgs < 5000) {
          my $r = &msglimit($totmsgs);
          if ($r == 0) {
            $$nntpRef->quit();
            goto scan_end;
          }
          elsif ($dlnew == 1) {
            $nfo[0] = $nfo[1] - $r;
          }
          else {
            $nfo[1] = $nfo[0] + $r;
          }
          $dlmsg = $nfo[1] - $nfo[0];
        }
      }
      else {
        #there are no new messages on the newsgroup
        warn "No new messages...\n";
        &update_status('No new messages...');
        $$nntpRef->quit();
        #load old messages
        &displayheaders('OLD');
        goto scan_end;
      }
    }
    else {
      #Newly subscribed or reset group; create a new db.
      warn "Creating a new db for $group\n";
      &update_status('Initializing newsgroup...');
      &update_status('4', 'PROGRESSBAR');
      unless($totmsgs < 5000) {
        #popup d/l messages
        my $r = &msglimit($totmsgs);
        warn "Message download limit set to:  [$r]\n";
        if ($r == 0)        { $$nntpRef->quit(); goto scan_end; }
        elsif ($dlnew == 1) { $nfo[0] = $nfo[1] - $r;           }
        else                { $nfo[1] = $nfo[0] + $r;           }
        $dlmsg = $nfo[1] - $nfo[0];
      }
    }
    $rng = \@nfo;
    
    #download overview into %xover, then disconnect from nntp server
    &update_status("Downloading $dlmsg of $totmsgs new messages...");
    &update_status('16', 'PROGRESSBAR');
    my($href, %xover);
    $href = $$nntpRef->xover($rng);                                     #<-blocks
    if ($href) {
      %xover = %$href;
      undef $href;
      #(%xover is a HoA) $_ is msgnum
      #$xover{$_}[0] #subject      #$xover{$_}[4] #references
      #$xover{$_}[1] #from         #$xover{$_}[5] #bytes
      #$xover{$_}[2] #date         #$xover{$_}[6] #lines *parts*
      #$xover{$_}[3] #message-id   #$xover{$_}[7] #xref:full *read*
    }
    else {
      #try to reconnect
      warn "Warning - retrying header download...\n";
      &update_status('retrying header download...');
      eval { $$nntpRef->quit };
      $nntpRef = &nntpconnect();
      if ($$nntpRef) {
        $$nntpRef->group($group);
        $href = $$nntpRef->xover($rng);                                 #<-blocks
        if (defined $href) {
          #retry overview
          %xover = %$href;
          undef $href;
        }
        else {
          &error('connect');
          goto scan_end;
        }
      }
      else {
        &error('connect');
        goto scan_end;
      }
    }
    $$nntpRef->quit();
    
    #handle multipart messages
    &update_status('Preparing messages...');
    my $subj_sav = ' ';
    my $tmp;
    my $c = 0;
    tie my %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
      or &error('MLDBM', 'DIE',);
    $tmp = $file{MULTIPARTDB};
    while (my $k = each %xover) {
      if ($pb >= 100) { $pb = 0;                                  }
      if ($c   > 500) { for(1..1) { $pb++; $mw->update; $c = 0; } }
      else            { $c++;                                     }
      if ($xover{$k}[0] =~ m/
        (\p{Any}+)                                  #the main subject $1
        [\(\[\{]+?                            #followed by a ( or [ or {
        (\d+)                                    #followed by a digit $2
        [\/\-]+?                     #followed by a foward slash or dash
        (\d+)                                    #followed by a digit $3
        [\)\]\}]+?                            #followed by a ) or ] or }
        (\p{Any}*)                           #additional subject text $4
                       #$1 = subj, $2 = part, $3 = total, $4 = more subj
        /gx) {
        #it is a multipart message
        my $newsubj;
        $newsubj = $1.$4;
        $newsubj =~ s/                                 #validate subject
          ~::~/                                            #replace this
          ____                                                #with this
        /x;
        
        #record multipart message ids
        $tmp->{$newsubj}{$2} = $xover{$k}[3];
        
        #combine parts for display, update subject
        if ($1 ne $subj_sav) {
          $subj_sav     = $1;       #it is a new subject
          $xover{$k}[6] = $3;       #parts total
          $xover{$k}[0] = $newsubj; #edited subject
        }
        else {
          #seen this subject already
          delete $xover{$k};
        }
      }
      else {
        #not a multipart message
        $xover{$k}[6] = 1;
      }
    }
    $file{MULTIPARTDB} = $tmp;
    undef $tmp;
    
    #remove multipart duplicates and log new message ids
    &update_status('Combining parts...');
    &update_status('16', 'PROGRESSBAR');
    my %seen;
    while (my $k = each %xover) {
      if ($xover{$k}) {
        if ($xover{$k}[6] != 1) {
          my $l = $xover{$k}[0].$xover{$k}[1].$xover{$k}[6];
          #          subject        from         parts
          if (defined $seen{$l}) {
            delete $xover{$k};
          }
          $seen{$l} = 1;
        }
      }
    }
    undef %seen;
    
    #format the time/date, remove old headers(optional), count headers
    &update_status('Formatting Time/Date...');
    &update_status('16', 'PROGRESSBAR');
    while (my $k = each %xover) {
      my $now   = time;
      my $epoch = str2time($xover{$k}[2]);
      my $age   = $now - $epoch;
      if ($age < 2592000 or $k == $nfo [1]) {
        chomp($xover{$k}[2] = ctime($epoch));
      }
      else {
        delete $xover{$k}
      }
    }
    
    #save new headers to group header db
    &update_status('Saving Group...');
    &update_status('16', 'PROGRESSBAR');
    $tmp = $file{HEADERDB};
    my $newheadercount = 0;
    while (my $messagenumber = each %xover) {
      for my $c (0..7) {
        $tmp->{$messagenumber}[$c] = $xover{$messagenumber}[$c];
      }
      $newheadercount++;
    }
    $file{HEADERDB} = $tmp;
    undef $tmp;
    untie %file;
    
    #display messages
    warn "Displaying [$newheadercount] new messages\n";
    &update_status('Displaying messages...');
    &update_status('4', 'PROGRESSBAR');
    &displayheaders('NEW', $newheadercount);
    
    #update Last Scanned
    scan_end:
    {
      dbmopen(my %SBSCRIBE, 'sbscribe', '0640')
        || die "Cannot create sbscribe.\n$!";
      my $stime;
      chomp ($stime = ctime(time));
      $SBSCRIBE{"$group"} = "$stime";
      dbmclose %SBSCRIBE;
    }
    &display_groups();
    $lb2_msg->focus;
    if ($sel[0]) { $lb1_grp->selectionSet($sel[0]); }
    while($pb < 100) {
      $pb++;
      $mw->update;
    }
    $pb = 0;
    &update_status('Ready');
    $mw->Unbusy;
    return(1);
  }
  sub msglimit #--------------------------------------------------------
  {
    #called from sub scan
    my $totmsgs = $_[0] || 'NULL';
    $dlnew = 0;
    
    my $ret;
    $ret = &dlmsgs('PROMPT', $totmsgs);
    $ret = &dlmsgs($ret, $totmsgs);
    #return number of messages to be downloaded to the scan subroutine
    return($ret);
  }
  sub dlmsgs #----------------------------------------------------------
  {
    #called from sub msglimit
    my $opt     = uc($_[0])     || 'NULL';
    my $totmsgs = $_[1]         || 'NULL';
    my $maxdl   = $e1_msgs->get || '5000';
    $e1_msgs->delete(0, 'end');
    $e1_msgs->insert(0, $maxdl);
    
    if ($opt eq 'PROMPT') {
      $l1_msgs->configure(-text => "There are more than $totmsgs ".
                                   'unread messages in this group.');
      $tl9->deiconify();
      $tl9->raise();
      $e1_msgs->focus;
      $mw->update;
      $mw->Unbusy;
      $mw->waitVariable(\$msglimitOption);                #wait for user
      $mw->Busy(-recurse => 1);
      return($msglimitOption);
    }
    elsif ($opt eq 'OK') {
      if ($maxdl =~ m/\D/)      { $maxdl = 0;        }
      elsif ($maxdl > $totmsgs) { $maxdl = $totmsgs; }
      $tl9->withdraw;
    }
    elsif ($opt eq 'CANCEL') {
      $maxdl = 0;
      $tl9->withdraw;
    }
    else {
      warn "ERROR - Invalid dlmsgs option:  [$opt]\n$!";
      $mw->destroy;
    }
    return($maxdl);
  }
  sub displayheaders #--------------------------------------------------
  {
    #called from subs scan and message_load
    #when opt1 is set to 'NEW' then opt2 should specify # of new msgs
    my $opt1 = uc($_[0]) || 'OLD';
    my $opt2 = $_[1]     || 0;
    my(%file, $lb2_k1, $lb2_k2, $lb2_b1, $lb2_b2, $chek, $group, @sel);
    
    #determine which newsgroup is selected
    @sel = $lb1_grp->selectionGet;
    if (defined $sel[0]) {
      $group = $lb1_grp->itemCget($sel[0], 0, -text);
    }
    else {
      warn "Warning - No valid group selected for header display\n";
      return(0);
    }
    
    #prepare display
    {
      my $imagedata = &load_image(2);
      $chek = $mw->Photo(
        -format => 'bmp',
        -data   => $imagedata
      );
    }
    $lb2_b1 = $lb2_msg->ItemStyle('text',
      -anchor           => 'e',
      -selectforeground => '#fff000',
      -background       => '#ffffff',
      -foreground       => '#0000ff',
      -font             => '{Arial} 8',
    );
    $lb2_b2 = $lb2_msg->ItemStyle('text',
      -anchor           => 'w',
      -selectforeground => '#fff000',
      -background       => '#ffffff',
      -foreground       => '#0000ff',
      -font             => '{Arial} 8',
    );
    $lb2_k1 = $lb2_msg->ItemStyle('text',
      -anchor           => 'e',
      -selectforeground => '#fff000',
      -background       => '#ffffff',
      -foreground       => '#000000',
      -font             => '{Arial} 8',
    );
    $lb2_k2 = $lb2_msg->ItemStyle('text',
      -anchor           => 'w',
      -selectforeground => '#fff000',
      -background       => '#ffffff',
      -foreground       => '#000000',
      -font             => '{Arial} 8',
    );
    
    #load group db
    tie %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
      or &error('MLDBM', 'DIE',);
    my $tmp = $file{HEADERDB};
    
    #display headers                                                    #TODO -
    my $cnt = my $c = 0;                                                #discussion threads
    for (1..10) { $pb++; $mw->update; }
    foreach my $k (reverse sort keys %$tmp) {
      if ($pb >= 100) { $pb = 0;                                   }
      if ($c  > 100)  { for(1..10) { $pb++; $mw->update; $c = 0; } }
      else            { $c++;                                      }
      $cnt++;
      if ($opt1 eq 'NEW' && $cnt <= $opt2) {
        $lb2_msg->add($k);
        my $counter = 0;
        foreach my $headerportion (0, 1, 6, 5, 2,) {
          if ($counter < 2) {
            $lb2_msg->itemCreate($k, $counter,
              -itemtype => 'text',
              -style    => $lb2_b2,
              -text     => $tmp->{$k}[$headerportion],
            );
          }
          else {
            $lb2_msg->itemCreate($k, $counter,
              -itemtype => 'text',
              -style    => $lb2_b1,
              -text     => $tmp->{$k}[$headerportion],
            );
          }
          $counter++;
        }
      }
      else {
        $lb2_msg->add($k);
        my $counter = 0;
        foreach my $headerportion (0, 1, 6, 5, 2,) {
          if ($counter < 2) {
            $lb2_msg->itemCreate($k, $counter,
              -itemtype => 'text',
              -style    => $lb2_k2,
              -text     => $tmp->{$k}[$headerportion],
            );
          }
          else {
            $lb2_msg->itemCreate($k, $counter,
              -itemtype => 'text',
              -style    => $lb2_k1,
              -text     => $tmp->{$k}[$headerportion],
            );
          }
          $counter++;
        }
      }
      if ($tmp->{$k}[7] eq 'read') {
        $lb2_msg->indicator('create', $k,
          -itemtype => 'image',
          -image    => $chek
        );
      }
      #mark message as old
      $tmp->{$k}[8] = 1;
    }
    $file{HEADERDB} = $tmp;
    undef $tmp;
    untie %file;
    return(1);
  }
  sub message_load #----------------------------------------------------
  {
    #called from the main window, rc menu, or sub message_clear
    my($group, $return,);
    $sblabel = 'Loading newsgroup...';
    $sb_lab->configure(-text => "  $sblabel");
    $mw->Busy(-recurse => 1);
    $lb2_msg->focus;
    $mw->update;
    
    #load messages
    $lb2_msg->delete('all');
    for (1..10) { $pb++; $mw->update; }
    my $ret = &displayheaders('OLD');
    if ($ret) { $return = 1; }
    else      { $return = 0; }
    
    message_load_end:
    while($pb < 100) {
      $pb++;
      $mw->update;
    }
    $pb = 0;
    $sblabel = 'Ready';
    $sb_lab->configure(-text => "  $sblabel");
    $lb2_msg->focus;
    $mw->Unbusy;
    $mw->update;
    return($return);
  }
  sub message_clear #---------------------------------------------------
  {
    #called from the rc menu
    my ($group, @sel, @paths, %file,);
    $sblabel = 'Clearing previously scanned messages from group...';
    $sb_lab->configure(-text => "  $sblabel");
    $mw->Busy(-recurse => 1);
    $mw->update;
    
    #get a list of paths for the message hlist
    &lb2_msg_select_all();
    @paths = $lb2_msg->infoSelection;
    unless ($paths[0]) {
      my $ret = &displayheaders('OLD');
      if ($ret) {
        &lb2_msg_select_all();
        @paths = $lb2_msg->infoSelection;
      }
      else {
        warn "Error - Unable to clear group\n";
        goto message_clear_end;
      }
    }
    
    #determine group
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected to clear.\n";
      goto message_clear_end;
    }
    
    #load grp file
    if (-e "$group.grp") {
      tie %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
        or &error('MLDBM', 'DIE',);
    }
    else {
      goto message_clear_end;
    }
    my $tmp = $file{HEADERDB};
    
    #clear group, and update group header db
    my $c = 1;
    foreach my $path (@paths) {
      unless ($path == $paths[0]) {
        $lb2_msg->delete('entry', $path);
        delete $tmp->{$path};
        if ($c == 100) {
          $mw->update;
          undef $c;
        }
        $c++;
      }
    }
    $file{HEADERDB} = $tmp;
    
    #clear group multipart db
    delete $file{MULTIPARTDB};
    
    message_clear_end:
    untie %file;
    while($pb < 100) {
      $pb++;
      $mw->update;
    }
    $pb = 0;
    $sblabel = 'Ready';
    $sb_lab->configure(-text => "  $sblabel");
    $lb1_grp->focus;
    $mw->Unbusy;
    $mw->update;
    return(1);
  }
  sub lb2_msg_sort #----------------------------------------------------
  {
    #called from a button pressed in the main window
    my $caller = uc($_[0]) || ' ';
    my(@sel, $group, @y, $imagedata, $chek, %file, $c, $col, $opt,);
    
    if ($caller eq ' ')          { return(1);          }
    elsif ($caller eq 'HEADERS') { $col = 0; $opt = 1; }
    elsif ($caller eq 'FROM')    { $col = 1; $opt = 1; }
    elsif ($caller eq 'PARTS')   { $col = 6; $opt = 2; }
    elsif ($caller eq 'BYTES')   { $col = 5; $opt = 2; }
    elsif ($caller eq 'DATE')    { $col = 2; $opt = 3; }
    else {
      warn "Error - Invalid sort option:  [$caller]\n";
      return(0);
    }
    
    $sort_cnt++;
    $mw->Busy(-recurse => 1,);
    $lb2_msg->delete('all');
    $sblabel = 'Sorting...';
    $sb_lab->configure(-text => "  $sblabel");
    $mw->update;
    
    $imagedata = &load_image(2);
    $chek = $mw->Photo(
      -format => 'bmp',
      -data   => $imagedata
    );
    undef $imagedata;
    
    #load group header db
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected for sort.\n";
      $mw->Unbusy;
      return(0);
    }
    tie %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
      or &error('MLDBM', 'DIE',);
    my $tmp = $file{HEADERDB};
    
    #sort
    if ($sort_cnt % 2) {
      if ($opt == 1) {
        @y = sort{
          $tmp->{$b}[$col] cmp $tmp->{$a}[$col]
        }keys %$tmp;
      }
      elsif ($opt == 2) {
        @y = sort{
          $tmp->{$b}[$col] <=> $tmp->{$a}[$col]
        }keys %$tmp;
      }
      else {
        @y = sort{
          str2time($tmp->{$b}[$col]) <=> str2time($tmp->{$a}[$col])
        }keys %$tmp;
      }
    }
    else {
      if ($opt == 1) {
        @y = sort{
          $tmp->{$a}[$col] cmp $tmp->{$b}[$col]
        }keys %$tmp;
      }
      elsif ($opt == 2) {
        @y = sort{
          $tmp->{$a}[$col] <=> $tmp->{$b}[$col]
        }keys %$tmp;
      }
      else {
        @y = sort{
          str2time($tmp->{$a}[$col]) <=> str2time($tmp->{$b}[$col])
        }keys %$tmp;
      }
    }
    
    #re-populate
    $c = 0;
    foreach my $k (@y) {
      my($lb2_k1, $lb2_k2,);
      if ($tmp->{$k}[8]) {
        $lb2_k1 = $lb2_msg->ItemStyle('text',
          -selectforeground => '#fff000',
          -bg               => '#ffffff',
          -fg               => '#000000',
          -anchor           => 'e',
          -font             => '{Arial} 8',
        );
        $lb2_k2 = $lb2_msg->ItemStyle('text',
          -selectforeground => '#fff000',
          -bg               => '#ffffff',
          -fg               => '#000000',
          -anchor           => 'w',
          -font             => '{Arial} 8',
        );
      }
      else {
        $lb2_k1 = $lb2_msg->ItemStyle('text',
          -selectforeground => '#fff000',
          -bg               => '#ffffff',
          -fg               => 'blue',
          -anchor           => 'e',
          -font             => '{Arial} 8',
        );
        $lb2_k2 = $lb2_msg->ItemStyle('text',
          -selectforeground => '#fff000',
          -bg               => '#ffffff',
          -fg               => 'blue',
          -anchor           => 'w',
          -font             => '{Arial} 8',
        );
      }
      if ($c > 100) { $mw->update; $c = 0; }
      else          { $c++ }
      
      $lb2_msg->add($k);
      $lb2_msg->itemCreate($k, 0,
        -itemtype => 'text',
        -style    => $lb2_k2,
        -text     => $tmp->{$k}[0]
      );
      $lb2_msg->itemCreate($k, 1,
        -itemtype => 'text',
        -style    => $lb2_k2,
        -text     => $tmp->{$k}[1]
      );
      $lb2_msg->itemCreate($k, 2,
        -itemtype => 'text',
        -style    => $lb2_k1,
        -text     => $tmp->{$k}[6]
      );
      $lb2_msg->itemCreate($k, 3,
        -itemtype => 'text',
        -style    => $lb2_k1,
        -text     => $tmp->{$k}[5]
      );
      $lb2_msg->itemCreate($k, 4,
        -itemtype => 'text',
        -style    => $lb2_k1,
        -text     => $tmp->{$k}[2]
      );
      if ($tmp->{$k}[7] eq 'read') {
        $lb2_msg->indicator('create', $k,
        -itemtype => 'image',
        -image    => $chek
        );
      }
    }
    
    untie %file;
    $sblabel = 'Ready';
    $sb_lab->configure(-text => "  $sblabel");
    $mw->Unbusy;
    $mw->update;
    return(1);
  }
  sub grab #------------------------------------------------------------
  {
    #called from a button in the main window or the rc menu
    my $open = $_[0] || '0';
    my (@sel, $group, @grabs, $connected,);
    $mw->Busy(-recurse => 1);
    $pb = 0;
    
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected for grab.\n";
      goto b2_grab_cmd_end;
    }
    
    #Grab what?
    $lb2_msg->focus;
    @grabs = $lb2_msg->selectionGet;
    unless ($group and @grabs) {
      warn "Selection error\n";
      goto b2_grab_cmd_end;
    }
    
    #load group multipart db (%multi is a HoHoA) subj->part = msg id#
    my(%file,);
    tie %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
      or &error('MLDBM', 'DIE',);
    
    #get selection(s)
    foreach my $msgnum (@grabs) {
      my($subje, $parts, @art, $aref, $treturn,);
      for(1..4) { $pb++; $mw->update; }
      
      #read subject
      $subje = $lb2_msg->itemCget($msgnum, 0, -text);
      $parts = $lb2_msg->itemCget($msgnum, 2, -text);
      
      #lookup subject
      if ($parts > 1) {
        #Multipart message
        my $tmp     = $file{MULTIPARTDB}{$subje};
        my $parttot = keys %$tmp;
        my @parts   = sort(keys %$tmp);
        my $x = 0;
        if ($parttot == $parts + 1) { $x-- } #$x is a part 0 nfo fix
        
        #Download each part
        foreach my $part (@parts) {
          $x++;
          $sblabel = "Downloading... ($x of $parts)";
          $sb_lab->configure(-text => "  $sblabel");
          if ($pb >= 100) { $pb = 0; $mw->update;             }
          else            { for(1..5) { $pb++; $mw->update; } }
          my $msgid = $tmp->{$part};
          warn "part: [$part of $parts] msgid: [$msgid] x: [$x]\n";
          
          #Launch thread
          $shash{1}{optionCSV} = "$msgid,$x";
          $shash{1}{article} = 1;
          while ($shash{1}{article} == 1) {
            #wait for thread (only using 1 thread)
            if ($pb >= 100) { $pb = 0; }
            else            { $pb++;   }
            $mw->after(100);
            $mw->update;
          }
          $treturn = $shash{1}{return};
          unless ($treturn) {
            #missing parts
            last;
          }
        }
      }
      else {
        #singlepart message
        for(1..5) { $pb += 5; $mw->update; }
        $sblabel = 'Downloading... (1 of 1)';
        $sb_lab->configure(-text => "  $sblabel");
        $mw->update;
        
        #Launch thread
        $shash{1}{optionCSV} = "$msgnum,1,$group";
        $shash{1}{article} = 1;
        while ($shash{1}{article} == 1) {
          if ($pb >= 100) { $pb = 0; }
          else            { $pb++;   }
          $mw->after(100);
          $mw->update;
        }
        $treturn = $shash{1}{return};
      }
      
      #If the message was downloaded ok, then start up the decoder
      if ($treturn) {
        my ($res, $cvt, $ret,);
        for(1..5) { $pb += 5; $mw->update; }
        $sblabel = 'Decoding attachment...';
        $sb_lab->configure(-text => "  $sblabel");
        if ($pb > 99) { $pb = 0; }
        warn "Decoding attachment(s)\n";
        $mw->update;
        
        #launch thread
        $shash{1}{decode} = 1;
        while ($shash{1}{decode} == 1) {
          $mw->after(100);
          $mw->update;
        }
        $ret = $shash{1}{return};
        
        if ($ret) {
          #mark read; load and update group header db
          my($tmp, $chek,);
          $tmp = $file{HEADERDB};
          $tmp->{$msgnum}[7] = 'read';
          $file{HEADERDB} = $tmp;
          {
            my $imagedata = &load_image(2);
            $chek = $mw->Photo(
              -format => 'bmp',
              -data   => $imagedata
            );
          }
          $lb2_msg->indicator(
            'create', $msgnum,
            -itemtype => 'image',
            -image    => $chek
          );
          
          #open it?
          if ($open == 1) {
            my $cwd = cwd;
            my($dir, $file) = split(',', $ret);
            if ($^O eq 'MSWin32') {
              chdir "$dir";
              system('start', '/B', "$file");
              chdir "$cwd";
            }
            else {                                                      #test
              chdir "$dir";
              system("$file");
              chdir "$cwd";
            }
          }
        }
        else {
          #Could not decode attachment, try the next message
        }
      }
      else {
        #Missing some or all parts, try the next message
      }
    }
    
    b2_grab_cmd_end:
    untie %file;
    while($pb < 100) {
      $pb++;
      $mw->update;
    }
    $pb = 0;
    $sblabel = 'Ready';
    $sb_lab->configure(-text => "  $sblabel");
    $mw->update;
    $mw->Unbusy;
    return(1);
  }
  sub message_delete #--------------------------------------------------
  {
    #called from the rc menu
    my($group, @sel, %file,);
    $mw->Busy(-recurse => 1,);
    $sblabel = 'Deleting selected messages...';
    $sb_lab->configure(-text => "  $sblabel");
    
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected for message delete.\n";
      goto message_delete_end;
    }
    
    $lb2_msg->focus;
    @sel = $lb2_msg->selectionGet;
    unless ($sel[0]) {
      goto message_delete_end;
    }
    
    #load group header db
    if (-e "$group.grp") {
      tie %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
        or &error('MLDBM', 'DIE',);
    }
    else {
      goto message_delete_end;
    }
    
    my $tmp = $file{HEADERDB};
    #delete selected messages from screen and group header db
    foreach my $msgnum (@sel) {
      $lb2_msg->hide('entry', $msgnum);
      delete $tmp->{$msgnum};
    }
    $file{HEADERDB} = $tmp;
    $lb2_msg->selectionClear;
    $mw->update;
    
    message_delete_end:
    untie %file;
    $sblabel = 'Ready';
    $sb_lab->configure(-text => "  $sblabel");
    $mw->update;
    $mw->Unbusy;
    return(1);
  }
  sub read_message #----------------------------------------------------
  {
    #called from a button pressed in the main window or the rc menu
    my ($group, @sel, @a, $msg, $imagedata, $chek, $qp, %file,);
    $mw->Busy(-recurse => 1,);
    $sblabel = 'Connecting to server...';
    $sb_lab->configure(-text => "  $sblabel");
    $mw->update;
    
    #Read what?
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected for message read.\n";
      goto b3_read_cmd_end;
    }
    @sel = $lb2_msg->selectionGet;
    $lb2_msg->focus;
    unless ($group && $sel[0]) {
      $mw->Unbusy;
      goto b3_read_cmd_end;
    }
    
    #Connect
    my $nntpRef;
    $nntpRef = &nntpconnect();
    unless ($nntpRef) {
      $nntpRef = &nntpconnect();
      unless ($nntpRef) {
        warn "Error - Unable to connect to server, try again\n";
        goto b3_read_cmd_end;
      }
    }
    
    #Download message
    $sblabel = 'Downloading message...';
    $sb_lab->configure(-text => "  $sblabel");
    $mw->update;
    
    $$nntpRef->group($group);
    $msg = $$nntpRef->article($sel[0]);                                 #<-blocks
    $$nntpRef->quit();
    unless($msg) {
      &error('grab_4');
      goto b3_read_cmd_end;
    }
    
    $tl4->deiconify();
    $tl4->raise();
    $mw->update;
    
    $imagedata = &load_image(2);
    $chek = $mw->Photo(
      -format => 'bmp',
      -data   => $imagedata
    );
    undef $imagedata;
    
    #Parse MIME
    foreach (@$msg) {
      $_ =~ m/Content-Transfer-Encoding:\s+(.+)/;
      if ($1) {
        $qp = 1;
        last;
      }
    }
    if ($qp) {
      foreach my $res (@$msg) {
        #The following altered code is borrowed from the module
        #MIME::QuotedPrint::Perl created by: Gisle Aas
        $res =~ s/\r\n/\n/g;     # normalize newlines
        $res =~ s/[ \t]+\n/\n/g; # rule #3 (trailing space deleted)
        $res =~ s/=\n//g;        # rule #5 (soft line breaks)
        if (ord('A') == 193) {   # EBCDIC style machine
          if (ord('[') == 173) {
            $res =~ s/=([\da-fA-F]{2})/Encode::encode('cp1047',
            Encode::decode('iso-8859-1',pack("C", hex($1))))/gex;
          }
          elsif (ord('[') == 187) {
            $res =~ s/=([\da-fA-F]{2})/Encode::encode('posix-bc',
            Encode::decode('iso-8859-1',pack("C", hex($1))))/gex;
          }
          elsif (ord('[') == 186) {
            $res =~ s/=([\da-fA-F]{2})/Encode::encode('cp37',
            Encode::decode('iso-8859-1',pack("C", hex($1))))/gex;
          }
        }
        else {                    # ASCII style machine
          $res =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
        }
        push(@a, $res);
      }
      undef $msg;
      $msg = \@a;
    }
    
    #populate text
    foreach (@$msg) {
      $txt_read->insert('end', "$_");
    }
    undef $msg;
    
    $mw->Unbusy;
    $txt_read->focus;
    $tl4->update;
    
    #mark read; load and update group header db
    my $tmp;
    tie %file, 'MLDBM', "$group.grp", O_CREAT|O_RDWR, '0640'
      or &error('MLDBM', 'DIE',);
    $tmp = $file{HEADERDB};
    $tmp->{$sel[0]}[7] = 'read';
    $file{HEADERDB} = $tmp;
    $lb2_msg->indicator('create', $sel[0],
        -itemtype => 'image',
        -image    => $chek
    );
    
    b3_read_cmd_end:
    untie %file;
    while ($pb > 100) {
      $pb++;
      $mw->update;
    }
    $pb = 0;
    $sblabel = 'Ready';
    $sb_lab->configure(-text => "  $sblabel");
    $mw->Unbusy;
    $mw->update;
    return(1);
  }
  sub read_close #------------------------------------------------------
  {
    #called from a button pressed in the read window
    $txt_read->delete("1.0", 'end');
    $tl4->withdraw;
    $tl4->configure(-title => 'Read Message');
    $mw->update;
    return(1);
  }
  sub read_reply #------------------------------------------------------
  {
    #called from a button pressed in the read window
    my($c, $txt, @tmp, $refs, $mid, $subj);
    $mw->Busy(-recurse => 1);
    $txt = $txt_read->get('1.0', 'end');
    $txt_read->delete("1.0", 'end');
    $tl4->withdraw;
    
    @tmp = split('\n', $txt);
    undef $txt;
    
    $c = 0;
    foreach my $line (@tmp) {
      unless ($line =~ m/(.+)/) {
        $c++;
      }
      if ($c >= 1) {
        $txt .= ">$line\n";
      }
      else {
        if ($line =~ m/^References:\s+(.+)/) {
          $refs   = $1;
          #warn "gotref, refs is $refs\n";
        }
        elsif ($line =~ m/^Message-ID:\s+(.+)/) {
          $mid = $1;
          #warn "gotmid, mid is $mid\n";
        }
        elsif ($line =~ m/^Subject:\s+(.+)/) {
          my $a    = $1;
          if ($a =~ m/[Rr][Ee]:.*/) { $subj = $a;       }
          else                      { $subj = "Re: $a"; }
          #warn "gotsubj, subj is $subj\n";
        }
      }
    }
    if ($mid) { $refs .= $mid };
    dbmopen(my %OPT, 'settings', '0640')
      || die "Cannot create settings.\n$!";
    $OPT{Refs} = $refs;
    $post_entries[0]->delete('0', 'end');
    $post_entries[1]->delete('0', 'end');
    $post_entries[0]->insert('end', $OPT{Mail});
    $post_entries[1]->insert('end', $subj);
    dbmclose %OPT;
    
    my $typed;
    my @sel = $lb2_msg->selectionGet;
    $typed  = $lb2_msg->itemCget($sel[0], 1, -text);
    $typed .= " wrote in message-id:  $mid\n";
    $txt_post->insert('end', "$typed\n");
    $txt_post->insert('end', "$txt");
    $mw->Unbusy;
    &post();
    return(1);
  }
  sub post #------------------------------------------------------------
  {
    #called from a main button, rc menu, or read_reply
    my($from,);
    my @sel = $lb1_grp->selectionGet;
    my $group;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected for message post.\n";
      return(0);
    }
    {
      dbmopen(my %OPT, 'settings', '0640')
        || die "Cannot read settings.\n$!";
      $from = $OPT{Mail};
      dbmclose %OPT
    }
    $post_entries[0]->delete('0', 'end');
    $post_entries[0]->insert('end', $from);
    
    $tl2->deiconify();
    $tl2->raise();
    $txt_post->focus;
    $mw->update;
    return(1);
  }
  sub post_post #-------------------------------------------------------
  {
    #called from a button pressed in the post window or sub post_attach
    my $atch     = $_[0] || 0;
    my $cur      = $_[1] || 1;
    my $tot      = $_[2] || 1;
    my $filename = $_[3] || ' ';
    my (@sel, $msg, $hdr, $bdy, $subj, $from, $refs, $sign, $group,);
    
    #determine group
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected for posting to.\n";
      return(0);
    }
    $mw->update;
    $mw->Busy(-recurse => 1,);
    $sblabel = 'Formatting message...';
    $sb_lab->configure(-text => "  $sblabel");
    for (1..4) { $pb++; $mw->update; }
    
    #gather message information, update subject header
    #subject should not contain (#/#), it should look like below
    #[Comment1] "filename" yEnc (partnum/numparts) [size] [Comment2]
    $subj = $post_entries[1]->get();
    $from = $post_entries[0]->get();
    $subj =~ s/\(\d+\/\d+\)//g;
    {
      dbmopen(my %OPT, 'settings', '0640')
        || die "Cannot read settings.\n$!";
      unless ($sign)      { $sign = 0;                   }
      unless ($subj)      { $subj = 'No Subject';        }
      unless ($OPT{Refs}) { $OPT{Refs} = 0;              }
      if ($atch)          { $subj .= ' "'.$filename.'" '.
                                     "yEnc ($cur/$tot)"; }
      $refs = $OPT{Refs};
      $sign = $OPT{Sig};
      $OPT{Refs} = 0;                                                   #<-test
      dbmclose %OPT;
    }
    
    #create header
    if ($refs) {
      $hdr = 'From: '."$from\n".
             'Newsgroups: '."$group\n".
             'Distribution: '."world\n".
             'References: '."$refs\n".
             'X-NNTPclient: '."NewsSurfer v3.00\n".
             'X-CreatedBy: '." Just another Perl hacker...\n".
             'Subject: '."$subj\n\n";
    }
    else {
      $hdr = 'From: '."$from\n".
             'Newsgroups: '."$group\n".
             'Distribution: '."world\n".
             'X-NNTPclient: '."NewsSurfer v3.00\n".
             'X-CreatedBy: '." Just another Perl hacker...\n".
             'Subject: '."$subj\n\n";
    }
    $msg = $hdr."\n";
    
    #attach body and signature to first article only
    if ($cur == 1) {
      $bdy  = $txt_post->get("1.0", 'end');
      if ($sign) {
        #attach signature to body
        my (@sig,);
        if (open ('FH', '<', $sign)) {
          @sig = (<FH>);
          close FH;
          $bdy .= "\n--\n";
          foreach my $line (@sig) {
            chomp $line;
            $bdy .= "$line\n";
          }
        }
        else {
          &error('sig1')
        }
      }
      $msg .= $bdy."\n";
    }
    if ($atch) {
      #attach file part to article
      $msg .= $atch."\n";
    }
    
    #connect, post message, and disconnect
    $sblabel = 'Posting message...';
    $sb_lab->configure(-text => "  $sblabel");
    for (1..4) { $pb += 4; $mw->update; }
    my $nntpRef = &nntpconnect();
    if($nntpRef) {
      $$nntpRef->post([$msg]);                                          #<-blocks + check ret
      $$nntpRef->quit;
    }
    else {
      warn "Error - Unable to post message, could not connect\n";
    }
    
    #finish up
    while ($pb < 100) {
      $pb++;
      $mw->update;
    }
    $pb = 0;
    $sblabel = 'Ready';
    $sb_lab->configure(-text => "  $sblabel");
    $mw->Unbusy;
    $mw->update;
    
    if ($cur == $tot) {
      &post_cancel();
    }
    return(1);
  }
  sub post_yenc #-------------------------------------------------------
  {
    my $aref = $_[0] || return(0);
    my(@in, @out, $linesize,);
    $sblabel = 'Encoding attachment...';
    $sb_lab->configure(-text => "  $sblabel");
    for (1..4) { $pb++; $mw->update; }
    
    @in = @$aref;
    undef $aref;
    
    $linesize = 0;
    while (defined(my $byte = shift @in)) {
      my $yenc = ($byte + 42) % 256;
      if ($linesize >= 128) {
        #enforce line size, insert a CRLF pair
        push @out, 0x0D;
        push @out, 0x0A;
        $linesize = 0;
      }
      if ($linesize == 0 || $linesize == 127) {
        #escape a tab or space in the first or last column of a line
        if ($yenc == 0x09 || $yenc == 0x20) {
          $yenc = ( $byte + 64 ) % 256;
          push @out, 0x3D;
          push @out, $yenc;
          $linesize += 2;
          next;
        }
      }
      if ($yenc==0x00 || $yenc==0x0A || $yenc==0x0D || $yenc==0x3D ){
        #found a critical character, escape it with 0x3D (=)
        push @out, 0x3D;
        $yenc = ( $byte + 64 ) % 256;
        $linesize++;
      }
      push @out, $yenc;
      $linesize++;
    }
    my $ydata = join '', map { chr $_ } @out;
    return($ydata);
  }
  sub post_attachandpost #----------------------------------------------
  {
    #called from a button pressed in the post window
    my $file = $mw->getOpenFile();
    $mw->Busy(-recurse => 1);
    
    if (defined $file) {
      #Open the file, or return early
      unless (open ('ATCH', '< :raw', $file)) {
        &error('post_atch_1');
        return(0);
      }
      
      #deterimine filename and remove leading and trailing whitespace
      $sblabel = 'Creating attachment...';
      $sb_lab->configure(-text => "  $sblabel");
      for (1..4) { $pb += 4; $mw->update; }
      my $file_name = $file;
      $file_name =~ s/.+\/(.+)/$1/;
      $file_name =~ s/^\s+//;
      $file_name =~ s/\s+$//;
      
      #truncate filenames longer than 254 characters
      my $file_name_len = length $file_name;
      if ($file_name_len >= 255) {
        for (255..$file_name_len) {
          chop $file_name;
        }
      }
      
      #how large is the file in bytes
      my($file_bytes, $file_kbytes,);
      $file_bytes = -s $file;
      
      #Split files that are larger than the posting limit
      if ($file_bytes > 409600) {
        #how many parts will this be?
        my($totalparts, $currentpart,);
        $totalparts = 1 + (int($file_bytes / 409600));
        
        #read 400k chunks of the file into a string
        $currentpart = 1;
        while (my $size = read(ATCH, my $buf, 409600)) {
          #yEncode data
          my @data  = map { ord $_ } split(//, $buf);
          my $ydata = &post_yenc(\@data);
          my $begin = 1 + (($currentpart * 409600) - 409600);
          my $end;
          if ($size == 409600) {
            $end = $currentpart * $size;
          }
          else {
            $end = (($currentpart - 1) * 409600) + $size;
          }
          
          #Encapsulate data in yENC headers
          my $crlf  = "\015\012";
          my $yhead = "=ybegin ".
                      "part=$currentpart ".
                      "total=$totalparts ".
                      "line=128 ".
                      "size=$file_bytes ".
                      "name=$file_name";
          my $ypart = "=ypart ".
                      "begin=$begin ".
                      "end=$end";
          my $ytail = "=yend ".
                      "size=$size ".
                      "part=$currentpart";
          my $atch  = $crlf.$yhead.$crlf.$ypart.
                      $crlf.$ydata.$crlf.$ytail.$crlf;
          
          #send the message
          my $ret = &post_post($atch, $currentpart,
                               $totalparts, $file_name);
          if ($ret) {
            $currentpart++;
          }
          else {
            warn "Error - Unable to attach file\n";
            last;
          }
          $mw->update;
        }
        close ATCH;
      }
      else {
        #create single part message attachement
        my $line;
        while (<ATCH>) { $line .= $_; }
        close ATCH;
        
        #yEncode data
        my @data  = map { ord $_ } split(//, $line);
        my $ydata = &post_yenc(\@data);
        
        #Encapsulate data in yENC headers
        my $crlf  = "\015\012";
        my $yhead = "=ybegin ".
                    "line=128 ".
                    "size=$file_bytes ".
                    "name=$file_name";
        my $ytail = "=yend ".
                    "size=$file_bytes";
        my $atch  = $crlf.$yhead.$crlf.$ydata.$crlf.$ytail.$crlf;
        
        #send the message
        my $ret = &post_post($atch, 1, 1, $file_name);
        unless ($ret) {
          warn "Error - Unable to attach file\n";
        }
      }
    }
    else {
      warn "Warning - No file selected for attachment\n";
    }
    $mw->Unbusy;
    return(1);
  }
  sub post_cancel #-----------------------------------------------------
  {
    #called from a button pressed in the post window
    $txt_post->delete('1.0', 'end');
    $tl2->Unbusy;
    $tl2->withdraw();
    $mw->update;
    return(1);
  }
  sub browse #----------------------------------------------------------
  {
    #called from a button pressed in the main window
    $mw->Busy(-recurse => 1);
    dbmopen(my %OPT, 'settings', '0640')
      || die "Cannot create settings.\n$!";
    
    if ($^O eq 'MSWin32') {
      my ($dir,);
      $dir = $OPT{DDir};
      $dir =~ s#\/#\\#g;
      system("explorer.exe", "$dir");
    }
    else {
      system("ls", "$OPT{DDir}"); #test
    }
    dbmclose %OPT;
    $mw->Unbusy;
    $mw->update;
    return(1);
  }
  sub rset_cmd #--------------------------------------------------------
  {
    #called from the rc menu
    my ($sel, $rem,);
    $mw->Busy(-recurse => 1);
    $sel = $lb1_grp->selectionGet;
    $rem = $lb1_grp->itemCget($sel, 0, -text);
    unless ($sel && $rem) {
      warn "Warning - No valid groups selected for reset.\n";
      return(0);
    }
    $lb2_msg->delete('all');
    
    if (-e "$rem.grp") {
      unless (unlink  "$rem.grp") {
        &error('rset_1');
        return(0);
      }
    }
    dbmopen(my %SBSCRIBE, 'sbscribe', '0640')
      || die "Cannot create sbscribe.\a\n$!";
    $SBSCRIBE{$rem} = 'Never';
    dbmclose %SBSCRIBE;
    $mw->after(640);
    &display_groups();
    $mw->Unbusy;
    return(1);
  }
  sub group #-----------------------------------------------------------
  {
    #called from a button pressed in the main window
    my($lb_grp_s1, $imagedata, $chek,);
    $mw->Busy(-recurse => 1);
    $tl3->deiconify();
    $tl3->raise();
    $lb_grp->focus;
    foreach my $b (@buttons) {
      $b->configure(-state => 'disabled');
    }
    $mw->Unbusy;
    $mw->update;
    return(1);
  }
  sub grp_search #------------------------------------------------------
  {
    &search($lb_grp);
    return(1);
  }
  sub grp_shownewsgroups #----------------------------------------------
  {
    my($chek, $lb_grp_s1,);
    $mw->Busy(-recurse => 1,);
    $tl3->Busy(-recurse => 1,);
    $sblabel = 'Loading groups...';
    $sb_lab->configure(-text => "  $sblabel");
    
    {
      my $imagedata = &load_image(3);
      $chek = $mw->Photo(-format => 'bmp', -data => $imagedata);
      for (1..4) { $pb++; $mw->update; }
    }
    $lb_grp_s1 = $lb_grp->ItemStyle(
      'text',
      -selectforeground => '#000000',
      -selectbackground => '#fff000',
      -bg               => '#000000',
      -fg               => '#ffffff',
      -font             => '{Arial} 8',
      -anchor           => 'w',
    );
    
    if (-e 'groups') {
      my(%groups, $counter, $c,);
      tie %groups, 'MLDBM', 'groups', O_CREAT|O_RDWR, '0640' or die $!;
      dbmopen(my %SBSCRIBE, 'sbscribe', '0640')
        || die "Cannot create sbscribe.\a\n$!";
      $counter = $c = 0;
      foreach my $k (sort(keys(%groups))) {
        my $v = $groups{$k};
        $lb_grp->add($counter);
        $lb_grp->itemCreate($counter, 0,
          -text  => $k,
          -style => $lb_grp_s1
        );
        $lb_grp->itemCreate($counter, 1,
          -text  => $v,
          -style => $lb_grp_s1
        );
        if ($SBSCRIBE{$k}) {
          $lb_grp->indicator('create', $counter,
            -itemtype => 'image',
            -image    => $chek
          );
        }
        if ($pb >= 100) { $pb  = 0; $mw->update;                     }
        if ($c  > 1000) { for (1..5) { $pb++; $mw->update; } $c = 0; }
        else            { $c++;                                      }
        $counter++;
      }
      untie %groups;
      dbmclose %SBSCRIBE;
    }
    else {
      cant_open:
      $lb_grp->add(0);
      $lb_grp->itemCreate(0,0,
        -text => 'Press the Update button to retrieve groups '.
                 'from server.'
      );
    }
    
    until ($pb == 100) {
      $pb++;
      $mw->update;
    }
    $pb = 0;
    $sblabel = 'Ready';
    $sb_lab->configure(-text => "  $sblabel");
    $lb_grp->focus;
    $tl3->Unbusy;
    $mw->Unbusy;
    $mw->update;
    return(1);
  }
  sub grp_update #------------------------------------------------------
  {
    #called from a button pressed in the group window
    my ($HoA_ref, %HoA, %groups,);
    $tl3->Busy(-recurse => 1,);
    $sblabel = 'Downloading groups...';
    $sb_lab->configure(-text => "  $sblabel");
    $lb_grp->delete('all'); $mw->update;
    
    #connect
    my $nntpRef;
    $nntpRef = &nntpconnect();
    unless ($nntpRef) {
      $nntpRef = &nntpconnect();
      unless ($nntpRef) {
        warn "Error - Unable to connect to server, try again\n";
        goto b2_grp_update_end;
      }
    }
    
    $HoA_ref = $$nntpRef->list();                                       #<-blocks
    $$nntpRef->quit();
    %HoA = %$HoA_ref;
    undef $HoA_ref;
    #(HoA_ref) groupname = last, first, moderated
    #pl.misc.telefonia.gsm: 0000339959 0000307277 y
    #mvis.lists.apache.talk: 0000003574 0000003322 m
    
    $sblabel = 'Creating groups file...';
    $sb_lab->configure(-text => "  $sblabel");
    $mw->update;
    
    tie %groups, 'MLDBM', 'groups', O_CREAT|O_RDWR, '0640' or die $!;
    my $x;
    for my $groupname (keys %HoA) {
      my $totalarticles = $HoA{$groupname}[0] - $HoA{$groupname}[1];
      $groups{"$groupname"} = $totalarticles;
      $x++;
    }
    
    b2_grp_update_end:
    untie %groups;
    $tl3->Unbusy;
    &grp_close();
    &group();
    &grp_shownewsgroups();
    $sblabel = 'Ready';
    $sb_lab->configure(-text => "  $sblabel");
    $mw->update;
    return(1);
  }
  sub grp_subscribe #---------------------------------------------------
  {
    #called from a button pressed in the group window
    my ($imagedata, $chek, @sel,);
    $imagedata = &load_image(3);
    $chek = $mw->Photo(
      -format => 'bmp',
      -data   => $imagedata
    );
    undef $imagedata;
    dbmopen(my %SBSCRIBE, 'sbscribe', '0640')
      || die "Cannot create sbscribe.\a\n$!";
    
    @sel = $lb_grp->selectionGet;
    foreach (@sel) {
      my $a = $lb_grp->itemCget($_, 0, -text);
      $lb_grp->indicator('create', $_,
        -itemtype => 'image',
        -image    => $chek
      );
      $SBSCRIBE{$a} = 'Never';
    }
    dbmclose %SBSCRIBE;
    &display_groups();
    return(1);
  }
  sub grp_unsubscribe #-------------------------------------------------
  {
    #called from a button pressed in the group or main window
    my $opt = $_[0];
    dbmopen(my %SBSCRIBE, 'sbscribe', '0640')
      || die "Cannot create sbscribe.\a\n$!";
    if ($opt) {
      #unsubscribe from main screen
      my($sel, $a,);
      $sel = $lb1_grp->selectionGet;
      unless ($sel) {
        warn "Warning - No valid group selected to remove.\n";
        goto b4_grp_unsubscribe_end;
      }
      $a = $lb1_grp->itemCget($sel, 0, -text);
      warn "Warning - Removing newsgroup:  [$a.grp].\n";
      delete $SBSCRIBE{$a};
      if  (-e "$a.grp") {
        unlink "$a.grp" || &error('grp_unsub_1', "$a");
      }
      $lb2_msg->delete('all');
    }
    else {
      #unsubscribe from groups screen
      my (@sel,);
      @sel = $lb_grp->selectionGet;
      unless (@sel) {
        warn "Warning - No valid group selected to remove.\n";
        goto b4_grp_unsubscribe_end;
      }
      foreach (@sel) {
        my $a = $lb_grp->itemCget($_, 0, -text);
        $lb_grp->indicator('delete', $_,);
        warn "Warning - Removing newsgroup:  [$a.grp].\n";
        delete $SBSCRIBE{$a};
        if (-e "$a.grp") {
          unlink "$a.grp" || &error('grp_unsub_1', "$a");
        }
      }
    }
    b4_grp_unsubscribe_end:
    dbmclose %SBSCRIBE;
    &display_groups();
    return(1);
  }
  sub grp_close #-------------------------------------------------------
  {
    #called from a button pressed in the group window
    $mw->Busy(-recurse => 1);
    $mw->update;
    $lb_grp->delete('all');
    $tl3->withdraw;
    foreach my $b (@buttons) {
      $b->configure(-state => 'normal',);
    }
    $mw->update;
    $mw->Unbusy;
    return(1);
  }
  sub display_groups #--------------------------------------------------
  {
    #called from sub group_subscribe and group_unsubscribe
    my ($lb1_k1, $lb1_k2,);
    dbmopen(my %SBSCRIBE, 'sbscribe', '0640')
      || die "Cannot create sbscribe.\n$!";
    $lb1_grp->delete('all');
    $lb1_k1 = $lb1_grp->ItemStyle('text',
      -anchor           => 'w',
      -selectforeground => '#fff000',
      -background       => '#ffffff',
      -foreground       => '#000000',
      -font             => '{Arial} 8',
    );
    $lb1_k2 = $lb1_grp->ItemStyle('text',
      -anchor           => 'e',
      -selectforeground => '#fff000',
      -background       => '#ffffff',
      -foreground       => '#000000',
      -font             => '{Arial} 8',
    );
    
    my $counter = 1;
    for my $k (sort keys %SBSCRIBE) {
      $lb1_grp->add($counter);
      $lb1_grp->itemCreate($counter, 0,
        -text  => "$k",
        -style => $lb1_k1,
      );
      $lb1_grp->itemCreate($counter, 1,
        -text  => "$SBSCRIBE{$k}",
        -style => $lb1_k2,
      );
      $counter++;
    }
    dbmclose %SBSCRIBE;
    return(1);
  }
  sub search_popup #----------------------------------------------------
  {
    #called from rc menu
    my ($group, @sel,);
    #make sure the group clicked has been loaded or scanned.
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      print STDERR 'No valid group selected to search.'.
                   "\nEval: $@\n";
    }
    
    #raise popup
    $tla->deiconify;
    $tla->raise;
    $tla->focus;
    $mw->update;
    return(1);
  }
  sub search #----------------------------------------------------------
  {
    #called from button pressed in group window or search_popup window
    my $w = $_[0];
    my (@paths, $c,);
    
    #works for HLists only
    $w->focus;
    $mw->Busy(-recurse => 1,);
    $sblabel = 'Searching groups...';
    $sb_lab->configure(-text => "  $sblabel");
    $mw->update;
    
    if (defined $search) {
      #remove troublesome characters from search string
      #$search =~ s/([\+ \* \. \? \^ \$]+)/\\$1/x;
      $search = quotemeta($search);                                     #<-test
    }
    else {
      $search = ' ';
    }
    $tla->withdraw;
    
    $c = 0;
    @paths = $w->infoChildren;
    for (1..4) { $pb++; $mw->update; }
    foreach my $path (@paths) {
      my $item  = $w->itemCget($path, 0, -text);
      if ($item =~ m/$search/i) { $w->show('entry', $path); }
      else                      { $w->hide('entry', $path); }
      $c++;
      if ($c >= 1000) {
        if ($pb >= 100) { $pb = 0; }
        else            { $pb++;   }
        $c = 0;
        $mw->update;
      }
    }
    
    grp_search_end:
    undef $search;
    while ($pb < 100) { $pb++; $mw->update; }
    $pb = 0;
    $sblabel = 'Ready';
    $sb_lab->configure(-text => "  $sblabel");
    $mw->update;
    $mw->Unbusy;
    return(1);
  }
  sub opt #-------------------------------------------------------------
  {
    #called from button pressed in the main window
    dbmopen(my %OPT, 'settings', '0640')
      || die "Cannot create settings.\n$!";
    foreach my $e (@OPT_entries) {
      $e->delete(0, 'end');
    }
    $OPT_entries[0]->insert('end', $OPT{Serv});
    $OPT_entries[1]->insert('end', $OPT{User});
    $OPT_entries[2]->insert('end', $OPT{Pass});
    $OPT_entries[3]->insert('end', $OPT{Mail});
    $OPT_entries[4]->insert('end', $OPT{DDir});
    $OPT_entries[5]->insert('end', $OPT{Sig});
    
    dbmclose %OPT;
    $tl5->deiconify();
    $tl5->raise();
    $tl5->focus;
    $mw->update;
    return(1);
  }
  sub opt_close #-------------------------------------------------------
  {
    #called from button pressed in the option window
    my($serv, $user, $pass, $email, $ddir, $sig,);
    dbmopen(my %OPT, 'settings', '0640')
      || die "Cannot create settings.\n$!";
    $serv  = $OPT_entries[0]->get();
    $user  = $OPT_entries[1]->get();
    $pass  = $OPT_entries[2]->get();
    $email = $OPT_entries[3]->get();
    $ddir  = $OPT_entries[4]->get();
    $sig   = $OPT_entries[5]->get();
    $OPT{Serv} = $serv;
    $OPT{User} = $user;
    $OPT{Pass} = $pass;
    $OPT{Mail} = $email;
    $OPT{DDir} = $ddir;
    $OPT{Sig}  = $sig;
    dbmclose %OPT;
    $tl5->withdraw;
    $mw->update;
    return(1);
  }
  sub opt_download #----------------------------------------------------
  {
    #called from button pressed in the option window
    my ($dir,);
    $OPT_entries[4]->delete(0, 'end');
    
    eval {
      $dir = $tl5->chooseDirectory(
        -title      => 'Choose a download directory.',
        -initialdir => '.',
        -mustexist  => 1,
      )
    };
    if ($@) { &error('conf_browse1'); }
    
    if ($dir) {
      $OPT_entries[4]->insert('end', "$dir");
    }
    else {
      $OPT_entries[4]->insert('end', ".");
    }
    $mw->update;
    return(1);
  }
  sub opt_signature #---------------------------------------------------
  {
    #called from button pressed in the option window
    my ($sig, $ofile,);
    $OPT_entries[5]->delete(0, 'end');
    
    $ofile = $tl5->getOpenFile(
      -title      => 'Choose Signature File',
      -initialdir => '.',
    );
    if ($ofile) {
      $OPT_entries[5]->insert('end', "$ofile");
    }
    return(1);
  }
  sub show_log #--------------------------------------------------------
  {
    #called from button pressed in the main window
    my (@log,);
    $tl1->deiconify();
    $tl1->raise();
    $txt_log->focus;
    $txt_log->delete('1.0', 'end');
    $mw->update;
    $mw->Busy(-recurse => 1);
    
    close STDERR;
    open ('FH', '<', 'NewsSurfer.log')
      || warn "Error - Cannot open NewsSurfer.log\n$!";
    @log = (<FH>);
    close FH;
    open STDERR, '>>', 'NewsSurfer.log'
      || warn "Error - Cannot open NewsSurfer.log\n$!";
    
    foreach my $line (@log) {
      chomp $line;
      unless (defined $line) { $line = '#'; }
      $line =~ s/^Net.*\)(<|>.*)/$1/;
      if ($line =~ /^>>>.*/) {
        $txt_log->insert('end', $line."\n", 'Blue');
      }
      elsif ($line =~ m/^Error\s*-.+/i) {
        $txt_log->insert('end', $line."\n", 'Red');
      }
      elsif ($line =~ m/^Warning\s*-.+/i) {
        $txt_log->insert('end', $line."\n", 'Yellow');
      }
      else {
        $txt_log->insert('end', $line."\n");
      }
      $mw->update;
    }
    $mw->Unbusy;
    return(1);
  }
  sub log_close #-------------------------------------------------------
  {
    #called from button pressed in the log window
    $tl1->withdraw;
    $mw->update;
    return(1);
  }
  sub log_save #--------------------------------------------------------
  {
    #called from button pressed in the log window
    my (@log, $sf,);
    $sf  = $tl1->getSaveFile(-title => 'Save Log',);
    
    if ($sf) {
      warn "Warning - A logfile has been saved.\n";
      $mw->Busy(-recurse => 1);
      open ('FH', '<', 'NewsSurfer.log')
        || warn "Error - Cannot open NewsSurfer.log\n";
      @log = (<FH>);
      close FH;
      open ('FH', '>', $sf)
        || warn "Error - Can not save log.\n$!";
      foreach my $line (@log) {
        chomp $line;
        print FH "$line\n";
      }
      close FH;
      $mw->Unbusy;
      return(1);
    }
  }
  sub help #------------------------------------------------------------
  {
    #called from button pressed in the main window
    $tl6->deiconify();
    $tl6->raise();
    $txt_help->focus;
    $txt_help->delete("1.0", 'end');
    $txt_help->insert('end',
      'NewsSurfer can download binaries and read messages on '.
      "usenet newsgroups.\n".
      "You can use NewsSurfer to post messages and atachments.\n"
    );
    $mw->update;
    return(1);
  }
  sub help_about #------------------------------------------------------
  {
    #called from button pressed in the help window
    my($pod,);
    $pod = $mw->Pod(-tree => 0,);
    $pod->configure(-file => $0);
    return(1);
  }
  sub help_close #------------------------------------------------------
  {
    #called from button pressed in the help window
    $tl6->withdraw;
    $mw->update;
    return(1);
  }
  sub quit #------------------------------------------------------------
  {
    #called from button pressed in the main window
    $mw->Busy(-recurse => 1,);
    $mw->update;
    warn 'NewsSurfer has closed.  (' . localtime() . ")\n";
    $mw->destroy;
    return(1);
  }
  sub raise_rc_menu #---------------------------------------------------
  {
    #called from right-clicking in the main window
    my $toplevelwidget = $_[0] || 'NULL'; #required
    my $listbox        = $_[1];           #optional
    my($x, $y) = $mw->pointerxy;
    my $height;
    
    $mw->Busy(-recurse => 1,);
    if ($listbox && Exists($listbox) && Exists($toplevelwidget)) {
      #a listbox was supplied
      my($selected,);
      
      #verify widget is a listbox
      eval { $selected = $listbox->nearest($y - $listbox->rooty) };
      if (! $@) {
        #it's a listbox, make selection at xy if there is a entry
        if ($selected) {
          $listbox->selectionClear();
          $listbox->selectionSet($selected);
        }
      }
      $height = $toplevelwidget->height;
      $y -= $height;
    }
    if (Exists($toplevelwidget)) {
      $toplevelwidget->geometry('+'."$x".'+'."$y");
      $toplevelwidget->deiconify();
      $toplevelwidget->raise();
      $toplevelwidget->focus();
      $mw->update;
    }
    $mw->Unbusy;
    return(1);
  }
  sub lb2_msg_select_all #----------------------------------------------
  {
    #called from the rc menu or key binding
    my (@paths, $count, $home, $end,);
    $mw->Busy(-recurse => 1);
    
    @paths = $lb2_msg->infoChildren;
    if (@paths) {
      $count = $#paths;
      $home  = $paths[0];
      $end   = $paths[$count];
      $lb2_msg->focus;
      $lb2_msg->selectionSet("$home", "$end");
    }
    $mw->update;
    $mw->Unbusy;
    return(1);
  }
  sub lb2_msg_select_end #----------------------------------------------
  {
    #called from the rc menu or key binding
    my ($sel, @paths, $count, $end,);
    $sel   = $lb2_msg->selectionGet;
    @paths = $lb2_msg->infoChildren;
    $count = $#paths;
    $end   = $paths[$count];
    $lb2_msg->selectionSet($sel, "$end");
    $mw->update;
    return(1);
  }
  sub lb2_msg_select_hom #----------------------------------------------
  {
    #called from the rc menu or key binding
    my ($sel, @paths, $home,);
    $sel   = $lb2_msg->selectionGet;
    @paths = $lb2_msg->infoChildren;
    $home  = $paths[0];
    $lb2_msg->selectionSet($sel, "$home");
    $mw->update;
    return(1);
  }
  sub FlashButton #-----------------------------------------------------
  {
    #called during widget creation
    my $w = $_[0]; my $c1 = $_[1]; my $c2 = $_[2];
    unless($w and $c1 and $c2) {
      goto FlashButton_end;
    }
    $w->bind('<ButtonPress-1>' => sub {
      $w->configure(-relief  => 'flat',);
      $w->configure(-fg      => $c1); $w->flash; $w->flash;
      $w->configure(-fg      => $c2);
    });
    return(1);
  }
  sub MainButtons #-----------------------------------------------------
  {
    #called during widget creation
    my $w = $_[0]; my $o1 = $_[1];
    my ($id1, $id2, $i1, $i2, $i3,);
    my $o2 = $o1.'1';
    
    $id1 = &load_image($o1);
    $id2 = &load_image($o2);
    
    $i1 = $mw->Photo(
      -data    => $id1,
      -format  => 'bmp',
      -palette => '256',
    );
    $i2 = $mw->Photo(
      -data    => $id1,
      -format  => 'bmp',
      -palette => '64/64/64',
    );
    $i3 = $mw->Photo(
      -data   => $id2,
      -format => 'bmp',
    );
    undef $id1;
    undef $id2;
    
    my $width  = $mw->screenwidth;
    if ($width > 800) {
      $i1->copy($i1, -zoom => 1.9,1,);
      $i2->copy($i2, -zoom => 1.9,1,);
      $i3->copy($i3, -zoom => 1.9,1,);
    }
    
    $w->configure(-relief => 'flat', -image => $i1);
    
    $w->bind('<Leave>' => sub { $w->configure(-image => $i1); });
    $w->bind('<Enter>' => sub { $w->configure(-image => $i2); });
    $w->bind('<ButtonPress-1>' => sub {
      $w->configure(
        -relief => 'flat',
        -image  => $i3
      );
    });
    $w->bind('<ButtonRelease-1>' => sub {
      $w->configure(
        -relief => 'flat',
        -image  => $i1
      );
    });
    $mw->update;
    return(1);
  }
  sub error #-----------------------------------------------------------
  {
    #called from various subroutines
    my $error = $_[0] || 'NULL';
    my $opt1  = $_[1] || 0;
    my(@sel, $group,);
    
    my $msg   = "\nError - ";
    @sel = $lb1_grp->selectionGet;
    eval { $group = $lb1_grp->itemCget($sel[0], 0, -text) };
    if ($@) {
      warn "Error - No valid group selected.\n";
    }
    
    $mw->Busy(-recurse => 1);
    if ($error eq 'connect') {
      $msg .= "Could not connect, try again.\n";
    }
    elsif ($error =~ m/grab*/ig) {
      if ($error eq 'grab_1') {
        $msg .= "Cannot open $group.dat\n$!";
      }
      elsif ($error eq 'grab_2a') {
        $msg .= "Cant decode attachment.\n"."File already exists.\n";
      }
      elsif ($error eq 'grab_2b') {
        $msg .= "Cant decode attachment.  Decoder error.\n$!";
      }
      elsif ($error eq 'grab_3') {
        $msg .= "Cannot open $group.grp\n$!";
      }
      elsif ($error eq 'grab_4') {
        $msg .= "Article does not exist on server\n$!";
      }
    }
    elsif ($error =~ m/scan*/ig) {
      if ($error eq 'scan_1') {
        $msg .= "Must select a group to scan.\n";
      }
      elsif ($error eq 'scan_2') {
        $msg .= "Cannot open $group.grp\n$!";
      }
      elsif ($error eq 'scan_3') {
        $msg .= "Cannot create $group.grp\n$!";
      }
    }
    elsif ($error =~ m/grp*/ig) {
      if ($error eq 'grp_1') {
        $msg .= "Cannot open groups.\n$!";
      }
      elsif ($error eq 'grp_update_1') {
        $msg .= "Can't create local groups.\n$!";
      }
      elsif ($error eq 'grp_unsub_1') {
        $msg .= "Unable to delete $_[1].grp\n$!";
      }
      elsif ($error eq 'grp_unsub_2') {
        $msg .= "Unable to delete $_[1].dat\n$!";
      }
      elsif ($error eq 'grp_search_1') {
        $msg .= "Must enter a search term.\n";
      }
    }
    elsif ($error =~ m/post*/ig) {
      if ($error eq 'post_1') {
        $msg .= "Must scan a group to post to.\n";
      }
      elsif ($error eq 'post_atch_1') {
        $msg .= "Cannot open file\n$!";
      }
      elsif ($error eq 'post_attach_tobig') {
        $msg .= "Can't post file attachments larger than 1Mb.\n";
      }
    }
    else {
      if ($error eq 'login') {
        $msg .= "Cannot login\n$!";
      }
      elsif ($error eq 'MLDBM') {
        $msg .= "Error opening .grp database file\n$!";
      }
      elsif ($error eq 'conf_browse1') {
        $msg .= 'Manually enter path or upgrade perl/Tk.';
      }
      elsif ($error eq 'msg_del_1') {
        $msg .= "Cannot open $group.grp\n$!";
      }
      elsif ($error eq 'read_1') {
        $msg .= "Cannot open $group.grp\n$!";
      }
      elsif ($error eq 'rset_1') {
        $msg .= "Unable to delete file.\n$!";
      }
      elsif ($error eq 'sort_1') {
        $msg .= "Cannot open $group.grp\n$!";
      }
      elsif ($error eq 'sig1') {
        $msg .= "Can't load signature.\n$!";
      }
    }
    
    $sblabel = "$msg";
    $sblabel =~ s/[\n\r]//g;
    $sb_lab->configure(-text => "  $sblabel");
    warn "$msg\n";
    $mw->update;
    $mw->after(2000);
    if ($opt1) { $mw->destroy; }
    
    $sblabel = 'Ready';
    $sb_lab->configure(-text => "  $sblabel");
    $mw->update;
    $mw->Unbusy;
    return(1);
  }
  sub update_status #---------------------------------------------------
  {
    #called from various subroutines
    #called with either a status message in $txt
    #or a number followed by PROGRESSBAR (triggers progressbar update)
    my $txt = $_[0] || 'NULL';
    my $opt = $_[1] || 'NULL';
    
    if ($opt eq 'PROGRESSBAR' && $txt =~ m/(^\d+)/) {
      #update status of progressbar
      for (1..$1) { $pb++; $mw->update; $mw->after(64); }
    }
    elsif ($txt ne 'NULL' && $opt ne 'PROGRESSBAR') {
      $sb_lab->configure(-text => "  $txt");
      $mw->update;
    }
    else {
      warn "Error - update_status error\ntxt [$txt]\nopt [$opt]\n$!";
      $mw->destroy;
    }
    return(1);
  }
  return(1);
}
#***********************************************************************END news_gui
sub load_image #--------------------------------------------------------
{
  #called from various subroutines, returns imagedata
  my $opt = $_[0]; my $imagedata;
  if ($opt == 2) {
    $imagedata =
    'Qk1YAgAAAAAAADYAAAAoAAAACgAAABEAAAABABgAAAAAAAAAAAASCwAAEgsAAA'.
    'AAAAAAAAAA////////////////////////////////////////AAD4+Pj/////'.
    '//////////////////////////////8AAP////////////////////////////'.
    '39/f39/fj4+AAA////////////////////////////////////////AAD/////'.
    '///+/v7+/v79/f39/f3+/v7///////////8AAGZHumlKvUYvi4p0xotyzVhEkm'.
    'BFp1w8sP38/v///wAAdlfK////////9fL79fP8+vj//fz/i3LN+vn9////AABm'.
    'R7r49//4+/9JTFsXGCGvr7b///9sU7X////9/f8AAGZHuvHu/sPG1RYZKBobKx'.
    'AQFGFedGFHrPz8/f79/wAAa0+6/Pv/Xl5mAAAIq6yyJygrAAASZE6i+/v9/v7/'.
    'AAByWLv49f/R0NfLy9Dw8PStrrUHBhBRP4P///////8AAHNVv/v6/fXy+vj3/P'.
    'Lv+vHv+RcSJgUDCO/v7////wAAgGTGeV3AlX3RhGjLi3LNi3LNdlrAIiElDQsT'.
    '7+/vAAD///3///7+/f/////////////9/fz39/clJyPQ0NAAAP////////////'.
    '///////////////////////////wAA/v7+////////////////////////+/v7'.
    '////+Pj5AAD////////+/v7+/v7+/v7////////////////7/PsAAAAA';
  }
  elsif ($opt == 3) {
    $imagedata =
    'Qk1YAgAAAAAAADYAAAAoAAAACgAAABEAAAABABgAAAAAAAAAAAASCwAAEgsAAA'.
    'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHBwcAAAAA'.
    'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA'.
    'ICAgICAgcHBwAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA'.
    'AAARDSABAQEBAQEAAAAAAAANCRgAAAAAAAAAAGZHunZXymtQtmZHumlYmHNfqm'.
    'tRsWxSsAgHDQAAAAAAdlfKAAAAAAAACg0ECgwDBQcAAgMAZke6HBYuAAAAAABm'.
    'R7oHCAAHBAC2s6To595QUEkAAABtWKgZES0BAQAAAGZHug4RATw5Kunm1+Xk1O'.
    '/v656hi3JepREMHQAAAAAAa0+6AwQAoaGZ///3VFNN2NfU///taUy1GRIsAQEA'.
    'AAByWLsHCgAjIx4qKiYODgpSUUr4+e9sUrQYESwAAAAAAHNVvwoJDg0KFRwUMB'.
    'wYKBQTEdDO0/r89xAQEAAAAAAAbU69Zke6ZkytZ0uzaVSgZke6Zke63d7a8vTs'.
    'EBAQAAAAAAIAAAEBAgAAAAAAAAAAAAACAgMICAja2NwvLy8AAAAAAAAAAAAAAA'.
    'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQEBAAAAAAAAAAAAAAAAAAAAAAAABAQE'.
    'AAAABwcGAAAAAAAAAAABAQEBAQEBAQEAAAAAAAAAAAAAAAAEAwQAAAAA';
  }
  elsif ($opt == 10) {
$imagedata =
'Qk2mDgAAAAAAADYAAAAoAAAAOAAAABYAAAABABgAAAAAAHAOAAAmDgAAJg4AAAAAAAAAAAAAoaGh
oaGhoKCgoKCgoKCgnJyckJCQiIiIh4eHh4eHhYWFhYWFhISEhISEhISEg4ODg4ODg4ODg4ODgoKC
goKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCg4ODg4ODg4ODhISEhISEhISEhYWFhYWFhoaGhoaG
hoaGh4eHh4eHh4eHh4eHh4eHiIiIiIiIiIiIjIyMlJSUnp6eoaGhoaGhoaGhoaGhoaGhoaGhoaGh
oKCgoKCgkpKSj4+Purq61NTU29vb2dnZ2tra2dnZ2NjY1tbW1tbW1dXV1dXV1dXV1NTU1NTU1NTU
09PT09PT09PT09PT09PT09PT09PT1NTU1dXV1dXV1dXV1tbW1tbW2NjY2dnZ2tra29vb3Nzc3Nzc
3Nzc3d3d3d3d3t7e3t7e39/f39/f39/f0dHRsrKyioqKlJSUoaGhoaGhoaGhoaGhoaGhoaGhoKCg
jo6OoqKi6enp/Pz8+/v7+vr6+fn5+Pj49vb29fX19PT08/Pz8vLy8fHx8fHx8PDw7+/v7+/v7+/v
7+/v7+/v7u7u7+/v7+/v7+/v8PDw8PDw8fHx8vLy8/Pz9PT09fX19/f3+Pj4+fn5+vr6+/v7/Pz8
/f39/f39/v7+/v7+////////////////////5ubmoaGhjo6OoaGhoaGhoaGhoaGhoKCgkZGRoKCg
+fn5/Pz8+/v7+vr6+fn5+Pj49vb29fX18/Pz8vLy8fHx8PDw7+/v7u7u7u7u7e3t7Ozs7Ozs7Ozs
7Ozs7Ozs7Ozs7Ozs7Ozs7u7u7u7u7+/v8PDw8fHx8vLy8/Pz9fX19/f3+Pj4+fn5+vr6+/v7/Pz8
/f39/v7+/v7+/v7+/////////////////////Pz8qqqqj4+PoaGhoaGhoaGhmZmZi4uL5+fn9vb2
9fX19PT08/Pz8vLy8fHx7+/v7e3t6+vr6urq6enp6Ojo5ubm5ubm5eXl5OTk5OTk5OTk5OTk5OTk
5OTk5OTk5OTk5OTk5eXl5ubm5ubm6Ojo6enp6urq7Ozs7u7u7+/v8fHx8/Pz9PT09fX19vb29/f3
9/f3+Pj4+Pj4+fn5+fn5+fn5+fn5+fn5+fn58/PznJyck5OToaGhoaGhjIyMxcXF7+/v7u7u7e3t
7Ozs6+vr6enp6Ojo5ubm5eXl4+Pj4eHh39/f3t7e3d3d3Nzc3Nzc29vb29vb2tra2tra2tra2tra
2tra2tra29vb3Nzc3d3d3d3d39/f4eHh4uLi4+Pj5eXl5+fn6Ojo6urq6+vr7e3t7u7u7u7u7+/v
8PDw8PDw8fHx8fHx8fHx8fHx8fHx8fHx8fHx4ODgh4eHn5+fnJycjo6O4uLi5eXl5OTk4+Pj4uLi
4eHh39/f3d3d29vb2dnZ2NjY1tbW1NTU09PT0tLS0dHR0NDQ0NDQz8/Pz8/Pz8/Pz8/Pz8/Pz8/P
z8/P0NDQ0dHR0tLS09PT1NTU1dXV19fX2dnZ2tra3Nzc3t7e4ODg4uLi4uLi4+Pj5OTk5eXl5ubm
5ubm5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fnp6enlZWVlJSUpKSk29vb2tra2dnZ2NjY19fX1dXV
09PT0tLS0NDQzs7OzMzMy8vLycnJyMjIx8fHxsbGxsbGxcXFxMTExMTExMTEw8PDw8PDxMTExMTE
xcXFxsbGxsbGx8fHycnJysrKzMzMzc3Nz8/P0dHR09PT1dXV1tbW2NjY2dnZ2dnZ2tra29vb29vb
3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3NzcxMTEiYmJjIyMsrKyzs7Ozs7Ozc3NzMzMy8vLycnJyMjI
xsbGxcXFw8PDwcHBv7+/vr6+vLy8vLy8u7u7urq6ubm5ubm5uLi4uLi4uLi4uLi4uLi4ubm5ubm5
u7u7vLy8vLy8vb29v7+/wMDAwsLCxMTExcXFx8fHycnJysrKzMzMzc3Nzs7Ozs7Oz8/Pz8/P0NDQ
0NDQ0NDQ0NDQ0NDQ0NDQ0NDQ0NDQy8vLgoKChoaGt7e3wsLCwsLCwcHBwMDAv7+/v7+/vr6+vb29
vLy8u7u7uLi4t7e3tbW1vaem32Vf8kI48kI46lBH0Xp1sbGxsbGx1nNt7kk/8kI45VdOsrKy419W
8kI45lhP8kI4419XuLi48kI45GBYvb295WFZ8kI4wcHBwsLCw8PDxMTExMTExcXFxcXFxsbGxcXF
xcXFxMTExMTExMTExMTExMTEwMDAgoKCg4ODs7OzuLi4t7e3tra2tra2urq6u7u7u7u7urq6ubm5
t7e3tbW1tLS0s7OzwpqX6FxTyY2JwZiW1Hp08FBGyIyI0IF78FBG1Hp0wJiW1Hp0wZiW8FBG3W9o
xpSQ8FBG4WpitbW18FBG4mtjurq642tk8FBGvb29vr6+v7+/wMDAwcHBwcHBwcHBwsLCwsLCwMDA
vLy8ubm5ubm5ubm5ubm5tra2goKCgoKCq6urrq6urq6urKyssrKyurq6u7u7urq6ubm5t7e3t7e3
tra2tLS0tLS0t66us7Ozs7Ozwp2b3Xhy8F5V0IiE4HNt8F5VsbGxsrKysrKyt62t7GRb6Glh0omF
8F5V4XRttra28F5V4nRuubm54nVv8F5VvLy8vb29vb29vr6+v7+/v7+/v7+/v7+/v7+/v7+/u7u7
srKyr6+vr6+vr6+vrKysgoKCg4ODoqKipqampqamp6entbW1vr6+vr6+vb29vLy8u7u7urq6urq6
ubm5uLi4t7e305SQ7XRt8HBo8HBo7XRtva2s3oaB8HBovq6tt7e3vq6ut7e3u7OyyqKf1JSR8HBo
4oJ8urq68HBo44N9vLy85IN+8HBov7+/v7+/wMDAwcHBwcHBwcHBwcHBwcHBwcHBwcHBwMDAs7Oz
qKiop6enp6enpaWlgoKCh4eHmZmZoKCgoKCgp6envb29xMTExMTEw8PDw8PDwcHBwcHBwcHBwMDA
wMDAybSy8oN974eB252a0qimwbu6vr6+yLSy74eB74eB5ZKN8oN9vr6+4paS5ZKN6I+J8oN93J6b
wcHB8oN974eB5pOO8oN97IuGxMTExMTExcXFxsbGxsbGxsbGxsbGxsbGxsbGxsbGxsbGurq6paWl
oaGhoaGhn5+fgoKCjY2Nk5OToKCgoKCgrq6uysrKz8/Pzs7Ozs7Ozs7Ozc3NzMzMzMzMzMzMy8vL
08LB9JmT56ily8vLzcfH2ri20sHAysrK0MTD3bWy37Kv2Lu5y8vL08LB4LKw4LKw27m2zMzMzMzM
18C+1cPC18C/4bSx08jHz8/Pz8/Pz8/P0NDQ0NDQ0NDQ0NDQ0NDQ0NDQ0NDQ0NDQx8fHq6uroaGh
oaGhn5+fgoKClZWVi4uLoKCgoKCgtLS01NTU2dnZ2dnZ2NjY2NjY19fX19fX19fX19fX1tbW1tbW
6MC99q6p9q6p9q6p9q6p3M7N1tbW1tbW1tbW1tbW1tbW1tbW1tbW19fX19fX19fX19fX19fX19fX
2NjY2NjY2NjY2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2tra2tra2tra2tra2tra0dHRr6+voaGhoaGh
l5eXioqKnp6eg4ODnp6eoKCgsLCw2NjY4uLi4uLi4uLi4uLi4uLi4eHh4eHh4eHh4eHh4eHh4eHh
4t/f59nY59nY4eHh4ODg4ODg4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4uLi
4uLi4uLi4uLi4uLi4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj0tLSq6uroaGhoaGhioqK
l5eXoaGhkJCQkJCQoKCgqamp1tbW6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6urq6urq
6urq6urq6urq6urq6urq6urq6urq6urq6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr
6+vr6+vr6+vr7Ozs7Ozs7Ozs7Ozs7Ozs7Ozs7Ozs7Ozs7Ozs6+vry8vLpaWloaGhmZmZgYGBoKCg
oaGhnZ2dgYGBmZmZoqKixsbG7u7u8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz
8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz
8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz9PT09PT09PT09PT09PT05+fnubm5oaGhnZ2dhYWFlZWVoaGhoaGh
oaGhlJSUhYWFnZ2dsbGx4eHh+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6
+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6
+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr68/Pzzs7Op6ennp6eiIiIkZGRoaGhoaGhoaGhoaGh
oaGhkJCQhISEmpqavLy84ODg8vLy9/f39/f3+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5
+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5
+fn5+fn5+fn5+fn5+fn5+fn58/Pz5eXly8vLrKyslpaWhYWFkJCQoaGhoaGhoaGhoaGhoaGhoaGh
oaGhlpaWgYGBjIyMoaGhsrKyurq6vb29wMDAwcHBwcHBwMDAwMDAwMDAwMDAwMDAwMDAwMDAwcHB
wcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHB
wcHBwcHBwcHBwcHBwMDAtra2pqamlpaWioqKgICAmZmZoaGhoaGhoaGhoaGh';
  }
  elsif ($opt == 101) {
$imagedata =
'Qk2mDgAAAAAAADYAAAAoAAAAOAAAABYAAAABABgAAAAAAHAOAAAmDgAAJg4AAAAAAAAAAAAAoaGh
oaGhoKCgoKCgoKCgnJyckJCQiIiIh4eHh4eHhYWFhYWFhISEhISEhISEg4ODg4ODg4ODg4ODgoKC
goKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCg4ODg4ODg4ODhISEhISEhISEhYWFhYWFhoaGhoaG
hoaGh4eHh4eHh4eHh4eHh4eHiIiIiIiIiIiIjIyMlJSUnp6eoaGhoaGhoaGhoaGhoaGhoaGhoaGh
oKCgoKCgkpKShoaGmpqapaWlqampqKioqKiop6enp6enpaWlpaWlpaWlpKSkpKSko6Ojo6Ojo6Oj
o6Ojo6Ojo6Ojo6Ojo6Ojo6Ojo6Ojo6OjpKSkpKSkpaWlpaWlpaWlp6enp6enqKioqampqampqqqq
qqqqq6urq6urq6urq6urrKysrKysrKyspqaml5eXhYWFlJSUoaGhoaGhoaGhoaGhoaGhoaGhoKCg
jo6Oj4+PsLCwubm5uLi4t7e3t7e3tra2tLS0tLS0s7OzsrKysbGxsbGxsbGxsLCwr6+vr6+vr6+v
r6+vr6+vr6+vr6+vr6+vr6+vsLCwsLCwsbGxsbGxsrKys7OztLS0tbW1tra2t7e3t7e3uLi4ubm5
urq6urq6urq6urq6u7u7u7u7u7u7u7u7u7u7r6+vkJCQjo6OoaGhoaGhoaGhoaGhoKCgkZGRj4+P
uLi4ubm5uLi4t7e3t7e3tra2tLS0tLS0srKysbGxsbGxsLCwr6+vr6+vr6+vrq6ura2tra2tra2t
ra2tra2tra2tra2tra2tr6+vr6+vr6+vsLCwsbGxsbGxsrKytLS0tbW1tra2t7e3t7e3uLi4ubm5
urq6urq6urq6urq6u7u7u7u7u7u7u7u7u7u7urq6lJSUj4+PoaGhoaGhoaGhmZmZhISEsLCwtra2
tbW1tLS0tLS0s7OzsrKysbGxr6+vrq6ura2trKysrKysqqqqqqqqqqqqqampqampqampqKioqKio
qKioqKioqampqampqqqqqqqqqqqqrKysrKysra2tr6+vsLCwsbGxsrKytLS0tLS0tbW1tra2t7e3
t7e3t7e3t7e3uLi4uLi4uLi4uLi4uLi4uLi4tbW1jY2Nk5OToaGhoaGhjIyMnp6esrKysbGxsLCw
r6+vr6+vra2trKysq6urqqqqqKiop6enpqampaWlpKSkpKSkpKSko6Ojo6OjoqKioqKioqKioqKi
oqKioqKio6OjpKSkpKSkpKSkpqamp6enqKioqKioqqqqq6urra2trq6ur6+vsLCwsbGxsbGxsrKy
srKysrKys7Ozs7Ozs7Ozs7Ozs7Ozs7Ozs7Ozq6urg4ODn5+fnJychYWFqqqqrKysq6urqqqqqamp
qKiop6enpqampKSko6OjoaGhoKCgn5+fnp6enZ2dnZ2dnJycnJycm5ubm5ubm5ubm5ubm5ubm5ub
m5ubnJycnZ2dnZ2dnp6en5+fn5+foaGhoqKipKSkpaWlpqamqKioqampqqqqqqqqq6urrKysrKys
rKysra2tra2tra2tra2tra2tra2tra2tra2tkZGRlZWVlJSUj4+PpqampqampKSkpKSko6OjoqKi
oKCgn5+fnp6enZ2dm5ubmpqamZmZmJiYl5eXl5eXlpaWlZWVlZWVlZWVlZWVlJSUlJSUlZWVlZWV
lZWVlpaWl5eXl5eXmZmZmZmZm5ubnJycnZ2dnp6eoKCgoqKioqKipKSkpKSkpaWlpqampqampqam
p6enp6enp6enp6enp6enp6enp6enp6ennZ2diYmJjIyMk5OTn5+fn5+fnZ2dnZ2dnJycm5ubmpqa
mJiYl5eXlpaWlJSUk5OTkpKSkZGRkJCQkJCQj4+Pjo6Ojo6Ojo6Ojo6Ojo6Ojo6Ojo6Ojo6Ojo6O
kJCQkJCQkZGRkpKSk5OTk5OTlZWVl5eXmJiYmZmZmpqanJycnZ2dnZ2dnp6en5+fn5+fn5+foKCg
oKCgoKCgoKCgoKCgoKCgoKCgoKCgnp6egoKChoaGk5OTmJiYl5eXl5eXlpaWlpaWlpaWl5eXlpaW
lpaWlJSUk5OTkZGRkJCQm4WEzFNM6Dku6Dku3UM6umJejY2NjY2Nv15X4z406Dku10lAjo6O0U1G
6Dku2ElA6Dku0k5Hk5OT6Dku009IlpaW1FBI6DkumZmZmpqam5ubm5ubnJycnJycnJycnJycm5ub
mpqamZmZmZmZmZmZmZmZmZmZmJiYgoKCg4ODkJCQkpKSkZGRkZGRkpKSl5eXm5ubm5ubmpqamZmZ
mJiYlpaWlpaWlZWVqYF+3lJIs3hzqIF+wmlj6Eg+s3ZyvW1o6Eg+wmljqIB9wmljqIF+6Eg+zmBZ
r3156Eg+01xUlpaW6Eg+1FxVmpqa1V1V6Eg+nZ2dnZ2dnp6enp6en5+fn5+fn5+foKCgn5+fnZ2d
mJiYk5OTk5OTk5OTk5OTkpKSgoKCgoKCi4uLjIyMjIyMi4uLk5OTn5+foaGhn5+fn5+fnp6enp6e
nJycm5ubm5ubn5eWmpqampqarYiH0G1m6lhPwXh01mlh6lhPmZmZmZmZmZmZn5aV5VxU4GFZwnl1
6lhP1mlinZ2d6lhP1mljn5+f12pj6lhPoqKioqKio6Ojo6Ojo6Ojo6Ojo6OjpKSkpKSkpKSknp6e
kpKSjY2NjY2NjY2NjIyMgoKCg4ODhoaGh4eHh4eHiYmJm5ubqampqampqKiop6enp6enpqampaWl
pKSkpKSkpKSkx4eD525n62tj62tj525nq5ub1Hx362tjrJybo6OjrJybo6OjqKCgupKPyIiE62tj
2np0pqam62tj2np0qKio2np162tjqampqqqqqqqqq6urq6urq6urq6urq6urq6urq6urqampmJiY
iYmJiIiIiIiIiIiIgoKCh4eHg4ODhISEhISEjY2Nq6urtLS0s7Ozs7OzsrKysrKysbGxsLCwsLCw
sLCwu6al7X946oJ80pSQxp2as6yrr6+vu6ak6YJ86YJ83ouG7X94r6+v2o6K3ouG4oiD7X9405WR
sbGx7X946oJ83oyH7X945oaAtLS0tLS0tLS0tbW1tbW1tbW1tbW1tbW1tbW1tbW1tbW1pqamioqK
hYWFhYWFhYWFgoKCjY2NgoKChISEhISEl5eXu7u7wcHBwcHBwMDAwMDAwMDAv7+/v7+/vr6+vr6+
yLe18ZWQ4aKevr6+wLu60a6sx7a1vb29xLi41Kyp16qnzrGvvr6+yLe116qn16qn0q+tv7+/v7+/
zLWzybi3zLW02auox7u7wcHBwcHBwcHBwsLCwsLCwsLCwsLCwsLCwsLCwsLCwsLCt7e3kpKShYWF
hYWFhYWFgoKClZWVgYGBhISEhYWFnp6eyMjIzs7Ozc3Nzc3Nzc3Nzc3Nzc3NzMzMzMzMzMzMzMzM
4rm39Kun9Kun9Kun9Kun08bEzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzMzc3N
zc3Nzc3Nzc3Nzc3Nzs7Ozs7Ozs7Ozs7Ozs7Ozs7Oz8/Pz8/Pz8/Pz8/Pz8/PxMTEl5eXhYWFhYWF
g4ODioqKnp6egYGBhISEhISEmZmZzc3N2tra2tra2tra2tra2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ
2tfX4NLR4NLR2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ
2tra2tra2tra2tra2tra2tra2tra2tra2tra29vb29vb29vb29vb29vbxcXFkpKShYWFhYWFgoKC
l5eXoaGhkJCQgoKChISEkJCQysrK5ubm5ubm5ubm5ubm5ubm5eXl5eXl5eXl5eXl5eXl5eXl5eXl
5eXl5eXl5eXl5eXl5eXl5eXl5eXl5eXl5eXl5eXl5eXl5eXl5eXl5eXl5eXl5eXl5ubm5ubm5ubm
5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5ubm5OTku7u7ioqKhYWFhISEgICAoKCg
oaGhnZ2df39/g4ODhoaGtra26urq8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw
8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw
8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw8PDw39/fpKSkhYWFhISEgYGBlZWVoaGhoaGh
oaGhlJSUgICAhISEmpqa2NjY+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5
+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5
+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn57+/vwMDAjY2NhYWFgYGBkZGRoaGhoaGhoaGhoaGh
oaGhkJCQgICAhoaGqKio19fX7u7u9PT09fX19/f39/f39/f39/f39/f39/f39/f39/f39/f39/f3
9/f39/f39/f39/f39/f39/f39/f39/f39/f39/f39/f39/f39/f39/f39/f39/f39/f39/f39/f3
9/f39/f39/f39/f39/f39/f37+/v3t7evLy8lJSUg4ODgYGBkJCQoaGhoaGhoaGhoaGhoaGhoaGh
oaGhlpaWf39/gYGBkJCQpKSkra2tr6+vs7OztLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0
tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0tbW1tbW1
tbW1tbW1tbW1tbW1s7Ozp6enlJSUhYWFgYGBgICAmZmZoaGhoaGhoaGhoaGh';
  }
  elsif ($opt == 11) {
$imagedata =
'Qk2mDgAAAAAAADYAAAAoAAAAOAAAABYAAAABABgAAAAAAHAOAAAmDgAAJg4AAAAAAAAAAAAAoaGh
oaGhoKCgoKCgoKCgnJyckJCQiIiIh4eHh4eHhYWFhYWFhYWFhISEhISEhISEg4ODg4ODg4ODg4OD
goKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCg4ODg4ODg4ODhISEhISEhISEhYWFhYWFhoaG
hoaGh4eHh4eHh4eHh4eHh4eHiIiIiIiIiIiIjIyMlJSUnp6eoaGhoaGhoaGhoaGhoaGhoaGhoaGh
oKCgoKCgkpKSj4+Purq61NTU29vb2dnZ2tra2dnZ2NjY19fX1tbW1dXV1dXV1dXV1dXV1NTU1NTU
1NTU1NTU09PT09PT09PT09PT09PT1NTU1NTU1NTU1dXV1dXV1tbW1tbW2NjY2dnZ2tra29vb3Nzc
3Nzc3d3d3d3d3t7e3t7e39/f39/f39/f0dHRsrKyioqKlJSUoaGhoaGhoaGhoaGhoaGhoaGhoKCg
jo6OoqKi6enp/Pz8+/v7+vr6+fn5+Pj49/f39fX19PT08/Pz8vLy8vLy8fHx8fHx8PDw8PDw7+/v
7+/v7+/v7+/v7+/v7+/v7+/v7+/v8PDw8PDw8fHx8vLy8/Pz9PT09fX19/f3+Pj4+fn5+vr6+/v7
/Pz8/f39/v7+/v7+/v7+////////////////5ubmoaGhjo6OoaGhoaGhoaGhoaGhoKCgkZGRoKCg
+fn5/Pz8+/v7+vr6+fn5+Pj49/f39fX19PT08vLy8fHx8PDw7+/v7+/v7+/v7u7u7e3t7e3t7Ozs
7Ozs7Ozs7Ozs7Ozs7Ozs7e3t7u7u7u7u7+/v8PDw8fHx8vLy9PT09fX19/f3+Pj4+vr6+/v7/Pz8
/f39/f39/v7+/v7+/////////////////////Pz8qqqqj4+PoaGhoaGhoaGhmZmZi4uL5+fn9/f3
9vb29fX18/Pz8vLy8fHx7+/v7e3t7Ozs6+vr6urq6Ojo5+fn5ubm5ubm5eXl5eXl5OTk5OTk5OTk
5OTk5OTk5OTk5OTk5OTk5eXl5eXl5ubm6Ojo6enp6urq7Ozs7u7u8PDw8vLy8/Pz9PT09fX19vb2
9/f3+Pj4+Pj4+fn5+fn5+fn5+fn5+fn5+fn58/PznJyck5OToaGhoaGhjIyMxcXF7+/v7u7u7e3t
7Ozs6+vr6enp6Ojo5+fn5eXl4+Pj4uLi4eHh39/f3t7e3d3d3d3d3Nzc29vb29vb29vb2tra2tra
2tra2tra2tra29vb3Nzc3Nzc3d3d3t7e4ODg4uLi5OTk5ubm5+fn6enp6urq7Ozs7e3t7u7u7+/v
8PDw8PDw8fHx8fHx8fHx8fHx8fHx8fHx8fHx4ODgh4eHn5+fnJycjo6O4uLi5eXl5OTk4+Pj4uLi
4eHh39/f3d3d3Nzc2tra2dnZ19fX1dXV1NTU09PT0tLS0tLS0dHR0NDQ0NDQz8/Pz8/Pz8/Pz8/P
z8/Pz8/P0NDQ0NDQ0dHR0tLS09PT1dXV19fX2dnZ2tra3Nzc3t7e4eHh4uLi4uLi5OTk5eXl5ubm
5ubm5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fnp6enlZWVlJSUpKSk29vb2tra2dnZ2NjY19fX1tbW
09PT09PT0dHRz8/Pzc3NzMzMysrKycnJx8fHx8fHxsbGxsbGxcXFxcXFxMTExMTEw8PDw8PDxMTE
xMTExcXFxsbGxsbGxsbGyMjIysrKzMzMzc3Nz8/P0tLS09PT1dXV19fX2NjY2dnZ2tra29vb29vb
3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3Nzc3NzcxMTEiYmJjIyMsrKyzs7Ozs7Ozs7OzMzMy8vLycnJyMjI
xsbGxcXFw8PDwcHBwMDAvr6+vb29vLy8vLy8u7u7urq6ubm5ubm5uLi4uLi4uLi4uLi4uLi4uLi4
ubm5urq6u7u7vLy8vb29vr6+wMDAwsLCxMTExcXFx8fHycnJy8vLzMzMzc3Nzs7Ozs7Oz8/P0NDQ
0NDQ0NDQ0NDQ0NDQ0NDQ0NDQ0NDQy8vLgoKChoaGt7e3wsLCwsLCwcHBwMDAv7+/v7+/vr6+vb29
vLy8u7u7ubm5uLi4tra2tbW1ua2t221m7kk/8kI46lBH2mxlsbGx0Xp18kI4wZaTsbGxsbGx4l5W
8kI45ldO8kI4419Xtra2419Y8kI47kpA8kI43HlzwMDAwcHBwsLCw8PDxMTExMTExcXFxsbGxcXF
xcXFxMTExMTExMTExMTExMTEwMDAgoKCg4ODs7OzuLi4uLi4t7e3tra2urq6u7u7u7u7urq6ubm5
t7e3tra2tLS0tLS0s7Oz4Glh8FBG2HVuwZiW5GNa8FBGsLCw0IF78FBGwJiWsLCwwJiW8FBG3G9n
xZOP8FBG4GlhtLS04Wpi8FBGxp2b33Jq8FBGyaGevr6+vr6+v7+/wcHBwcHBwcHBwsLCwsLCwMDA
vLy8ubm5ubm5ubm5ubm5tra2goKCgoKCq6urrq6urq6ura2tsrKyurq6u7u7u7u7ubm5uLi4t7e3
tra2tbW1tLS0u6mo8F5V4XRts7Ozwp2b5G5n8F5VsbGx0IiE8F5VwZyasbGxtaur7GRb6Glh0YiE
8F5V4XRttLS04nRt8F5Vt7e3xqKg8F5V1o2IvLy8vb29vr6+v7+/v7+/v7+/v7+/v7+/v7+/u7u7
srKyr6+vr6+vr6+vrKysgoKCg4ODoqKipqampqamp6entbW1vr6+vr6+vr6+vLy8vLy8u7u7urq6
urq6ubm5xqak8HBo05SQt7e38HBo8HBo8HBotra205OP8HBoyKCdtra2tra2urKyyaGf05SQ8HBo
4oJ8ubm544N88HBou7u7zKSi8HBo15eTv7+/v7+/wMDAwcHBwcHBwcHBwcHBwcHBwcHBwMDAs7Oz
qKiop6enp6enpaWlgoKCh4eHmZmZoKCgoKCgp6envb29xMTExMTEw8PDw8PDwsLCwcHBwcHBwMDA
wMDAybSz8oN93pqVvr6+vr6+vr6+vr6+vr6+2KGe8oN96I6J8oN9vr6+4ZaR5ZKN6I6J8oN93J6a
wMDA5pON8oN96Y+K74eB8oN9yry7xMTExMTExcXFxsbGxsbGxsbGxsbGxsbGxsbGxsbGurq6paWl
oaGhoaGhn5+fgoKCjY2Nk5OToKCgoKCgrq6uysrKz8/Pzs7Ozs7Ozs7Ozc3Nzc3NzMzMzMzMzMzM
y8vL7KKe9JmT1b69y8vL0MTD6qWhysrK0MTD1b68zcfH1b68ysrK08HA37Kv37Kv27i2zMzMzMzM
6qai9JmT1cPC4bOx2MG/z8/Pz8/Pz8/P0NDQ0NDQ0NDQ0NDQ0NDQ0NDQ0NDQ0NDQx8fHq6uroaGh
oaGhn5+fgoKClZWVi4uLoKCgoKCgtLS01NTU2dnZ2dnZ2NjY2NjY2NjY19fX19fX19fX19fX1tbW
3M/O8LWy9q6p9q6p9q6p8rOv1tbW1tbW1tbW1tbW1tbW1tbW1tbW1tbW1tbW1tbW19fX19fX7ri1
9q6p2NjY2NjY2NjY2dnZ2dnZ2dnZ2dnZ2dnZ2dnZ2tra2tra2tra2tra2tra0dHRr6+voaGhoaGh
l5eXioqKnp6eg4ODnp6eoKCgsLCw2NjY4uLi4uLi4uLi4uLi4uLi4eHh4eHh4eHh4eHh4eHh4eHh
4eHh5dva59nY5dva4ODg4ODg4ODg4ODg4ODg4ODg4ODg4eHh4eHh4eHh4eHh4eHh4eHh5tvb59nZ
4uLi4uLi4uLi4uLi4uLi4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj0tLSq6uroaGhoaGhioqK
l5eXoaGhkJCQkJCQoKCgqamp1tbW6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6urq
6urq6urq6urq6urq6urq6urq6urq6urq6urq6urq6urq6urq6+vr6+vr6+vr6+vr6+vr6+vr6+vr
6+vr6+vr6+vr6+vr7Ozs7Ozs7Ozs7Ozs7Ozs7Ozs7Ozs7Ozs6+vry8vLpaWloaGhmZmZgYGBoKCg
oaGhnZ2dgYGBmZmZoqKixsbG7u7u8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz
8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz
8/Pz8/Pz8/Pz8/Pz8/Pz8/Pz9PT09PT09PT09PT09PT05+fnubm5oaGhnZ2dhYWFlZWVoaGhoaGh
oaGhlJSUhYWFnZ2dsbGx4eHh+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6
+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6
+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr6+vr68/Pzzs7Op6ennp6eiIiIkZGRoaGhoaGhoaGhoaGh
oaGhkZGRhISEmpqavLy84ODg8vLy9/f39/f3+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5
+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5+fn5
+fn5+fn5+fn5+fn5+fn5+fn58/Pz5eXly8vLrKyslpaWhYWFkJCQoaGhoaGhoaGhoaGhoaGhoaGh
oaGhl5eXgYGBjIyMoaGhsrKyurq6vb29wMDAwcHBwcHBwcHBwMDAwMDAwMDAwMDAwMDAwMDAwMDA
wMDAwMDAwMDAwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHBwcHB
wcHBwcHBwcHBwcHBwMDAtra2pqamlpaWioqKgICAmZmZoaGhoaGhoaGhoaGh';
  }
  elsif ($opt == 111) {
$imagedata =
'Qk2mDgAAAAAAADYAAAAoAAAAOAAAABYAAAABABgAAAAAAHAOAAAmDgAAJg4AAAAAAAAAAAAAoaGh
oaGhoKCgoKCgoKCgnJyckJCQiIiIh4eHh4eHhYWFhYWFhYWFhISEhISEhISEg4ODg4ODg4ODg4OD
goKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCgoKCg4ODg4ODg4ODhISEhISEhISEhYWFhYWFhoaG
hoaGh4eHh4eHh4eHh4eHh4eHiIiIiIiIiIiIjIyMlJSUnp6eoaGhoaGhoaGhoaGhoaGhoaGhoaGh
oKCgoKCgkpKSioqKp6enurq6vb29vLy8vLy8vLy8u7u7urq6ubm5ubm5ubm5uLi4uLi4t7e3t7e3
t7e3t7e3tra2tra2tra2tra2tra2t7e3t7e3t7e3uLi4ubm5ubm5ubm5u7u7vLy8vLy8vb29vr6+
v7+/v7+/v7+/wMDAwMDAwcHBwcHBwcHBuLi4oqKih4eHlJSUoaGhoaGhoaGhoaGhoaGhoaGhoKCg
jo6Ol5eXyMjI1NTU1NTU09PT0tLS0dHR0NDQz8/Pzs7Ozc3NzMzMzMzMy8vLy8vLysrKysrKysrK
ysrKysrKysrKysrKysrKysrKysrKysrKysrKy8vLzMzMzc3Nzs7Oz8/P0NDQ0dHR0tLS09PT1NTU
1NTU1dXV1tbW1tbW1tbW19fX19fX19fX19fXxsbGl5eXjo6OoaGhoaGhoaGhoaGhoKCgkZGRlpaW
0tLS1NTU1NTU09PT0tLS0dHR0NDQz8/Pzs7OzMzMy8vLysrKysrKysrKysrKycnJyMjIyMjIx8fH
x8fHx8fHx8fHx8fHx8fHyMjIycnJycnJysrKysrKy8vLzMzMzs7Oz8/P0NDQ0dHR09PT1NTU1NTU
1dXV1dXV1tbW1tbW19fX19fX19fX19fX19fX1dXVnZ2dj4+PoaGhoaGhoaGhmZmZh4eHxcXFz8/P
z8/Pzs7OzMzMy8vLysrKycnJx8fHxsbGxsbGxcXFw8PDwsLCwcHBwcHBwcHBwcHBwMDAwMDAwMDA
v7+/v7+/v7+/wMDAwMDAwcHBwcHBwcHBw8PDxMTExcXFxsbGyMjIysrKy8vLzMzMzc3Nzs7Oz8/P
z8/P0NDQ0NDQ0dHR0dHR0dHR0dHR0dHR0dHRzc3Nk5OTk5OToaGhoaGhjIyMrKysx8fHx8fHxsbG
xcXFxMTEw8PDwcHBwMDAv7+/vb29vLy8vLy8urq6ubm5uLi4uLi4uLi4t7e3t7e3t7e3tra2tra2
tra2tra2tra2t7e3uLi4uLi4uLi4ubm5u7u7vLy8vr6+wMDAwMDAw8PDw8PDxcXFxsbGx8fHx8fH
yMjIyMjIycnJycnJycnJycnJycnJycnJycnJvr6+hISEn5+fnJyciIiIvLy8vr6+vb29vLy8u7u7
urq6uLi4t7e3tra2tbW1s7OzsrKysLCwr6+vr6+vrq6urq6ura2trKysrKysrKysrKysq6urq6ur
rKysrKysrKysrKysra2trq6ur6+vsLCwsrKys7OztbW1tra2uLi4urq6u7u7u7u7vb29vr6+vr6+
vr6+v7+/v7+/v7+/v7+/v7+/v7+/v7+/v7+/mJiYlZWVlJSUlJSUs7Ozs7OzsrKysLCwsLCwr6+v
ra2trKysq6urqampqKiop6enpaWlpKSko6Ojo6OjoqKioqKioaGhoaGhoKCgoKCgoKCgoKCgoKCg
oKCgoaGhoqKioqKioqKipKSkpaWlp6enqKioqamprKysra2trq6usLCwsLCwsbGxs7Ozs7Ozs7Oz
tLS0tLS0tLS0tLS0tLS0tLS0tLS0tLS0pqamiYmJjIyMmZmZp6enp6enpqampaWlpKSko6OjoaGh
oKCgn5+fnZ2dnJycm5ubmpqamZmZmJiYmJiYl5eXlpaWlpaWlpaWlZWVlZWVlZWVlZWVlZWVlZWV
lpaWlpaWl5eXmJiYmZmZmpqam5ubnZ2dnp6en5+foaGho6OjpKSkpaWlpaWlpqamp6enp6enqKio
qKioqKioqKioqKioqKioqKioqKiopqamgoKChoaGlpaWm5ubm5ubmpqamZmZmZmZmZmZmZmZmZmZ
mJiYl5eXlpaWlZWVlJSUk5OTmIyLx1tT4z806Dou3UQ6xlpSkJCQu2Rf6DoupXp3j4+Pj4+P0k9H
6Dou2EpA6Dou009HlJSU01BI6Dou4z816DouxWNdm5ubnJycnZ2dnp6enp6en5+fn5+fn5+fnp6e
nZ2dnJycnJycnJycnJycnJycmpqagoKCg4ODjo6OkJCQkJCQj4+PkJCQlpaWmZmZmZmZmJiYl5eX
lpaWlpaWlZWVlJSUk5OT0lpT6Ec+yGRdp39811VO6Ec+kJCQvGxn6Ec+pn57kJCQpn576Ec+zV5Y
rXp46Ec+01tTlJSU01tU6Ec+q4KBz2Fa6Ec+rYWDnJycnJycnZ2dnZ2dnZ2dnZ2dnp6enZ2dm5ub
lpaWkZGRkZGRkZGRkZGRkJCQgoKCgoKChoaGhoaGhoaGhYWFjY2NmpqanJycm5ubm5ubmpqamZmZ
mJiYmJiYl5eXoY+N6FdN02dglZWVqoWD2GNb6FdNlJSUvnZx6FdNqYWDlJSUmpCQ4ltS3l9Wv3Zx
6FdN02dgl5eX1Gdg6FdNmpqaroqI6FdNwnp1nZ2dnZ2dnp6en5+fn5+fn5+fn5+fn5+fn5+fmZmZ
jIyMh4eHh4eHh4eHh4eHgoKCg4ODf39/f39/fn5+gYGBlZWVo6Ojo6OjoqKioqKioaGhoKCgoKCg
oKCgn5+fsZGP6Wlhw4N/nZ2d6Wlh6Wlh6WlhnZ2dw4N/6WlhtY2KnZ2dnZ2dopqatY2Kw4N/6Wlh
1ndxn5+f13dx6WlhoaGhuJCN6WlhxoaCpKSkpKSkpKSkpKSkpaWlpaWlpaWlpaWlpaWlo6OjkJCQ
gICAf39/f39/f39/goKCh4eHenp6eXl5eHh4g4ODo6Ojra2trKysrKysq6urq6urqqqqqqqqqamp
qamptaCf7H130o2JqampqampqKioqKioqKioypOP7H1334WA7H13qKio14qG24iD34aA7H13z5CN
qamp24mD7H134IaA54B67H13tKamra2tra2tra2tra2trq6urq6urq6urq6urq6urq6unZ2df39/
eXl5eXl5eXl5goKCjY2NfHx8eXl5eHh4jo6OtLS0u7u7u7u7u7u7urq6urq6urq6ubm5ubm5ubm5
uLi45ZuW75SOxq+uuLi4v7Oz4Z2ZuLi4v7Ozxq+tu7W1xq+tuLi4wrGw1Kaj1Kajzauoubm5ubm5
4p2Z75SOxLOy1aekyLGwu7u7u7u7vLy8vLy8vLy8vLy8vLy8vLy8vLy8vLy8vLy8sLCwh4eHeXl5
eXl5eXl5goKClZWVfX19eXl5eXl5lZWVxMTEycnJycnJycnJycnJyMjIyMjIyMjIyMjIyMjIx8fH
z8LB6q+s8qql8qql8qql7a2qx8fHx8fHx8fHx8fHx8fHx8fHx8fHx8fHx8fHx8fHyMjIyMjI6LGu
8qqlyMjIycnJycnJycnJycnJysrKysrKysrKysrKysrKysrKysrKysrKysrKvr6+jY2NeXl5eXl5
e3t7ioqKnp6ef39/eXl5eXl5j4+PycnJ19fX1tbW1tbW1tbW1tbW1tbW1tbW1tbW1tbW1dXV1dXV
1dXV29HR3dDP29HR1dXV1dXV1dXV1dXV1dXV1dXV1dXV1dXV1dXV1dXV1dXV1tbW1tbW3NHR3tDP
1tbW1tbW1tbW1tbW19fX19fX19fX19fX19fX19fX19fX19fX19fX19fXv7+/h4eHeXl5eXl5fn5+
l5eXoaGhkJCQfHx8eXl5hYWFxMTE4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj
4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj4+Pj
4+Pj4+Pj4+Pj4+Pj4+Pj5OTk5OTk5OTk5OTk5OTk5OTk5OTk4uLitbW1fn5+eXl5e3t7gICAoKCg
oaGhnZ2df39/enp6e3t7r6+v6Ojo7+/v7+/v7u7u7u7u7u7u7u7u7u7u7u7u7u7u7u7u7u7u7u7u
7u7u7u7u7u7u7u7u7u7u7u7u7u7u7u7u7u7u7u7u