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