#!/usr/bin/perl

use warnings;
use Tk;

$MW = new MainWindow;
$MW->bind("<Button-3>"=>sub{scanmenus(X);$menu->Popup(-popover=>"cursor",-popanchor=>'nw')});
$MW->bind("<Button-1>"=>sub{scanmenus(Y);$menu->Popup(-popover=>"cursor",-popanchor=>'nw')});

$label=$MW->Label(-text=>"click right mouse button")->pack();
$label2=$MW->Label(-text=>"click left mouse button")->pack();

MainLoop;

sub scanmenus {
	%MM=(); $sw="@_"; print $sw;
	@choices = ("one", "two", "three");
	@levels = (1..4);
	@cascs = (1,2,3);
	$menu = $MW -> Menu(-tearoff=>0);
	foreach $level (@levels) {
		$par=int($level-1);
		if ($level==1) {
			foreach $casc (@cascs) { my $this="CM1$casc"; 
				$MM{$this} = $menu->cascade(-label=>"Level 1 Cascade $casc",-underline=>0,-tearoff=>0);}  					
			foreach $choice (@choices) { my $this="PK1$choice";
				$MM{$this} = $menu->command(-label=>"L1 $choice",-command=>[\&printchoice, "L1 C$choice"]);}
		} else {
			foreach $casc (@cascs) { my $this="CM$level$casc"; my $that="CM$par$casc";
				unless ($level==4) {$MM{$this} = $MM{$that}->cascade(-label=>"Level $level Cascade $casc",-underline=>0,-tearoff=>0);}
				foreach $choice (@choices) { my $this="PK$level$casc"; my $that="CM$par$casc";
					if ($sw eq "Y" && $choice eq "two") {
						$MM{$this} = $MM{$that}->command(-label=>"L$level $choice",-state=>'disabled');}
					else {	$MM{$this} = $MM{$that}->command(-label=>"L$level $choice",-command=>[\&printchoice, "L$level C$choice"]);}
				}
			}
		}
	}
}		

sub printchoice {
    print "@_\n";
}