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

my $width = 300;
my $height = 150;
my $xpos = -10;
my $ypos = -10;

my $mw = MainWindow->new(-background => 'black',
                         -cursor => "top_left_arrow");
$mw->geometry($width.'x'.$height.$xpos.$ypos);
$mw->overrideredirect(1);

my ($background,$imageon,$imageoff) = get_chrome();

my $zinc = $mw->Zinc(-width => $width,
                     -height => $height,
                     -reshape => 1,     #clips zinc 
                     -fullreshape => 1,  #clips $mw and xterm 
                     -backcolor => 'black',
                       )->pack;

my $ufo = $zinc->add('curve',1,[[$width/2,0],
                                          [2*$width,0, 'c'],
                                          [2*$width,$height, 'c'],
                                  [$width/2,$height],
                                          [-$width,$height, 'c'],
                                          [-$width,0, 'c'],
                                   [$width/2,0]],
                   -tags => ['bezier1'],
                   -closed => 1,
                   -visible => 1,
		   -filled => 1, 
		   -fillcolor => 'black',
                   -priority => 1,     
		   );


my $ufo1 = $zinc->clone($ufo);
$zinc->itemconfigure($ufo1, -tile => $background,
                           -linecolor => 'black',
                           -linewidth => 3,    
			   -priority => 2,
			   );

my $bgroup = $zinc->add('group', 1 , -visible => 1);

#######################################################
my $toggle0 = -1;
my $hole0 = $zinc->add('arc',$bgroup, [10,35,50,75], 
		            -visible => 0 );
			                      
my $holeid0 = $zinc->contour($ufo1, 'add',1, $hole0);  # will produce a see-thru because $arc3b

my $imageid0 = $zinc->add('icon',$bgroup, -image => $imageoff, 
                                   -position => [10,35],
				   -priority => 1,
				   -tags => 'button',    
				   );

$zinc->bind($imageid0,"<Button 1>", [\&sub0] );

############################################################
my $toggle1 = -1;
my $hole1 = $zinc->add('arc',$bgroup, [50,15,90,55], 
		            -visible => 0);
			                      
my $holeid1 = $zinc->contour($ufo1, 'add',1, $hole1);  
# will produce a see-thru because $arc3b
my $imageid1 = $zinc->add('icon',$bgroup, -image => $imageoff, 
                                   -position => [50,15],
				   -priority => 1,
				   -tags => 'button',    
				   );

$zinc->bind($imageid1,"<Button 1>", [\&sub1] );
###############################################################
my $toggle2 = -1;
my $hole2 = $zinc->add('arc',$bgroup, [98,5,138,45], 
		            -visible => 0,
			    );
		                      
my $holeid2 = $zinc->contour($ufo1, 'add',1, $hole2);  
# will produce a see-thru because $arc3b
my $imageid2 = $zinc->add('icon',$bgroup, -image => $imageoff, 
                                   -position => [98,5],
				   -priority => 1,
				   -tags => 'button',    
				   );

$zinc->bind($imageid2,"<Button 1>", [\&sub2] );
###############################################################
my $toggle3 = -1;
my $hole3 = $zinc->add('arc',$bgroup, [152,5,192,45], 
		            -visible => 0,
			    );
			                      
my $holeid3 = $zinc->contour($ufo1, 'add',1, $hole3);  # will produce a see-thru because $arc3b

my $imageid3 = $zinc->add('icon',$bgroup, -image => $imageoff, 
                                   -position => [152,5],
				   -priority => 1,
				   -tags => 'button',    
				   );

$zinc->bind($imageid3,"<Button 1>", [\&sub3] );
###############################################################
my $toggle4 = -1;
my $hole4 = $zinc->add('arc',$bgroup, [200,15,240,55], 
		            -visible => 0);
			                      
my $holeid4 = $zinc->contour($ufo1, 'add',1, $hole4);  # will produce a see-thru because $arc3b

my $imageid4 = $zinc->add('icon',$bgroup, -image => $imageoff, 
                                   -position => [200,15],
				   -priority => 1,
				   -tags => 'button',    
				   );
$zinc->bind($imageid4,"<Button 1>", [\&sub4] );
###############################################################
my $toggle5 = -1;
my $hole5 = $zinc->add('arc',$bgroup, [245,35,285,75], 
		            -visible => 0);

my $holeid5 = $zinc->contour($ufo1, 'add',1, $hole5);  # will produce a see-thru because $arc3b

my $imageid5 = $zinc->add('icon',$bgroup, -image => $imageoff, 
                                   -position => [245,35],
				   -priority => 1,
				   -tags => 'button',    
				   );

$zinc->bind($imageid5,"<Button 1>", [\&sub5] );
###############################################################

$zinc->bind('button',"<Enter>", sub{
                                 $zinc->configure(-cursor => 'hand2');
                                   });

$zinc->bind('button',"<Leave>", sub{
                                $zinc->configure(-cursor => 'top_left_arrow');
                                    });

$mw->bind("<Button 3>",sub{Tk::exit});

# using the curve to reshape both TkZinc and Mainwindow widgets  
$zinc->itemconfigure(1, -clip => $ufo);

MainLoop;


sub sub0{
if ($toggle0 == -1){$zinc->itemconfigure($imageid0,-image => $imageon)}
if ($toggle0 == 1){$zinc->itemconfigure($imageid0,-image => $imageoff)}
$toggle0 *= -1;
print "\007";
}

sub sub1{
if ($toggle1 == -1){$zinc->itemconfigure($imageid1,-image => $imageon)}
if ($toggle1 == 1){$zinc->itemconfigure($imageid1,-image => $imageoff)}
$toggle1 *= -1;
print "\007";
}

sub sub2{
if ($toggle2 == -1){$zinc->itemconfigure($imageid2,-image => $imageon)}
if ($toggle2 == 1){$zinc->itemconfigure($imageid2,-image => $imageoff)}
$toggle2 *= -1;
print "\007";
}

sub sub3{
if ($toggle3 == -1){$zinc->itemconfigure($imageid3,-image => $imageon)}
if ($toggle3 == 1){$zinc->itemconfigure($imageid3,-image => $imageoff)}
$toggle3 *= -1;
print "\007";
}

sub sub4{
if ($toggle4 == -1){$zinc->itemconfigure($imageid4,-image => $imageon)}
if ($toggle4 == 1){$zinc->itemconfigure($imageid4,-image => $imageoff)}
$toggle4 *= -1;
print "\007";
}

sub sub5{
if ($toggle5 == -1){$zinc->itemconfigure($imageid5,-image => $imageon)}
if ($toggle5 == 1){$zinc->itemconfigure($imageid5,-image => $imageoff)}
$toggle5 *= -1;
print "\007";
}

###########################################################################
sub get_chrome{

my $backphoto =
'R0lGODdhYQBSAPEAAAAAAP///7+/vwAAACwAAAAAYQBSAAAC/oRkiarrbJAEbS462ZHZRgxmAWR1
JRVxiZaG1betqnxiB2x/uDbffQNB+VYuXQwXc9ROHpWSc1ESbyxW0vns1WimIOoLDovH4QtZbD6r
z5u2bxNop9z0Oj1uv+brc7cB/xaYA8XUhWc0xyUA2HdkZxWYlAMz9PVGEpUwQoUkBCIz+ACU8WlJ
xfkg5wjpAbB5anMJ5Zp5SWnkJ/ikE4pp1bLTBLLZ2dE5VQQZ22IrSYo1yhM0tMRDPSu6Su0bqczM
Nbqd8hq9tDuJZOxpSpKeys3UbiwR5zmzho5/+iPr0lVpCx8YQnsKHrHEDli8TALzNFL1KFSTPUTW
pLGXKxeS/lfO8q0DCC6jw2cGITqRxgskIDnS1F18VPLKNC3yWFYDdc3Vi4z2Ekl51nKiuWVZbtGK
F0yIpE9YCs2cFwwkP3k4mf0I16rVrXc/J1KKclFgsZ0/g7YsR/UYmpgHB9EAdUwcrF2yhJWhuC+v
n56LvvXrCNFtWFMRl6J6pygNVJdFYLGBqSrkyXC4GrHrStcLYT19/vyKqxRRZpkfHZMaWBAIRrvO
pPoFvbcUwruRK+HKGy1u2cY5H55eTQfTyVVbRYvl5o5o8OBjt819oXkzRYQu+WWd99d6Olq0+fhm
Wbx39qOCd5YXRfg12IHgomaFC7Rjsd9K9zrHqdHoW4Cz/r4KzlyRRHLdp1BpgqDlFoLNBPhdc1s5
ddB42w1Rj3r1hKXHcARONtow2uC3wiGMSdHdX/up5kGFnKB4YX+HlecTeiZVJdQOvBzXGlMRqveb
d86x1sQIJTpURV8CfgRXaM5wRONtpxF5zTmI+EVfCDyRZNYWwAn3VISjZYGXP/4dqE5nvY2VXC1P
KeRYbjaiV19bdYlZVH/qNQdNa9Cs5eJzU4iH2DJFDkiifDc2qEsvczpAjgnDYdDifi++x9d7DJ1Z
pkxf/gkffzbGOV5T5u0zITrNlIDNdrJZ9Us2Ov0zGGocLnIPVzpqBaaYyTnIJ3gJanPYnitKV5kw
FzD5/ttKDwHDaZQMkgETjQupyOBySdl3J6g2QYaSpUnV59N//pAK5FEm4XohcpNRx5M1CAjpoFeJ
GFgOUo/KGpmVb72Kp77ngCeOkIatI11grqHqqDvr+TuJvKreGiNi5CaJKjyKUVshlVWx225FiZoD
0rV2fixutVdaUyzExv4bWgVtzQTvkKhQdbBXtlZc55+HWDRSyhxSRuJsqFVKJ1s+2lpkbldhiG1j
utWy6J/3algvGmYu97KJiYILm2rxMoVvbdfF1i25UeM21LC9GtykUHJKaqp8j5rxEmQD91VWh51d
VuBzjsSKNR+LcbV1jb6CnTO0yykL+KxSpSLXV8yJy9WitTqFDeyU3cI9tZVGcza2pmIKHKeTNnd1
m2XLRkHM0kSjTmBKKOoKeYBBO23p2ZJVmnhgZAl4DeNoTbwy2MUJPVuNpXaKuHKLMRyoRVVA27Ci
CM9Xrtpi2V3SGAvRLDuO3IdpFZh1ZNyQGiOJ9CCuyrh66fltrCSi/KlpKuxCNUQqKvxzCX4upylJ
Yv6CX9v2hbdvnKg0prLe3PJHFFWJ7kN5Kl/CDKOVfj1PWkrTEQJpIjEssYBaG+Ic7MalCblRMIWt
8tLwElAAADs=';

my $offphoto =
'/9j/4AAQSkZJRgABAQEASABIAAD/2wBDAAgGBgcGBQgHBwcJCQgKDBQNDAsLDBkSEw8UHRofHh0a
HBwgJC4nICIsIxwcKDcpLDAxNDQ0Hyc5PTgyPC4zNDL/2wBDAQkJCQwLDBgNDRgyIRwhMjIyMjIy
MjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjL/wAARCAAuAC4DASIA
AhEBAxEB/8QAGgAAAgMBAQAAAAAAAAAAAAAAAwYFBwgCBP/EADMQAAEDAwEFBwEIAwAAAAAAAAEC
AwQABREGByExQVESExQiYXGBIxUWJDNDU5GxksHR/8QAFwEAAwEAAAAAAAAAAAAAAAAABAUGA//E
ACMRAAICAgEEAgMAAAAAAAAAAAECAAMEERIFBiExE0EiYcH/2gAMAwEAAhEDEQA/AL6kSGYsdyRI
dQ0y2kqWtZwEgcSTVQan2vyFKU1YuxEjE4RLea7x171baO4D1Vx38xihbYtVrXO+7rCj4eOlLspA
/VcVvbbPPGPMetI1st2MyZJ7ySvepSuXoOgrG64VDZjDp3TrM6zivgD2Z1L1NqaevvftC+lWc9rx
3dA9fIkAJosPaBqyyuBQuk4pHFE1QkoV7kjI+N9e8IGOFAkRkOoIUkHIoQZrb8iUb9s0FdI53+9a
lr6H2mwNVqTBlITCuuCQ12soeA5oP+uPvT3WQ5TLtsmtvR3FNKSsKQtJwW1g5BB5VpTQOqRqzS7E
1zAmN/RlJAx9QcT87j80cjh15CSeTjvjWmqz2JQGp5Cpuvbotw7jcnx8IPZT/AFTTP5YqO2h29dk
2g3NJSQhb/i0HGMpc3nHscj4osKWh1pOFDP90DmA8gZVds2J8Tp97/kaoL1sRaXUPNgyMbiR/VQi
sYOK57YoTzyUJyTgdKELblGlXAlt+5B38Atq6jBp12M3VcCddo6iS2ttt3GM+Y8aQbi4ubIRGaOV
uKwKedlMBcuddH2N7WAhJ3jyp4cuhpliAhPMh+v2K+V+P0I87VdFuaitjVygI7VxhAgI/dbPFP8A
z3PWqDZekRVqQhC8oJ7bRBC0e4rYBAIwRkGq+1nsztd8UqfH/CSxvK292T1ohkDjRimjIsofnWdG
UYm+YTxIxyzihGfInOd1FaW4sjgkZwOvoPWmC56QudtkKaNwjv8AYyMvMhZ5nioHpRLdo243gIbf
uafDqIV3ScpT/iBisBioDuNH67lOvGLcaIt57wcQiRNe8jjqN6GknilJ5k8CeGNwznNaN2f6ZRpy
wIbI+q4AVE4zivLpHZ5bdPNoeKUvOkcSMjNO1EAa8CJmYseTHzP/2Q==';

my $onphoto =
'/9j/4AAQSkZJRgABAQEASABIAAD/2wBDAAgGBgcGBQgHBwcJCQgKDBQNDAsLDBkSEw8UHRofHh0a
HBwgJC4nICIsIxwcKDcpLDAxNDQ0Hyc5PTgyPC4zNDL/2wBDAQkJCQwLDBgNDRgyIRwhMjIyMjIy
MjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjL/wAARCAAuAC4DASIA
AhEBAxEB/8QAHAAAAQQDAQAAAAAAAAAAAAAABwMEBggAAQUC/8QANBAAAQIEAwUGBQQDAAAAAAAA
AQIDAAQFEQYSIQdBUWFxExQiMVKBFiMyM6FCYpHBcrHw/8QAFwEBAQEBAAAAAAAAAAAAAAAABAYF
A//EACURAAEEAQQBBAMAAAAAAAAAAAEAAgMEEQYSIcExEyIycZHR8P/aAAwDAQACEQMRAD8APxIS
CSbAakmBpiXa5KyKnWaG0zNdmrIudmFlMuFbwkDxOH/HrqIY7XsYKlU/Dso6UJU2HZ5aSQrKT4Wg
d2bfy94HlNpCC0ioVUXVazTA0CAP0gbrcf8AZuY5yyiMZKbRoyXJNjPA8ldKa2nYunFlyWqsykX+
mWprfZ87FV1H3heR2w4np7wE46zOp/Uiblgws9CjQcNRDRyrNIVkbaaQnytkzfk3jSzLT7RbebQp
J5f9+IILpzyFvnTTS32yc/X92jPhHHdJxewoSylS862PmyjxGdI4j1J5j8RKIqa6icw1Vpedp76m
1trzMOA6pPpPEGLK4PxKzivDcrVGwlDihlfbB+24PqHTeORENY8PG4KZsV5K8hikGCFX7E766ntI
qfbXN6k6g3N7hrwpH8CHVRdVlSlN/SIa4zl10XaVUw75d9VMX/a74r/mHz7YeQFDUHUEQC5neFW6
b2mu8D5Z6GO01lpHMLkX39YXSwGl3TpxELsuKaN0qKTxBjCMxHCBqka0NTGttByjulQ1SMw6jWJh
sKnnBO1enKV8soRMpHM2B/qIjX1lqQEqBd945Anfc7olWw9q2IKw6kgthkNJUDe+VQ1jRpg7CorU
jmmw3HnHZwu1tiwe9VJVmvSDRcmZVHZPtJGrjV76cwSf56QJaVWu7spbmLrYBslzzKeSotatKVpK
VC6SLEQJMc7MJNTy6pS3+5ur1Wi10qPSESRtkGHLIp3JaknqRH9FQ1mckHU5u9ADkAf7EamK3T5H
7BLz97J3m+6yRv8AeI1O06YkHMkwzIvkeSrLTp0TYQvISM/NuBpl6XlEK3sIsq3DN9VveDCmAfK2
36kkc3AZz98fjHa8TT8y9OWVdVRd8DbSTfsAfNSj6tfLdvsbQeNmWF/h6g5nE2ef1UbWMcfAezaQ
pyUTswoPrKQrfBPSkISEpACQLACGNaGjAU7NM+Z5kkOSV//Z';

my $imageoff = $mw->Photo(-data => $offphoto);
my $imageon  = $mw->Photo(-data => $onphoto);
my $background  = $mw->Photo(-data => $backphoto);

return($background,$imageon,$imageoff);
}