1#
2# This file is part of Tk-Sugar
3#
4# This software is copyright (c) 2009 by Jerome Quelin.
5#
6# This is free software; you can redistribute it and/or modify it under
7# the same terms as the Perl 5 programming language system itself.
8#
9use 5.008;
10use strict;
11use warnings;
12
13package Tk::Sugar;
14our $VERSION = '1.093190';
15
16
17# ABSTRACT: Sugar syntax for Tk
18
19use Sub::Exporter -setup => {
20    exports => [ qw{
21        top bottom left right
22        fillx filly fill2 xfillx xfilly xfill2 expand
23        pad pad1 pad2 pad5 pad10 pad20 padx pady
24        ipad ipad1 ipad2 ipad5 ipad10 ipad20 ipadx ipady
25        enabled disabled
26        N S E W C NE NW SE SW
27        horizontal vertical
28    } ],
29    groups  => {
30        fill    => [ qw{ fillx filly fill2 xfillx xfilly xfill2 expand } ],
31        side    => [ qw{ top bottom left right } ],
32        pad     => [ qw{ pad pad1 pad2 pad5 pad10 pad20 padx pady } ],
33        ipad    => [ qw{ ipad ipad1 ipad2 ipad5 ipad10 ipad20 ipadx ipady } ],
34        pack    => [ qw{ -fill -side -pad -ipad } ],
35        state   => [ qw{ enabled disabled } ],
36        anchor  => [ qw{ N S E W C NE NW SE SW } ],
37        orient  => [ qw{ horizontal vertical } ],
38        options => [ qw{ -state -anchor -orient } ],
39        default => [ qw{ -pack -options } ],
40    }
41};
42
43## no critic (ProhibitSubroutinePrototypes)
44
45# -- pack options
46# cf perldoc Tk::pack for more information
47
48# pack sides
49sub top    () { return ( -side => 'top'    ); }
50sub bottom () { return ( -side => 'bottom' ); }
51sub left   () { return ( -side => 'left'   ); }
52sub right  () { return ( -side => 'right'  ); }
53
54# pack fill / expand
55sub fillx  () { return ( -fill => 'x'    ); }
56sub filly  () { return ( -fill => 'y'    ); }
57sub fill2  () { return ( -fill => 'both' ); }
58sub xfillx () { return ( -expand => 1, -fill => 'x'    ); }
59sub xfilly () { return ( -expand => 1, -fill => 'y'    ); }
60sub xfill2 () { return ( -expand => 1, -fill => 'both' ); }
61sub expand () { return ( -expand => 1 ); }
62
63# padding
64sub pad1  () { return ( -padx => 1,  -pady => 1  ); }
65sub pad2  () { return ( -padx => 2,  -pady => 2  ); }
66sub pad5  () { return ( -padx => 5,  -pady => 5  ); }
67sub pad10 () { return ( -padx => 10, -pady => 10 ); }
68sub pad20 () { return ( -padx => 20, -pady => 20 ); }
69sub pad  { my $n=shift; return ( -padx => $n, -pady => $n ); }
70sub padx { my $n=shift; return ( -padx => $n ); }
71sub pady { my $n=shift; return ( -pady => $n ); }
72
73# internal padding
74sub ipad1  () { return ( -ipadx => 1,  -ipady => 1  ); }
75sub ipad2  () { return ( -ipadx => 2,  -ipady => 2  ); }
76sub ipad5  () { return ( -ipadx => 5,  -ipady => 5  ); }
77sub ipad10 () { return ( -ipadx => 10, -ipady => 10 ); }
78sub ipad20 () { return ( -ipadx => 20, -ipady => 20 ); }
79sub ipad  { my $n=shift; return ( -ipadx => $n, -ipady => $n ); }
80sub ipadx { my $n=shift; return ( -ipadx => $n ); }
81sub ipady { my $n=shift; return ( -ipady => $n ); }
82
83
84# -- common widget options
85# cf perldoc Tk::options for more information
86
87# widget state
88sub enabled  () { return ( -state => 'normal'   ); }
89sub disabled () { return ( -state => 'disabled' ); }
90
91# anchor
92sub N  () { return ( -anchor => 'n'      ); }
93sub S  () { return ( -anchor => 's'      ); }
94sub E  () { return ( -anchor => 'e'      ); }
95sub W  () { return ( -anchor => 'w'      ); }
96sub C  () { return ( -anchor => 'center' ); }
97sub NE () { return ( -anchor => 'ne'     ); }
98sub NW () { return ( -anchor => 'nw'     ); }
99sub SE () { return ( -anchor => 'se'     ); }
100sub SW () { return ( -anchor => 'sw'     ); }
101
102# orientation
103sub horizontal () { return ( -orient => 'horizontal' ); }
104sub vertical   () { return ( -orient => 'vertical' ); }
105
106
107
1081;
109
110
111=pod
112
113=head1 NAME
114
115Tk::Sugar - Sugar syntax for Tk
116
117=head1 VERSION
118
119version 1.093190
120
121=head1 SYNOPSIS
122
123    use Tk::Sugar qw{ :pack :state };
124
125    $widget->pack( top, xfill2, pad10 );
126    # equivalent to those pack options:
127    #     -side   => 'top'
128    #     -expand => 1
129    #     -fill   => 'both'
130    #     -padx   => 10
131    #     -pady   => 10
132
133    $widget->configure( enabled );
134    # equivalent to: -state => 'enabled'
135
136=head1 DESCRIPTION
137
138L<Tk> is a great graphical toolkit to write desktop applications.
139However, one can get bothered with the constant typing of quotes and
140options. L<Tk::Sugar> provides handy subs for common options used when
141programming Tk.
142
143Benefits are obvious:
144
145=over 4
146
147=item * Reduced typing.
148
149The constant need to type C<< => >> and C<''> is fine for one-off cases,
150but the instant you start using Tk it starts to get annoying.
151
152=item * More compact statements.
153
154Reduces much of the redundant typing in most cases, which makes your
155life easier, and makes it take up less visual space, which makes it
156faster to read.
157
158=item * No string worries.
159
160Strings are often problematic, since they aren't checked at compile-
161time. Sometimes it makes spotting an error a difficult task. Using this
162alleviates that worry.
163
164=back
165
166=head1 EXPORTS
167
168This module is using L<Sub::Exporter> underneath, so you can use all its
169shenanigans to change the export names.
170
171=head2 Exported subs
172
173Look below for the list of available subs.
174
175=head3 Pack options
176
177Traditional packer sides (available as C<:side> export group):
178
179=over 4
180
181=item * top - equivalent to C<< ( -side => 'top' ) >>
182
183=item * bottom - ditto for C<bottom>
184
185=item * left - ditto for C<left>
186
187=item * right - ditto for C<right>
188
189=back
190
191Packer expand and filling (available as C<:fill> export group):
192
193=over 4
194
195=item * fillx - equivalent to C<< ( -fill => 'x' ) >>
196
197=item * filly - equivalent to C<< ( -fill => 'y' ) >>
198
199=item * fill2 - equivalent to C<< ( -fill => 'both' ) >>
200
201=item * xfillx - same as C<fillx> with C<< ( -expand => 1 ) >>
202
203=item * xfilly - ditto for C<filly>
204
205=item * xfill2 - ditto for C<fill2>
206
207=item * expand - equivalent to C<< ( -expand => 1 ) >> if you don't like
208the C<xfill*> notation
209
210=back
211
212Packer padding (available as C<:pad> export group):
213
214=over 4
215
216=item * pad1 - equivalent to C<< ( -padx => 1, -pady => 1 ) >>
217
218=item * pad2 - ditto with 2 pixels
219
220=item * pad5 - ditto with 5 pixels
221
222=item * pad10 - ditto with 10 pixels
223
224=item * pad20 - ditto with 20 pixels
225
226=item * pad($n) - ditto with $n pixels (function call with one argument)
227
228=item * padx($n) - x padding with $n pixels (function call with one argument)
229
230=item * pady($n) - y padding with $n pixels (function call with one argument)
231
232=back
233
234Packer padding (available as C<:ipad> export group):
235
236=over 4
237
238=item * ipad1 - equivalent to C<< ( -ipadx => 1, -ipady => 1 ) >>
239
240=item * ipad2 - ditto with 2 pixels
241
242=item * ipad5 - ditto with 5 pixels
243
244=item * ipad10 - ditto with 10 pixels
245
246=item * ipad20 - ditto with 20 pixels
247
248=item * ipad($n) - ditto with $n pixels (function call with one argument)
249
250=item * ipadx($n) - internal x padding with $n pixels (function call
251with one argument)
252
253=item * ipady($n) - internal y padding with $n pixels (function call
254with one argument)
255
256=back
257
258=head3 Common options
259
260Widget state (available as C<:state> export group):
261
262=over 4
263
264=item * enabled - equivalent to C<< ( -state => 'normal' ) >>
265
266=item * disabled - ditto for C<disabled>
267
268=back
269
270Widget anchor (available as C<:anchor> export group). Note that those
271subs are upper case, otherwise the sub C<s> would clash with the regex
272substitution:
273
274=over 4
275
276=item * N - equivalent to C<< ( -anchor => 'n' ) >>
277
278=item * S - ditto with C<s>
279
280=item * E - ditto with C<e>
281
282=item * W - ditto with C<w>
283
284=item * C - ditto with C<center>
285
286=item * NE - ditto with C<ne>
287
288=item * NW - ditto with C<nw>
289
290=item * SE - ditto with C<se>
291
292=item * SW - ditto with C<sw>
293
294=back
295
296Widget orientation (available as C<:orient> export group).:
297
298=over 4
299
300=item * horizontal - equivalent to C<< ( -orient => 'horizontal' ) >>
301
302=item * vertical - ditto with C<vertical>
303
304=back
305
306=head2 Export groups
307
308Beside the individual groups outlined above, the following export groups
309exist for your convenience:
310
311=over 4
312
313=item :default
314
315This exports all existing subs.
316
317=item :pack
318
319This exports subs related to L<Tk::pack> options. Same as C<:side>,
320C<:fill>, C<:pad> and C<:ipad>.
321
322=item :options
323
324This exports subs related to widget configure options. Same as
325C<:state>, C<:anchor> and C<:orient>.
326
327=back
328
329=head1 SEE ALSO
330
331You can look for information on this module at:
332
333=over 4
334
335=item * Search CPAN
336
337L<http://search.cpan.org/dist/Tk-Sugar/>
338
339=item * Open / report bugs
340
341L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Tk-Sugar>
342
343=item * Git repository
344
345L<http://github.com/jquelin/tk-sugar.git>
346
347=item * AnnoCPAN: Annotated CPAN documentation
348
349L<http://annocpan.org/dist/Tk-Sugar>
350
351=item * CPAN Ratings
352
353L<http://cpanratings.perl.org/d/Tk-Sugar>
354
355=back
356
357=head1 AUTHOR
358
359  Jerome Quelin
360
361=head1 COPYRIGHT AND LICENSE
362
363This software is copyright (c) 2009 by Jerome Quelin.
364
365This is free software; you can redistribute it and/or modify it under
366the same terms as the Perl 5 programming language system itself.
367
368=cut
369
370
371__END__