| 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
|
|
829
|
use strict; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
31
|
|
|
9
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
22
|
|
|
10
|
1
|
|
|
1
|
|
3
|
use base qw( Tickit::SingleChildWidget ); |
|
|
1
|
|
|
|
|
0
|
|
|
|
1
|
|
|
|
|
85
|
|
|
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; |