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