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