1# -*- perl -*- 2 3# 4# Author: Slaven Rezic 5# 6# Copyright (C) 1999, 2000 Slaven Rezic. All rights reserved. 7# This package is free software; you can redistribute it and/or 8# modify it under the same terms as Perl itself. 9# 10# Mail: srezic@cpan.org 11# WWW: http://www.rezic.de/ 12# 13 14package Tk::LayerEditorToplevel; 15use Tk::Toplevel; 16use Tk::LayerEditorCore; 17use vars qw(@ISA $VERSION); 18@ISA = qw(Tk::LayerEditorCore Tk::Toplevel); 19$VERSION = $Tk::LayerEditorCore::VERSION; 20Construct Tk::Widget 'LayerEditorToplevel'; 21 22sub Populate { 23 my($w, $args) = @_; 24 $w->Tk::Toplevel::Populate($args); 25 26 my $f = $w->Component('Frame' => 'buttons' 27 )->pack(-fill => 'x', -side => "bottom"); 28 29 $w->CommonPopulate($args); 30 31 if (delete $args->{'buttons'}) { 32 my $o_b = $f->Button(-command => [$w, 'OK'], 33 )->pack(-side => 'left', 34 -expand => 1, 35 -fill => 'x' 36 ); 37 $w->Advertise('ok' => $o_b); 38 my $a_b = $f->Button(-command => [$w, 'Apply'], 39 )->pack(-side => 'left', 40 -expand => 1, 41 -fill => 'x'); 42 $w->Advertise('apply' => $a_b); 43 my $c_b = $f->Button(-command => [$w, 'Cancel'], 44 )->pack(-side => 'left', 45 -expand => 1, 46 -fill => 'x'); 47 $w->Advertise('cancel' => $c_b); 48 } else { 49 my $c_b = $f->Button(-command => [$w, 'destroy'], 50 )->pack(-fill => 'x'); 51 $w->Advertise('close' => $c_b); 52 } 53 54 $w->ConfigSpecs 55 ( 56 $w->SUPER::CommonConfigSpecs(), 57 -okcmd => ['CALLBACK',undef,undef,undef], 58 -applycmd => ['CALLBACK',undef,undef,undef], 59 -cancelcmd => ['CALLBACK',undef,undef,undef], 60 -transient => ['METHOD',undef,undef,undef], 61 -title => ['METHOD','title','Title','Layer editor'], 62 -oklabel => ['METHOD','okLabel','OkLabel','OK'], 63 -applylabel => ['METHOD','applyLabel','ApplyLabel','Apply'], 64 -cancellabel => ['METHOD','cancelLabel','CancelLabel','Cancel'], 65 -closelabel => ['METHOD','closeLabel','CloseLabel','Close'], 66 ); 67} 68 69sub transient { 70 my($w) = shift; 71 my $ret; 72 if (@_) { 73 if ($_[0]) { 74 $ret = $w->SUPER::transient($_[0]); 75 } else { 76 $ret = $w->SUPER::transient; 77 } 78 } 79 $ret; 80} 81 82sub title { 83 my($w) = shift; 84 if (@_) { 85 $w->Tk::Toplevel::title($_[0]); 86 } else { 87 $w->Tk::Toplevel::title; 88 } 89} 90 91sub _set_label { 92 my($w, $subwname, $val) = @_; 93 my $subw = $w->Subwidget($subwname); 94 if ($subw) { 95 if (defined $val) { 96 $subw->configure(-text => $val); 97 } else { 98 return $subw->cget(-text); 99 } 100 } 101} 102 103sub oklabel { $_[0]->_set_label('ok', $_[1]) } 104sub applylabel { $_[0]->_set_label('apply', $_[1]) } 105sub cancellabel { $_[0]->_set_label('cancel', $_[1]) } 106sub closelabel { $_[0]->_set_label('close', $_[1]) } 107 108sub OK { 109 my $w = shift; 110 $w->Call(-okcmd); 111} 112 113sub Apply { 114 my $w = shift; 115 $w->Call(-applycmd); 116} 117 118sub Cancel { 119 my $w = shift; 120 $w->Call(-cancelcmd); 121} 122 1231; 124 125__END__ 126 127=head1 NAME 128 129Tk::LayerEditorToplevel - a gimp-like layer dialog 130 131=head1 SYNOPSIS 132 133 use Tk; 134 use Tk::LayerEditorToplevel; 135 $top = new MainWindow; 136 $c = $top->Canvas->pack; 137 $le = $top->LayerEditor(...)->pack; 138 $le->add(...); 139 140=head1 DESCRIPTION 141 142This is a Tk::LayerEditor widget embedded in a Toplevel window. See 143the L<Tk::LayerEditor|Tk::LayerEditor> documentation for further 144options and methods. 145 146=head1 STANDARD OPTIONS 147 148=head1 WIDGET-SPECIFIC OPTIONS 149 150=head1 METHODS 151 152=head1 EXAMPLES 153 154=head1 BUGS/TODO 155 156=head1 AUTHOR 157 158Slaven Rezic <eserte@cs.tu-berlin.de> 159 160=head1 COPYRIGHT 161 162Copyright (c) 1999, 2000 Slaven Rezic. All rights reserved. 163This module is free software; you can redistribute it and/or modify 164it under the same terms as Perl itself. 165 166=head1 SEE ALSO 167 168Tk::LayerEditor(3), Tk::Toplevel(3). 169 170=cut 171 172