view release on metacpan or  search on metacpan

lib/Ante/Deluvian/Dialog.pm  view on Meta::CPAN

use warnings;
use Term::ReadKey;
use Text::Wrap qw($columns wrap);
use IO::File;

our $VERSION = 0.02;
sub FALSE { return 0; }
sub TRUE  { return 1; }
my $_isWin = FALSE;
my $_doRec = FALSE;
my $_rplay = FALSE;
my $_fhInp = undef;
my $_fhRec = undef;

#------------------------------------------------------------------
sub new {
#------------------------------------------------------------------ 
  my $class = shift;
  my %param = @_; 
	my $self = {};
  my ($iCols, $iRows);
  
  $self = bless {}, $class;
  $self->{'rows'} = 25;
  $self->{'cols'} = 80;
  $self->{'stat'} = 0;
  $self->{'from'} = 1;
  $self->{'eoln'} = "";
  $self->{'curpid'}   = $$,
  $self->{'getdrv'}   = \&_procDfCmd,
  $self->{'usable'}   = 25;
  $self->{'hcenter'}  = 12;
  $self->{'vcenter'}  = 40;
  $self->{'recary'}   = [];
  $self->{'parind'}   = $param{parindent} || 2;
  $self->{'title'}    = $param{title}     || undef;
  $self->{'header'}   = $param{header}    || " ";
  $self->{'prompt'}   = $param{prompt}    || ":";
  $self->{'platform'} = $param{platform}  || "UNIX";
  $_isWin = $param{platform} eq "MSWIN";
  $_doRec = $param{record}   || FALSE;
  $_fhInp = $param{inpfile}  || undef;
  if ((exists($param{replay})) && (-s $param{replay})) {
    my $fi = IO::File->new("< $param{replay}");
    @{$self->{'recary'}} = <$fi>;
    $fi->close();
    $_rplay = TRUE;
  }
  $self->_getWinSize();
  $self->{'usable'} = $self->{'rows'};
  if (defined($self->{'header'})) {
    $self->{'usable'}--;
    $self->{'stat'}++;
    $self->{'from'}++;
  }
  if (defined($self->{'prompt'})) {
    $self->{'usable'}--;
  }
  $self->{'hcenter'} = int ($self->{'cols'} / 2);
  $self->{'vcenter'} = int (($self->{'usable'} - $self->{'from'}) / 2);
  $self->{'lines'} = $self->_drawframe();
  $self->{'usable'} -= 2;
  return $self;
}

#------------------------------------------------------------------
sub DESTROY {
#------------------------------------------------------------------
  my $self = shift;
  
  if ($_doRec) {
    $self->_createRecFile();
    print $_fhRec "@{$self->{'recary'}}\n";
  }
}

#------------------------------------------------------------------
sub _getWinSize {
#------------------------------------------------------------------
  my $self = shift;
  my ($maxCol, $maxRow);
  
  if ($_isWin) {
    require Win32::Console;
    my $cns = new Win32::Console();
    my @info =$cns->Info();
    ($maxCol, $maxRow) = $cns->MaxWindow();
    $self->{'gdrv'} = \&_procNetUse;
    $self->{'eoln'} = "\n";
  }
  else {
    ($maxCol, $maxRow) = GetTerminalSize();
  }
  $self->{'cols'} = $maxCol;
  $self->{'rows'} = $maxRow;
}

#------------------------------------------------------------------
sub _createRecFile {
#------------------------------------------------------------------
  my $self  = shift;
  my $tmpth = $_isWin ? "C:/temp/addialog" : "/tmp/addialog";
  my $tmpf  = sprintf("%s/%s_%d", $tmpth, $_isWin ? $ENV{USERNAME} : $ENV{USER}, $self->{'curpid'});
  
  if (! -d $tmpth) {
    mkdir($tmpth);
  }
  $_fhRec = IO::File->new("> $tmpf");
  print "File $tmpf created to record user input ...\n";
}

#------------------------------------------------------------------
sub _drawframe {
#------------------------------------------------------------------
  my $self = shift;
  my $rows = $self->{'rows'} - 1;
  my $cols = $self->{'cols'} - 2;
  my ($line, @lines, $inp);
  
  if (defined($self->{'prompt'})) {
    $rows--;
  }
  for my $i (0 .. $rows) {
    if (($i == 0) || ($i == $rows)) {
      push @lines, "+" . "-" x $cols . "+";
    }
    else {
      push @lines, "|" . " " x $cols . "|";
    }
  }
  if (defined($self->{'title'})) {
    _formatline(\$lines[0], $self->{'title'}, "C");
  }
  if (defined($self->{'prompt'})) {
    push @lines, "$self->{'prompt'} ";
  }
  return [ @lines ];
}

#------------------------------------------------------------------
sub _doselection {
#
# This function is likely to be called recursively ...
#------------------------------------------------------------------
  my $self  = shift;
  my %param = @_;
  
  my $rpag = $param{pagary};
  my $rsel = $param{selary};
  my $inpt = $param{input};
  my $mode = $param{selmod};
  
  my $j = int($inpt / $self->{'usable'}) + 1;
  my $k = int($inpt % $self->{'usable'}) + $self->{'from'};
  print "_doselection (..., $inpt, $mode)   j = $j   k = $k ...\n";
  if ($mode eq "single") {
    if (defined($rsel->[0])) {
      $self->_doselection(
              selary => $rsel,
              pagary => $rpag,
              input  => $rsel->[0],
              selmod => "discard",
      );
    }
    $self->_doselection(
            selary => $rsel,
            pagary => $rpag,
            input  => $inpt,
            selmod => "select",
    );
    $rsel->[0] = $inpt;
  }
  elsif ($mode eq "multi") {

lib/Ante/Deluvian/Dialog.pm  view on Meta::CPAN

  }
  elsif ($pref eq "IO::File") {
    @txtlns = <$itxt>;
  }
  elsif (($pref eq "") && (-f $itxt)) {
    my $fi = IO::File->new("< $itxt");
    if (-T $itxt) {
      @txtlns = <$fi>;
    }
    else {
      #$/ = "\0";
      #while (<$fi>) {
      #  while (/([\040-\176\s]{4,})/g) {
      #    push @txtlns, $1;
      #  }
      #}
      $doFmt = FALSE;
      @filstat = stat($itxt);
      @txtlns  = ( "$itxt", "appears to be a binary file ...", "");
      foreach my $i (0 .. $#filstat) {
        push @txtlns, sprintf("%-10s  ->  %s", $stNames[$i], $stNames[$i] =~ /time/ ? scalar localtime($filstat[$i]) : $filstat[$i]);
      }
    }
    $fi->close();
  }
  if ($doFmt) {
    if (!defined($text)) {
      $text = join "", @txtlns;
    } 
    $text =~ s/\n\n+/#PAR#/g;
    $text =~ tr/[\n\t ]/ /s;
    print "$text\n";
    $text =~ s/#PAR#/\n\n/g;
    $text =~ s/#LN#/\n/g;
    @txtlns = split(/\t/, $text);
    $columns = $self->{'cols'} - 4;
    $text = wrap("", "", @txtlns);
    @lines = split(/\n/, $text);
  }
  else {
    @lines = @txtlns;
  }
  print "Maximal $columns Spalten ...\n\n@lines\n";
  $self->listbox(\@lines, input => "text");
}

1;
__END__
# Below is stub documentation for your module. You'd better edit it!

=head1 NAME

Ante::Deluvian::Dialog - Perl extension for very old style user interaction

=head1 SYNOPSIS

  use Ante::Deluvian::Dialog;
  
  $d = Ante::Deluvian::Dialog->new(
    platform  => "MSWIN",
    drawframe => 1,
    title     => "Title of Window",
    prompt    => "Please make your choice:",
    # record    => 1,
    # replay    => "C:/temp/addialog/<username>_<pid>.txt",
  );

  $fdir  = $d->dselect();
  print "You have selected directory $fdir ...\n";
  
  $fname = $d->fselect($fdir);
  print "You have selected file $fname ...\n";
  
  @aLst = ( "A" .. "Z", "a" .. "z" );
  @aRes = $d->listbox(\@aLst, select => "multi");
  
  $rd = $d->radiolist([
		[ "List of radio buttons", 1, ],
		[ "red",    "RED", 0 ],
		[ "green",  "GRN", 1 ],
		[ "blue",   "BLU", 0 ],
		[ "yellow", "YLW", 0 ],
	]);

  $d->alert([
  	"Press <RETURN> to continue ...",
  	"Attention! This is considered to be",
  	"an alert box (see below) ...",
  	"The recent radio list resulted in $rd",
  ]);

  if (-T $fname) {
    $inpf = IO::File->new($fname);
    $d->textbox($inpf);
  }
  else {
    $d->textbox($fname);
  }

=head1 CONSTRUCTOR

=over 4

=item new (platform => "MSWIN", title => "Window's title", prompt => "What do you want");

There are two other options C<record>, which can be set to a boolean value, and C<replay>, which
expects to get some previously recorded input file. This is mainly for testing purposes, if you
don't like to repeat a special input sequence by hand... I'm sure you will find out if this is
interesting to you.

=back

=head1 DESCRIPTION

After several attempts to get curses running on windows (without having to install cygwin),
I made up my mind to do some programming to get a pure ASCII based and very simple dialog
window.

I'm sure there won't be many users preferring this kind of interface, but I don't want to
be obliged to produce some GUI just for controling or testing communication.