Comment out the "reshape" and "fullrehape" lines to see the clipping control.
#!/usr/bin/perl use warnings; use strict; use Tk::Zinc; my $width = 200; my $height = 100; my $xpos = -10; my $ypos = -10; my $mw = MainWindow->new(-background => 'cyan'); $mw->geometry($width.'x'.$height.$xpos.$ypos); $mw->overrideredirect(1); my $zinc = $mw->Zinc(-width => $width, -height => $height, -reshape => 1, #clips zinc -fullreshape => 1, #clips $mw and xterm -backcolor => 'cyan', )->pack; my $ufo = $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'], -closed => 1, -visible => 0, ); my @portholes; for(0..8){ my $porthole = $zinc->add('arc', 1, [10+20*$_,40,20+20*$_,50], -filled => 1, -fillcolor => 'white', -visible => 1); push(@portholes,$porthole); } $mw->bind("<Button 1>",sub{Tk::exit}); # using the curve to reshape both TkZinc and Mainwindow widgets $zinc->itemconfigure(1, -clip => $ufo); my $dx = 0 ; my $dy = -1; $mw->repeat(10,sub { $xpos = $xpos + $dx; $ypos = $ypos + $dy; if(400 + $ypos < 0){$dy = 1; $dx = -1} if(-$ypos < 10){$dx = 1; $dy = 0} if($xpos == 0){$xpos = -10;$ypos = -10; $dx = 0;$d +y=-1} $mw->geometry($width.'x'.$height.$xpos.$ypos); $mw->update; }); &Tk::MainLoop;
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: UFO: Oval xterm with Tk::Zinc
by christopheM (Beadle) on Nov 28, 2003 at 11:51 UTC |