From 52f0552cb303a8847f4167c0b9583eba74e10ba9 Mon Sep 17 00:00:00 2001
From: milkbone57 <milkbone57>
Date: Thu, 14 Aug 2003 03:06:04 +0000
Subject: [PATCH] ""

---
 plugins/Tk-GUI/Tk/ColorChoice.pm | 95 ++++++++++++++++++++++++++++++++
 1 file changed, 95 insertions(+)
 create mode 100644 plugins/Tk-GUI/Tk/ColorChoice.pm

diff --git a/plugins/Tk-GUI/Tk/ColorChoice.pm b/plugins/Tk-GUI/Tk/ColorChoice.pm
new file mode 100644
index 0000000..8b964d6
--- /dev/null
+++ b/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;