view release on metacpan or  search on metacpan

lib/Acme/AsciiArt2HtmlTable.pm  view on Meta::CPAN

                "ggggggggrrrrrrrrrrrrrr\n" .
                "ggggggggrrrrrrrrrrrrrr\n" .
                "ggggggggrrrrrrrrrrrrrr\n" .
                "ggggggyyyyrrrrrrrrrrrr\n" .
                "ggggggyyyyrrrrrrrrrrrr\n" .
                "gggggyyyyyyrrrrrrrrrrr\n" .
                "gggggyyyyyyrrrrrrrrrrr\n" .
                "ggggggyyyyrrrrrrrrrrrr\n" .
                "ggggggyyyyrrrrrrrrrrrr\n" .
                "ggggggggrrrrrrrrrrrrrr\n" .
                "ggggggggrrrrrrrrrrrrrr\n" .
                "ggggggggrrrrrrrrrrrrrr\n" .
                "ggggggggrrrrrrrrrrrrrr\n" ;

    my $html = aa2ht( { td => { width => 3 , height => 3 } } , $table);

    # $html now holds a table with a color representation of your
    # ascii art. In this case, the Portuguese flag.

=cut

our %default_configuration;

=head1 FUNCTIONS

=head2 aa2ht

Gets ascii text and converts it to an HTML table. This is how it works:

=over 4

=item * each line is a C<tr> element

=item * each letter is a C<td> element

=item * each C<td> has background of a specific color, which is
defined by the letter that created it

=back

=cut

sub aa2ht {

  # default configuration
  my %config = _clone_hash( \%default_configuration );

=head3 OPTIONS

You can pass a reference to a hash before the text you want to
convert.

=cut

  if ( ref($_[0]) eq 'HASH' ) {
    my $new_config = shift;

=head4 id

In order to save space in the output, C<td> and C<tr> elements'
attributes are not in each element, but rather in a C<style> element.

This causes a problem if you want to put two different outputs with
different attributes on the same page.

To solve this problem: C<id>.

When creating a table, use the parameter C<id> to make sure it doesn't
end up mixed up with something else.

  my $html = aa2ht( { 'id' => 'special' } $ascii );

The result will be something like this:

  <style>
  .special td { width:1; height:1; }
  .special tr {  }
  </style>
  <table class="special" cellspacing="0" cellpadding="0" border="0">

=cut

    if (defined $new_config->{'id'}) { $config{'id'} = $new_config->{'id'} }

=head4 use-default-colors

If set to a false value, no default mappings are used.

  my $html = aa2ht( { 'use-default-colors' => 0 }, $ascii);

Behind the curtains, there is still a mapping: the default mapping to
white.

=cut

    if ( defined $new_config->{'use-default-colors'} ) {
      if ( not $new_config->{'use-default-colors'}) {
        $config{'colors'} = { 'default' => 'ffffff' } # everything is now white
      }
    }

=head4 colors

You can override color definitions or specify your own.

  my $html = aa2ht( { 'colors' => { '@' => 'ffddee',
                                    'g' => '00ffff' } }, $ascii);

=cut

    if ( ref($new_config->{'colors'}) eq 'HASH' ) {
      for (keys %{$new_config->{'colors'}}) {
        $config{'colors'}{$_} = $new_config->{'colors'}{$_};
      }
    }

=head4 randomize-new-colors

If set to a true value, letters with no mappings are assigned a
random one.

  my $html = aa2ht( { 'randomize-new-colors' => 1 }, $ascii);

You might want to remove the default mappings if you're really
interested in a completely random effect:

  my $html = aa2ht( { 'use-default-colors' => 0,
                      'randomize-new-colors' => 1 }, $ascii);

You might also want to keep the white space as a white block:

  my $html = aa2ht( { 'use-default-colors' => 0,
                      'colors' => { ' ' => 'ffffff'},
                      'randomize-new-colors' => 1 }, $ascii);

=cut

    if ( defined $new_config->{'randomize-new-colors'} ) {
      $config{'randomize-new-colors'} = $new_config->{'randomize-new-colors'}
    }

=head4 table

With the parameter C<table> you can specify specific values for fields
like C<border>, C<cellpadding> and C<cellspacing> (all these have
value "0" by default).

  my $html = aa2ht( { 'table' => { 'border' => '1' } }, $ascii );

These attributes go directly into the C<table> tag.

=head4 tr

With the C<tr> parameter you can specify specific values for C<tr>'s
attributes.

These attributes go into a C<style> tag. The table class uses that
style.

=head4 td

With the C<td> parameter you can specify specific values for C<td>'s
attributes, like C<width> or C<height>.

  my $html = aa2ht( { 'td' => { 'width' => '2px',
                                'height' => '2px' } }, $ascii);

These attributes go into a C<style> tag. The table class uses that
style.

=cut

    for my $elem ( qw/table tr td/ ) {
      defined $new_config->{$elem}            or next;
      ref    ($new_config->{$elem}) eq 'HASH' or next;

      for ( keys %{$new_config->{$elem}} ) {
        $config{$elem}{$_} = $new_config->{$elem}{$_};
      }
    }

    if (defined $new_config->{'optimization'}) {
      $config{'optimization'} = $new_config->{'optimization'};
    }

  }

##############

  # prepare the table, tr and td attributes
  my $table = join ' ', map { "$_=\"$config{'table'}{$_}\"" } sort keys %{$config{'table'}};

  my $tr    = join ' ', map { "$_:$config{'tr'}{$_};"       } sort keys %{$config{'tr'   }};
  my $td    = join ' ', map { "$_:$config{'td'}{$_};"       } sort keys %{$config{'td'   }};

  # our ascii text
  my $text = shift;

  # where we'll store our html
  my $html = '';

  # style (td and tr elements' attributes)
  $html .= "<style>\n" .
           ".$config{'id'} td { $td }\n.$config{'id'} tr { $tr }" .
           "\n</style>\n";

  # table header
  $html .= "<table class=\"$config{'id'}\" $table>\n";

  # prepare the cells
  my @lines = map { [ split //, $_ ] } split /\n/, $text;

  # just to make sure an optimized table has the same width as the normal one
  my $opt_fix = '';
  if ( $config{'optimization'} ) {
    my $width = 0;
    for my $l ( 0 .. $#lines ) {
      if ( $width < $#{$lines[$l]} ) {
        $width = $#{$lines[$l]};
      }
    }
    $opt_fix = '<tr>' . ( '<td></td>' x $width ) . '</tr>';
  }

  for my $line ( 0 .. $#lines ) {
    for my $cell ( 0 .. $#{$lines[$line]} ) {
      next if $lines[$line]->[$cell] eq '';

      # randomizing new colors
      if ( $config{'randomize-new-colors'} ) {
        if ( not defined $config{'colors'}{ $lines[$line]->[$cell] } ) {
          $config{'colors'}{ $lines[$line]->[$cell] } = _random_color();
        }
      }

      # optimization
      my $optimization = '';

      # debugging messages were kept for future reference

      # remember that lines and cells are not the exact values, as
      # arrays start at index 0 and both lines and cells start at
      # position 1

      #my $debug = "line $line, cell $cell, ";

      if ( $config{'optimization'} ) {

        #$debug .= "\nthis is line $line, cell $cell";
	# check how many cells we could have on each line from the line we're
	# in to the last one
        my %we_could_have;
        for ( $line .. $#lines ) {
          $we_could_have{$_} = _count_in_the_beginning(
                                        $lines[$line]->[$cell],
                                        @{$lines[$_]}[$cell .. $#{$lines[$_]}]
                                      );
          #$debug .= "\nwe could have $we_could_have{$_} on line $_";
        }

        # check, for each line, how many cells an area up to that line would have
        my %area;
        my %area_width;
        for ( $line .. $#lines ) {
          my $min = _min( @we_could_have{$line .. $_} );