File Coverage

blib/lib/Curses/Application.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

# Curses::Application.pm -- Curses Application Framework
#
# (c) 2001, Arthur Corliss
#
# $Id: Application.pm,v 0.2 2002/11/14 19:40:42 corliss Exp corliss $
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#####################################################################

=head1 NAME

Curses::Application - Curses Application Framework

=head1 MODULE VERSION

$Id: Application.pm,v 0.2 2002/11/14 19:40:42 corliss Exp corliss $

=head1 SYNOPSIS

  use Curses::Application;

  $app = Curses::Application->new({
      FOREGROUND  => 'white',
      BACKGROUND  => 'blue',
      TITLEBAR    => 1,
      STATUSBAR   => 1,
      CAPTION     => 'My Application',
      MAINFORM    => { name => defname },
      MINY        => 20,
      MINX        => 60,
      ALTFBASE    => 'MyCompany::Forms',
      ALTBASE     => 'MyCompany::Widgets',
    });

  ($y, $x) = $app->maxyx;
  $mwh = $app->mwh;

  $app->titlebar($caption);
  $app->statusbar($message);

  $app->draw;
  $app->redraw;

  $app->addFormDef('MyForm', { %formopts });
  $app->createForm($name, $def);
  $form = $app->getForm('MainFrm');
  $app->delForm('Main');
  $app->execForm('Main');

  $app->execute;

=head1 REQUIREMENTS

Curses
Curses::Widgets
Curses::Forms

=head1 DESCRIPTION

Curses::Application attempts to relieve the programmer of having to deal
directly with Curses at all.  Based upon Curses::Widgets and Curses::Forms,
all one should have to do is define the application forms and contents in the
DATA block of a script.  Curses::Application will take care of the rest.

=cut

#####################################################################
#
# Environment definitions
#
#####################################################################

package Curses::Application;

use strict;
use vars qw($VERSION @ISA @EXPORT);
use Exporter;
use Carp;
use Curses;
use Curses::Widgets;
use Curses::Forms;
use Curses::Forms::Dialog;
use Curses::Forms::Dialog::Input;
use Curses::Forms::Dialog::Logon;

($VERSION) = (q$Revision: 0.2 $ =~ /(\d+(?:\.(\d+))+)/);

@ISA = qw(Curses::Widgets);
@EXPORT = qw(dialog input logon BTN_OK BTN_YES BTN_NO BTN_CANCEL
  BTN_HELP scankey);

my @events = qw(OnEnter OnExit);
my @colitems = qw(FOREGROUND BACKGROUND BORDERCOL CAPTIONCOL);

#####################################################################
#
# Module code follows
#
#####################################################################

=head1 INTRODUCTION

This module follows many of the conventions established by the Curses::Widgets
and Curses::Forms modules, being built upon that framework.  One area of
special note, however, is the declaration of forms used within the
application.

B differentiates between forms and form definitions.
A form is an instance of any particular form definition.  Keeping that line of
separation simplifies the development of MDI (Multiple Document Interface)
applications.

Form definitions can be provided in two ways:  as a list of definitions in the
main::DATA block, or individually by using the B method.  The
former would normally be the simplest way to do so.

At the end of your script, declare a DATA block using Perl's B<__DATA__>
token.  In that DATA block place a hash declaration (%forms) which contains
a key/value pair for each form definition.  The key being the name of the
definition, and the value being a hash reference to the form declarations
(see the B pod for directives available to that module).  The
only extra key that should be in each form's hash reference should be a
B directive, which would point to a module name relative to the base
Curses::Forms class.  If you omit this key, then it will be assumed that the
form is a Curses::Forms object, or some custom derivative as specified in
B.

  Example:
  ========

  __DATA__

  %forms = (
    Main    => {
      TYPE      => 'Custom',
      ALTBASE   => 'MyCompany::Forms',
      LINES     => 10,
      COLUMNS   => 80,
      DERIVED   => 0,
      WIDGETS   => {
        ...
        },
      ...
      },
    );

Just as Curses::Forms allows you to use custom derivatives of Curses::Widgets,
this module also allows you to use custom derivatives of Curses::Forms using
the B directive.  Similarly, the OnEnter and OnExit events are also
supported on per-form basis.  Instead of passing the form reference as an
argument to the call it passes the application object reference.

B:  The main form (as declared with B) will always be a
derived form and the size of the screen minus any title or status bars used.
This is overridden in the object constructor, so expect those options to be
set as such.

=head1 FUNCTIONS

This module exports the functions and constants provided by
Curses::Forms::Dialog and child modules:

  Functions
  ---------
  dialog, input, logon, scankey

  Constants
  ---------
  BTN_OK, BTN_YES, BTN_NO, BTN_CANCEL, BTN_HELP

This should provide all of the functionality needed within your main
application code.  The intent of this module is to prevent you from having to
know and/or use the entire Curses family of modules directly.  The only thing
you will need to be aware of is the appropriate configuration syntax for both
forms and widgets.

If you need access to the B, etc., functions, you'll need to add:

  use Curses::Forms;

to your main script body, and they'll be imported directly.

=head1 METHODS

=head2 new

  $app = Curses::Application->new({
      FOREGROUND  => 'white',
      BACKGROUND  => 'blue',
      TITLEBAR    => 1,
      STATUSBAR   => 1,
      CAPTION     => 'My Application',
      MAINFORM    => { name => defname },
      MINY        => 20,
      MINX        => 60,
      ALTFBASE    => 'MyCompany::Forms',
      ALTBASE     => 'MyCompany::Widgets',
    });

The B class method returns a Curses::Application object. All
arguments are optional, provided you're happy with the defaults, with the
exception of B.  That directive is a key/value pair consisting of
the form name and the name of the form definition.

  Argument    Default  Description
  ============================================================
  FOREGROUND    undef  Default foreground colour
  BACKGROUND    undef  Default background colour
  CAPTIONCOL    undef  Default caption colour
  TITLEBAR          0  Whether or not to show a title bar
  STATUSBAR         0  Whether or not to show a status bar
  CAPTION          $0  Default caption to show in the titlebar
  MINY             24  Minimum lines needed for application
  MINX             80  Minimum columns needed for application
  ALTFBASE      undef  Alternate namespace to search for forms
  ALTBASE       undef  Alternate namespace to search for widgets
  FORMDEFS         {}  Form definitions
  INPUTFUNC \&scankey  Default input routine

B is the form first display by the application when executed.

If either B or B is not satisfied, this method will return undef
instead of an object reference to Curses::Application.

Like Curses::Forms, all colour choices are passed to each form that doesn't
explicitly declare their own.  Alternate namespaces are also passed.

=cut

sub _conf {
  # This method creates the initial curses object and initialises
  # both the curses and application configurable space.
  #
  # Usage:  $self->_conf(%conf);

  my $self = shift;
  my %conf = (
    TITLEBAR    => 0,
    STATUSBAR   => 0,
    FORMDEFS    => {},
    CAPTION     => $0,
    MINY        => 24,
    MINX        => 80,
    @_ );
  my $mwh = new Curses;
  my @required = qw(MAINFORM);
  my ($y, $x, %forms, $code);
  my ($my, $ml) = (0, 0);
  my $err = 0;
  my $main;

  # Set some defaults
  $self->{CONF} = {%conf};
  $self->{FORMS} = {};
  $self->{FORMDEFS} = {};

	# Check for required arguments
	foreach (@required) { $err = 1 unless exists $conf{$_} };
  unless ($err == 0) {
    carp ref($self), ":  Required fields not passed";
    return 0;
  }

  # Save the handle to stdscr
  $self->{MWH} = $mwh;
  pushwh($mwh);

  # Get and store the max X and Y
  $mwh->getmaxyx($y, $x);
  $self->{MAX} = [$y, $x];

  # Return an error if MINY and MINX aren't met
  unless ($y >= $conf{MINY} && $x >= $conf{MINX}) {
    carp ref($self), ":  Minimum screen size not satisfied!";
    return 0;
  }

  # Set up the session
  noecho();         # Turn off input echoing
  halfdelay(1);     # Turn on partial blocking uncooked input
  curs_set(0);      # Turn off visible cursor
  $mwh->keypad(1);  # Turn on keypad support for special keys
  $mwh->syncok(1);  # Sync sub/derwins up to mainwin

  # Read the forms from main
  $code = join('', );
  close(main::DATA);
  unless (eval $code) {
    carp ref($self), ":  Eval of main::DATA failed!";
    return 0;
  }

  # Get geometry for the main form
  $ml = $y;
  $my = 0;
  if ($conf{TITLEBAR}) {
    --$ml;
    ++$my;
  }
  --$ml if $conf{STATUSBAR};

  # Set size of MAINFORM
  $main = (keys %{$conf{MAINFORM}})[0];
  $forms{$conf{MAINFORM}{$main}} = {
    %{$forms{$conf{MAINFORM}{$main}}},
    Y       => $my,
    X       => 0,
    LINES   => $ml,
    COLUMNS => $x,
    DERIVED => 1,
    };

  # Save the form defs, adjusting the colours, if neccessary
  foreach (keys %forms) { $self->addFormDef($_, $forms{$_}) };

  # Set the window foreground/background colours if specified
  if ($conf{FOREGROUND} && $conf{BACKGROUND}) {
    $mwh->bkgdset(COLOR_PAIR(
      select_colour($conf{FOREGROUND}, $conf{BACKGROUND})));
  }

  # Make sure no errors are returned by the parent method
  $err = 1 unless $self->SUPER::_conf(%conf);

  # Initialise window
  $self->_init($mwh);

  return $err == 1 ? 0 : 1;
}

=head2 maxyx

  ($y, $x) = $app->maxyx;

Returns the maximum Y and X coordinates for the screen.

=cut

sub maxyx {
  my $self = shift;

  return @{$self->{MAX}};
}

=head2 mwh

  $mwh = $app->mwh;

Returns a handle to the curses window handle.

=cut

sub mwh {
  my $self = shift;

  return $self->{MWH};
}

=head2 titlebar

  $app->titlebar($newcaption);

This method updates the application caption used in the titlebar and
immediately updates screen with a refresh.  If you'd prefer to have it updated
at the next application refresh (such as the next B method call) you
should use the B method instead, and update the B

=cut

sub titlebar {
  my $self = shift;
  my $caption = shift;
  my $conf = $self->{CONF};

  $$conf{CAPTION} = $caption;
  $self->_titlebar;
  $self->{MWH}->refresh;
}

sub _titlebar {
  my $self = shift;
  my $mwh = $self->{MWH};
  my $enabled = $self->{CONF}->{TITLEBAR};
  my $caption = $self->{CONF}->{CAPTION};

  if ($enabled) {
    $mwh->standout;
    $mwh->addstr(0, 0, $caption . ' ' x ($COLS - length($caption)));
    $mwh->standend;
  }
}

=head2 statusbar

  $app->statusbar($message);

This method updates the statusbar message and immediately updates screen with
a refresh.  If you'd prefer to have it updated at the next application
refresh (such as the next B method call) you should use the
B method instead, and update the B field.

=cut

sub statusbar {
  my $self = shift;
  my $message = shift;
  my $conf = $self->{CONF};

  $$conf{MESSAGE} = $message;
  $self->_statusbar;
  $self->{MWH}->refresh;
}

sub _statusbar {
  my $self = shift;
  my $mwh = $self->{MWH};
  my $enabled = $self->{CONF}->{STATUSBAR};
  my $message = $self->{CONF}->{MESSAGE};
  my ($y, $x);

  if ($enabled) {
    $mwh->getmaxyx($y, $x);
    $mwh->standout;
    $mwh->addstr($y - 1, 0, $message . ' ' x ($COLS - length($message)));
    $mwh->standend;
  }
}

=head2 draw

  $app->draw;

Flushes all screen changes to the terminal.

=cut

sub draw {
  my $self = shift;
  my $mwh = $self->{MWH};
  my $conf = $self->{CONF};

  $self->_titlebar;
  $self->_statusbar;
  $mwh->refresh;
}

=head2 redraw

  $app->redraw;

Redraws the entire screen.

=cut

sub redraw {
  my $self = shift;
  my $mwh = $self->{MWH};

  $mwh->touchwin;
  $mwh->refresh;
}

=head2 addFormDef

  $app->addFormDef('MyForm', { %formopts });

Adds another form definition to the current library.  Returns a true if
successful, and a false if not (such as if the form type requested is provided
by an unavailable module).

=cut

sub addFormDef {
  my $self = shift;
  my $name = shift;
  my $options = shift;
  my $type = $$options{TYPE} || '';
  my $forms = $self->{FORMDEFS};
  my @try = ('Curses::Forms');
  my $conf = $self->{CONF};
  my ($altf, $altw) = @$conf{qw(ALTFBASE ALTBASE)};
  my $success = 0;
  my ($base, $mod);

  # Get the alt forms base class, if specified
  if (defined $altf) {
    if (ref($altf) eq 'ARRAY') {
      unshift @try, @$altf;
    } else {
      unshift @try, $self->{CONF}->{ALTBASE};
    }
  }

  # Load the applicable module
  foreach $base (@try) {
    $mod = $type eq '' ? $base : "${base}::$type";
    if (eval "require $mod") {
      $success = 1;
      $type = $mod;
      last;
    }
  }
  unless ($success) {
    carp ref($self), ":  Loading module $type (in @try) failed!";
    return 0;
  }

  # Avoid name collisions
  if (exists $$forms{$name}) {
    carp ref($_), ":  A form def named $name is already in the hash!";
    return 0;
  }

  # Store the form def after updating few options
  $$options{INPUTFUNC} = $$conf{INPUTFUNC};
  $$options{MODULE} = $mod;
  foreach (@colitems) {
    $$options{$_} = $$conf{$_} if
      (exists $$conf{$_} && ! exists $$options{$_});
  }
  $$forms{$name} = { ALTFBASE => $altf, ALTBASE => $altw, %$options };

  return 1;
}

=head2 createForm

  $app->createForm($name, $def);

Creates a form object based on the named definition.  Returns a handle to the
form if successful, and a false if not.

=cut

sub createForm {
  my $self = shift;
  my $name = shift;
  my $def = shift;
  my $forms = $self->{FORMS};
  my $defs = $self->{FORMDEFS};
  my ($type, $options);

  # Saftey checks
  unless (exists $$defs{$def}) {
    carp ref($self), ":  No form def exists by that name ($name)!";
    return 0;
  }
  if (exists $$forms{$name}) {
    carp ref($self), ":  A form by the name of $name already exists!";
    return 0;
  }

  # Create and store the form
  {
    no strict 'refs';
    $type = $$defs{$def}{MODULE};
    $options = $$defs{$def};
    unless ($$forms{$name} = "$type"->new($options)) {
      carp ref($self), ":  $type creation failed!";
      return 0;
    }

    # Reference event subs under form space
    foreach (@events) {
      $$forms{$name}->{$_} = $$options{$_} if exists $$options{$_};
    }
  }

  return $$forms{$name};
}

=head2 getForm

  $form = $app->getForm('MainFrm');

Returns a handle to the specified form.  If that form does not exist, the
object generates a warning and returns undef.

=cut

sub getForm {
  my $self = shift;
  my $name = shift;
  my $forms = $self->{FORMS};

  if (exists $$forms{$name}) {
    return $$forms{$name};
  } else {
    carp ref($self), ":  No form by the name $name exists!";
    return undef;
  }
}

=head2 delForm

  $app->delForm('Main');

Deletes the form object by that name.

=cut

sub delForm {
  my $self = shift;
  my $name = shift;
  my $forms = $self->{FORMS};

  unless (exists $$forms{$name}) {
    carp ref($self), ":  No form by that name ($name) exists to be deleted!";
    return 0;
  }

  delete $$forms{$name};
  return 1;
}

=head2 execForm

  $app->execForm('Main');

Executes the form specified by name.  This form must be created beforehand via
the B method.  Returns the return value of the form's B
method.

=cut

sub execForm {
  my $self = shift;
  my $name = shift;
  my $forms = $self->{FORMS};
  my ($f, $rv);

  unless (exists $$forms{$name}) {
    carp ref($self), ":  No form ($name) available to execute!";
    return 0;
  }

  $f = $$forms{$name};

  # Call the OnEnter routine if present
  &{$f->{OnEnter}}($self) if defined $f->{OnEnter};

  # Execute the form
  $rv = $f->execute($self->mwh);

  # Call the OnExit routine if present
  &{$f->{OnExit}}($self) if defined $f->{OnExit};

  return $rv;
}

=head2 execute

  $app->execute;

Causes the main form to execute.  Once the main form exits, this call will
exit as well.

=cut

sub execute {
  my $self = shift;
  my $conf = $self->{CONF};
  my $forms = $self->{FORMS};
  my $main;

  # Get the main form name
  $main = (keys %{$$conf{MAINFORM}})[0];

  # Create it if necessary
  unless (exists $$forms{$main}) {
    $self->createForm($main, $$conf{MAINFORM}{$main});
  }

  # Execute it
  $self->execForm($main);
}

sub DESTROY {
  # This routines resets the console to the previous sane state
  # before the application began.
  #
  # Internal use only.

  my $self = shift;

  popwh();
  endwin();
}

1;

=head1 HISTORY

=over

=item 2002/11/12 - Initial release.

=back

=head1 AUTHOR/COPYRIGHT

(c) 2001 Arthur Corliss ([e-mail])

=cut