#!/usr/bin/perl
use strict;
use warnings;

use Tk;
use Tk::ItemStyle;
use Tk::TList;

my $mw = Tk::MainWindow->new();
my $tl = $mw->TList->pack;

my %TkStyle;
my %count;

for my $color (qw( Black Red Green Blue )) {
    $TkStyle{$color} = $mw->ItemStyle('text',
                                      -stylename        => $color,
                                      -foreground       => $color,
                                      -background       => 'Wheat',
                                      -selectforeground => 'LightSeaGreen');
    $tl->insert('end', -itemtype => 'text',
                       -text     => $color,
                       -style    => $TkStyle{$color});
    ++$count{ $TkStyle{$color} };
}

for my $colour (keys %TkStyle ) {
    my $style = $TkStyle{$colour};
    printf("%10s has count %d (style=$style)\n", $colour, $count{$style});
}

MainLoop();