# File: Stem/Event/Tk.pm
# This file is part of Stem.
# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
# Stem is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# Stem is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with Stem; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
# For a license to use the Stem under conditions other than those
# described here, to purchase support for this software, or to purchase a
# commercial warranty contract, please contact Stem Systems at:
# Stem Systems, Inc. 781-643-7504
# 79 Everett St. info@stemsystems.com
# Arlington, MA 02474
# USA
=head1 Stem::Event::Tk
This module wraps the CPAN module Event.pm for use by the rest of
Stem. It provides the common API for the standard Stem::Event classes:
=over 4
=item Stem::Event
=item Stem::Event::Plain
=item Stem::Event::Timer
=item Stem::Event::Signal
=item Stem::Event::Read
=item Stem::Event::Write
=back
=cut
package Stem::Event::Tk ;
use strict ;
use Tk ;
use Stem::Event::Signal ;
my $tk_main_window ;
# basic wrappers for top level Tk.pm calls.
sub _init_loop {
$tk_main_window ||= MainWindow->new() ;
$tk_main_window->withdraw() ;
}
sub _start_loop {
_init_loop() ;
MainLoop() ;
}
sub _stop_loop {
#print "STOP INFO ", $tk_main_window->afterInfo(), "\n" ;
$tk_main_window->destroy() ;
$tk_main_window = undef ;
}
############################################################################
package Stem::Event::Plain ;
sub _build {
my( $self ) = @_ ;
# create the plain event watcher
$self->{'idle_event'} = Event->idle(
'cb' => [ $self, 'idle_triggered' ],
'repeat' => 0
) ;
return $self ;
}
sub idle_triggered {
my( $self ) = @_ ;
$self->trigger() ;
my $idle_event = delete $self->{'idle_event'} ;
$idle_event->cancel() ;
}
############################################################################
package Stem::Event::Timer ;
sub _build {
my( $self ) = @_ ;
Stem::Event::Tk::_init_loop() ;
# tk times in milliseconds and stem times in floating seconds so
# we convert to integer ms.
my $delay_ms = int( $self->{'delay'} * 1000 ) ;
# $self->{interval_ms} = int( ( $self->{'interval'} || 0 ) * 1000 ) ;
my $timer_method = $self->{'interval'} ? 'repeat' : 'after' ;
return $tk_main_window->$timer_method(
$delay_ms,
[$self => 'timer_triggered']
) ;
}
sub _reset {
my( $self, $timer_event, $delay ) = @_ ;
my $delay_ms = int( $delay * 1000 ) ;
$timer_event->time( $delay_ms ) ;
}
sub _cancel {
my( $self, $timer_event ) = @_ ;
$timer_event->cancel() ;
return ;
}
############################################################################
package Stem::Event::Read ;
sub _build {
my( $self ) = @_ ;
goto &_start if $self->{active} ;
return ;
}
sub _start {
my( $self ) = @_ ;
return $tk_main_window->fileevent(
$self->{'fh'},
'readable',
[$self => 'trigger']
) ;
}
sub _cancel { goto &_stop }
sub _stop {
my( $self ) = @_ ;
$tk_main_window->fileevent(
$self->{'fh'},
'readable',
''
) ;
}
############################################################################
package Stem::Event::Write ;
sub _build {
my( $self ) = @_ ;
goto &_start if $self->{active} ;
return ;
}
sub _start {
my( $self ) = @_ ;
return $tk_main_window->fileevent(
$self->{'fh'},
'writable',
[$self => 'trigger']
) ;
}
sub _cancel { goto &_stop }
sub _stop {
my( $self ) = @_ ;
$tk_main_window->fileevent(
$self->{'fh'},
'writable',
''
) ;
}
1 ;