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