lib/SDL/Timer.pm

   1 #!/usr/bin/env perl
   2 #
   3 # Timer.pm
   4 #
   5 # Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
   6 #
   7 # ------------------------------------------------------------------------------
   8 #
   9 # This library is free software; you can redistribute it and/or
  10 # modify it under the terms of the GNU Lesser General Public
  11 # License as published by the Free Software Foundation; either
  12 # version 2.1 of the License, or (at your option) any later version.
  13 #
  14 # This library is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 # Lesser General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU Lesser General Public
  20 # License along with this library; if not, write to the Free Software
  21 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  22 #
  23 # ------------------------------------------------------------------------------
  24 #
  25 # Please feel free to send questions, suggestions or improvements to:
  26 #
  27 #       David J. Goehrig
  28 #       dgoehrig@cpan.org
  29 #
  30
  31 package SDL::Timer;
  32
  33 use strict;
  34 use SDL;
  35
  36 sub new {
  37         my $proto = shift;
  38         my $class = ref($proto) || $proto;
  39         my $self = {};
  40         my $func = shift;
  41         my (%options) = @_;
  42
  43         verify(%options,qw/ -delay -times -d -t /);
  44
  45         die "SDL::Timer::new no delay specified\n"
  46                 unless ($options{-delay});
  47         $$self{-delay} = $options{-delay} || $options{-d} || 0;
  48         $$self{-times} = $options{-times} || $options{-t} || 0;
  49         if ($$self{-times}) {
  50                 $$self{-routine} = sub { &$func($self); $$self{-delay} if(--$$self{-times}) };
  51         } else {
  52                 $$self{-routine} = sub { &$func; $$self{-delay}};
  53         }
  54         $$self{-timer} = SDL::NewTimer($$self{-delay},$$self{-routine});
  55         die "Could not create timer, ", SDL::GetError(), "\n"
  56                 unless ($self->{-timer});
  57         bless $self,$class;
  58         return $self;
  59 }
  60
  61 sub DESTROY {
  62         my $self = shift;
  63         SDL::RemoveTimer($$self{-timer}) if ($$self{-timer});
  64         $$self{-timer} = 0;
  65 }
  66
  67 sub run {
  68         my ($self,$delay,$times) = @_;
  69         $$self{-delay} = $delay;
  70         $$self{-times} = $times;
  71         SDL::RemoveTimer($$self{-timer}) if ($$self{-timer});
  72         $$self{-timer} = SDL::AddTimer($$self{-delay},SDL::PerlTimerCallback,$$self{-routine});
  73 }
  74
  75 sub stop {
  76         my ($self) = @_;
  77         SDL::RemoveTimer($$self{-timer}) if ($$self{-timer});
  78         $$self{-timer} = 0;
  79 }
  80
  81 1;
  82
  83 __END__;
  84
  85 =pod
  86
  87
  88 =head1 NAME
  89
  90 SDL::Timer - a SDL perl extension to handle timers
  91
  92 =head1 SYNOPSIS
  93
  94   $timer = new SDL::Timer { print "tick"; 4000; } -delay => 4000;
  95
  96 =head1 DESCRIPTION
  97
  98 C<SDL::Timer> provides an abstract interface to the SDL::Timer
  99 callback code.  SDL::Timer::new requires a subroutine and a delay
 100 at which is the initial interval between the creation of the
 101 timer until the first call to the subroutine.  The subroutine
 102 must return a value which is the delay until the it is called again.
 103
 104 =head1 AUTHOR
 105
 106 David J. Goehrig
 107
 108 =head1 SEE ALSO
 109
 110 L<perl> L<SDL>
 111
 112 =pod