lib/Stem/Event/Tk.pm

   1 #  File: Stem/Event/Tk.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::Tk
  30
  31 This module wraps the CPAN module Event.pm for use by the rest of
  32 Stem. It provides the common API for the standard Stem::Event classes:
  33
  34 =over 4
  35
  36 =item Stem::Event
  37 =item Stem::Event::Plain
  38 =item Stem::Event::Timer
  39 =item Stem::Event::Signal
  40 =item Stem::Event::Read
  41 =item Stem::Event::Write
  42
  43 =back
  44
  45 =cut
  46
  47 package Stem::Event::Tk ;
  48
  49 use strict ;
  50 use Tk ;
  51
  52 use Stem::Event::Signal ;
  53
  54 my $tk_main_window ;
  55
  56 # basic wrappers for top level Tk.pm calls.
  57
  58 sub _init_loop {
  59
  60         $tk_main_window ||= MainWindow->new() ;
  61         $tk_main_window->withdraw() ;
  62 }
  63
  64 sub _start_loop {
  65         _init_loop() ;
  66         MainLoop() ;
  67 }
  68
  69 sub _stop_loop {
  70
  71 #print "STOP INFO ", $tk_main_window->afterInfo(), "\n" ;
  72
  73         $tk_main_window->destroy() ;
  74         $tk_main_window = undef ;
  75 }
  76
  77 ############################################################################
  78
  79 package Stem::Event::Plain ;
  80
  81 sub _build {
  82
  83         my( $self ) = @_ ;
  84
  85 # create the plain event watcher
  86
  87         $self->{'idle_event'} = Event->idle(
  88                 'cb'            => [ $self, 'idle_triggered' ],
  89                 'repeat'        => 0
  90         ) ;
  91
  92         return $self ;
  93 }
  94
  95 sub idle_triggered {
  96
  97         my( $self ) = @_ ;
  98
  99         $self->trigger() ;
 100         my $idle_event = delete $self->{'idle_event'} ;
 101         $idle_event->cancel() ;
 102 }
 103
 104 ############################################################################
 105
 106 package Stem::Event::Timer ;
 107
 108 sub _build {
 109
 110         my( $self ) = @_ ;
 111
 112 Stem::Event::Tk::_init_loop() ;
 113
 114 # tk times in milliseconds and stem times in floating seconds so
 115 # we convert to integer ms.
 116
 117         my $delay_ms = int( $self->{'delay'} * 1000 ) ;
 118
 119 #       $self->{interval_ms} = int( ( $self->{'interval'} || 0 ) * 1000 ) ;
 120
 121         my $timer_method = $self->{'interval'} ? 'repeat' : 'after' ;
 122
 123         return $tk_main_window->$timer_method(
 124                                 $delay_ms,
 125                                 [$self => 'timer_triggered']
 126         ) ;
 127 }
 128
 129 sub _reset {
 130
 131         my( $self, $timer_event, $delay ) = @_ ;
 132         my $delay_ms = int( $delay * 1000 ) ;
 133         $timer_event->time( $delay_ms ) ;
 134 }
 135
 136 sub _cancel {
 137         my( $self, $timer_event ) = @_ ;
 138         $timer_event->cancel() ;
 139         return ;
 140 }
 141
 142 ############################################################################
 143
 144 package Stem::Event::Read ;
 145
 146 sub _build {
 147
 148         my( $self ) = @_ ;
 149         goto &_start if $self->{active} ;
 150         return ;
 151 }
 152
 153 sub _start {
 154
 155         my( $self ) = @_ ;
 156
 157         return $tk_main_window->fileevent(
 158                 $self->{'fh'},
 159                 'readable',
 160                 [$self => 'trigger']
 161         ) ;
 162 }
 163
 164 sub _cancel { goto &_stop }
 165
 166 sub _stop {
 167         my( $self ) = @_ ;
 168
 169         $tk_main_window->fileevent(
 170                 $self->{'fh'},
 171                 'readable',
 172                 ''
 173         ) ;
 174 }
 175
 176 ############################################################################
 177
 178 package Stem::Event::Write ;
 179
 180 sub _build {
 181         my( $self ) = @_ ;
 182         goto &_start if $self->{active} ;
 183         return ;
 184 }
 185
 186 sub _start {
 187
 188         my( $self ) = @_ ;
 189
 190         return $tk_main_window->fileevent(
 191                 $self->{'fh'},
 192                 'writable',
 193                 [$self => 'trigger']
 194         ) ;
 195 }
 196
 197 sub _cancel { goto &_stop }
 198
 199 sub _stop {
 200
 201         my( $self ) = @_ ;
 202
 203         $tk_main_window->fileevent(
 204                 $self->{'fh'},
 205                 'writable',
 206                 ''
 207         ) ;
 208 }
 209
 210 1 ;