|
Re: Shrinking Pie Analog Countdown Timer
by ww (Archbishop) on May 24, 2006 at 14:23 UTC
|
<sigh> ...for what values of "best?"
if "best" relates to your ability to write the code for the ap you've described, best is probably tied to your existing skills... and you merely disclaimed skills using graphics. Tell us more....
if "best" refers to the smallest || fastest || most easily maintained || some other value, you'll have make that judgement.
That said, and despite utter inexperience with TK (tho we have numerous folk here who are highly skillful) this sounds like a perl/TK project... and you might help youself by searching for nodes on the topic | [reply] |
|
|
| [reply] |
|
|
| [reply] |
|
|
|
|
Re: Shrinking Pie Analog Countdown Timer
by BrowserUk (Patriarch) on May 24, 2006 at 18:53 UTC
|
If you get Tk to work, this is one way to do it. It draws 360 tagged segements in the background color (so they are invisible, and when the spacebar is pressed, changes their color to black making them visible. It then sets up a repeating, timed callback that makes the segments invisible again one at a time.
#! perl -slw
use strict;
use Time::HiRes qw[ time ];
use Tk::Canvas;
our $TIME ||= 10;
## Fudge factor! using 850 instead of a 1000 works
## reasonably well for timeperiods of 5 to 30 seconds
## on my machine. Adjust to suit processor speed.
my $repeatTime = int( 850 * $TIME / 360 );
print $repeatTime;
my $mw = MainWindow->new;
my $canvas = $mw->Canvas(
-width => 640,
-height => 480,
-bg => 'white',
)->pack;
## Create 360 tagged segments white (invisible).
for my $tag ( 0 .. 359 ) {
$canvas->createArc(
80, 0, 560, 480,
-fill => 'white', -outline => undef,
-start => $tag + 90, -extent => 1,
-tag => "t$tag",
);
}
## Bind action to space bar
$mw->bind( '<space>', sub {
## remove previous alphanumeric code
$canvas->delete( 'code' );
print time();
## make circle visible by setting the color of the segments
$canvas->itemconfigure( "t$_", -fill => 'black' ) for 0 .. 359;
my $tag = 359; ## Start with the first tag to 'remove'.
my $rep;
## Set up the repeating callback with the delay calculated earlier
$rep = $mw->repeat( $repeatTime, sub {
## if the last segment has been removed
## beep, display the code and cancel the timer.
if( $tag < 0 ) {
printf "\a";
$canvas->createText( 300, 240,
-text => 'AN ALPHA-NUMERIC CODE', -tag => 'code'
);
$rep->cancel;
print time();
}
## If a quater of the circle left, beep and change the color t
+o red
if( $tag == 90 ) {
printf "\a";
$canvas->itemconfigure( "t$_", -fill => 'red' ) for 0 .. 9
+0;
}
## make the next segment invisible.
$canvas->itemconfigure( "t$tag", -fill => 'white' );
--$tag; ## Next segment to remove.
});
});
$mw->MainLoop;
There is a fudge factor in the timer calculation (using 850 instead of 1000 milliseconds), to account for processing time. 850 workd fairly well for short countdowns (5 to 30 seconds) on my machine, but it will need adjusting to accomodate your processor and graphics card performance.
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
| [reply]
[d/l] |
|
|
Stealing liberaly and recoding a little. This does the same thing (mostly) but without all the different slices. This lets you set the angle that you could like to be removed every frame and the timer length. Moved configuration data to the top and thats about it. Mine is probably worse in some ways or better in others, but in reality i was just playing and thought i would share.
#! perl -slw
use strict;
use warnings;
use Time::HiRes qw[ time ];
use Tk::Canvas;
my $inc = 1; #degrees to move each frame
my $length = 10; #seconds to take
my ($width, $height) = (480,480);
my $trip_point = 90;
my $code = 'A123BC';
my $repeatTime = ($length * 1000) / (360 / $inc);
my $mw = MainWindow->new;
my $canvas = $mw->Canvas(
-width => $width,
-height => $height,
-bg => 'black',
)->pack;
my $start = 359;
my $arc =
$canvas->createArc(
0, 0, $width, $height,
-fill => 'white',
-outline => undef,
-extent => $start,
-start => 90,
-tag => 'arc',
);
## Bind action to space bar
$mw->bind( '<space>', sub {
my $rep;
my $tripped = 0;
## Set up the repeating callback with the delay calculated earlier
$rep = $mw->repeat( $repeatTime, sub {
$start -= $inc;
$canvas->itemconfigure('arc', -extent => $start );
if ($start < 0) {
$canvas->itemconfigure('arc', -extent => 0);
$rep->cancel;
printf "\a";
$canvas->createText($width / 2, $height /2,
-text => $code,
-tag => 'code',
-fill => 'red',
);
} elsif ($start < $trip_point and !$tripped) {
printf "\a";
$tripped = 1;
$canvas->itemconfigure('arc', -fill => 'red');
}
});
});
$mw->MainLoop;
Update: .... errr cut and pasted the wrong file, sorry bout that.
| [reply]
[d/l] |
|
|
| [reply]
[d/l] |
|
|
Re: Shrinking Pie Analog Countdown Timer
by zentara (Cardinal) on May 24, 2006 at 19:36 UTC
|
Here is another Tk version, :-) Mine differs in style from BrowserUk's. He made a bunch of pie segments to manipulate. I used a technique of layering an arc over a background circle, and changing their extent and color. There are many ways to do it! UPDATE: added 'cleanup' tags to improve performance, and fixed the bell repitition problem.
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $mw = tkinit;
$mw->fontCreate('big',
-family=>'arial',
-weight=>'bold',
-size=>int(-18*18/14));
my $running = 0;
my $canvas = $mw->Canvas(-width => 600, -height => 600,
-bg =>'black')->pack();
my $start_message = $canvas->createText(300,30,
-text => 'Press SpaceBar to Start',
-fill => 'hotpink',
-anchor => 'center',
-font => 'big');
$mw->bind('<space>', \&start );
MainLoop;
###########################################################
sub start{
return if $running;
$running = 1;
$canvas->delete('cleanup');
$canvas->itemconfigure($start_message, -state => 'hidden');
$canvas->createOval(100,100,500,500,
-fill => 'white',
-tags => ['backplate','cleanup'],
);
my $extent = -1;
my $arc = $canvas->createArc(100,100,500,500,
-extent => $extent,
-start => 90,
-fill => 'black',
-tags => ['cleanup'],
);
my $repeater;
$repeater = $mw->repeat(20, sub{
$extent = $extent - 1;
$canvas->itemconfigure($arc, -extent => $extent);
if( $extent == -320 ){
print chr(07); #beep
$canvas->itemconfigure('backplate', -fill => 'red');
}
if( $extent < -359 ){
$repeater->cancel;
&message;
}
});
}
##############################################
sub message{
$canvas->createText(300,300,
-text => time,
-anchor => 'center',
-font => 'big',
-tags => ['cleanup'],
);
$running = 0;
$canvas->itemconfigure($start_message, -state => 'normal');
}
I'm not really a human, but I play one on earth.
flash japh
| [reply]
[d/l] |
|
|
There is another small problem with your version. If you modify it so that it runs as quickly as possible (set the repeat delay to 1) and to display the elapsed time from start to finish, it gets slower each time you run it?
On my machine, the first run takes under a second, but by the 10th it takes nearly 3, and by the 20th over 5. I think this is because you are re-creating new arcs and text at each run rather than modifying the existing ones.
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
| [reply]
[d/l] |
|
|
It pays to have a second set of eyes looking at something. :-) Thanks for pointing out that repeated red fill update glitch. As far as the slowdown problem goes, it dawned on me in my dreams last night that I wasn't cleaning up those items. I checked for memory gain, but there was none, so I let it go. But after switching to delay=1, I did see some sluggish performance after about 20 runs. I added the cleanup tags, and it seems to run fine now while holding down the spacebar.
I thought about creating the circle and arc as globals and just using hidden states to reuse them, but I thought I would show it created new in a sub, in case the tester wanted to randomly change the size and position of the circle on each run( which would be handy in a psychological test of eye movement).
I'm not really a human, but I play one on earth.
flash japh
| [reply] |
|
|
if( $extent == -320 ){
It prevents it sounding like a fire engine on amphetamines (my console bell is rather strident). It also prevents the red extent being re-drawn 40 times and freezing (due to the bells) at 40 degrees before jumping to 0.
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
| [reply]
[d/l] |
Re: Shrinking Pie Analog Countdown Timer
by zentara (Cardinal) on May 24, 2006 at 16:07 UTC
|
A Tk canvas could do this very easily, I could whip up a script
in less than an hour. Maybe you should concentrate on how to get Tk working on a Mac. It can be done, because quite a few Tk developers run Macs. Maybe look at Installing Tk (and other modules) on Mac OS X or post another question on installing Tk on a Mac.
I'm not really a human, but I play one on earth.
flash japh
| [reply] |
|
|
Upon looking thru my notes, other people have asked why Tk dosn't run on a Mac. Steven Lidie wrote
> I'm trying to install the Tk module on Mac OS X.
> I've done all that, according to README.darwin, must be done:
> - Install X11 SDK
> - compile Perl from the sources with
> sh Configure -des -Duseshrplib
> and use this new Perl as default.
> - I'm installing everything from the root account
>
> Everything goes well, but almost no test is passed.
> The error is, in almost all the tests, the following:
> "couldn't connect to display ":0" at
> /private/var/root/.cpan/build/Tk-804.027/blib/lib/Tk/MainWindow.pm l
+ine 55"
Most likely you have no X server running. Find and install X11.app, a
+nd do
the make test while in an X11 window.
>
> Thus, I've done no "make install" yet.
>
> I'm new to the Mac world, but I've used Perl/Tk under Linux and Wind
+ows
> with no problem installing the module.
>
> Any help will be greatly appreciated...
>
> Thanks a lot in advance,
>
I'm not really a human, but I play one on earth.
flash japh
| [reply]
[d/l] |