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