view release on metacpan or  search on metacpan

lib/GFtk.pm  view on Meta::CPAN

package GFtk;
   use strict;
   use warnings;
   
   our $VERSION = '0.081';
   
   use parent qw(Tk::MainWindow);
   
   use Tk::JPEG;
   use Tk::BrowseEntry;
   use Image::Magick;
   use MIME::Base64;
   
   use Exporter 'import';   
   our @EXPORT_OK      = qw<addWidget addVar setScale $frame $winScale $winWidth $winHeight $winTitle>;
   our $frame;
   
   our $winX=30;
   our $winY=30;
   our $winWidth;
   our $winHeight;
   our $winTitle;
   our $winScale=6.5; 
 
   # these arrays will contain the widgets each as an arrayref of the parameters
   my @widgets=();
   my %iVars=();     #vars for interface operation (e.g. 
   my %oVars=();      #vars for interface creation (e.g. list of options)
   my %styles;
   
   my $lastMenuLabel;  #bug workaround in menu generator may be needed for submenus
   
   sub new
   {
    my $class = shift;    
    my $self = $class->SUPER::new(@_);  # call the superclass' constructor
    $self -> title($winTitle);
    $self -> geometry($winWidth."x".$winHeight);
      $frame = $self->Canvas(
         -bg => 'lavender',
         -relief => 'sunken',
         -width => $winWidth,
         -height => $winHeight)->pack(-expand => 1, -fill => 'both');
      
      $frame ->fontCreate('medium',
             -family=>'arial',
             -weight=>'normal',
             -size=>int(-18*18/14));
      setupContent($self,$frame);  #then add content
      return $self;
   };

# setupContent  sets up the initial content before Mainloop can be run.
   sub setupContent{
	   my ($self, $canvas)=@_;
	   $self ->{"menubar"}=undef;
	   my $currentMenu;
	   foreach my $widget (@widgets){
		   my @params=@$widget;
		   my $wtype=shift @params;
		   if ($wtype eq "btn")             {aBt($self, $canvas, @params);}
		   elsif ($wtype eq "textctrl")     {aTC($self, $canvas, @params);}
		   elsif ($wtype eq "stattext")     {aST($self, $canvas, @params);}
		   elsif ($wtype eq "sp")           {aSP($self, $canvas, @params);}
		   elsif ($wtype eq "combo")        {aCB($self, $canvas, @params);}
		   elsif ($wtype eq "sp")           {aSP($self, $canvas, @params);}
		   elsif ($wtype eq "mb")
		                   {
							   if (! $self->{"menubar"}){
							       $self->configure(-menu => $self ->{"menubar"} = $self->Menu);
		                          }
	                          $currentMenu=aMB($self,$canvas,$currentMenu,@params)
	       }
	   }

	   sub aBt{
	    my ($self,$canvas, $id, $label, $location, $size, $action)=@_;
	    $canvas->{"btn$id"}=$canvas->Button(-text => $label,
	                         -width  => ${$size}[0]/6.68-4,
	                         -height => ${$size}[1]/16,
	                         -pady   => 1,
	                         -command => $action);
	    $canvas->createWindow(${$location}[0] ,${$location}[1],
	                         -anchor => "nw",
	                         -window => $canvas->{"btn$id"});
        }
       sub aTC{
		my ($self,$canvas, $id, $text, $location, $size, $action)=@_;
		$canvas->{"textctrl$id"}=$canvas->Entry(
                             -bg => 'white',
	                         -width  => (${$size}[0]+32)/8);
	    $canvas->createWindow(${$location}[0] ,${$location}[1],
	                         -anchor => "nw",
	                         -window => $canvas->{"textctrl$id"} );
        }
       sub aST{
		my ($self,$canvas, $id, $text, $location)=@_;
		$canvas->{"stattext$id"}=$canvas->createText(${$location}[0] ,${$location}[1], 
		                     -anchor => "nw",
                             -text => $text,
                             -font =>'medium'
                 );
        }
        sub aCB{  #adapted from http://www.perlmonks.org/?node_id=799673
		   my ($self,$canvas, $id, $label, $location, $size, $action)=@_;
		   if (defined $oVars{$label}){
	        my @strings2 = split(",",$oVars{$label});
	        $iVars{"combo$id"}=$strings2[0];
	        $canvas->{"combo$id"}=$canvas->BrowseEntry(
	             -variable    => \($iVars{"combo$id"}),
				 -listheight => scalar @strings2, 
				 -listwidth  => (${$size}[0]-20)/2,
				 -browsecmd => $action);
		    foreach (@strings2){ $canvas->{"combo$id"}->insert("end",$_);}
			$canvas->{"cont$id"}=$canvas->{"combo$id"}->Subwidget('slistbox')->Subwidget('scrolled');#??
			
			$canvas->createWindow(${$location}[0] ,${$location}[1],
	             -width  => (${$size}[0]-20)*1.5,
	             -height => ${$size}[1], 
	                         -anchor => "nw",
	                         -window =>$canvas->{"combo$id"});
			}
		 
		 else {print "Combo options not defined for 'combo$id' with label $label\n"}
	        
	   }
        sub aMB{
	     my ($self,$canvas,$currentMenu, $id, $label, $type, $action)=@_;
	     if (($lastMenuLabel) &&($label eq $lastMenuLabel)){return $currentMenu} # bug workaround 
	     else {$lastMenuLabel=$label};	                                         # in menu generator
	    
	     
	       if ($type eq "menuhead"){
			   $currentMenu="menu".$id;
			   $self ->{$currentMenu} =  $self ->{"menubar"}->cascade(-label => "~$label")
		   }
		   elsif ($type eq "radio"){
			   $self ->{$currentMenu}->radiobutton(-label => $label);
		   }
		   elsif ($type eq "check"){
			   $self ->{$currentMenu}->checkbutton(-label => $label);
		   }
		   elsif ($type eq "separator"){
			   $self ->{$currentMenu}->separator;
		   }
		   else{
			   if($currentMenu!~m/$label/){
			     $self ->{$currentMenu}->command(-label => $label, -command =>$action);
			 }
		   }
		   # logging menu generator print "$currentMenu---$id----$label---$type\n";
		   return $currentMenu;
	   }
	   sub aSP{
			 my ($self,$canvas, $id, $panelType, $content, $location, $size)=@_;
			
			if ($panelType eq "I"){  # Image panels start with I
				if (! -e $content){ return; }
				no warnings;   # sorry about that...suppresses a "Useless string used in void context"
			    my $image = Image::Magick->new;
			    my $r = $image->Read("$content");
			    if ($image){
			      my $bmp;    # used to hold the bitmap.
			      my $geom=${$size}[0]."x".${$size}[1]."!";
			      $image->Scale(geometry => $geom);
			      $bmp = ( $image->ImageToBlob(magick=>'jpg') )[0];
			      $canvas->{"image".($id+1)}=$canvas->createImage(${$location}[0],${$location}[1],
			                             -anchor=>"nw",
			                             -image => $canvas->Photo(#"img$id",
			                                     -format=>'jpeg',
			                                     -data=>encode_base64($bmp) ));
                    }
				 else {"print failed to load image $content \n";}
			 }
			if ($panelType eq "T"){  
				$id++;
				$canvas->{"TextCtrl$id"}=$canvas->Text(
				             -bg => 'white',
	                         -width  => (${$size}[0])/7,
	                         -height => (${$size}[1]+12)/15);
	            $canvas->{"TextCtrl$id"}->insert('end',$content);
	             $canvas->createWindow(${$location}[0] ,${$location}[1],
	                         -anchor => "nw",
	                         -window => $canvas->{"TextCtrl$id"});
			 }
		 }
        
	   
   }

      
#functions for GUIDeFATE to load the widgets into the backend
   sub addWidget{
	   push (@widgets,shift );
   }
   sub addStyle{
	   my ($name,$style)=@_;
	   $styles{$name}=$style;
   }
   sub addVar{
	   my ($varName,$value)=@_;
	   $oVars{$varName}=$value;
   }

# Functions for internal use 
   sub getSize{
	   my ($self,$id)=@_;
	   my $found=getItem($self,$id);
	   return ( $found!=-1) ? $widgets[$found][5]:0;
	   
   }
   sub getLocation{