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
28use warnings;
29use strict;
30use diagnostics;
31
32use FindBin qw($Bin $Script);
33use lib "$Bin";
34
35require "dialog.pl";
36dialog->import('@dialog_result');
37our @dialog_result;
38
39sub 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
48sub napms($) {
49    my $msecs = shift;
50    select( undef, undef, undef, $msecs * 0.001 );
51}
52
53sub 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
65sub 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
3371;
338