1#!/usr/local/bin/perl -w
2
3package POE::Wheel::Curses;
4
5use strict;
6
7use vars qw($VERSION @ISA);
8$VERSION = '1.368'; # NOTE - Should be #.### (three decimal places)
9
10use Carp qw(croak);
11use Curses qw(
12  initscr start_color cbreak raw noecho nonl nodelay timeout keypad
13  intrflush meta typeahead clear refresh
14  endwin COLS
15);
16use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
17use POE qw( Wheel );
18push @ISA, qw(POE::Wheel);
19
20sub SELF_STATE_READ  () { 0 }
21sub SELF_STATE_WRITE () { 1 }
22sub SELF_EVENT_INPUT () { 2 }
23sub SELF_ID          () { 3 }
24
25sub new {
26  my $type = shift;
27  my %params = @_;
28
29  croak "$type needs a working Kernel" unless defined $poe_kernel;
30
31  my $input_event = delete $params{InputEvent};
32  croak "$type requires an InputEvent parameter" unless defined $input_event;
33
34  if (scalar keys %params) {
35    carp( "unknown parameters in $type constructor call: ",
36          join(', ', keys %params)
37        );
38  }
39
40  # Create the object.
41  my $self = bless
42    [ undef,                            # SELF_STATE_READ
43      undef,                            # SELF_STATE_WRITE
44      $input_event,                     # SELF_EVENT_INPUT
45      &POE::Wheel::allocate_wheel_id(), # SELF_ID
46    ];
47
48  # Set up the screen, and enable color, mangle the terminal and
49  # keyboard.
50
51  initscr();
52  start_color();
53
54  cbreak();
55  raw();
56  noecho();
57  nonl();
58
59  # Both of these achieve nonblocking input.
60  nodelay(1);
61  timeout(0);
62
63  keypad(1);
64  intrflush(0);
65  meta(1);
66  typeahead(-1);
67
68  clear();
69  refresh();
70
71  # Define the input event.
72  $self->_define_input_state();
73
74  # Oop! Return ourself.  I forgot to do this.
75  $self;
76}
77
78sub _define_input_state {
79  my $self = shift;
80
81  # Register the select-read handler.
82  if (defined $self->[SELF_EVENT_INPUT]) {
83    # Stupid closure tricks.
84    my $event_input = \$self->[SELF_EVENT_INPUT];
85    my $unique_id   = $self->[SELF_ID];
86
87    $poe_kernel->state
88      ( $self->[SELF_STATE_READ] = ref($self) . "($unique_id) -> select read",
89        sub {
90
91          # Prevents SEGV in older Perls.
92          0 && CRIMSON_SCOPE_HACK('<');
93
94          my ($k, $me) = @_[KERNEL, SESSION];
95
96          # Curses' getch() normally blocks, but we've already
97          # determined that STDIN has something for us.  Be explicit
98          # about which getch() to use.
99          while ((my $keystroke = Curses::getch) ne '-1') {
100            $k->call( $me, $$event_input, $keystroke, $unique_id );
101          }
102        }
103      );
104
105    # Now start reading from it.
106    $poe_kernel->select_read( \*STDIN, $self->[SELF_STATE_READ] );
107
108    # Turn blocking back on for STDIN.  Some Curses implementations
109    # don't deal well with non-blocking STDIN.
110    my $flags = fcntl(STDIN, F_GETFL, 0) or die $!;
111    fcntl(STDIN, F_SETFL, $flags & ~O_NONBLOCK) or die $!;
112  }
113  else {
114    $poe_kernel->select_read( \*STDIN );
115  }
116}
117
118sub DESTROY {
119  my $self = shift;
120
121  # Turn off the select.
122  $poe_kernel->select( \*STDIN );
123
124  # Remove states.
125  if ($self->[SELF_STATE_READ]) {
126    $poe_kernel->state($self->[SELF_STATE_READ]);
127    $self->[SELF_STATE_READ] = undef;
128  }
129
130  # Restore the terminal.
131  endwin if COLS;
132
133  &POE::Wheel::free_wheel_id($self->[SELF_ID]);
134}
135
1361;
137
138__END__
139
140=head1 NAME
141
142POE::Wheel::Curses - non-blocking input for Curses
143
144=head1 SYNOPSIS
145
146  use Curses;
147  use POE qw(Wheel::Curses);
148
149  POE::Session->create(
150    inline_states => {
151      _start => sub {
152        $_[HEAP]{console} = POE::Wheel::Curses->new(
153          InputEvent => 'got_keystroke',
154        );
155      },
156      got_keystroke => sub {
157        my $keystroke = $_[ARG0];
158
159        # Make control and extended keystrokes printable.
160        if ($keystroke lt ' ') {
161          $keystroke = '<' . uc(unctrl($keystroke)) . '>';
162        }
163        elsif ($keystroke =~ /^\d{2,}$/) {
164          $keystroke = '<' . uc(keyname($keystroke)) . '>';
165        }
166
167        # Just display it.
168        addstr($keystroke);
169        noutrefresh();
170        doupdate;
171
172        # Gotta exit somehow.
173        delete $_[HEAP]{console} if $keystroke eq "<^C>";
174      },
175    }
176  );
177
178  POE::Kernel->run();
179  exit;
180
181=head1 DESCRIPTION
182
183POE::Wheel::Curses implements non-blocking input for Curses programs.
184
185POE::Wheel::Curses will emit an "InputEvent" of your choosing whenever
186an input event is registered on a recognized input device (keyboard
187and sometimes mouse, depending on the curses library).  Meanwhile,
188applications can be doing other things like monitoring network
189connections or child processes, or managing timers and stuff.
190
191=head1 PUBLIC METHODS
192
193POE::Wheel::Curses is rather simple.
194
195=head2 new
196
197new() creates a new POE::Wheel::Curses object.  During construction,
198the wheel registers an input watcher for STDIN (via select_read()) and
199registers an internal handler to preprocess keystrokes.
200
201new() accepts only one parameter C<InputEvent>.  C<InputEvent>
202contains the name of the event that the wheel will emit whenever there
203is input on the console or terminal.  As with all wheels, the event
204will be sent to the session that was active when the wheel was
205constructed.
206
207It should be noted that an application may only have one active
208POE::Wheel::Curses object.
209
210=head1 EVENTS AND PARAMETERS
211
212These are the events sent by POE::Wheel::Curses.
213
214=head2 InputEvent
215
216C<InputEvent> defines the event that will be emitted when
217POE::Wheel::Curses detects and reads console input.  This event
218includes two parameters:
219
220C<$_[ARG0]> contains the raw keystroke as received by Curses::getch().
221An application may process the keystroke using Curses::unctrl() and
222Curses::keyname() on the keystroke.
223
224C<$_[ARG1]> contains the POE::Wheel::Curses object's ID.
225
226Mouse events aren't portable.  As of October 2009, it's up to the
227application to decide whether to call mousemask().
228
229=head1 SEE ALSO
230
231L<Curses> documents what can be done with Curses.  Also see the man
232page for whichever version of libcurses happens to be installed
233(curses, ncurses, etc.).
234
235L<POE::Wheel> describes wheels in general.
236
237The SEE ALSO section in L<POE> contains a table of contents covering
238the entire POE distribution.
239
240=head1 BUGS
241
242None known, although curses implementations vary widely.
243
244=head1 AUTHORS & COPYRIGHTS
245
246Please see L<POE> for more information about authors and contributors.
247
248=cut
249
250# rocco // vim: ts=2 sw=2 expandtab
251# TODO - Edit.
252