At 03|59 +0200 2002/04/12, Bart Lateur wrote:
>On Fri, 12 Apr 2002 01:25:05 +0100, p kent wrote:
>>(for entering options that have arguments). Maybe I should be constructing
>>a dialog box, as opposed to a normal window. It's pretty amazing what you
>>can do with a few lines of perl anyway.
>
>Can you show the rest of us some of your more succesful experiments?
>It's not necessary that all of us have to reinvent this paricular wheel,
>especially since it's not what I'd call "trivial".

Well I've now found out how to make dialog boxes and I'm pretty impressed
with the Mac toolbox stuff. Anyway, attached is Getopt::Mac, with POD, and
a little demo program. I don't pretend that this code is particularly
pretty and I'm sure it can be made a lot cleaner. However, it does work on
my machine :-)

Basically you say:

use Getopt::Mac;
our ($opt_a, $opt_b);
getopts( 'ab:' );
print "Got: <$opt_a> <$opt_b>\n";

(or pass in a hashref, just like Getopt::Std)
and the user gets a lovely plain dialog box in which to enter the options,
or click checkboxes.

P
#!perl
use strict;
use Getopt::Mac;
use Data::Dumper;

our ($opt_a, $opt_b);
print "Starting: <$opt_a> <$opt_b>\n";
getopts( 'ab:' );
print "Ending: <$opt_a> <$opt_b>\n\n";

my %hash;
getopts( 'c:d:e', \%hash );
print Dumper \%hash;
package Getopt::Mac;

# A quick bit of code, with code samples gleaned from Google and the
# internet at large, to ask the user for some options.

use Mac::Windows;
use Mac::Events;
use Mac::Dialogs;
require Exporter;

use vars qw(
        %OPTIONS $maxPerDialog $w $h $header $footer $rowheight $x $y
@textIDs @boolIDs %id2optLUT
        @ISA @EXPORT $VERSION
);

@ISA = qw(Exporter);
@EXPORT = qw(getopts);
$VERSION = '1.00';


# I know there's lots of globals here. This is because the code used to
# be a script. These may translate to instance variables in an object,
# or package globals. But for now

# GEOMETRY
$w = 400;                               # dialog width
$header = 28;                   # space for text at the top
$footer = 34;                   # space at the bottom for buttons
$rowheight = 24;                # each option takes up this much vertical space
($x, $y) = (50, 70);    # upper left corner of dialog
$maxPerDialog = 8;              # how many options can we fit in one dialog box

# arguments come in as a string like 'ab:c:', maybe followed by a hashref
sub getopts {
        my ($string, $hashref) = @_;
        my @args;

        # find our arguments in the string
        while ($string =~ s/^\s*(\w:?)\s*//) {
                push @args, $1;
        }
        my (%MASTEROPTIONS, $pageN, $ofPages);

        # does this require many pages?
        if ( @args > $maxPerDialog ) {
                $pageN = 1;
                $ofPages = (int(@args / $maxPerDialog) + 1);
        }

        # get all but one pages (if needed)
        while ( @args > $maxPerDialog ) {
                my @subargs = splice @args, 0, $maxPerDialog;
                my %result = go($pageN++, $ofPages, @subargs);
                unless (keys %result) { return 1; }
                foreach( keys %result ) {
                        $MASTEROPTIONS{ $_ } = $result{ $_ };
                }
        }

        # final page
        my %result = go($pageN, $ofPages, @args);
        unless (keys %result) { return 1; }
        foreach( keys %result ) {
                $MASTEROPTIONS{ $_ } = $result{ $_ };
        }

        # all data is in our hash, return to the user as they wanted it...

        # put in their hash...
        if (ref $hashref) {
                foreach( keys %MASTEROPTIONS ) {
                        $hashref->{ $_ } = $MASTEROPTIONS{ $_ };
                }
        } else {
        # export it all to their namesapce
                foreach ( keys %MASTEROPTIONS ) {
                        my $opt = $_;
                        $opt =~ s/:$//;
                        ${"opt_$opt"} = $MASTEROPTIONS{ $_ };
                    push( @EXPORT, "\$opt_$opt" );
                }
                local $Exporter::ExportLevel = 1;
                import Getopt::Mac;
        }
        return 0;
}

###### PRIVATE ROUTINES #########################################

sub go {
        my ($pageN, $ofPages, @opts) = @_;

        # clear these variables that are used to hold state globally. not
very pretty.
        @textIDs = ();
        @boolIDs = ();
        %id2optLUT = ();
        %OPTIONS = ();

        my $optnum = 0;                 # how many options we've been through

        my $body = (@opts * $rowheight);
        my $h = $header + $body + $footer;

        my $oktext = ($pageN<$ofPages) ? 'Next...' : 'OK';
        my @items = (
                [ kButtonDialogItem(), newRect(210, ($header+$body+7), 80,
20), 'Cancel'], #1
                [ kButtonDialogItem(), newRect(300, ($header+$body+7), 80,
20), $oktext],  #2
                [ kStaticTextDialogItem(), newRect(10, 5, 300, 20), 'Check
the boxes, or type values, as needed'], #3
        );

        if ($pageN) {
                push @items, [ kStaticTextDialogItem(), newRect(320, 5, 80,
20), "Page $pageN/$ofPages"],   #4
        }

        my $currDialogItem = (@items+1);        # the id of the dialog item
that corresponds to the option

        foreach (@opts) {       # loop over the options as given to us
                if (m/^(\w):$/) {
                        push( @items, [ kEditTextDialogItem(), newRect(30,
($header+2+$optnum*$rowheight), 300, 16), ''] );
                        push( @items, [ kStaticTextDialogItem(),
newRect(10, ($header+2+$optnum*$rowheight), 15, 20), $1] );

                        $id2optLUT{ $currDialogItem } = $1;
                        push @textIDs, $currDialogItem;
                        $currDialogItem += 2;
                } else {
                        push( @items, [ kCheckBoxDialogItem(), newRect(27,
($header+$optnum*$rowheight), 50, 20), ''] );
                        push( @items, [ kStaticTextDialogItem(),
newRect(10, ($header+2+$optnum*$rowheight), 15, 20), $_] );

                        $id2optLUT{ $currDialogItem } = $_;
                        push @boolIDs, $currDialogItem;
                        $currDialogItem += 2;
                }
                $optnum++;
        }

        # I'd like a ColorDialog, with a nice platinum grey background, etc.
        my $dlg = new MacDialog(
                newRect($x, $y, $w, $h),        # dialog rectangle
                'Choose options...',            # dialog title
                1,                                                      # is visible?
                movableDBoxProc(),                      # window style
                0,                                                      #
has go away box?
                @items
        );
        SetDialogCancelItem ($dlg->window(), 1);
        SetDialogDefaultItem($dlg->window(), 2);
        $dlg->item_hit(1 => \&btnCancelHndlr);
        $dlg->item_hit(2 => \&btnOKHndlr);

        # install handlers for checkboxen
        foreach (@boolIDs) {
                $dlg->item_hit($_ => \&checkBoxHdlr);
        }

        # Sit there and let the user interact with us
        while ($dlg->window()) {
                WaitNextEvent();
        }

        # cleanup if the dialog exists
        END {
                $dlg->dispose() if (defined($dlg));
        }

        return %OPTIONS;
}

# these two just handle the button clicks
sub btnCancelHndlr {
        my $self = shift;
        $self->dispose();
        return 1;
}

sub btnOKHndlr {
        my $self = shift;

        foreach (@textIDs) {
                $OPTIONS{ $id2optLUT{ $_ } } = $self->item_text( $_ );
        }

        foreach (@boolIDs) {
                $OPTIONS{ $id2optLUT{ $_ } } = $self->item_value( $_ );
        }

        $self->dispose();
        return 1;
}

# utility function
sub newRect {
        my ($x, $y, $w, $h) = @_;
        return Rect->new($x, $y, $x+$w, $y+$h);
}

# toggle the value of a checkbox
sub checkBoxHdlr {
        my ($self, $item) = @_;
        my $value = 1-$self->item_value($item);
        $self->item_value($item, $value);
        return 1;
}

=pod

=head1 NAME

Getopt::Mac - Allegedly friendly way to get options from a user

=head1 SYNOPSIS

        # Make sure you're using MacPerl
        use Getopt::Mac;
        our ($opt_a, $opt_b, $opt_c, $opt_h, $opt_t);
        getopts( 'a:bcht:' );
        # the $opt_* variable will now be set according to the user's responses
        print "Options: $opt_a $opt_b $opt_c\n";

        my %hash;
        getopts( 'X:YZ:', \%hash );
        print $hash{'X'};

=head1 DESCRIPTION

Functionally this is a drop-in replacement for Getopt::Std - well, just the
getopts
routine at the moment, not getopt. It's supposed to have the same
interface. However
the options are gleaned not from @ARGV but from one or more dialog boxes
presented to the user.

The dialog(s) pop-up depending on how many options there are. By default
8 options are put in each dialog box. The user
clicks checkboxes if the options are switches, or they enter text in a
field if the options
take an argument.

If they hit 'Cancel' at any time then the routine returns 1, else 0, and no
variables/hash
keys are set.

=head1 OPTIONS SPECIFICATION

You specify your options in the usual syntax of a string of tokens that are
either
single letters (actually \w characters) or single letters followed by a
colon. Whitespace
between tokens is ignored. Hence:

getopts( 'ab:' ) - says that option 'a' is a simple switch, but 'b' takes
an argument.

You could say getopts( 'a b:' ); to make it a bit more readable.

=head1 SETTINGS

Set $Getopt::Mac::maxPerDialog to the number of items you want, at maximum,
in each dialog box.
Default is 8.

=head1 AUTHOR

P Kent [EMAIL PROTECTED]

=head1 BUGS

Not very pretty code, and may not behave properly. But it seems to work OK
on my MacPerl 5.6.1r1.

=cut
--
[EMAIL PROTECTED]                         "all the world's indeed a stage"
http://www.pkent.me.uk/              For PGP see the keyservers or website
http://www.selsyn.co.uk/
Fax: Britain 0870 137 9220 - America (208) 692-8600

Reply via email to