banner string generator

3 files changed, 682 insertions, 0 deletions

diff --git a/fml/lib/FML/String/Banner.pm b/fml/lib/FML/String/Banner.pm
new file mode 100644
index 00000000..31bc9f61
--- /dev/null
+++ b/fml/lib/FML/String/Banner.pm
@@ -0,0 +1,255 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2008 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself.
+#
+# $FML: @template.pm,v 1.12 2008/08/24 08:28:36 fukachan Exp $
+#
+
+package FML::String::Banner;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD $banner_table);
+use Carp;
+
+
+=head1 NAME
+
+FML::String::Banner - manipulate a banner string.
+
+=head1 SYNOPSIS
+
+    use FML::String::Banner;
+    my $banner = new FML::String::Banner;
+    $banner->set_string($string);
+
+    # ASCII version.
+    my $ascii = $banner->as_ascii();
+    printf("\n<pre>[%s]\n\n%s\n</pre>\n", $name_magic, $ascii);
+
+    # PNG version.
+    use File::Spec;
+    my $png_filename = sprintf("%s.png", $session_id);
+    my $image_file   = File::Spec->catfile($html_tmp_dir, $png_filename);
+
+    use FileHandle;
+    my $wh = new FileHandle "> $image_file";
+    if (defined $wh) {
+	$wh->binmode();
+	my $png = $banner->as_png();
+	$wh->print($png);
+	$wh->close();
+    }
+
+    my $url_base = $config->{ html_tmp_base_url };
+    my $url = sprintf("%s/%s", $url_base, $png_filename);
+    printf("\n<p>%s\n\n<image src=\"%s\">\n", $name_magic, $url);
+
+=head1 DESCRIPTION
+
+generate a banner for the specified string. 
+
+The output is either of ascii strings or png format image.
+
+Also, the output is bended. In the case of ascii format, the vertical
+position varies randomely within the specified "drift" paremeter (see
+set_drift() method). In the case of image (PNG) format, the output
+image is vertically varied, bended and be colorful.
+
+=head1 METHODS
+
+=head2 new()
+
+constructor.
+
+=cut
+
+
+# Descriptions: constructor.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+    my ($self) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = {};
+
+    srand(time|$$);
+
+    return bless $me, $type;
+}
+
+
+=head2 set_string($string)
+
+set the current string to manipulate.
+
+=head2 get_string()
+
+get the current string to manipulate.
+
+=cut
+
+
+# Descriptions: set the current string to manipulate.
+#    Arguments: OBJ($self) STR($string)
+# Side Effects: $self updated.
+# Return Value: none
+sub set_string
+{
+    my ($self, $string) = @_;
+    $self->{ _string } = $string;
+}
+
+
+# Descriptions: get the current string to manipulate.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: STR
+sub get_string
+{
+    my ($self) = @_;
+    return($self->{ _string } || '');
+}
+
+
+=head2 set_drift($drift)
+
+set the drift parameter. 
+
+This parameter is a tunable parameter used to shift the letter
+position or bend the letter.
+
+=head2 get_drift()
+
+get the drift parameter.
+
+=cut
+
+
+# Descriptions: set the drift parameter.
+#    Arguments: OBJ($self) NUM($drift)
+# Side Effects: $self modified.
+# Return Value: none
+sub set_drift
+{
+    my ($self, $drift) = @_;
+    $self->{ _drift } = $drift;
+}
+
+
+# Descriptions: get the drift parameter.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: NUM
+sub get_drift
+{
+    my ($self) = @_;
+    return($self->{ _drift } || 8);
+}
+
+
+=head2 as_ascii([$string])
+
+generate an ascii based banner string. 
+
+return the generated string image.
+
+=cut
+
+
+# Descriptions: return a generated banner as an ascii image. 
+#    Arguments: OBJ($self) STR($string)
+# Side Effects: none
+# Return Value: STR
+sub as_ascii
+{
+    my ($self, $string) = @_;
+    my ($_string) = $self->get_string() || $string;
+    my ($_drift)  = $self->get_drift();
+
+    use FML::String::Banner::Ascii;
+    my $banner = new FML::String::Banner::Ascii;
+    return $banner->as_ascii($_string, $_drift);
+}
+
+
+=head2 as_png([$string])
+
+generate GD based image as PNG format.
+
+return the generated PNG image format. You need to save it into a
+file at the caller side.
+
+=cut
+
+
+# Descriptions: return a generated banner as a png image. 
+#    Arguments: OBJ($self) STR($string)
+# Side Effects: none
+# Return Value: IMAGE
+sub as_png
+{
+    my ($self, $string) = @_;
+    my ($_string) = $self->get_string() || $string;
+
+    use FML::String::Banner::Image;
+    my $banner = new FML::String::Banner::Image;
+    return $banner->as_png($_string);
+}
+
+
+#
+# DEBUG
+#
+if ($0 eq __FILE__) {
+    my $banner = new FML::String::Banner;
+    my $string = 'SCX9;AD2';
+
+    $banner->set_string($string);
+    my $ascii = $banner->as_ascii();
+    my $png   = $banner->as_png($string);
+    my $sep   = "-" x 72;
+    print $sep, "\n";
+    print $ascii;
+    print $sep, "\n";
+    print $banner->get_string(), "\n";
+
+    use FileHandle;
+    my $wh = new FileHandle "> /var/tmp/test.png";
+    if (defined $wh) {
+	$wh->binmode();
+	$wh->print($png);
+	$wh->close();
+    }
+    else {
+	croak("cannot open /var/tmp/test.png");
+    }
+}
+
+
+=head1 CODING STYLE
+
+See C<http://www.fml.org/software/FNF/> on fml coding style guide.
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2008 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=head1 HISTORY
+
+FML::String::Banner appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/FML/String/Banner/Ascii.pm b/fml/lib/FML/String/Banner/Ascii.pm
new file mode 100644
index 00000000..29c57e5a
--- /dev/null
+++ b/fml/lib/FML/String/Banner/Ascii.pm
@@ -0,0 +1,126 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2008 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself.
+#
+# $FML: @template.pm,v 1.12 2008/08/24 08:28:36 fukachan Exp $
+#
+
+package FML::String::Banner::Ascii;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD $banner_table);
+use Carp;
+
+use FML::Char::Ascii::Data;
+$banner_table = $FML::Char::Ascii::Data::banner_table;
+
+
+=head1 NAME
+
+FML::String::Banner::Ascii - generate an ascii bannner.
+
+=head1 SYNOPSIS
+
+    use FML::String::Banner::Ascii;
+    my $banner = new FML::String::Banner::Ascii;
+    print $banner->as_ascii("TRIAL_PASSWORD", 8);
+
+=head1 DESCRIPTION
+
+See L<FML::String::Banner> CLASS. This class provides the ascii part
+of the class.
+
+=head1 METHODS
+
+=head2 new()
+
+constructor.
+
+=cut
+
+
+# Descriptions: constructor.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+    my ($self) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = {};
+    return bless $me, $type;
+}
+
+
+=head2 as_ascii($string, $drift)
+
+return an ascii banner string. The string is specificed by the
+argument $string. The vertical position of each character in the
+$string is shifted randomly within the $drift characters.
+
+=cut
+
+
+# Descriptions: return an ascii banner string. The string is
+#               specificed by the argument $string. The vertical 
+#               position of each character in the $string is shifted 
+#               randomly within the $drift characters.
+#    Arguments: OBJ($self) STR($string) NUM($drift)
+# Side Effects: none
+# Return Value: STR
+sub as_ascii
+{
+    my ($self, $string, $drift) = @_;
+    my (@banner)  = ();
+
+    srand(time|$$);
+
+    my ($_seed)   = $drift || 8; 
+    my ($strlen)  = length($string);
+    for (my $i = 0; $i < $strlen; $i++) {
+	my $c = substr($string, $i, 1);
+	my $t = $banner_table->{ $c };
+
+	# stuff the banner into the final buffer with random height position;
+	my $height_begin = int(rand($drift));
+	for (my $h = 0, my $j = 0; $h < 8 + $drift; $h++) {
+	    if ($h < $height_begin || $h >= $height_begin + 8) {
+		$banner[ $h ] .= "       ";
+	    }
+	    else {
+		$banner[ $h ] .= $t->[ $j++ ];
+	    }
+	    $banner[ $h ] .= "  ";
+	}
+    }
+
+    my $r = join("\n", @banner);
+    return sprintf("%s\n", $r);
+}
+
+
+=head1 CODING STYLE
+
+See C<http://www.fml.org/software/FNF/> on fml coding style guide.
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2008 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=head1 HISTORY
+
+FML::String::Banner::Ascii appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/FML/String/Banner/Image.pm b/fml/lib/FML/String/Banner/Image.pm
new file mode 100644
index 00000000..887cc82d
--- /dev/null
+++ b/fml/lib/FML/String/Banner/Image.pm
@@ -0,0 +1,301 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2008 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself.
+#
+# $FML: @template.pm,v 1.12 2008/08/24 08:28:36 fukachan Exp $
+#
+
+package FML::String::Banner::Image;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD $banner_table);
+use Carp;
+
+use FML::Char::Ascii::Data;
+$banner_table = $FML::Char::Ascii::Data::banner_table;
+
+
+=head1 NAME
+
+FML::String::Banner::Image - generate a banner by using GD library.
+
+=head1 SYNOPSIS
+
+    use FML::String::Banner::Image;
+    my $banner = new FML::String::Banner::Image;
+    my $png    = $banner->as_png($_string);
+
+    use FileHandle;
+    my $wh = new FileHandle "> /var/tmp/test.png";
+    if (defined $wh) {
+        $wh->binmode();
+        $wh->print($png);
+        $wh->close();
+    }
+    else {
+        croak("cannot open /var/tmp/test.png");
+    }
+
+=head1 DESCRIPTION
+
+See L<FML::String::Banner> CLASS. This class provides the image part
+of the class. 
+
+Currently the image format is PNG only (but extensible if needed).
+
+=head1 METHODS
+
+=head2 new()
+
+constructor.
+
+=cut
+
+
+# Descriptions: constructor.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+    my ($self) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = {};
+    return bless $me, $type;
+}
+
+
+=head2 as_png($string)
+
+return a generated banner as PNG image.
+
+=cut
+
+
+# Descriptions: return a generated banner as PNG image.
+#    Arguments: OBJ($self) STR($string)
+# Side Effects: none
+# Return Value: IMAGE
+sub as_png
+{
+    my ($self, $string) = @_;
+
+    $self->_bitmap_string($string);
+    $self->_bitmap_merge();
+}
+
+
+# Descriptions: return color table as HASH_REF.
+#    Arguments: OBJ($self) OBJ($image)
+# Side Effects: none
+# Return Value: HASH_REF
+sub _bitmap_color_table_example
+{
+    my ($self, $image) = @_;
+
+    # allocate some colors
+    my $white = $image->colorAllocate(255, 255, 255);
+    my $black = $image->colorAllocate(  0,   0,   0);
+    my $red   = $image->colorAllocate(255,   0,   0);
+    my $blue  = $image->colorAllocate(  0,   0, 255);
+
+    my $color_table = {
+	white => $white,
+	black => $black,
+	red   => $red,
+	blue  => $blue,
+    };
+
+    return $color_table;
+}
+
+
+# Descriptions: build a new image template.
+#    Arguments: OBJ($self) NUM($width) NUM($height)
+# Side Effects: none
+# Return Value: IMAGE
+sub _bitmap_new_image
+{
+    my ($self, $width, $height) = @_;
+
+    # 8*8 x 8*8 dots.
+    $width  ||= 64;
+    $height ||= 64;
+
+    use GD;
+    my $image = new GD::Image($width, $height);
+    my $color_table = $self->_bitmap_color_table_example($image);
+    $image->transparent($color_table->{ black });
+    $image->interlaced('true');
+    return $image;
+}
+
+
+# Descriptions: merge character images to one string image.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: IMAGE
+sub _bitmap_merge
+{
+    my ($self) = @_;
+
+    my $image_buffer = $self->{ _image_buffer } || [];
+    my $image = $self->_bitmap_new_image(64*8, 64*2);
+
+    my $i = 0;
+    for (my $i = 0; $i < 8; $i++) {
+	my $im = $image_buffer->[ $i ];
+	$image->copyResampled($im,
+			      64*$i, int(rand(32)),
+			      32, 32,
+			      96, 96, 96, 96);
+    }
+
+    return $image->png;
+}
+
+
+# Descriptions: create a string image.
+#    Arguments: OBJ($self) STR($string)
+# Side Effects: $self modified.
+# Return Value: none
+sub _bitmap_string
+{
+    my ($self, $string) = @_;
+    my (@image_buffer)  = ();
+
+    my $len = length($string);
+    for (my $i = 0; $i < $len; $i++) {
+	my $c     = substr($string, $i, 1);
+	$image_buffer[ $i ] = $self->_bitmap_char($c, $i);
+    }
+
+    $self->{ _image_buffer } = \@image_buffer;
+}
+
+
+# Descriptions: create one character and rotate it a little.
+#    Arguments: OBJ($self) STR($char) NUM($pos)
+# Side Effects: none
+# Return Value: IMAGE
+sub _bitmap_char
+{
+    my ($self, $char, $pos) = @_;
+    my ($x, $y) = (0, 0);
+
+    my $image = $self->_bitmap_new_image(128, 128);
+
+    # XXX 8 is the magic number
+    # XXX since each letter of the ascii banner_table is 8x8 dots.
+    my $banner = $banner_table->{ $char };
+    for my $line (@$banner) {
+	++$x;
+	for (my $i = 0; $i < 8; $i++) {
+	    my $c = substr($line, $i, 1);
+	    $y = $i + 1;
+	    if ($c =~ /^\S+$/) {
+		$self->_create_sub_image($image, $x, $y);
+	    }
+	}
+    }
+
+    # rotate the image.
+    my $rt_image = $self->_bitmap_new_image(128, 128);
+    my $angle    = $self->_random_drift(8);
+    $rt_image->copyRotated($image,
+			   64, 64,
+			   0, 0,
+			   128, 128, $angle);
+    return $rt_image;
+}
+
+
+# Descriptions: create a part of a character image.
+#    Arguments: OBJ($self) OBJ($image) NUM($x) NUM($y)
+# Side Effects: none
+# Return Value: none
+sub _create_sub_image
+{
+    my ($self, $image, $x, $y) = @_;
+    my $color_table = $self->_bitmap_color_table_example($image);
+
+    # drift the end position a little.
+    my ($r0, $r1, $r2, $r3) = ($self->_random_drift(),
+			       $self->_random_drift(),
+			       $self->_random_drift(),
+			       $self->_random_drift());
+
+    # region
+    my ($c0, $c1, $c2, $c3) = ($y*8 + $r0 + 32,
+			       $x*8 + $r1 + 32,
+			       $y*8 + 8 + $r2 + 32,
+			       $x*8 + 8 + $r3 + 32);
+
+
+    my $type = int(rand(4)) % 4;
+    $image->setThickness($type);
+
+    $type = int(rand(4)) % 4;
+    if ($type == 0) {
+	$image->filledRectangle($c0, $c1, $c2, $c3, $color_table->{ red });
+    }
+    elsif ($type == 1) {
+	$image->filledRectangle($c0, $c1, $c2, $c3, $color_table->{ blue });
+    }
+    elsif ($type == 2) {
+	$image->filledArc($c0 +4, $c1 +4, 8, 8, 0, 360, $color_table->{black});
+    }
+    elsif ($type == 3) {
+	$image->filledArc($c0 +4, $c1 +4, 9, 9, 0, 360, $color_table->{ red });
+    }
+    else {
+	$image->filledRectangle($c0, $c1, $c2, $c3, $color_table->{ black });
+    }
+}
+
+
+# Descriptions: return a randomized drift parameter.
+#    Arguments: OBJ($self) NUM($max)
+# Side Effects: none
+# Return Value: NUM
+sub _random_drift
+{
+    my ($self, $max) = @_;
+
+    my $shift = int(rand($max || 2));
+
+    my $pm = int(rand(2)) % 1;
+    if ($pm == 1) {
+	return( -1 * $shift );
+    }
+    else {
+	return( $shift );
+    }
+}
+
+
+=head1 CODING STYLE
+
+See C<http://www.fml.org/software/FNF/> on fml coding style guide.
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2008 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=head1 HISTORY
+
+FML::String::Banner::Image appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;