From 2069267e70aab788651aff603c64f99845e1cffd Mon Sep 17 00:00:00 2001 From: tony Date: Mon, 10 Sep 2001 23:31:09 +0000 Subject: [PATCH] Derived cows! --- cows/DragonAndCow.pm | 36 ++++++++ cows/Example.pm | 149 +++++++++++++++++++++++++++++++ cows/Frogs.pm | 35 ++++++++ cows/MechAndCow.pm | 40 +++++++++ cows/Stegosaurus.pm | 38 ++++++++ cows/TextBalloon.pm | 207 +++++++++++++++++++++++++++++++++++++++++++ cows/TuxStab.pm | 43 +++++++++ 7 files changed, 548 insertions(+) create mode 100644 cows/DragonAndCow.pm create mode 100644 cows/Example.pm create mode 100644 cows/Frogs.pm create mode 100644 cows/MechAndCow.pm create mode 100644 cows/Stegosaurus.pm create mode 100644 cows/TextBalloon.pm create mode 100644 cows/TuxStab.pm diff --git a/cows/DragonAndCow.pm b/cows/DragonAndCow.pm new file mode 100644 index 0000000..f32c0a4 --- /dev/null +++ b/cows/DragonAndCow.pm @@ -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); +} diff --git a/cows/Example.pm b/cows/Example.pm new file mode 100644 index 0000000..1dfcca5 --- /dev/null +++ b/cows/Example.pm @@ -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, +using L as a reference. It is recommended that +you store this template in a variable in your package's namespace. +B This will +cause ugly things to happen. + +Your C 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 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 in the C 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 distribution is a short program +called C which takes care of most of the boilerplate stuff +for you. It's almost as simple as I but there's +still a bit that you have to fill in. It has its own documentation; +you should peruse L. + +=head1 SEE ALSO + +L, L + +=head1 AUTHOR + +Tony Monroe + +=head1 BUGS + +Very few. diff --git a/cows/Frogs.pm b/cows/Frogs.pm new file mode 100644 index 0000000..badae8f --- /dev/null +++ b/cows/Frogs.pm @@ -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; diff --git a/cows/MechAndCow.pm b/cows/MechAndCow.pm new file mode 100644 index 0000000..57708af --- /dev/null +++ b/cows/MechAndCow.pm @@ -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; diff --git a/cows/Stegosaurus.pm b/cows/Stegosaurus.pm new file mode 100644 index 0000000..3fa72ac --- /dev/null +++ b/cows/Stegosaurus.pm @@ -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; diff --git a/cows/TextBalloon.pm b/cows/TextBalloon.pm new file mode 100644 index 0000000..b3ddcd2 --- /dev/null +++ b/cows/TextBalloon.pm @@ -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 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; 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 Etmonroe+perl@nog.netE + +=head1 SEE ALSO + +L + +=cut + +1; +__END__ diff --git a/cows/TuxStab.pm b/cows/TuxStab.pm new file mode 100644 index 0000000..587d977 --- /dev/null +++ b/cows/TuxStab.pm @@ -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;