File Coverage

blib/lib/Image/TextMode/Canvas.pm

Criterion	Covered	Total	%
statement	57	75	76.0
branch	18	26	69.2
condition	1	3	33.3
subroutine	12	13	92.3
pod	10	10	100.0
total	98	127	77.1

package Image::TextMode::Canvas;

use Moo;
use Types::Standard qw( Int ArrayRef );
use Image::TextMode::Pixel;

=head1 NAME

Image::TextMode::Canvas - A canvas of text mode pixels

=head1 DESCRIPTION

This module represents the graphical portion of an image, i.e. a grid
of pixels.

=head1 ACCESSORS

=over 4

=item * width - the width of the canvas

=item * height - the height of the canvas

=item * pixeldata - an arrayref of arrayrefs of pixel data

=back

=cut

has 'width' => ( is => 'rw', lazy => 1, isa => Int, default => 0 );

has 'height' => ( is => 'rw', lazy => 1, isa => Int, default => 0 );

has 'pixeldata' => ( is => 'rw', lazy => 1, isa => ArrayRef, default => sub { [] } );

=head1 METHODS

=head2 new( %args )

Creates a new canvas.

=head2 getpixel( $x, $y )

Get raw pixel data at C<$x>, C<$y>.

=cut

sub getpixel {
    my ( $self, $x, $y ) = @_;
    return unless exists $self->pixeldata->[ $y ];    # avoid autovivification
    return $self->pixeldata->[ $y ]->[ $x ];
}

=head2 getpixel_obj( $x, $y, \%options )

Create a pixel object data at C<$x>, C<$y>. Available options include:

=over 4

=item * blink_mode - enabed or disable blink mode for the pixel object

=back

=cut

sub getpixel_obj {
    my ( $self, $x, $y, $options ) = @_;
    my $pixel = $self->getpixel( $x, $y );
    return unless $pixel;
    return Image::TextMode::Pixel->new( %$pixel, $options );
}

=head2 putpixel( \%pixel, $x, $y )

Store pixel data at C<$x>, C<$y>.

=cut

sub putpixel {
    my ( $self, $pixel, $x, $y ) = @_;
    $self->pixeldata->[ $y ]->[ $x ] = $pixel;

    my ( $w, $h ) = ( $x + 1, $y + 1 );
    $self->height( $h ) if $self->height < $h;
    $self->width( $w )  if $self->width < $w;
}

=head2 dimensions( )

returns a list of the width and height of the image.

=cut

sub dimensions {
    my $self = shift;
    return $self->width, $self->height;
}

=head2 clear_screen( )

Clears the canvas pixel data.

=cut

sub clear_screen {
    my $self = shift;
    $self->width( 0 );
    $self->height( 0 );
    $self->pixeldata( [] );
}

=head2 clear_line( $y, [ \@range ] )

Clears the data at line C<$y>. Specify a range to clear only a portion of
line C<$y>.

=cut

sub clear_line {
    my $self  = shift;
    my $y     = shift;
    my $range = shift;

    return unless defined $self->pixeldata->[ $y ];

    if ( !$range ) {
        $self->pixeldata->[ $y ] = [];
    }
    else {
        $range->[ 1 ] = @{ $self->pixeldata->[ $y ] } - 1 if $range->[ 1 ] == -1;
        $self->pixeldata->[ $y ]->[ $_ ] = undef
            for $range->[ 0 ] .. $range->[ 1 ];
    }
}

=head2 delete_line( $y )

Removes the line from the canvas, moving all subsquent lines up.

=cut

sub delete_line {
    my $self  = shift;
    my $y     = shift;

    return unless exists $self->pixeldata->[ $y ];

    delete @{ $self->pixeldata }[ $y ];
    $self->height( $self->height - 1 );
}

=head2 as_ascii( )

Returns only the character data stored in the canvas.

=cut

sub as_ascii {
    my ( $self ) = @_;

    my $output = '';
    for my $row ( @{ $self->pixeldata } ) {
        for my $col ( @$row ) {
            $output .= defined $col
                && defined $col->{ char } ? $col->{ char } : ' ';
        }
        $output .= "\n";
    }

    return $output;
}

=head2 max_x( $line )

Finds the last defined pixel on a given line. Useful for optimizing writes
in formats where width matters. Returns undef for a missing line.

=cut

sub max_x {
    my ( $self, $y ) = @_;
    my $line = $self->pixeldata->[ $y ];

    return unless $line;

    my $x;
    for ( 0 .. @$line - 1 ) {
        $x = $_ if defined $line->[ $_ ];
    }

    return $x;
}

=head2 ansiscale( $factor )

Perform nearest neighbor scaling in text mode. Returns a new textmode
image.

    # scale down to 1/4 the original size
    my $scaled = $image->ansiscale( 0.25 );

=cut

sub ansiscale {
    my ( $self, $factor ) = @_;

    my $new    = ( ref $self )->new;
    my $width  = $self->width * $factor;
    my $height = $self->height * $factor;

    $width  = int( $width + 1 )  if int( $width ) != $width;
    $height = int( $height + 1 ) if int( $height ) != $height;

    my $oldpixels = $self->pixeldata;
    my $newpixels = [];

    my $inv_ratio = ( 1 / $factor );

    for my $y ( 0 .. $height - 1 ) {
        for my $x ( 0 .. $width - 1 ) {
            my $px = int( $x * $inv_ratio );
            my $py = int( $y * $inv_ratio );

            $newpixels->[ $y ]->[ $x ] = $oldpixels->[ $py ]->[ $px ];
        }
    }

    $new->width( $width );
    $new->height( $height );
    $new->pixeldata( $newpixels );
    return $new;
}

=head1 AUTHOR

Brian Cassidy [e-mail]

=head1 COPYRIGHT AND LICENSE

Copyright 2008-2014 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;