The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Image::TextMode::Renderer::GD;

use Moose;
use Module::Runtime ();
use GD;
use Image::TextMode::Palette::ANSI;
use Carp 'croak';
use File::ShareDir;

=head1 NAME

Image::TextMode::Renderer::GD - A GD-based renderer for text mode images

=head1 SYNOPSIS

    use Image::TextMode::Format::ANSI;
    use Image::TextMode::Renderer::GD;
    
    my $ansi = Image::TextMode::Format::ANSI->new;
    $ansi->read( $file );
    
    my $renderer = Image::TextMode::Renderer::GD->new;
    
    # render fullscale version
    print $renderer->fullscale( $ansi );
    
    # render thumnail version
    print $renderer->thumbnail( $ansi );

=head1 DESCRIPTION

This module allows you to render your text mode image though the GD
graphics library.

=head1 METHODS

=head2 new( %args )

Creates a new instance.

=head2 thumbnail( $source, \%options )

Renders a thumbnail-sized version of the image. This is mostly a pass-through to
C<fullscale()> with the resulting image being scaled down to 1 pixel width per
1 character column. Options specific to this method are:

=over 4

=item * zoom - a zoom factor for the thumbnail (default: n/a)

=back

See C<fullscale> for all of the other available options.

=cut

sub thumbnail {
    my ( $self, $source, $options ) = @_;

    $options = { %{ $source->render_options }, $options ? %$options : () };

    if ( $source->can( 'frames' ) ) {
        return $self->_render_animated_thumbnail( $source, $options );
    }

    my $image_l = do {
        local $options->{ format } = 'object';    ## no critic (Variables::ProhibitLocalVar)
        $self->fullscale( $source, $options );
    };

    my ( $width, $height ) = _thumbnail_size( $source, $image_l, $options );

    my $image = GD::Image->new( $width, $height, 1 );
    $image->copyResampled( $image_l, 0, 0, 0, 0, $width, $height,
        $image_l->getBounds );

    my $output = $options->{ format } || 'png';

    return $image if $output eq 'object';
    return $image->$output;
}

sub _render_animated_thumbnail {
    my ( $self, $source, $options ) = @_;
    my @frames = @{ $source->frames };
    $options->{ format } = 'object';
    $self->_prepare_options( $source, $options );
    my $frame = $self->_render_frame( $frames[ 0 ], $options );
    my ( $width, $height ) = _thumbnail_size( $source, $frame, $options );
    my $master = GD::Image->new( $width, $height, 1 );

    $master->copyResampled( $frame, 0, 0, 0, 0, $width, $height,
        $frame->getBounds );
    my $output = $master->gifanimbegin( 0 );
    $output .= $master->gifanimadd( 1, 0, 0, 15, 1 );

    shift @frames;
    for my $canvas ( @frames ) {
        $frame = $self->_render_frame( $canvas, $options );
        $master->copyResampled( $frame, 0, 0, 0, 0, $width, $height,
            $frame->getBounds );
        $output .= $master->gifanimadd( 1, 0, 0, 15, 1 );
    }

    $output .= $master->gifanimend;

    return $output;
}

sub _thumbnail_size {
    my ( $source, $image, $options ) = @_;

    my ( $width, $height ) = $source->dimensions;
    $height = $image->height / int( $image->width / $width + 0.5 );

    if ( my $zoom = $options->{ zoom } ) {
        $width  *= $zoom;
        $height *= $zoom;
    }

    return ( $width, $height );
}

=head2 fullscale( $source, \%options )

Renders a pixel-by-pixel representation of the text mode image. You may use the
following options to change the output:

=over 4

=item * crop - limit the display to this many rows (default: no limit)

=item * blink_mode - when false, use the 8th bit of an attribute byte as part of the background color (aka iCEColor) (default: differs by format)

=item * truecolor - set this to true to enable true color image output (default: false)

=item * 9th_bit - compatibility option to enable a ninth column in the font (default: false)

=item * dos_apsect - emulate the aspect ratio from DOS (default: false)

=item * ced - CED mode (black text on gray background) (default: false)

=item * font - override the image font; either a font object, or the last part of the clas name (e.g. 8x8)

=item * palette - override the image palette; either a palette object, or the last part of the class name (e.g. VGA)

=item * format - the output format (default: png)

=back

=cut

sub fullscale {
    my ( $self, $source, $options ) = @_;

    $options = { %{ $source->render_options }, $options ? %$options : () };

    $self->_prepare_options( $source, $options );

    if ( $source->can( 'frames' ) ) {
        $options->{ format } = 'object';
        my $master = GD::Image->new( @{ $options->{ full_dimensions } } );
        my $output = $master->gifanimbegin( 0 );
        for my $canvas ( @{ $source->frames } ) {
            my $obj = $self->_render_frame( $canvas, $options );

            $output .= $obj->gifanimadd( 1, 0, 0, 15, 1 );
        }
        $output .= $master->gifanimend;
        return $output;
    }

    return $self->_render_frame( $source, $options );
}

sub _prepare_options {
    my ( $self, $source, $options ) = @_;

    $options->{ font }    ||= $source->font;
    $options->{ palette } ||= $source->palette;
    $options->{ palette } = Image::TextMode::Palette::ANSI->new
        if $options->{ ced };

    for ( qw( font palette ) ) {
        next if ref $options->{ $_ };

        my $class
            = 'Image::TextMode::' . ucfirst( $_ ) . q(::) . $options->{ $_ };

        if ( !eval { Module::Runtime::require_module( $class ) } ) {
            croak sprintf( "Unable to load ${_} '%s'", $options->{ $_ } );
        }

        $options->{ $_ } = $class->new;

    }

    $options->{ font } = _font_to_gd( $options->{ font },
        { '9th_bit' => $options->{ '9th_bit' } } );

    $options->{ truecolor } ||= 0;
    $options->{ format }    ||= 'png';

    my ( $width, $height ) = $source->dimensions;
    $height = $options->{ crop } if $options->{ crop };
    $options->{ full_dimensions } = [
        $width * $options->{ font }->width,
        $height * $options->{ font }->height
    ];

    if ( $options->{ dos_aspect } ) {
        my $ratio = $options->{ '9th_bit' } ? 1.35 : 1.2;
        $options->{ full_dimensions }->[ 1 ]
            = int( $options->{ full_dimensions }->[ 1 ] * $ratio + 0.5 );
    }
}

sub _render_frame {
    my ( $self, $canvas, $options ) = @_;

    my ( $width, $height ) = $canvas->dimensions;
    $height = $options->{ crop } if $options->{ crop };

    my $font     = $options->{ font };
    my $ftwidth  = $font->width;
    my $ftheight = $font->height;
    my $ced      = $options->{ ced };

    my $image = GD::Image->new( @{ $options->{ full_dimensions } },
        $options->{ truecolor } );

    my $colors = _fill_gd_palette( $options->{ palette }, $image );

    $image->fill( 0, 0, 7 ) if $ced;

    for my $y ( 0 .. $height - 1 ) {
        for my $x ( 0 .. $width - 1 ) {
            my $pixel = $canvas->getpixel_obj( $x, $y, $options );

            next unless $pixel;

            if ( defined $pixel->bg ) {
                $image->filledRectangle(
                    $x * $ftwidth,
                    $y * $ftheight,
                    ( $x + 1 ) * $ftwidth - 1,
                    ( $y + 1 ) * $ftheight - 1,
                    $colors->[ $ced ? 7 : $pixel->bg ]
                );
            }

            $image->string(
                $font,
                $x * $ftwidth,
                $y * $ftheight,
                $pixel->char, $colors->[ $ced ? 0 : $pixel->fg ]
            );
        }
    }

    if ( $options->{ dos_aspect } ) {
        my $resized = GD::Image->new( $image->getBounds, 1 );
        $resized->copyResampled( $image, 0, 0, 0, 0,
            @{ $options->{ full_dimensions } },
            $image->width, $height * $ftheight );
        $image = $resized;
    }

    my $output = $options->{ format };

    return $image if $output eq 'object';
    return $image->$output;
}

sub _font_to_gd {
    my ( $font, $options ) = @_;
    my $ninth = $options->{ '9th_bit' };
    my $name = lc( ( split( /\::/s, ref $font ) )[ -1 ] );

    if (my $fn = eval {
            File::ShareDir::dist_file( 'Image-TextMode',
                $name . ( $ninth ? '_9b' : '' ) . '.fnt' );
        }
        )
    {
        return GD::Font->load( $fn );
    }

    require File::Temp;
    my $temp = File::Temp->new;
    _save_gd_font( $font, $options, $temp );
    close $temp or croak "Unable to close temp file: $!";

    return GD::Font->load( $temp->filename );
}

sub _save_gd_font {
    my ( $font, $options, $fh ) = @_;

    binmode( $fh );

    my $ninth     = $options->{ '9th_bit' };
    my $chars     = $font->chars;
    my $font_size = @$chars;

    print $fh pack( 'VVVV',
        $font_size, 0, $font->width + ( $ninth ? 1 : 0 ),
        $font->height );

    for my $charval ( 0 .. $font_size ) {
        my $char = $chars->[ $charval ];
        for ( @$char ) {
            my @binary = split( //s, sprintf( '%08b', $_ ) );

            if ( $ninth ) {
                push @binary,
                    (       $charval >= 0xc0
                        and $charval <= 0xdf ? $binary[ -1 ] : 0 );
            }

            print $fh pack( 'C*', @binary );
        }
    }
}

sub _fill_gd_palette {
    my ( $palette, $image ) = @_;
    my @allocations
        = map { $image->colorAllocate( @$_ ) } @{ $palette->colors };
    return \@allocations;
}

no Moose;

__PACKAGE__->meta->make_immutable;

=head1 AUTHOR

Brian Cassidy E<lt>bricas@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2008-2013 by Brian Cassidy

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut

1;