#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::Zinc;

my $mw = MainWindow->new;
$mw->geometry("700x600");

my $zinc = $mw->Zinc(-width => 700, -height => 565,
                -backcolor => 'black',
        -borderwidth => 3, 
        -relief => 'sunken',
           )->pack;

my $closebutton = $mw->Button(-text => 'Exit', -command => sub{Tk::exi
+t(0)})
               ->pack; 

$zinc->fontCreate(
    "fonta",
    -family => 'arial',
    -size   => -30,
    -weight => 'normal'
);

my $menugroup = $zinc->add('group',1, 
                         -visible=>1,
             -sensitive =>1,
             -tags => ['menu'],
             );

#move off screen leaving a slight visible bar
$zinc->translate($menugroup,-25 ,0 );

my $menubox = $zinc->add('rectangle',$menugroup,
                  [[0, 0], [35,700] ],
                 -filled => 1,
                 -fillcolor => 'orange',
                 -linewidth => 2,
                 -linecolor => '#000000',
                 -priority => 1,
                 -tags => ['menu'],
                  );

my %menuitems;
my $y = 5;

for my $item ('a'.. 'm'){
     
  $menuitems{$item}{'item'} = $zinc->add( 'text', $menugroup,
        -position => [ 5, $y ],
        -text     => $item,
        -font     => 'fonta',
        -tags => ['menuitem','menu',$item]
  );
  
  $menuitems{$item}{'location'} = $y;
  $y += 40;  
  $zinc->bind('menuitem', '<1>', sub {&Selected()});
  }


 $zinc->bind( 'menu', '<Enter>', sub {&Slide_open()});
 $zinc->bind( 'menu', '<Leave>', sub {&Slide_close()});


MainLoop;

sub Slide_open{
     my $count = 0;
     my $repeater;
     $repeater = $mw->repeat(10, sub{
              $zinc->translate($menugroup, 1 ,0 );
          $count++;
             if($count >= 25){ $repeater->cancel }       
      } );
   }


sub Slide_close{
      my $count = 0;
     my $repeater;
     $repeater = $mw->repeat(10, sub{
              $zinc->translate($menugroup, -1 ,0 );
          $count++;
             if($count >= 25){ $repeater->cancel }       
      } );
}

sub Selected {
    my $curr_object = $zinc->find('withtag','current');

    my @list =();
    my $item;

    if(defined $curr_object){
      # print "curr->",@$curr_object,"\n";  #array dereference  
       (@list) = $zinc->gettags($curr_object);
       ($item) = grep /\b\w{1}\b/g, @list; 
       print "item->$item\n";
     } else {return}    

}
[download]