contrib/dialog/demo.pl

   1 #!/usr/bin/env perl
   2 # $Id: demo.pl,v 1.23 2018/06/12 21:39:44 tom Exp $
   3 ################################################################################
   4 #  Copyright 2018       Thomas E. Dickey
   5 #
   6 #  This program is free software; you can redistribute it and/or modify
   7 #  it under the terms of the GNU Lesser General Public License, version 2.1
   8 #  as published by the Free Software Foundation.
   9 #
  10 #  This program is distributed in the hope that it will be useful, but
  11 #  WITHOUT ANY WARRANTY; without even the implied warranty of
  12 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 #  Lesser General Public License for more details.
  14 #
  15 #  You should have received a copy of the GNU Lesser General Public
  16 #  License along with this program; if not, write to
  17 #       Free Software Foundation, Inc.
  18 #       51 Franklin St., Fifth Floor
  19 #       Boston, MA 02110, USA.
  20 ################################################################################
  21 # This demonstration is provided solely to exercise the sample Perl wrapper for
  22 # dialog which is included in its source-code.  See libui-dialog-perl for a
  23 # more comprehensive binding.
  24 #
  25 # TODO: modify dialog.pl to use $DIALOG environment variable, drive from GetOpts here
  26 # TODO: eliminate constant $scr_lines in dialog.pl
  27
  28 use warnings;
  29 use strict;
  30 use diagnostics;
  31
  32 use FindBin qw($Bin $Script);
  33 use lib "$Bin";
  34
  35 require "dialog.pl";
  36 dialog->import('@dialog_result');
  37 our @dialog_result;
  38
  39 sub tput($$) {
  40     my $name    = shift;
  41     my $default = shift;
  42     my $value   = `tput "$name"`;
  43     chomp $value;
  44     $value = $default unless ( $value =~ /^[0-9]+$/ );
  45     return $value;
  46 }
  47
  48 sub napms($) {
  49     my $msecs = shift;
  50     select( undef, undef, undef, $msecs * 0.001 );
  51 }
  52
  53 sub show_results($$) {
  54     my $title = shift;
  55     my $width = shift;
  56     &rhs_msgbox(
  57         $title,
  58         sprintf(
  59             "Resulting text:\\n    %s", join( '\\n    ', @dialog_result )
  60         ),
  61         $width
  62     );
  63 }
  64
  65 sub doit() {
  66     my $status         = 1;
  67     my $RHS_CLEAR      = "clear";
  68     my $RHS_TEXTBOX    = "textbox";
  69     my $RHS_MSGBOX     = "msgbox";
  70     my $RHS_INFOBOX    = "infobox";
  71     my $RHS_YESNO      = "yesno";
  72     my $RHS_GAUGE      = "gauge";
  73     my $RHS_INPUTBOX   = "inputbox";
  74     my $RHS_MENU       = "menu";
  75     my $RHS_MENUL      = "menul";
  76     my $RHS_MENUA      = "menua";
  77     my $RHS_CHECKLIST  = "checklist";
  78     my $RHS_CHECKLISTL = "checklistl";
  79     my $RHS_CHECKLISTA = "checklista";
  80     my $RHS_RADIOLIST  = "radiolist";
  81
  82     my @demo_2col = qw(
  83       This      that
  84       is        has
  85       a         this
  86       2-column  quoted
  87       menu      "tag".
  88     );
  89     my @demo_3col;
  90     my @demo_tags;
  91     my %demo_hash;
  92
  93     for ( my $s = 0, my $t = 0 ; $s <= $#demo_2col ; $s += 2, $t += 3 ) {
  94         my $d  = $s / 2;
  95         my $c1 = $demo_2col[$s];
  96         my $c2 = $demo_2col[ $s + 1 ];
  97         $demo_3col[$t] = $c1;
  98         $demo_3col[ $t + 1 ] = $c2;
  99         $demo_3col[ $t + 2 ] = ( $c1 =~ /2/ ) ? 1 : 0;
 100         $demo_tags[$d] = $c1;
 101         $demo_tags[$d] =~ s/2/1/;
 102         $demo_tags[ $d + ( $#demo_2col + 1 ) / 2 ] = $c2;
 103         $demo_hash{ sprintf( "%d %s", $d, $c1 ) } = $c2;
 104     }
 105
 106     while ( $status > 0 ) {
 107         my $lines = &tput( "lines", 24 );
 108         my $cols  = &tput( "cols",  80 );
 109         my $maxcols = $cols - 4;
 110         my $mincols = ( $cols > 8 ) ? 8 : $cols;
 111         my $midcols = int( ( $cols * 3 ) / 4 );
 112
 113         @dialog_result = ();
 114         $status        = &rhs_menu(
 115             "My title",      "My message",
 116             0,               14,
 117             $RHS_CLEAR,      "clear and exit",
 118             $RHS_TEXTBOX,    "text-box of this script",
 119             $RHS_MSGBOX,     "informational-message, OK button",
 120             $RHS_INFOBOX,    "informational-message, no button",
 121             $RHS_YESNO,      "message with Yes/No buttons",
 122             $RHS_GAUGE,      "message with progress-gauge",
 123             $RHS_INPUTBOX,   "input-box",
 124             $RHS_MENU,       "menu, with tags and description",
 125             $RHS_MENUL,      "menu, using only tags",
 126             $RHS_MENUA,      "alphabetically sorted menu",
 127             $RHS_CHECKLIST,  "check-list with tags and description",
 128             $RHS_CHECKLISTL, "check-list using only tags",
 129             $RHS_CHECKLISTA, "alphabetically sorted check-list",
 130             $RHS_RADIOLIST,  "list of radio-buttons"
 131         );
 132         if ( $status > 0 and $#dialog_result == 0 ) {
 133
 134             my $testcase = $dialog_result[0];
 135             if ( $testcase eq $RHS_CLEAR ) {
 136                 &rhs_clear;
 137                 last;
 138             }
 139             elsif ( $testcase eq $RHS_TEXTBOX ) {
 140                 &rhs_textbox( "This script", "$Script", 0, 0 );
 141             }
 142             elsif ( $testcase eq $RHS_MSGBOX ) {
 143                 my $msg =
 144                     "This is a demonstration script.\\n"
 145                   . "This should be the second line,\\n"
 146                   . "and this should be the third line,";
 147                 &rhs_msgbox( "A message", $msg,
 148                     int( ( length($msg) + 3 ) / 3 ) + 3 );
 149             }
 150             elsif ( $testcase eq $RHS_INFOBOX ) {
 151                 my $msg =
 152                     "This is a fairly long line of text, used to"
 153                   . " show how dialog can be used to wrap lines to fit in"
 154                   . " screens with different width.  The text will start wide,"
 155                   . " then get narrower, showing a new infobox for each width"
 156                   . " before going back up to the full width of the terminal.";
 157                 my $wide = $maxcols;
 158                 while ( $wide > $mincols ) {
 159                     &rhs_infobox( "Info-box", $msg, $wide-- );
 160                     &napms(50);
 161                 }
 162                 while ( $wide < $maxcols ) {
 163                     &rhs_infobox( "Info-box", $msg, ++$wide );
 164                     &napms(50);
 165                 }
 166                 &rhs_msgbox( "Info-end", $msg, $wide );
 167             }
 168             elsif ( $testcase eq $RHS_YESNO ) {
 169                 if (
 170                     &rhs_yesno(
 171                         "Yes/no",
 172                         "Should \"dialog --yesno\" return \"1\" on \"yes\""
 173                           . " to simplify (some) shell scripts?",
 174                         $cols / 2
 175                     )
 176                   )
 177                 {
 178                     &rhs_msgbox(
 179                         "Explanation",
 180                         "No, a successful program exits with "
 181                           . "\"0\" (EXIT_SUCCESS)",
 182                         $cols / 2
 183                     );
 184                 }
 185                 else {
 186                     &rhs_msgbox(
 187                         "Explanation",
 188                         "Shell scripts assume that \"exit\ 0\" is successful;"
 189                           . " Perl is different.",
 190                         $cols / 2
 191                     );
 192                 }
 193             }
 194             elsif ( $testcase eq $RHS_GAUGE ) {
 195                 my $pct = 0;
 196                 my $sec = 10;
 197                 &rhs_gauge(
 198                     "My gauge",
 199                     "Show progress (or lack of it)",
 200                     $midcols * 3, $pct
 201                 );
 202                 while ( $pct < 100 ) {
 203                     $pct++;
 204                     &napms($sec);
 205                     $sec *= 1.04;
 206                     &rhs_update_gauge($pct);
 207                 }
 208                 $pct = 99;
 209                 &rhs_update_gauge_and_message( "This will go faster", $pct );
 210                 while ( $pct > 0 ) {
 211                     $pct--;
 212                     &napms($sec);
 213                     $sec /= 1.05;
 214                     &rhs_update_gauge($pct);
 215                 }
 216                 &napms(1000);
 217                 &rhs_stop_gauge;
 218             }
 219             elsif ( $testcase eq $RHS_INPUTBOX ) {
 220                 if (
 221                     &rhs_inputbox(
 222                         "My inputbox", "This demonstrates the inputbox",
 223                         $maxcols,      ""
 224                     )
 225                   )
 226                 {
 227                     &show_results( "My inputbox", $midcols );
 228                 }
 229             }
 230             elsif ( $testcase eq $RHS_MENU ) {
 231                 if (
 232                     &rhs_menu(
 233                         (
 234                             "A menu",
 235                             "This menu uses \"tag\" values and descriptions:",
 236                             $midcols, ( $#demo_2col + 1 ) / 2
 237                         ),
 238                         @demo_2col
 239                     )
 240                   )
 241                 {
 242                     &show_results( "My menu", $midcols );
 243                 }
 244             }
 245             elsif ( $testcase eq $RHS_MENUL ) {
 246                 if (
 247                     &rhs_menul(
 248                         (
 249                             "A menu", "This menu uses only the \"tag\" values:",
 250                             $midcols, $#demo_tags + 1
 251                         ),
 252                         @demo_tags
 253                     )
 254                   )
 255                 {
 256                     &show_results( "My long-menu", $midcols );
 257                 }
 258             }
 259             elsif ( $testcase eq $RHS_MENUA ) {
 260                 if (
 261                     &rhs_menua(
 262                         "A menu", "This menu uses the sorted keys from a hash:",
 263                         $midcols, %demo_hash
 264                     )
 265                   )
 266                 {
 267                     &show_results( "My alpha-menu", $midcols );
 268                 }
 269             }
 270             elsif ( $testcase eq $RHS_CHECKLIST ) {
 271                 if (
 272                     &rhs_checklist(
 273                         (
 274                             "A checklist",
 275                             "This checklist uses \"tag\" values"
 276                               . " and descriptions:",
 277                             $midcols,
 278                             ( $#demo_3col + 1 ) / 3
 279                         ),
 280                         @demo_3col
 281                     )
 282                   )
 283                 {
 284                     &show_results( "My checklist", $midcols );
 285                 }
 286             }
 287             elsif ( $testcase eq $RHS_CHECKLISTL ) {
 288                 if (
 289                     &rhs_checklistl(
 290                         (
 291                             "A checklist",
 292                             "This checklist uses only the \"tag\" values:",
 293                             $midcols, $#demo_tags + 1
 294                         ),
 295                         @demo_tags
 296                     )
 297                   )
 298                 {
 299                     &show_results( "My long-checklist", $midcols );
 300                 }
 301             }
 302             elsif ( $testcase eq $RHS_CHECKLISTA ) {
 303                 if (
 304                     &rhs_checklista(
 305                         "A checklist",
 306                         "This checklist uses the sorted keys from a hash:",
 307                         $midcols, %demo_hash
 308                     )
 309                   )
 310                 {
 311                     &show_results( "My alpha-checklist", $midcols );
 312                 }
 313             }
 314             elsif ( $testcase eq $RHS_RADIOLIST ) {
 315                 if (
 316                     &rhs_radiolist(
 317                         (
 318                             "A radiolist",
 319                             "This radiolist uses \"tag\" values"
 320                               . " and descriptions:",
 321                             $midcols,
 322                             ( $#demo_3col + 1 ) / 3
 323                         ),
 324                         @demo_3col
 325                     )
 326                   )
 327                 {
 328                     &show_results( "My radiolist", $midcols );
 329                 }
 330             }
 331         }
 332     }
 333 }
 334
 335 &doit;
 336
 337 1;