ZooZ
view release on metacpan or search on metacpan
ZooZ/Forms.pm view on Meta::CPAN
# populate family list.
$l4->insert(end => $_) for sort $top->fontFamilies;
$F4->Button(-text => 'Ok',
-command => sub {
my $name = "$FONTDATA{family} $FONTDATA{size} $FONTDATA{weight} $FONTDATA{slant} " .
($FONTDATA{underline} ? 'u ' : '') . ($FONTDATA{overstrike} ? 'o': '');
$name =~ y/ /_/;
#print "Name is $name.\n";
# register it unless font already exists.
unless ($::FONTOBJ->FontExists($name)) {
# create it and register it.
my $obj = $top->fontCreate($name,
map {
'-' . $_ => $FONTDATA{$_}
} qw/family size weight slant underline overstrike/);
$::FONTOBJ->add($name, $obj);
}
$FONTDATA{localReturn} = $name;
})->pack(qw/-side top -padx 5 -pady 0 -fill x/);
$F4->Button(-text => 'Cancel',
-command => [\&cancelForm, \%FONTDATA],
)->pack(qw/-side top -padx 5 -pady 0 -fill x/);
my $sample = $f2->Label(-text => "There's More Than One Way To Do It",
)->pack(qw/-side top/);
my $default = $sample->cget('-font');
if ($default =~ /\{(.+)\}\s+(\d+)/) {
$FONTDATA{family} = $1;
$FONTDATA{size} = $2;
} else {
$FONTDATA{family} = '';
$FONTDATA{size} = 8;
}
$FONTDATA{weight} = 'normal';
$FONTDATA{slant} = 'roman';
$FONTDATA{underline} = 0;
$FONTDATA{overstrike} = 0;
for my $i (0 .. $l4->size - 1) {
next unless $l4->get($i) eq $FONTDATA{family};
$l4->selectionSet($i);
$l4->see($i);
last;
}
$f5->Label(-text => 'Size',
)->grid(-column => 0, -row => 0, -sticky => 'w');
$f5->Optionmenu(-options => [5 .. 25],
-textvariable => \$FONTDATA{size},
-command => [\&configureSampleFont, $sample],
)->grid(-column => 1, -row => 0, -sticky => 'ew',
-columnspan => 2);
$f5->Label(-text => 'Weight',
)->grid(-column => 0, -row => 1, -sticky => 'w');
$f5->Radiobutton(-text => 'Normal',
-value => 'normal',
-variable => \$FONTDATA{weight},
-command => [\&configureSampleFont, $sample],
)->grid(-column => 1, -row => 1, -sticky => 'w');
$f5->Radiobutton(-text => 'Bold',
-value => 'bold',
-variable => \$FONTDATA{weight},
-command => [\&configureSampleFont, $sample],
)->grid(-column => 2, -row => 1, -sticky => 'w');
$f5->Label(-text => 'Slant',
)->grid(-column => 0, -row => 2, -sticky => 'w');
$f5->Radiobutton(-text => 'Normal',
-value => 'roman',
-variable => \$FONTDATA{slant},
-command => [\&configureSampleFont, $sample],
)->grid(-column => 1, -row => 2, -sticky => 'w');
$f5->Radiobutton(-text => 'Italic',
-value => 'italic',
-variable => \$FONTDATA{slant},
-command => [\&configureSampleFont, $sample],
)->grid(-column => 2, -row => 2, -sticky => 'w');
$f5->Label(-text => 'Underline',
)->grid(-column => 0, -row => 3, -sticky => 'w');
$f5->Checkbutton(-text => 'Yes/No',
-variable => \$FONTDATA{underline},
-command => [\&configureSampleFont, $sample],
)->grid(-column => 1, -row => 3, -sticky => 'ew',
-columnspan => 2);
$f5->Label(-text => 'Overstrike',
)->grid(-column => 0, -row => 4, -sticky => 'w');
$f5->Checkbutton(-text => 'Yes/No',
-variable => \$FONTDATA{overstrike},
-command => [\&configureSampleFont, $sample],
)->grid(-column => 1, -row => 4, -sticky => 'ew',
-columnspan => 2);
# when user selects a registered font, update the other widgets.
$l3->bind('<1>' => sub {
my ($sel) = $l3->curselection;
defined $sel or return;
$sel = $l3->get($sel);
my $obj = $::FONTOBJ->obj($sel);
# update all the vars.
for my $o (qw/family size weight slant underline overstrike/) {
$FONTDATA{$o} = $obj->configure("-$o");
}
# configure the sample.
$sample->configure(-font => $obj);
# select the correct entry in the list of available fonts.
for my $i (0 .. $l4->size - 1) {
next unless $l4->get($i) eq $FONTDATA{family};
$l4->selectionClear(qw/0.0 end/);
$l4->selectionSet($i);
$l4->see($i);
last;
}
});
# when user selects a new font, update the sample and some vars.
$l4->bind('<1>' => sub {
my ($sel) = $l4->curselection;
defined $sel or return;
$l3->selectionClear(qw/0.0 end/);
$FONTDATA{family} = $l4->get($sel);
configureSampleFont($sample);
});
# to take care of waitVariable.
$top->protocol(WM_DELETE_WINDOW => sub {
$FONTDATA{localReturn} = '';
});
$FONTDATA{list} = $l3;
}
sub setup_chooseCallback {
# this form let's users add/delete callbacks/subroutines.
# as a side effect, it returns the name of the
# selected callback so it can be used to assign
# callbacks to -command arguments.
my ($class, $top) = @_;
my $f1 = $top->Labelframe(-text => 'Defined Subroutines',
)->pack(qw/-side top -fill both -expand 1/);
my $f2 = $top->Frame->pack(qw/-side bottom -fill x -padx 5 -pady 5/);
my $l = $f1->Scrolled(qw/Listbox -scrollbars se/,
-selectmode => 'single',
-width => 40,
ZooZ/Forms.pm view on Meta::CPAN
$f2->Button(-text => "Return Nothing\n(Unsets binding)",
-command => sub {
$VARDATA{localReturn} = 'UNSET';
})->pack(qw/-side left -fill both -expand 1/);
$f2->Button(-text => 'Cancel',
-height => 2,
-command => [\&cancelForm, \%VARDATA],
)->pack(qw/-side left -fill x -expand 1/);
# to take care of waitVariable.
$top->protocol(WM_DELETE_WINDOW => sub {
$VARDATA{localReturn} = '';
});
$l->bind('<Double-1>' => [\&initSelectedVar, $top, $l]);
}
sub initSelectedVar {
my $l = pop;
my $top = pop;
my $sel = $l->curselection;
return unless defined $sel;
my $var = $l->get($sel);
$var =~ s/^(.)//; # the sigil.
my $s = $1;
unless ($VARDATA{initForm}) {
my $t = $VARDATA{initForm} = $top->DialogBox(-title => 'Initialize Variable',
-buttons => [qw/Ok Cancel/],
-popover => $top);
$t->bind('<Return>' => ''); # remove default.
# create a frame for each type of variable.
{
my $f = $VARDATA{initScalarF} = $t->Frame;
$f->Label(-text => 'Enter Value',
-anchor => 'w',
)->pack(qw/-fill x/);
$VARDATA{initScalarV} = $f->Entry->pack(qw/-fill x/);
}
{
my $f = $VARDATA{initArrayF} = $t->Frame;
$f->Label(-text => 'Enter Values One Per Line',
-anchor => 'w',
)->pack(qw/-fill x/);
$VARDATA{initArrayV} = $f->Scrolled(Text =>
-scrollbars => 'e',
)->pack(qw/-fill both -expand 1/);
}
{
my $f = $VARDATA{initHashF} = $t->Frame;
$f->Label(-anchor => 'w',
-justify => 'left',
-text => <<EOT)->grid(-columnspan => 2);
Enter key value pairs.
Each line on the left will define a key and
each line on the right will define the corresponding value.
EOT
;
$f->Label(-text => 'Keys',
-font => 'OptionText',
)->grid(-row => 1, -column => 0, -sticky => 'w');
$f->Label(-text => 'Values',
-font => 'OptionText',
)->grid(-row => 1, -column => 1, -sticky => 'w');
my $t1 = $f->Scrolled(Text =>
-scrollbars => 'e',
-width => 20,
-bd => 1,
-wrap => 'none',
)->grid(-row => 2, -column => 0);
my $t2 = $f->Scrolled(Text =>
-scrollbars => 'e',
-width => 20,
-bd => 1,
-wrap => 'none',
)->grid(-row => 2, -column => 1);
# define bindings such that the tab key
# jumps between the two texts.
# must jump to same location.
$VARDATA{initHashK} = $t1->Subwidget('text');
$VARDATA{initHashV} = $t2->Subwidget('text');
$_->bindtags([$_, 'Tk::Text']) for $VARDATA{initHashK}, $VARDATA{initHashV};
$VARDATA{initHashK}->bind('<Tab>' => sub {
my $loc = $VARDATA{initHashK}->index('insert');
my $end = $VARDATA{initHashV}->index('end');
$loc =~ s/\..*//;
$end =~ s/\..*//;
$VARDATA{initHashV}->insert(end => "\n") for $end .. $loc;
$VARDATA{initHashV}->focus;
$VARDATA{initHashV}->markSet(insert => "$loc.0");
Tk::break;
});
$VARDATA{initHashV}->bind('<Tab>' => sub {
my $loc = $VARDATA{initHashV}->index('insert');
$loc =~ s/\..*//;
$VARDATA{initHashK}->insert(end => "\n")
if $VARDATA{initHashK}->get("$loc.0") =~ /\S/ &&
$VARDATA{initHashK}->get(($loc+1).".0") !~ /\S/;
$VARDATA{initHashK}->focus;
$VARDATA{initHashK}->markSet(insert => ($loc+1) . ".0");
Tk::break;
});
}
}
my $f = $s eq "\$" ? 'initScalarF' : $s eq '@' ? 'initArrayF' : 'initHashF';
# populate with the any old values.
{
ZooZ/Forms.pm view on Meta::CPAN
$VARDATA{initScalarV}->insert(0, $ {"main::$var"});
} elsif ($f =~ /Array/) {
$VARDATA{initArrayV}->delete(qw/0.0 end/);
$VARDATA{initArrayV}->insert(end => "$_\n") for @{"main::$var"};
} else { # hash
$VARDATA{$_}->delete(qw/0.0 end/) for qw/initHashK initHashV/;
for my $k (sort keys %{"main::$var"}) {
$VARDATA{initHashK}->insert(end => "$k\n");
$VARDATA{initHashV}->insert(end => $ {"main::$var"}{$k} . "\n");
}
}
}
$VARDATA{$_}->packForget for qw/initScalarF initArrayF initHashF/;
$VARDATA{$f}->pack(qw/-fill both -expand 1/);
my $ans = $VARDATA{initForm}->Show;
return if $ans eq 'Cancel';
# set the value.
{
no strict;
if ($f =~ /Scalar/) {
$ {"main::$var"} = $VARDATA{initScalarV}->get;
} elsif ($f =~ /Array/) {
@ {"main::$var"} = split /\n/ => $VARDATA{initArrayV}->get(qw/0.0 end/);
} else { # hash
%{"main::$var"} = ();
my @k = split /\n/ => $VARDATA{initHashK}->get(qw/0.0 end/);
for my $i (1 .. @k) {
my $v = $VARDATA{initHashV}->get("$i.0", "$i.end");
$ {"main::$var"}{$k[$i - 1]} = $v;
}
}
}
}
###############
#
# Setup the form to configure the menus.
#
###############
sub setup_configureMenu {
my ($class, $top) = @_;
# Create a label that is easy to see to tell user what widget
# is being configured.
$top->Label(
-textvariable => \$MENUDATA{FormName},
-font => 'WidgetName',
-fg => 'darkolivegreen',
-bg => 'white',
-borderwidth => 1,
-relief => 'ridge',
-pady => 5,
)->grid(-row => 0,
-column => 0,
-columnspan => 2,
-sticky => 'ew');
my $hl = $top->Scrolled(HList =>
-scrollbars => 'se',
-bg => 'white',
-header => 1,
-columns => 4,
)->grid(-row => 1,
-column => 0,
-rowspan => 2,
-sticky => 'nsew',
);
$hl->header(create => 0, -relief => 'raised', -text => 'Label');
$hl->header(create => 1, -relief => 'raised', -text => 'Type');
$hl->header(create => 2, -relief => 'raised', -text => 'Accelerator');
$hl->header(create => 3, -relief => 'raised', -text => 'Command');
my $det = $top->Labelframe(-text => 'Details',
)->grid(-row => 1,
-column => 1,
-sticky => 'ns',
);
# my $but = $top->Frame->grid(-row => 1,
# -column => 2,
# -sticky => 'ns',
# );
my $but = $top->Frame->grid(-row => 2,
-column => 1,
-sticky => 'ns',
);
# create the buttons.
$but->Button(-text => 'Add',
)->pack(qw/-side left -fill x -expand 1/);
$but->Button(-text => 'Delete Selected',
)->pack(qw/-side left -fill x -expand 1/);
# now the details.
$top->gridRowconfigure (1, -weight => 1);
$top->gridColumnconfigure(0, -weight => 1);
$MENUDATA{HL} = $hl;
# bind for mouse wheel.
ZooZ::Generic::BindMouseWheel($top, sub {
my $r = $CONFDATA{NB}->raised;
($CONFDATA{$r}->packSlaves)[0];
});
}
#########################
#
# This should be called as a static sub
#
#########################
# IS THIS NECESSARY?
ZooZ/Forms.pm view on Meta::CPAN
);
}
$rf->Button(-text => 'Add Page',
-command => sub {
return unless $o->{Name};
# does the page exist?
my @pages = $widget->pages;
if (grep $_ eq $o->{Name}, @pages) {
ZooZ::Generic::popMessage
(-over => $::MW,
-msg => "Page '$o->{Name}' already exists!",
-font => 'Level',
-bg => 'White',
-delay => 1500);
return;
}
# add it.
my $tab = $widget->add($o->{Name}, map {
$_ ne 'Name' && $o->{$_} ? ($_ => $o->{$_}) : ()
} keys %$o);
# make room for it in the preview.
$tab ->GeometryRequest(100, 100);
$widget->Resize;
$CONFDATA{NBCONF}{$projid}{$name}{TABS}{$o->{Name}} = [$o->{-label}, $tab];
$lb->insert(end => $o->{Name});
})->pack(qw/-fill x/);
# When a user clicks on a listbox entry, the options are updated.
$lb->bind('<1>' => sub {
my ($sel) = $lb->curselection;
defined $sel or return;
$sel = $lb->get($sel);
#my $tabs = $CONFDATA{NBCONF}{$projid}{$name}{TABS};
$o->{Name} = $sel;
$o->{$_} = $widget->pagecget($sel, $_) for @TAB_OPTIONS;
});
$p->gridRowconfigure($row, -weight => 1);
ZooZ::Generic::BindMouseWheel($t, $p);
}
# update the listbox.
my $ref = $CONFDATA{NBCONF}{$projid}{$name};
$ref->{LB}->delete(qw/0 end/);
$ref->{LB}->insert(end => $_) for keys %{$ref->{TABS}};
$ref->{TOP}->deiconify;
#$top->waitVisibility;
})->grid(-row => $row,
-column => 0,
-sticky => 'nsew',
-columnspan => 3,
-pady => 10,
-pady => 5,
);
# Check if we have menu builder support enabled.
} elsif (main::MENU_BUILDER_SUPPORT && ref($widget) eq 'Tk::Toplevel') {
$MENUS[$projid]{ENABLED} = 0;
my $lf;
my $cb = $f->Checkbutton(-text => 'Add Menu',
-variable => \$MENUS[$projid]{ENABLED},
-command => sub {
if ($MENUS[$projid]{ENABLED}) {
$_->configure(-state => 'normal') for $lf->children;
} else {
$_->configure(-state => 'disabled') for $lf->children;
}
});
$lf = $f->Labelframe(#-text => 'Menus',
-labelwidget => $cb,
-relief => 'ridge',
)->grid(-row => $row+1,
-column => 0,
-sticky => 'nsew',
-columnspan => 3,
);
$lf->Button(-text => 'Configure Menu',
-command => [\&configureMenu, __PACKAGE__, $project, $projid, $name, $widget],
)->pack(qw/-fill both -expand 1/);
# initially .. set everything to disabled state.
$_->configure(-state => 'disabled') for $lf->children;
}
}
# populate the placement options frame.
if (defined $Poptions) {
my $f1 = $g->Labelframe(-text => "Stick to Which Container's Edge",
)->pack(qw/-side top -fill both -expand 0/);
my $f2 = $g->Labelframe(-text => "Internal Padding",
)->pack(qw/-side top -fill both -expand 0/);
my $f3 = $g->Labelframe(-text => "External Padding",
)->pack(qw/-side top -fill both -expand 0/);
my $f4 = $g->Labelframe(-text => 'Apply Same Settings to ...',
)->pack(qw/-side top -fill both -expand 0/);
for my $ref ([qw/North n/],
[qw/South s/],
[qw/East e/],
[qw/West w/]
) {
$Poptions->{$ref->[1]} ||= '';
$f1->Checkbutton(-text => $ref->[0],
-onvalue => $ref->[1],
-offvalue => '',
-borderwidth => 1,
-variable => \$Poptions->{$ref->[1]},
-font => 'OptionText',
-command => sub {
$Poptions->{-sticky} = join '' => @{$Poptions}{qw/n s e w/};
})->pack(qw/-side top -anchor w/);
}
tie $Poptions->{-sticky} =>
'ZooZ::TiedVar', $widget, '', 'grid', '-sticky';
my $row = 0;
for my $ref (['Horizontal', '-ipadx'],
['Vertical', '-ipady'],
) {
$Poptions->{$ref->[1]} ||= 0;
my $label = ZooZ::Options->addOptionGrid(
$ref->[1],
$ref->[0],
$f2,
$row,
0,
\$Poptions->{$ref->[1]},
);
ZooZ/Forms.pm view on Meta::CPAN
$row,
0,
\$Poptions->{$ref->[1]},
);
tie $Poptions->{$ref->[1]} =>
'ZooZ::TiedVar', $widget, 0, 'grid', $ref->[1], $label;
$row++;
}
$_->gridColumnconfigure(0, -weight => 1) for $f2, $f3;
$_->gridColumnconfigure(1, -weight => 5) for $f2, $f3;
my $duplicate = 'All Widgets';
$f4->BrowseEntry(
-choices => [
'All Widgets',
'Similar Widgets',
'All Widgets in Same Row',
'All Widgets in Same Column',
'Similar Widgets in Same Row',
'Similar Widgets in Same Column',
],
-state => 'readonly',
-variable => \$duplicate,
-disabledforeground => 'black',
)->pack(qw/-side top -fill x -padx 10 -pady 10/);
$f4->Button(-text => 'Apply',
-command => [$project, 'duplicatePlacementOptions', \$duplicate],
)->pack(qw/-fill x/);
}
# populate the extra options frame
if (defined $Eoptions) {
# First, the scrollbars options.
my $f1 = $h->Labelframe(-text => 'Scrollbars',
)->pack(qw/-side top -fill both -expand 0/);
$Eoptions->{$_} = 0 for qw/SCROLLON HOPTIONAL VOPTIONAL/;
$Eoptions->{$_} = '' for qw/HSCROLLLOC VSCROLLLOC/;
my $scrollCB = $f1->Checkbutton(-text => 'Enable Scrollbars',
-variable => \$Eoptions->{SCROLLON},
-font => 'OptionText',
)->pack(qw/-side top/);
my $f11 = $f1->Frame(-relief => 'sunken',
-borderwidth => 1,
)->pack(qw/-side top -fill both -expand 1/);
$f11->Label(-text => 'Horizontal',
)->grid(-column => 0, -row => 1, -sticky => 'w');
$f11->Checkbutton(-text => 'Display Only if Needed',
-variable => \$Eoptions->{HOPTIONAL},
-font => 'OptionText',
)->grid(-column => 1,
-row => 1,
-sticky => 'w',
-columnspan => 3,
);
$f11->Radiobutton(-text => 'North',
-value => 'n',
-variable => \$Eoptions->{HSCROLLLOC},
-font => 'OptionText',
)->grid(-column => 1,
-row => 2,
-sticky => 'ew');
$f11->Radiobutton(-text => 'South',
-value => 's',
-variable => \$Eoptions->{HSCROLLLOC},
-font => 'OptionText',
)->grid(-column => 2,
-row => 2,
-sticky => 'ew');
$f11->Radiobutton(-text => 'None',
-value => '',
-variable => \$Eoptions->{HSCROLLLOC},
-font => 'OptionText',
)->grid(-column => 3,
-row => 2,
-sticky => 'ew');
$f11->Label(-text => 'Vertical',
)->grid(-column => 0, -row => 3, -sticky => 'w');
$f11->Checkbutton(-text => 'Display Only if Needed',
-variable => \$Eoptions->{VOPTIONAL},
-font => 'OptionText',
)->grid(-column => 1,
-row => 3,
-sticky => 'w',
-columnspan => 3,
);
$f11->Radiobutton(-text => 'East',
-value => 'e',
-variable => \$Eoptions->{VSCROLLLOC},
-font => 'OptionText',
)->grid(-column => 1,
-row => 4,
-sticky => 'ew');
$f11->Radiobutton(-text => 'West',
-value => 'w',
-variable => \$Eoptions->{VSCROLLLOC},
-font => 'OptionText',
)->grid(-column => 2,
-row => 4,
-sticky => 'ew');
$f11->Radiobutton(-text => 'None',
-value => '',
-variable => \$Eoptions->{VSCROLLLOC},
-font => 'OptionText',
)->grid(-column => 3,
-row => 4,
-sticky => 'ew');
$f11->gridColumnconfigure(0, -weight => 1);
# start with all disabled.
$_->configure(-state => 'disabled') for $f11->children;
# Tie the variables.
# Whenever the SCROLLON value changes, enable/disable the options.
Tie::Watch->new(
-variable => \$Eoptions->{SCROLLON},
-store => [\&scrollState, $Eoptions, $widget, $f11],
);
# Show appropriate scrollbars when chosen.
Tie::Watch->new(
-variable => \$Eoptions->{HSCROLLLOC},
-store => [\&addScrolls, $Eoptions, $widget],
);
Tie::Watch->new(
-variable => \$Eoptions->{VSCROLLLOC},
-store => [\&addScrolls, $Eoptions, $widget],
);
# is it scrollable?
$scrollCB->configure(-state => 'disabled') unless $scroll;
}
}
# configure the window title
my $top = $TOPLEVEL{configureWidget};
$top->title("Configure Widget - Project $projid");
return if $noforce && !$top->ismapped;
# display the correct frames in the notebook.
$_->packForget for map $_->packSlaves => (
( run in 1.103 second using v1.01-cache-2.11-cpan-9581c071862 )