1package Acme::Cow::TextBalloon; 2 3use strict; 4 5my $rcs_id = q$Id$; 6 7=pod 8 9=head1 NAME 10 11Acme::Cow::TextBalloon - A balloon of text 12 13=head1 SYNOPSIS 14 15 use Acme::Cow::TextBalloon; 16 17 $x = new Acme::Cow::TextBalloon; 18 $x->add("bunch of text"); 19 $x->wrapcolumn(29); 20 21 $y = new Acme::Cow::TextBalloon; 22 $y->adjust(0); 23 $y->add("more text"); 24 25=head1 DESCRIPTION 26 27C<Acme::Cow::TextBalloon> Creates and manipulates balloons of text, 28optionally printing them. One may notice that the methods in this 29module are named very similarly to those in C<Acme::Cow>; that's 30because most of them have to do with the balloon rather than the 31cow. 32 33=cut 34 35use Text::Tabs; 36use Text::Wrap; 37 38 39sub new 40{ 41 my $proto = shift; 42 my $class = ref $proto || $proto; 43 my $self = { 44 fill => 1, 45 mode => 'say', 46 over => 0, 47 text => [ ], 48 wrap => 40, 49 }; 50 return bless $self, $class; 51} 52 53sub wrapcolumn 54{ 55 my $self = shift; 56 if (@_) { 57 $self->{'wrap'} = $_[0]; 58 } 59 return $self->{'wrap'}; 60} 61 62sub mode 63{ 64 my $self = shift; 65 return $self->{'mode'}; 66} 67 68sub think 69{ 70 my $self = shift; 71 $self->{'mode'} = "think"; 72} 73 74sub say 75{ 76 my $self = shift; 77 $self->{'mode'} = "say"; 78} 79 80sub print 81{ 82 my $self = shift; 83 $self->{'mode'} = "think"; 84} 85 86sub adjust 87{ 88 my $self = shift; 89 if (@_) { 90 $self->{'fill'} = $_[0]; 91 } 92 return $self->{'fill'}; 93} 94 95sub over 96{ 97 my $self = shift; 98 if (@_) { 99 $self->{'over'} = $_[0]; 100 } 101 return $self->{'over'}; 102} 103 104sub as_list 105{ 106 my $self = shift; 107 return $self->_construct(); 108} 109 110sub as_string 111{ 112 my $self = shift; 113 return join('', $self->_construct()); 114} 115 116sub add 117{ 118 my $self = shift; 119 push @{$self->{'text'}}, @_; 120 return $self->{'text'}; 121} 122 123sub text 124{ 125 my $self = shift; 126 if (@_) { 127 my @l = @_; 128 $self->{'text'} = \@l; 129 } 130 return $self->{'text'}; 131} 132 133sub _maxlength 134{ 135 my ($len, $max); 136 $max = -1; 137 for my $i (@_) { 138 $len = length $i; 139 $max = $len if ($len > $max); 140 } 141 return $max; 142} 143 144sub _fill_text 145{ 146 my $self = shift; 147 for my $i (@{$self->{'text'}}) { 148 $i =~ s/\s+$//; 149 } 150 $Text::Tabs::tabstop = 8; 151 my @expanded = Text::Tabs::expand(@{$self->{'text'}}); 152 unless ($self->{'fill'}) { 153 return @expanded; 154 } 155 $Text::Wrap::columns = $self->{'wrap'}; 156 my @filled = split("\n", Text::Wrap::wrap("", "", @expanded)); 157 $Text::Tabs::tabstop = 2; # Defeat a dumb heuristic. 158 my @final = expand(@filled); 159 return @final; 160} 161 162sub _construct 163{ 164 my $self = shift; 165 my $mode = $self->{'mode'}; 166 my @message = $self->_fill_text(); 167 my $max = _maxlength(@message); 168 my $max2 = $max + 2; ## border space fudge. 169 my @border; ## up-left, up-right, down-left, down-right, left, right 170 my @balloon_lines = (); 171 my $shove = " " x $self->{'over'}; 172 my $format = "$shove%s %-${max}s %s\n"; 173 if ($mode eq think) { 174 @border = qw[ ( ) ( ) ( ) ]; 175 } elsif (@message < 2) { 176 @border = qw[ < > ]; 177 } else { 178 @border = ( "/", "\\", "\\", "/", "|", "|" ); 179 } 180 push(@balloon_lines, 181 "$shove " . ("_" x $max2) . "\n" , 182 sprintf($format, $border[0], $message[0], $border[1]), 183 (@message < 2 ? "" : 184 map { sprintf($format, $border[4], $_, $border[5]) } 185 @message[1 .. $#message - 1]), 186 (@message < 2 ? "" : 187 sprintf($format, $border[2], $message[$#message], $border[3])), 188 "$shove " . ("-" x $max2) . "\n" 189 ); 190 return @balloon_lines; 191} 192 193 194=pod 195 196=head1 AUTHOR 197 198Tony Monroe E<lt>tmonroe+perl@nog.netE<gt> 199 200=head1 SEE ALSO 201 202L<Acme::Cow> 203 204=cut 205 2061; 207__END__ 208