Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
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 musing on the Monastery: (5)
As of 2014-08-02 09:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Who would be the most fun to work for?















    Results (55 votes), past polls