Does anyone have/know of some example code that fills Canvas objects (Ovals/rectangles etc.), with a stippled pattern?
IIRC there are examples of canvas stipples in the "widget" demo bundled with Tk.
--
Oh Lord, wont you burn me a Knoppix CD ?
My friends all rate Windows, I must disagree.
Your powers of persuasion will set them all free,
So oh Lord, wont you burn me a Knoppix CD ?
(Missquoting Janis Joplin)
I've found examples, and made my own, of using stippled lines and outlines, but the knowledge does not seem to transfer to doing stippled fills.
Since posting, I turned up this quote from the 300 and something google hit on my fourth set of search criteria:
======================================================================== #12.4. How can I get bitmaps created with 'image' to work with '-stipple'? At the moment, you can't. Bitmaps created with 'image create bitmap ...' do not use 'Tk_DefineBitmap', which is required for '-stipple' to know it's a bitmap. Instead, you'll have to use the old format for using bitmaps in stipples, like so: .canvas create rect 10 10 80 80 -fill black -stipple @/path/to/my.bmp It's not a simple C fix for the above problem, but it's on Sun's ToDo list.
Whether that is relevant, still current, whatever, I have no idea.
I also previously went through my copy of Perl/Tk (on CD) looking for a worked example, but there either isn't one in there or I managed to miss it?
I've tried using both the built-in stipples (gray50, gray25) etc. and bitmaps I've created myself using DefineBitmap(). Once I got the incatations right, I ceased getting errors, but it simply has no effect on the graphic? Hence, asking if there was an example out there. Three solid hours of Googling hasn't turned up a single piece of code that does a stippled fill.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $mw = MainWindow->new();
# first create a canvas widget
my $canvas = $mw->Canvas(width => 300, height => 200)->pack();
my $one = $canvas->createOval(55, 20, 200, 190,
-fill => 'blue',
-outline=>'blue',
-tags => ['blue'],
-stipple => 'gray75',
);
my $two = $canvas->createOval(105, 20, 250, 190,
-fill => 'red',
-outline=>'red',
-tags => ['red'],
-stipple => 'gray12',
#-stipple => 'transparent',
);
my $ebutton = $mw->Button(-text => 'Exit',
-command => 'Tk::exit')->pack();
$canvas->Tk::bind("", [ \&print_xy, Ev('x'), Ev('y') ]);
MainLoop();
sub print_xy {
my ($canv, $x, $y) = @_;
# print "(x,y) = ", $canv->canvasx($x), ", ", $canv->canvasy($y), "\n";
#my $x1 = $x+1;
#my $y1 = $y+1;
my (@current) = $canvas->find('overlapping', $x, $y, $x, $y);
foreach my $id(@current){
print $canvas->gettags($id),' ';
}
print "\n";
}
__END__
I'm not really a human, but I play one on earth. flash japh
This looks amazingly like my test code, except I have three circles red, green, and blue overlapping in the usual way. However, your code produces exactly the same non-effect as mine.
Just in case you are seeing something different to me, I have uploaded a pixel grab png of your demo above as my homenode pic. Does it look different on your machine?
I'm not really a human, but I play one on earth. flash japh
Hmm. Overnight I completely wiped 5.8 from my machine and installed afresh. I just re-ran your sample and got exactly the same results. Seems like there is either a bug or a limitation in Tk 804.027 on Win32 :(
I wonder if it is a known/documented limitation or just something that hasn't been reported. Where is the best place to ask?
Anyway, many thanks for the sample* and confirmation. At least I can stop pursuing a lost cause now :)
*And the latest one.
I'm not really a human, but I play one on earth. flash japh
Guess what I just turned up here.
6. Under Windows, -stipple option for canvas and text is apparently not supported at all. RT
#!/usr/bin/perl
use warnings;
#use diagnostics;
use strict;
use Tk;
my $mw = MainWindow->new(-background => 'white', -relief => 'flat');
my $stipple_bits = []; # important
foreach my $b (1 .. 8) {
push @$stipple_bits, pack('b8', '1' x $b . '.' x (8 - $b));
$mw->DefineBitmap("stipple$b" => 8, 1, $stipple_bits->[$b-1]);
};
my $c = $mw->Canvas(qw/-width 200 -background white -relief flat/)->grid;
$c->createLine(qw/20 20 180 20/);
my $y = 40;
for my $b (1 .. 8) {
$c->createText(10, $y, -text => $b);
$c->createLine(20, $y, 180, $y, -stipple => "stipple$b");
$y += 20;
}
my $bits = pack("b8" x 5,
"........",
"...11...",
"..1111..",
".111111.",
"........");
$mw->DefineBitmap('increment' => 8, 5, $bits);
MainLoop;
I'm not really a human, but I play one on earth. flash japh
Your example is remarkably similar to this one I found in the Mastering Perl/Tk:
#!/usr/local/bin/perl -w
use strict;
use Tk;
my $mw = MainWindow->new(-background => 'white', -relief => 'flat');
my $stipple_bits = []; # important
foreach my $b (1 .. 8) {
push @$stipple_bits, pack('b8', '1' x $b . '0' x (8 - $b));
$mw->DefineBitmap("stipple$b" => 8, 1, $stipple_bits->[$b-1]);
};
my $c = $mw->Canvas(qw/-width 200 -background white -relief flat/)->grid;
$c->createLine(qw/20 20 180 20/);
my $y = 40;
for my $b (1 .. 8) {
$c->createText(10, $y, -text => $b);
$c->createLine(20, $y, 180, $y, -stipple => "stipple$b");
$y += 20;
}
MainLoop;
But as I mentioned above, it only stipples lines. It also works for -outlinestipple, but not -fill stipples.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $mw = MainWindow->new();
# first create a canvas widget
my $canvas = $mw->Scrolled('Canvas',
-width=>300,
-height=>600,
-scrollregion=>[0,0,300,1000],
-scrollbars=>'e')
->pack(-fill=>'both',-expand=>1);
####################################################
my $gray50_width = 2;
my $gray50_height = 2;
my $gray50_bits = pack "CC", 0x02, 0x01;
$mw->DefineBitmap('mask' => 2,2, $gray50_bits);
########################################################
$canvas->createOval(55, 0, 200, 170,
-fill => 'red',
-outline=>'red',
-tags => ['red'],
);
$canvas->createOval(55, 150, 200, 290,
-fill => 'red',
-outline=>'red',
-tags => ['red'],
-stipple => 'mask',
);
my $stipple_bits = []; # important
foreach my $b (1 .. 8) {
push @$stipple_bits, pack('b8', '1' x $b . '.' x (8 - $b));
$mw->DefineBitmap("stipple$b" => 8, 1, $stipple_bits->[$b-1]);
};
my $y = 0;
for my $b (1 .. 8) {
$canvas->createOval(55, $y+20, 200, $y+190,
-fill => 'blue',
-outline=>'blue',
-tags => ['blue'],
-stipple => "stipple$b",
);
$y += 80;
}
my $ebutton = $mw->Button(-text => 'Exit',
-command => 'Tk::exit')->pack();
MainLoop();
I'm not really a human, but I play one on earth. flash japh