Re: Perl TK window transparency / opacity

[zentara]

I think you might be better off with Tk::Zinc than plain Tk. I played around a few years ago, without much useful success. On linux, it depends on the WindowManager features. You may be more ingenious than me. It's been awhile since I read the docs with a fine toothed comb, but I seem to think that alpha levels are not supported when clipping( making the xterm transparent).

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

my $width = 100;
my $height = 100;

my $mw = MainWindow->new(-background => 'cyan' ); 

#$mw->geometry($width.'x'.$height.'+300+300');

$mw->geometry('500x500+300+300');


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

my $petal = $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'],
                   -filled => 1,
                   #-fillcolor => 'cyan',
                   #attempt at semi-transparency
           -fillcolor => "=radial 0 0 |yellow;40|black;40 50|cyan;40",
+ 
           -closed => 1,
                   -linewidth => 0,
           -priority => 1,
           -visible => 1,
           );

# using the triangulaire curve to reshape both TkZinc and Mainwindow w
+idgets 
$zinc->itemconfigure(1, -clip => $petal); 

MainLoop;

If you wanted to do everything on a Zinc Canvas, you could simulate it. Here is some alpha stuff

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

my $currenttransfo;
my $previousangle = 0;
my $rotate_angle = .1;
my $zoomfactor = .1;
my ($dx, $dy);

# some sample gradients to try
# '=axial 0|#ff7777|#ffff99',
# '=axial 270|#a7ffa7;70 0|#ffffff;90 5|#00bd00;80 8|#b7ffb7;50 80|#ff
+ffff;70 91|#00ac00;70 95|#006700;60 100',
# '=axial 270|#00bd00;80 |#d7ffd7;60',
# '=axial 270|#00bd00;100 0|#ffffff;100 14|#ffffff;100 16|#00bd00;90 2
+5|#b7ffb7;60 100',
# '=axial 0|#00bd00;100 0|#ffffff;100 20|#00bd00;50 30|#00bd00;90 80|#
+b7ffb7;60 100',
# '=path 48 48|#e7ffe7;20 0 70|#007900;20',
# '=axial 270|#d7ffd7;60|#7777ff;80',
# '=axial 270|#2222ff;80 |#d7ffd7;60',
# '=axial 270|#7777ff;80 |#d7ffd7;60',
# '=radial -15 -20|#ffb7b7;50|#bd6622;90',
# '=axial 90|#ffff77;80 |#ff7700;60',
# '=axial 0|#cccccc;100 0|#ffffff;100 10|#5a5a6a;100 80|#aaaadd;100 10
+0',
# '=axial 270|#ccccff;100 0|#ffffff;100 10|#5a5a7a;100 80|#bbbbee;100 
+100',
# '=conical 0 0 -45|#ffffff;100 0|#888899;100 30|#555566;100 50|#88889
+9;100 70|#ffffff;100 100',
# '=conical 0 0 135|#ffffff;100 0|#777788;100 30|#444455;100 50|#77778
+8;100 70|#ffffff;100 100',
 
my $mw = MainWindow->new();
$mw->geometry("700x560");
$mw->title('Transparency');

my $zinc = $mw->Zinc(-render => 1,
             -width => 700,
             -height => 560,
             -borderwidth => 0,
             -lightangle => 140,
             -borderwidth => 0,
             -backcolor => '#ffffff',);
$zinc->pack(-fill => 'both', -expand => 1);

# main group
my $tgroup = $zinc->add('group', 1);
$zinc->coords($tgroup, [0,0]);  #create at zinc origin

# add some text to main zinc
$zinc->add('text', 1,
       -position => [50, 470],
       -text => "<Up>, <Down>, <Left> and <Right> keys move content of
+ TabBox pages\n<Plus> and <Minus> keys zoom out and zoom in this page
+\n<Greater> and <Less> keys rotate this page\n<Escape> key reset tran
+sformations",
       -color => '#000000',
       -spacing => 2,
       );

# add some items to $tgroup
# the form #ffffff;70 means white at 70% ; 100 will mean no transparen
+cy
$zinc->add('rectangle',$tgroup,[200,150,300,250], 
            -filled => 1, 
        -fillcolor => '=axial 270|#bdffa7;70 0|#000000;90 5|#bd0000;60
+ 8|#b7ffb7;50 80|#ffffff;70 91|#00ac00;70 95|#006700;60',
        -tags=>['move'],
        );

$zinc->add('rectangle',$tgroup,[350,150,450,250], 
            -filled => 1, 
        -fillcolor => '#00bd00;30',
        -tags=>['move'],
        );

$zinc->add('arc', $tgroup, [225, 275, 450, 350], 
           -fillcolor => "=radial 0 0 |yellow;40|black;40 50|cyan;40",
+ 
       -filled => 1,
       -tags=>['move'],
       );

# setup bindings
&setBindings;


MainLoop;
######################################################################
+########

sub setBindings {
  # grab keyboard
  $mw->Tk::focus();

  # plus,minus : Zoom++, Zoom--
  $mw->Tk::bind('<plus>', sub {viewZoom('up');});
  $mw->Tk::bind('<minus>', sub {viewZoom('down');});

  # Up, Down, Right, Left : Translate
  $mw->Tk::bind('<KeyPress-Up>', sub {viewTranslate('up');});
  $mw->Tk::bind('<KeyPress-Down>', sub {viewTranslate('down');});
  $mw->Tk::bind('<KeyPress-Left>', sub {viewTranslate('left');});
  $mw->Tk::bind('<KeyPress-Right>', sub {viewTranslate('right');});


  # >, < : Rotate counterclockwise et clockwise
  $mw->Tk::bind('<greater>', sub {viewRotate('cw');});
  $mw->Tk::bind('<less>', sub {viewRotate('ccw');});

  # Escape : reset transforms
  $mw->Tk::bind('<Escape>', sub {$zinc->treset('move');
                 $zinc->raise('move');
                 $zinc->treset($tgroup);});

  $zinc->bind('move', '<1>', sub {&mobileStart();});
  $zinc->bind('move', '<B1-Motion>', sub {&mobileMove();});
  $zinc->bind('move', '<ButtonRelease>', sub {&mobileStop();});
}

#---------------------------------------------------------------------
+--------------
sub mobileStart {
  my $ev = $zinc->XEvent;
  ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
  $zinc->raise('current');
}
#---------------------------------------------------------------------
+--------------
sub mobileMove {
    my $ev = $zinc->XEvent;
    $zinc->translate('current', $ev->x + $dx, $ev->y +$dy);
    ($dx, $dy) = (0 - $ev->x, 0 - $ev->y);
}
#---------------------------------------------------------------------
+--------------
sub mobileStop {
  &mobileMove;
}
#---------------------------------------------------------------------
+--------------
sub viewTranslate {
  my $way = shift;
  my $dx = ($way eq 'left') ? -10 : ($way eq 'right') ? 10 : 0;
  my $dy = ($way eq 'up') ? -10 : ($way eq 'down') ? 10 : 0;
  $zinc->translate($tgroup, $dx, $dy);
}
#---------------------------------------------------------------------
+--------------
sub viewZoom {
  my $key = shift;
  my $scaleratio = ($key eq 'up') ? 1+$zoomfactor : 1-$zoomfactor;
  $zinc->scale($tgroup, $scaleratio, $scaleratio,350,280); #around cen
+ter of zinc
}
#---------------------------------------------------------------------
+--------------
sub viewRotate {
  my $way = shift;
  my $delta_angle = $rotate_angle;
  $delta_angle *= -1 if ($way eq 'cw');
  $zinc->rotate($tgroup, $delta_angle,350,280);  #around center of zin
+c
}

__END__