# File: Stem/Event/Wx.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::Wx This module is a pure Perl event loop. It requires Perl 5.8 (or better) which has safe signal handling. It provides the common event API for the standard classes: =cut package Stem::Event::Wx ; use strict ; use base qw( Stem::Event ) ; use Stem::Event::Perl ; use Wx ; my $app = Stem::Event::Wx::App->new() ; my $wx_timer = Stem::Event::Wx::Timer->new() ; # this will call the io_poll_timer method in $wx_timer's class my $io_poll_timer = Stem::Event::Timer->new( object => $wx_timer, interval => 1, # .1 second poll method => 'io_poll_timer', ) ; sub _start_loop { # _build just sets the min delay for the wx timer. this will make sure # any timer events get going when we start the loop. Stem::Event::Timer::_build() ; Wx::wxTheApp->MainLoop() ; } sub _stop_loop { Wx::wxTheApp->ExitMainLoop() ; } package Stem::Event::Timer ; sub _build { my $min_delay = Stem::Event::Perl::find_min_delay() ; $wx_timer->set_wx_timer_delay( $min_delay ) ; return ; } ############################################################################ # this class subclasses Wx::Timer and its Notify method will be called # after the current delay. package Stem::Event::Wx::Timer ; use base qw( Wx::Timer ) ; BEGIN { unless ( eval { require Time::HiRes } ) { Time::HiRes->import( qw( time ) ) ; } } my $last_time ; sub set_wx_timer_delay { my( $self, $delay ) = @_ ; #print "WX DELAY [$delay]\n" ; if ( $delay ) { $self->Start( int( $delay * 1000 ), 0 ); $last_time = time() ; return ; } $self->Stop(); } # Wx calls this method when its timers get triggered. this is the only # wx timer callback in this wrapper. all the others are handled with # perl in Event.pm and Event/Perl.pm sub Notify { #print "NOTIFY\n" ; my $delta_time = time() - $last_time ; my $min_delay = Stem::Event::Perl::find_min_delay() ; $wx_timer->set_wx_timer_delay( $min_delay ) ; Stem::Event::Perl::trigger_timer_events( $delta_time ) ; } sub io_poll_timer { #print "IO POLL\n" ; Stem::Event::Perl::_one_time_loop() ; } ############################################################################ # this class is needed to subclass Wx::App and to make our own # WxApp. it needs to provide OnInit which is called at startup and has # to return true. package Stem::Event::Wx::App ; use base 'Wx::App' ; sub OnInit { return( 1 ) } 1 ; __END__