lib/Stem/Event/Wx.pm

   1 #  File: Stem/Event/Wx.pm
   2
   3 #  This file is part of Stem.
   4 #  Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
   5
   6 #  Stem is free software; you can redistribute it and/or modify
   7 #  it under the terms of the GNU General Public License as published by
   8 #  the Free Software Foundation; either version 2 of the License, or
   9 #  (at your option) any later version.
  10
  11 #  Stem is distributed in the hope that it will be useful,
  12 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 #  GNU General Public License for more details.
  15
  16 #  You should have received a copy of the GNU General Public License
  17 #  along with Stem; if not, write to the Free Software
  18 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19
  20 #  For a license to use the Stem under conditions other than those
  21 #  described here, to purchase support for this software, or to purchase a
  22 #  commercial warranty contract, please contact Stem Systems at:
  23
  24 #       Stem Systems, Inc.              781-643-7504
  25 #       79 Everett St.                  info@stemsystems.com
  26 #       Arlington, MA 02474
  27 #       USA
  28
  29 =head1 Stem::Event::Wx
  30
  31 This module is a pure Perl event loop. It requires Perl 5.8 (or
  32 better) which has safe signal handling.  It provides the common event
  33 API for the standard classes:
  34
  35 =cut
  36
  37 package Stem::Event::Wx ;
  38
  39 use strict ;
  40
  41 use base qw( Stem::Event ) ;
  42 use Stem::Event::Perl ;
  43 use Wx ;
  44
  45 my $app = Stem::Event::Wx::App->new() ;
  46 my $wx_timer = Stem::Event::Wx::Timer->new() ;
  47
  48 # this will call the io_poll_timer method in $wx_timer's class
  49
  50 my $io_poll_timer = Stem::Event::Timer->new(
  51         object          => $wx_timer,
  52         interval        => 1,                   # .1 second poll
  53         method          => 'io_poll_timer',
  54 ) ;
  55
  56 sub _start_loop {
  57
  58 # _build just sets the min delay for the wx timer. this will make sure
  59 # any timer events get going when we start the loop.
  60
  61         Stem::Event::Timer::_build() ;
  62         Wx::wxTheApp->MainLoop() ;
  63 }
  64
  65 sub _stop_loop {
  66
  67         Wx::wxTheApp->ExitMainLoop() ;
  68 }
  69
  70
  71 package Stem::Event::Timer ;
  72
  73 sub _build {
  74
  75         my $min_delay = Stem::Event::Perl::find_min_delay() ;
  76         $wx_timer->set_wx_timer_delay( $min_delay ) ;
  77         return ;
  78 }
  79
  80 ############################################################################
  81
  82 # this class subclasses Wx::Timer and its Notify method will be called
  83 # after the current delay.
  84
  85 package Stem::Event::Wx::Timer ;
  86
  87 use base qw( Wx::Timer ) ;
  88
  89 BEGIN {
  90
  91         unless ( eval { require Time::HiRes } ) {
  92
  93                 Time::HiRes->import( qw( time ) ) ;
  94         }
  95 }
  96
  97 my $last_time ;
  98
  99 sub set_wx_timer_delay {
 100
 101         my( $self, $delay ) = @_ ;
 102
 103 #print "WX DELAY [$delay]\n" ;
 104         if ( $delay ) {
 105
 106                 $self->Start( int( $delay * 1000 ), 0 );
 107                 $last_time = time() ;
 108                 return ;
 109         }
 110
 111         $self->Stop();
 112 }
 113
 114 # Wx calls this method when its timers get triggered. this is the only
 115 # wx timer callback in this wrapper. all the others are handled with
 116 # perl in Event.pm and Event/Perl.pm
 117
 118 sub Notify {
 119
 120 #print "NOTIFY\n" ;
 121         my $delta_time = time() - $last_time ;
 122         my $min_delay = Stem::Event::Perl::find_min_delay() ;
 123         $wx_timer->set_wx_timer_delay( $min_delay ) ;
 124         Stem::Event::Perl::trigger_timer_events( $delta_time ) ;
 125 }
 126
 127 sub io_poll_timer {
 128
 129 #print "IO POLL\n" ;
 130
 131         Stem::Event::Perl::_one_time_loop() ;
 132 }
 133
 134
 135 ############################################################################
 136
 137 # this class is needed to subclass Wx::App and to make our own
 138 # WxApp. it needs to provide OnInit which is called at startup and has
 139 # to return true.
 140
 141 package Stem::Event::Wx::App ;
 142
 143 use base 'Wx::App' ;
 144 sub OnInit { return( 1 ) }
 145
 146 1 ;
 147
 148 __END__