package Graphics::Framebuffer;

=head1 NAME

Graphics::Framebuffer - A Simple Framebuffer Graphics Library

=head1 SYNOPSIS

 use Graphics::Framebuffer;

 my $fb = Graphics::Framebuffer->new();

 $fb->cls();
 $fb->set_color({'red' => 255, 'green' => 255, 'blue' => 255});
 $fb->plot({'x' => 28, 'y' => 79,'pixel_size' => 1});
 $fb->drawto({'x' => 405,'y' => 681,'pixel_size' => 1});
 $fb->circle({'x' => 200, 'y' => 200, 'radius' => 100, 'filled' => 1});
 $fb->polygon({'coords' => [20,20,  53,3,  233,620], 'pixel_size' => 5});
 $fb->box({'x' => 95, 'y' => 100, 'xx' => 400, 'yy' => 600, 'filled' => 1});

 $fb->close_screen();

=head1 DESCRIPTION

A (mostly) Pure Perl graphics library for exclusive use in a console
framebuffer environment.  It is written for simplicity, without the need for
complex API's and drivers with "surfaces" and such.

Back in the old days, computers drew graphics this way, and it was simple and
easy to do.  I was writing a console based media playing program, and was not
satisfied with the limited abilities offered by the Curses library, and I did
not want the overhead of the X environment to get in the way.  My intention
was to create a mobile media server.  In case you are wondering, that project
has been quite successful, and I am still making improvements to it.  I may
even include it in the "examples" directory on future versions.

There are places where Pure Perl just won't cut it.  So I use the Imager
library to take up the slack.  It's just used to load and save images, and
draw TrueType text.

I cannot guarantee this will work on your video card, but I have successfully
tested it on NVidia GeForce, AMD Radeon, Matrox, Raspberry PI, and VirtualBox
displays.  However, you MUST remember, your video driver MUST be framebuffer
based.  The proprietary Nvidia and AMD drivers will NOT work with this module.
You must use the open source video drivers, such as Nouveau, to be able to use
this library.  Also, it is not going to work from within X, so don't even try
it, at will either crash, or make a mess.  This is a console only graphics
library.

I have not been able to get it to work on the Odroid XU3.  Apparently its
video driver is not a true framebuffer.  Which is sad, as a multithreaded
program on its 8 cores would be awesome.

I highly suggest you use 32 bit mode and avoid 16 bit, as it has been a long
time since I tested it on a 16 bit graphics mode.

NOTE:

If a framebuffer is not available, the module will go into emulation mode and
open a pseudo-screen in the object's hash variable 'SCREEN'

You can write this to a file, whatever.  It defaults to a 640x480x32 graphics
'buffer'.  However, you can change that by passing parameters to the 'new'
method.

You will not be able to see the output directly when in emulation mode.  I
mainly created this mode so that you could install this module (on systems
without a framebuffer) and test code you may be writing to be used on other
devices that have accessible framebuffer devices.

=cut

use strict;
no strict 'vars'; # We have to map a variable as the screen.  So strict is
                  # going to whine about what we do with it.
use constant {
    RGB => 1,
    BGR => 0
};
use 5.010;
# use Carp;
use Switch;             # Yes, a touch of new Perl. Switch is so much nicer
                        # a ton of if-else's
use Math::Trig qw(:pi); # Yes, yummy PI
use Sys::Mmap;          # Absolutely necessary to map the screen to a string.
                        # Without this, I doubt this module would exist.
use Imager;             # This is used for TrueType font printing, and where
                        # 'Pure Perl' goes up in smoke.

BEGIN {
    require Exporter;

    # set the version for version checking
    our $VERSION   = 4.11;
    our @ISA       = qw(Exporter);
    our @EXPORT    = qw();
    our @EXPORT_OK = qw();
}

DESTROY {
    my $self = shift;
    $self->screen_close();
}

=head1 METHODS

=head2 new

This instantiates the framebuffer object

=over 1

my $fb = Graphics::Framebuffer->new(parameter => value);

=back

=head3 PARAMETERS

=over 2

=item B< FB_DEVICE>

 Framebuffer device name. Default is /dev/fb0

=item B< COLOR_ORDER >

Sets the coloring logic to use the proper color ordering.
Currently, the only accepted values are either 1 for RGB or
0 for BGR.

The default is 0 for BGR

=item B< VXRES (Emulation Mode Only!  Otherwise ignored.)>

 Width of the emulation framebuffer.  Default is 640.

=item B< VYRES (Emulation Mode Only!  Otherwise ignored.)>

 Height of the emulation framebuffer.  Default is 480.

=item B< BITS (Emulation Mode Only!  Otherwise ignored.)>

 Number of bits per pixel in the emulation framebuffer.
 Default is 32.

=item B< BYTES (Emulation Mode Only!  Otherwise ignored.)>

 Number of bytes per pixel in the emulation framebuffer.
 It's best to keep it BITS/8.  Default is 4.

=back

=cut

sub new {
    my $class = shift;
    my @dummy;    # Just a temporary generic array for excess data returned from _get_info
    my $self = {
        'SCREEN' => '',

        # Set up the user defined graphics primitives and attributes default values
        'I_COLOR'     => undef,
        'X'           => 0,
        'Y'           => 0,
        'X_CLIP'      => 0,
        'Y_CLIP'      => 0,
        'YY_CLIP'     => undef,
        'XX_CLIP'     => undef,
        'COLOR'       => undef,
        'DRAW_MODE'   => 0,
        'B_COLOR'     => undef,
        'NORMAL_MODE' => 0,
        'XOR_MODE'    => 1,
        'OR_MODE'     => 2,
        'AND_MODE'    => 3,
        'MASK_MODE'   => 4,
        'CLIPPED'     => 0,

        ## Set up the Framebuffer driver "constants" defaults
        # Commands
        'FBIOGET_VSCREENINFO'      => 0x4600,
        'FBIOPUT_VSCRRENINFO'      => 0x4601,
        'FBIOGET_FSCREENINFO'      => 0x4602,
        'FBIOGETCMAP'              => 0x4604,
        'FBIOPUTCMAP'              => 0x4605,
        'FBIOPAN_DISPLAY'          => 0x4606,
        # FLAGS
        'FBINFO_HWACCEL_COPYAREA'  => 0x0100,
        'FBINFO_HWACCEL_FILLRECT'  => 0x0200,
        'FBINFO_HWACCEL_IMAGEBLIT' => 0x0400,
        'FBINFO_HWACCEL_ROTATE'    => 0x1000,
        'FBINFO_HWACCEL_XPAN'      => 0x2000,
        'FBINFO_HWACCEL_YPAN'      => 0x4000,
        # Structure Definitions
        'FBioget_vscreeninfo'      => 'I24',
        'FBioget_fscreeninfo'      => 'A16LI4S3ILI2S',
        'FBinfo_hwaccel_copyarea'  => 'I6',     # dx(32),dy(32),width(32),height(32),sx(32),sy(32)
        'FBinfo_hwaccel_fillrect'  => 'I6',     # dx(32),dy(32),width(32),height(32),color(32),rop(32)
        'FBinfo_hwaccel_imageblit' => 'I6C1I2', # dx(32),dy(32),width(32),height(32),fg_color(32),bg_color(32),depth(8),image pointer(32),color map pointer(32)
                                                # COLOR MAP:
                                                #  start(32),length(32),red(16),green(16),blue(16),alpha(16)
        # Default values
        'VXRES'                    => 640,
        'VYRES'                    => 480,
        'BITS'                     => 32,
        'BYTES'                    => 4,
        'XOFFSET'                  => 0,
        'YOFFSET'                  => 0,
        'FB_DEVICE'                => '/dev/fb0',
        'COLOR_ORDER'              => BGR,   # Either BGR or RGB
        @_
    };
    if (open($self->{'FB'}, '+<',$self->{'FB_DEVICE'})) { # Can we open the framebuffer device??
        # YAY!  We can, so let's set things up

        binmode($self->{'FB'}); # We have to be in binary mode first

        # Make the IOCTL call to get info on the virtual (viewable) screen (Sometimes different than physical)
        ($self->{'xres'}, $self->{'yres'}, $self->{'xres_virtual'}, $self->{'yres_virtual'}, $self->{'xoffset'}, $self->{'yoffset'}, $self->{'bits_per_pixel'}, $self->{'grayscale'}, $self->{'bitfields'}, $self->{'nonstd'}, $self->{'activate'}, $self->{'height'}, $self->{'width'}, $self->{'accel_flags'}, $self->{'pixclock'}, $self->{'left_margin'}, $self->{'right_margin'}, $self->{'upper_margin'}, $self->{'lower_margin'}, $self->{'hsync_len'}, $self->{'vsync_len'}, $self->{'sync'}, $self->{'vmode'}, @dummy) = _get_info($self->{'FBIOGET_VSCREENINFO'}, $self->{'FBioget_vscreeninfo'}, $self->{'FB'});

        # MAke the IOCTL call to get info on the physical screen
        ($self->{'id'}, $self->{'smem_start'}, $self->{'smem_len'}, $self->{'type'}, $self->{'type_aux'}, $self->{'visual'}, $self->{'xpanstep'}, $self->{'ypanstep'}, $self->{'ywrapstep'}, $self->{'line_length'}, $self->{'mmio_start'}, $self->{'mmio_len'}, $self->{'accel'}, @dummy) = _get_info($self->{'FBIOGET_FSCREENINFO'}, $self->{'FBioget_fscreeninfo'}, $self->{'FB'});

        $self->{'VXRES'}          = $self->{'xres_virtual'};
        $self->{'VYRES'}          = $self->{'yres_virtual'};
        $self->{'XRES'}           = $self->{'xres'};
        $self->{'YRES'}           = $self->{'yres'};
        $self->{'XOFFSET'}        = $self->{'xoffset'} || 0;
        $self->{'YOFFSET'}        = $self->{'yoffset'} || 0;
        $self->{'BITS'}           = $self->{'bits_per_pixel'};
        $self->{'BYTES'}          = $self->{'BITS'} / 8;
        $self->{'PIXELS'}         = (($self->{'XOFFSET'} + $self->{'VXRES'}) * ($self->{'YOFFSET'} + $self->{'VYRES'}));
        $self->{'SIZE'}           = $self->{'PIXELS'} * $self->{'BYTES'};
        $self->{'smem_len'}       = $self->{'BYTES'} * ($self->{'VXRES'} * $self->{'VYRES'}) if (!defined($self->{'smem_len'}) || $self->{'smem_len'} <= 0);
        $self->{'BYTES_PER_LINE'} = int($self->{'smem_len'} / $self->{'VYRES'});

        bless($self, $class);

        attribute_reset($self);

        # Now that everything is set up, let's map the framebuffer to SCREEN
    
        mmap($self->{'SCREEN'}, $self->{'smem_len'}, PROT_READ | PROT_WRITE, MAP_SHARED, $self->{'FB'});
    } else {    # Go into emulation mode if no actual framebuffer available
        # Aww bummer, no screen.  Ok, turn on emulation mode then
        $self->{'ERROR'}          = 'Framebuffer Device Not Found! Emulation mode.  EXPERIMENTAL!!';
        
        # Set the resolution.  Either the defaults, or whatever the user passed in.
        $self->{'SCREEN'}         = chr(0) x ($self->{'VXRES'} * $self->{'VYRES'} * $self->{'BYTES'});
        $self->{'XRES'}           = $self->{'VXRES'}; # Virtual and physical are the same
        $self->{'YRES'}           = $self->{'VYRES'};
        $self->{'PIXELS'}         = (($self->{'XOFFSET'} + $self->{'VXRES'}) * ($self->{'YOFFSET'} + $self->{'VYRES'}));
        $self->{'SIZE'}           = $self->{'PIXELS'} * $self->{'BYTES'};
        $self->{'smem_len'}       = $self->{'BYTES'} * ($self->{'VXRES'} * $self->{'VYRES'}) if (!defined($self->{'smem_len'}) || $self->{'smem_len'} <= 0);
        $self->{'BYTES_PER_LINE'} = int($self->{'smem_len'} / $self->{'VYRES'});

        bless($self, $class);

        attribute_reset($self);
    } ## end else [ if (open($self->{'FB'}...))]
    return $self;
} ## end sub new
##############################################################################

=head2 screen_close

Unmaps the SCREEN and closes the framebuffer.  This is usually automatically
called when the object is destroyed.

=over 1

$fb->screen_close();

=back
=cut

sub screen_close {
    my $self = shift;
    if (!defined($self->{'ERROR'})) { # Only do it if not in emulation mode
        munmap($self->{'SCREEN'}) if (defined($self->{'SCREEN'}));
        close($self->{'FB'}) if (defined($self->{'FB'}));
        delete($self->{'FB'}); # We leave no remnants MUHWAHAHAHAHA!!!
    }
    delete($self->{'SCREEN'}); # MUHWAHAHAHA!!
}
###############################################################

=head2 screen_dimensions

Returns the size of the framebuffer in X,Y pixel values.

=over 1

my ($width,$height) = $fb->screen_dimensions();

=back
=cut

sub screen_dimensions {
    my $self = shift;
    return ($self->{'xres'}, $self->{'yres'});
}

=head2 draw_mode

Sets or returns the drawing mode, depending on how it is called.

=over 1

 my $draw_mode = $fb->draw_mode();

 $fb->draw_mode($fb->{'NORMAL_MODE'});
 $fb->draw_mode($fb->{'XOR_MODE'});
 $fb->draw_mode($fb->{'OR_MODE'});
 $fb->draw_mode($fb->{'AND_MODE'});
 $fb->draw_mode($fb->{'MASK_MODE'});

=back
=cut

sub draw_mode {
    my $self = shift;
    if (@_) {
        $self->{'DRAW_MODE'} = int(shift);
    } else {
        return ($self->{'DRAW_MODE'});
    }
}

=head2 normal_mode

This is an alias to draw_mode($fb->{'NORMAL_MODE'})

=over 1

 $fb->normal_mode();

=back

=cut

sub normal_mode {
    my $self = shift;
    $self->draw_mode($self->{'NORMAL_MODE'});
}

=head2 xor_mode

This is an alias to draw_mode($fb->{'XOR_MODE'})

=over 1

 $fb->xor_mode();

=back

=cut

sub xor_mode {
    my $self = shift;
    $self->draw_mode($self->{'XOR_MODE'});
}

=head2 or_mode

This is an alias to draw_mode($fb->{'OR_MODE'})

=over 1

 $fb->or_mode();

=back

=cut

sub or_mode {
    my $self = shift;
    $self->draw_mode($self->{'OR_MODE'});
}

=head2 and_mode

This is an alias to draw_mode($fb->{'AND_MODE'})

=over 1

 $fb->and_mode();

=back

=cut

sub and_mode {
    my $self = shift;
    $self->draw_mode($self->{'AND_MODE'});
}

=head2 mask_mode

This is an alias to draw_mode($fb->{'MASK_MODE'})

=over 1

 $fb->mask_mode();

=back

=cut

sub mask_mode {
    my $self = shift;
    $self->draw_mode($self->{'MASK_MODE'});
}

=head2 clear_screen

Fills the entire screen with the background color

=over 1

$fb->clear_screen();

=back
=cut

sub clear_screen {

    # Fills the entire screen with the background color fast #
    my $self = shift;
    $self->blit_write({'x' => 0, 'y' => 0, 'width' => $self->{'XRES'}, 'height' => $self->{'YRES'}, 'image' => chr(0) x $self->{'SIZE'}}, 0);
}

=head2 cls

The same as clear_screen

=over 1

$fb->cls();

=back
=cut

sub cls {
    my $self = shift;
    $self->clear_screen();
}

=head2 attribute_reset

Resets the plot point at 0,0.  Resets clipping to the current screen size.
Resets the global color to white and resets the drawing mode to NORMAL.

=over 1

$fb->attribute_reset();

=back
=cut

sub attribute_reset {
    my $self = shift;

    $self->{'X'} = 0;
    $self->{'Y'} = 0;
    $self->set_color({'red' => 255, 'green' => 255, 'blue' => 255});
    $self->{'DRAW_MODE'} = $self->{'NORMAL_MODE'};
    $self->set_b_color({'red' => 0, 'green' => 0, 'blue' => 0});
    $self->clip_reset;
}

=head2 reset

The same as 'attribute_reset'.

=over 1

$fb->reset();

=back
=cut

sub reset {
    my $self = shift;
    $self->attribute_reset();
}

=head2 plot

Set a single pixel in the globally set color at position x,y
with the given pixel size (or default).  Clipping applies.

=over 1

$fb->plot({'x' => 20,'y' => 30, 'pixel_size' => 3});

=back

=cut

sub plot {
    my $self   = shift;
    my $params = shift;

    my $x    = int($params->{'x'}) || 0;                 # Ignore decimals
    my $y    = int($params->{'y'}) || 0;
    my $size = int($params->{'pixel_size'} || 1);
    my ($c, $index);

    if ($size > 1) {
        $self->circle({'x' => $x, 'y' => $y, 'radius' => ($size / 2), 'filled' => 1, 'pixel_size' => 1});
    } else {
        # Only plot if the pixel is within the clipping region
        if (   ($x <= $self->{'XX_CLIP'})
            && ($y <= $self->{'YY_CLIP'})
            && ($x >= $self->{'X_CLIP'})
            && ($y >= $self->{'Y_CLIP'})) {
            $index = ($self->{'BYTES_PER_LINE'} * ($y + $self->{'YOFFSET'})) + ($x * $self->{'BYTES'});
            if ($self->{'DRAW_MODE'} == $self->{'NORMAL_MODE'}) {
                substr($self->{'SCREEN'}, $index, $self->{'BYTES'}) = $self->{'COLOR'};
            } else {
                $c = substr($self->{'SCREEN'}, $index, $self->{'BYTES'});
                switch ($self->{'DRAW_MODE'}) {
                    case ($self->{'XOR_MODE'}) {
                        $c ^= $self->{'COLOR'};
                    }
                    case ($self->{'OR_MODE'}) {
                        $c |= $self->{'COLOR'};
                    }
                    case ($self->{'AND_MODE'}) {
                        $c &= $self->{'COLOR'};
                    }
                    case ($self->{'MASK_MODE'}) {
                        $c = $self->{'COLOR'} if ($self->{'COLOR'} ne $self->{'B_COLOR'});
                    }
                    case ($self->{'UNMASK_MODE'}) {
                        $c = $self->{'COLOR'} if ($self->pixel($x, $y) eq $self->{'B_COLOR'});
                    }
                } ## end switch
                substr($self->{'SCREEN'}, $index, $self->{'BYTES'}) = $c;
            } ## end else [ if ($self->{'DRAW_MODE'...})]
        } ## end if (($x <= $self->{'XX_CLIP'...}))
        $self->{'X'} = $x;
        $self->{'Y'} = $y;
    } ## end else [ if ($size > 1) ]
} ## end sub plot

=head2 drawto

Draws a line, in the global color, from the last plotted
position to the position x,y.  Clipping applies.

=over 1

 $fb->drawto({
    'x' => 50,
    'y' => 60,
    'pixel_size' => 2
 });

=back

=cut

sub drawto {
    ##########################################################
    # Perfectly horizontal line drawing is optimized by      #
    # using the BLIT functions.  This assists greatly with   #
    # drawing filled objects.  In fact, it's hundreds of     #
    # times faster!                                          #
    ##########################################################
    my $self   = shift;
    my $params = shift;

    my $x_end = int($params->{'x'}) || 0;    # Ignore decimals
    my $y_end = int($params->{'y'}) || 0;
    my $size  = int($params->{'pixel_size'} || 1);

    my ($width, $height);
    my $start_x = $self->{'X'};
    my $start_y = $self->{'Y'};

    # Determines if the coordinates sent were right-side-up or up-side-down.
    if ($start_x > $x_end) {
        $width = $start_x - $x_end;
    } else {
        $width = $x_end - $start_x;
    }
    if ($start_y > $y_end) {
        $height = $start_y - $y_end;
    } else {
        $height = $y_end - $start_y;
    }
    # We need only plot if start and end are the same
    if (($x_end == $start_x) && ($y_end == $start_y)) {
        $self->plot({'x' => $x_end, 'y' => $y_end, 'pixel_size' => $size});

        # Else, let's get to drawing
    } elsif ($x_end == $start_x) { # Draw a perfectly verticle line
        if ($start_y > $y_end) { # Draw direction is UP
            while ($start_y >= $y_end) {
                $self->plot({'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size});
                $start_y--;
            }
        } else { # Draw direction is DOWN
            while ($start_y <= $y_end) {
                $self->plot({'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size});
                $start_y++;
            }
        }
        $self->plot({'x' => $x_end, 'y' => $y_end, 'pixel_size' => $size});
    } elsif ($y_end == $start_y) { # Draw a perfectly horizontal line (fast)
        if ($size == 1) {
            if ($start_x > $x_end) {
                $self->blit_write({'x' => $x_end, 'y' => $y_end, 'width' => $width, 'height' => 1, 'image' => $self->{'COLOR'} x $width});    # Blitting a horizontal line is much faster!
            } else {
                $self->blit_write({'x' => $start_x, 'y' => $start_y, 'width' => $width, 'height' => 1, 'image' => $self->{'COLOR'} x $width});    # Blitting a horizontal line is much faster!
            }
        } else {
            for (my $ty = ($y_end - ($size / 2)); $ty <= ($y_end + ($size / 2)); $ty++) {
                if ($start_x > $x_end) {
                    $self->blit_write({'x' => $x_end, 'y' => $ty, 'width' => $width, 'height' => 1, 'image' => $self->{'COLOR'} x $width});       # Blitting a horizontal line is much faster!
                } else {
                    $self->blit_write({'x' => $start_x, 'y' => $ty, 'width' => $width, 'height' => 1, 'image' => $self->{'COLOR'} x $width});     # Blitting a horizontal line is much faster!
                }
            }
        }
        $self->plot({'x' => $x_end, 'y' => $y_end, 'pixel_size' => $size});
    } elsif ($width > $height) { # Wider than it is high
        my $factor = $height / $width;
        if (($start_x < $x_end) && ($start_y < $y_end)) { # Draw UP and to the RIGHT
            while ($start_x < $x_end) {
                $self->plot({'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size});
                $start_y += $factor;
                $start_x++;
            }
        } elsif (($start_x > $x_end) && ($start_y < $y_end)) { # Draw UP and to the LEFT
            while ($start_x > $x_end) {
                $self->plot({'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size});
                $start_y += $factor;
                $start_x--;
            }
        } elsif (($start_x < $x_end) && ($start_y > $y_end)) { # Draw DOWN and to the RIGHT
            while ($start_x < $x_end) {
                $self->plot({'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size});
                $start_y -= $factor;
                $start_x++;
            }
        } elsif (($start_x > $x_end) && ($start_y > $y_end)) { # Draw DOWN and to the LEFT
            while ($start_x > $x_end) {
                $self->plot({'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size});
                $start_y -= $factor;
                $start_x--;
            }
        }
        $self->plot({'x' => $x_end, 'y' => $y_end, 'pixel_size' => $size});
    } elsif ($width < $height) { # Higher than it is wide
        my $factor = $width / $height;
        if (($start_x < $x_end) && ($start_y < $y_end)) { # Draw UP and to the RIGHT
            while ($start_y < $y_end) {
                $self->plot({'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size});
                $start_x += $factor;
                $start_y++;
            }
        } elsif (($start_x > $x_end) && ($start_y < $y_end)) { # Draw UP and to the LEFT
            while ($start_y < $y_end) {
                $self->plot({'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size});
                $start_x -= $factor;
                $start_y++;
            }
        } elsif (($start_x < $x_end) && ($start_y > $y_end)) { # Draw DOWN and to the RIGHT
            while ($start_y > $y_end) {
                $self->plot({'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size});
                $start_x += $factor;
                $start_y--;
            }
        } elsif (($start_x > $x_end) && ($start_y > $y_end)) { # Draw DOWN and to the LEFT
            while ($start_y > $y_end) {
                $self->plot({'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size});
                $start_x -= $factor;
                $start_y--;
            }
        }
        $self->plot({'x' => $x_end, 'y' => $y_end, 'pixel_size' => $size});
    } else {    # $width == $height
        if (($start_x < $x_end) && ($start_y < $y_end)) { # Draw UP and to the RIGHT
            while ($start_y < $y_end) {
                $self->plot({'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size});
                $start_x++;
                $start_y++;
            }
        } elsif (($start_x > $x_end) && ($start_y < $y_end)) { # Draw UP and to the LEFT
            while ($start_y < $y_end) {
                $self->plot({'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size});
                $start_x--;
                $start_y++;
            }
        } elsif (($start_x < $x_end) && ($start_y > $y_end)) { # Draw DOWN and to the RIGHT
            while ($start_y > $y_end) {
                $self->plot({'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size});
                $start_x++;
                $start_y--;
            }
        } elsif (($start_x > $x_end) && ($start_y > $y_end)) { # Draw DOWN and to the LEFT
            while ($start_y > $y_end) {
                $self->plot({'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size});
                $start_x--;
                $start_y--;
            }
        }
        # Plot the last pixel
        $self->plot({'x' => $x_end, 'y' => $y_end, 'pixel_size' => $size});
    } ## end else [ if (($x_end == $start_x...))]
} ## end sub drawto

=head2 draw_arc

Draws an arc of a circle at point x,y.

=over 1

 x             = x of center of circle
 y             = y of center of circle
 radius        = radius of circle
 start_degrees = starting point, in degrees, of arc
 end_degrees   = ending point, in degrees, of arc
 granularity   = This is used for accuracy in drawing
                 the arc.  The smaller the number, the
                 more accurate the arc is drawn, but it
                 is also slower.  Values between 0.1
                 and 0.01 are usually good.
 mode          = Specifies the drawing mode.
                  0 > arc only
                  1 > Filled pie section
                  2 > Poly arc.  Draws a line from x,y to the
                      beginning and ending arc position.

 $fb->draw_arc({
    'x'             => 100,
    'y'             => 100,
    'radius'        => 100,
    'start_degrees' => -40,
    'end_degrees'   => 80,
    'grandularity   => .05,
    'mode'          => 2
 });

=back

=cut

sub draw_arc {
    # This isn't exactly the fastest routine out there,
    # hence the "granularity" parameter, but it is pretty
    # neat.
    my $self   = shift;
    my $params = shift;

    my $x             = int($params->{'x'})      || 0;
    my $y             = int($params->{'y'})      || 0;
    my $radius        = int($params->{'radius'}) || 1;

    my $start_degrees = 0 + sprintf('%.03f', $params->{'start_degrees'}) || 0;
    my $end_degrees   = 0 + sprintf('%.03f', $params->{'end_degrees'})   || 360;
    my $granularity   = 0 + sprintf('%.03f', $params->{'granularity'})   || .1;

    my $mode          = int($params->{'mode'})      || 0;
    my $size          = int($params->{'pixel_size'} || 1);
    $size = 1 if ($mode == 1);
    my ($sx, $sy, $degrees, $ox, $oy) = (0,0,1,1,1);

    $degrees = $start_degrees;
    if ($start_degrees > $end_degrees) {
        do {
            $sx = $x - ($radius * sin(($degrees * pi) / 180));
            $sy = $y - ($radius * cos(($degrees * pi) / 180));
            if (($sx <=> $ox) || ($sy <=> $oy)) {
                switch ($mode) {
                    case (0) {    # Ordinary arc
                        $self->plot({'x' => $sx, 'y' => $sy, 'pixel_size' => $size});
                    }
                    case (1) {    # Filled arc
                        $self->plot({'x' => $x, 'y' => $y, 'pixel_size' => $size});
                        $self->drawto({'x' => $sx, 'y' => $sy, 'pixel_size' => $size});
                    }
                    case (2) {    # Poly arc
                        if ($degrees == $start_degrees) {
                            $self->plot({'x' => $x, 'y' => $y, 'pixel_size' => $size});
                            $self->drawto({'x' => $sx, 'y' => $sy, 'pixel_size' => $size});
                        } else {
                            $self->plot({'x' => $sx, 'y' => $sy, 'pixel_size' => $size});
                        }
                    }
                } ## end switch
                $ox = $sx;
                $oy = $sy;
            } ## end if (($sx <=> $ox) || (...))
            $degrees += $granularity;
        } until ($degrees >= 360);
        $degrees = 0;
    } ## end if ($start_degrees > $end_degrees)
    do {
        $sx = $x - ($radius * sin(($degrees * pi) / 180));
        $sy = $y - ($radius * cos(($degrees * pi) / 180));
        if (($sx <=> $ox) || ($sy <=> $oy)) {
            switch ($mode) {
                case (0) {    # Ordinary arc
                    $self->plot({'x' => $sx, 'y' => $sy, 'pixel_size' => $size});
                }
                case (1) {    # Filled arc
                    $self->plot({'x' => $x, 'y' => $y, 'pixel_size' => $size});
                    $self->drawto({'x' => $sx, 'y' => $sy, 'pixel_size' => $size});
                }
                case (2) {    # Poly arc
                    if ($degrees == $start_degrees) {
                        $self->plot({'x' => $x, 'y' => $y, 'piel_size' => $size});
                        $self->drawto({'x' => $sx, 'y' => $sy, 'pixel_size' => $size});
                    } else {
                        $self->plot({'x' => $sx, 'y' => $sy, 'pixel_size' => $size});
                    }
                }
            } ## end switch
            $ox = $sx;
            $oy = $sy;
        } ## end if (($sx <=> $ox) || (...))
        $degrees += $granularity;
    } until ($degrees >= $end_degrees);
    if ($mode == 2) {
        $self->plot({'x' => $x, 'y' => $y, 'pixel_size' => $size});
        $self->drawto({'x' => $sx, 'y' => $sy, 'pixel_size' => $size});
    }
} ## end sub draw_arc

=head2 ellipse

Draw an ellipse at center position x,y with XRadius, YRadius.  Either a filled
out outline is drawn based on the value of $filled.  The optional factor value
varies from the default 1 to change the look and nature of the output.

Clipping Applies.

=over 1

 $fb->ellipse({
    'x'          => 200,
    'y'          => 250,
    'xradius'    => 50,
    'yradius'    => 100,
    'filled'     => 0,
    'pixel_size' => 4
 });

=back
=cut

sub ellipse {
    # The routine even works properly for XOR mode when
    # filled ellipses are drawn as well.  This was solved by
    # drawing only if the X or Y position changed.
    my $self   = shift;
    my $params = shift;

    my $cx      = int($params->{'x'}) || 0;
    my $cy      = int($params->{'y'}) || 0;
    my $XRadius = int($params->{'xradius'}) || 1;
    my $YRadius = int($params->{'yradius'}) || 1;
    $XRadius    = 1 if ($XRadius < 1);
    $YRadius    = 1 if ($YRadius < 1);

    my $filled = int($params->{'filled'});
    my $fact   = $params->{'factor'}     || 1;
    my $size   = $params->{'pixel_size'} || 1;
    $size      = 1 if ($filled);

    my ($old_cyy, $old_cy_y) = (0,0);
    if ($fact == 0) { # We don't allow zero values for this
        $fact = 1;
    }
    my $TwoASquare   = (2 * ($XRadius * $XRadius)) * $fact;
    my $TwoBSquare   = (2 * ($YRadius * $YRadius)) * $fact;
    my $x            = $XRadius;
    my $y            = 0;
    my $XChange      = ($YRadius * $YRadius) * (1 - (2 * $XRadius));
    my $YChange      = ($XRadius * $XRadius);
    my $EllipseError = 0;
    my $StoppingX    = $TwoBSquare * $XRadius;
    my $StoppingY    = 0;

    while ($StoppingX >= $StoppingY) {
        my $cxx  = $cx + $x;
        my $cx_x = $cx - $x;
        my $cyy  = $cy + $y;
        my $cy_y = $cy - $y;
        if ($filled) {
            if ($cyy <=> $old_cyy) {
                $self->plot({'x' => $cxx, 'y' => $cyy, 'pixel_size' => $size});
                $self->drawto({'x' => $cx_x, 'y' => $cyy, 'pixel_size' => $size});
                $old_cyy = int($cyy);
            }
            if (($cy_y <=> $old_cy_y) && ($cyy <=> $cy_y)) {
                $self->plot({'x' => $cx_x, 'y' => $cy_y, 'pixel_size' => $size});
                $self->drawto({'x' => $cxx, 'y' => $cy_y, 'pixel_size' => $size});
                $old_cy_y = int($cy_y);
            }
        } else {
            $self->plot({'x' => $cxx,  'y' => $cyy,  'pixel_size' => $size});
            $self->plot({'x' => $cx_x, 'y' => $cyy,  'pixel_size' => $size});
            $self->plot({'x' => $cx_x, 'y' => $cy_y, 'pixel_size' => $size}) if ($cyy <=> $cy_y);
            $self->plot({'x' => $cxx,  'y' => $cy_y, 'pixel_size' => $size}) if ($cyy <=> $cy_y);
        }
        $y++;
        $StoppingY    += $TwoASquare;
        $EllipseError += $YChange;
        $YChange      += $TwoASquare;
        if ((($EllipseError * 2) + $XChange) > 0) {
            $x--;
            $StoppingX -= $TwoBSquare;
            $EllipseError += $XChange;
            $XChange      += $TwoBSquare;
        }
    } ## end while ($StoppingX >= $StoppingY)
    $old_cyy      = 0;
    $old_cy_y     = 0;
    $x            = 0;
    $y            = $YRadius;
    $XChange      = ($YRadius * $YRadius);
    $YChange      = ($XRadius * $XRadius) * (1 - 2 * $YRadius);
    $EllipseError = 0;
    $StoppingX    = 0;
    $StoppingY    = $TwoASquare * $YRadius;

    while ($StoppingX <= $StoppingY) {
        my $cxx  = $cx + $x;
        my $cx_x = $cx - $x;
        my $cyy  = $cy + $y;
        my $cy_y = $cy - $y;
        if ($filled) {
            if ($cyy <=> $old_cyy) {
                $self->plot({'x' => $cxx, 'y' => $cyy, 'pixel_size' => $size});
                $self->drawto({'x' => $cx_x, 'y' => $cyy, 'pixel_size' => $size});
                $old_cyy = int($cyy);
            }
            if (($cy_y <=> $old_cy_y) && ($cyy <=> $cy_y)) {
                $self->plot({'x' => $cx_x, 'y' => $cy_y, 'pixel_size' => $size});
                $self->drawto({'x' => $cxx, 'y' => $cy_y, 'pixel_size' => $size});
                $old_cy_y = int($cy_y);
            }
        } else {
            $self->plot({'x' => $cxx,  'y' => $cyy,  'pixel_size' => $size});
            $self->plot({'x' => $cx_x, 'y' => $cyy,  'pixel_size' => $size}) if ($cxx <=> $cx_x);
            $self->plot({'x' => $cx_x, 'y' => $cy_y, 'pixel_size' => $size}) if ($cxx <=> $cx_x);
            $self->plot({'x' => $cxx,  'y' => $cy_y, 'pixel_size' => $size});
        }
        $x++;
        $StoppingX    += $TwoBSquare;
        $EllipseError += $XChange;
        $XChange      += $TwoBSquare;
        if ((($EllipseError * 2) + $YChange) > 0) {
            $y--;
            $StoppingY -= $TwoASquare;
            $EllipseError += $YChange;
            $YChange      += $TwoASquare;
        }
    } ## end while ($StoppingX <= $StoppingY)
} ## end sub ellipse

=head2 circle

A wrapper for 'ellipse'.  I generally only needs x,y, and
radius, but filled and pixel_size are also allowed.

=over 1

 $fb->circle({
    'x'      => 300,
    'y'      => 300,
    'radius' => 100,
    'filled' => 1,
 });

=back
=cut

sub circle {
    my $self   = shift;
    my $params = shift;

    my $x      = int($params->{'x'});
    my $y      = int($params->{'y'});
    my $r      = int($params->{'radius'});
    my $filled = int($params->{'filled'} || 0);
    my $size   = int($params->{'pixel_size'} || 1);
    $self->ellipse({'x' => $x, 'y' => $y, 'xradius' => $r, 'yradius' => $r, 'filled' => $filled, 'factor' => 1, 'pixel_size' => $size});
}

=head2 polygon

Creates an empty polygon drawn in the global color value.  The parameter
'coordinates' is a reference to an array of x,y values.  The last x,y
combination is connected automatically with the first to close the polygon.
All x,y values are absolute, not relative.

Clipping applies.

=over 1

 $fb->polygon({
    'coordinates' => [
        5,5,
        23,34,
        7,7
    ],
    'pixel_size'  => 4
 });

=back
=cut

sub polygon {
    my $self   = shift;
    my $params = shift;

    my $size      = int($params->{'pixel_size'} || 1);
    my @coords    = @{$params->{'coordinates'}};
    my ($xx, $yy) = (int(shift(@coords)), int(shift(@coords)));
    my ($x, $y);
    $self->plot({'x' => $xx, 'y' => $yy, 'pixel_size' => $size});
    while (scalar(@coords)) {
        $x = int(shift(@coords));
        $y = int(shift(@coords));
        $self->drawto({'x' => $x, 'y' => $y, 'pixel_size' => $size});
    }
    $self->drawto({'x' => $xx, 'y' => $yy, 'pixel_size' => $size});
    $self->plot({'x' => $xx, 'y' => $yy, 'pixel_size' => $size}) if ($self->{'DRAW_MODE'} == 1);
} ## end sub polygon

=head2 box

Draws a box from point x,y to point xx,yy, either as an outline, if 'filled'
is 0, or as a filled block, if 'filled' is 1.  Filled boxes draw faster than
frames.

Clipping applies.

=over 1

 $fb->box({
    'x'      => 20,
    'y'      => 50,
    'xx'     => 70,
    'yy'     => 100,
    'filled' => 1,
 });

=back
=cut

sub box {
    my $self   = shift;
    my $params = shift;

    my $x      = int($params->{'x'});
    my $y      = int($params->{'y'});
    my $xx     = int($params->{'xx'});
    my $yy     = int($params->{'yy'});
    my $filled = int($params->{'filled'} || 0);
    my $size   = int($params->{'pixel_size'} || 1);
    $size = 1 if ($filled);
    my ($count, $data, $w, $h);

    # This puts $x,$y,$xx,$yy in their correct order if backwards.
    # $x must always be less than $xx
    # $y must always be less than $yy
    if ($x > $xx) {
        ($x, $xx) = ($xx, $x);
    }
    if ($y > $yy) {
        ($y, $yy) = ($yy, $y);
    }
    if ($filled == 1) {
        $w = abs($xx - $x);
        $h = abs($yy - $y);
        $self->blit_write({'x' => $x, 'y' => $y, 'width' => $w, 'height' => $h, 'image' => $self->{'COLOR'} x ($w * $h)});
    } else {
        $self->polygon({'pixel_size' => $size, 'coordinates' => [$x, $y, $xx, $y, $xx, $yy, $x, $yy]});
    }
} ## end sub box

=head2 rbox

Draws a box at point x,y with the width 'width' and height 'height'.
It draws a frame if 'filled' is 0 or a filled box if 'filled' is 1.
'pixel_size' only applies if 'filled' is 0.  Filled boxes draw
faster than frames.

Clipping applies.

=over 1

 $fb->rbox({
    'x'          => 100,
    'y'          => 100,
    'width'      => 200,
    'height'     => 150,
    'filled'     => 0,
    'pixel_size' => 2
 });

=back
=cut

sub rbox {
    my $self   = shift;
    my $params = shift;

    my $x      = int($params->{'x'});
    my $y      = int($params->{'y'});
    my $w      = int($params->{'width'});
    my $h      = int($params->{'height'});
    my $filled = int($params->{'filled'} || 0);
    my $size   = int($params->{'pixel_size'} || 1);
    $size      = 1 if ($filled);
    my $xx     = $x + $w;
    my $yy     = $y + $h;
    $self->box({'x' => $x, 'y' => $y, 'xx' => $xx, 'yy' => $yy, 'filled' => $filled, 'pixel_size' => $size});
} ## end sub rbox

=head2 set_color

Sets the drawing color in red, green, and blue, absolute values.

=over 1

 $fb->set_color({
    'red'   => 255,
    'green' => 255,
    'blue'  => 0
 });

=back
=cut

sub set_color {
    my $self   = shift;
    my $params = shift;

    my $R = int($params->{'red'}) & 255;
    my $G = int($params->{'green'}) & 255;
    my $B = int($params->{'blue'}) & 255;
    if ($self->{'BITS'} == 32) {
        unless($self->{'COLOR_ORDER'}) { # BGR
            $self->{'COLOR'} = chr($B) . chr($G) . chr($R) . chr(255);
        } else { # RGB
            $self->{'COLOR'} = chr($R) . chr($G) . chr($B) . chr(255);
        }
    } else {
        $R = int($R / 8);
        $G = int($G / 8);
        $B = int($B / 8);
        unless($self->{'COLOR_ORDER'}) { # BGR
            $self->{'COLOR'} = ($B << 11) + ($G << 6) + $R;
        } else { # RGB
            $self->{'COLOR'} = ($R << 11) + ($G << 6) + $B;
        }
        $self->{'COLOR'} = pack('S', $self->{'COLOR'});
    }
    $self->{'I_COLOR'} = Imager::Color->new($R, $G, $B);
} ## end sub set_color

=head2 set_b_color

Sets the background color in red, green, and blue values.

=over 1

 $fb->set_b_color({
    'red'   => 0,
    'green' => 0,
    'blue'  => 255
 });

=back
=cut

sub set_b_color {
    my $self   = shift;
    my $params = shift;

    my $R = int($params->{'red'}) & 255;
    my $G = int($params->{'green'}) & 255;
    my $B = int($params->{'blue'}) & 255;
    if ($self->{'BITS'} == 32) {
        unless($self->{'COLOR_ORDER'}) { # BGR
            $self->{'B_COLOR'} = chr($B) . chr($G) . chr($R) . chr(255);
        } else {
            $self->{'B_COLOR'} = chr($R) . chr($G) . chr($B) . chr(255);
        }
    } else {
        $R = int($R / 8);
        $G = int($G / 8);
        $B = int($B / 8);
        $self->{'B_COLOR'} = ($R << 11) + ($G << 6) + $B;
        $self->{'B_COLOR'} = pack('S', $self->{'B_COLOR'});
    }
} ## end sub set_b_color

=head2 set_background_color

Same as set_b_color

=back
=cut

sub set_background_color {
    my $self = shift;
    $self->set_b_color(@_);
}

=head2 pixel

Returns the color of the pixel at coordinate x,y.

=over 1

 my $pixel = $fb->pixel({'x' => 20,'y' => 25});

 # $pixel is a hash reference in the form:
 #
 # {
 #    'red'   => integer value, # 0 - 255
 #    'green' => integer value, # 0 - 255
 #    'blue'  => integer value, # 0 - 255
 #    'raw'   => 32bit value
 # }

=back
=cut

sub pixel {
    my $self   = shift;
    my $params = shift;

    my $x = int($params->{'x'});
    my $y = int($params->{'y'});

    # Values outside of the clipping area return undefined.
    if (($x > $self->{'XX_CLIP'}) || ($y > $self->{'YY_CLIP'}) || ($x < $self->{'X_CLIP'}) || ($y < $self->{'Y_CLIP'})) {
        return (undef,undef,undef,undef);
    } else {
        my ($color, $R, $G, $B, $A);
        my $index = ($self->{'BYTES_PER_LINE'} * ($y + $self->{'YOFFSET'})) + ($x * $self->{'BYTES'});
        $color = substr($self->{'SCREEN'}, $index, $self->{'BYTES'});
        if ($self->{'BITS'} == 32) {
            unless($self->{'COLOR_ORDER'}) { # BGR
                ($B, $G, $R, $A) = unpack('C4', $color);
            } else {
                ($R, $G, $B, $A) = unpack('C4', $color);
            }
        } else {
            $A = unpack('S', $color);
            $color = pack('S', $A);
            unless($self->{'COLOR_ORDER'}) { # BGR
                $B     = $A & 31;
                $G     = ($A >> 6) & 31;
                $R     = ($A >> 11) & 31;
            } else {
                $R     = $A & 31;
                $G     = ($A >> 6) & 31;
                $B     = ($A >> 11) & 31;
            }
            $R     = int($R * 8);
            $G     = int($G * 8);
            $B     = int($B * 8);
        }
        return ({'red' => $R, 'green' => $G, 'blue' => $B, 'raw' => $color});
    } ## end else [ if (($x > $self->{'XX_CLIP'...}))]
} ## end sub pixel

=head2 fill

Does a flood fill starting at point x,y.  It samples the color
at that point and determines that color to be the "background"
color, and proceeds to fill in, with the current global color,
until the "background" color is replaced with the new color.

Clipping applies.

BECAUSE OF ITS RECURSIVE NATURE, IT CAN CHOW DOWN ON MEMORY
LIKE IT IS GOING OUT OF STYLE!  Memory is restored when
complete, but be prepared to see a lot disappear while it is
running!  This is a stack issue.

=over 1

 $fb->fill({'x' => 334, 'y' => 23});

=back

** Perhaps the memory issue could be avoided if somehow the flood fill would
   operate in blocks, instead of recurse until it can find no more to fill.
   My brain hurts thinking about it.

   Maybe just a different fill algorithmn might be better.

=cut

sub fill {
    my $self   = shift;
    my $params = shift;

    my $x = int($params->{'x'});
    my $y = int($params->{'y'});
    my ($BR, $BG, $BB, $back) = $self->pixel({'x' => $x, 'y' => $y});
    $self->_flood({'x' => $x, 'y' => $y, 'background' => $back}) if ($back ne $self->{'COLOR'});
}

sub _flood {
    ##########################################################
    ##                         FLOOD                        ##
    ##########################################################
    # Used by FLOOD FILL above to flood fill an empty space  #
    # It starts at X,Y.  This can be a memory hog due to the #
    # recursive calls it makes.                              #
    ##########################################################
    my $self   = shift;
    my $params = shift;

    my $x    = int($params->{'x'});
    my $y    = int($params->{'y'});
    my $back = $params->{'background'};
    my ($r, $g, $b, $f_color) = $self->pixel({'x' => $x, 'y' => $y});
    if (($x >= $self->{'X_CLIP'}) && ($x <= $self->{'XX_CLIP'}) && ($y >= $self->{'Y_CLIP'}) && ($y <= $self->{'YY_CLIP'}) && ($f_color eq $back)) {
        $self->plot({'x' => $x, 'y' => $y, 'pixel_size' => 1});
        # WEEEE!  Let's chow down on stack memory!!
        $self->_flood({'x' => $x,     'y' => $y + 1, 'background' => $back});
        $self->_flood({'x' => $x,     'y' => $y - 1, 'background' => $back});
        $self->_flood({'x' => $x + 1, 'y' => $y,     'background' => $back});
        $self->_flood({'x' => $x - 1, 'y' => $y,     'background' => $back});
    }
} ## end sub _flood

=head2 replace_color

This replaces one color with another inside the clipping
region.  Sort of like a fill without boundary checking.

=over 1

 $fb->replace_color({
    'old_red'   => 23,
    'old_green' => 48,
    'old_blue'  => 98,
    'new_red'   => 255,
    'new_green' => 255,
    'new_blue'  => 0
 });

=back
=cut

sub replace_color {
    my $self   = shift;
    my $params = shift;

    my $old_r = int($params->{'old_red'});
    my $old_g = int($params->{'old_green'});
    my $old_b = int($params->{'old_blue'});
    my $new_r = int($params->{'new_red'});
    my $new_g = int($params->{'new_green'});
    my $new_b = int($params->{'new_blue'});

    $self->set_color({'red' => $new_r, 'green' => $new_g, 'blue' => $new_b});
    my $old_mode = $self->{'DRAW_MODE'};
    $self->{'DRAW_MODE'} = $self->{'NORMAL_MODE'};

    for (my $y = $self->{'Y_CLIP'}; $y <= $self->{'YY_CLIP'}; $y++) {
        for (my $x = $self->{'X_CLIP'}; $x <= $self->{'XX_CLIP'}; $x++) {
            my $p = $self->pixel({'x' => $x, 'y' => $y, 'pixel_size' => 1});
            my ($r, $g, $b) = ($p->{'red'}, $p->{'green'}, $p->{'blue'});
            if (($r == $old_r) && ($g == $old_g) && ($b == $old_b)) {
                $self->plot({'x' => $x, 'y' => $y, 'pixel_size' => 1});
            }
        }
    }
    $self->{'DRAW_MODE'} = $old_mode;
} ## end sub replace_color

=head2 blit_copy

Copies a square portion of screen graphic data from x,y,w,h
to x_dest,y_dest.  It copies in the current drawing mode.

=over 1

 $fb->blit_copy({
    'x'      => 20,
    'y'      => 20,
    'width'  => 30,
    'height' => 30,
    'x_dest' => 200,
    'y_dest' => 200
 });

=back
=cut

sub blit_copy {
    my $self   = shift;
    my $params = shift;

    my $x  = int($params->{'x'});
    my $y  = int($params->{'y'});
    my $w  = int($params->{'width'});
    my $h  = int($params->{'height'});
    my $xx = int($params->{'x_dest'});
    my $yy = int($params->{'y_dest'});

    $self->blit_write({'x' => $xx, 'y' => $yy, %{$self->blit_read({'x' => $x, 'y' => $y, 'width' => $w, 'height' => $h})}});
}

=head2 blit_read

Reads in a square portion of screen data at x,y,width,height,
and returns a hash pointer with information about the block,
including the raw data as a string.

=over 1

 my $blit_data = $fb->blit_read({
    'x'      => 30,
    'y'      => 50,
    'width'  => 100,
    'height' => 100
 });

=back

Returns:

=over 1

 {
     'x'      => original X position,
     'y'      => original Y position,
     'width'  => width,
     'height' => height,
     'image'  => string of image data for the block
 }

=back
=cut

sub blit_read {
    my $self   = shift;
    my $params = shift;

    my $x = int($params->{'x'});
    my $y = int($params->{'y'});
    my $w = int($params->{'width'});
    my $h = int($params->{'height'});

    $x = 0               if ($x < 0);
    $y = 0               if ($y < 0);
    $w = $self->{'XRES'} if ($w > $self->{'XRES'});
    $h = $self->{'YRES'} if ($h > $self->{'YRES'});

    my $yend = $y + $h;
    my $W    = $w * $self->{'BYTES'};
    my $XX   = $x * $self->{'BYTES'};
    my ($index, $scrn, $line);
    for ($line = $y; $line < $yend; $line++) {
        $index = ($self->{'BYTES_PER_LINE'} * ($line + $self->{'YOFFSET'})) + $XX;
        $scrn .= substr($self->{'SCREEN'}, $index, $W);
    }

    return ({'x' => $x, 'y' => $y, 'width' => $w, 'height' => $h, 'image' => $scrn});
} ## end sub blit_read

=head2 blit_write

Writes a previously read block of screen data at x,y,width,height.

It takes a hash reference.  It draws in the current drawing mode.

=over 1

 $fb->blit_write({
    'x'      => 0,
    'y'      => 0,
    'width'  => 100,
    'height' => 100,
    'image'  => $blit_data
 });

=back
=cut

sub blit_write {
    my $self   = shift;
    my $params = shift;

    my $x    = int($params->{'x'});
    my $y    = int($params->{'y'});
    my $w    = int($params->{'width'}) || 1;
    my $h    = int($params->{'height'}) || 1;
    my $scrn = $params->{'image'};

    $w = $self->{'XRES'}         if ($w > $self->{'XRES'});
    $h = $self->{'YRES'}         if ($h > $self->{'YRES'});
    $w = $self->{'XX_CLIP'} - $x if (($x + $w) > $self->{'XX_CLIP'});
    my $scan = $w * $self->{'BYTES'};

    my $yend = $y + $h;
    if ($yend > $self->{'YY_CLIP'}) {
        $yend = $self->{'YY_CLIP'};
    } elsif ($yend < $self->{'Y_CLIP'}) {
        $yend = $self->{'Y_CLIP'};
    }
    my $WW = int((length($scrn) || 1) / $h);
    my $X_X = ($x + $self->{'XOFFSET'}) * $self->{'BYTES'};
    my ($index, $data, $px, $line, $idx, $px4);

    if (   ($x >= $self->{'X_CLIP'})
        && ($x <= $self->{'XX_CLIP'})
        && ($y >= $self->{'Y_CLIP'})
        && ($y <= $self->{'YY_CLIP'})) {
        if ($x < 0) {
            $w += $x;
            $x = 0;
        }
        if ($y < 0) {
            $scrn = substr($scrn, (abs($y) * $WW));
            $yend += $y;
            $y = 0;
        }
        $idx = 0;
        $y    += $self->{'YOFFSET'};
        $yend += $self->{'YOFFSET'};
        for ($line = $y; $line < $yend; $line++) {
            $index = ($self->{'BYTES_PER_LINE'} * $line) + $X_X;
            switch ($self->{'DRAW_MODE'}) {
                case ($self->{'NORMAL_MODE'}) {
                    substr($self->{'SCREEN'}, $index, $scan) = substr($scrn, $idx, $scan);
                }
                case ($self->{'XOR_MODE'}) {
                    substr($self->{'SCREEN'}, $index, $scan) ^= substr($scrn, $idx, $scan);
                }
                case ($self->{'OR_MODE'}) {
                    substr($self->{'SCREEN'}, $index, $scan) |= substr($scrn, $idx, $scan);
                }
                case ($self->{'AND_MODE'}) {
                    substr($self->{'SCREEN'}, $index, $scan) &= substr($scrn, $idx, $scan);
                }
                case ($self->{'MASK_MODE'}) {
                    for ($px = 0; $px < $w; $px++) {
                        if ($px <= $self->{'XX_CLIP'} && $px >= $self->{'X_CLIP'}) {
                            $px4 = $px * $self->{'BYTES'};
                            $data = substr($self->{'SCREEN'}, ($index + $px4), $self->{'BYTES'});
                            if ($self->{'BITS'} == 32) {
                                if (substr($scrn, ($idx + $px4), 3) . chr(255) ne $self->{'B_COLOR'}) {
                                    substr($self->{'SCREEN'}, ($index + $px4), $self->{'BYTES'}) = substr($scrn, ($idx + $px4), $self->{'BYTES'});
                                }
                            } else {
                                if (substr($scrn, ($idx + $px4), 2) ne $self->{'B_COLOR'}) {
                                    substr($self->{'SCREEN'}, ($index + $px4), $self->{'BYTES'}) = substr($scrn, ($idx + $px4), $self->{'BYTES'});
                                }
                            }
                        }
                    } ## end for ($px = 0; $px < $w;...)
                } ## end case ($self->{'MASK_MODE'...})
                case ($self->{'UNMASK_MODE'}) {
                    for ($px = 0; $px < $w; $px++) {
                        if ($px <= $self->{'XX_CLIP'} && $px >= $self->{'X_CLIP'}) {
                            $px4 = $px * $self->{'BYTES'};
                            $data = substr($self->{'SCREEN'}, ($index + $px4), $self->{'BYTES'});
                            if ($self->{'BITS'} == 32) {
                                if (substr($self->{'SCREEN'}, ($index + $px4), 3) . chr(255) eq $self->{'B_COLOR'}) {
                                    substr($self->{'SCREEN'}, ($index + $px4), $self->{'BYTES'}) = substr($scrn, ($idx + $px4), $self->{'BYTES'});
                                }
                            } else {
                                if (substr($self->{'SCREEN'}, ($index + $px4), 2) eq $self->{'B_COLOR'}) {
                                    substr($self->{'SCREEN'}, ($index + $px4), $self->{'BYTES'}) = substr($scrn, ($idx + $px4), $self->{'BYTES'});
                                }
                            }
                        }
                    } ## end for ($px = 0; $px < $w;...)
                } ## end case ($self->{'UNMASK_MODE'...})
            } ## end switch
            $idx += $WW;
        } ## end for ($line = $y; $line ...)
    } ## end if (($x >= $self->{'X_CLIP'...}))
} ## end sub blit_write

=head2 clip_reset

Turns off clipping, and resets the clipping values to the full
size of the screen.

=over 1

 $fb->clip_reset();

=back
=cut

sub clip_reset {
    my $self = shift;

    $self->{'X_CLIP'}  = 0;
    $self->{'Y_CLIP'}  = 0;
    $self->{'XX_CLIP'} = ($self->{'XRES'} - 1);
    $self->{'YY_CLIP'} = ($self->{'YRES'} - 1);
    $self->{'CLIPPED'} = 0;
}

=head2 clip_set

Sets the clipping rectangle starting at the top left point x,y
and ending at bottom right point xx,yy.

=over 1

 $fb->clip_set({
    'x' => 10,
    'y' => 10,
    'xx' => 300,
    'yy' => 300
 });

=back
=cut

sub clip_set {
    my $self   = shift;
    my $params = shift;

    $self->{'X_CLIP'}  = int($params->{'x'});
    $self->{'Y_CLIP'}  = int($params->{'y'});
    $self->{'XX_CLIP'} = int($params->{'xx'});
    $self->{'YY_CLIP'} = int($params->{'yy'});

    $self->{'X_CLIP'}  = 0                     if ($self->{'X_CLIP'} < 0);
    $self->{'Y_CLIP'}  = 0                     if ($self->{'Y_CLIP'} < 0);
    $self->{'XX_CLIP'} = ($self->{'XRES'} - 1) if ($self->{'XX_CLIP'} >= $self->{'XRES'});
    $self->{'YY_CLIP'} = ($self->{'YRES'} - 1) if ($self->{'YY_CLIP'} >= $self->{'YRES'});
    $self->{'CLIPPED'} = 1;
} ## end sub clip_set

=head2 clip_rset

Sets the clipping rectangle to point x,y,width,height

=over 1

 $fb->clip_rset({
    'x'      => 10,
    'y'      => 10,
    'width'  => 600,
    'height' => 400
 });

=back
=cut

sub clip_rset {
    my $self   = shift;
    my $params = shift;
    my $x      = int($params->{'x'});
    my $y      = int($params->{'y'});
    my $w      = int($params->{'width'});
    my $h      = int($params->{'height'});

    $self->clip_set({'x' => $x, 'y' => $y, 'xx' => ($x + $w), 'yy' => ($y + $h)});
}

=head2 ttf_print

Prints TrueType text on the screen at point x,y in the rectangle width,height,
using the color 'color', and the face 'face'.

This is best called twice, first in bounding box mode, and then in normal mode.

Bounding box mode gets the actual values needed to display the text.

=over 1

 my $bounding_box = $fb->ttf_print({
     'x'            => 20,
     'y'            => 100,
     'height'       => 16,
     'color'        => 'FFFF00', # Yellow
     'text'         => 'Hello World!',
     'face'         => 'Arial',
     'bounding_box' => 1,
     'center'       => 0
 });

 $fb->ttf_print($bounding_box);

=back
=cut

sub ttf_print {
    # Yes, this is a "hack".                                                     #

    # This uses the 'Imager' package.  It allocates a temporary screen buffer    #
    # and prints to it, then this buffer is dumped to the screen at the x,y      #
    # coordinates given.  Since no decent True Type packages or libraries are    #
    # available for Perl, this turned out to be the best and easiest solution.   #
    #                                                                            #
    # Will return the bounding box dimensions instead of printing if $box_mode=1 #
    ##############################################################################
    my $self   = shift;
    my $params = shift;

    my $TTF_x       = int($params->{'x'});
    my $TTF_y       = int($params->{'y'});
    my $TTF_w       = int($params->{'width'})  || 1;
    my $TTF_h       = int($params->{'height'}) || 1;
    my $P_color     = $params->{'color'};
    my $text        = $params->{'text'};
    my $face        = $params->{'face'};
    my $box_mode    = int($params->{'bounding_box'} || 0);
    my $center_mode = int($params->{'center'} || 0);
    my $font_path   = $params->{'font_path'};

    my ($data, $font, $neg_width, $global_descent, $pos_width, $global_ascent, $descent, $ascent, $advance_width, $right_bearing);
    $P_color = substr($P_color, 4, 2) . substr($P_color, 2, 2) . substr($P_color, 0, 2);    # T$        $P_color = Imager::Color->new("#$P_color");

    eval {
        $font = Imager::Font->new(
            'file'  => "$font_path/$face",
            'color' => $P_color,
            'size'  => $TTF_h
        );

        ($neg_width, $global_descent, $pos_width, $global_ascent, $descent, $ascent, $advance_width, $right_bearing) = $font->bounding_box('string' => $text, 'canon' => 1, 'size' => $TTF_h);
        if ($box_mode) {
            return (
                {
                    'x'            => $params->{'x'},
                    'y'            => $params->{'y'},
                    'width'        => $advance_width,
                    'height'       => ($global_ascent - $global_descent),
                    'color'        => $params->{'color'},
                    'text'         => $params->{'text'},
                    'bounding_box' => 0,
                    'face'         => $params->{'face'},
                    'center'       => $params->{'center'}
                }
            );
        } elsif ($center_mode) {
            $TTF_x = int(($self->{'XRES'} - $advance_width) / 2);
            $TTF_y = int((($self->{'YRES'} - $global_ascent) / 2) + $global_ascent);
        }
        $TTF_w = $advance_width;
        my $img = Imager->new(
            'xsize'    => $advance_width,                                   # $TTF_w,
            'ysize'    => (($TTF_h + $global_ascent) - $global_descent),    # * 2),
            'channels' => $self->{'BYTES'}
        );

        $img->string(
            'font'  => $font,
            'text'  => $text,
            'x'     => 0,
            'y'     => ($TTF_h - 1),
            'size'  => $TTF_h,
            'color' => $P_color,
            'aa'    => 1
        );

        $img->write(
            'type'          => 'raw',
            'storechannels' => $self->{'BYTES'},
            'interleave'    => 0,
            'data'          => \$data
        );
        $self->blit_write({'x' => $TTF_x, 'y' => (($TTF_y - $TTF_h) + 1), 'width' => $TTF_w, 'height' => (($TTF_h + $global_ascent) - $global_descent), 'image' => $data});
    };
    print STDERR $@ if ($@);
    return (
        {
            'x'            => $TTF_x,
            'y'            => $TTF_y - $TTF_h,
            'width'        => $TTF_w,
            'height'       => ($TTF_h + $global_ascent) - $global_descent
        }
    );
} ## end sub ttf_print

=head2 get_face_name

Returns the TrueType face name based on the parameters passed.
It uses the exact same parameters as the ttf_print method.
=cut

sub get_face_name {
    my $self   = shift;
    my $params = shift;

    my $face      = Imager::Font->new(%{$params});
    my $face_name = eval($face->face_name());
    return ($face_name);
}

=head2 load_image

Loads an image at point x,y[,width,height]

If 'width' and/or 'height' is given, the image is resized
=cut

sub load_image {
    my $self   = shift;
    my $params = shift;

    my $img = Imager->new('channels' => 3);
    return () unless ($img->read('file' => $params->{'file'}, 'allow_incomplete' => 0));
    my $orientation = $img->tags('name' => 'exif_orientation');
    if (defined($orientation) && $orientation) {
        switch ($orientation) {
            case (3) {    # 180
                $img = $img->rotate('degrees' => 180);
            }
            case (6) {    # -90
                $img = $img->rotate('degrees' => 90);
            }
            case (8) {    # 90
                $img = $img->rotate('degrees' => -90);
            }
        }
    }
    if ($params->{'adjust'}) {
        $img = $img->convert('matrix' => [[0, 0, 1], [0, 1, 0], [1, 0, 0]]);
    }

    $img = $img->convert('preset' => 'addalpha');

    $img->filter('type' => 'autolevels') if ($params->{'autolevels'});

    my ($xs, $ys, $w, $h, %scale);
    $w = int($img->getwidth());
    $h = int($img->getheight());
    if ((defined($params->{'width'}) && $params->{'width'} <=> $w) || (defined($params->{'height'}) && $params->{'height'} <=> $h)) {
        $scale{'xpixels'} = $params->{'width'}  if (defined($params->{'width'}));
        $scale{'ypixels'} = $params->{'height'} if (defined($params->{'height'}));
        $scale{'type'}    = 'min';
        ($xs, $ys, $w, $h) = $img->scale_calculate(%scale);
        $w = int($w);
        $h = int($h);

        $img = $img->scale(%scale);
    }
    $w = int($img->getwidth());
    $h = int($img->getheight());
    my $data = '';
    $img->write(
        'type'          => 'raw',
        'interleave'    => 0,
        'datachannels'  => 4,
        'storechannels' => 4,
        'data'          => \$data
    );

    my ($x, $y);
    if (defined($params->{'x'}) && defined($params->{'y'})) {
        $x = $params->{'x'};
        $y = $params->{'y'};
    } else {
        if ($w < $self->{'XRES'}) {
            $x = ($self->{'XRES'} - $w) / 2;
            $y = 0;
        } elsif ($h < $self->{'YRES'}) {
            $x = 0;
            $y = ($self->{'YRES'} - $h) / 2;
        } else {
            $x = 0;
            $y = 0;
        }
    }
    $x = int($x);
    $y = int($y);

    return (
        {
            'x'           => $x,
            'y'           => $y,
            'width'       => $w,
            'height'      => $h,
            'image'       => $data,
            'orientation' => $orientation
        }
    );
} ## end sub load_image

=head2 screen_dump

Dumps the screen to a file given in 'file'.  This is a RAW dump.
=cut

sub screen_dump {
    ##############################################################################
    ##                            Dump Screen To File                           ##
    ##############################################################################
    # Dumps the screen to a file as a raw file                                   #
    ##############################################################################
    my $self   = shift;
    my $params = shift;

    my $filename = $params->{'file'};

    my ($w, $h, $dump) = $self->blit_read({'x' => 0, 'y' => 0, 'width' => $self->{'XRES'}, 'height' => $self->{'YRES'}});
    open(my $DUMP, '>', $filename);
    print $DUMP $dump;
    close($DUMP);
} ## end sub screen_dump

=head2 RGB_to_16

Converts 24 bit color values to 16 bit color values.
=cut

sub RGB_to_16 {
    ##############################################################################
    ##                               RGB to 16 Bit                              ##
    ##############################################################################
    # Converts a 24 bit pixel value to a 16 bit pixel value.                     #
    # -------------------------------------------------------------------------- #
    # This is not a fancy table based color conversion.  This merely uses math,  #
    # and thus the quality is lacking on the output.                             #
    ##############################################################################

    my $self   = shift;
    my $params = shift;

    my $big_data = $params->{'color'};

    my $n_data;
    while ($big_data ne '') {
        my $pixel_data = substr($big_data, 0, 3);
        $big_data = substr($big_data, 3) . chr(255);
        my ($b, $g, $r, $a) = unpack('I', $pixel_data);
        $r = int($r / 8);
        $g = int($g / 8);
        $b = int($b / 8);
        my $color = ($r << 11) + ($g << 6) + $b;
        $n_data .= pack('S', $color);
    }
    return ({'color' => $n_data});
} ## end sub RGB_to_16

=head2 RGBA_to_16

Converts 32 bit color values to 16 bit
=cut

sub RGBA_to_16 {
    ##############################################################################
    ##                              RGBA to 16 Bit                              ##
    ##############################################################################
    # Converts a 32 bit pixel value to a 16 bit pixel value.                     #
    # -------------------------------------------------------------------------- #
    # This is not a fancy table based color conversion.  This merely uses math,  #
    # and thus the quality is lacking on the output.  This discards the alpha    #
    # channel.                                                                   #
    ##############################################################################
    my $self   = shift;
    my $params = shift;

    my $big_data = $params->{'color'};

    my $n_data;
    while ($big_data ne '') {
        my $pixel_data = substr($big_data, 0, 4);
        $big_data = substr($big_data, 4);
        my ($b, $g, $r, $a) = unpack('I', $pixel_data);
        $r = int($r / 8);
        $g = int($g / 8);
        $b = int($b / 8);
        my $color = ($r << 11) + ($g << 6) + $b;
        $n_data .= pack('S', $color);
    }
    return ({'color' => $n_data});
} ## end sub RGBA_to_16

=head2 RGB_to_RGBA

Converts 24 bit color to 32 bit color
=cut

sub RGB_to_RGBA {
    my $self   = shift;
    my $params = shift;

    my $big_data = $params->{'color'};
    my $bsize    = length($big_data);
    my $n_data   = chr(255) x (($bsize / 3) * 4);
    my $index    = 0;
    for (my $count = 0; $count < $bsize; $count += 3) {
        substr($n_data, $index, 3) = substr($big_data, $count + 2, 1) . substr($big_data, $count + 1, 1) . substr($big_data, $count, 1);
        $index += 4;
    }
    return ({'color' => $n_data});
}

## Not objects nor methods, just standard flat subroutines

sub _get_info {
    ##########################################################
    ##                    GET IOCTL INFO                    ##
    ##########################################################
    # Used to return an array specific to the ioctl function #
    ##########################################################
    my $command = shift;
    my $format  = shift;
    my $fb      = shift;
    my $data    = '';
    my @array;
    ioctl($fb, $command, $data);
    @array = unpack($format, $data);
    return (@array);
} ## end sub _get_info

sub _set_info {
    ##########################################################
    ##                    SET IOCTL INFO                    ##
    ##########################################################
    # Used to call or set ioctl specific functions           #
    ##########################################################
    my $command = shift;
    my $format  = shift;
    my $fb      = shift;
    my @array   = @_;
    my $data    = pack($format, @array);
    ioctl($fb, $command, $data);
}

1;

__END__

=head1 USAGE HINTS

=head2 THREADS

The module can NOT have separate threads calling the same object.
You WILL crash. However, you can instantiate an object for each
thread and it will work just fine!

See the "examples" directory for "frtest.pl" as an example of a
threading script that uses this module.  Just add the number of
threads you want it to use to the command line when you run it.

=head2 BLITTING

Use blit_read and blit_write to save portions of the screen
instead of redrawing everything.  It will speed up response
tremendously.

=head2 HORIZONTAL "MAGIC"

Horizontal lines and filled boxes draw very fast.  Learn to
exploit them.

Filled boxes draw faster than thick horizontal lines.  See
where I'm going?

=head2 PIXEL SIZE

Pixel sizes over 1 utilize a filled "circle" to do the drawing.
This is why the larger the "pixel", the slower the draw.  Maybe
for speed sake, a loop of lines drawn at single pixel size, but
offset to make a "wide" line, will draw faster for you.  If making
a game, or user interface, you may want to consider this technique.

=head1 AUTHOR

Richard Kelsch <rich@rk-internet.com>

=head1 COPYRIGHT

Copyright 2013-2015 Richard Kelsch, All Rights Reserved.

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

=head1 VERSION

Version 4.11 (July 3, 2015)

=head1 THANKS

My thanks go out to those using this module and submitting helpful patches
and suggestions for improvement:

Troy Beisigl
Markus Maier

=cut
