home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Curses.pm < prev    next >
Encoding:
Perl POD Document  |  2003-11-21  |  6.4 KB  |  250 lines
  1. #!/usr/bin/perl -w
  2.  
  3. package POE::Wheel::Curses;
  4.  
  5. use strict;
  6.  
  7. use vars qw($VERSION);
  8. $VERSION = do {my@r=(q$Revision: 1.11 $=~/\d+/g);sprintf"%d."."%04d"x$#r,@r};
  9.  
  10. use Carp qw(croak);
  11. use Curses;
  12. use POSIX qw(fcntl_h);
  13. use POE qw(Wheel);
  14.  
  15.  
  16. sub SELF_STATE_READ  () { 0 }
  17. sub SELF_STATE_WRITE () { 1 }
  18. sub SELF_EVENT_INPUT () { 2 }
  19. sub SELF_ID          () { 3 }
  20.  
  21. sub new {
  22.   my $type = shift;
  23.   my %params = @_;
  24.  
  25.   croak "$type needs a working Kernel" unless defined $poe_kernel;
  26.  
  27.   my $input_event = delete $params{InputEvent};
  28.   croak "$type requires an InputEvent parameter" unless defined $input_event;
  29.  
  30.   if (scalar keys %params) {
  31.     carp( "unknown parameters in $type constructor call: ",
  32.           join(', ', keys %params)
  33.         );
  34.   }
  35.  
  36.   # Create the object.
  37.   my $self = bless
  38.     [ undef,                            # SELF_STATE_READ
  39.       undef,                            # SELF_STATE_WRITE
  40.       $input_event,                     # SELF_EVENT_INPUT
  41.       &POE::Wheel::allocate_wheel_id(), # SELF_ID
  42.     ];
  43.  
  44.   # Set up the screen, and enable color, mangle the terminal and
  45.   # keyboard.
  46.  
  47.   initscr();
  48.   start_color();
  49.  
  50.   cbreak();
  51.   raw();
  52.   noecho();
  53.   nonl();
  54.  
  55.   # Both of these achieve nonblocking input.
  56.   nodelay(1);
  57.   timeout(0);
  58.  
  59.   keypad(1);
  60.   intrflush(0);
  61.   meta(1);
  62.   typeahead(-1);
  63.  
  64.   my $old_mouse_events = 0;
  65.   mousemask(ALL_MOUSE_EVENTS, $old_mouse_events);
  66.  
  67.   clear();
  68.   refresh();
  69.  
  70.   # Define the input event.
  71.   $self->_define_input_state();
  72.  
  73.   # Oop! Return ourself.  I forgot to do this.
  74.   $self;
  75. }
  76.  
  77. sub _define_input_state {
  78.   my $self = shift;
  79.  
  80.   # Register the select-read handler.
  81.   if (defined $self->[SELF_EVENT_INPUT]) {
  82.     # Stupid closure tricks.
  83.     my $event_input = \$self->[SELF_EVENT_INPUT];
  84.     my $unique_id   = $self->[SELF_ID];
  85.  
  86.     $poe_kernel->state
  87.       ( $self->[SELF_STATE_READ] = ref($self) . "($unique_id) -> select read",
  88.         sub {
  89.  
  90.           # Prevents SEGV in older Perls.
  91.           0 && CRIMSON_SCOPE_HACK('<');
  92.  
  93.           my ($k, $me) = @_[KERNEL, SESSION];
  94.  
  95.           # Curses' getch() normally blocks, but we've already
  96.           # determined that STDIN has something for us.  Be explicit
  97.           # about which getch() to use.
  98.           while ((my $keystroke = Curses::getch) ne '-1') {
  99.             $k->call( $me, $$event_input, $keystroke, $unique_id );
  100.           }
  101.         }
  102.       );
  103.  
  104.     # Now start reading from it.
  105.     $poe_kernel->select_read( \*STDIN, $self->[SELF_STATE_READ] );
  106.  
  107.     # Turn blocking back on for STDIN.  Some Curses implementations
  108.     # don't deal well with non-blocking STDIN.
  109.     my $flags = fcntl(STDIN, F_GETFL, 0) or die $!;
  110.     fcntl(STDIN, F_SETFL, $flags & ~O_NONBLOCK) or die $!;
  111.   }
  112.   else {
  113.     $poe_kernel->select_read( \*STDIN );
  114.   }
  115. }
  116.  
  117. sub DESTROY {
  118.   my $self = shift;
  119.  
  120.   # Turn off the select.
  121.   $poe_kernel->select( \*STDIN );
  122.  
  123.   # Remove states.
  124.   if ($self->[SELF_STATE_READ]) {
  125.     $poe_kernel->state($self->[SELF_STATE_READ]);
  126.     $self->[SELF_STATE_READ] = undef;
  127.   }
  128.  
  129.   # Restore the terminal.
  130.   endwin if COLS;
  131.  
  132.   &POE::Wheel::free_wheel_id($self->[SELF_ID]);
  133. }
  134.  
  135. ###############################################################################
  136. 1;
  137.  
  138. __END__
  139.  
  140. =head1 NAME
  141.  
  142. POE::Wheel::Curses - non-blocking Curses.pm input for full-screen console apps
  143.  
  144. =head1 SYNOPSIS
  145.  
  146.   use POE;
  147.   use Curses;  # for unctrl, etc
  148.   use POE::Wheel::Curses;
  149.  
  150.   # Generate events from console input.  Sets up Curses, too.
  151.   $heap->{console} = POE::Wheel::Curses->new(
  152.     InputEvent => 'got_keystroke',
  153.   );
  154.  
  155.   # A keystroke handler.  This is the body of the program's main input
  156.   # loop.
  157.   sub keystroke_handler {
  158.     my ($keystroke, $wheel_id) = @_[ARG0, ARG1];
  159.  
  160.     # Control characters.  Change them into something printable via
  161.     # Curses' unctrl function.
  162.  
  163.     if ($keystroke lt ' ') {
  164.       $keystroke = '<' . uc(unctrl($keystroke)) . '>';
  165.     }
  166.  
  167.     # Extended keys get translated into their names via Curses'
  168.     # keyname function.
  169.  
  170.     elsif ($keystroke =~ /^\d{2,}$/) {
  171.       $keystroke = '<' . uc(keyname($keystroke)) . '>';
  172.     }
  173.  
  174.     # Just display it.
  175.     addstr( $heap->{some_window}, $keystroke );
  176.     noutrefresh( $heap->{some_window} );
  177.     doupdate;
  178.   }
  179.  
  180. =head1 DESCRIPTION
  181.  
  182. Many console programs work best with full-screen input: top, systat,
  183. nethack, and various text editors.  POE::Wheel::Curses provides a
  184. simple way to add full-screen interfaces to POE programs.
  185.  
  186. Whenever something occurs on a recognized input device-- usually just
  187. the keyboard, but also sometimes the mouse, as in the case of
  188. ncurses-- the Curses wheel will emit a predetermined event to tell the
  189. program about it.  This lets the program do other non-blocking things
  190. in between keystrokes, like interact on sockets or watch log files or
  191. move monsters or highlight text or something.
  192.  
  193. =head1 PUBLIC METHODS
  194.  
  195. =over 2
  196.  
  197. =item new NOT_SO_MANY_THINGS
  198.  
  199. new() creates a new Curses wheel.  Note, though, that there can be
  200. only one Curses wheel in any given program, since they glom onto
  201. *STDIN real hard.  Maybe this will change.
  202.  
  203. new() always returns a Curses wheel reference, even if there is a
  204. problem glomming onto *STDIN or otherwise initializing curses.
  205.  
  206. new() accepts only one parameter so far: InputEvent.  InputEvent
  207. contains the name of the event that the Curses wheel will emit
  208. whenever there is input on the console or terminal.
  209.  
  210. =back
  211.  
  212. =head1 EVENTS AND PARAMETERS
  213.  
  214. =over 2
  215.  
  216. =item InputEvent
  217.  
  218. InputEvent defines the event that will be emitted when the Curses
  219. wheel detects and receives input.
  220.  
  221. InputEvent is accompanied by two parameters:
  222.  
  223. C<ARG0> contains the raw keystroke as received by Curses' getch()
  224. function.  It may be passed to Curses' unctrl() and keyname()
  225. functions for further processing.
  226.  
  227. C<ARG1> contains the ID of the Curses wheel.
  228.  
  229. =back
  230.  
  231. =head1 SEE ALSO
  232.  
  233. curses, Curses, POE::Wheel.
  234.  
  235. The SEE ALSO section in L<POE> contains a table of contents covering
  236. the entire POE distribution.
  237.  
  238. =head1 BUGS
  239.  
  240. Curses implementations vary widely, and Wheel::Curses was written on a
  241. system sporting ncurses.  The functions used may not be the same as
  242. those used on systems with other curses implementations, and Bad
  243. Things might happen.  Please send patches.
  244.  
  245. =head1 AUTHORS & COPYRIGHTS
  246.  
  247. Please see L<POE> for more information about authors and contributors.
  248.  
  249. =cut
  250.