libtqt-perl/PerlTQt/examples/forever/forever.pl

#!/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;