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/)->gr
+id;
$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;
[download]

But as I mentioned above, it only stipples lines. It also works for -outlinestipple, but not -fill stipples.

Well fill stipples work for me on linux. Here is a screenshot of the script below.

#!/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();
[download]

---

I'm not really a human, but I play one on earth. flash japh