alazyreader/cowsay
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Derived cows!

Browse Source
This commit is contained in:
tony 2001-09-10 23:31:09 +00:00
parent 38fed456fa
commit 2069267e70
7 changed files with 548 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
cows/DragonAndCow.pm Normal file
View File

@ -0,0 +1,36 @@
package Acme::Cow::DragonAndCow;
use strict;
use Acme::Cow;
@Acme::Cow::DragonAndCow::ISA = qw(Acme::Cow);
my $dragon_and_cow = <<'EOC';
{$balloon}
{$tl} ^ /^
{$tl} / \ // \
{$tl} |\___/| / \// .\
{$tl} /O O \__ / // | \ \ *----*
/ / \/_/ // | \ \ \ |
@___@` \/_ // | \ \ \/\ \
0/0/| \/_ // | \ \ \ \
0/0/0/0/| \/// | \ \ | |
0/0/0/0/0/_|_ / ( // | \ _\ | /
0/0/0/0/0/0/`/,_ _ _/ ) ; -. | _ _\.-~ / /
,-\} _ *-.|.-~-. .~ ~
\ \__/ `/\ / ~-. _ .-~ /
\____({$el}{$er}) *. \} \{ /
( (--) .----~-.\ \-` .~
//__\\ \__ Ack! ///.----..< \ _ -~
// \\ ///-._ _ _ _ _ _ _\{^ - - - - ~
EOC
sub new
{
my $proto = shift;
my $class = ref $proto || $proto;
my $self = $class->SUPER::new();
return bless $self, $class;
}
sub as_string
{
my $self = shift;
return $self->SUPER::as_string($dragon_and_cow);
}

149
cows/Example.pm Normal file
View File

@ -0,0 +1,149 @@
package Acme::Cow::Example;
use strict;
use Acme::Cow;
@Acme::Cow::Example::ISA = qw(Acme::Cow);
my $generic_ascii_art = <<'EOC';
{$balloon}
{$tr}
{$el}{$er} {$tr}
___________________
/ Insert cute ASCII \
\ artwork here. /
-------------------
{$U}
EOC
sub new
{
my $proto = shift;
my $class = ref $proto || $proto;
my $self = $class->SUPER::new();
$self->over(24);
return $self;
}
sub as_string
{
my $self = shift;
return $self->SUPER::as_string($generic_ascii_art);
}
1;
__END__
=pod
=head1 NAME
Acme::Cow::Example - How to write a "derived cow"
=head1 SYNOPSIS
package Acme::Cow::MyCow;
use Acme::Cow;
@Acme::Cow::MyCow::ISA = qw(Acme::Cow);
my $my_cow = <<'EOC';
... template goes here ...
EOC
sub new { ... }
sub as_string { ... }
=head1 DESCRIPTION
First, put together your template as described in L<Acme::Cow>,
using L<Text::Template> as a reference. It is recommended that
you store this template in a variable in your package's namespace.
B<Your template should not have tab characters in it.> This will
cause ugly things to happen.
Your C<new> method will likely want to look a lot like this:
sub new
{
my $proto = shift;
my $class = ref $proto || $proto;
my $self = $class->SUPER::new();
return $self;
}
Assuming you stored the template as C<$my_cow> then
your C<as_string> method will likely want to be like this:
sub as_string
{
my $self = shift;
return $self->SUPER::as_string($my_cow);
}
Below, we present the actual code in this module, so you can see
it in action. Yes, you can use this module to produce ASCII art.
No, it won't be very exciting.
=head1 Acme::Cow::Example code
package Acme::Cow::Example;
use strict;
use Acme::Cow;
@Acme::Cow::Example::ISA = qw(Acme::Cow);
my $generic_ascii_art = <<'EOC';
{$balloon}
{$tr}
{$el}{$er} {$tr}
___________________
/ Insert cute ASCII \
\ artwork here. /
-------------------
{$U}
EOC
sub new
{
my $proto = shift;
my $class = ref $proto || $proto;
my $self = $class->SUPER::new();
$self->over(24);
return $self;
}
sub as_string
{
my $self = shift;
return $self->SUPER::as_string($generic_ascii_art);
}
=head1 HIGHLIGHTS
The C<{$balloon}> directive is flush left, but due to the call to
C<over()> in the C<new()> method, it will be shoved over 24 spaces
to the right, to line up with the thought/speech lines (represented
by C<{$tr}>).
=head1 SAVING WORK
Included with the C<Acme::Cow> distribution is a short program
called C<cowpm> which takes care of most of the boilerplate stuff
for you. It's almost as simple as I<just add ASCII art> but there's
still a bit that you have to fill in. It has its own documentation;
you should peruse L<cowpm>.
=head1 SEE ALSO
L<Acme::Cow>, L<cowpm>
=head1 AUTHOR
Tony Monroe <tmonroe plus perl at nog dot net>
=head1 BUGS
Very few.

35
cows/Frogs.pm Normal file
View File

@ -0,0 +1,35 @@
package Acme::Cow::Frogs;
use strict;
use Acme::Cow;
@Acme::Cow::Frogs::ISA = qw(Acme::Cow);
my $frogs = <<'EOC';
{$balloon}
{$tr}
{$tr}
oO)-. .-(Oo
/__ _\ /_ __\
\ \( | ()~() | )/ /
\__|\ | (-___-) | /|__/
' '--' ==`-'== '--' '
EOC
sub new
{
my $proto = shift;
my $class = ref $proto || $proto;
my $self = $class->SUPER::new();
$self->over(46);
return bless $self, $class;
}
sub as_string
{
my $self = shift;
return $self->SUPER::as_string($frogs);
}
1;

40
cows/MechAndCow.pm Normal file
View File

@ -0,0 +1,40 @@
package Acme::Cow::MechAndCow;
use strict;
use Acme::Cow;
@Acme::Cow::MechAndCow::ISA = qw(Acme::Cow);
my $mech_and_cow = <<'EOC';
{$balloon}
{$tl} ,-----.
{$tl} | |
{$tl} ,--| |-.
__,----| | | |
,;:: | `_____' |
`._______| i^i |
`----| |---'| .
,-------._| |== ||//
| |_|P`. /'/
`-------' 'Y Y/'/'
.==\ /_\
^__^ / /'| `i
({$el}{$er})\_______ /' / | |
(__)\ )\/\ /' / | `i
{$U} ||----w | ___,;`----'.___L_,-'`\__
|| || i_____;----\.____i""\____\
EOC
sub new
{
my $proto = shift;
my $class = ref $proto || $proto;
my $self = $class->SUPER::new();
$self->over(10);
return bless $self, $class;
}
sub as_string
{
my $self = shift;
return $self->SUPER::as_string($mech_and_cow);
}
1;

38
cows/Stegosaurus.pm Normal file
View File

@ -0,0 +1,38 @@
package Acme::Cow::Stegosaurus;
use strict;
use Acme::Cow;
@Acme::Cow::Stegosaurus::ISA = qw(Acme::Cow);
my $stegosaurus = <<'EOC';
{$balloon}
{$tr} . .
{$tr} / `. .' "
{$tr} .---. < > < > .---.
| \ \ - ~ ~ - / / |
_____ ..-~ ~-..-~
| | \~~~\.' `./~~~/
--------- \__/ \__/
.' O \ / / \ "
(_____, `._.' | \} \/~~~/
`----. / \} | / \__/
`-. | / | / `. ,~~|
~-.__| /_ - ~ ^| /- _ `..-'
| / | / ~-. `-. _ _ _
|_____| |_____| ~ - . _ _ _ _ _>
EOC
sub new
{
my $proto = shift;
my $class = ref $proto || $proto;
my $self = $class->SUPER::new();
$self->over(20);
return bless $self, $class;
}
sub as_string
{
my $self = shift;
return $self->SUPER::as_string($stegosaurus);
}
1;

207
cows/TextBalloon.pm Normal file
View File

@ -0,0 +1,207 @@
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__

43
cows/TuxStab.pm Normal file
View File

@ -0,0 +1,43 @@
package Acme::Cow::TuxStab;
use strict;
use Acme::Cow;
@Acme::Cow::TuxStab::ISA = qw(Acme::Cow);
my $tux_being_stabbed = <<'EOC';
{$balloon}
{$tl} , ,
{$tl} /( )`
{$tl} \ \___ / |
/- _ `-/ '
(/\/ \ \ /\
/ / | ` \
O O ) / |
`-^--'`< '
.--. (_.) _ ) /
|o_o | `.___/` /
|:_/ | `-----' /
//<- \ \----. __ / __ \
(| <- | )---|====O)))==) \) /====
/'\ <- _/`\---' `--' `.__,' \
\___)=(___/ | |
\ /
______( (_ / \______
,' ,-----' | \
`--\{__________) \/
EOC
sub new
{
my $proto = shift;
my $class = ref $proto || $proto;
my $self = $class->SUPER::new();
$self->over(8);
return bless $self, $class;
}
sub as_string
{
my $self = shift;
return $self->SUPER::as_string($tux_being_stabbed);
}
1;