Curses-Devkit
view release on metacpan or search on metacpan
# Set the version.
$VERSION = "4.9.1";
# Set the diag flag off.
$DIAGFLAG = 0;
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw (VERSION checkDef checkReq popupLabel popupDialog);
sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function. If a constant is not found then control is passed
# to the AUTOLOAD in AutoLoader.
my $constname;
($constname = $AUTOLOAD) =~ s/.*:://;
my $val = constant($constname, @_ ? $_[0] : 0);
if ($! != 0) {
{
# Report the info.
Cdk::Diag::Log ("Diag", $type, "Required parameter $name being set to <$value>");
return ($value);
}
}
#
# This pops up a label.
#
sub popupLabel
{
my $mesg = shift;
my $popup = new Cdk::Label ("Message" => $mesg);
$popup->draw();
$popup->wait();
}
#
# This pops up a question on the screen.
#
sub popupDialog
{
my ($mesg, $buttons) = @_;
my $popup = new Cdk::Dialog ('Message' => $mesg, 'Buttons' => $buttons);
return $popup->activate;
}
#
# This function takes a scalar and returns a list with elements in the
# list to the given width.
#
sub scalar2List
{
my ($scalar, $elementLen) = @_;
my $tempLine = "";
demos/async view on Meta::CPAN
# Get the password info.
my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell) = getpwnam ($listItems[$itemPicked]);
# Display it.
my $info = ["</B/5>Account Name<!B!5> $name",
"</B/5>UID <!B!5> $uid",
"</B/5>GID <!B!5> $gid",
"</B/5>Directory <!B!5> $dir",
"</B/5>Shell <!B!5> $shell"];
popupLabel ($info);
}
# Exit Cdk.
Cdk::end();
#
# This is the async function.
#
sub littleWeeClock
{
my ($day, $month, $year) = $calendar->getDate();
# Ask the user what type of marker to add.
my $dialog = new Cdk::Dialog ('Message' => \@mesg, 'Buttons' => \@buttons);
my $choice = $dialog->activate();
undef $dialog;
# If they hit escape, tell them...
if (!defined $choice)
{
popupLabel (["Escape Hit. No marker set."]);
$calendar->draw();
return;
}
# Check the choice.
if ($choice == 0)
{
addBirthdayMarker ($day, $month, $year);
}
elsif ($choice == 1)
demos/perlbug view on Meta::CPAN
" [-r Reply Account] [-s subject]",
" [-f filename] [-v] [-h]", "",
"<B=-c> The account to carbon copy to.",
"<B=-a> The perl admin account.",
"<B=-r> The account to reply to.",
"<B=-s> The subject of the bug report.",
"<B=-f> The file to read in as the bug report.",
"<B=-v> Turns on verbose output for the bug report.",
"<B=-h> Pops up this help window.", "",
"<C></B/5>Press Any Key To Continue.");
popupLabel (\@help);
}
# Create a program information message.
my @progInfo = ("<C></5/B>Perl Bug Reporting Facility",
"<C></24/B>Version $Version", "",
"This program allows you to create a bug report which will be",
"mailed to </B>$address<!B> once the report has been filled out.", "",
"<C>Hit any key when you are ready to start.");
popupLabel (\@progInfo);
# Create the generic label.
my @mesg = ("******************************************************",
"******************************************************",
"******************************************************",
"******************************************************");
my $mainTitle = new Cdk::Label ('Message' => \@mesg, 'Xpos' => "TOP");
# Get the subject to the mail message.
my $subject = $opt_s || getSubject ($mainTitle);
demos/perlbug view on Meta::CPAN
$mainTitle->set ('Message' => \@mesg);
$mainTitle->draw();
# Get the subject.
while (1)
{
my $subject = $entry->activate();
last if defined $subject;
# No subject, prompt them for one...
popupLabel (["<C></16/B>Error",
"<C>You must have a subject line for the mail message.", "",
"<C>Please try again."]);
}
return $subject;
}
############################################################################
#
# This gets an emial address.
#
demos/perlbug view on Meta::CPAN
# Put the user name in the entry field.
$entry->set ('Value' => "$entryValue");
# Get the emial address
while (1)
{
$info = $entry->activate();
last if defined $info;
# No subject, prompt them for one...
popupLabel (["<C></B/16>Error",
"<C>You must provide an email address.", "",
"<C>Please Try again."]);
}
return $info;
}
############################################################################
#
# This gets the bug report from the user.
#
demos/perlbug view on Meta::CPAN
'Lrows' => 15,
'Width' => 50);
# Get the bug report.
while (1)
{
$info = $entry->activate();
last if defined $info;
# No subject, prompt them for one...
popupLabel (["<C></B/16>Error",
"<C>You must provide a description of the bug.", "",
"<C>Please Try again."]);
}
# Split the string into a list.
my @info = Cdk::scalar2List ($info, 40);
# Create the bug report.
push (@bugReport, "This is a bug report for perl from $from generated with");
push (@bugReport, "the help of the Cdk version of perlbug running under perl $].");
demos/perlbug view on Meta::CPAN
'Info' => \@bugReport);
$viewer->activate();
# Ask them what they want to do with the bug report.
my @mesg = ("<C>Now that the bug report has been created, you can",
"<C>send the bug report to </R>$replyAddress<!R> and </R>$adminAddress<!R>,",
"<C>or you can save the report to a file and send it later",
"<C>on your own, or you can quit without saving or sending",
"<C>the bug report.");
my @buttons = ("</B/24>Send", "</B/8>Save", "</B/16>Cancel");
my $choice = popupDialog (\@mesg, \@buttons);
# Redraw the viewer widget.
$viewer->draw();
# Check what they want to do.
if ($choice == 0)
{
# Mail to bug report.
sendBugReport ($subject, $replyAddress, $adminAddress, @bugReport);
}
elsif ($choice == 1)
{
# Save to a file.
saveBugReport (@bugReport);
}
else
{
popupLabel (["<C></B/24>Send Bug Report Canceled."]);
}
}
#
# This saves the bug report to a file.
#
sub saveBugReport
{
my @bugReport = @_;
demos/perlbug view on Meta::CPAN
# Make sure we can write to the file.
while (1)
{
# Get the filename.
$filename = $entry->activate();
# Try to open the filename.
last if open (FILE, ">$filename");
popupLabel (["<C></B/16>Error", "<C>Can not save to the file $filename"]);
}
# Save the bug report to the file.
foreach (@bugReport)
{
print FILE "$_\n";
}
close (FILE);
# Tell the user the file has been saved.
popupLabel (["The bug report has been saved to $filename", "",
"<C>Press any key to continue."]);
}
#
# This sends the bug report to the given addresses.
#
sub sendBugReport
{
my ($subject, $replyAddress, $adminAddress, $cc, @bugReport) = @_;
my $address = "perlbug\@perl.com";
demos/perlbug view on Meta::CPAN
$fh = $msg->open;
foreach (@bugReport)
{
print $fh "$_\n";
}
# Close the mail message (aka send it.)
$fh->close;
# Popup a little message.
popupLabel (["<C>The bug report has been sent."]);
return;
}
else
{
# No, Okay, let's try to use sendmail normally. (normally????)
my $sendmail = "";
# Where oh where are you you today...
foreach (qw(/usr/lib/sendmail /usr/sbin/sendmail /usr/ucblib/sendmail))
{
demos/perlbug view on Meta::CPAN
# Can we even send the bug report?
if ($sendmail eq "")
{
# We can't send the bug report, maybe we can save it to a file.
my @mesg = ("</B/5>Hmmmm.",
"<C>I'm terribly sorry but I can't find sendmail and the package",
"<C>Mail::Send has not been installed, so I can't send your bug",
"<C>report. Since I can't send the bug report, would you like to",
"<C>save it to a file and send it yourself?");
if (popupDialog (\@mesg, ["Yep", "Nope"]) == 0)
{
saveBugReport (@bugReport);
}
return;
}
# Send the message via sendmail.
open (SENDMAIL,"|$sendmail -t");
print SENDMAIL "To: $address\n";
print SENDMAIL "Subject: $subject\n";
print SENDMAIL "Cc: $cc\n" if $cc;
print SENDMAIL "Reply-To: $replyAddress\n" if $replyAddress;
print SENDMAIL "\n\n";
foreach (@bugReport)
{
print SENDMAIL "$_\n";
}
close(SENDMAIL);
# Popup a little message.
popupLabel (["<C>The bug report has been sent."]);
}
}
demos/pkgInfo view on Meta::CPAN
my $dialog = new Cdk::Dialog ('Message' => \@mesg,
'Buttons' => \@buttons);
# Activate it.
my $answer = $dialog->activate();
# If the user hit escape, let the user know the package
# was NOT deleted.
if (!defined $answer)
{
popupLabel (["<C>Escape Hit", "<C>The package was </R>Not<!R> deleted."]);
next;
}
# Check the answer
if ($answer == 1)
{
# Delete the package
system ("pkgrm $name");
}
else
demos/rolodex view on Meta::CPAN
my $filename = $ENV{"HOME"} . "/.rolorc";
my $dbmDir = $ENV{"HOME"} . "/.rolodex";
my %groupInfo = readRCFile ($filename);
my $groupCount = keys %groupInfo;
# Pop up a message stating how many groups were loaded.
if ($groupCount == 0)
{
my $groupMessage = ["</B>Empty rolodex RC file. No groups loaded.",
"<C></B>Press any key to continue."];
popupLabel ($groupMessage);
}
elsif ($groupCount == 1)
{
my $groupMessage = ["</B>There was 1 group loaded from the RC file.",
"<C></B>Press any key to continue."];
popupLabel ($groupMessage);
}
else
{
my $groupMessage = ["</B>There were $groupCount groups loaded from the RC file.",
"<C></B>Press any key to continue."];
popupLabel ($groupMessage);
}
# Start the main loop
for (;;)
{
# Activate the object.
my ($menuItem, $submenuItem) = $menu->activate();
# Make sure they didn't hit escape.
next if ! defined $menuItem;
demos/rolodex view on Meta::CPAN
if (defined $file)
{
my %tmpGroup = readRCFile ($file);
# Check the results.
if (! defined %tmpGroup)
{
my $mesg = ["<C></16>There were too many errors in the file",
"<C></16>$file.",
"<C></16>Are you sure it is a rolodex RC file?"];
popupLabel ($mesg);
}
else
{
%groupInfo = %tmpGroup;
}
}
}
elsif ($submenuItem == 2)
{
# Save the RC file.
demos/rolodex view on Meta::CPAN
'Max' => 256,
'Width' => 20,
'Min' => 2,
'Filler' => "_");
$filename = $entry->activate();
# Check if they supplied a value.
if (!defined $filename)
{
my $mesg = ["<C>No name provided.", "<C>Information not saved."];
popupLabel ($mesg);
}
else
{
saveRCFile ($filename, %groupInfo);
}
undef $entry;
}
elsif ($submenuItem == 4)
{
# Quit
demos/rolodex view on Meta::CPAN
{
# About rolodex.
my $roloInfo = ["<C></U>About Cdk/Perl5 Rolodex", "",
"This demo was written to demonstrate the widgets",
"available with the Cdk Perl5 extension. Not all of",
"the Cdk widgets are used, but most of them have",
"been. I hope this little demonstration helps give",
"you an understanding of what the Cdk Perl5",
"extension offers.", "Have fun with it.", "",
"ttfn,", "<C>Mike", "<C><#HL(30)>", "<C>March 1996"];
popupLabel ($roloInfo);
}
elsif ($submenuItem == 2)
{
# Rolodex statistics.
my $groupCount = keys %groupInfo;
my $roloInfo = ["<C></U>Rolodex Statistics",
"</R>Read Command Filename<!R> </U>$filename",
"</R>Group Count <!R> </U>$groupCount"];
popupLabel ($roloInfo);
}
}
}
#
# This reads an RC file.
#
sub readRCFile
{
my $filename = shift;
demos/rolodex view on Meta::CPAN
{
my ($filename, %info) = @_;
my $date = qx (date);
my $count = 0;
# Open the file.
if (!open (FILE, ">$filename"))
{
my $mesg = ["<C>Could not write RC file to",
"<C>$filename", "<C>Try </R>Save As<!R> option."];
popupLabel ($mesg);
return;
}
# Attach the header to the file.
print FILE "#\n";
print FILE "# This file was automatically created on $date";
print FILE "#\n";
# Start writing the info to the file.
foreach $name (keys %info)
demos/rolodex view on Meta::CPAN
}
# Close the file.
close (FILE);
# Pop up a little message.
if ($count == 1)
{
my $mesg = ["<C>There was 1 group saved to file",
"<C>$filename", "<C>Press any key to continue."];
popupLabel ($mesg);
}
else
{
my $mesg = ["<C>There were $count groups saved to file",
"<C>$filename", "<C>Press any key to continue."];
popupLabel ($mesg);
}
# Reset the global flag.
$GGroupInfoChanged = 0;
return;
}
#
# This adds a new rolodex group to the current list of rolodex groups.
#
demos/rolodex view on Meta::CPAN
'Max' =>256,
'Ypos' => 11);
# Get the group name.
my $newName = $name->activate();
# Did they send in a name.
if (!defined $newName)
{
my $mesg = ["<C>No name provided.", "<C>Group not added."];
popupLabel ($mesg);
return %info;
}
else
{
# Check if the group already exists.
if (defined $info{$newName})
{
my $mesg = ["<C>Sorry the group ($newName) already exists."];
popupLabel ($mesg);
return %info;
}
}
# Get the group description.
while (!defined $description)
{
$description = $desc->activate();
# If there is no description given then tell them they need one.
if (!defined $description)
{
popupLabel (["The group has to have a description."]);
$name->draw();
}
}
# Create the DBM filename.
my $dbm = "${dbmDir}/${newName}.phl";
# Add it to the groupList.
$info{$newName} = "${description}${dbm}";
$GGroupInfoChanged = 1;
demos/rolodex view on Meta::CPAN
$helpWindow->draw('Box' => "FALSE");
# If the list if empty, ask them if they want to add an entry.
if ($#list < 0)
{
my $mesg = ["<C>There were no entries in this group.",
"<C>Do you want to add a new listng?"];
my $buttons = ["<<Yes>>", "<<No>>"];
# Go ahead and ask.
if (popupDialog ($mesg, $buttons) == 0)
{
# Get the new record.
my $newRecord = getNewPhoneRecord();
if (defined $newRecord)
{
my $name = $newRecord->{'Name'};
my $type = $GLineType [$newRecord->{'Type'}];
$rolodexData[0] = $newRecord;
push (@list, "$name ($type)");
}
demos/rolodex view on Meta::CPAN
# Display the phone record.
displayPhoneRecord ($rolodexData[$selection]);
}
# Save the information into the file.
if (!open (FILE, ">$database"))
{
my $mesg = ["<C>Can not save phone information to",
"<C></U>$database", "<C>$!",
"<C>Press any key to continue."];
popupLabel ($mesg);
}
# Start writing.
my $date = qx (date);
print FILE "#\n";
print FILE "# This file was automatically generated on $date";
print FILE "#\n";
for ($x=0; $x <= $#rolodexData; $x++)
{
my $object = $rolodexData[$x];
demos/rolodex view on Meta::CPAN
#
sub deleteRolodexGroup
{
my (%info) = @_;
# Pick which group to delete.
my $name = pickRolodexGroup ("<C></U>Delete Which Rolodex Group?", %info);
if (! defined $name)
{
my $mesg = ["<C> Delete Canceled ", "<C>No Group Deleted"];
popupLabel ($mesg);
return;
}
# Confirm the delete
my $mesg = ["<C></U>Confirm Delete",
"<C>Are you sure you want to delete the group",
"<C></R>$name<!R>?"];
my $buttons = ["<<No>>", "<<Yes>>"];
if (popupDialog ($mesg, $buttons) == 1)
{
# Delete the group.
my $dbm = (split (//, $info{$name}))[1];
delete $info{$name};
unlink $dbm;
$GGroupInfoChanged = 1;
}
return %info;
}
demos/rolodex view on Meta::CPAN
my ($database) = @_;
my @phoneRecords = ();
# Open the database.
if (!open (DB, $database))
{
my $mesg = ["<C></R>Error",
"<C>Could not open the database",
"<C>$database", "<C></U>$!", "",
"<C>Press any key to continue."];
popupLabel ($mesg);
return;
}
# Start scanning through the file.
foreach $row (<DB>)
{
next if $row =~ /^#/;
next if $row =~ /^$/;
chomp $row;
demos/rolodex view on Meta::CPAN
#
# This is a callback to the scrolling list.
#
sub rolodexHelpCB
{
my $mesg = ["<C></R>Rolodex Phone Editor",
"</B>i <!B> Inserts a new phone entry.",
"</B>d <!B> Deletes the currently selected phone entry.",
"</B>Escape <!B> Exits the scrolling list.",
"</B>? <!B> Pops up this help window."];
popupLabel ($mesg);
}
#
# This displays a phone record.
#
sub displayPhoneRecord
{
my $record = shift;
my $type = $GLineType[$record->{'Type'}];
my $mesg = "";
demos/rolodex view on Meta::CPAN
{
$mesg = ["<C></U>$type Phone Record",
"</B/5>Name <!B!5>$record->{'Name'}",
"</B/5>Phone Number<!B!5>$record->{'Number'}",
"</B/5>Address <!B!5>$record->{'Address'}",
"</B/5>City <!B!5>$record->{'City'}",
"</B/5>Province <!B!5>$record->{'Province'}",
"</B/5>Postal Code <!B!5>$record->{'Postal Code'}",
"</B/5>Comment <!B!5>$record->{'Description'}"];
}
popupLabel ($mesg);
}
#
# This gets a new phone record.
#
sub getNewPhoneRecord
{
my @list = ();
my ($record, $type);
demos/rolodex view on Meta::CPAN
# Ask the user what type of line it it.
my $itemList = new Cdk::Itemlist ('Label' => "What Type Of Line Is It?",
'List' => \@list);
while (!defined $type)
{
$type = $itemList->activate();
if (!defined $type)
{
popupLabel (["Please specify a line type."]);
}
}
undef $itemList;
# Given the type, ask certain questions.
if ($GLineType[$type] =~ /Cell/ || $GLineType[$type] =~ /Pager/)
{
$record = getSmallPhoneRecord($type);
}
else
demos/rolodex view on Meta::CPAN
$nameEntry->draw();
$phoneTemp->draw();
$descEntry->draw();
# Get the information.
$name = $nameEntry->activate();
$unmixedPhone = $phoneTemp->activate();
$desc = $descEntry->activate();
# Make sure they want to add this number.
my $answer = popupDialog ($mesg, $buttons);
last if $answer == 0;
return if $answer == 1;
}
# Assemble the information and create the object.
my $phone = $phoneTemp->mix();
my $temp = "$name$type$phone----$desc";
my $object = new PhoneData ($temp);
return $object;
}
demos/rolodex view on Meta::CPAN
# Get the information.
$name = $nameEntry->activate();
$address = $addressEntry->activate();
$city = $cityEntry->activate();
$prov = $provEntry->activate();
$postal = $postalEntry->activate();
$unmixedPhone = $phoneTemp->activate();
$desc = $descEntry->activate();
# Make sure they want to add this number.
my $answer = popupDialog ($mesg, $buttons);
last if $answer == 0;
return if $answer == 1;
}
# Assemble the information and create the object.
my $phone = $phoneTemp->mix();
my $temp = "$name$type$phone$address$city$prov$postal$desc";
my $object = new PhoneData ($temp);
return $object;
}
demos/rolodex view on Meta::CPAN
{
my ($scroll, $data, $list) = @_;
my ($size, $currentItem) = $scroll->info();
my $itemName = $list->[$currentItem];
my $buttons = ["<<No>>", "<<Yes>>"];
my $mesg = ["Do you really want to delete the phone entry",
"<C></R>$itemName"];
my @array = @$data;
# Ask the user if they really want to delete this item.
if (popupDialog ($mesg, $buttons) == 1)
{
# Nuke it.
$scroll->delete ('Position' => $currentItem);
# Remove it from the arrays.
for ($x=$currentItem; $x < $#array; $x++)
{
$data->[$x] = $data->[$x+1];
$list->[$x] = $list->[$x+1];
}
demos/rolodex view on Meta::CPAN
'Choices' => $options);
# Get the selections to print.
my @answer = $select->activate();
undef $select;
# check if the user canceled.
if (!defined @answer)
{
my $mesg = ["Print Canceled"];
popupLabel ($mesg);
return;
}
# Start printing the groups.
for ($x=0; $x <= $#answer; $x++)
{
my $groupName = $list[$x];
if ($answer[$x] == 0)
{
# Create a label for a title.
demos/rolodex view on Meta::CPAN
'Min' => 2,
'Max' => 256);
# Make sure that a filename is given.
while (!defined $filename)
{
$filename = $fileEntry->activate();
if (!defined $filename)
{
popupLabel (["Please supply a filename."]);
}
}
# Print the group to a file.
printGroup ($groupName, %groupInfo, $filename);
}
}
}
#
demos/rolodex view on Meta::CPAN
sub printGroup
{
my ($name, %groupInfo, $filename) = @_;
# Try to open the file.
if (!open (PHONE, ">$filename"))
{
my $mesg = ["<C></R>Error",
"<C>Could not print the group </B>$name<!B> to </B>$filename<!B>.",
"<C></U>$!", "<C>Press any key to continue."];
popupLabel ($mesg);
return;
}
# Open the phone database file and read in the contents.
my ($desc, $dbm) = split (//, $groupInfo{$name});
my @rolodexData = readPhoneDataFile ($dbm);
select (PHONE); $| =1;
# Set variables for the report.
foreach $object (@rolodexData)
demos/rolodex view on Meta::CPAN
sub display
{
my $self = shift;
my %object = %$self;
my @mesg = ();
foreach $key (sort keys %object)
{
push (@mesg, sprintf ("Key = %-10s Value = %-30s", $key, $object{$key}));
}
main::popupLabel (\@mesg);
}
sub print
{
my $object = shift;
foreach $key (sort keys %info)
{
print "Key = $key Value = $info{$key}\n";
}
}
demos/workman view on Meta::CPAN
#!../../../perl
#
# Initialize Cdk.
#
use Cdk;
Cdk::init();
# Pop up the opening label.
popupLabel (["<C></16/B>Workman Database Editor.", "",
"<C></24/B>Written By Mike Glover"]);
# Set a default name for the workman database.
my $workmandb = $ENV{'HOME'} . "/.workmandb";
# Open up the database and read in the contents.
my @cdList = readWorkmanDatabase ($workmandb);
# Let the user play with the given information.
playWithWorkManDatabase (@cdList);
examples/alphalist view on Meta::CPAN
'List' => \@info);
$alphalist->set ('BoxAttribute' => "</R>");
# Activate the object.
my $info = $alphalist->activate();
# Check the results...
if (! defined $info)
{
popupLabel (["<C>You hit escape to exit the widget."]);
}
else
{
popupLabel (["<C>You selected ($info)"]);
}
# Exit Cdk.
Cdk::end();
examples/bind view on Meta::CPAN
# Create a key binding.
my @mesg = ("<C>Hi Mike", "<C></U>How Are You?");
$filename->bind ('Key' => "KEY_TAB", 'Function' => sub {main::callback ($filename);});
# Activate the object.
my $file = $filename->activate();
# Check the results.
if (! defined $file)
{
popupLabel (["<C>Escape hit, no filename entered."]);
}
else
{
popupLabel (["<C>You typed in the filename ($file)"]);
}
# Exit Cdk.
Cdk::end();
examples/buttonbox view on Meta::CPAN
'Width' => 50,
'Cols' => 4,
'Rows' => 1);
# Activate the object.
my $button = $buttonbox->activate();
# Check the results.
if (!defined $button)
{
popupLabel (["<C>Escape hit. No button selected."]);
}
else
{
popupLabel (["<C>You selected button $button"]);
}
# Exit Cdk.
Cdk::end();
examples/dialog view on Meta::CPAN
# Create a key binding.
$dialog->bind ('Key' => '?', 'Function' => sub {main::callback();});
# Activate the object.
my $button = $dialog->activate();
# Check the results.
if (!defined $button)
{
popupLabel (["<C>Escape hit. No button selected."]);
}
else
{
popupLabel (["<C>You selected button $button"]);
}
# Exit Cdk.
Cdk::end();
#
# This is the callback function to the dialog widget.
#
sub callback
{
examples/entry view on Meta::CPAN
'Width' => 20,
'Min' => 0,
'Max' => 256);
# Activate the object.
my $info = $entry->activate();
# Check the results.
if (!defined $info)
{
popupLabel (["<C>You hit escape, nothing returned."]);
}
else
{
popupLabel (["<C>You typed in ($info)"]);
}
# Exit Cdk.
Cdk::end();
examples/fselect view on Meta::CPAN
'Height' => 0,
'Width' => 0);
# Activate the object.
$fselect->set ('ULChar' => "#");
my $filename = $fselect->activate();
# Check the results.
if (! defined $filename)
{
popupLabel (["<C>You hit escape. No file selected."]);
}
else
{
popupLabel (["<C>You selected the following file", "<C>($filename)"]);
}
# Exit Cdk.
Cdk::end();
examples/itemlist view on Meta::CPAN
my $itemlist = new Cdk::Itemlist ('List' => \@months,
'Label' => "Month >>",
'Title' => ["<C>Pick A Month"]);
# Activate the object.
my $choice = $itemlist->activate();
# Check the results
if (!defined $choice)
{
popupLabel (["<C>Escape hit. No item selected."]);
}
else
{
popupLabel (["<C>You selected ($months[$choice])"]);
}
# Exit Cdk.
Cdk::end();
examples/matrix view on Meta::CPAN
# Draw the matrix.
$matrix->draw();
# Activate the matrix.
my ($rows, $cols, $info) = $matrix->activate();
# Check the results.
if (!defined $rows)
{
popupLabel (["<C>Escape hit. No information in the matrix."]);
}
else
{
my @info = ("<C>Rows: $rows Cols: $cols");
for ($x=0; $x < $rows; $x++)
{
my $row = "";
for ($y=0; $y < $cols; $y++)
{
$row .= "($x,$y) = $info->[$x][$y], ";
}
chomp $row; chomp $row;
push (@info, $row);
}
popupLabel (\@info);
}
# Exit Cdk.
Cdk::end();
examples/mentry view on Meta::CPAN
'Width' => 20,
'Prows' => 5,
'Lrows' => 10);
# Activate the object.
my $filename = $mentry->activate();
# Check the results.
if (!defined $filename)
{
popupLabel (["<C>Escape hit. No information returned."]);
}
else
{
popupLabel (["<C>You typed in", "<C>$filename"]);
}
# Shut down Cdk.
Cdk::end();
examples/menu view on Meta::CPAN
# Create the menu object.
my $menu = new Cdk::Menu ('Menulist' => \@menulist,
'Menuloc' => \@menuloc);
# Activate the object.
my ($menuItem, $submenuItem) = $menu->activate();
# Check the results.
if (!defined $menuItem)
{
popupLabel (["<C>Escape hit. No menu item selected."]);
}
else
{
popupLabel (["<C>Item Selected </R>$menulist[$menuItem]->[$submenuItem]"]);
}
# End Cdk.
Cdk::end();
examples/preProcess view on Meta::CPAN
# Set up the pre and post processing.
$entry->preProcess ('Function' => sub {preProcessCB (@_, $entry);});
# Activate the object.
my $info = $entry->activate();
# Check the results.
if (!defined $info)
{
popupLabel (["<C>You hit escape, nothing returned."]);
}
else
{
popupLabel (["<C>You typed in ($info)"]);
}
# Exit Cdk.
Cdk::end();
#
# This example will set the pre process function so it
# will not accept the letter g.
#
sub preProcessCB
{
my ($input, $entry) = @_;
# Check the letter.
if (uc $input eq "G")
{
Cdk::Beep();
popupLabel (["<C>I Told You </B>NOT<!B> To Do That"]);
$entry->draw();
return 0;
}
return 1;
}
examples/radio view on Meta::CPAN
'Height' => 10,
'Width' => 20);
# Activate the radio object.
$radioWidget->set ('Choice' => "#");
my $choice = $radioWidget->activate ();
# Check the results.
if (!defined $choice)
{
popupLabel (["<C>Escape hit. No item selected."]);
}
else
{
popupLabel (["<C>You selected $choice."]);
}
# Exit Cdk.
Cdk::end();
examples/scale view on Meta::CPAN
my $scale = new Cdk::Scale ('Label' => "</5>Pick A Number: ",
'Low' => 1,
'High' => 10);
# Activate the object.
my $number = $scale->activate ();
# Check the results.
if (!defined $number)
{
popupLabel (["<C>Escape hit. No number selected."]);
}
else
{
popupLabel (["<C>You selected $number"]);
}
# Exit Cdk.
Cdk::end();
# Print out the info.
print "\n\n\n";
print "Number Chosen: $number\n";
examples/scroll view on Meta::CPAN
'Spos' => "RIGHT",
'List' => \@listItems);
$scroll->add ('Item' => "HELLO");
# Activate the scrolling list.
my $itemPicked = $scroll->activate ();
# Check the results.
if (!defined $itemPicked)
{
popupLabel (["<C>Escape hit. No menu item selected."]);
}
else
{
popupLabel (["<C>You selected </R>$listItems[$itemPicked]"]);
}
# Exit Cdk.
Cdk::end();
examples/selection view on Meta::CPAN
'Choices' => \@choices,
'Height' => 10,
'Width' => 20);
# Activate the object.
my @info = $selection->activate ();
# Check the results.
if (!defined @info)
{
popupLabel (["<C>Escape hit. No menu item selected."]);
}
else
{
my @list = ("<C></R>Items Selected");
for ($x=0; $x < $#info; $x++)
{
push (@list, "<C>$listItems[$x]") if $info[$x] == 0;
}
popupLabel (\@list);
}
# Exit Cdk.
Cdk::end();
examples/slider view on Meta::CPAN
'Low' => 1,
'High' => 10,
'Width' => 50);
# Activate the object.
my $number = $slider->activate ();
# Check the results.
if (!defined $number)
{
popupLabel (["<C>Escape hit. No menu item selected."]);
}
else
{
popupLabel (["<C>You chose $number"]);
}
# Exit Cdk.
Cdk::end();
examples/template view on Meta::CPAN
# Activate the widget.
my $date = $template->activate();
# Get the mixed date back.
my $mixedDate = $template->mix();
# Check the results.
if (!defined $date)
{
popupLabel (["<C>Escape hit. No information to return."]);
}
else
{
popupLabel (["<C>With Overlay Mixing : $mixedDate",
"<C>Without Overlay Mixing: $date"]);
}
# Exit Cdk.
Cdk::end();
fulldemo/cdkdemo view on Meta::CPAN
my $continue;
my $entry = new Cdk::Entry ('Label' => "</B/56>Enter a new pause prompt: ",
'Max' => 125,
'Width' => 30);
$continue = $entry->activate ();
# Check if they hit escape.
if (! defined $continue)
{
popupLabel (["<C></U>Escape Hit",
"<C>Pause prompt not changed.", "",
"<C>$CONTINUE"]);
return;
}
# Pop up a message stating what we got.
$CONTINUE = $continue;
my @mesg = ("<C>The new pause prompt is now set to",
"<C>what is below this message",
"<C>$CONTINUE");
( run in 4.564 seconds using v1.01-cache-2.11-cpan-364913b4093 )