Re: Icon generation on the fly

[zentara]

Does this look interesting? Use a here doc to define an XPM, then convert to icon.

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

# by Ch Lambrecht

my $logo = <<'logo_end';
/* XPM */
static char * logo_xpm[] = {
"32 32 5 1",
"     c None",
".    c #FD000A",
"+    c #FD6463",
"@    c #FEBEBE",
"#    c #FEFFFC",
"################################",
"################################",
"################################",
"################################",
"################################",
"################################",
"################################",
"################################",
"################################",
"########........##.....@########",
"#########@....+####@.###########",
"##########+....@###.@###########",
"###########.....##++############",
"###########@....+@.#############",
"############+.....@#############",
"#############.....##############",
"#############@....@#############",
"#############@.....#############",
"#############.+....+############",
"############++#+....@###########",
"###########@.###.....###########",
"###########.@###@....+##########",
"##########++#####+....@#########",
"########+....###........########",
"################################",
"################################",
"################################",
"################################",
"################################",
"################################",
"################################",
"################################"};
logo_end
;
package Tk::Toplevel;

sub InitObject{
     my ($self,$args) = @_;
     $self->SUPER::InitObject($args);
     my $mw = $self;
     while ($mw->parent){$mw = $mw->parent}
     if ($mw->cget('-appicon')){
         $self->afterIdle(sub{$self->iconimage($mw->cget('-appicon'))}
+) ;
     }
}

package MainWindow;
sub Populate{
     my ($self,$args) = @_;

     $self->SUPER::Populate($args);
     $self->ConfigSpecs(-appicondata => ['METHOD'],
                        -appiconfile => ['METHOD'],
                        -appicon     => ['PASSIVE']
                    );
     $self->configure(%$args);
     }

sub appicondata{
     my $self = shift;
     $self->configure(-appicon => $self->Pixmap(-data=>$_[0]));

}
sub appiconfile{
     my $self = shift;
     $self->configure('-appicon' => $self->Pixmap(-file=>$_[0]));
}



package main;

#my $mw = MainWindow->new(-appiconfile => 'logo.xpm');
my $mw = MainWindow->new(-appicondata => $logo);
$mw->Toplevel();
my $tp = $mw->Toplevel();


MainLoop;

[chessgui]

This app seems to override some Tk methods. Is it possible in your view to create a windowless Toplevel ( I mean with no edges, title bar etc. just a plain widget: say a canvas )?

[zentara]

mean with no edges, title bar etc. just a plain widget: say a canvas

Something like this?

#!/usr/bin/perl -w
use warnings;
use strict;
use Tk;
use Tk::LabEntry;

my $mw = MainWindow->new;
my $vh = $mw->vrootheight;
my $vw = $mw->vrootwidth;

# this is what grabs all virtual desktops
$mw->overrideredirect(1);

# Note that the 'virtual window' height and width are $vh and $vw
# respectively, so we use those dimensions for our Canvas height 
# and width, and let the Canvas expand and fill in both x and y
# directions.
#
my $canvas = $mw->Canvas(
   -width => $vw, 
   -height => $vh, 
   -background =>'blue',
   -takefocus =>0
   ); # so canvas dosn't take focus on tab press

$canvas->pack(-expand => 1, -fill => 'both');

#just for fun instead of an image
$canvas->createRectangle(100, 100, 150, 150, -fill => 'orange'); 

my $window = 
    $canvas->Button(-text=> 'Ok',
               -command=> sub{ exit;}
    );

$canvas->createWindow($vw/2, $vh/2,
          -window=> $window );

MainLoop;

[chessgui]

Boy, this is cool. It has gray edges (where does this gray come from? the color for window edges and title bars generated for toplevel windows by Win32 is blue on my system) but other than that it is a plain canvas as a Toplevel.