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

my $bits = pack("b8" x 5,
"........",
"...11...",
"..1111..",
".111111.",
"........");
$mw->DefineBitmap('increment' => 8, 5, $bits);

MainLoop;
[download]