#!/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;