#!/usr/bin/perl -w
use strict;
use Tk;

my $MW = MainWindow->new();

my $canvas = $MW->Canvas( -background => 'white', );

$canvas->createPolygon(
    ( 10, 20 ),
    ( 20,  10 ),
    ( 250, 240 ),
    ( 240, 250 ),
    -fill => 'pink',
    -stipple => 'gray50',
);

$canvas->createPolygon(
    ( 250, 20 ),
    ( 240, 10 ),
    ( 10,  240 ),
    ( 20,  250 ),
    -fill => 'blue',
    -stipple => 'gray12',
);


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]);
};


$canvas->createPolygon(
    ( 150, 20 ),
    ( 140, 10 ),
    ( 20,  240 ),
    ( 30,  250 ),
    -fill => 'green',
    -stipple => 'stipple8',
);

$canvas->pack();

MainLoop();