1package Term::Choose::LineFold;
2
3use warnings;
4use strict;
5use 5.10.0;
6
7our $VERSION = '1.745';
8
9use Exporter qw( import );
10
11our @EXPORT_OK = qw( line_fold print_columns cut_to_printwidth );
12
13use Term::Choose::Constants qw( WIDTH_CURSOR );
14use Term::Choose::Screen    qw( normal );
15
16
17BEGIN {
18    if ( $ENV{TC_AMBIGUOUS_WIDE} ) {
19        require Term::Choose::LineFold::CharWidthAmbiguousWide;
20        Term::Choose::LineFold::CharWidthAmbiguousWide->import( 'table_char_width' );
21    }
22    else {
23        require Term::Choose::LineFold::CharWidthDefault;
24        Term::Choose::LineFold::CharWidthDefault->import( 'table_char_width' );
25    }
26}
27
28
29my $table = table_char_width();
30
31my $cache = [];
32
33
34sub char_width {
35    my $c = $_[0];
36    my $min = 0;
37    my $mid;
38    my $max = $#$table;
39    if ($c < $table->[0][0] || $c > $table->[$max][1] ) {
40        return 1;
41    }
42    while ( $max >= $min ) {
43        $mid = int( ( $min + $max ) / 2 );
44        if ( $c > $table->[$mid][1] ) {
45            $min = $mid + 1;
46        }
47        elsif ( $c < $table->[$mid][0] ) {
48            $max = $mid - 1;
49        }
50        else {
51            return $table->[$mid][2];
52        }
53    }
54    return 1;
55}
56
57
58sub print_columns {
59    my $str = $_[0];
60    my $width = 0;
61    for my $i ( 0 .. ( length( $str ) - 1 ) ) {
62        my $c = ord substr $str, $i, 1;
63        if ( ! defined $cache->[$c] ) {
64            $cache->[$c] = char_width( $c );
65        }
66        $width = $width + $cache->[$c];
67    }
68    return $width;
69}
70
71
72sub cut_to_printwidth {
73    my ( $str, $avail_width, $return_remainder ) = @_;
74    my $count = 0;
75    my $total = 0;
76    for my $i ( 0 .. ( length( $str ) - 1 ) ) {
77        my $c = ord substr $str, $i, 1;
78        if ( ! defined $cache->[$c] ) {
79            $cache->[$c] = char_width( $c )
80        }
81        if ( ( $total = $total + $cache->[$c] ) > $avail_width ) {
82            if ( ( $total - $cache->[$c] ) < $avail_width ) {
83                return substr( $str, 0, $count ) . ' ', substr( $str, $count ) if $return_remainder;
84                return substr( $str, 0, $count ) . ' ';
85            }
86            return substr( $str, 0, $count ), substr( $str, $count ) if $return_remainder;
87            return substr( $str, 0, $count );
88
89        }
90        ++$count;
91    }
92    return $str, '' if $return_remainder;
93    return $str;
94}
95
96
97sub line_fold {
98    my ( $str, $avail_width, $opt ) = @_; #copy $str
99    if ( ! defined $str || ! length $str ) {
100        return $str;
101    }
102    for ( $opt->{init_tab}, $opt->{subseq_tab} ) {
103        if ( defined $_ && length $_ ) {
104            s/\t/ /g;
105            s/\v+/\ \ /g;
106            s/[\p{Cc}\p{Noncharacter_Code_Point}\p{Cs}]//g;
107            if ( length > $avail_width / 4 ) {
108                $_ = cut_to_printwidth( $_, int( $avail_width / 2 ) );
109            }
110        }
111        else {
112            $_ = '';
113        }
114    }
115    my @color;
116    if ( $opt->{color} ) {
117        $str =~ s/\x{feff}//g;
118        $str =~ s/(\e\[[\d;]*m)/push( @color, $1 ) && "\x{feff}"/ge;
119    }
120    $str =~ s/\t/ /g;
121    $str =~ s/[^\v\P{Cc}]//g; # remove control chars but keep vertical spaces
122    $str =~ s/[\p{Noncharacter_Code_Point}\p{Cs}]//g;
123    if ( $str !~ /\R/ && print_columns( $opt->{init_tab} . $str ) <= $avail_width && ! @color ) {
124        return $opt->{init_tab} . $str;
125    }
126    my @paragraphs;
127
128    for my $row ( split /\R/, $str, -1 ) { # -1 to keep trailing empty fields
129        my @lines;
130        $row =~ s/\s+\z//;
131        my @words = split( /(?<=\S)(?=\s)/, $row );
132        my $line = $opt->{init_tab};
133
134        for my $i ( 0 .. $#words ) {
135            if ( print_columns( $line . $words[$i] ) <= $avail_width ) {
136                $line .= $words[$i];
137            }
138            else {
139                my $tmp;
140                if ( $i == 0 ) {
141                    $tmp = $opt->{init_tab} . $words[$i];
142                }
143                else {
144                    push( @lines, $line );
145                    $words[$i] =~ s/^\s+//;
146                    $tmp = $opt->{subseq_tab} . $words[$i];
147                }
148                ( $line, my $remainder ) = cut_to_printwidth( $tmp, $avail_width, 1 );
149                while ( length $remainder ) {
150                    push( @lines, $line );
151                    $tmp = $opt->{subseq_tab} . $remainder;
152                    ( $line, $remainder ) = cut_to_printwidth( $tmp, $avail_width, 1 );
153                }
154            }
155            if ( $i == $#words ) {
156                push( @lines, $line );
157            }
158        }
159        if ( $opt->{join} ) {
160            push( @paragraphs, join( "\n", @lines ) );
161        }
162        else {
163            if ( @lines ) {
164                push( @paragraphs, @lines );
165            }
166            else {
167                push( @paragraphs, '' );
168            }
169        }
170    }
171    if ( @color ) {
172        for my $paragraph ( @paragraphs ) {
173            $paragraph =~ s/\x{feff}/shift @color/ge;
174            if ( ! @color ) {
175                last;
176            }
177        }
178        $paragraphs[-1] .= normal();
179    }
180    if ( $opt->{join} ) {
181        return join( "\n", @paragraphs );
182    }
183    else {
184        return @paragraphs;
185    }
186}
187
188
189
190
191
192
193
194
195
196
1971;
198