Image::XBin - (DEPRECATED) Load, create, manipulate and save XBin image files

    This module has been replaced by Image:TextMode.

	use Image::XBin;

	# Read in a file...
	my $img = Image::XBin->new( file => 'myxbin.xb' );

	# Image width and height
	my $w = $img->width;
	my $h = $img->height;

	# get and put "pixels"
	my $pixel = $img->getpixel( $x, $y );
	$img->putpixel( $x, $y, $pixel );

	# font (XBin::Font)
	my $font = $img->font;

	# palette (XBin::Palette)
	my $palette = $img->palette;

	# save the data to a file
	$img->write( file => 'x.xb' );

	+------------+
	| Header     |
	+------------+
	| Palette    |
	+------------+
	| Font       |
	+------------+
	| Image Data |
	+------------+

	perl Build.PL
	./Build         # or `perl Build`
	./Build test    # or `perl Build test`
	./Build install # or `perl Build install`

	perl Makefile.PL
	make
	make test
	make install

	# filename
	$xbin = Image::XBin->new( file => 'file.xb' );

	# file handle
	$xbin = Image::XBin->new( handle => $handle );

	# string
	$xbin = Image::XBin->new( string => $string );

	# Thumbnail -- Default
	$xbin->as_png( mode => 'thumbnail' );

	# Full size
	$xbin->as_png( mode => 'full' );

	# Crop it after 25 (text-mode) rows
	$xbin->as_png_full( crop => 25 );

package Image::XBin;

use base qw( Class::Accessor );

use strict;
use warnings;

use Carp;
use Image::XBin::Parser;
use Image::XBin::Util;
use Image::XBin::Palette::Default;
use Image::XBin::Font::Default;
use GD;

our $VERSION = '0.06';

use constant XBIN_ID          => 'XBIN';

# Header byte constants
use constant PALETTE          => 1;
use constant FONT             => 2;
use constant COMPRESSED       => 4;
use constant NON_BLINK        => 8;
use constant FIVETWELVE_CHARS => 16;

my $header_template = 'A4 C S S C C';
my @header_fields   = qw( id eofchar width height fontsize flags );
my $eof_char        = chr( 26 );

__PACKAGE__->mk_accessors( @header_fields );

sub new {
	my $class   = shift;
	my $self    = {};
	my %options = @_;

	bless $self, $class;

	$self->clear;

	if(
		exists $options{ file } or
		exists $options{ string } or
		exists $options{ handle }
	) {
		return $self->read( @_ );
	}
	else {
		# create new using options
	}

	return $self;
}

sub clear {
	my $self = shift;

	$self->id( XBIN_ID );
	$self->eofchar( $eof_char );
	$self->fontsize( undef );
	$self->flags( 0 );
	$self->width( 0 );
	$self->height( 0 );
	$self->font( undef );
	$self->palette( undef );
	$self->sauce( undef );
	$self->{ image } = undef;
}

sub read {
	my $self    = shift;
	my %options = @_;
	$self       = Image::XBin::Parser->new( %options );

	return $self;
}

sub write {
	my $self    = shift;
	my %options = @_;
	my $file    = create_io_object( \%options, '>' );

	print $file $self->as_string;
}

sub as_string {
	my $self = shift;

	my $output;

	# must set header to uncompressed because we don't have a compression alg yet.
	# set old value back when done.
	# this is temporary!!!
	my $compressed = $self->is_compressed;
	$self->compress( 0 );

	# header
	$output .= pack( $header_template, map { $self->$_ } @header_fields );

	# palette
	if( $self->has_palette ) {
		$output .= $self->palette->as_string;
	}

	# font
	if( $self->has_font ) {
		$output .= $self->font->as_string;
	}

	# image
	if( $self->is_compressed ) {
		# RLE compression alg.
	}
	else {
		for my $y ( 0..$self->height - 1 ) {
			for my $x ( 0..$self->width - 1 ) {
				my $pixel = $self->getpixel( $x, $y );
				$output .= pack( 'C*', ord( $pixel->char ), $pixel->attr );
			}
		}
	}

	if( $self->sauce ) {
		$output .= $self->sauce->as_string;
	}

	# set old value
	$self->compress( $compressed );

	return $output;
}

sub as_png {
	my $self    = shift;
	my %options = @_;

        $options{ mode } = 'thumbnail' unless defined $options{ mode } and $options{ mode } eq 'full';

        if( $options{ mode } eq 'full' ) {
                return $self->as_png_full( @_ );
        }
        else {
                return $self->as_png_thumbnail( @_ );
	}
}

sub as_png_thumbnail {
	my $self = shift;
	croak( "Not implemented" );
}

sub as_png_full {
	my $self    = shift;
	my %options = @_;
	my $crop    = ( defined $options{ crop } and $options{ crop } > 0 and $options{ crop } < $self->height ) ? $options{ crop } : $self->height;

	my $palette = $self->has_palette ? $self->palette : Image::XBin::Palette::Default->new;
	my $font    = $self->has_font ? $self->font : Image::XBin::Font::Default->new;

	my $image   = GD::Image->new( $self->width * 8, $crop * $font->height );

	my @colors;
        for( 0..15 ) {
		push @colors, $image->colorAllocate(
			map {
				$_->[ 0 ] / 63 * 255,
				$_->[ 1 ] / 63 * 255,
				$_->[ 2 ] / 63 * 255 
			} $palette->get( $_ )
		);
        }

	my $gdfont = $font->as_gd;

	# Create the png
	for my $y ( 0..$crop - 1 ) {
		for my $x ( 0..$self->width - 1 ) {
			my $pixel = $self->getpixel( $x, $y );
			if( $pixel->bg ) {
				$image->filledRectangle( $x * $font->width, $y * $font->height, ( $x + 1 ) * $font->width, ( $y + 1 ) * $font->height - 1, $colors[ $pixel->bg ] );
			}

			$image->string( $gdfont, $x * $font->width, $y * $font->height, $pixel->char, $colors[ $pixel->fg ] );
		}
	}

	return $image->png;
}

sub has_palette {
	return $_[ 0 ]->flags & PALETTE;
}

sub has_font {
	return ( $_[ 0 ]->flags & FONT ) >> 1;
}

sub is_compressed {
	my $self = shift;
	return $self->compress;
}

sub is_nonblink {
	return ( $_[ 0 ]->flags & NON_BLINK ) >> 3;
}

sub has_512chars {
	return ( $_[ 0 ]->flags & FIVETWELVE_CHARS ) >> 4;
}

sub sauce {
	my $self  = shift;
	my $sauce = shift;

	if( ref $sauce eq 'File::SAUCE' ) {
		$self->{ sauce } = $sauce;
	}
	elsif( $sauce ) {
		$self->{ sauce } = undef;

	}

	return $self->{ sauce };
}

sub putpixel {
	my $self = shift;
	return $self->pixel( @_ );
}

sub getpixel {
	my $self = shift;
	return $self->pixel( @_ );
}

sub pixel {
	my $self = shift;
	my( $x, $y, $pixel ) = @_;

	if( defined $pixel ) {
		$self->{ image }->[ $y * $self->width + $x ] = $pixel;
	}

	return $self->{ image }->[ $y * $self->width + $x ];
}

sub font {
	my $self = shift;
	my $font = $_[ 0 ];

	# set palette and header flags if it's a valid object
	if( @_ and ref $font eq 'Image::XBin::Font' ) {
		$self->{ font } = $font;
		$self->flags( $self->flags | FONT );
		$self->flags( $self->flags | FIVETWELVE_CHARS ) if $font->characters == 512;
	}
	# clear data otherwise
	elsif( @_ ) {
		$self->flags( $self->flags & ~FONT );
		$self->flags( $self->flags & ~FIVETWELVE_CHARS );
		$self->{ font } = undef;
	}

	return $self->{ font };
}

sub palette {
	my $self    = shift;
	my $palette = $_[ 0 ];
	use Data::Dumper;

	# set palette and header flags if it's a valid object
	if( @_ and ref $palette eq 'Image::XBin::Palette' ) {
		$self->{ palette } = $palette;
		$self->flags( $self->flags | PALETTE );
	}
	# clear data otherwise
	elsif( @_ ) {
		$self->flags( $self->flags & ~PALETTE );
		$self->{ palette } = undef;
	}

	return $self->{ palette };
}

sub compress {
	my $self     = shift;
	my $compress = $_[ 0 ];

	# if $compress is true, set it in the flags. else, unset it
	if( @_ and $compress ) {
		$self->flags( $self->flags | COMPRESSED );
	}
	elsif( @_ ) {
		$self->flags( $self->flags & ~COMPRESSED );
	}

	return ( $self->flags & COMPRESSED ) >> 2;
}

1;