xref: /freebsd/contrib/dialog/demo.pl (revision c6879c6c14eedbd060ba588a3129a6c60ebbe783)

#!/usr/bin/env perl
# $Id: demo.pl,v 1.23 2018/06/12 21:39:44 tom Exp $
################################################################################
#  Copyright 2018	Thomas E. Dickey
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU Lesser General Public License, version 2.1
#  as published by the Free Software Foundation.
#
#  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
#  Lesser General Public License for more details.
#
#  You should have received a copy of the GNU Lesser General Public
#  License along with this program; if not, write to
#	Free Software Foundation, Inc.
#	51 Franklin St., Fifth Floor
#	Boston, MA 02110, USA.
################################################################################
# This demonstration is provided solely to exercise the sample Perl wrapper for
# dialog which is included in its source-code.  See libui-dialog-perl for a
# more comprehensive binding.
#
# TODO: modify dialog.pl to use $DIALOG environment variable, drive from GetOpts here
# TODO: eliminate constant $scr_lines in dialog.pl

use warnings;
use strict;
use diagnostics;

use FindBin qw($Bin $Script);
use lib "$Bin";

require "dialog.pl";
dialog->import('@dialog_result');
our @dialog_result;

sub tput($$) {
    my $name    = shift;
    my $default = shift;
    my $value   = `tput "$name"`;
    chomp $value;
    $value = $default unless ( $value =~ /^[0-9]+$/ );
    return $value;
}

sub napms($) {
    my $msecs = shift;
    select( undef, undef, undef, $msecs * 0.001 );
}

sub show_results($$) {
    my $title = shift;
    my $width = shift;
    &rhs_msgbox(
        $title,
        sprintf(
            "Resulting text:\\n    %s", join( '\\n    ', @dialog_result )
        ),
        $width
    );
}

sub doit() {
    my $status         = 1;
    my $RHS_CLEAR      = "clear";
    my $RHS_TEXTBOX    = "textbox";
    my $RHS_MSGBOX     = "msgbox";
    my $RHS_INFOBOX    = "infobox";
    my $RHS_YESNO      = "yesno";
    my $RHS_GAUGE      = "gauge";
    my $RHS_INPUTBOX   = "inputbox";
    my $RHS_MENU       = "menu";
    my $RHS_MENUL      = "menul";
    my $RHS_MENUA      = "menua";
    my $RHS_CHECKLIST  = "checklist";
    my $RHS_CHECKLISTL = "checklistl";
    my $RHS_CHECKLISTA = "checklista";
    my $RHS_RADIOLIST  = "radiolist";

    my @demo_2col = qw(
      This      that
      is        has
      a         this
      2-column  quoted
      menu      "tag".
    );
    my @demo_3col;
    my @demo_tags;
    my %demo_hash;

    for ( my $s = 0, my $t = 0 ; $s <= $#demo_2col ; $s += 2, $t += 3 ) {
        my $d  = $s / 2;
        my $c1 = $demo_2col[$s];
        my $c2 = $demo_2col[ $s + 1 ];
        $demo_3col[$t] = $c1;
        $demo_3col[ $t + 1 ] = $c2;
        $demo_3col[ $t + 2 ] = ( $c1 =~ /2/ ) ? 1 : 0;
        $demo_tags[$d] = $c1;
        $demo_tags[$d] =~ s/2/1/;
        $demo_tags[ $d + ( $#demo_2col + 1 ) / 2 ] = $c2;
        $demo_hash{ sprintf( "%d %s", $d, $c1 ) } = $c2;
    }

    while ( $status > 0 ) {
        my $lines = &tput( "lines", 24 );
        my $cols  = &tput( "cols",  80 );
        my $maxcols = $cols - 4;
        my $mincols = ( $cols > 8 ) ? 8 : $cols;
        my $midcols = int( ( $cols * 3 ) / 4 );

        @dialog_result = ();
        $status        = &rhs_menu(
            "My title",      "My message",
            0,               14,
            $RHS_CLEAR,      "clear and exit",
            $RHS_TEXTBOX,    "text-box of this script",
            $RHS_MSGBOX,     "informational-message, OK button",
            $RHS_INFOBOX,    "informational-message, no button",
            $RHS_YESNO,      "message with Yes/No buttons",
            $RHS_GAUGE,      "message with progress-gauge",
            $RHS_INPUTBOX,   "input-box",
            $RHS_MENU,       "menu, with tags and description",
            $RHS_MENUL,      "menu, using only tags",
            $RHS_MENUA,      "alphabetically sorted menu",
            $RHS_CHECKLIST,  "check-list with tags and description",
            $RHS_CHECKLISTL, "check-list using only tags",
            $RHS_CHECKLISTA, "alphabetically sorted check-list",
            $RHS_RADIOLIST,  "list of radio-buttons"
        );
        if ( $status > 0 and $#dialog_result == 0 ) {

            my $testcase = $dialog_result[0];
            if ( $testcase eq $RHS_CLEAR ) {
                &rhs_clear;
                last;
            }
            elsif ( $testcase eq $RHS_TEXTBOX ) {
                &rhs_textbox( "This script", "$Script", 0, 0 );
            }
            elsif ( $testcase eq $RHS_MSGBOX ) {
                my $msg =
                    "This is a demonstration script.\\n"
                  . "This should be the second line,\\n"
                  . "and this should be the third line,";
                &rhs_msgbox( "A message", $msg,
                    int( ( length($msg) + 3 ) / 3 ) + 3 );
            }
            elsif ( $testcase eq $RHS_INFOBOX ) {
                my $msg =
                    "This is a fairly long line of text, used to"
                  . " show how dialog can be used to wrap lines to fit in"
                  . " screens with different width.  The text will start wide,"
                  . " then get narrower, showing a new infobox for each width"
                  . " before going back up to the full width of the terminal.";
                my $wide = $maxcols;
                while ( $wide > $mincols ) {
                    &rhs_infobox( "Info-box", $msg, $wide-- );
                    &napms(50);
                }
                while ( $wide < $maxcols ) {
                    &rhs_infobox( "Info-box", $msg, ++$wide );
                    &napms(50);
                }
                &rhs_msgbox( "Info-end", $msg, $wide );
            }
            elsif ( $testcase eq $RHS_YESNO ) {
                if (
                    &rhs_yesno(
                        "Yes/no",
                        "Should \"dialog --yesno\" return \"1\" on \"yes\""
                          . " to simplify (some) shell scripts?",
                        $cols / 2
                    )
                  )
                {
                    &rhs_msgbox(
                        "Explanation",
                        "No, a successful program exits with "
                          . "\"0\" (EXIT_SUCCESS)",
                        $cols / 2
                    );
                }
                else {
                    &rhs_msgbox(
                        "Explanation",
                        "Shell scripts assume that \"exit\ 0\" is successful;"
                          . " Perl is different.",
                        $cols / 2
                    );
                }
            }
            elsif ( $testcase eq $RHS_GAUGE ) {
                my $pct = 0;
                my $sec = 10;
                &rhs_gauge(
                    "My gauge",
                    "Show progress (or lack of it)",
                    $midcols * 3, $pct
                );
                while ( $pct < 100 ) {
                    $pct++;
                    &napms($sec);
                    $sec *= 1.04;
                    &rhs_update_gauge($pct);
                }
                $pct = 99;
                &rhs_update_gauge_and_message( "This will go faster", $pct );
                while ( $pct > 0 ) {
                    $pct--;
                    &napms($sec);
                    $sec /= 1.05;
                    &rhs_update_gauge($pct);
                }
                &napms(1000);
                &rhs_stop_gauge;
            }
            elsif ( $testcase eq $RHS_INPUTBOX ) {
                if (
                    &rhs_inputbox(
                        "My inputbox", "This demonstrates the inputbox",
                        $maxcols,      ""
                    )
                  )
                {
                    &show_results( "My inputbox", $midcols );
                }
            }
            elsif ( $testcase eq $RHS_MENU ) {
                if (
                    &rhs_menu(
                        (
                            "A menu",
                            "This menu uses \"tag\" values and descriptions:",
                            $midcols, ( $#demo_2col + 1 ) / 2
                        ),
                        @demo_2col
                    )
                  )
                {
                    &show_results( "My menu", $midcols );
                }
            }
            elsif ( $testcase eq $RHS_MENUL ) {
                if (
                    &rhs_menul(
                        (
                            "A menu", "This menu uses only the \"tag\" values:",
                            $midcols, $#demo_tags + 1
                        ),
                        @demo_tags
                    )
                  )
                {
                    &show_results( "My long-menu", $midcols );
                }
            }
            elsif ( $testcase eq $RHS_MENUA ) {
                if (
                    &rhs_menua(
                        "A menu", "This menu uses the sorted keys from a hash:",
                        $midcols, %demo_hash
                    )
                  )
                {
                    &show_results( "My alpha-menu", $midcols );
                }
            }
            elsif ( $testcase eq $RHS_CHECKLIST ) {
                if (
                    &rhs_checklist(
                        (
                            "A checklist",
                            "This checklist uses \"tag\" values"
                              . " and descriptions:",
                            $midcols,
                            ( $#demo_3col + 1 ) / 3
                        ),
                        @demo_3col
                    )
                  )
                {
                    &show_results( "My checklist", $midcols );
                }
            }
            elsif ( $testcase eq $RHS_CHECKLISTL ) {
                if (
                    &rhs_checklistl(
                        (
                            "A checklist",
                            "This checklist uses only the \"tag\" values:",
                            $midcols, $#demo_tags + 1
                        ),
                        @demo_tags
                    )
                  )
                {
                    &show_results( "My long-checklist", $midcols );
                }
            }
            elsif ( $testcase eq $RHS_CHECKLISTA ) {
                if (
                    &rhs_checklista(
                        "A checklist",
                        "This checklist uses the sorted keys from a hash:",
                        $midcols, %demo_hash
                    )
                  )
                {
                    &show_results( "My alpha-checklist", $midcols );
                }
            }
            elsif ( $testcase eq $RHS_RADIOLIST ) {
                if (
                    &rhs_radiolist(
                        (
                            "A radiolist",
                            "This radiolist uses \"tag\" values"
                              . " and descriptions:",
                            $midcols,
                            ( $#demo_3col + 1 ) / 3
                        ),
                        @demo_3col
                    )
                  )
                {
                    &show_results( "My radiolist", $midcols );
                }
            }
        }
    }
}

&doit;

1;