#!/usr/bin/env perl
use
5.010;
our
$VERSION
=
'1.007'
;
our
$LAST_UPDATE
=
'1.007'
;
my
$compat_mode
= 0;
my
$repeat_default
= 1;
my
$oddeven_default
= 1;
my
$padding_default
= 2;
if
(
$compat_mode
) {
(
$repeat_default
,
$oddeven_default
,
$padding_default
) = (0, 0, 0);
}
else
{
(
$repeat_default
,
$oddeven_default
,
$padding_default
) = (1, 1, 2);
}
my
$fg_color_default
=
'black'
;
my
$h_fg_color_default
=
'#000066'
; # fg text color
for
header
my
$h_bg_color_default
=
'#FFFFAA'
; # bg color
for
header
my
$font_size_default
= 12;
my
$leading_ratio
= 1.25;
my
$border_w_default
= 1;
my
$max_wordlen_default
= 20;
my
$empty_cell_text
=
'-'
;
my
$dashed_rule_default
= 2;
my
$min_col_width
= 2;
my
$ink
= 1;
print
__PACKAGE__.
' is version: '
.
$VERSION
.$/
if
(
$ENV
{
'PDF_TABLE_DEBUG'
});
sub
new {
my
$type
=
shift
(
@_
);
my
$class
=
ref
(
$type
) ||
$type
;
my
$self
= {};
bless
(
$self
,
$class
);
$self
->_init(
@_
);
return
$self
;
}
sub
_init {
my
(
$self
,
$pdf
,
$page
,
$data
,
%options
) =
@_
;
$self
->set_defaults();
$self
->set_pdf(
$pdf
);
$self
->set_page(
$page
);
$self
->set_data(
$data
);
$self
->set_options(\
%options
);
return
;
}
sub
set_defaults {
my
$self
=
shift
;
$self
->{
'font_size'
} =
$font_size_default
;
$min_col_width
= max(
$min_col_width
, 1);
return
;
}
sub
set_pdf {
my
(
$self
,
$pdf
) =
@_
;
$self
->{
'pdf'
} =
$pdf
;
return
;
}
sub
set_page {
my
(
$self
,
$page
) =
@_
;
if
(
defined
(
$page
) &&
ref
(
$page
) ne
'PDF::API2::Page'
&&
ref
(
$page
) ne
'PDF::Builder::Page'
) {
if
(
ref
(
$self
->{
'pdf'
}) eq
'PDF::API2'
||
ref
(
$self
->{
'pdf'
}) eq
'PDF::Builder'
) {
$self
->{
'page'
} =
$self
->{
'pdf'
}->page();
}
else
{
carp
'Warning: Page must be a PDF::API2::Page or PDF::Builder::Page object but it seems to be: '
.
ref
(
$page
).$/;
carp
'Error: Cannot set page from passed PDF object either, as it is invalid!'
.$/;
}
return
;
}
$self
->{
'page'
} =
$page
;
return
;
}
sub
set_data {
my
(
$self
,
$data
) =
@_
;
return
;
}
sub
set_options {
my
(
$self
,
$options
) =
@_
;
return
;
}
sub
table {
my
$self
=
shift
;
my
$pdf
=
shift
;
my
$page
=
shift
;
my
$data
=
shift
;
my
%arg
=
@_
;
unless
(
$pdf
and
$page
and
$data
) {
carp
"Error: Mandatory parameter is missing PDF/page/data object!\n"
;
return
(
$page
, 0, 0);
}
croak
"Error: Invalid PDF object received."
unless
(
ref
(
$pdf
) eq
'PDF::API2'
||
ref
(
$pdf
) eq
'PDF::Builder'
);
croak
"Error: Invalid page object received."
unless
(
ref
(
$page
) eq
'PDF::API2::Page'
||
ref
(
$page
) eq
'PDF::Builder::Page'
);
croak
"Error: Invalid data received."
unless
((
ref
(
$data
) eq
'ARRAY'
) &&
scalar
(
@$data
));
croak
"Error: Missing required settings."
unless
(
scalar
(
keys
%arg
));
(
$repeat_default
,
$oddeven_default
,
$padding_default
) =
@{
$arg
{
'compatibility'
}}
if
defined
$arg
{
'compatibility'
};
$arg
{
'cell_render_hook'
} ||=
undef
;
$ink
=
$arg
{
'ink'
}
if
defined
$arg
{
'ink'
};
my
@vsizes
;
my
%valid_settings_key
= (
'x'
=> 1,
'w'
=> 1,
'y'
=> 1,
'start_y'
=> 1,
'h'
=> 1,
'start_h'
=> 1,
'ink'
=> 1,
'next_y'
=> 1,
'next_h'
=> 1,
'leading'
=> 1,
'lead'
=> 1,
'padding'
=> 1,
'padding_right'
=> 1,
'padding_left'
=> 1,
'padding_top'
=> 1,
'padding_bottom'
=> 1,
'bg_color'
=> 1,
'background_color'
=> 1,
'bg_color_odd'
=> 1,
'background_color_odd'
=> 1,
'bg_color_even'
=> 1,
'background_color_even'
=> 1,
'fg_color'
=> 1,
'font_color'
=> 1,
'fg_color_odd'
=> 1,
'font_color_odd'
=> 1,
'fg_color_even'
=> 1,
'font_color_even'
=> 1,
'border_w'
=> 1,
'border'
=> 1,
'h_border_w'
=> 1,
'horizontal_borders'
=> 1,
'v_border_w'
=> 1,
'vertical_borders'
=> 1,
'border_c'
=> 1,
'border_color'
=> 1,
'rule_w'
=> 1,
'h_rule_w'
=> 1,
'v_rule_w'
=> 1,
'rule_c'
=> 1,
'h_rule_c'
=> 1,
'v_rule_c'
=> 1,
'font'
=> 1,
'font_size'
=> 1,
'underline'
=> 1,
'font_underline'
=> 1,
'min_w'
=> 1,
'max_w'
=> 1,
'min_rh'
=> 1,
'row_height'
=> 1,
'new_page_func'
=> 1,
'header_props'
=> 1,
'row_props'
=> 1,
'column_props'
=> 1,
'cell_props'
=> 1,
'max_word_length'
=> 1,
'cell_render_hook'
=> 1,
'default_text'
=> 1,
'justify'
=> 1,
'size'
=> 1,
);
foreach
my
$key
(
keys
%arg
) {
$arg
{
$key
} =
delete
$arg
{
"-$key"
}
if
$key
=~ s/^-//;
croak
"Error: Invalid setting key '$key' received."
unless
exists
$valid_settings_key
{
$key
};
}
my
(
$xbase
,
$ybase
,
$width
,
$height
) = (
undef
,
undef
,
undef
,
undef
);
$xbase
=
$arg
{
'x'
} || -1;
$ybase
=
$arg
{
'y'
} ||
$arg
{
'start_y'
} || -1;
$width
=
$arg
{
'w'
} || -1;
$height
=
$arg
{
'h'
} ||
$arg
{
'start_h'
} || -1;
unless
(
$xbase
> 0 ) {
carp
"Error: Left Edge of Table is NOT defined!\n"
;
return
(
$page
, 0,
$ybase
);
}
unless
(
$ybase
> 0 ) {
carp
"Error: Base Line of Table is NOT defined!\n"
;
return
(
$page
, 0,
$ybase
);
}
unless
(
$width
> 0 ) {
carp
"Error: Width of Table is NOT defined!\n"
;
return
(
$page
, 0,
$ybase
);
}
unless
(
$height
> 0 ) {
carp
"Error: Height of Table is NOT defined!\n"
;
return
(
$page
, 0,
$ybase
);
}
my
$bottom_margin
=
$ybase
-
$height
;
my
$pg_cnt
= 1;
my
$cur_y
=
$ybase
;
my
$cell_props
=
$arg
{
'cell_props'
} || [];
if
(
ref
$data
ne
'ARRAY'
) {
carp
"Passed table data is not an ARRAY reference. It's actually a ref to "
.
ref
(
$data
);
return
(
$page
, 0,
$cur_y
);
}
my
$next_y
=
$arg
{
'next_y'
} ||
undef
;
my
$next_h
=
$arg
{
'next_h'
} ||
undef
;
my
$size
=
$arg
{
'size'
} ||
undef
;
my
$txt
=
$page
->text();
if
(!
$ink
) {
@vsizes
= (0, 0, 0);
$ybase
=
$height
= 2147000000;
}
my
$header_props
=
undef
;
my
$do_headers
= 0;
if
(
defined
$arg
{
'header_props'
} and
ref
(
$arg
{
'header_props'
}) eq
'HASH'
) {
$header_props
=
$arg
{
'header_props'
};
$header_props
->{
'repeat'
} //=
$repeat_default
;
$do_headers
= 1;
$do_headers
= 2
if
$header_props
->{
'repeat'
};
}
my
$header_row
=
undef
;
@$header_row
=
$$data
[0]
if
$do_headers
;
my
$col_props
=
$arg
{
'column_props'
} || [];
my
$row_props
=
$arg
{
'row_props'
} || [];
PDF::Table::Settings::deprecated_settings(
$data
,
$row_props
,
$col_props
,
$cell_props
,
$header_props
, \
%arg
);
PDF::Table::Settings::check_settings(
%arg
);
my
$fnt_obj
=
$arg
{
'font'
} ||
$pdf
->corefont(
'Times-Roman'
,
-encode
=>
'latin1'
);
my
$fnt_size
=
$arg
{
'font_size'
} ||
$font_size_default
;
my
$min_leading
=
$fnt_size
*
$leading_ratio
;
my
$leading
=
$arg
{
'leading'
} ||
$min_leading
;
if
(
$leading
<
$fnt_size
) {
carp
"Warning: Global leading value $leading is less than font size $fnt_size, increased to $min_leading\n"
;
$arg
{
'leading'
} =
$leading
=
$min_leading
;
}
my
$border_w
=
defined
$arg
{
'border_w'
}?
$arg
{
'border_w'
}: 1;
my
$h_border_w
=
$arg
{
'h_border_w'
} ||
$border_w
;
my
$v_border_w
=
$arg
{
'v_border_w'
} ||
$border_w
;
my
$border_c
=
$arg
{
'border_c'
} ||
$fg_color_default
;
my
$underline
=
$arg
{
'underline'
} ||
undef
;
my
$max_word_len
=
$arg
{
'max_word_length'
} ||
$max_wordlen_default
;
my
$default_text
=
$arg
{
'default_text'
} ||
$empty_cell_text
;
my
$row_col_widths
= [];
my
$h_row_widths
= [];
my
(
$max_col_w
,
$min_col_w
) = ( 0,0 );
my
(
$row
,
$space_w
);
my
$word_widths
= {};
my
$rows_height
= [];
my
$first_row
= 1;
my
$is_header_row
= 0;
my
(
$cell_font
,
$cell_font_size
,
$cell_underline
,
$cell_justify
,
$cell_height
,
$cell_pad_top
,
$cell_pad_right
,
$cell_pad_bot
,
$cell_pad_left
,
$cell_leading
,
$cell_max_word_len
,
$cell_bg_color
,
$cell_fg_color
,
$cell_bg_color_even
,
$cell_bg_color_odd
,
$cell_fg_color_even
,
$cell_fg_color_odd
,
$cell_min_w
,
$cell_max_w
,
$cell_h_rule_w
,
$cell_v_rule_w
,
$cell_h_rule_c
,
$cell_v_rule_c
,
$cell_def_text
,
$cell_markup
);
my
$GLOBALS
= [
$cell_props
,
$col_props
,
$row_props
, -1, -1, \
%arg
];
my
$col_min_width
= [];
my
$col_max_content
= [];
my
$max_w
= [];
for
(
my
$row_idx
= 0;
$row_idx
<
scalar
(
@$data
) ;
$row_idx
++ ) {
$GLOBALS
->[3] =
$row_idx
;
my
$column_widths
= [];
$rows_height
->[
$row_idx
] = 0;
for
(
my
$col_idx
= 0;
$col_idx
<
scalar
(@{
$data
->[
$row_idx
]});
$col_idx
++ ) {
$GLOBALS
->[4] =
$col_idx
;
$col_min_width
->[
$col_idx
]=0
if
!
defined
$col_min_width
->[
$col_idx
];
$col_max_content
->[
$col_idx
]=0
if
!
defined
$col_max_content
->[
$col_idx
];
my
$bad_markup
=
''
;
if
(
ref
(
$data
->[
$row_idx
][
$col_idx
]) eq
''
) {
$cell_markup
=
''
;
}
elsif
(
ref
(
$data
->[
$row_idx
][
$col_idx
]) eq
'ARRAY'
) {
if
(!
defined
$data
->[
$row_idx
][
$col_idx
]->[0]) {
$bad_markup
=
'array has no data'
;
}
else
{
$cell_markup
=
$data
->[
$row_idx
][
$col_idx
]->[0];
if
(
$cell_markup
ne
'none'
&&
$cell_markup
ne
'md1'
&&
$cell_markup
ne
'html'
&&
$cell_markup
ne
'pre'
) {
$bad_markup
=
"markup type '$cell_markup' unsupported"
;
}
elsif
(
defined
$data
->[
$row_idx
][
$col_idx
]->[1] &&
ref
(
$data
->[
$row_idx
][
$col_idx
]->[1]) ne
''
&&
ref
(
$data
->[
$row_idx
][
$col_idx
]->[1]) ne
'ARRAY'
) {
$bad_markup
=
'data not string or array of strings'
;
}
elsif
(
defined
$data
->[
$row_idx
][
$col_idx
]->[2] &&
ref
(
$data
->[
$row_idx
][
$col_idx
]->[2]) ne
'HASH'
) {
$bad_markup
=
'options not hash ref'
;
}
}
}
else
{
my
$string
=
''
;
$bad_markup
=
''
;
eval
{
$string
=
''
.
$data
->[
$row_idx
][
$col_idx
]; };
$bad_markup
=
'is not a string or array reference'
if
$@;
$data
->[
$row_idx
][
$col_idx
] =
$string
;
}
if
(
$bad_markup
ne
''
) {
carp
"Cell $row_idx,$col_idx $bad_markup.\n"
;
$data
->[
$row_idx
][
$col_idx
] =
'(invalid)'
;
$cell_markup
=
''
;
}
if
( !
$row_idx
&&
$do_headers
) {
$is_header_row
= 1;
$GLOBALS
->[3] = 0;
$cell_font
=
$header_props
->{
'font'
};
$cell_font_size
=
$header_props
->{
'font_size'
};
$cell_leading
=
$header_props
->{
'leading'
};
$cell_height
=
$header_props
->{
'min_rh'
};
$cell_pad_top
=
$header_props
->{
'padding_top'
} ||
$header_props
->{
'padding'
};
$cell_pad_right
=
$header_props
->{
'padding_right'
} ||
$header_props
->{
'padding'
};
$cell_pad_bot
=
$header_props
->{
'padding_bottom'
} ||
$header_props
->{
'padding'
};
$cell_pad_left
=
$header_props
->{
'padding_left'
} ||
$header_props
->{
'padding'
};
$cell_max_word_len
=
$header_props
->{
'max_word_length'
};
$cell_min_w
=
$header_props
->{
'min_w'
};
$cell_max_w
=
$header_props
->{
'max_w'
};
$cell_def_text
=
$header_props
->{
'default_text'
};
}
else
{
$is_header_row
= 0;
$cell_font
=
undef
;
$cell_font_size
=
undef
;
$cell_leading
=
undef
;
$cell_height
=
undef
;
$cell_pad_top
=
undef
;
$cell_pad_right
=
undef
;
$cell_pad_bot
=
undef
;
$cell_pad_left
=
undef
;
$cell_max_word_len
=
undef
;
$cell_min_w
=
undef
;
$cell_max_w
=
undef
;
$cell_def_text
=
undef
;
}
$cell_font
= find_value(
$cell_font
,
'font'
,
''
,
$fnt_obj
,
$GLOBALS
);
$cell_font_size
= find_value(
$cell_font_size
,
'font_size'
,
''
, 0,
$GLOBALS
);
if
(
$cell_font_size
== 0) {
if
(
$is_header_row
) {
$cell_font_size
=
$fnt_size
+ 2;
}
else
{
$cell_font_size
=
$fnt_size
;
}
}
$cell_leading
= find_value(
$cell_leading
,
'leading'
,
''
, -1,
$GLOBALS
);
$cell_height
= find_value(
$cell_height
,
'min_rh'
,
''
, 0,
$GLOBALS
);
$cell_pad_top
= find_value(
$cell_pad_top
,
'padding_top'
,
'padding'
,
$padding_default
,
$GLOBALS
);
$cell_pad_right
= find_value(
$cell_pad_right
,
'padding_right'
,
'padding'
,
$padding_default
,
$GLOBALS
);
$cell_pad_bot
= find_value(
$cell_pad_bot
,
'padding_bottom'
,
'padding'
,
$padding_default
,
$GLOBALS
);
$cell_pad_left
= find_value(
$cell_pad_left
,
'padding_left'
,
'padding'
,
$padding_default
,
$GLOBALS
);
$cell_max_word_len
= find_value(
$cell_max_word_len
,
'max_word_len'
,
''
,
$max_word_len
,
$GLOBALS
);
$cell_min_w
= find_value(
$cell_min_w
,
'min_w'
,
''
,
undef
,
$GLOBALS
);
$cell_max_w
= find_value(
$cell_max_w
,
'max_w'
,
''
,
undef
,
$GLOBALS
);
if
(
defined
$cell_max_w
&&
defined
$cell_min_w
) {
$cell_max_w
= max(
$cell_max_w
,
$cell_min_w
);
}
$cell_def_text
= find_value(
$cell_def_text
,
'default_text'
,
''
,
$default_text
,
$GLOBALS
);
my
$min_leading
=
$cell_font_size
*
$leading_ratio
;
if
(
$cell_leading
<= 0) {
$cell_leading
=
$min_leading
;
}
else
{
if
(
$cell_leading
<
$cell_font_size
) {
carp
"Warning: Cell[$row_idx][$col_idx] leading value $cell_leading is less than font size $cell_font_size, increased to $min_leading\n"
;
$cell_leading
=
$min_leading
;
}
}
$txt
->font(
$cell_font
,
$cell_font_size
);
$rows_height
->[
$row_idx
] = max(
$rows_height
->[
$row_idx
],
$cell_leading
+
$cell_pad_top
+
$cell_pad_bot
,
$cell_height
);
if
(
$cell_max_word_len
> 0 &&
$data
->[
$row_idx
][
$col_idx
] &&
ref
(
$data
->[
$row_idx
][
$col_idx
]) eq
''
) {
$data
->[
$row_idx
][
$col_idx
] =~ s
}
$space_w
=
$txt
->advancewidth(
"\x20"
);
$column_widths
->[
$col_idx
] = 0;
$max_col_w
= 0;
$min_col_w
= 0;
my
@words
;
@words
=
split
( /\s+/,
$data
->[
$row_idx
][
$col_idx
] )
if
$data
->[
$row_idx
][
$col_idx
];
foreach
(
@words
) {
unless
(
exists
$word_widths
->{
$_
} ) {
$word_widths
->{
$_
} =
$txt
->advancewidth(
$_
);
}
$min_col_w
= max(
$min_col_w
,
$word_widths
->{
$_
});
if
(
$max_col_w
) {
$max_col_w
+=
$space_w
;
}
else
{
}
$max_col_w
+=
$word_widths
->{
$_
};
}
$min_col_w
= max(
$min_col_w
,
$txt
->advancewidth(
$cell_def_text
));
$min_col_w
+=
$cell_pad_left
+
$cell_pad_right
;
$min_col_w
= max(
$min_col_w
,
$cell_min_w
)
if
defined
$cell_min_w
;
$max_col_w
+=
$cell_pad_left
+
$cell_pad_right
;
$max_col_w
= max(
$min_col_w
,
$max_col_w
);
$col_min_width
->[
$col_idx
] = max(
$col_min_width
->[
$col_idx
],
$min_col_w
);
$col_max_content
->[
$col_idx
] = max(
$col_max_content
->[
$col_idx
],
$max_col_w
);
if
(!
defined
$max_w
->[
$col_idx
]) {
$max_w
->[
$col_idx
] = -1; }
$max_w
->[
$col_idx
] = max(
$max_w
->[
$col_idx
],
$cell_max_w
)
if
defined
$cell_max_w
;
$column_widths
->[
$col_idx
] =
$col_max_content
->[
$col_idx
];
}
$row_col_widths
->[
$row_idx
] =
$column_widths
;
@$h_row_widths
=
@$column_widths
if
!
$row_idx
&&
$do_headers
;
}
my
$calc_column_widths
;
my
$em_size
=
$txt
->advancewidth(
'M'
);
my
$ex_size
=
$txt
->advancewidth(
'x'
);
if
(
defined
$size
) {
(
$calc_column_widths
,
$width
) =
PDF::Table::ColumnWidth::SetColumnWidths(
$width
,
$size
,
$em_size
,
$ex_size
);
}
else
{
(
$calc_column_widths
,
$width
) =
PDF::Table::ColumnWidth::CalcColumnWidths(
$width
,
$col_min_width
,
$col_max_content
,
$max_w
);
}
my
$row_idx
= 0;
my
$row_is_odd
= 0;
my
$header_min_rh
=
$rows_height
->[0];
my
$next_top_border
= 0;
my
(
$gfx
,
$gfx_bg
,
$bg_color
,
$fg_color
,
$bot_margin
,
$table_top_y
,
$text_start_y
);
while
(
scalar
(@{
$data
})) {
my
(
$page_header
,
$columns_number
);
if
(
$pg_cnt
== 1) {
$table_top_y
=
$ybase
;
$bot_margin
=
$table_top_y
-
$height
;
if
(
$bot_margin
< 0 ) {
carp
"!!! Warning: !!! Incorrect Table Geometry! h ($height) greater than remaining page space y ($table_top_y). Reducing height to fit on page.\n"
;
$bot_margin
= 0;
$height
=
$table_top_y
;
}
}
else
{
if
(
ref
$arg
{
'new_page_func'
}) {
$page
= &{
$arg
{
'new_page_func'
} };
}
else
{
$page
=
$pdf
->page();
}
if
(!
defined
$next_y
) {
my
@page_dim
=
$page
->mediabox();
$next_y
= (
$page_dim
[3] -
$page_dim
[1]) * 0.9;
carp
"!!! Error: !!! Table spills to next page, but no next_y was given! Using $next_y.\n"
;
}
if
(!
defined
$next_h
) {
my
@page_dim
=
$page
->mediabox();
$next_h
= (
$page_dim
[3] -
$page_dim
[1]) * 0.8;
carp
"!!! Error: !!! Table spills to next page, but no next_h was given! Using $next_h.\n"
;
}
$table_top_y
=
$next_y
;
$bot_margin
=
$table_top_y
-
$next_h
;
if
(
$bot_margin
< 0 ) {
carp
"!!! Warning: !!! Incorrect Table Geometry! next_h ($next_h) greater than remaining page space next_y ($next_y), must be reduced to fit on page.\n"
;
$bot_margin
= 0;
$next_h
=
$table_top_y
;
}
if
(
$do_headers
== 2 ) {
@$page_header
=
@$header_row
;
my
$hrw
;
@$hrw
=
@$h_row_widths
;
unshift
@$data
,
@$page_header
;
unshift
@$row_col_widths
,
$hrw
;
unshift
@$rows_height
,
$header_min_rh
;
$first_row
= 1;
$row_idx
--;
}
}
my
$min_height
=
$rows_height
->[0];
$min_height
+=
$rows_height
->[1]
if
(
$do_headers
&&
$pg_cnt
==1 ||
$do_headers
==2 &&
$pg_cnt
>1) &&
defined
$rows_height
->[1];
if
(
$min_height
>=
$table_top_y
-
$bot_margin
) {
my
$delta
=
$min_height
- (
$table_top_y
-
$bot_margin
) + 1;
if
(
$delta
>
$bot_margin
) {
carp
"!! Error !! Insufficient space (by $delta) to get minimum number of row(s) on page. Some content may be lost off page bottom"
;
}
else
{
carp
"!! Warning !! Need to expand allotted vertical height by $delta to fit minimum number of row(s) on page"
;
}
$bot_margin
-=
$delta
;
if
(
$pg_cnt
== 1) {
$height
+=
$delta
;
}
else
{
$next_h
+=
$delta
;
}
}
$gfx_bg
=
$page
->gfx()
if
$ink
;
$txt
=
$page
->text();
$cur_y
=
$table_top_y
;
$gfx
=
$page
->gfx()
if
$ink
;
$gfx
->strokecolor(
$border_c
)
if
$ink
;
if
(
$ink
&&
$h_border_w
) {
if
(
$next_top_border
== 0) {
$gfx
->linewidth(
$h_border_w
);
}
elsif
(
$next_top_border
== 1) {
$gfx
->linewidth(
$border_w_default
);
}
else
{
$gfx
->linewidth(
$border_w_default
);
$gfx
->linedash(
$dashed_rule_default
);
}
$gfx
->move(
$xbase
-
$v_border_w
/2 ,
$cur_y
);
$gfx
->hline(
$xbase
+
$width
+
$v_border_w
/2);
$gfx
->stroke();
$gfx
->linedash();
}
my
@actual_column_widths
;
my
%colspanned
;
while
(
scalar
(@{
$data
}) and
$cur_y
-
$rows_height
->[0] >
$bot_margin
) {
my
$data_row
=
shift
@{
$data
};
$columns_number
=
scalar
(
@$data_row
);
my
$current_min_rh
=
shift
@$rows_height
;
my
$actual_row_height
=
$current_min_rh
;
my
$data_row_widths
=
shift
@$row_col_widths
;
my
$cur_x
=
$xbase
;
my
$leftovers
=
undef
;
my
$do_leftovers
= 0;
my
@save_bg_color
;
my
@save_fg_color
;
my
(
@save_v_rule_w
,
@save_v_rule_c
,
@save_h_rule_w
,
@save_h_rule_c
);
for
(
my
$col_idx
= 0;
$col_idx
<
$columns_number
;
$col_idx
++ ) {
$GLOBALS
->[3] =
$row_idx
;
$GLOBALS
->[4] =
$col_idx
;
next
if
$colspanned
{
$row_idx
.
'_'
.
$col_idx
};
$leftovers
->[
$col_idx
] =
undef
;
my
(
$cell_font
,
$cell_font_size
,
$cell_leading
,
$cell_underline
,
$cell_pad_top
,
$cell_pad_right
,
$cell_pad_bot
,
$cell_pad_left
,
$cell_justify
,
$cell_fg_color
,
$cell_bg_color
,
$cell_def_text
,
$cell_min_w
,
$cell_max_w
);
if
(
$first_row
and
$do_headers
) {
$is_header_row
= 1;
$GLOBALS
->[3] = 0;
$cell_font
=
$header_props
->{
'font'
};
$cell_font_size
=
$header_props
->{
'font_size'
};
$cell_leading
=
$header_props
->{
'leading'
};
$cell_height
=
$header_props
->{
'min_rh'
};
$cell_pad_top
=
$header_props
->{
'padding_top'
} ||
$header_props
->{
'padding'
};
$cell_pad_right
=
$header_props
->{
'padding_right'
} ||
$header_props
->{
'padding'
};
$cell_pad_bot
=
$header_props
->{
'padding_bottom'
} ||
$header_props
->{
'padding'
};
$cell_pad_left
=
$header_props
->{
'padding_left'
} ||
$header_props
->{
'padding'
};
$cell_max_word_len
=
$header_props
->{
'max_word_length'
};
$cell_min_w
=
$header_props
->{
'min_w'
};
$cell_max_w
=
$header_props
->{
'max_w'
};
$cell_underline
=
$header_props
->{
'underline'
};
$cell_def_text
=
$header_props
->{
'default_text'
};
$cell_justify
=
$header_props
->{
'justify'
};
$cell_bg_color
=
$header_props
->{
'bg_color'
};
$cell_fg_color
=
$header_props
->{
'fg_color'
};
$cell_bg_color_even
=
undef
;
$cell_bg_color_odd
=
undef
;
$cell_fg_color_even
=
undef
;
$cell_fg_color_odd
=
undef
;
$cell_h_rule_w
=
$header_props
->{
'h_rule_w'
};
$cell_v_rule_w
=
$header_props
->{
'v_rule_w'
};
$cell_h_rule_c
=
$header_props
->{
'h_rule_c'
};
$cell_v_rule_c
=
$header_props
->{
'v_rule_c'
};
}
else
{
$is_header_row
= 0;
$cell_font
=
undef
;
$cell_font_size
=
undef
;
$cell_leading
=
undef
;
$cell_height
=
undef
;
$cell_pad_top
=
undef
;
$cell_pad_right
=
undef
;
$cell_pad_bot
=
undef
;
$cell_pad_left
=
undef
;
$cell_max_word_len
=
undef
;
$cell_min_w
=
undef
;
$cell_max_w
=
undef
;
$cell_underline
=
undef
;
$cell_def_text
=
undef
;
$cell_justify
=
undef
;
$cell_bg_color
=
undef
;
$cell_fg_color
=
undef
;
$cell_bg_color_even
=
undef
;
$cell_bg_color_odd
=
undef
;
$cell_fg_color_even
=
undef
;
$cell_fg_color_odd
=
undef
;
$cell_h_rule_w
=
undef
;
$cell_v_rule_w
=
undef
;
$cell_h_rule_c
=
undef
;
$cell_v_rule_c
=
undef
;
}
$cell_font
= find_value(
$cell_font
,
'font'
,
''
,
$fnt_obj
,
$GLOBALS
);
$cell_font_size
= find_value(
$cell_font_size
,
'font_size'
,
''
, 0,
$GLOBALS
);
if
(
$cell_font_size
== 0) {
if
(
$is_header_row
) {
$cell_font_size
=
$fnt_size
+ 2;
}
else
{
$cell_font_size
=
$fnt_size
;
}
}
$cell_leading
= find_value(
$cell_leading
,
'leading'
,
'leading'
, -1,
$GLOBALS
);
if
(
$cell_leading
<= 0) {
$cell_leading
=
$cell_font_size
*
$leading_ratio
;
}
$cell_height
= find_value(
$cell_height
,
'min_rh'
,
''
, 0,
$GLOBALS
);
$cell_pad_top
= find_value(
$cell_pad_top
,
'padding_top'
,
'padding'
,
$padding_default
,
$GLOBALS
);
$cell_pad_right
= find_value(
$cell_pad_right
,
'padding_right'
,
'padding'
,
$padding_default
,
$GLOBALS
);
$cell_pad_bot
= find_value(
$cell_pad_bot
,
'padding_bottom'
,
'padding'
,
$padding_default
,
$GLOBALS
);
$cell_pad_left
= find_value(
$cell_pad_left
,
'padding_left'
,
'padding'
,
$padding_default
,
$GLOBALS
);
$cell_max_word_len
= find_value(
$cell_max_word_len
,
'max_word_len'
,
''
,
$max_word_len
,
$GLOBALS
);
$cell_min_w
= find_value(
$cell_min_w
,
'min_w'
,
''
,
undef
,
$GLOBALS
);
$cell_max_w
= find_value(
$cell_max_w
,
'max_w'
,
''
,
undef
,
$GLOBALS
);
if
(
defined
$cell_max_w
&&
defined
$cell_min_w
) {
$cell_max_w
= max(
$cell_max_w
,
$cell_min_w
);
}
$cell_underline
= find_value(
$cell_underline
,
'underline'
,
''
,
$underline
,
$GLOBALS
);
$cell_def_text
= find_value(
$cell_def_text
,
'default_text'
,
''
,
$default_text
,
$GLOBALS
);
$cell_justify
= find_value(
$cell_justify
,
'justify'
,
'justify'
,
'left'
,
$GLOBALS
);
if
(
$is_header_row
) {
$cell_bg_color
= find_value(
$cell_bg_color
,
'bg_color'
,
''
,
$h_bg_color_default
,
$GLOBALS
);
$cell_fg_color
= find_value(
$cell_fg_color
,
'fg_color'
,
''
,
$h_fg_color_default
,
$GLOBALS
);
}
else
{
$cell_bg_color
= find_value(
$cell_bg_color
,
'bg_color'
,
''
,
undef
,
$GLOBALS
);
$cell_fg_color
= find_value(
$cell_fg_color
,
'fg_color'
,
''
,
undef
,
$GLOBALS
);
$cell_bg_color_even
= find_value(
$cell_bg_color_even
,
'bg_color_even'
,
''
,
undef
,
$GLOBALS
);
$cell_bg_color_odd
= find_value(
$cell_bg_color_odd
,
'bg_color_odd'
,
''
,
undef
,
$GLOBALS
);
$cell_fg_color_even
= find_value(
$cell_fg_color_even
,
'fg_color_even'
,
''
,
undef
,
$GLOBALS
);
$cell_fg_color_odd
= find_value(
$cell_fg_color_odd
,
'fg_color_odd'
,
''
,
undef
,
$GLOBALS
);
}
$cell_h_rule_w
= find_value(
$cell_h_rule_w
,
'h_rule_w'
,
'rule_w'
,
$h_border_w
,
$GLOBALS
);
$cell_v_rule_w
= find_value(
$cell_v_rule_w
,
'v_rule_w'
,
'rule_w'
,
$v_border_w
,
$GLOBALS
);
$cell_h_rule_c
= find_value(
$cell_h_rule_c
,
'h_rule_c'
,
'rule_c'
,
$border_c
,
$GLOBALS
);
$cell_v_rule_c
= find_value(
$cell_v_rule_c
,
'v_rule_c'
,
'rule_c'
,
$border_c
,
$GLOBALS
);
$bg_color
=
$cell_bg_color
;
$fg_color
=
$cell_fg_color
;
if
(
$oddeven_default
) {
if
(!
defined
$bg_color
) {
$bg_color
=
$row_is_odd
?
$cell_bg_color_odd
:
$cell_bg_color_even
;
}
if
(!
defined
$fg_color
) {
$fg_color
=
$row_is_odd
?
$cell_fg_color_odd
:
$cell_fg_color_even
;
}
}
else
{
if
(!
defined
$bg_color
) {
$bg_color
=
$row_idx
% 2 ?
$cell_bg_color_even
:
$cell_bg_color_odd
;
}
if
(!
defined
$fg_color
) {
$fg_color
=
$row_idx
% 2 ?
$cell_fg_color_even
:
$cell_fg_color_odd
;
}
}
$fg_color
||=
$fg_color_default
;
$text_start_y
=
$cur_y
-
$cell_pad_top
-
$cell_font_size
;
$txt
->font(
$cell_font
,
$cell_font_size
);
$txt
->fillcolor(
$fg_color
)
if
$ink
;
$data_row
->[
$col_idx
] //=
$cell_def_text
;
my
$c_cell_props
=
$is_header_row
?
$cell_props
->[0][
$col_idx
] :
$cell_props
->[
$row_idx
][
$col_idx
];
my
$this_cell_width
=
$calc_column_widths
->[
$col_idx
];
if
(
$c_cell_props
&&
$c_cell_props
->{
'colspan'
} &&
$c_cell_props
->{
'colspan'
} > 1) {
my
$colspan
=
$c_cell_props
->{
'colspan'
};
for
my
$offset
(1 ..
$colspan
- 1) {
$this_cell_width
+=
$calc_column_widths
->[
$col_idx
+
$offset
]
if
$calc_column_widths
->[
$col_idx
+
$offset
];
if
(
$is_header_row
) {
$colspanned
{
'0_'
.(
$col_idx
+
$offset
)} = 1;
}
else
{
$colspanned
{
$row_idx
.
'_'
.(
$col_idx
+
$offset
)} = 1;
}
}
}
$this_cell_width
= max(
$this_cell_width
,
$min_col_width
);
$actual_column_widths
[
$row_idx
][
$col_idx
] =
$this_cell_width
;
my
%text_options
;
if
(
$cell_underline
) {
$text_options
{
'-underline'
} =
$cell_underline
;
$text_options
{
'-strokecolor'
} =
$fg_color
;
}
my
$content
=
$data_row
->[
$col_idx
];
$content
=
$cell_def_text
if
(
ref
(
$content
) eq
''
&&
$content
eq
''
);
if
(
ref
(
$content
) eq
'ARRAY'
) {
$cell_markup
=
$content
->[0];
my
(
$rc
,
$next_y
,
$remainder
);
my
$ULx
=
$cur_x
+
$cell_pad_left
;
my
$ULy
=
$cur_y
-
$cell_pad_top
;
my
$width
=
$actual_column_widths
[
$row_idx
][
$col_idx
] -
$cell_pad_right
-
$cell_pad_left
;
my
$max_h
=
$cur_y
-
$bottom_margin
-
$cell_pad_top
-
$cell_pad_bot
;
(
$rc
,
$next_y
,
$remainder
) =
$txt
->column(
$page
,
$txt
,
$gfx
,
$cell_markup
,
$content
->[1],
'rect'
=>[
$ULx
,
$ULy
,
$width
,
$max_h
],
'font_size'
=>
$cell_font_size
,
%{
$content
->[2]});
if
(
$rc
) {
$actual_row_height
= max(
$actual_row_height
,
$cur_y
-
$bottom_margin
);
}
else
{
$actual_row_height
= max(
$actual_row_height
,
$cur_y
-
$next_y
+
$cell_pad_bot
+
(
$cell_leading
-
$cell_font_size
)*1.0);
}
if
(
$rc
) {
$leftovers
->[
$col_idx
] = [
'pre'
,
$remainder
,
$content
->[2] ];
$do_leftovers
= 1;
}
}
elsif
(
$content
!~ m/(.\n.)/ and
$data_row_widths
->[
$col_idx
] and
$data_row_widths
->[
$col_idx
] <=
$actual_column_widths
[
$row_idx
][
$col_idx
] ) {
if
(
$ink
) {
if
(
$cell_justify
eq
'right'
) {
$txt
->translate(
$cur_x
+
$actual_column_widths
[
$row_idx
][
$col_idx
] -
$cell_pad_right
,
$text_start_y
);
$txt
->text_right(
$content
,
%text_options
);
}
elsif
(
$cell_justify
eq
'center'
) {
$txt
->translate(
$cur_x
+
$cell_pad_left
+ (
$actual_column_widths
[
$row_idx
][
$col_idx
] -
$cell_pad_left
-
$cell_pad_right
)/2,
$text_start_y
);
$txt
->text_center(
$content
,
%text_options
);
}
else
{
$txt
->translate(
$cur_x
+
$cell_pad_left
,
$text_start_y
);
$txt
->text(
$content
,
%text_options
);
}
}
}
else
{
my
(
$width_of_last_line
,
$ypos_of_last_line
,
$left_over_text
)
=
$self
->text_block(
$txt
,
$content
,
$row_idx
,
$col_idx
,
'x'
=>
$cur_x
+
$cell_pad_left
,
'y'
=>
$text_start_y
,
'w'
=>
$actual_column_widths
[
$row_idx
][
$col_idx
] -
$cell_pad_left
-
$cell_pad_right
,
'h'
=>
$cur_y
-
$bot_margin
-
$cell_pad_top
-
$cell_pad_bot
,
'font_size'
=>
$cell_font_size
,
'leading'
=>
$cell_leading
,
'align'
=>
$cell_justify
,
'text_opt'
=> \
%text_options
,
);
$actual_row_height
= max(
$actual_row_height
,
$cur_y
-
$ypos_of_last_line
+
$cell_pad_bot
+
(
$cell_leading
-
$cell_font_size
)*2.5);
if
(
$left_over_text
) {
$leftovers
->[
$col_idx
] =
$left_over_text
;
$do_leftovers
= 1;
}
}
if
(
ref
$arg
{
'cell_render_hook'
} eq
'CODE'
) {
$arg
{
'cell_render_hook'
}->(
$page
,
$first_row
,
$row_idx
,
$col_idx
,
$cur_x
,
$cur_y
-
$actual_row_height
,
$actual_column_widths
[
$row_idx
][
$col_idx
],
$actual_row_height
);
}
$cur_x
+=
$actual_column_widths
[
$row_idx
][
$col_idx
];
$save_bg_color
[
$col_idx
] =
$bg_color
;
$save_fg_color
[
$col_idx
] =
$fg_color
;
$save_v_rule_w
[
$col_idx
] =
$cell_v_rule_w
;
$save_h_rule_w
[
$col_idx
] =
$cell_h_rule_w
;
$save_v_rule_c
[
$col_idx
] =
$cell_v_rule_c
;
$save_h_rule_c
[
$col_idx
] =
$cell_h_rule_c
;
}
if
(
$do_leftovers
) {
unshift
@$data
,
$leftovers
;
unshift
@$row_col_widths
,
$data_row_widths
;
unshift
@$rows_height
,
$current_min_rh
;
}
if
(
$oddeven_default
) {
if
( !(
$first_row
and
$do_headers
) ) {
$row_is_odd
= !
$row_is_odd
;
}
}
$cur_x
=
$xbase
;
for
(
my
$col_idx
= 0;
$col_idx
<
scalar
(
@$data_row
);
$col_idx
++) {
$bg_color
=
$save_bg_color
[
$col_idx
];
$fg_color
=
$save_fg_color
[
$col_idx
];
$cell_v_rule_w
=
$save_v_rule_w
[
$col_idx
];
$cell_h_rule_w
=
$save_h_rule_w
[
$col_idx
];
$cell_v_rule_c
=
$save_v_rule_c
[
$col_idx
];
$cell_h_rule_c
=
$save_h_rule_c
[
$col_idx
];
if
(
$ink
) {
if
(
defined
$bg_color
&&
$bg_color
ne
'transparent'
&&
$bg_color
ne
'trans'
&&
!
$colspanned
{
$row_idx
.
'_'
.
$col_idx
}) {
$gfx_bg
->rect(
$cur_x
,
$cur_y
-
$actual_row_height
,
$actual_column_widths
[
$row_idx
][
$col_idx
],
$actual_row_height
);
$gfx_bg
->fillcolor(
$bg_color
);
$gfx_bg
->fill();
}
if
(
$gfx
&&
$cell_v_rule_w
&&
$col_idx
&&
!
$colspanned
{
$row_idx
.
'_'
.
$col_idx
}) {
$gfx
->linewidth(
$cell_v_rule_w
);
$gfx
->strokecolor(
$cell_v_rule_c
);
$gfx
->move(
$cur_x
,
$cur_y
-
$actual_row_height
);
$gfx
->vline(
$cur_y
- (
$row_idx
? 0:
$h_border_w
/2));
$gfx
->stroke();
}
if
(
$gfx
&&
$cell_h_rule_w
&&
scalar
(@{
$data
}) &&
$cur_y
-
$actual_row_height
-
$current_min_rh
>
$bot_margin
) {
$gfx
->linewidth(
$cell_h_rule_w
);
$gfx
->strokecolor(
$cell_h_rule_c
);
$gfx
->move(
$cur_x
,
$cur_y
-
$actual_row_height
);
$gfx
->hline(
$cur_x
+
$actual_column_widths
[
$row_idx
][
$col_idx
] );
$gfx
->stroke();
}
}
$cur_x
+=
$calc_column_widths
->[
$col_idx
];
}
$cur_y
-=
$actual_row_height
;
if
(!
$ink
) {
if
(
$first_row
&&
$do_headers
) {
$vsizes
[1] =
$actual_row_height
;
}
else
{
push
@vsizes
,
$actual_row_height
;
}
}
if
(
$do_leftovers
) {
$row_is_odd
= !
$row_is_odd
;
$next_top_border
= 2;
}
else
{
$row_idx
++;
$next_top_border
= 1;
}
$first_row
= 0;
}
if
(!
scalar
(@{
$data
})) {
$next_top_border
= 0; }
if
(
$ink
) {
if
(
$gfx
&&
$h_border_w
) {
if
(
$next_top_border
== 0) {
$gfx
->linewidth(
$h_border_w
);
}
elsif
(
$next_top_border
== 1) {
$gfx
->linewidth(
$border_w_default
);
}
else
{
$gfx
->linewidth(
$border_w_default
);
$gfx
->linedash(
$dashed_rule_default
);
}
$gfx
->strokecolor(
$border_c
);
$gfx
->move(
$xbase
-
$v_border_w
/2 ,
$cur_y
);
$gfx
->hline(
$xbase
+
$width
+
$v_border_w
/2);
$gfx
->stroke();
$gfx
->linedash();
}
if
(
$gfx
) {
if
(
$v_border_w
) {
$gfx
->linewidth(
$v_border_w
);
$gfx
->move(
$xbase
,
$table_top_y
);
$gfx
->vline(
$cur_y
);
$gfx
->move(
$xbase
+
$width
,
$table_top_y
);
$gfx
->vline(
$cur_y
);
}
$gfx
->stroke();
}
}
$pg_cnt
++;
}
if
(
$ink
) {
return
(
$page
, --
$pg_cnt
,
$cur_y
);
}
else
{
for
(
my
$i
= 1;
$i
<
@vsizes
;
$i
++) {
$vsizes
[0] +=
$vsizes
[
$i
];
}
return
@vsizes
;
}
}
sub
find_value {
my
(
$cell_val
,
$name
,
$fallback
,
$default
,
$GLOBALS
) =
@_
;
my
(
$cell_props
,
$col_props
,
$row_props
,
$row_idx
,
$col_idx
,
$argref
) =
@$GLOBALS
;
my
%arg
=
%$argref
;
if
(!
defined
$default
&&
(
$name
ne
'underline'
&&
$name
ne
'bg_color'
&&
$name
ne
'fg_color'
&&
$name
ne
'bg_color_even'
&&
$name
ne
'bg_color_odd'
&&
$name
ne
'fg_color_even'
&&
$name
ne
'fg_color_odd'
&&
$name
ne
'min_w'
&&
$name
ne
'max_w'
) ) {
carp
"Error! find_value() default value undefined for '$name'\n"
;
}
$cell_val
=
$cell_props
->[
$row_idx
][
$col_idx
]->{
$name
}
if
!
defined
$cell_val
;
$cell_val
=
$cell_props
->[
$row_idx
][
$col_idx
]->{
$fallback
}
if
!
defined
$cell_val
&&
$fallback
ne
''
;
$cell_val
=
$col_props
->[
$col_idx
]->{
$name
}
if
!
defined
$cell_val
;
$cell_val
=
$col_props
->[
$col_idx
]->{
$fallback
}
if
!
defined
$cell_val
&&
$fallback
ne
''
;
$cell_val
=
$row_props
->[
$row_idx
]->{
$name
}
if
!
defined
$cell_val
;
$cell_val
=
$row_props
->[
$row_idx
]->{
$fallback
}
if
!
defined
$cell_val
&&
$fallback
ne
''
;
$cell_val
=
$arg
{
$name
}
if
!
defined
$cell_val
;
$cell_val
=
$arg
{
$fallback
}
if
!
defined
$cell_val
&&
$fallback
ne
''
;
if
(!
defined
$cell_val
) {
$cell_val
=
$default
;
}
return
$cell_val
;
}
sub
text_block {
my
$self
=
shift
;
my
$text_object
=
shift
;
my
$text
=
shift
;
my
$row_idx
=
shift
;
my
$col_idx
=
shift
;
my
%arg
=
@_
;
my
(
$align
,
$xpos
,
$ypos
,
$xbase
,
$ybase
,
$line_width
,
$wordspace
,
$endw
,
$width
,
$height
) =
(
undef
,
undef
,
undef
,
undef
,
undef
,
undef
,
undef
,
undef
,
undef
,
undef
);
my
@line
= ();
my
%width
= ();
my
%text_options
= %{
$arg
{
'text_opt'
} };
foreach
my
$key
(
keys
%arg
) {
my
$newkey
=
$key
;
if
(
$newkey
=~ s
$arg
{
$newkey
} =
$arg
{
$key
};
delete
$arg
{
$key
};
}
}
$xbase
=
$arg
{
'x'
} || -1;
$ybase
=
$arg
{
'y'
} || -1;
$width
=
$arg
{
'w'
} || -1;
$height
=
$arg
{
'h'
} || -1;
unless
(
$xbase
> 0 ) {
carp
"Error: Left Edge of Block is NOT defined!\n"
;
return
(0,
$ybase
,
''
);
}
unless
(
$ybase
> 0 ) {
carp
"Error: Base Line of Block is NOT defined!\n"
;
return
(0,
$ybase
,
''
);
}
unless
(
$width
> 0 ) {
carp
"Error: Width of Block is NOT defined!\n"
;
return
(0,
$ybase
,
''
);
}
unless
(
$height
> 0 ) {
carp
"Error: Height of Block is NOT defined!\n"
;
return
(0,
$ybase
,
''
);
}
unless
(
defined
(
$text
) and
length
(
$text
) > 0 ) {
$text
=
' '
;
}
$text
=~ s/\r//g;
my
@paragraphs
=
split
(/\n/,
$text
);
my
$font_size
=
$arg
{
'font_size'
} ||
$font_size_default
;
my
$line_space
=
defined
$arg
{
'leading'
} &&
$arg
{
'leading'
} > 0 ?
$arg
{
'leading'
} :
undef
;
$line_space
||=
$font_size
*
$leading_ratio
;
$line_space
=
$font_size
*
$leading_ratio
if
$font_size
>
$line_space
;
my
$space_width
=
$text_object
->advancewidth(
"\x20"
);
my
%word_width
;
my
@text_words
=
split
(/\s+/,
$text
);
foreach
(
@text_words
) {
next
if
exists
$word_width
{
$_
};
$word_width
{
$_
} =
$text_object
->advancewidth(
$_
);
}
my
@paragraph
=
split
(
' '
,
shift
(
@paragraphs
));
my
$first_line
= 1;
my
$paragraph_number
= 1;
$xpos
=
$xbase
;
$ypos
=
$ybase
;
$ypos
=
$ybase
+
$line_space
;
my
$bottom_border
=
$ypos
-
$height
;
while
(
$ypos
>=
$bottom_border
+
$line_space
) {
unless
(
@paragraph
) {
last
unless
scalar
@paragraphs
;
@paragraph
=
split
(
' '
,
shift
(
@paragraphs
) );
$paragraph_number
++;
$ypos
-=
$arg
{
'parspace'
}
if
$arg
{
'parspace'
} and
$paragraph_number
> 1;
last
unless
$ypos
>=
$bottom_border
;
}
$ypos
-=
$line_space
;
$xpos
=
$xbase
;
@line
= ();
$line_width
= 0;
if
(
$first_line
&&
exists
$arg
{
'hang'
} ) {
my
$hang_width
=
$text_object
->advancewidth(
$arg
{
'hang'
});
$text_object
->translate(
$xpos
,
$ypos
)
if
$ink
;
$text_object
->text(
$arg
{
'hang'
} )
if
$ink
;
$xpos
+=
$hang_width
;
$line_width
+=
$hang_width
;
$arg
{
'indent'
} +=
$hang_width
if
$paragraph_number
== 1;
}
elsif
(
$first_line
&&
exists
$arg
{
'flindent'
} &&
$arg
{
'flindent'
} > 0 ) {
$xpos
+=
$arg
{
'flindent'
};
$line_width
+=
$arg
{
'flindent'
};
}
elsif
(
$paragraph_number
== 1 &&
exists
$arg
{
'fpindent'
} &&
$arg
{
'fpindent'
} > 0 ) {
$xpos
+=
$arg
{
'fpindent'
};
$line_width
+=
$arg
{
'fpindent'
};
}
elsif
(
exists
$arg
{
'indent'
} &&
$arg
{
'indent'
} > 0 ) {
$xpos
+=
$arg
{
'indent'
};
$line_width
+=
$arg
{
'indent'
};
}
while
(
@paragraph
) {
if
( !
@line
) {
if
(
$text_object
->advancewidth(
$paragraph
[0] ) +
$line_width
<=
$width
+0.01 ) {
push
(
@line
,
shift
(
@paragraph
));
next
if
@paragraph
;
}
else
{
die
(
"!!! Error !!! first word in paragraph for row $row_idx, col $col_idx '$paragraph[0]' doesn't fit into empty line!"
);
}
}
else
{
if
(
$text_object
->advancewidth(
join
(
" "
,
@line
).
" "
.
$paragraph
[0] ) +
$line_width
<=
$width
) {
push
(
@line
,
shift
(
@paragraph
));
next
if
@paragraph
;
}
}
last
;
}
$line_width
+=
$text_object
->advancewidth(
join
(
' '
,
@line
));
$align
=
$arg
{
'align'
} ||
'left'
;
if
(
$align
eq
'fulljustify'
or
(
$align
eq
'justify'
and
@paragraph
)) {
@line
=
split
(//,
$line
[0])
if
scalar
(
@line
) == 1;
if
(
scalar
(
@line
) > 1) {
$wordspace
= (
$width
-
$line_width
) / (
scalar
(
@line
) - 1);
}
else
{
$wordspace
= 0;
}
$align
=
'justify'
;
}
else
{
$align
=
'left'
if
$align
eq
'justify'
;
$wordspace
=
$space_width
;
}
$line_width
+=
$wordspace
* (
scalar
(
@line
) - 1);
if
(
$align
eq
'justify'
) {
foreach
my
$word
(
@line
) {
$text_object
->translate(
$xpos
,
$ypos
)
if
$ink
;
$text_object
->text(
$word
)
if
$ink
;
$xpos
+= (
$word_width
{
$word
} +
$wordspace
)
if
(
@line
);
}
$endw
=
$width
;
}
else
{
if
(
$ink
) {
if
(
$align
eq
'right'
) {
$text_object
->translate(
$xpos
+
$width
,
$ypos
);
$endw
=
$text_object
->text_right(
join
(
' '
,
@line
),
%text_options
);
}
elsif
(
$align
eq
'center'
) {
$text_object
->translate(
$xpos
+
$width
/2,
$ypos
);
$endw
=
$text_object
->text_center(
join
(
' '
,
@line
),
%text_options
);
}
else
{
$text_object
->translate(
$xpos
,
$ypos
);
$endw
=
$text_object
->text(
join
(
' '
,
@line
),
%text_options
);
}
}
}
$first_line
= 0;
}
unshift
(
@paragraphs
,
join
(
' '
,
@paragraph
))
if
scalar
(
@paragraph
);
return
(
$endw
,
$ypos
,
join
(
"\n"
,
@paragraphs
))
}
1;
Hide Show 6 lines of Pod