cowsay/cows/TextBalloon.pm

208 lines
3.5 KiB
Perl
Raw Normal View History

2001-09-10 23:31:09 +00:00
package Acme::Cow::TextBalloon;
use strict;
my $rcs_id = q$Id$;
=pod
=head1 NAME
Acme::Cow::TextBalloon - A balloon of text
=head1 SYNOPSIS
use Acme::Cow::TextBalloon;
$x = new Acme::Cow::TextBalloon;
$x->add("bunch of text");
$x->wrapcolumn(29);
$y = new Acme::Cow::TextBalloon;
$y->adjust(0);
$y->add("more text");
=head1 DESCRIPTION
C<Acme::Cow::TextBalloon> Creates and manipulates balloons of text,
optionally printing them. One may notice that the methods in this
module are named very similarly to those in C<Acme::Cow>; that's
because most of them have to do with the balloon rather than the
cow.
=cut
use Text::Tabs;
use Text::Wrap;
sub new
{
my $proto = shift;
my $class = ref $proto || $proto;
my $self = {
fill => 1,
mode => 'say',
over => 0,
text => [ ],
wrap => 40,
};
return bless $self, $class;
}
sub wrapcolumn
{
my $self = shift;
if (@_) {
$self->{'wrap'} = $_[0];
}
return $self->{'wrap'};
}
sub mode
{
my $self = shift;
return $self->{'mode'};
}
sub think
{
my $self = shift;
$self->{'mode'} = "think";
}
sub say
{
my $self = shift;
$self->{'mode'} = "say";
}
sub print
{
my $self = shift;
$self->{'mode'} = "think";
}
sub adjust
{
my $self = shift;
if (@_) {
$self->{'fill'} = $_[0];
}
return $self->{'fill'};
}
sub over
{
my $self = shift;
if (@_) {
$self->{'over'} = $_[0];
}
return $self->{'over'};
}
sub as_list
{
my $self = shift;
return $self->_construct();
}
sub as_string
{
my $self = shift;
return join('', $self->_construct());
}
sub add
{
my $self = shift;
push @{$self->{'text'}}, @_;
return $self->{'text'};
}
sub text
{
my $self = shift;
if (@_) {
my @l = @_;
$self->{'text'} = \@l;
}
return $self->{'text'};
}
sub _maxlength
{
my ($len, $max);
$max = -1;
for my $i (@_) {
$len = length $i;
$max = $len if ($len > $max);
}
return $max;
}
sub _fill_text
{
my $self = shift;
for my $i (@{$self->{'text'}}) {
$i =~ s/\s+$//;
}
$Text::Tabs::tabstop = 8;
my @expanded = Text::Tabs::expand(@{$self->{'text'}});
unless ($self->{'fill'}) {
return @expanded;
}
$Text::Wrap::columns = $self->{'wrap'};
my @filled = split("\n", Text::Wrap::wrap("", "", @expanded));
$Text::Tabs::tabstop = 2; # Defeat a dumb heuristic.
my @final = expand(@filled);
return @final;
}
sub _construct
{
my $self = shift;
my $mode = $self->{'mode'};
my @message = $self->_fill_text();
my $max = _maxlength(@message);
my $max2 = $max + 2; ## border space fudge.
my @border; ## up-left, up-right, down-left, down-right, left, right
my @balloon_lines = ();
my $shove = " " x $self->{'over'};
my $format = "$shove%s %-${max}s %s\n";
if ($mode eq think) {
@border = qw[ ( ) ( ) ( ) ];
} elsif (@message < 2) {
@border = qw[ < > ];
} else {
@border = ( "/", "\\", "\\", "/", "|", "|" );
}
push(@balloon_lines,
"$shove " . ("_" x $max2) . "\n" ,
sprintf($format, $border[0], $message[0], $border[1]),
(@message < 2 ? "" :
map { sprintf($format, $border[4], $_, $border[5]) }
@message[1 .. $#message - 1]),
(@message < 2 ? "" :
sprintf($format, $border[2], $message[$#message], $border[3])),
"$shove " . ("-" x $max2) . "\n"
);
return @balloon_lines;
}
=pod
=head1 AUTHOR
Tony Monroe E<lt>tmonroe+perl@nog.netE<gt>
=head1 SEE ALSO
L<Acme::Cow>
=cut
1;
__END__