cursor results from the CPAN

Curses-UI


Create a new Curses::UI object:

    my $cui = Curses::UI->new( OPTIONS );

where C<OPTIONS> is one or more of the following.

=head2 -clear_on_exit

If true, Curses::UI will call C<clear> on exit. Defaults to false.

=head2 -color_support

If true, Curses::UI tries to enable color for the
application. Defaults to false.

=head2 -compat

If true, Curses::UI will run in compatibility mode, meaning that only
very simple characters will be used for creating the widgets. Defaults
to false.

=head2 -keydelay

If set to a positive integer, Curses::UI will track elapsed seconds
since the user's last keystroke, preventing timer events from
occurring for the specified number of seconds afterwards. By default
this option is set to '0' (disabled).

=head2 -mouse_support

Curses::UI attempts to auto-discover if mouse support should be
enabled or not. This option allows a hard override. Expects a boolean
value.

=head2 -userdata

Takes a scalar (frequently a hashref) as its argument, and stows that
scalar inside the Curses::UI object where it can be retrieved with the
L<#userdata> method. Handy inside callbacks and the like.

=head2 -default_colors

Directs the underlying Curses library to allow use of default color
pairs on terminals. Is preset to true and you almost certainly don't
want to twiddle it. See C<man use_default_colors> if you think you do.

=cut

sub new {
    my ($class,%userargs) = @_;

    fatalerror("Curses::UI->new can only be called once!")
      if $Curses::UI::initialized;

    &Curses::UI::Common::keys_to_lowercase(\%userargs);

    my %args = (
        -compat        => 0,     # Use compatibility mode?
        -clear_on_exit => 0,     # Clear screen if program exits?
        -cursor_mode   => 0,     # What is the current cursor_mode?
	-debug         => undef, # Turn on debugging mode?
	-keydelay      => 0,     # Track seconds since last keystroke?
	-language      => undef, # Which language to use?
	-mouse_support => 1,     # Do we want mouse support
	-overlapping   => 1,     # Whether overlapping widgets are supported
	-color_support => 0,
	-default_colors=> 1,
        #user data
        -userdata       => undef,    #user internal data
	%userargs,
	-read_timeout   => -1,    # full blocking read by default
	-scheduled_code => [],
	-added_code     => {},
        -lastkey        => 0,     # Last keypress time (set in mainloop)
    );

    $Curses::UI::debug = $args{-debug}
        if defined $args{-debug};

    $Curses::UI::ncurses_mouse = $args{-mouse_support}
        if defined $args{-mouse_support};

    if ($Curses::UI::gpm_mouse && $args{-mouse_support}) {
	$Curses::UI::ncurses_mouse = 1;
	$args{-read_timeout} = 0.25;
    } else {
	$Curses::UI::gpm_mouse = 0;
    }

    my $self = bless { %args }, $class;

    my $lang = new Curses::UI::Language($self->{-language});
    $self->lang($lang);
    print STDERR "DEBUG: Loaded language: $lang->{-lang}\n"
	if $Curses::UI::debug;

    # Color support
    $Curses::UI::color_support = $args{-color_support} if
	defined $args{-color_support};

    $self->layout();

    return $self;
}

DESTROY {
    my $self = shift;
    my $scr = $self->{-canvasscr};
    $scr->delwin() if (defined($scr));
    endwin();
    $Curses::UI::initialized = 0;

    if ($self->{-clear_on_exit})
      {	Curses::erase(); Curses::clear() }
}



=head1 EVENT HANDLING METHODS

lib/Curses/UI.pm view on Meta::CPAN

    # Curses::UI widget, regarding size, location and
    # drawing area. This will make it possible for
    # child windows / widgets to layout and draw themselves.
    $self->{-width}  = $self->{-w} = $self->{-bw} = $cols;
    $self->{-height} = $self->{-h} = $self->{-bh} = $lines;
    $self->{-x}      = $self->{-y} = 0;
    $self->{-canvasscr} = $root;

    # Walk through all contained objects and let them
    # layout themselves.
    $self->layout_contained_objects;
    $self->draw();

    $Curses::UI::initialized = 1;
    return $self;
}

sub layout_new()
{
    my $self = shift;

    $Curses::UI::screen_too_small = 0;

    # find the terminal size.
    my ($cols,$lines) = GetTerminalSize;
    $ENV{COLS}  = $cols;
    $ENV{LINES} = $lines;

    # Let this object present itself as a standard 
    # Curses::UI widget, regarding size, location and
    # drawing area. This will make it possible for
    # child windows / widgets to layout and draw themselves.
    #
    $self->{-width}  = $self->{-w} = $self->{-bw} = $cols;
    $self->{-height} = $self->{-h} = $self->{-bh} = $lines;
    $self->{-x}      = $self->{-y} = 0;
#    $self->{-canvasscr} = $root;

    # Walk through all contained objects and let them
    # layout themselves.
    $self->layout_contained_objects;

    $Curses::UI::initialized = 1;
    $self->draw();
    return $self;
}


# ----------------------------------------------------------------------
# Event handling
# ----------------------------------------------------------------------


# TODO: document
sub do_one_event(;$)
{
    my $self = shift;
    my $object = shift;
    $object = $self unless defined $object;

    eval {curs_set($self->{-cursor_mode})};

    # gpm mouse?
    if ($Curses::UI::gpm_mouse) {
	$self->handle_gpm_mouse_event($object);
	doupdate();
    }

    # Read a key or use the feeded key.
    my $key = $self->{-feedkey};
    unless (defined $key) {
        $key = $self->get_key($self->{-read_timeout});
    }
    $self->{-feedkey} = undef;

    # If there was a keypress, set -lastkey
    $self->{-lastkey} = time() unless ($key eq '-1');

    # ncurses sends KEY_RESIZE() key on resize. Ignore this key.
    # TODO: Try to redraw and layout everything anew
    # KEY_RESIZE doesn't seem to work right;
    if (Curses->can("KEY_RESIZE")) {
      eval { $key = '-1' if $key eq KEY_RESIZE(); };
    }
    my ($cols,$lines) = GetTerminalSize;
    if ( ($ENV{COLS} != $cols) || ( $ENV{LINES} != $lines )) {
	$self->layout();
	$self->draw;
    }

    # ncurses sends KEY_MOUSE()
    if ($Curses::UI::ncurses_mouse) {
	if ($key eq KEY_MOUSE()) {
	    print STDERR "DEBUG: Got a KEY_MOUSE(), handeling it\n"
		if $Curses::UI::debug;
	    $self->handle_mouse_event($object);
	    doupdate();
	    return $self;
	}
    }

    # If the screen is too small, then <CTRL+C> will exit.
    # Else the next event loop will be started.
    if ($Curses::UI::screen_too_small) {
	exit(1) if $key eq "\cC";
	return $self;
    }

    # Delegate the keypress. This is not done to $self,
    # but to $object, so all events will go to the
    # object that called do_one_event(). This is used to
    # enable modal focusing.
    $object->event_keypress($key) unless $key eq '-1';

    # Execute timer code
    $self->do_timer;

    # Execute one scheduled event;
    if (@{$self->{-scheduled_code}}) {
	my $code = shift @{$self->{-scheduled_code}};
	$code->($self);

lib/Curses/UI.pm view on Meta::CPAN

    my ($self,$id) = @_;
    if (defined $self->{-timers}->{$id}) {
        $self->{-timers}->{$id}->{-enabled} = 0;
    }
    $self->set_read_timeout;
    return $self;
}

sub enable_timer($;)
{
    my ($self,$id) = @_;
    if (defined $self->{-timers}->{$id}) {
        $self->{-timers}->{$id}->{-enabled} = 1;
    }
    $self->set_read_timeout;
    return $self;
}

sub delete_timer($;)
{
    my ($self,$id) = @_;
    if (defined $self->{-timers}->{$id}) {
        delete $self->{-timers}->{$id};
    }
    $self->set_read_timeout;
    return $self;
}

sub do_timer()
{
    my $self = shift;

    my $now = time();
    my $timers_done = 0;

    # Short-circuit timers if the keydelay hasn't elapsed
    if ($self->{-keydelay}) {
        return $self unless $self->keydelay;
    }

    TIMER: while (my ($id, $config) = each %{$self->{-timers}}) 
    {
        # Skip timer if it is disabled.
        next TIMER unless $config->{-enabled};

        # No -lastrun set? Then do it now.
        unless (defined $config->{-lastrun})
        {
            $config->{-lastrun} = $now; 
            next TIMER;
        }

        if ($config->{-lastrun} <= ($now - $config->{-time})) 
        {
            $config->{-callback}->($self);
            $config->{-lastrun} = $now;
            $timers_done++;
        }
    }

    # Bring the cursor back to the focused object by
    # redrawing it. Due to drawing other objects, it might
    # have moved to another widget or screen location.
    #
    $self->focus_path(-1)->draw if $timers_done;

    return $self;
}

# ----------------------------------------------------------------------
# Mouse events
# ----------------------------------------------------------------------

sub handle_mouse_event()
{
    my $self = shift;
    my $object = shift;
    $object = $self unless defined $object;

    my $MEVENT = 0;
    getmouse($MEVENT);

    # $MEVENT is a struct. From curses.h (note: this might change!):
    #
    # typedef struct
    # {
    #    short id;           /* ID to distinguish multiple devices */
    #	 int x, y, z;        /* event coordinates (character-cell) */
    #	 mmask_t bstate;     /* button state bits */
    # } MEVENT;
    #
    # ---------------
    # s signed short
    # x null byte
    # x null byte
    # ---------------
    # i integer
    # ---------------
    # i integer
    # ---------------
    # i integer
    # ---------------
    # l long
    # ---------------

    my ($id, $x, $y, $z, $bstate) = unpack("sx2i3l", $MEVENT);
    my %MEVENT = (
	-id     => $id,
	-x      => $x,
	-y      => $y,
        -bstate => $bstate,
    );

    # Get the objects at the mouse event position.
    my $tree = $self->object_at_xy($object, $MEVENT{-x}, $MEVENT{-y});

    # Walk through the object tree, top object first.
    foreach my $object (reverse @$tree)
    {
	# Send the mouse-event to the object. 
	# Leave the loop if the object handled the event.

lib/Curses/UI.pm view on Meta::CPAN

    # if a key is pressed on my Solaris machine. Flushing
    # the input keys solves this. And this is not a bad
    # thing to do during a progress dialog (input is ignored
    # this way).
    $self->flushkeys;

    my $p = $self->getobj("__progress_$self");
    return unless defined $p;
    $p->pos($pos) if defined $pos;
    $p->message($message) if defined $message;
    $p->draw;

    return $self;
}

sub noprogress()
{
    my $self = shift;
    $self->delete("__progress_$self");
    $self->flushkeys;
    $self->draw;
    return $self;
}

sub leave_curses()
{
    my $self = shift;
    def_prog_mode();
    endwin();
}

sub reset_curses()
{
    my $self = shift;
    reset_prog_mode();
    $self->layout(); # In case the terminal has been resized
}

### Color support

sub color() {
    my $self = shift;
    return $Curses::UI::color_object;
}

sub set_color {
    my $self = shift;
    my $co   = shift;

    $Curses::UI::color_object = $co;
}



# ----------------------------------------------------------------------
# Accessor functions
# ----------------------------------------------------------------------

sub compat(;$)        { shift()->accessor('-compat',          shift()) }
sub clear_on_exit(;$) { shift()->accessor('-clear_on_exit',   shift()) }
sub cursor_mode(;$)   { shift()->accessor('-cursor_mode',     shift()) }
sub lang(;$)          { shift()->accessor('-language_object', shift()) }
sub overlapping(;$)   { shift()->accessor('-overlapping',     shift()) }

# TODO: document
sub debug(;$)
{
    my $self  = shift;
    my $value = shift;
    $Curses::UI::debug = $self->accessor('-debug', $value);
}






=head1 CONVENIENCE DIALOG METHODS

=head2 dialog

Use the C<dialog> method to show a dialog window. If you only provide
a single argument, this argument will be used as the message to
show. Example:

    $cui->dialog("Hello, world!");

If you want to have some more control over the dialog window, you will
have to provide more arguments (for an explanation of the arguments
that can be used, see L<Curses::UI::Dialog::Basic>.  Example:

    my $yes = $cui->dialog(
        -message => "Hello, world?",
        -buttons =3D> ['yes','no'],
        -values  => [1,0],
        -title   => 'Question',
    );

    if ($yes) {
        # whatever
    }


=head2 error

The C<error> method will create an error dialog. This is basically a
Curses::UI::Dialog::Basic, but it has an ASCII-art exclamation sign
drawn left to the message. For the rest it's just like
C<dialog>. Example:

    $cui->error("It's the end of the\n"
               ."world as we know it!");

=head2 filebrowser

Creates a file browser dialog. For an explanation of the arguments
that can be used, see L<Curses::UI::Dialog::Filebrowser>.  Example:

    my $file = $cui->filebrowser(
        -path => "/tmp",
        -show_hidden => 1,

( run in 2.983 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )