Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Re: Perl TK window transparency / opacity

by zentara (Archbishop)
on Jul 01, 2006 at 13:02 UTC ( #558758=note: print w/ replies, xml ) Need Help??


in reply to Perl TK window transparency / opacity

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__

I'm not really a human, but I play one on earth. Cogito ergo sum a bum


Comment on Re: Perl TK window transparency / opacity
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://558758]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (15)
As of 2015-07-30 17:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (273 votes), past polls