""

plugins/Tk-GUI/Tk/ColorChoice.pm

@@ -0,0 +1,95 @@
+package Tk::ColorChoice;
+
+use Tk;
+use Tk::Font;
+use base 'Tk::Toplevel';
+
+use strict;
+use warnings;
+
+Construct Tk::Widget 'ColorChoice';
+
+sub ClassInit
+{
+        my ($class, $mw) = @_;
+        $class->SUPER::ClassInit($mw);
+}
+
+sub Populate
+{
+    my ($self, $args) = @_;
+    $self->SUPER::Populate($args);
+
+        $self->after(10, [$self, "init"]);
+
+}
+package Tk::ColorChoice;
+
+use Tk;
+use Tk::Font;
+use base 'Tk::Toplevel';
+
+use strict;
+use warnings;
+
+Construct Tk::Widget 'ColorChoice';
+
+sub ClassInit
+{
+        my ($class, $mw) = @_;
+        $class->SUPER::ClassInit($mw);
+}
+
+sub Populate
+{
+    my ($self, $args) = @_;
+    $self->SUPER::Populate($args);
+
+        $self->after(10, [$self, "init"]);
+
+}
+
+sub init
+{
+        my ($self) = @_;
+
+        my (@colors) = qw(red pink purple blue green yellow orange red brown
+black white);
+
+        while(@colors)
+        {
+                my @currow;
+                while(@colors and @currow < 4)
+                {
+                        my $color = shift @colors;
+                        push @currow, $self->Button(-background => $color, -activebackground =>
+$color, -text => '     ');
+                }
+                last unless @currow;
+                (shift @currow)->grid(@currow);
+        }
+}
+
+1;
+sub init
+{
+        my ($self) = @_;
+
+        my (@colors) = qw(red pink purple blue green yellow orange red brown
+black white);
+
+        while(@colors)
+        {
+                my @currow;
+                while(@colors and @currow < 4)
+                {
+                        my $color = shift @colors;
+                        push @currow, $self->Button(-background => $color, -activebackground =>
+$color, -text => '     ');
+                }
+                last unless @currow;
+                (shift @currow)->grid(@currow);
+        }
+}
+
+1;