You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
libtqt-perl/PerlTQt/examples/forever/forever.pl

60 lines
1.2 KiB

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