use strict;
use warnings;

use Tk; 
use Tk::ROText; 


# User-defined
my $textfont = "Helvetica 12";
my @colors = qw( peachpuff lightyellow );
my @items = (
    'blue',
    'orange',
    'white',
    'red',
    'gray',
    'yellow',
    'purple',
    'tan',
    'pink',
    'green',
    'black',
);


# Globals
my @all_items  = ( );
my $item_count = 0;


# Main program
my $mw  = new MainWindow;
my $f1  = $mw->Frame()->pack(-expand => 0, -fill => 'x');
my $f2  = $mw->Frame()->pack(-expand => 1, -fill => 'both');
my $ps  = sub { $mw->destroy() };
my $b1  = button($f1, 'Exit',   'right', $ps, "Escape");
my $b2  = button($f1, 'Clear',  'left',  sub { clear_all() });
my $b3  = button($f1, 'Insert', 'left',  sub { insert_all() });
my $txt = $f2->Scrolled('ROText', -scrollbars => 'osoe')->pack();
insert_all();
MainLoop;


# Subroutines
sub button {
    my ($w, $text, $side, $psub, $bind) = @_;
    $bind ||= 0;
    $bind and $text .= " ($bind)";
    my $btn = $w->Button(-bg => 'skyblue', -text => $text);
    if ($psub || 0) {
        $btn->configure(-command => $psub);
        $bind and $mw->bind("<$bind>" => sub { $btn->invoke() });
    }
    $btn->pack(-side => $side);
    return $btn;
}


sub clear_all {
    # Delete all items in the Text widget
    @all_items = ( );
    $txt->delete("1.0", "end");
    $item_count = 0;
}


sub insert_all {
    # Delete the contents of the Text widget first
    $txt->delete("1.0", "end");
    $item_count = 0;

    # Sort the items, adding each to the Text widget
    push @all_items, @items;
    my @sorted = sort @all_items;
    foreach (@sorted) {
        insert_item($_);
    }
}


sub insert_item {
    my ($text) = @_;
    my $tag = "item_" . ++$item_count;
    my $bg = $colors[$item_count % @colors];
    $txt->tagConfigure($tag, -font => $textfont, -background => $bg);
    $txt->insert("end", "$text\n", $tag);
}