1 files changed, 59 insertions, 0 deletions
diff --git a/PerlTQt/examples/forever/forever.pl b/PerlTQt/examples/forever/forever.pl
new file mode 100644
index 0000000..e388e44
--- /dev/null
+++ b/PerlTQt/examples/forever/forever.pl
@@ -0,0 +1,59 @@
+#!/usr/bin/perl -w
+use strict;
+package Forever;
+use TQt;
+use TQt::isa qw(TQt::Widget);
+use TQt::slots
+	updateCaption => [];
+use TQt::attributes qw(
+	rectangles
+	colors
+);
+use constant numColors => 120;
+
+sub NEW {
+    shift->SUPER::NEW(@_);
+    colors = \my @colors;
+    for(my $a = 0; $a < numColors; $a++) {
+	push @colors, TQt::Color(rand(255), rand(255), rand(255));
+    }
+    rectangles = 0;
+    startTimer(0);
+    my $counter = TQt::Timer(this);
+    this->connect($counter, TQT_SIGNAL('timeout()'), TQT_SLOT('updateCaption()'));
+    $counter->start(1000);
+}
+
+sub updateCaption {
+    my $s = sprintf "PerlTQt Example - Forever - %d rectangles/second", rectangles;
+    rectangles = 0;
+    setCaption($s);
+}
+
+sub paintEvent {
+    my $paint = TQt::Painter(this);
+    my $w = width();
+    my $h = height();
+    return if $w <= 0 || $h <= 0;
+    $paint->setPen(&NoPen);
+    $paint->setBrush(colors->[rand(numColors)]);
+    $paint->drawRect(rand($w), rand($h), rand($w), rand($h));
+}
+
+sub timerEvent {
+    for(my $i = 0; $i < 100; $i++) {
+	repaint(0);
+	rectangles++;
+    }
+}
+
+package main;
+use TQt;
+use Forever;
+
+my $a = TQt::Application(\@ARGV);
+my $always = Forever;
+$a->setMainWidget($always);
+$always->setCaption("PerlTQt Example - Forever");
+$always->show;
+exit $a->exec;