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 warnings;
  35 use Carp;
  36 use SDL;
  37
  38 sub new {
  39         my $proto = shift;
  40         my $class = ref($proto) || $proto;
  41         my $self = {};
  42         my $func = shift;
  43         my (%options) = @_;
  44
  45         verify(%options,qw/ -delay -times -d -t /);
  46
  47         croak "SDL::Timer::new no delay specified\n"
  48                 unless ($options{-delay});
  49         $$self{-delay} = $options{-delay} || $options{-d} || 0;
  50         $$self{-times} = $options{-times} || $options{-t} || 0;
  51         if ($$self{-times}) {
  52                 $$self{-routine} = sub { &$func($self); $$self{-delay} if(--$$self{-times}) };
  53         } else {
  54                 $$self{-routine} = sub { &$func; $$self{-delay}};
  55         }
  56         $$self{-timer} = SDL::NewTimer($$self{-delay},$$self{-routine});
  57         croak "Could not create timer, ", SDL::GetError(), "\n"
  58                 unless ($self->{-timer});
  59         bless $self,$class;
  60         return $self;
  61 }
  62
  63 sub DESTROY {
  64         my $self = shift;
  65         SDL::RemoveTimer($$self{-timer}) if ($$self{-timer});
  66         $$self{-timer} = 0;
  67 }
  68
  69 sub run {
  70         my ($self,$delay,$times) = @_;
  71         $$self{-delay} = $delay;
  72         $$self{-times} = $times;
  73         SDL::RemoveTimer($$self{-timer}) if ($$self{-timer});
  74         $$self{-timer} = SDL::AddTimer($$self{-delay},SDL::PerlTimerCallback,$$self{-routine});
  75 }
  76
  77 sub stop {
  78         my ($self) = @_;
  79         SDL::RemoveTimer($$self{-timer}) if ($$self{-timer});
  80         $$self{-timer} = 0;
  81 }
  82
  83 1;
  84
  85 __END__;
  86
  87 =pod
  88
  89
  90 =head1 NAME
  91
  92 SDL::Timer - a SDL perl extension to handle timers
  93
  94 =head1 SYNOPSIS
  95
  96   $timer = new SDL::Timer { print "tick"; 4000; } -delay => 4000;
  97
  98 =head1 DESCRIPTION
  99
 100 C<SDL::Timer> provides an abstract interface to the SDL::Timer
 101 callback code.  SDL::Timer::new requires a subroutine and a delay
 102 at which is the initial interval between the creation of the
 103 timer until the first call to the subroutine.  The subroutine
 104 must return a value which is the delay until the it is called again.
 105
 106 =head1 AUTHOR
 107
 108 David J. Goehrig
 109
 110 =head1 SEE ALSO
 111
 112 L<perl> L<SDL>
 113
 114 =pod