Commit | Line | Data |
4536f655 |
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 ; |