line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# You may distribute under the terms of either the GNU General Public License |
2
|
|
|
|
|
|
|
# or the Artistic License (the same terms as Perl itself) |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# (C) Paul Evans, 2011-2014 -- leonerd@leonerd.org.uk |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package Tickit::Widget::Frame; |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
790
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
21
|
|
9
|
1
|
|
|
1
|
|
3
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
20
|
|
10
|
1
|
|
|
1
|
|
2
|
use base qw( Tickit::SingleChildWidget ); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
81
|
|
11
|
|
|
|
|
|
|
use Tickit::Style; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
use Tickit::WidgetRole::Alignable name => "title_align"; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our $VERSION = '0.31'; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
use Carp; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
use Tickit::Pen; |
20
|
|
|
|
|
|
|
use Tickit::Utils qw( textwidth substrwidth ); |
21
|
|
|
|
|
|
|
use Tickit::RenderBuffer qw( LINE_SINGLE LINE_DOUBLE LINE_THICK CAP_START CAP_END ); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 NAME |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
C - draw a frame around another widget |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=head1 SYNOPSIS |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
use Tickit; |
30
|
|
|
|
|
|
|
use Tickit::Widget::Frame; |
31
|
|
|
|
|
|
|
use Tickit::Widget::Static; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
my $hello = Tickit::Widget::Static->new( |
34
|
|
|
|
|
|
|
text => "Hello, world", |
35
|
|
|
|
|
|
|
align => "centre", |
36
|
|
|
|
|
|
|
valign => "middle", |
37
|
|
|
|
|
|
|
); |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
my $frame = Tickit::Widget::Frame->new( |
40
|
|
|
|
|
|
|
child => $hello, |
41
|
|
|
|
|
|
|
style => { linetype => "single" }, |
42
|
|
|
|
|
|
|
); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
Tickit->new( root => $frame )->run; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head1 DESCRIPTION |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
This container widget draws a frame around a single child widget. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head1 STYLE |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
The default style pen is used as the widget pen. The following style pen |
53
|
|
|
|
|
|
|
prefixes are also used: |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=over 4 |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=item frame => PEN |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
The pen used to render the frame lines |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=back |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
The following style keys are used: |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=over 4 |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=item linetype => STRING |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
Controls the type of line characters used to draw the frame. Must be one of |
70
|
|
|
|
|
|
|
the following names: |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
ascii single double thick solid_inside solid_outside |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
The C linetype is default, and uses only the C<-|+> ASCII characters. |
75
|
|
|
|
|
|
|
Other linetypes use Unicode box-drawing characters. These may not be supported |
76
|
|
|
|
|
|
|
by all terminals or fonts. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=item linetype_top => STRING |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=item linetype_bottom => STRING |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=item linetype_left => STRING |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=item linetype_right => STRING |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
Overrides the C attribute for each side of the frame specifically. |
87
|
|
|
|
|
|
|
If two line-drawing styles meet at corners they should be drawn correctly if |
88
|
|
|
|
|
|
|
C can combine the line segments, but in other |
89
|
|
|
|
|
|
|
circumstances the corners are drawn as extensions of the top or bottom line, |
90
|
|
|
|
|
|
|
and the left and right lines do not meet it. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
Any edge's linetype may be set to C to cause that edge not to have a |
93
|
|
|
|
|
|
|
line at all; no extra space will be consumed on that side. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=back |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=cut |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
style_definition base => |
100
|
|
|
|
|
|
|
linetype => "ascii"; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
style_redraw_keys qw( linetype linetype_top linetype_bottom linetype_left linetype_right ); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
use constant WIDGET_PEN_FROM_STYLE => 1; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=cut |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head2 $frame = Tickit::Widget::Frame->new( %args ) |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
Constructs a new C object. |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
Takes the following named arguments in addition to those taken by the base |
115
|
|
|
|
|
|
|
L constructor: |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=over 8 |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=item title => STRING |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
Optional. |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=item title_align => FLOAT|STRING |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
Optional. Defaults to C<0.0> if unspecified. |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=back |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
For more details see the accessors below. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=cut |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub new |
134
|
|
|
|
|
|
|
{ |
135
|
|
|
|
|
|
|
my $class = shift; |
136
|
|
|
|
|
|
|
my %args = @_; |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# Previously 'linetype' was called 'style', but it collided with |
139
|
|
|
|
|
|
|
# Tickit::Widget's idea of style |
140
|
|
|
|
|
|
|
if( defined $args{style} and !ref $args{style} ) { |
141
|
|
|
|
|
|
|
$args{style} = { linetype => delete $args{style} }; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
my $self = $class->SUPER::new( %args ); |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
$self->set_title( $args{title} ) if defined $args{title}; |
147
|
|
|
|
|
|
|
$self->set_title_align( $args{title_align} || 0 ); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# Prepopulate has_* caches |
150
|
|
|
|
|
|
|
$self->on_style_changed_values; |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
return $self; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=head1 ACCESSORS |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=cut |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub on_style_changed_values |
160
|
|
|
|
|
|
|
{ |
161
|
|
|
|
|
|
|
my $self = shift; |
162
|
|
|
|
|
|
|
my %values = @_; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
my $reshape = 0; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
my $linetype = $values{linetype}[1] // $self->get_style_values( "linetype" ); |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
# Cache these |
169
|
|
|
|
|
|
|
foreach (qw( top bottom left right )) { |
170
|
|
|
|
|
|
|
no warnings 'uninitialized'; # treat undef as false |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
my $new = ( $values{"linetype_$_"}[1] // $self->get_style_values( "linetype_$_") // $linetype ) |
173
|
|
|
|
|
|
|
ne "none"; |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
$reshape = 1 if $self->{"has_$_"} != $new; |
176
|
|
|
|
|
|
|
$self->{"has_$_"} = $new; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
$self->reshape if $reshape; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub lines |
183
|
|
|
|
|
|
|
{ |
184
|
|
|
|
|
|
|
my $self = shift; |
185
|
|
|
|
|
|
|
my $child = $self->child; |
186
|
|
|
|
|
|
|
return ( $child ? $child->requested_lines : 0 ) + $self->{has_top} + $self->{has_bottom}; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub cols |
190
|
|
|
|
|
|
|
{ |
191
|
|
|
|
|
|
|
my $self = shift; |
192
|
|
|
|
|
|
|
my $child = $self->child; |
193
|
|
|
|
|
|
|
return ( $child ? $child->requested_cols : 0 ) + $self->{has_left} + $self->{has_right}; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
use constant { |
197
|
|
|
|
|
|
|
TOP => 0, |
198
|
|
|
|
|
|
|
BOTTOM => 1, |
199
|
|
|
|
|
|
|
LEFT => 2, |
200
|
|
|
|
|
|
|
RIGHT => 3, |
201
|
|
|
|
|
|
|
CORNER_TL => 4, |
202
|
|
|
|
|
|
|
CORNER_TR => 5, |
203
|
|
|
|
|
|
|
CORNER_BL => 6, |
204
|
|
|
|
|
|
|
CORNER_BR => 7, |
205
|
|
|
|
|
|
|
}; |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
# Character numbers from |
208
|
|
|
|
|
|
|
# http://en.wikipedia.org/wiki/Box-drawing_characters |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
my %LINECHARS = ( # TOP BOTTOM LEFT RIGHT TL TR BL BR |
211
|
|
|
|
|
|
|
ascii => [ '-', '-', '|', '|', '+', '+', '+', '+' ], |
212
|
|
|
|
|
|
|
solid_inside => [ map chr, 0x2584, 0x2580, 0x2590, 0x258C, 0x2597, 0x2596, 0x259D, 0x2598 ], |
213
|
|
|
|
|
|
|
solid_outside => [ map chr, 0x2580, 0x2584, 0x258C, 0x2590, 0x259B, 0x259C, 0x2599, 0x259F ], |
214
|
|
|
|
|
|
|
); |
215
|
|
|
|
|
|
|
my %LINESTYLES = ( |
216
|
|
|
|
|
|
|
single => LINE_SINGLE, |
217
|
|
|
|
|
|
|
double => LINE_DOUBLE, |
218
|
|
|
|
|
|
|
thick => LINE_THICK, |
219
|
|
|
|
|
|
|
); |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=head2 $title = $frame->title |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=cut |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub title |
226
|
|
|
|
|
|
|
{ |
227
|
|
|
|
|
|
|
my $self = shift; |
228
|
|
|
|
|
|
|
return $self->{title}; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=head2 $frame->set_title( $title ) |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
Accessor for the C property, a string written in the top of the |
234
|
|
|
|
|
|
|
frame. |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=cut |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub set_title |
239
|
|
|
|
|
|
|
{ |
240
|
|
|
|
|
|
|
my $self = shift; |
241
|
|
|
|
|
|
|
$self->{title} = $_[0]; |
242
|
|
|
|
|
|
|
$self->redraw; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=head2 $title_align = $frame->title_align |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=head2 $frame->set_title_align( $title_align ) |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
Accessor for the C property. Gives a vlaue in the range C<0.0> to |
250
|
|
|
|
|
|
|
C<1.0> to align the title in the top of the frame. |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
See also L. |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=cut |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
## This should come from Tickit::ContainerWidget |
257
|
|
|
|
|
|
|
sub children_changed { shift->reshape } |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
sub reshape |
260
|
|
|
|
|
|
|
{ |
261
|
|
|
|
|
|
|
my $self = shift; |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
my $window = $self->window or return; |
264
|
|
|
|
|
|
|
my $child = $self->child or return; |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
my $lines = $window->lines; |
267
|
|
|
|
|
|
|
my $cols = $window->cols; |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
my $extra_lines = $self->{has_top} + $self->{has_bottom}; |
270
|
|
|
|
|
|
|
my $extra_cols = $self->{has_left} + $self->{has_right}; |
271
|
|
|
|
|
|
|
if( $lines > $extra_lines and $cols > $extra_cols ) { |
272
|
|
|
|
|
|
|
my @geom = ( $self->{has_top}, $self->{has_left}, $lines - $extra_lines, $cols - $extra_cols ); |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
if( my $childwin = $child->window ) { |
275
|
|
|
|
|
|
|
$childwin->change_geometry( @geom ); |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
else { |
278
|
|
|
|
|
|
|
my $childwin = $window->make_sub( @geom ); |
279
|
|
|
|
|
|
|
$child->set_window( $childwin ); |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
else { |
283
|
|
|
|
|
|
|
if( $child->window ) { |
284
|
|
|
|
|
|
|
$child->set_window( undef ); |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
sub render_to_rb |
290
|
|
|
|
|
|
|
{ |
291
|
|
|
|
|
|
|
my $self = shift; |
292
|
|
|
|
|
|
|
my ( $rb, $rect ) = @_; |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
$rb->setpen( $self->get_style_pen( "frame" ) ); |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
my $cols = $self->window->cols; |
297
|
|
|
|
|
|
|
my $lines = $self->window->lines; |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
my $right = $cols - 1; |
300
|
|
|
|
|
|
|
my $bottom = $lines - 1; |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
my $linetype = $self->get_style_values( "linetype" ); |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
my $linetype_top = $self->get_style_values( "linetype_top" ) // $linetype; |
305
|
|
|
|
|
|
|
my $linetype_bottom = $self->get_style_values( "linetype_bottom" ) // $linetype; |
306
|
|
|
|
|
|
|
my $linetype_left = $self->get_style_values( "linetype_left" ) // $linetype; |
307
|
|
|
|
|
|
|
my $linetype_right = $self->get_style_values( "linetype_right" ) // $linetype; |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
my $top_is_line = defined $LINESTYLES{$linetype_top}; |
310
|
|
|
|
|
|
|
my $bottom_is_line = defined $LINESTYLES{$linetype_bottom}; |
311
|
|
|
|
|
|
|
my $left_is_line = defined $LINESTYLES{$linetype_left}; |
312
|
|
|
|
|
|
|
my $right_is_line = defined $LINESTYLES{$linetype_right}; |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
my $h_caps = ( $left_is_line ? 0 : CAP_START ) | ( $right_is_line ? 0 : CAP_END ); |
315
|
|
|
|
|
|
|
my $v_caps = ( $top_is_line ? 0 : CAP_START ) | ( $bottom_is_line ? 0 : CAP_END ); |
316
|
|
|
|
|
|
|
my $v_start = $top_is_line ? 0 : $self->{has_top}; |
317
|
|
|
|
|
|
|
my $v_end = $bottom_is_line ? $bottom : $bottom - $self->{has_bottom}; |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
my $linechars; |
320
|
|
|
|
|
|
|
my $style; |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
# Top |
323
|
|
|
|
|
|
|
if( $rect->top == 0 ) { |
324
|
|
|
|
|
|
|
if( $linechars = $LINECHARS{$linetype_top} ) { |
325
|
|
|
|
|
|
|
$rb->goto( 0, 0 ); |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
$rb->text( $linechars->[$linetype_top eq $linetype_left ? CORNER_TL : TOP] ); |
328
|
|
|
|
|
|
|
$rb->text( $linechars->[TOP] x ($cols - 2) ) if $cols > 2; |
329
|
|
|
|
|
|
|
$rb->text( $linechars->[$linetype_top eq $linetype_right ? CORNER_TR : TOP] ) if $cols > 1; |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
elsif( $style = $LINESTYLES{$linetype_top} ) { |
332
|
|
|
|
|
|
|
$rb->hline_at( 0, 0, $right, $style, undef, $h_caps ); |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
if( defined( my $title = $self->title ) ) { |
336
|
|
|
|
|
|
|
my $cols = $self->window->cols; |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
# At most we can fit $cols-4 columns of title |
339
|
|
|
|
|
|
|
my ( $left, $titlewidth, $right ) = $self->_title_align_allocation( textwidth( $title ), $cols - 4 ); |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
$rb->goto( 0, 1 + $left ); |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
$rb->text( " " ); |
344
|
|
|
|
|
|
|
$rb->text( $title ); |
345
|
|
|
|
|
|
|
$rb->text( " " ); |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
# Left |
350
|
|
|
|
|
|
|
if( $rect->left == 0 ) { |
351
|
|
|
|
|
|
|
if( $linechars = $LINECHARS{$linetype_left} ) { |
352
|
|
|
|
|
|
|
$rb->text_at( $_, 0, $linechars->[LEFT] ) for 1 .. $bottom-1; |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
elsif( $style = $LINESTYLES{$linetype_left} ) { |
355
|
|
|
|
|
|
|
$rb->vline_at( $v_start, $v_end, 0, $style, undef, $v_caps ); |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
# Right |
359
|
|
|
|
|
|
|
if( $rect->right == $cols and $cols > 1 ) { |
360
|
|
|
|
|
|
|
if( $linechars = $LINECHARS{$linetype_right} ) { |
361
|
|
|
|
|
|
|
$rb->text_at( $_, $right, $linechars->[RIGHT] ) for 1 .. $bottom-1; |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
elsif( $style = $LINESTYLES{$linetype_right} ) { |
364
|
|
|
|
|
|
|
$rb->vline_at( $v_start, $v_end, $right, $style, undef, $v_caps ); |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
# Bottom |
369
|
|
|
|
|
|
|
if( $rect->bottom == $lines and $lines > 1 ) { |
370
|
|
|
|
|
|
|
if( $linechars = $LINECHARS{$linetype_bottom} ) { |
371
|
|
|
|
|
|
|
$rb->goto( $bottom, 0 ); |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
$rb->text( $linechars->[$linetype_bottom eq $linetype_left ? CORNER_BL : BOTTOM] ); |
374
|
|
|
|
|
|
|
$rb->text( $linechars->[BOTTOM] x ($cols - 2) ) if $cols > 2; |
375
|
|
|
|
|
|
|
$rb->text( $linechars->[$linetype_bottom eq $linetype_right ? CORNER_BR : BOTTOM] ) if $cols > 1; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
elsif( $style = $LINESTYLES{$linetype_bottom} ) { |
378
|
|
|
|
|
|
|
$rb->hline_at( $bottom, 0, $right, $style, undef, $h_caps ); |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
=head1 TODO |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
=over 4 |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
=item * |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
Specific pen for title. Layered on top of frame pen. |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=item * |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
Caption at the bottom of the frame as well. Identical to title. |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=item * |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
Consider if it's useful to provide accessors to apply extra padding inside the |
398
|
|
|
|
|
|
|
frame, surrounding the child window. |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=back |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
=head1 AUTHOR |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
Paul Evans |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=cut |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
0x55AA; |