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({'coordinates' => [20,20,  53,3,  233,620], 'pixel_size' => 5});
 $fb->box({'x' => 95, 'y' => 100, 'xx' => 400, 'yy' => 600, 'filled' => 1});

=head1 DESCRIPTION

A (mostly) Pure Perl graphics library for exclusive use in a Unix 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 images,, save images,
and draw TrueType/Type1 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, Odroid XU3/XU4,
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 (with output to see).  Also, it is not going to
work from within X-Windows, so don't even try it, it will either crash X, or
make a mess on the screen.  This is a console only graphics library.

I highly suggest you use 32 bit mode and avoid 16 bit, as the routines are
optimized for 32 bit.  16 bit mode requires many conversions and bit shifting
to achieve its goal.  Drawing basic primitives will be just as fast.  However,
blitting, true type text, and image loading WILL be slower in 16 bit modes.

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.  Nevertheless, I have
learned that people use emulation mode as an offscreen drawing surface, and
blit from one to the other.  Which is pretty clever.

Make sure you have read/write access to the framebuffer device.  Usually this
just means adding your account to the "video" group.  Alternately, you can
just run your script as root.  Although I don't recommend it.

=head1 INSTALLATION

Before you install this, please note it requires the Perl module "Imager".  If
you are installing via CPAN, then please first make sure your system has the
appropriate JPEG, GIF, TIFF, Freetype, and Type1 development libraries
installed first.  If you don't, then Imager will just be compiled without
support for those kinds of files, which pretty much makes it useless.

If you are using a Debian based system (Ubuntu, Weezy, Mint, etc.) then run
the following command (and answer yes to the prompt) before doing anything
else:

=over 4

sudo apt-get install libjpeg-dev libgif-dev libtiff5-dev libfreetype6-dev fbset

=back

* Those with RedHat based systems, use Yum in place of apt-get.

After you have done this, Then install Imager and the rest of the needed
modules.

When you install this module, please do it within a console, not a console
window in X-Windows, but the actual Linux console outside of X-Windows.

If you are in X-Windows and don't know how to get to a console, then just
hit CTRL-ALT-F1 and it should show you a console.  ALT-F7 or ALT-F8 will
get you back to X-Windows.

If you are using CPAN, then installation is simple, but if you are installing
manually, then the typical steps apply:

=over 4

 perl Build.pl
 ./Build
 clear && ./Build test
 ./Build install

 or...

 perl Makefile.PL
 make
 clear && make test
 make install

=back

Please note, that the install step my require root permissions (run it with
sudo).

If testing fails, it will usually be ok to install it anyway, as it will
likely work.  The testing is flakey (thank Perl's test mode for that).

I recommend running the scripts inside of the "examples" directory for real
testing instead.  In fact, the script "mmapvsfile.pl" will tell which mode
you be running this module in for the fastest speed.

=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.
no warnings;

use constant {
    TRUE  => 1,
    FALSE => 0
};

# require 'sys/ioctl.ph';exit;
use Config;

# use Math::Round qw(round);
use Math::Trig;    ## qw(:pi tan atan2 ); # Yes, yummy PI
use Math::Bezier;
use Math::Gradient qw( gradient array_gradient );
use List::Util qw(min max);
use Sys::Mmap;     ## Absolutely necessary to map the screen to a string.

use Imager;        ## This is used for TrueType font printing, image loading,
                   ## and where 'Pure Perl' goes up in smoke.

## These are for debugging, and should normally be commented out.
# use Time::HiRes qw(sleep);
# use Data::Dumper::Simple;$Data::Dumper::Sortkeys=1;

BEGIN {
    require Exporter;

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

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

=head1 METHODS

=head2 B<new>

This instantiates the framebuffer object

=over 2

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

=back

=head3 PARAMETERS

=over 4

=item C<FB_DEVICE> [/dev/fb0]

Framebuffer device name.  If this is not defined, then it
tries the following devices in the following order:

      *  /dev/fb0
      *  /dev/graphics/fb0
      *  /dev/fb1
      *  /dev/graphics/fb1

If none of these work, then the module goes into
emulation mode.

=item C<FILE_MODE> [1 or 0]

 Sets the internal drawing system to use file handle mode
 instead of memory mapped mode.  File mode is more stable,
 but a bit slower.  I recommend doing this ONLY if you
 are having issues with memory mapped mode.

 Note:  On TFT modules with a SPI interface, FILE_MODE may
        actually be much faster.  This is the only exception
        to the above that I have found.

=item C<FOREGROUND>

Sets the default foreground color for when 'attribute_reset'
is called.  It is in the same format as "set_color"
expects:

 { # This is the default value
   'red'   => 255,
   'green' => 255,
   'blue'  => 255,
   'alpha' => 255
 }

=item C<BACKGROUN>

Sets the default background color for when 'attribute_reset'
is called.  It is in the same format as "set_b_color"
expects:

 { # This is the default value
   'red'   => 0,
   'green' => 0,
   'blue'  => 0,
   'alpha' => 0
 }

=item C<SPLASH>

The splash screen is or is not displayed

A true value turns it on (default)
A false value turns it off

=item C<FONT_PATH>

Overrides the default font path for TrueType/Type1 fonts

If 'ttf_print' is not displaying any text, then this may need
to be overridden.

=item C<FONT_FACE>

Overrides the default font filename for TrueType/Type 1 fonts.

If 'ttf_print' is not displaying any text, then this may need
to be overridden.

=item C<SHOW_ERRORS>

Normally this module is completely silent and does not display
errors or warnings (to the best of its ability).  This is to
prevent corruption of the graphics.  However, you can enable
error reporting by setting this to 1.

This is helpful for troubleshooting.

=back

=head3 EMULATION MODE OPTIONS

The options here only apply to emulation mode.

Emulation mode can be used as a secondary off-screen drawing
surface, if you are clever.

=over 4

=item C<VXRES>

 Width of the emulation framebuffer in pixels.  Default is 640.

=item C<VYRES>

 Height of the emulation framebuffer in pixels.  Default is 480.

=item C<BITS>

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

=item C<BYTES>

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

=item C<COLOR_ORDER>

 Defines the colorspace for the graphics routines to draw in.
 The possible (and only accepted) values are:

   'RGB'  for Red-Green-Blue (the default)
   'RBG'  for Red-Blue-Green
   'GRB'  for Green-Red-Blue
   'GBR'  for Green-Blue-Red
   'BRG'  for Blue-Red-Green
   'BGR'  for Blue-Green-Red

=back

=cut

sub new {
    my $class = shift;

    my $self = {
        'SCREEN' => '',    # The all mighty framebuffer

        # Set up the user defined graphics primitives and attributes default values
        'Imager-Has-TrueType'  => $Imager::formats{'tt'}  || 0,
        'Imager-Has-Type1'     => $Imager::formats{'t1'}  || 0,
        'Imager-Has-Freetype2' => $Imager::formats{'ft2'} || 0,

        '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,
        'UNMASK_MODE'  => 5,
        'CLIPPED'      => FALSE,
        'ARC'          => 0,
        'PIE'          => 1,
        'POLY_ARC'     => 2,
        'FILE_MODE'    => FALSE,
        'SHOW_ERRORS'  => FALSE,
        'LINE_PADDING' => undef,
        'FOREGROUND'   => {
            'red'   => 255,
            'green' => 255,
            'blue'  => 255,
            'alpha' => 255
        },
        'BACKGROUND' => {
            'red'   => 0,
            'green' => 0,
            'blue'  => 0,
            'alpha' => 255
        },
        'FONT_PATH'   => '/usr/share/fonts/truetype/freefont',
        'FONT_FACE'   => 'FreeSans.ttf',
        'SPLASH'      => TRUE,
        'RGB'         => 0,
        'RBG'         => 1,
        'BGR'         => 2,
        'BRG'         => 3,
        'GBR'         => 4,
        'GRB'         => 5,
        'CENTER_NONE' => 0,
        'CENTER_X'    => 1,
        'CENTER_Y'    => 2,
        'CENTER_XY'   => 3,

        ## Set up the Framebuffer driver "constants" defaults
        # Commands
        'FBIOGET_VSCREENINFO' => 0x4600,
        'FBIOPUT_VSCREENINFO' => 0x4601,
        'FBIOGET_FSCREENINFO' => 0x4602,
        'FBIOGETCMAP'         => 0x4604,
        'FBIOPUTCMAP'         => 0x4605,
        'FBIOPAN_DISPLAY'     => 0x4606,
        'FBIO_CURSOR'         => 0x4608,
        'FBIOGET_CON2FBMAP'   => 0x460F,
        'FBIOPUT_CON2FBMAP'   => 0x4610,
        'FBIOBLANK'           => 0x4611,
        'FBIOGET_VBLANK'      => 0x4612,
        'FBIOGET_GLYPH'       => 0x4615,
        'FBIOGET_HWCINFO'     => 0x4616,
        'FBIOPUT_MODEINFO'    => 0x4617,
        'FBIOGET_DISPINFO'    => 0x4618,
        'FBIO_WAITFORVSYNC'   => 0x4620,

        # FLAGS
        'FBINFO_HWACCEL_NONE'      => 0x0000,
        'FBINFO_HWACCEL_COPYAREA'  => 0x0100,
        'FBINFO_HWACCEL_FILLRECT'  => 0x0200,
        'FBINFO_HWACCEL_IMAGEBLIT' => 0x0400,
        'FBINFO_HWACCEL_ROTATE'    => 0x0800,
        'FBINFO_HWACCEL_XPAN'      => 0x1000,
        'FBINFO_HWACCEL_YPAN'      => 0x2000,
        'FBINFO_HWACCEL_YWRAP'     => 0x4000,

        # I=32.64,L=32,S=16,C=8,A=string
        # Structure Definitions

        'FBioget_vscreeninfo' => 'L' .  # 32 bits for xres
        'L' .                           # 32 bits for yres
        'L' .                           # 32 bits for xres_virtual
        'L' .                           # 32 bits for yres_vortual
        'L' .                           # 32 bits for xoffset
        'L' .                           # 32 bits for yoffset
        'L' .                           # 32 bits for bits per pixel
        'L' .                           # 32 bits for grayscale (0=color)
        'L' .                           # 32 bits for red bit offset
        'L' .                           # 32 bits for red bit length
        'L' .                           # 32 bits for red msb_right (!0 msb is right)
        'L' .                           # 32 bits for green bit offset
        'L' .                           # 32 bits for green bit length
        'L' .                           # 32 bits for green msb_right (!0 msb is right)
        'L' .                           # 32 bits for blue bit offset
        'L' .                           # 32 bits for blue bit length
        'L' .                           # 32 bits for blue msb_right (!0 msb is right)
        'L' .                           # 32 bits for alpha bit offset
        'L' .                           # 32 bits for alpha bit length
        'L' .                           # 32 bits for alpha msb_right (!0 msb is right)
        'L' .                           # 32 bits for nonstd (!0 non standard pixel format)
        'L' .                           # 32 bits for activate
        'L' .                           # 32 bits for height in mm
        'L' .                           # 32 bits for width in mm
        'L' .                           # 32 bits for accel_flags (obsolete)
        'L' .                           # 32 bits for pixclock
        'L' .                           # 32 bits for left margin
        'L' .                           # 32 bits for right margin
        'L' .                           # 32 bits for upper margin
        'L' .                           # 32 bits for lower margin
        'L' .                           # 32 bits for hsync length
        'L' .                           # 32 bits for vsync length
        'L' .                           # 32 bits for sync
        'L' .                           # 32 bits for vmode
        'L' .                           # 32 bits for rotate (angle we rotate counter clockwise)
        'L' .                           # 32 bits for colorspace
        'L4',                           # 32 bits x 4 reserved

        'FBioget_fscreeninfo' => 'A16' .  # 16 bytes for ID name
        'L' .                           # 32/64 bits unsigned address
        'L' .                           # 32 bits for smem_len
        'L' .                           # 32 bits for type
        'L' .                           # 32 bits for type_aux (interleave)
        'L' .                           # 32 bits for visual
        'S' .                           # 16 bits for xpanstep
        'S' .                           # 16 bits for ypanstep
        'S1' .                           # 16 bits for ywrapstep (extra 16 bits added on if system is 8 byte aligned)
        'L' .                           # 32 bits for line length in bytes
        'L' .                           # 32/64 bits for mmio_start
        'L' .                           # 32 bits for mmio_len
        'L' .                           # 32 bits for accel
        'S' .                           # 16 bits for capabilities
        'S2',                           # 16 bits x 2 reserved

        'FBinfo_hwaccel_fillrect'  => 'L6',      # dx(32),dy(32),width(32),height(32),color(32),rop(32)?
        'FBinfo_hwaccel_copyarea'  => 'L6',      # dx(32),dy(32),width(32),height(32),sx(32),sy(32)
        'FBinfo_hwaccel_fillrect'  => 'L6',      # dx(32),dy(32),width(32),height(32),color(32),rop(32)
        'FBinfo_hwaccel_imageblit' => 'L6CL',    # 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'   => undef,
        'COLOR_ORDER' => 'RGB',
        'ACCELERATED' => 0,
        @_
    };

    unless (defined($self->{'FB_DEVICE'})) {
        foreach my $dev (qw(/dev/fb0 /dev/graphics/fb0 /dev/fb1 /dev/graphics/fb1)) {
            if (-e $dev) {
                $self->{'FB_DEVICE'} = $dev;
                last;
            }
        } ## end foreach my $dev (qw(/dev/fb0 /dev/graphics/fb0 /dev/fb1 /dev/graphics/fb1))
    } ## end unless (defined($self->{'FB_DEVICE'...}))
    if (!defined($ENV{'DISPLAY'}) && defined($self->{'FB_DEVICE'}) && 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
        $| = 1;

        # Make the IOCTL call to get info on the virtual (viewable) screen (Sometimes different than physical)
        (
            $self->{'vscreeninfo'}->{'xres'},                                                                               # (32)
            $self->{'vscreeninfo'}->{'yres'},                                                                               # (32)
            $self->{'vscreeninfo'}->{'xres_virtual'},                                                                       # (32)
            $self->{'vscreeninfo'}->{'yres_virtual'},                                                                       # (32)
            $self->{'vscreeninfo'}->{'xoffset'},                                                                            # (32)
            $self->{'vscreeninfo'}->{'yoffset'},                                                                            # (32)
            $self->{'vscreeninfo'}->{'bits_per_pixel'},                                                                     # (32)
            $self->{'vscreeninfo'}->{'grayscale'},                                                                          # (32)
            $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'},                                                     # (32)
            $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'},                                                     # (32)
            $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'msb_right'},                                                  # (32)
            $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'},                                                   # (32)
            $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'},                                                   # (32)
            $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'msb_right'},                                                # (32)
            $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'},                                                    # (32)
            $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'},                                                    # (32)
            $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'msb_right'},                                                 # (32)
            $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'},                                                   # (32)
            $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'length'},                                                   # (32)
            $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'msb_right'},                                                # (32)
            $self->{'vscreeninfo'}->{'nonstd'},                                                                             # (32)
            $self->{'vscreeninfo'}->{'activate'},                                                                           # (32)
            $self->{'vscreeninfo'}->{'height'},                                                                             # (32)
            $self->{'vscreeninfo'}->{'width'},                                                                              # (32)
            $self->{'vscreeninfo'}->{'accel_flags'},                                                                        # (32)
            $self->{'vscreeninfo'}->{'pixclock'},                                                                           # (32)
            $self->{'vscreeninfo'}->{'left_margin'},                                                                        # (32)
            $self->{'vscreeninfo'}->{'right_margin'},                                                                       # (32)
            $self->{'vscreeninfo'}->{'upper_margin'},                                                                       # (32)
            $self->{'vscreeninfo'}->{'lower_margin'},                                                                       # (32)
            $self->{'vscreeninfo'}->{'hsync_len'},                                                                          # (32)
            $self->{'vscreeninfo'}->{'vsync_len'},                                                                          # (32)
            $self->{'vscreeninfo'}->{'sync'},                                                                               # (32)
            $self->{'vscreeninfo'}->{'vmode'},                                                                              # (32)
            $self->{'vscreeninfo'}->{'rotate'},                                                                             # (32)
            $self->{'vscreeninfo'}->{'colorspace'},                                                                         # (32)
            @{$self->{'vscreeninfo'}->{'reserved_fb_vir'}}                                                                  # (32) x 4
        ) = _get_ioctl($self->{'FBIOGET_VSCREENINFO'}, $self->{'FBioget_vscreeninfo'}, $self->{'FB'});

        # MAke the IOCTL call to get info on the physical screen
        my $extra = 0;
        do { # A hacked way to do this, but it seems to work
            my $typedef = $self->{'FBioget_fscreeninfo'};
            if ($extra) {                                                                                   # It turns out it was byte alignment issues, not driver weirdness
                $typedef =~ s/S1/SA$extra/;
                (
                    $self->{'fscreeninfo'}->{'id'},                                                                             # (8) x 16
                    $self->{'fscreeninfo'}->{'smem_start'},                                                                     # LONG
                    $self->{'fscreeninfo'}->{'smem_len'},                                                                       # (32)
                    $self->{'fscreeninfo'}->{'type'},                                                                           # (32)
                    $self->{'fscreeninfo'}->{'type_aux'},                                                                       # (32)
                    $self->{'fscreeninfo'}->{'visual'},                                                                         # (32)
                    $self->{'fscreeninfo'}->{'xpanstep'},                                                                       # (16)
                    $self->{'fscreeninfo'}->{'ypanstep'},                                                                       # (16)
                    $self->{'fscreeninfo'}->{'ywrapstep'},                                                                      # (16)
                    $self->{'fscreeninfo'}->{'filler'},                                                                         # (16) - Just a filler
                    $self->{'fscreeninfo'}->{'line_length'},                                                                    # (32)
                    $self->{'fscreeninfo'}->{'mmio_start'},                                                                     # LONG
                    $self->{'fscreeninfo'}->{'mmio_len'},                                                                       # (32)
                    $self->{'fscreeninfo'}->{'accel'},                                                                          # (32)
                    $self->{'fscreeninfo'}->{'capailities'},                                                                    # (16)
                    @{$self->{'fscreeninfo'}->{'reserved_fb_phys'}}                                                             # (16) x 2
                ) = _get_ioctl($self->{'FBIOGET_FSCREENINFO'}, $typedef, $self->{'FB'});
            } else {
                (
                    $self->{'fscreeninfo'}->{'id'},                                                                             # (8) x 16
                    $self->{'fscreeninfo'}->{'smem_start'},                                                                     # LONG
                    $self->{'fscreeninfo'}->{'smem_len'},                                                                       # (32)
                    $self->{'fscreeninfo'}->{'type'},                                                                           # (32)
                    $self->{'fscreeninfo'}->{'type_aux'},                                                                       # (32)
                    $self->{'fscreeninfo'}->{'visual'},                                                                         # (32)
                    $self->{'fscreeninfo'}->{'xpanstep'},                                                                       # (16)
                    $self->{'fscreeninfo'}->{'ypanstep'},                                                                       # (16)
                    $self->{'fscreeninfo'}->{'ywrapstep'},                                                                      # (16)
                    $self->{'fscreeninfo'}->{'line_length'},                                                                    # (32)
                    $self->{'fscreeninfo'}->{'mmio_start'},                                                                     # LONG
                    $self->{'fscreeninfo'}->{'mmio_len'},                                                                       # (32)
                    $self->{'fscreeninfo'}->{'accel'},                                                                          # (32)
                    $self->{'fscreeninfo'}->{'capailities'},                                                                    # (16)
                    @{$self->{'fscreeninfo'}->{'reserved_fb_phys'}}                                                             # (16) x 2
                ) = _get_ioctl($self->{'FBIOGET_FSCREENINFO'}, $typedef, $self->{'FB'});
            } ## end else [ if ($Config{'alignbytes'...})]
            $extra+=2;
        } until (($self->{'fscreeninfo'}->{'line_length'} < $self->{'fscreeninfo'}->{'smem_len'} && $self->{'fscreeninfo'}->{'line_length'} > 0)  || $extra > 16);
        $self->{'ACCELERATED'}    = 0;                                                                                      # ($self->{'fscreeninfo'}->{'accel'} || $self->{'vscreeninfo'}->{'accel_flags'});
        $self->{'VXRES'}          = $self->{'vscreeninfo'}->{'xres_virtual'};
        $self->{'VYRES'}          = $self->{'vscreeninfo'}->{'yres_virtual'};
        $self->{'XRES'}           = $self->{'vscreeninfo'}->{'xres'};
        $self->{'YRES'}           = $self->{'vscreeninfo'}->{'yres'};
        $self->{'XOFFSET'}        = $self->{'vscreeninfo'}->{'xoffset'} || 0;
        $self->{'YOFFSET'}        = $self->{'vscreeninfo'}->{'yoffset'} || 0;
        $self->{'BITS'}           = $self->{'vscreeninfo'}->{'bits_per_pixel'};
        $self->{'BYTES'}          = $self->{'BITS'} / 8;
        $self->{'BYTES_PER_LINE'} = $self->{'fscreeninfo'}->{'line_length'};
        if ($self->{'BYTES_PER_LINE'} < ($self->{'XRES'} * $self->{'BYTES'})) {
            print STDERR "Unable to detect proper byte alignment for IOCTL call, going to 'fbset -i' for more reliable information\n" if ($self->{'SHOW_ERRORS'});
            # Looks like we still have bad data
            $ENV{'PATH'} = '/usr/bin:/bin';
            my $fbset    = `fbset -i`;
            if ($fbset =~ /Frame buffer device information/i) {
                ($self->{'BYTES_PER_LINE'})             = $fbset =~ /LineLength\s*:\s*(\d+)/m;
                $self->{'fscreeninfo'}->{'line_length'} = $self->{'BYTES_PER_LINE'};
                ($self->{'fscreeninfo'}->{'smem_len'})  = $fbset =~ /Size\s*:\s*(\d+)/m;
                ($self->{'fscreeninfo'}->{'type'})      = $fbset =~ /Type\s*:\s*(.*)/m;
            }
        }

        ## For debugging only
#         print Dumper($self,\%Config),"\n"; exit;

        $self->{'PIXELS'} = (($self->{'XOFFSET'} + $self->{'VXRES'}) * ($self->{'YOFFSET'} + $self->{'VYRES'}));
        $self->{'SIZE'} = $self->{'PIXELS'} * $self->{'BYTES'};
        $self->{'fscreeninfo'}->{'smem_len'} = $self->{'BYTES'} * ($self->{'VXRES'} * $self->{'VYRES'}) if (!defined($self->{'fscreeninfo'}->{'smem_len'}) || $self->{'fscreeninfo'}->{'smem_len'} <= 0);

        # Only useful for debugging and for troubleshooting the module for specific display resolutions
        if (defined($self->{'SIMULATED_X'})) {
            my $w = $self->{'XRES'};
            $self->{'XRES'} = $self->{'SIMULATED_X'};
            $self->{'XOFFSET'} += ($w - $self->{'SIMULATED_X'}) / 2;
        }
        if (defined($self->{'SIMULATED_Y'})) {
            my $h = $self->{'YRES'};
            $self->{'YRES'} = $self->{'SIMULATED_Y'};
            $self->{'YOFFSET'} += ($h - $self->{'SIMULATED_Y'}) / 2;
        }

        bless($self, $class);
        $self->_color_order();    # Automatically determine color mode
        $self->attribute_reset();

        # Now that everything is set up, let's map the framebuffer to SCREEN

        mmap($self->{'SCREEN'}, $self->{'fscreeninfo'}->{'smem_len'}, PROT_READ | PROT_WRITE, MAP_SHARED, $self->{'FB'}) unless ($self->{'FILE_MODE'});
    } else {                      # Go into emulation mode if no actual framebuffer available

        $self->{'ERROR'} = 'Framebuffer Device Not Found! Emulation mode.  EXPERIMENTAL!!';

		$self->{'COLOR_ORDER'} = $self->{uc($self->{'COLOR_ORDER'})}; # Translate the color order

        $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'}      = 8;
        $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'msb_right'}   = 0;
        $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'}    = 8;
        $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'msb_right'} = 0;
        $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'}     = 8;
        $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'msb_right'}  = 0;
        $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'length'}    = 8;
        $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'msb_right'} = 0;

        if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
	        $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}      = 16;
	        $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}    = 8;
 	    	$self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}     = 0;
            $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'}    = 24;
        } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
	        $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}      = 8;
	        $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}    = 16;
 	    	$self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}     = 0;
            $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'}    = 24;
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
	        $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}      = 0;
	        $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}    = 8;
 	    	$self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}     = 16;
            $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'}    = 24;
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
	        $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}      = 0;
	        $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}    = 16;
 	    	$self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}     = 8;
            $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'}    = 24;
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
	        $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}      = 8;
	        $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}    = 0;
 	    	$self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}     = 16;
            $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'}    = 24;
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
	        $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}      = 16;
	        $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}    = 0;
 	    	$self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}     = 8;
            $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'}    = 24;
        }
        # 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->{'XOFFSET'} = 0;
        $self->{'YOFFSET'} = 0;
        $self->{'PIXELS'}  = (($self->{'XOFFSET'} + $self->{'VXRES'}) * ($self->{'YOFFSET'} + $self->{'VYRES'}));
        $self->{'SIZE'}    = $self->{'PIXELS'} * $self->{'BYTES'};
        $self->{'fscreeninfo'}->{'smem_len'} = $self->{'BYTES'} * ($self->{'VXRES'} * $self->{'VYRES'}) if (!defined($self->{'fscreeninfo'}->{'smem_len'}) || $self->{'fscreeninfo'}->{'smem_len'} <= 0);
        $self->{'BYTES_PER_LINE'}            = int($self->{'fscreeninfo'}->{'smem_len'} / $self->{'VYRES'});
        $self->{'COLOR_ORDER'}               = $self->{'RGB'};

        bless($self, $class);

        $self->attribute_reset();
    } ## end else [ if (!defined($ENV{'DISPLAY'...}))]
    if ($self->{'SPLASH'}) {
        $self->splash();
        sleep $self->{'SPLASH'};
    }
    return $self;
} ## end sub new

# Fixes the mmapping if Perl garbage collects (naughty Perl)
sub _fix_mapping {
    my $self = shift;
    unless ($self->{'FILE_MODE'}) {    # Nothing to fix in file handle mode
        munmap($self->{'SCREEN'});
        unless (defined($self->{'FB'})) {
            eval {close($self->{'FB'});};
            open($self->{'FB'}, '+<', $self->{'FB_DEVICE'});
        }
        $self->{'MAP_ATTEMPTS'}++;
        if ($self->{'MAP_ATTEMPTS'} > 2) {
            $self->{'FILE_MODE'} = TRUE;    # Just go into file handle mode if mapping keeps failing
        } else {
            mmap($self->{'SCREEN'}, $self->{'fscreeninfo'}->{'smem_len'}, PROT_READ | PROT_WRITE, MAP_SHARED, $self->{'FB'});
        }
    } ## end unless ($self->{'FILE_MODE'...})
} ## end sub _fix_mapping

# Determine the color order the video card uses
sub _color_order {
    my $self = shift;

    my $ro = $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'};
    my $go = $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'};
    my $bo = $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'};

    if ($ro < $go && $go < $bo) {
        $self->{'COLOR_ORDER'} = $self->{'RGB'};
    } elsif ($bo < $go && $go < $ro) {
        $self->{'COLOR_ORDER'} = $self->{'BGR'};
    } elsif ($go < $ro && $ro < $bo) {
        $self->{'COLOR_ORDER'} = $self->{'GRB'};
    } elsif ($go < $bo && $bo < $ro) {
        $self->{'COLOR_ORDER'} = $self->{'GBR'};
    } elsif ($bo < $ro && $ro < $go) {
        $self->{'COLOR_ORDER'} = $self->{'BRG'};
    } elsif ($ro < $bo && $bo < $go) {
        $self->{'COLOR_ORDER'} = $self->{'RBG'};
    } else {

        # UNKNOWM - default to RGB
        $self->{'COLOR_ORDER'} = $self->{'RGB'};
    }
} ## end sub _color_order

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'}) && !$self->{'FILE_MODE'});
        close($self->{'FB'}) if (defined($self->{'FB'}));
        delete($self->{'FB'});           # We leave no remnants MUHWAHAHAHAHA!!!
    }
    delete($self->{'SCREEN'});           # MUHWAHAHAHA!!
} ## end sub _screen_close

=head2 screen_dimensions

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

=over 2

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

=back
=cut

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

=head2 splash

Displays the Splash screen.  It automatically scales and positions to the
clipping region.

This is automatically displayed when this module is initialized, and the
variable 'SPLASH' is true (which is the default).

=over 2

 $fb->splash();

=back
=cut

sub splash {
    my $self = shift;

    my $X = $self->{'X_CLIP'};
    my $Y = $self->{'Y_CLIP'};
    my $W = $self->{'XX_CLIP'} - $X;
    my $H = $self->{'YY_CLIP'} - $Y;

    my $hf = $W / 1920;    # Scales the logo
    my $vf = $H / 1080;

    my $bold = $self->{'FONT_FACE'};
    $bold =~ s/\.ttf$/Bold.ttf/;

    $self->cls();

    if (($W < 129) || ($H < 129)) {
        $hf = $W / 128;
        $vf = $H / 128;
        $self->set_color({'red' => 0, 'green' => 0, 'blue' => 64});
        $self->polygon(
            {
                'coordinates' => [(27 * $hf) + $X, (9 * $vf) + $Y, (1.33 * $hf) + $X, (95 * $vf) + $Y, (107 * $hf) + $X, (127 * $vf) + $Y, (126 * $hf) + $X, (1 * $vf) + $Y],
                  'filled'      => TRUE,
                  'gradient'    => {
                      'start' => {
                          'red'   => 0,
                          'green' => 0,
                          'blue'  => 48
                      },
                      'end' => {
                          'red'   => 0,
                          'green' => 0,
                          'blue'  => 128
                      }
                  }
            }
        );
        $self->set_color({'red' => 0, 'green' => 0, 'blue' => 1});
        $self->rbox(
            {
                'x'      => (10 * $hf) + $X,
                  'y'      => (15 * $vf) + $Y,
                  'width'  => 111 * $hf,
                  'height' => 99 * $vf,
                  'radius' => 4,
                  'filled' => TRUE
            }
        );

        $self->set_color({'red' => 128, 'green' => 0, 'blue' => 0});
        $self->rbox(
            {
                'x'      => (8 * $hf) + $X,
                  'y'      => (13 * $vf) + $Y,
                  'width'  => 111 * $hf,
                  'height' => 99 * $vf,
                  'radius' => 4,
                  'filled' => TRUE
            }
        );
        $self->set_color({'red' => 64, 'green' => 0, 'blue' => 0});
        $self->circle(
            {
                'x'      => (15 * max($vf, $hf)) + $X,
                  'y'      => (15 * max($vf, $hf)) + $Y,
                  'radius' => 14 * max($vf,  $hf),
                  'filled' => TRUE
            }
        );

        $self->set_color({'red' => 255, 'green' => 255, 'blue' => 0});
        $self->circle(
            {
                'x'        => (14 * max($hf, $vf)) + $X,
                  'y'        => (14 * max($vf, $hf)) + $Y,
                  'radius'   => 14 * max($hf,  $vf),
                  'filled'   => TRUE,
                  'gradient' => {
                      'direction' => 'horizontal',
                      'start' => {
                          'red'   => 255,
                          'green' => 0,
                          'blue'  => 0
                      },
                      'end' => {
                          'red'   => 255,
                          'green' => 255,
                          'blue'  => 0
                      }
                  }
            }
        );
        $self->or_mode;
        my $color;

        # G
        if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
            $color = '0000FF';
        } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
            $color = '0000FF';
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
            $color = 'FF0000';
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
            $color = 'FF0000';
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
            $color = '00FF00';
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
            $color = '00FF00';
        }
        $self->ttf_print(
            $self->ttf_print(
                {
                    'bounding_box' => TRUE,
                      'x'            => (36 * $hf) + $X,
                      'y'            => (24 * $vf) + $Y,
                      'height'       => 20 * $vf,
                      'wscale'       => 2,
                      'color'        => $color,
                      'text'         => 'G',
                      'face'         => $bold,
                      'bounding_box' => TRUE,
                      'center'       => 0,
                      'antialias'    => FALSE
                }
            )
        );

        # F
        if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
            $color = '00FF00';
        } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
            $color = 'FF0000';
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
            $color = '00FF00';
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
            $color = '0000FF';
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
            $color = 'FF0000';
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
            $color = '0000FF';
        }
        $self->ttf_print(
            $self->ttf_print(
                {
                    'bounding_box' => TRUE,
                      'x'            => 0,
                      'y'            => (24 * $vf) + $Y,
                      'height'       => 20 * $vf,
                      'wscale'       => 2,
                      'color'        => $color,
                      'text'         => 'F',
                      'face'         => $bold,
                      'bounding_box' => TRUE,
                      'center'       => $self->{'CENTER_X'},
                      'antialias'    => FALSE
                }
            )
        );

        # B
        if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
            $color = 'FF0000';
        } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
            $color = '00FF00';
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
            $color = '0000FF';
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
            $color = '00FF00';
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
            $color = '0000FF';
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
            $color = 'FF0000';
        }
        $self->ttf_print(
            $self->ttf_print(
                {
                    'bounding_box' => TRUE,
                      'x'            => (76 * $hf) + $X,
                      'y'            => (24 * $vf) + $Y,
                      'height'       => 20 * $vf,
                      'wscale'       => 2,
                      'color'        => $color,
                      'face'         => $bold,
                      'text'         => 'B',
                      'bounding_box' => TRUE,
                      'center'       => 0,
                      'antialias'    => FALSE
                }
            )
        );
        $self->ttf_print(
            $self->ttf_print(
                {
                    'bounding_box' => TRUE,
                      'x'            => 0,
                      'y'            => (47 * $vf) + $Y,
                      'height'       => 20 * $vf,
                      'wscale'       => .9,
                      'color'        => 'FFFF00',
                      'text'         => 'Graphics-Framebuffer',
                      'bounding_box' => TRUE,
                      'center'       => $self->{'CENTER_X'},
                      'antialias'    => FALSE
                }
            )
        );
        $self->ttf_print(
            $self->ttf_print(
                {
                    'bounding_box' => TRUE,
                      'x'            => 0,
                      'y'            => (70 * $vf) + $Y,
                      'height'       => 17 * $vf,
                      'wscale'       => 1.2,
                      'color'        => 'FFFFFF',
                      'text'         => sprintf('VERSION %.02f', $VERSION),
                      'bounding_box' => TRUE,
                      'center'       => $self->{'CENTER_X'},
                      'antialias'    => FALSE
                }
            )
        );
        $self->ttf_print(
            $self->ttf_print(
                {
                    'bounding_box' => TRUE,
                      'x'            => 0,                                                                                                                                     # (600 * $hf) + $X,
                      'y'            => (90 * $vf) + $Y,
                      'height'       => 18 * $vf,
                      'wscale'       => .8115,
                      'color'        => 'FFFFFF',
                      'text'         => sprintf('%dx%d-%02d ON %s', $self->{'XRES'}, $self->{'YRES'}, $self->{'BITS'}, uc($self->{'fscreeninfo'}->{'id'} || 'Unknown GPU')),
                      'bounding_box' => TRUE,
                      'center'       => $self->{'CENTER_X'},
                      'antialias'    => FALSE
                }
            )
        );
    } else {
        $self->set_color({'red' => 0, 'green' => 0, 'blue' => 64});
        $self->polygon(
            {
                'coordinates' => [(400 * $hf) + $X, (80 * $vf) + $Y, (20 * $hf) + $X, (800 * $vf) + $Y, (1600 * $hf) + $X, (1078 * $vf) + $Y, (1900 * $hf) + $X, (5 * $vf) + $Y],
                  'filled'      => TRUE,
                  'gradient'    => {
                      'start' => {
                          'red'   => 0,
                          'green' => 0,
                          'blue'  => 48
                      },
                      'end' => {
                          'red'   => 0,
                          'green' => 0,
                          'blue'  => 128
                      }
                  }
            }
        );

        $self->set_color({'red' => 0, 'green' => 0, 'blue' => 1});
        $self->rbox(
            {
                'x'      => (160 * $hf) + $X,
                  'y'      => (160 * $vf) + $Y,
                  'width'  => 1620 * $hf,
                  'height' => 780 * $vf,
                  'radius' => 15 * min($hf, $vf),
                  'filled' => TRUE
            }
        );

        $self->set_color({'red' => 128, 'green' => 0, 'blue' => 0});
        $self->rbox(
            {
                'x'      => (150 * $hf) + $X,
                  'y'      => (150 * $vf) + $Y,
                  'width'  => 1620 * $hf,
                  'height' => 780 * $vf,
                  'radius' => 15 * min($hf, $vf),
                  'filled' => TRUE
            }
        );

        $self->set_color({'red' => 64, 'green' => 0, 'blue' => 0});
        $self->circle(
            {
                'x'      => (207 * $hf) + $X,
                  'y'      => (207 * $vf) + $Y,
                  'radius' => 199 * min($vf, $hf),
                  'filled' => TRUE
            }
        );

        $self->set_color({'red' => 255, 'green' => 255, 'blue' => 0});
        $self->circle(
            {
                'x'        => (200 * $hf) + $X,
                  'y'        => (200 * $vf) + $Y,
                  'radius'   => 199 * min($hf, $vf),
                  'filled'   => TRUE,
                  'gradient' => {
                      'direction' => 'horizontal',
                      'start' => {
                          'red'   => 255,
                          'green' => 0,
                          'blue'  => 0
                      },
                      'end' => {
                          'red'   => 255,
                          'green' => 255,
                          'blue'  => 0
                      }
                  }
            }
        );

        # G
        $self->set_color({'red' => 32, 'green' => 32, 'blue' => 0});
        $self->filled_pie(
            {
                'x'             => (102 * $hf) + $X,
                  'y'             => (202 * $vf) + $Y,
                  'radius'        => 52 * $vf,
                  'start_degrees' => 340,
                  'end_degrees'   => 270,
                  'granularity'   => 0.01
            }
        );

        # F
        $self->polygon(
            {
                'coordinates' => [(162 * $hf) + $X, (252 * $vf) + $Y, (162 * $hf) + $X, (152 * $vf) + $Y, (262 * $hf) + $X, (152 * $vf) + $Y, (242 * $hf) + $X, (172 * $vf) + $Y, (182 * $hf) + $X, (172 * $vf) + $Y, (182 * $hf) + $X, (192 * $vf) + $Y, (222 * $hf) + $X, (192 * $vf) + $Y, (202 * $hf) + $X, (212 * $vf) + $Y, (182 * $hf) + $X, (212 * $vf) + $Y, (182 * $hf) + $X, (232 * $vf) + $Y],
                  'filled'      => TRUE,
                  'pixel_size'  => 1
            }
        );

        # B
        $self->polygon(
            {
                'coordinates' => [(272 * $hf) + $X, (252 * $vf) + $Y, (272 * $hf) + $X, (152 * $vf) + $Y, (322 * $hf) + $X, (152 * $vf) + $Y, (322 * $hf) + $X, (252 * $vf) + $Y],
                  'filled'      => TRUE,
                  'pixel_size'  => 1
            }
        );
        $self->circle(
            {
                'x'      => (322 * $hf) + $X,
                  'y'      => (177 * $vf) + $Y,
                  'radius' => 25 * $vf,
                  'filled' => TRUE
            }
        );
        $self->circle(
            {
                'x'      => (322 * $hf) + $X,
                  'y'      => (227 * $vf) + $Y,
                  'radius' => 25 * $vf,
                  'filled' => TRUE
            }
        );

        if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
            $self->set_color({'red' => 0, 'green' => 0, 'blue' => 255});
        } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
            $self->set_color({'red' => 0, 'green' => 0, 'blue' => 255});
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
            $self->set_color({'red' => 255, 'green' => 0, 'blue' => 0});
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
            $self->set_color({'red' => 255, 'green' => 0, 'blue' => 0});
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
            $self->set_color({'red' => 0, 'green' => 255, 'blue' => 0});
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
            $self->set_color({'red' => 0, 'green' => 255, 'blue' => 0});
        }

        # G
        $self->filled_pie(
            {
                'x'             => (100 * $hf) + $X,
                  'y'             => (200 * $vf) + $Y,
                  'radius'        => 52 * $vf,
                  'start_degrees' => 340,
                  'end_degrees'   => 270,
                  'granularity'   => 0.01
            }
        );

        # F
        if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
            $self->set_color({'red' => 0, 'green' => 255, 'blue' => 0});
        } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
            $self->set_color({'red' => 255, 'green' => 0, 'blue' => 0});
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
            $self->set_color({'red' => 0, 'green' => 255, 'blue' => 0});
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
            $self->set_color({'red' => 0, 'green' => 0, 'blue' => 255});
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
            $self->set_color({'red' => 255, 'green' => 0, 'blue' => 0});
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
            $self->set_color({'red' => 0, 'green' => 0, 'blue' => 255});
        }
        $self->polygon(
            {
                'coordinates' => [(160 * $hf) + $X, (250 * $vf) + $Y, (160 * $hf) + $X, (150 * $vf) + $Y, (260 * $hf) + $X, (150 * $vf) + $Y, (240 * $hf) + $X, (170 * $vf) + $Y, (180 * $hf) + $X, (170 * $vf) + $Y, (180 * $hf) + $X, (190 * $vf) + $Y, (220 * $hf) + $X, (190 * $vf) + $Y, (200 * $hf) + $X, (210 * $vf) + $Y, (180 * $hf) + $X, (210 * $vf) + $Y, (180 * $hf) + $X, (230 * $vf) + $Y],
                  'filled'      => TRUE,
                  'pixel_size'  => 1
            }
        );

        # B
        if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
            $self->set_color({'red' => 255, 'green' => 0, 'blue' => 0});
        } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
            $self->set_color({'red' => 0, 'green' => 255, 'blue' => 0});
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
            $self->set_color({'red' => 0, 'green' => 0, 'blue' => 255});
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
            $self->set_color({'red' => 0, 'green' => 255, 'blue' => 0});
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
            $self->set_color({'red' => 0, 'green' => 0, 'blue' => 255});
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
            $self->set_color({'red' => 255, 'green' => 0, 'blue' => 0});
        }
        $self->polygon(
            {
                'coordinates' => [(270 * $hf) + $X, (250 * $vf) + $Y, (270 * $hf) + $X, (150 * $vf) + $Y, (320 * $hf) + $X, (150 * $vf) + $Y, (320 * $hf) + $X, (250 * $vf) + $Y],
                  'filled'      => TRUE,
                  'pixel_size'  => 1
            }
        );
        $self->circle(
            {
                'x'      => (320 * $hf) + $X,
                  'y'      => (175 * $vf) + $Y,
                  'radius' => 25 * $vf,
                  'filled' => TRUE
            }
        );
        $self->circle(
            {
                'x'      => (320 * $hf) + $X,
                  'y'      => (225 * $vf) + $Y,
                  'radius' => 25 * $vf,
                  'filled' => TRUE
            }
        );
        $self->set_color({'red' => 32, 'green' => 0, 'blue' => 0});
        $self->rbox(
            {
                'x'      => (478 * $hf) + $X,
                  'y'      => (208 * $vf) + $Y,
                  'width'  => (1230 * $hf),
                  'height' => (150 * $vf),
                  'filled' => TRUE,
                  'radius' => 20 * $vf,
            }
        );
        $self->rbox(
            {
                'x'        => (470 * $hf) + $X,
                  'y'        => (200 * $vf) + $Y,
                  'width'    => (1230 * $hf),
                  'height'   => (150 * $vf),
                  'filled'   => TRUE,
                  'radius'   => 20 * $vf,
                  'gradient' => {
                      'start' => {
                          'red'   => 64,
                          'green' => 0,
                          'blue'  => 255
                      },
                      'end' => {
                          'red'   => 255,
                          'green' => 0,
                          'blue'  => 64
                      }
                  }
            }
        );

        if ($self->{'ACCELERATED'}) {
            $self->xor_mode();
            $self->ttf_print(
                $self->ttf_print(
                    {
                        'bounding_box' => TRUE,
                          'x'            => (510 * $hf) + $X,
                          'y'            => (300 * $vf) + $Y,
                          'height'       => 110 * $vf,
                          'wscale'       => 1.8,
                          'color'        => 'FFFF00',
                          'text'         => 'Accelerated',
                          'bounding_box' => TRUE,
                          'center'       => 0,
                          'antialias'    => FALSE
                    }
                )
            );
        } ## end if ($self->{'ACCELERATED'...})

        $self->or_mode();
        $self->ttf_print(
            $self->ttf_print(
                {
                    'bounding_box' => TRUE,
                      'x'            => 0,                        # (400 * $hf) + $X,
                      'y'            => (530 * $vf) + $Y,
                      'height'       => 200 * $vf,
                      'wscale'       => .7,
                      'color'        => 'FFFF00',
                      'text'         => 'Graphics-Framebuffer',
                      'bounding_box' => TRUE,
                      'center'       => $self->{'CENTER_X'},
                      'antialias'    => FALSE
                }
            )
        );
        $self->ttf_print(
            $self->ttf_print(
                {
                    'bounding_box' => TRUE,
                      'x'            => 0,                                    # (600 * $hf) + $X,
                      'y'            => (690 * $vf) + $Y,
                      'height'       => 120 * $vf,
                      'wscale'       => 1,
                      'color'        => 'FFFFFF',
                      'text'         => sprintf('Version %.02f', $VERSION),
                      'bounding_box' => TRUE,
                      'center'       => $self->{'CENTER_X'},
                      'antialias'    => FALSE
                }
            )
        );
        $self->ttf_print(
            $self->ttf_print(
                {
                    'bounding_box' => TRUE,
                      'x'            => 0,                                                                                                                                 # (600 * $hf) + $X,
                      'y'            => (840 * $vf) + $Y,
                      'height'       => 120 * $vf,
                      'wscale'       => 0.7,
                      'color'        => 'FFFFFF',
                      'text'         => sprintf('%dx%d-%02d on %s', $self->{'XRES'}, $self->{'YRES'}, $self->{'BITS'}, $self->{'fscreeninfo'}->{'id'} || 'Unknown GPU'),
                      'bounding_box' => TRUE,
                      'center'       => $self->{'CENTER_X'},
                      'antialias'    => FALSE
                }
            )
        );
    } ## end else [ if (($W < 129) || ($H ...))]
    $self->normal_mode();
} ## end sub splash

=head2 draw_mode

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

=over 2

 my $draw_mode = $fb->draw_mode();     # Returns the current
                                       # Drawing mode.

 # Modes explained.  These settings are global

                                       # When you draw it...

 $fb->draw_mode($fb->{'NORMAL_MODE'}); # Replaces the screen pixel
                                       # with the new pixel.

 $fb->draw_mode($fb->{'XOR_MODE'});    # Does a bitwise XOR with
                                       # the new pixel and screen
                                       # pixel.

 $fb->draw_mode($fb->{'OR_MODE'});     # Does a bitwise OR with
                                       # the new pixel and screen
                                       # pixel.

 $fb->draw_mode($fb->{'AND_MODE'});    # Does a bitwise AND with
                                       # the new pixel and screen
                                       # pixel.

 $fb->draw_mode($fb->{'MASK_MODE'});   # Draws the new pixel on
                                       # screen areas not equal to
                                       # the background color. (SLOW)

 $fb->draw_mode($fb->{'UNMASK_MODE'}); # Draws the new pixel on
                                       # screen areas only equal to
                                       # the background color. (SLOW)

=back
=cut

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

=head2 normal_mode

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

=over 2

 $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 2

 $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 2

 $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 2

 $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 2

 $fb->mask_mode();

=back

=cut

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

=head2 unmask_mode

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

=over 2

 $fb->unmask_mode();

=back

=cut

sub unmask_mode {
    my $self = shift;
    $self->draw_mode($self->{'UNMASK_MODE'});
}

=head2 clear_screen

Fills the entire screen with the background color

You can add an optional parameter to turn the console cursor
on or off too.

=over 2

 $fb->clear_screen(); # Leave cursor as is.

 $fb->clear_screen('OFF'); # Turn cursor OFF.

 $fb->clear_screen('ON'); # Turn cursor ON.

=back
=cut

sub clear_screen {

    # Fills the entire screen with the background color fast #
    my $self = shift;
    my $cursor = shift || '';
    if ($cursor =~ /off/i) {
        system('clear && tput civis -- invisible');
    } elsif ($cursor =~ /on/i) {
        system('tput cnorm -- normal && reset');
    }
    select(STDOUT);
    $| = 1;
    if ($self->{'CLIPPED'}) {
        $self->blit_write({'x' => 0, 'y' => 0, 'width' => $self->{'XRES'}, 'height' => $self->{'YRES'}, 'image' => chr(0) x $self->{'SIZE'}}, 0);
    } elsif ($self->{'FILE_MODE'}) {
        my $fb = $self->{'FB'};
        seek($fb, 0, 0);
        print $fb $self->{'B_COLOR'} x ($self->{'fscreeninfo'}->{'smem_len'} / $self->{'BYTES'});
    } else {
        substr($self->{'SCREEN'}, 0) = $self->{'B_COLOR'} x ($self->{'fscreeninfo'}->{'smem_len'} / $self->{'BYTES'});
        substr($self->{'SCREEN'}, 0, $self->{'BYTES'}) = $self->{'B_COLOR'};    # Perl buffers string assignments???
    }
    select($self->{'FB'});
    $| = 1;
} ## end sub clear_screen

=head2 cls

The same as clear_screen

=over 2

 $fb->cls();      # Leave cursor as-is
 $fb->cls('OFF'); # Turn off cursor
 $fb->cls('ON');  # Turn on cursor

=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 whatever 'FOREGROUND' is set to, and the global
background color to whatever 'BACKGROUND' is set to, and resets the drawing
mode to NORMAL.

=over 2

 $fb->attribute_reset();

=back

=cut

sub attribute_reset {
    my $self = shift;

    $self->{'X'} = 0;
    $self->{'Y'} = 0;
    $self->set_color($self->{'FOREGROUND'});
    $self->{'DRAW_MODE'} = $self->{'NORMAL_MODE'};
    $self->set_b_color($self->{'BACKGROUND'});
    $self->clip_reset;
} ## end sub attribute_reset

=head2 reset

The same as 'attribute_reset'.

=over 2

 $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.

'pixel_size', if a positive number greater than 1, is drawn
with square pixels.  If it's a negative number, then it's
drawn with round pixels.  Square pixels are much faster.

=over 2

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

=back

=cut

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

    my $fb   = $self->{'FB'};
    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 (abs($size) > 1) {
        if ($size < -1) {
            $size = abs($size);
            $self->circle({'x' => $x, 'y' => $y, 'radius' => ($size / 2), 'filled' => 1, 'pixel_size' => 1});
        } else {
            $self->rbox({'x' => $x, 'y' => $y, 'width' => $size, 'height' => $size, 'filled' => TRUE, 'pixel_size' => 1});
        }
    } else {

        # Only plot if the pixel is within the clipping region
        unless (($x > $self->{'XX_CLIP'}) || ($y > $self->{'YY_CLIP'}) || ($x < $self->{'X_CLIP'}) || ($y < $self->{'Y_CLIP'})) {

            # The 'history' is a 'draw_arc' optimization and beautifier for xor mode.  It only draws pixels not in
            # the history buffer.
            unless (exists($self->{'history'}) && defined($self->{'history'}->{$y}->{$x})) {
                $index = ($self->{'BYTES_PER_LINE'} * ($y + $self->{'YOFFSET'})) + (($self->{'XOFFSET'} + $x) * $self->{'BYTES'});
                if ($index >= 0 && $index <= ($self->{'fscreeninfo'}->{'smem_len'} - $self->{'BYTES'})) {
                    eval {
                        if ($self->{'FILE_MODE'}) {
                            seek($fb, $index, 0);
                            read($fb, $c, $self->{'BYTES'});
                        } else {
                            $c = substr($self->{'SCREEN'}, $index, $self->{'BYTES'}) || chr(0) x $self->{'BYTES'};
                        }
                        if ($self->{'DRAW_MODE'} == $self->{'NORMAL_MODE'}) {
                            $c = $self->{'COLOR'};
                        } elsif ($self->{'DRAW_MODE'} == $self->{'XOR_MODE'}) {
                            $c ^= $self->{'COLOR'};
                        } elsif ($self->{'DRAW_MODE'} == $self->{'OR_MODE'}) {
                            $c |= $self->{'COLOR'};
                        } elsif ($self->{'DRAW_MODE'} == $self->{'ALPHA_MODE'}) {
                            $c |= ($self->{'COLOR'} & $self->{'COLOR_ALPHA'});
                        } elsif ($self->{'DRAW_MODE'} == $self->{'AND_MODE'}) {
                            $c &= $self->{'COLOR'};
                        } elsif ($self->{'DRAW_MODE'} == $self->{'MASK_MODE'}) {
                            $c = $self->{'COLOR'} if ($self->{'COLOR'} ne $self->{'B_COLOR'});
                        } elsif ($self->{'DRAW_MODE'} == $self->{'UNMASK_MODE'}) {
                            $c = $self->{'COLOR'} if ($self->pixel($x, $y) eq $self->{'B_COLOR'});
                        }
                        if ($self->{'FILE_MODE'}) {
                            seek($fb, $index, 0);
                            print $fb $c;
                        } else {
                            substr($self->{'SCREEN'}, $index, $self->{'BYTES'}) = $c;
                        }
                    };
                    my $error = $@;
                    print STDERR "$error\n" if ($error && $self->{'SHOW_ERRORS'});
                    $self->_fix_mapping() if ($error);
                } ## end if ($index >= 0 && $index...)
                $self->{'history'}->{$y}->{$x} = 1 if (exists($self->{'history'}));
            } ## end unless (exists($self->{'history'...}))
        } ## end unless (($x > $self->{'XX_CLIP'...}))
    } ## end else [ if (abs($size) > 1) ]

    $self->{'X'} = $x;
    $self->{'Y'} = $y;

    select($self->{'FB'});
    $| = 1;
} ## end sub plot

=head2 setpixel

Same as 'plot' above

=cut

sub setpixel {
    my $self = shift;
    $self->plot(shift);
}

=head2 last_plot

Returns the last plotted position

=over 2

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

This returns an anonymous hash reference in the form:

 {
     'x' => x position,
     'y' => y position
 }

=back

Or, if you want a simple array returned:

=over 2

 my ($x,$y) = $fb->last_plot();

This returns the position as a two element array:

 ( x position, y position )

=back

=cut

sub last_plot {
    my $self = shift;
    if (wantarray) {
        return($self->{'X'},$self->{'Y'});
    }
    return({'x' => $self->{'X'},'y' => $self->{'Y'}});
}

=head2 line

Draws a line, in the global color, from point x,y to
point xx,yy.  Clipping applies.

=over 2

 $fb->line({
    'x'          => 50,
    'y'          => 60,
    'xx'         => 100,
    'yy'         => 332
    'pixel_size' => 3
 });

=back

=cut

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

    $self->plot($params);
    $params->{'x'} = $params->{'xx'};
    $params->{'y'} = $params->{'yy'};
    $self->drawto($params);
} ## end sub line

=head2 angle_line

Draws a line, in the global foregrounde color, from point x,y
at an angle of 'angle', of length 'radius'.  Clipping
applies.

=over 2

 $fb->angle_line({
    'x'          => 50,
    'y'          => 60,
    'radius'     => 50,
    'angle'      => 30.3, # Compass coordinates (0-360)
    'pixel_size' => 3
 });

=back

=cut

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

    $params->{'xx'} = int($params->{'x'} - ($params->{'radius'} * sin(($params->{'angle'} * pi) / 180)));
    $params->{'yy'} = int($params->{'y'} - ($params->{'radius'} * cos(($params->{'angle'} * pi) / 180)));
    $self->line($params);
} ## end sub angle_line

=head2 drawto

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

=over 2

 $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'});
    my $y_end = int($params->{'y'});
    my $size  = int($params->{'pixel_size'} || 1);

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

    # 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++;
            }
        } ## end else [ if ($start_y > $y_end)]
    } elsif ($y_end == $start_y) {    # Draw a perfectly horizontal line (fast)
        $x_end   = max($self->{'X_CLIP'},min($x_end,$self->{'XX_CLIP'}));
        $start_x = max($self->{'X_CLIP'},min($start_x,$self->{'XX_CLIP'}));
        $width = abs($x_end - $start_x);
        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!
            } ## end else [ if ($start_x > $x_end)]
        } else {
            if ($start_x > $x_end) {
                $self->blit_write({'x' => $x_end, 'y' => ($y_end - ($size / 2)), 'width' => $width, 'height' => $size, 'image' => $self->{'COLOR'} x ($width * $size)});                                              # Blitting a horizontal line is much faster!
            } else {
                $self->blit_write({'x' => $start_x, 'y' => ($y_end - ($size / 2)), 'width' => $width, 'height' => $size, 'image' => $self->{'COLOR'} x ($width * $size)});                                                  # Blitting a horizontal line is much faster!
            } ## end else [ if ($start_x > $x_end)]
        } ## end else [ if ($size == 1) ]
    } 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--;
            }
        } ## end elsif (($start_x > $x_end...))
    } 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--;
            }
        } ## end elsif (($start_x > $x_end...))
    } 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--;
            }
        } ## end elsif (($start_x > $x_end...))

    } ## end else [ if (($x_end == $start_x...))]

    $self->{'X'} = $XX;
    $self->{'Y'} = $YY;

    select($self->{'FB'});
    $| = 1;
} ## end sub drawto

=head2 bezier

Draws a Bezier curve, based on a list of control points.

=over 2

 $fb->bezier(
     {
         'coordinates' => [
             x0,y0,
             x1,y1,
             ...              # As many as needed
         ],
         'points'     => 100, # Number of total points plotted for curve
                              # The higher the number, the smoother the curve.
         'pixel_size' => 2,   # optional
         'closed'     => 1,   # optional, close it and make it a full shape.
         'filled'     => 1    # Results may vary, optional
         'gradient' => {
              'direction' => 'horizontal', # or vertical
              'start' => {
                  'red'   => 255,
                  'green' => 0,
                  'blue'  => 0
              },
              'end' => {
                  'red'   => 255,
                  'green' => 0,
                  'blue'  => 64
              }
          }
     }
 );

=back

=cut

sub bezier {
    my $self   = shift;
    my $params = shift;
    my $size   = $params->{'pixel_size'} || 1;
    my $closed = $params->{'closed'} || 0;
    my $filled = $params->{'filled'} || 0;

    push(@{$params->{'coordinates'}}, $params->{'coordinates'}->[0], $params->{'coordinates'}->[1]) if ($closed);

    my $bezier = Math::Bezier->new($params->{'coordinates'});
    my @coords = $bezier->curve($params->{'points'} || (scalar(@{$params->{'coordinates'}}) / 2));
    if ($closed) {
        $params->{'coordinates'} = \@coords;
        $self->polygon($params);
    } else {
        $self->plot({'x' => shift(@coords), 'y' => shift(@coords), 'pixel_size' => $size});
        while (scalar(@coords)) {
            $self->drawto({'x' => shift(@coords), 'y' => shift(@coords), 'pixel_size' => $size});
        }
    }
} ## end sub bezier

=head2 cubic_bezier

DISCONTINUED, use 'bezier' instead.

=cut

sub cubic_bezier {
    my $self = shift;
    $self->bezier(shift);

    #    my $params = shift;

    #    my ($x0, $y0, $x1, $y1, $x2, $y2, $x3, $y3) = @{$params->{'coordinates'}};
    #    my $size = int($params->{'pixel_size'}) || 1;
    #    my @coords;
    #    my $n = $params->{'points'} || 100;
    #    foreach my $i (0..$n) {
    #        my $t = $i / $n;
    #        my $t1 = 1 - $t;
    #        my $a = $t1**3;
    #        my $b = 3 * $t * $t1**2;
    #        my $c = 3 * $t**2 * $t1;
    #        my $d = $t**3;
    #        my $x = round($a * $x0 + $b * $x1 + $c * $x2 + $d * $x3);
    #        my $y = round($a * $y0 + $b * $y1 + $c * $y2 + $d * $y3);
    #        push(@coords,[$x,$y]);
    #    }
    #    foreach my $c (0..($n - 1)) {
    #        $self->line({'x' => $coords[$c]->[0], 'y' => $coords[$c]->[1], 'xx' => $coords[$c + 1]->[0], 'yy' => $coords[$c + 1]->[1],'pixel_size' => $size});
    #    }
} ## end sub cubic_bezier

=head2 draw_arc

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

=over 2

 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.  Valid values
                 are any positive floating point number
                 down to 0.0001.  Anything smaller than
                 that is just silly.

 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, # Compass coordinates
    'end_degrees'   => 80,
    'grandularity   => .05,
    'mode'          => 2    # The object hash has 'ARC', 'PIE',
                            # and 'POLY_ARC' as a means of filling
                            # this value.
 });

=back

=cut

sub draw_arc {

    # This isn't exactly the fastest routine out there,
    # hence the "granularity" parameter, but it is pretty
    # neat.
    # drawing lines between points smooths and compensates for high
    # granularity settings.
    my $self   = shift;
    my $params = shift;

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

    my $start_degrees = $params->{'start_degrees'} || 0;
    my $end_degrees   = $params->{'end_degrees'}   || 360;
    my $granularity   = $params->{'granularity'}   || .1;

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

    my $plotted = FALSE;
    $degrees = $start_degrees;
    if ($start_degrees > $end_degrees) {
        do {
            $sx = int($x - ($radius * sin(($degrees * pi) / 180)));
            $sy = int($y - ($radius * cos(($degrees * pi) / 180)));
            if (($sx <=> $ox) || ($sy <=> $oy)) {
                if ($mode == $self->{'ARC'}) {       # Ordinary arc
                    if ($plotted) {                  # Fills in the gaps better this way
                        $self->drawto({'x' => $sx, 'y' => $sy, 'pixel_size' => $size});
                    } else {
                        $self->plot({'x' => $sx, 'y' => $sy, 'pixel_size' => $size});
                        $plotted = TRUE;
                    }
                } else {
                    if ($degrees == $start_degrees) {
                        push(@coords,$x,$y,$sx,$sy);
                    } else {
                        push(@coords,$sx,$sy);
                    }
                }
                $ox = $sx;
                $oy = $sy;
            } ## end if (($sx <=> $ox) || (...))
            $degrees += $granularity;
        } until ($degrees >= 360);
        $degrees = 0;
    } ## end if ($start_degrees > $end_degrees)
    $plotted = FALSE;
    do {
        $sx = int($x - ($radius * sin(($degrees * pi) / 180)));
        $sy = int($y - ($radius * cos(($degrees * pi) / 180)));
        if (($sx <=> $ox) || ($sy <=> $oy)) {
            if ($mode == $self->{'ARC'}) {    # Ordinary arc
                if ($plotted) {               # Fills in the gaps better this way
                    $self->drawto({'x' => $sx, 'y' => $sy, 'pixel_size' => $size});
                } else {
                    $self->plot({'x' => $sx, 'y' => $sy, 'pixel_size' => $size});
                    $plotted = TRUE;
                }
            } else {    # Filled pie arc
                if ($degrees == $start_degrees) {
                    push(@coords,$x,$y,$sx,$sy);
                } else {
                    push(@coords,$sx,$sy);
                }
            }
            $ox = $sx;
            $oy = $sy;
        } ## end if (($sx <=> $ox) || (...))
        $degrees += $granularity;
    } until ($degrees >= $end_degrees);
    if ($mode != $self->{'ARC'}) {
        $params->{'filled'} = ($mode == $self->{'PIE'}) ? TRUE : FALSE;
        $params->{'coordinates'} = \@coords;
        $self->polygon($params);
    }
    ($self->{'X'},$self->{'Y'}) = ($sx,$sy);
} ## end sub draw_arc

=head2 arc

Draws an arc of a circle at point x,y.  This is an alias to draw_arc above,
but no mode parameter needed.

=over 2

 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.  Valid values
                 are any positive floating point number
                 down to 0.0001.

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

=back

=cut

sub arc {
    my $self   = shift;
    my $params = shift;
    $params->{'mode'} = $self->{'ARC'};
    $self->draw_arc($params);
} ## end sub arc

=head2 filled_pie

Draws a filled pie wedge at point x,y.  This is an alias to draw_arc above,
but no mode parameter needed.

=over 2

 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.  Valid values
                 are any positive floating point number
                 down to 0.0001.

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

=back

=cut

sub filled_pie {
    my $self   = shift;
    my $params = shift;
    $params->{'mode'} = $self->{'PIE'};
    $self->draw_arc($params);
} ## end sub filled_pie

=head2 poly_arc

Draws a poly arc of a circle at point x,y.  This is an alias to draw_arc above,
but no mode parameter needed.

=over 2

 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.  Valid values
                 are any positive floating point number
                 down to 0.0001.

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

=back

=cut

sub poly_arc {
    my $self   = shift;
    my $params = shift;
    $params->{'mode'} = $self->{'POLY_ARC'};
    $self->draw_arc($params);
} ## end sub poly_arc

=head2 ellipse

Draw an ellipse at center position x,y with XRadius, YRadius.  Either a filled
ellipse or 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.

=over 2

 $fb->ellipse({
    'x'          => 200,
    'y'          => 250,
    'xradius'    => 50,
    'yradius'    => 100,
    'factor'     => 1, # Anything other than 1 has funkiness
    'filled'     => 1, # optional
    'pixel_size' => 4, # optional
    'gradient'   => {  # optional
        'direction' => 'horizontal', # or vertical
        'start' => {
            'red'    => 128,
            'green'  => 59,
            'blue'   => 0
        },
        'end'   => {
            'red'   => 0,
            'green' => 0,
            'blue'  => 255
        }
    }
 });

=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'});
    my $cy      = int($params->{'y'});
    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'} || 0);
    my $fact = $params->{'factor'} || 1;
    my $size = int($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;
    my $history_on   = FALSE;
    $history_on = TRUE if (exists($self->{'history'}));

    $self->{'history'} = {} unless ($history_on || !$filled || $size > 1);
    my ($red, $green, $blue, @rc, @gc, @bc);
    my $gradient = FALSE;
    my $saved    = $self->{'COLOR'};
    my $pattern;
    my $plen;
    if (exists($params->{'gradient'})) {
        if ($params->{'gradient'}->{'direction'} =~ /horizontal/i) {
            my $xdiameter = $XRadius * 2;
            $pattern      = $self->_generate_horizontal_fill($xdiameter,$params->{'gradient'}->{'start'},$params->{'gradient'}->{'end'});
            $plen         = length($pattern);
            $gradient     = 2;
        } else {
            my $ydiameter = $YRadius * 2;
            @rc = gradient($params->{'gradient'}->{'start'}->{'red'},   $params->{'gradient'}->{'end'}->{'red'},   $ydiameter);
            @gc = gradient($params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}, $ydiameter);
            @bc = gradient($params->{'gradient'}->{'start'}->{'blue'},  $params->{'gradient'}->{'end'}->{'blue'},  $ydiameter);
            $gradient = 1;
        }
    } ## end if (exists($params->{'gradient'...}))

    my $left = $cx - $XRadius;
    while ($StoppingX >= $StoppingY) {
        my $cxx  = int($cx + $x);
        my $cx_x = int($cx - $x);
        my $cyy  = int($cy + $y);
        my $cy_y = int($cy - $y);
        my $rpy  = $YRadius + $y;
        my $rmy  = $YRadius - $y;

        #        print "$rpy,$rmy,",scalar(@grad),"\n";
        if ($filled) {
            if ($cyy <=> $old_cyy) {
                if ($gradient == 2) {
                    my $wd = max($cx_x,$cxx) - min($cxx,$cx_x);
                    $self->blit_write({'x' => min($cxx,$cx_x), 'y' => $cyy, 'width' => $wd, 'height' => 1,'image' => substr($pattern,$self->{'BYTES'} * (min($cxx,$cx_x) - $left),$self->{'BYTES'} * ($wd))});
                } else {
                    if ($gradient) {
                        $self->set_color({'red' => $rc[$rpy], 'green' => $gc[$rpy], 'blue' => $bc[$rpy]});
                    }
                    $self->line({'x' => $cxx, 'y' => $cyy, 'xx' => $cx_x, 'yy' => $cyy});
                }
                $old_cyy = $cyy;
            } ## end if ($cyy <=> $old_cyy)
            if (($cy_y <=> $old_cy_y) && ($cyy <=> $cy_y)) {
                if ($gradient == 2) {
                    my $wd = max($cx_x,$cxx) - min($cxx,$cx_x);
                    $self->blit_write({'x' => min($cxx,$cx_x), 'y' => $cy_y, 'width' => $wd, 'height' => 1,'image' => substr($pattern,$self->{'BYTES'} * (min($cxx,$cx_x) - $left),$self->{'BYTES'} * ($wd))});
                } else {
                    if ($gradient) {
                        $self->set_color({'red' => $rc[$rmy], 'green' => $gc[$rmy], 'blue' => $bc[$rmy]});
                    }
                    $self->line({'x' => $cx_x, 'y' => $cy_y, 'xx' => $cxx, 'yy' => $cy_y});
                }
                $old_cy_y = $cy_y;
            } ## end if (($cy_y <=> $old_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 (int($cyy) <=> int($cy_y));
            $self->plot({'x' => $cxx,  'y' => $cy_y, 'pixel_size' => $size}) if (int($cyy) <=> int($cy_y));
        } ## end else [ if ($filled) ]
        $y++;
        $StoppingY    += $TwoASquare;
        $EllipseError += $YChange;
        $YChange      += $TwoASquare;
        if ((($EllipseError * 2) + $XChange) > 0) {
            $x--;
            $StoppingX -= $TwoBSquare;
            $EllipseError += $XChange;
            $XChange      += $TwoBSquare;
        } ## end if ((($EllipseError * ...)))
    } ## end while ($StoppingX >= $StoppingY)
    $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  = int($cx + $x);
        my $cx_x = int($cx - $x);
        my $cyy  = int($cy + $y);
        my $cy_y = int($cy - $y);
        my $rpy  = $YRadius + $y;
        my $rmy  = $YRadius - $y;
        if ($filled) {
            if ($cyy <=> $old_cyy) {
                if ($gradient == 2) {
                    my $wd = max($cx_x,$cxx) - min($cxx,$cx_x);
                    $self->blit_write({'x' => min($cxx,$cx_x), 'y' => $cyy, 'width' => $wd, 'height' => 1,'image' => substr($pattern,$self->{'BYTES'} * (min($cxx,$cx_x) - $left),$self->{'BYTES'} * ($wd))});
                } else {
                    if ($gradient) {
                        $self->set_color({'red' => $rc[$rpy], 'green' => $gc[$rpy], 'blue' => $bc[$rpy]});
                    }
                    $self->line({'x' => $cxx, 'y' => $cyy, 'xx' => $cx_x, 'yy' => $cyy});
                }
                $old_cyy = $cyy;
            } ## end if ($cyy <=> $old_cyy)
            if (($cy_y <=> $old_cy_y) && ($cyy <=> $cy_y)) {
                if ($gradient == 2) {
                    my $wd = max($cx_x,$cxx) - min($cxx,$cx_x);
                    $self->blit_write({'x' => min($cxx,$cx_x), 'y' => $cy_y, 'width' => $wd, 'height' => 1,'image' => substr($pattern,$self->{'BYTES'} * (min($cxx,$cx_x) - $left),$self->{'BYTES'} * ($wd))});
                } else {
                    if ($gradient) {
                        $self->set_color({'red' => $rc[$rmy], 'green' => $gc[$rmy], 'blue' => $bc[$rmy]});
                    }
                    $self->line({'x' => $cx_x, 'y' => $cy_y, 'xx' => $cxx, 'yy' => $cy_y});
                }
                $old_cy_y = $cy_y;
            } ## end if (($cy_y <=> $old_cy_y...))
        } else {
            $self->plot({'x' => $cxx,  'y' => $cyy,  'pixel_size' => $size});
            $self->plot({'x' => $cx_x, 'y' => $cyy,  'pixel_size' => $size}) if (int($cxx) <=> int($cx_x));
            $self->plot({'x' => $cx_x, 'y' => $cy_y, 'pixel_size' => $size}) if (int($cxx) <=> int($cx_x));
            $self->plot({'x' => $cxx,  'y' => $cy_y, 'pixel_size' => $size});
        } ## end else [ if ($filled) ]
        $x++;
        $StoppingX    += $TwoBSquare;
        $EllipseError += $XChange;
        $XChange      += $TwoBSquare;
        if ((($EllipseError * 2) + $YChange) > 0) {
            $y--;
            $StoppingY -= $TwoASquare;
            $EllipseError += $YChange;
            $YChange      += $TwoASquare;
        } ## end if ((($EllipseError * ...)))
    } ## end while ($StoppingX <= $StoppingY)
    delete($self->{'history'}) if (exists($self->{'history'}) && !$history_on);
    $self->{'COLOR'} = $saved;
} ## end sub ellipse

=head2 circle

Draws a circle at point x,y, with radius 'radius'.  It can be an outline,
solid filled, or gradient filled.  Outlined circles can have any pixel size.

=over 2

 $fb->circle({
    'x'        => 300,
    'y'        => 300,
    'radius'   => 100,
    'filled'   => 1, # optional
    'gradient' => {  # optional
        'direction' => 'horizontal', # or vertical
        'start' => {
            'red'   => 128,
            'green' => 59,
            'blue'  => 0
        },
        'end'   => {
            'red'   => 0,
            'green' => 0,
            'blue'  => 255
        }
    }
 });

=back
=cut

# This also doubles as the rounded box routine.

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

    my $x0            = int($params->{'x'});
    my $y0            = int($params->{'y'});
    my $x1            = int($params->{'xx'})  || $x0;
    my $y1            = int($params->{'yy'})  || $y0;
    my $bx            = int($params->{'bx'})  || 0;
    my $by            = int($params->{'by'})  || 0;
    my $bxx           = int($params->{'bxx'}) || 1;
    my $byy           = int($params->{'byy'}) || 1;
    my $r             = int($params->{'radius'});
    my $filled        = $params->{'filled'} || FALSE;
    my $gradient      = (defined($params->{'gradient'})) ? TRUE : FALSE;
    my $size          = $params->{'pixel_size'} || 1;
    my $start         = $y0 - $r;
    my $x             = $r;
    my $y             = 0;
    my $decisionOver2 = 1 - $x;
    my (@rc, @gc, @bc);

    ($x0, $x1) = ($x1, $x0) if ($x0 > $x1);
    ($y0, $y1) = ($y1, $y0) if ($y0 > $y1);

    my @coords;
    my $saved = $self->{'COLOR'};
    my $count = ($r * 2) + abs($y1 - $y0);
    my $pattern;
    my $plen;

    if ($gradient) {
        if ($params->{'gradient'}->{'direction'} =~ /horizontal/i) {
            my $W = $r*2;
            $W = $bxx - $bx unless($x0 == $x1 && $y0 == $y1);
            $pattern = $self->_generate_horizontal_fill($W,$params->{'gradient'}->{'start'},$params->{'gradient'}->{'end'});
            $plen    = length($pattern);
            $gradient = 2;
        } else {
            @rc = gradient($params->{'gradient'}->{'start'}->{'red'},   $params->{'gradient'}->{'end'}->{'red'},   $count);
            @gc = gradient($params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}, $count);
            @bc = gradient($params->{'gradient'}->{'start'}->{'blue'},  $params->{'gradient'}->{'end'}->{'blue'},  $count);
        }
    }
    my ($ymy, $ymx, $ypy, $ypx, $xmy, $xmx, $xpy, $xpx);

    while ($x >= ($y - 1)) {
        $ymy = $y0 - $y;    # Top
        $ymx = $y0 - $x;
        $ypy = $y1 + $y;    # Bottom
        $ypx = $y1 + $x;
        $xmy = $x0 - $y;    # Left
        $xmx = $x0 - $x;
        $xpy = $x1 + $y;    # Right
        $xpx = $x1 + $x;
        if ($filled) {
            if ($gradient == 2) {
                # Top

                my $wd = $xpx - $xmx;
                ($params->{'x'}, $params->{'y'}, $params->{'width'}, $params->{'height'},$params->{'image'}) = ($xmx, $ymy, $wd, 1, substr($pattern,($plen - ($self->{'BYTES'} * $wd)) / 2,$wd * $self->{'BYTES'}));
                $self->blit_write($params);

                $wd = $xpy - $xmy;
                ($params->{'x'}, $params->{'y'}, $params->{'width'}, $params->{'height'},$params->{'image'}) = ($xmy, $ymx, $wd, 1,  substr($pattern,($plen - ($self->{'BYTES'} * $wd)) / 2,$wd * $self->{'BYTES'}));
                $self->blit_write($params);

                # Bottom

                $wd = $xpx - $xmx;
                ($params->{'x'}, $params->{'y'}, $params->{'width'}, $params->{'height'},$params->{'image'}) = ($xmx, $ypy, $wd, 1,  substr($pattern,($plen - ($self->{'BYTES'} * $wd)) / 2,$wd * $self->{'BYTES'}));
                $self->blit_write($params);

                $wd = $xpy - $xmy;
                ($params->{'x'}, $params->{'y'}, $params->{'width'}, $params->{'height'},$params->{'image'}) = ($xmy, $ypx, $wd, 1,  substr($pattern,($plen - ($self->{'BYTES'} * $wd)) / 2,$wd * $self->{'BYTES'}));
                $self->blit_write($params);
            } elsif ($gradient) {
                # Top
                $self->set_color({'red' => $rc[$ymy - $start], 'green' => $gc[$ymy - $start], 'blue' => $bc[$ymy - $start]});
                ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmx, $ymy, $xpx, $ymy);
                $self->line($params);
                $self->set_color({'red' => $rc[$ymx - $start], 'green' => $gc[$ymx - $start], 'blue' => $bc[$ymx - $start]});
                ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmy, $ymx, $xpy, $ymx);
                $self->line($params);

                # Bottom
                $self->set_color({'red' => $rc[$ypy - $start], 'green' => $gc[$ypy - $start], 'blue' => $bc[$ypy - $start]});
                ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmx, $ypy, $xpx, $ypy);
                $self->line($params);
                $self->set_color({'red' => $rc[$ypx - $start], 'green' => $gc[$ypx - $start], 'blue' => $bc[$ypx - $start]});
                ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmy, $ypx, $xpy, $ypx);
                $self->line($params);
            } else {
                # Top
                ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmx, $ymy, $xpx, $ymy);
                $self->line($params);
                ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmy, $ymx, $xpy, $ymx);
                $self->line($params);

                # Bottom
                ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmx, $ypy, $xpx, $ypy);
                $self->line($params);
                ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmy, $ypx, $xpy, $ypx);
                $self->line($params);
            } ## end else [ if ($gradient) ]
        } else {
            # Top left
            ($params->{'x'}, $params->{'y'}) = ($xmx, $ymy);
            $self->plot($params);
            ($params->{'x'}, $params->{'y'}) = ($xmy, $ymx);
            $self->plot($params);

            # Top right
            ($params->{'x'}, $params->{'y'}) = ($xpx, $ymy);
            $self->plot($params);
            ($params->{'x'}, $params->{'y'}) = ($xpy, $ymx);
            $self->plot($params);

            # Bottom right
            ($params->{'x'}, $params->{'y'}) = ($xpx, $ypy);
            $self->plot($params);
            ($params->{'x'}, $params->{'y'}) = ($xpy, $ypx);
            $self->plot($params);

            # Bottom left
            ($params->{'x'}, $params->{'y'}) = ($xmx, $ypy);
            $self->plot($params);
            ($params->{'x'}, $params->{'y'}) = ($xmy, $ypx);
            $self->plot($params);
        } ## end else [ if ($filled) ]
        $y++;
        if ($decisionOver2 <= 0) {
            $decisionOver2 += 2 * $y + 1;
        } else {
            $x--;
            $decisionOver2 += 2 * ($y - $x) + 1;
        }
    } ## end while ($x >= ($y - 1))
    unless ($x0 == $x1 && $y0 == $y1) {
        if ($filled) {
            if ($gradient == 2) {
                $self->blit_write({'x' => $x0 - $r,'y' => $y0, 'width' => ($x1 + $r) - ($x0 -$r),'height' => $y1 - $y0,'image' => $pattern x ($y1 - $y0)});
            } elsif ($gradient) {
                map {
                    $self->set_color({'red' => $rc[$_ - $start], 'green' => $gc[$_ - $start], 'blue' => $bc[$_ - $start]});
                    $self->line({'x' => $x0 - $r, 'y' => $_, 'xx' => $x1 + $r, 'yy' => $_, 'pixel_size' => 1});
                } ($y0 .. $y1);
            } else {
                $self->{'COLOR'} = $saved;
                $self->box({'x' => $x0 - $r, 'y' => $y0, 'xx' => $x1 + $r, 'yy' => $y1, 'filled' => 1});
            }
        } else {

            # top
            $self->line({'x' => $x0, 'y' => $y0 - $r, 'xx' => $x1, 'yy' => $y0 - $r, 'pixel_size' => $size});

            # right
            $self->line({'x' => $x1 + $r, 'y' => $y0, 'xx' => $x1 + $r, 'yy' => $y1, 'pixel_size' => $size});

            # bottom
            $self->line({'x' => $x0, 'y' => $y1 + $r, 'xx' => $x1, 'yy' => $y1 + $r, 'pixel_size' => $size});

            # left
            $self->line({'x' => $x0 - $r, 'y' => $y0, 'xx' => $x0 - $r, 'yy' => $y1, 'pixel_size' => $size});
        } ## end else [ if ($filled) ]
    } ## end unless ($x0 == $x1 && $y0 ...)
    $self->{'COLOR'} = $saved;
} ## end sub circle

=head2 polygon

Creates a 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.

It is up to you to make sure the coordinates are "sane".  Weird things can
result from twisted or complex filled polygons.

=over 2

 $fb->polygon({
    'coordinates' => [
        5,5,
        23,34,
        70,7
    ],
    'pixel_size'  => 1, # optional
    'filled'      => 1, # optional
    'gradient'    => {  # optional
        'direction' => 'horizontal', # or vertical
        'start' => {
            'red'   => 128,
            'green' => 59,
            'blue'  => 0
        },
        'end'   => {
            'red'   => 0,
            'green' => 0,
            'blue'  => 255
        }
    }
 });

=back
=cut

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

    my $size = int($params->{'pixel_size'} || 1);
    my $history_on = 0;
    $history_on = 1 if (exists($self->{'history'}));
    if ($params->{'filled'}) {
        $self->_fill_polygon($params);
    } else {
        $self->{'history'} = {} unless ($history_on);
        my @coords = @{$params->{'coordinates'}};
        my ($xx, $yy) = (shift(@coords), shift(@coords));
        my ($x, $y);
        $self->plot({'x' => $xx, 'y' => $yy, 'pixel_size' => $size});
        while (scalar(@coords)) {
            $x = shift(@coords);
            $y = 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);
        delete($self->{'history'}) unless ($history_on);
    }
} ## end sub polygon

# Does point x,y fall inside the polygon described in
# coordinates?  Not yet used.

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

    my $poly_corners = (scalar(@{$params->{'coordinates'}}) / 2);
    my ($x,$y) = ($params->{'x'},$params->{'y'});
    my $j = $poly_corners - 1;
    my $odd_nodes = FALSE;

    for (my $i=0; $i < $poly_corners; $i += 2) {
        if (($params->{'coordinates'}->[$i + 1] < $y && $params->{'coordinates'}->[$j + 1] >= $y || $params->{'coordinates'}->[$j + 1] < $y && $params->{'coordinates'}->[$i + 1] >= $y) && ($params->{'coordinates'}->[$i] <= $x || $params->{'coordinates'}->[$j] <= $x)) {
            $odd_nodes ^= ($params->{'coordinates'}->[$i] + ($y - $params->{'coordinates'}->[$i + 1]) / ($params->{'coordinates'}->[$j + 1] - $params->{'coordinates'}->[$i + 1]) * ($params->{'coordinates'}->[$j] - $params->{'coordinates'}->[$i]) < $x);
        }
        $j = $i;
    }
    return($odd_nodes);
}

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

    my @polyX;
    my @polyY;
    my %isNode;
    my $gradient = 0;
    my $pattern = '';
    my $saved    = $self->{'COLOR'};
    for (my $idx=0;$idx<scalar(@{$params->{'coordinates'}});$idx += 2) {
        push(@polyX,$params->{'coordinates'}->[$idx]);
        push(@polyY,$params->{'coordinates'}->[$idx + 1]);
        $isNode{$params->{'coordinates'}->[$idx] . ',' . $params->{'coordinates'}->[$idx + 1]} = 1;
    }
    my $poly_corners = scalar(@polyY);
    my $height = max(@polyY) - min(@polyY);
    my $width  = max(@polyX) - min(@polyX);
    if (exists($params->{'gradient'})) {
        if ($params->{'gradient'}->{'direction'} =~ /horizontal/i) {
            $pattern  = $self->_generate_horizontal_fill($width,$params->{'gradient'}->{'start'},$params->{'gradient'}->{'end'});
            $gradient = 2;
        } else {
            $sred     = $params->{'gradient'}->{'start'}->{'red'};
            $sgreen   = $params->{'gradient'}->{'start'}->{'green'};
            $sblue    = $params->{'gradient'}->{'start'}->{'blue'};
            $ered     = $params->{'gradient'}->{'end'}->{'red'};
            $egreen   = $params->{'gradient'}->{'end'}->{'green'};
            $eblue    = $params->{'gradient'}->{'end'}->{'blue'};
            @rc       = gradient($sred,   $ered,   $height);
            @gc       = gradient($sgreen, $egreen, $height);
            @bc       = gradient($sblue,  $eblue,  $height);
            $gradient = 1;
        }
    } ## end if (exists($p->{'gradient'...}))
    my $i     = 0;
    my $nodes = 0;
    foreach my $pixelY (min(@polyY) .. max(@polyY)) {
        my $nodes = 0;
        my $j     = $poly_corners - 1;
        my @nodeX = ();
        foreach $i (0 .. ($poly_corners-1)) {
            if (($polyY[$i] <= $pixelY && $polyY[$j] > $pixelY) || ($polyY[$j] <= $pixelY && $polyY[$i] > $pixelY)) {
                $nodeX[$nodes++] = int(($polyX[$i] + (($pixelY - $polyY[$i]) / ($polyY[$j] - $polyY[$i]) * ($polyX[$j] - $polyX[$i]))));
            }
            $j = $i;
        }
        @nodeX = sort(@nodeX);
        
        if ($gradient == 1) {
            $self->set_color({'red' => shift(@rc), 'green' => shift(@gc), 'blue' => shift(@bc)});
        }
        my $minX = min(@polyX);
        for ($i = 0; $i < $nodes; $i += 2) {
            if ($gradient == 2) {
                $self->blit_write(
                    {
                        'x'      => $nodeX[$i],
                        'y'      => $pixelY,
                        'width'  => $nodeX[$i + 1] - $nodeX[$i],
                        'height' => 1,
                        'image'  => substr($pattern,($nodeX[$i] - $minX) * $self->{'BYTES'},($nodeX[$i + 1] - $nodeX[$i]) * $self->{'BYTES'})
                    }
                );
            } else {
                $self->line(
                    {
                        'x'  => $nodeX[$i],
                        'y'  => $pixelY,
                        'xx' => $nodeX[$i + 1],
                        'yy' => $pixelY
                    }
                );
            }
        }
#            sleep .01; # For debugging
    }
    $self->{'COLOR'} = $saved;
}
            
sub _generate_horizontal_fill {
    my $self      = shift;
    my $width     = shift;
    my $start     = shift;
    my $end       = shift;

    my $gradient = '';
    my $sred   = $start->{'red'};
    my $sgreen = $start->{'green'};
    my $sblue  = $start->{'blue'};
    my $ered   = $end->{'red'};
    my $egreen = $end->{'green'};
    my $eblue  = $end->{'blue'};
    @rc     = gradient($sred,   $ered,   $width);
    @gc     = gradient($sgreen, $egreen, $width);
    @bc     = gradient($sblue,  $eblue,  $width);
    for (my $idx=0;$idx<scalar(@rc);$idx++) {
        if ($self->{'BITS'} == 32) {
            if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
                $gradient .= chr($bc[$idx]) . chr($gc[$idx]) . chr($rc[$idx]) . chr(255);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
                $gradient .= chr($bc[$idx]) . chr($rc[$idx]) . chr($gc[$idx]) . chr(255);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
                $gradient .= chr($rc[$idx]) . chr($gc[$idx]) . chr($bc[$idx]) . chr(255);
            } elsif ($self->{'COLOR_qORDER'} == $self->{'RBG'}) {
                $gradient .= chr($rc[$idx]) . chr($bc[$idx]) . chr($gc[$idx]) . chr(255);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
                $gradient .= chr($gc[$idx]) . chr($rc[$idx]) . chr($bc[$idx]) . chr(255);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
                $gradient .= chr($gc[$idx]) . chr($bc[$idx]) . chr($rc[$idx]) . chr(255);
            }
        } elsif ($self->{'BITS'} == 24) {
            if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
                $gradient .= chr($bc[$idx]) . chr($gc[$idx]) . chr($rc[$idx]);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
                $gradient .= chr($bc[$idx]) . chr($rc[$idx]) . chr($gc[$idx]);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
                $gradient .= chr($rc[$idx]) . chr($gc[$idx]) . chr($bc[$idx]);
            } elsif ($self->{'COLOR_qORDER'} == $self->{'RBG'}) {
                $gradient .= chr($rc[$idx]) . chr($bc[$idx]) . chr($gc[$idx]);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
                $gradient .= chr($gc[$idx]) . chr($rc[$idx]) . chr($bc[$idx]);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
                $gradient .= chr($gc[$idx]) . chr($bc[$idx]) . chr($rc[$idx]);
            }
        } elsif ($self->{'BITS'} == 16) {
            my $temp;
            if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
                $temp = $self->RGB_to_16({'color' => chr($bc[$idx]) . chr($gc[$idx]) . chr($rc[$idx])});
            } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
                $temp = $self->RGB_to_16({'color' => chr($bc[$idx]) . chr($rc[$idx]) . chr($gc[$idx])});
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
                $temp = $self->RGB_to_16({'color' => chr($rc[$idx]) . chr($gc[$idx]) . chr($bc[$idx])});
            } elsif ($self->{'COLOR_qORDER'} == $self->{'RBG'}) {
                $temp = $self->RGB_to_16({'color' => chr($rc[$idx]) . chr($bc[$idx]) . chr($gc[$idx])});
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
                $temp = $self->RGB_to_16({'color' => chr($gc[$idx]) . chr($rc[$idx]) . chr($bc[$idx])});
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
                $temp = $self->RGB_to_16({'color' => chr($gc[$idx]) . chr($bc[$idx]) . chr($rc[$idx])});
            }
            $gradient .= $temp->{'color'};
        }
    }
    return ($gradient);
} ## end sub _generate_fill

=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.  You may also add a gradient.

=over 2

 $fb->box({
    'x'          => 20,
    'y'          => 50,
    'xx'         => 70,
    'yy'         => 100,
    'rounded'    => 0, # optional
    'filled'     => 1, # optional
    'pixel_size' => 1, # optional
    'gradient'   => {  # optional
        'direction' => 'horizontal', # or vertical
        'start' => {
            'red'   => 128,
            'green' => 59,
            'blue'  => 0
        },
        'end'   => {
            'red'   => 0,
            'green' => 0,
            'blue'  => 255
        }
    }
 });

=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;
    my $radius = int($params->{'radius'}) || 0;
    $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 ($radius) {

        # Keep the radius sane
        $radius = ($xx - $x) / 2 if ((($xx - $x) / 2) < $radius);
        $radius = ($yy - $y) / 2 if ((($yy - $y) / 2) < $radius);

        my $p = $params;
        $p->{'radius'} = $radius;
        $p->{'x'}      = ($x + $radius);
        $p->{'y'}      = ($y + $radius);
        $p->{'xx'}     = ($xx - $radius);
        $p->{'yy'}     = ($yy - $radius);
        $p->{'bx'}     = $x;
        $p->{'by'}     = $y;
        $p->{'bxx'}    = $xx;
        $p->{'byy'}    = $yy;
        $self->circle($p);    # Yep, circle
    } elsif (exists($params->{'gradient'}) || !$filled) {
        $params->{'coordinates'} = [$x, $y, $xx, $y, $xx, $yy, $x, $yy];
        $self->polygon($params);
    } elsif ($filled) {
        my $X = $xx;
        my $Y = $yy;
        $x  = max($self->{'X_CLIP'}, min($self->{'XX_CLIP'}, $x));
        $y  = max($self->{'Y_CLIP'}, min($self->{'YY_CLIP'}, $y));
        $xx = max($self->{'X_CLIP'}, min($self->{'XX_CLIP'}, $xx));
        $yy = max($self->{'Y_CLIP'}, min($self->{'YY_CLIP'}, $yy));
        $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)});
        $self->{'X'} = $X;
        $self->{'Y'} = $Y;
    }
} ## 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. Gradients are also allowed.

=over 2

 $fb->rbox({
    'x'          => 100,
    'y'          => 100,
    'width'      => 200,
    'height'     => 150,
    'filled'     => 0, # optional
    'rounded'    => 0, # optional
    'pixel_size' => 2, # optional
    'gradient'   => {  # optional
        'direction' => 'horizontal', # or vertical
        'start' => {
            'red'   => 128,
            'green' => 59,
            'blue'  => 0
        },
        'end'   => {
            'red'   => 0,
            'green' => 0,
            'blue'  => 255
        }
    }
 });

=back
=cut

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

    my $x  = $params->{'x'};
    my $y  = $params->{'y'};
    my $w  = $params->{'width'};
    my $h  = $params->{'height'};
    my $xx = $x + $w;
    my $yy = $y + $h;
    $params->{'xx'} = $xx;
    $params->{'yy'} = $yy;
    $self->box($params);
} ## end sub rbox

=head2 set_color

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

Even if you are in 16 bit color mode, use 8 bit values.  They will be
automatically scaled.

=over 2

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

=back
=cut

sub set_color {
    my $self   = shift;
    my $params = shift;
    my $name   = shift || 'COLOR';

    my $R = int($params->{'red'}) & 255;
    my $G = int($params->{'green'}) & 255;
    my $B = int($params->{'blue'}) & 255;
    my $A = int($params->{'alpha'} || 255) & 255;

    if ($self->{'BITS'} == 32) {
        if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
            $self->{$name} = chr($B) . chr($G) . chr($R) . chr($A);
        } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
            $self->{$name} = chr($B) . chr($R) . chr($G) . chr($A);
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
            $self->{$name} = chr($R) . chr($G) . chr($B) . chr($A);
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
            $self->{$name} = chr($R) . chr($B) . chr($G) . chr($A);
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
            $self->{$name} = chr($G) . chr($R) . chr($B) . chr($A);
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
            $self->{$name} = chr($G) . chr($B) . chr($R) . chr($A);
        }
    } elsif ($self->{'BITS'} == 24) {
        if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
            $self->{$name} = chr($B) . chr($G) . chr($R);
        } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
            $self->{$name} = chr($B) . chr($R) . chr($G);
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
            $self->{$name} = chr($R) . chr($G) . chr($B);
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
            $self->{$name} = chr($R) . chr($B) . chr($G);
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
            $self->{$name} = chr($G) . chr($R) . chr($B);
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
            $self->{$name} = chr($G) . chr($B) . chr($R);
        }
    } elsif ($self->{'BITS'} == 16) {
        $R = $R >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'});
        $G = $G >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'});
        $B = $B >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'});
        if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
            $self->{$name} = pack('S', $B | ($G << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($R << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})));
        } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
            $self->{$name} = pack('S', $B | ($R << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($G << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})));
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
            $self->{$name} = pack('S', $R | ($G << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($B << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})));
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
            $self->{$name} = pack('S', $R | ($B << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | ($G << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})));
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
            $self->{$name} = pack('S', $G | ($R << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($B << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})));
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
            $self->{$name} = pack('S', $G | ($B << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | ($R << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})));
        }
    } ## end elsif ($self->{'BITS'} ==...)

    $self->{'I_COLOR'} = Imager::Color->new($R, $G, $B) if ($name eq 'COLOR');
} ## end sub set_color

=head2 set_foreground_color

Sets the drawing color in red, green, and blue, absolute values.
This is the same as 'set_color' above.

=over 2

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

=back
=cut

sub set_foreground_color {
    my $self = shift;
    $self->set_color(shift);
}

=head2 set_b_color

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

The same rules as set_color apply.

=over 2

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

=back
=cut

sub set_b_color {
    my $self = shift;
    $self->set_color(shift, 'B_COLOR');
}

=head2 set_background_color

Same as set_b_color

=cut

sub set_background_color {
    my $self = shift;
    $self->set_color(shift, 'B_COLOR');
}

=head2 pixel

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

=over 2

 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
 #    'alpha' => integer value, # 0 - 255
 #    'raw'   => 32bit value
 # }

=back
=cut

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

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

    # Values outside of the clipping area return undefined.
    unless (($x > $self->{'XX_CLIP'}) || ($y > $self->{'YY_CLIP'}) || ($x < $self->{'X_CLIP'}) || ($y < $self->{'Y_CLIP'})) {
        my ($color, $R, $G, $B, $A);
        $A = 255;
        my $index = ($self->{'BYTES_PER_LINE'} * ($y + $self->{'YOFFSET'})) + (($self->{'XOFFSET'} + $x) * $self->{'BYTES'});
        if ($self->{'FILE_MODE'}) {
            seek($fb, $index, 0);
            read($fb, $color, $self->{'BYTES'});
        } else {
            $color = substr($self->{'SCREEN'}, $index, $self->{'BYTES'});
        }
        if ($self->{'BITS'} == 32) {
            if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
                ($B, $G, $R, $A) = unpack('C4', $color);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
                ($B, $R, $G, $A) = unpack('C4', $color);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
                ($R, $G, $B, $A) = unpack('C4', $color);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
                ($R, $B, $G, $A) = unpack('C4', $color);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
                ($G, $R, $B, $A) = unpack('C4', $color);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
                ($G, $B, $R, $A) = unpack('C4', $color);
            }
        } else {
            my $C = unpack('S', $color);

            #            $color = pack('S', $C);
            if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
                $B = ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'} < 6) ? $C & 31 : $C & 63;
                $G = ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'} < 6) ? ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) & 31 : ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) & 63;
                $R = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'} < 6)   ? ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) & 31   : ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) & 63;
            } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
                $B = ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'} < 6) ? $C & 31 : $C & 63;
                $R = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'} < 6)   ? ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) & 31   : ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) & 63;
                $G = ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'} < 6) ? ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) & 31 : ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) & 63;
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
                $R = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'} < 6) ? $C & 31 : $C & 63;
                $G = ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'} < 6) ? ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) & 31 : ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) & 63;
                $B = ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'} < 6)  ? ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) & 31  : ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) & 63;
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
                $R = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'} < 6) ? $C & 31 : $C & 63;
                $B = ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'} < 6)  ? ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) & 31  : ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) & 63;
                $G = ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'} < 6) ? ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) & 31 : ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) & 63;
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
                $G = ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'} < 6) ? $C & 31 : $C & 63;
                $R = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'} < 6)  ? ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) & 31  : ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) & 63;
                $B = ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'} < 6) ? ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) & 31 : ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) & 63;
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
                $G = ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'} < 6) ? $C & 31 : $C & 63;
                $B = ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'} < 6) ? ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) & 31 : ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) & 63;
                $R = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'} < 6)  ? ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) & 31  : ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) & 63;
            }
            $R = $R << (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'});
            $G = $G << (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'});
            $B = $B << (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'});
        } ## end else [ if ($self->{'BITS'} ==...)]
        return ({'red' => $R, 'green' => $G, 'blue' => $B, 'alpha' => $A, 'raw' => $color});
    } ## end unless (($x > $self->{'XX_CLIP'...}))
    return (undef);
} ## end sub pixel

=head2 get_pixel

Returns the color of the pixel at coordinate x,y.
It is the same as 'pixel' above.

=over 2

 my $pixel = $fb->get_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
 #    'alpha' => integer value, # 0 - 255
 #    'raw'   => 32/24/16 bit value (depending on
 #               mode)
 # }

=back

=cut

sub get_pixel {
    my $self = shift;
    return ($self->pixel(shift));
}

=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.

=over 2

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

=back

=cut

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

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

    my %visited = ();
    my @queue   = ();

    my $pixel = $self->pixel({'x' => $x, 'y' => $y});
    my $back = $pixel->{'raw'};

    return if ($back eq $self->{'COLOR'});
    my $background = $back;

    push(@queue, [$x, $y]);

    while (scalar(@queue)) {
        my $pointref = shift(@queue);
        ($x, $y) = @{$pointref};
        next if (($x < $self->{'X_CLIP'}) || ($x > $self->{'XX_CLIP'}) || ($y < $self->{'Y_CLIP'}) || ($y > $self->{'YY_CLIP'}));
        unless (exists($visited{"$x,$y"})) {
            $pixel = $self->pixel({'x' => $x, 'y' => $y});
            $back = $pixel->{'raw'};
            if ($back eq $background) {
                $self->plot({'x' => $x, 'y' => $y});
                $visited{"$x,$y"}++;
                push(@queue, [$x + 1, $y]);
                push(@queue, [$x - 1, $y]);
                push(@queue, [$x,     $y + 1]);
                push(@queue, [$x,     $y - 1]);
            } ## end if ($back eq $background)
        } ## end unless (exists($visited{"$x,$y"...}))
    } ## end while (scalar(@queue))
} ## end sub fill

=head2 replace_color

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

=over 2

 $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'});

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

    if ($self->{'FILE_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});
                if (!$start && ($p->{'red'} == $old_r) && ($p->{'green'} == $old_g) && ($p->{'blue'} == $old_b)) {
                    $start = TRUE;
                    $sx    = $x;
                } elsif ($start && (!(($p->{'red'} == $old_r) && ($p->{'green'} == $old_g) && ($p->{'blue'} == $old_b)))) {
                    $start = FALSE;
                    $self->line({'x' => $sx, 'y' => $y, 'xx' => $x, 'yy' => $y});
                }
            } ## end for (my $x = $self->{'X_CLIP'...})
            if ($start) {
                $start = FALSE;
                $self->line({'x' => $sx, 'y' => $y, 'xx' => $x, 'yy' => $y});
            }
        } ## end for (my $y = $self->{'Y_CLIP'...})
    } else {    # YEEEEEEHAAAAAW!!!!
        my ($old, $new);
        if ($self->{'BITS'} == 32) {
            if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
                $old = sprintf('\x%02x\x%02x\x%02x.',    $old_b, $old_g, $old_r);
                $new = sprintf('\x%02x\x%02x\x%02x\xFF', $new_b, $new_g, $new_r);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
                $old = sprintf('\x%02x\x%02x\x%02x.',    $old_b, $old_r, $old_g);
                $new = sprintf('\x%02x\x%02x\x%02x\xFF', $new_b, $new_r, $new_g);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
                $old = sprintf('\x%02x\x%02x\x%02x.',    $old_r, $old_g, $old_b);
                $new = sprintf('\x%02x\x%02x\x%02x\xFF', $new_r, $new_g, $new_b);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
                $old = sprintf('\x%02x\x%02x\x%02x.',    $old_r, $old_b, $old_g);
                $new = sprintf('\x%02x\x%02x\x%02x\xFF', $new_r, $new_b, $new_g);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
                $old = sprintf('\x%02x\x%02x\x%02x.',    $old_g, $old_r, $old_b);
                $new = sprintf('\x%02x\x%02x\x%02x\xFF', $new_g, $new_r, $new_b);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
                $old = sprintf('\x%02x\x%02x\x%02x.',    $old_g, $old_b, $old_r);
                $new = sprintf('\x%02x\x%02x\x%02x\xFF', $new_g, $new_b, $new_r);
            }
        } elsif ($self->{'BITS'} == 24) {
            if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
                $old = sprintf('\x%02x\x%02x\x%02x', $old_b, $old_g, $old_r);
                $new = sprintf('\x%02x\x%02x\x%02x', $new_b, $new_g, $new_r);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
                $old = sprintf('\x%02x\x%02x\x%02x', $old_b, $old_r, $old_g);
                $new = sprintf('\x%02x\x%02x\x%02x', $new_b, $new_r, $new_g);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
                $old = sprintf('\x%02x\x%02x\x%02x.', $old_r, $old_g, $old_b);
                $new = sprintf('\x%02x\x%02x\x%02x',  $new_r, $new_g, $new_b);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
                $old = sprintf('\x%02x\x%02x\x%02x.', $old_r, $old_b, $old_g);
                $new = sprintf('\x%02x\x%02x\x%02x',  $new_r, $new_b, $new_g);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
                $old = sprintf('\x%02x\x%02x\x%02x.', $old_g, $old_r, $old_b);
                $new = sprintf('\x%02x\x%02x\x%02x',  $new_g, $new_r, $new_b);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
                $old = sprintf('\x%02x\x%02x\x%02x.', $old_g, $old_b, $old_r);
                $new = sprintf('\x%02x\x%02x\x%02x',  $new_g, $new_b, $new_r);
            }
        } elsif ($self->{'BITS'} == 16) {
            $old_b = $old_b >> (8 - ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'}));
            $old_g = $old_g >> (8 - ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'}));
            $old_r = $old_r >> (8 - ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'}));
            $new_b = $new_b >> (8 - ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'}));
            $new_g = $new_g >> (8 - ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'}));
            $new_r = $new_r >> (8 - ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'}));
            if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
                $old = pack('S', ($old_b | ($old_g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($old_r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}))));
                $new = pack('S', ($new_b | ($new_g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($new_r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}))));
            } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
                $old = pack('S', ($old_b | ($old_r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($old_g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}))));
                $new = pack('S', ($new_b | ($new_r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($new_g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}))));
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
                $old = pack('S', ($old_r | ($old_g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($old_b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}))));
                $new = pack('S', ($new_r | ($new_g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($new_b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}))));
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
                $old = pack('S', ($old_r | ($old_b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | ($old_g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}))));
                $new = pack('S', ($new_r | ($new_b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | ($new_g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}))));
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
                $old = pack('S', ($old_g | ($old_r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($old_b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}))));
                $new = pack('S', ($new_g | ($new_r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($new_b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}))));
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
                $old = pack('S', ($old_g | ($old_b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | ($old_r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}))));
                $new = pack('S', ($new_g | ($new_b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | ($new_r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}))));
            }
            $old = sprintf('\x%02x\x%02x', unpack('C2', $old));
            $new = sprintf('\x%02x\x%02x', unpack('C2', $new));
        } ## end elsif ($self->{'BITS'} ==...)
        if ($self->{'CLIPPED'}) {
            my $X_X = ($self->{'X_CLIP'} + $self->{'XOFFSET'}) * $self->{'BYTES'};
            my $len = ($self->{'XX_CLIP'} - $self->{'X_CLIP'}) * $self->{'BYTES'};
            map {
                my $idx = ($self->{'BYTES_PER_LINE'} * ($self->{'YOFFSET'} + $_)) + $X_X;
                eval("substr(\$self->{'SCREEN'},$idx,$len) =~ s/$old/$new/sg;");
            } ($self->{'Y_CLIP'} .. $self->{'YY_CLIP'});
        } else {
            eval("\$self->{'SCREEN'} =~ s/$old/$new/sg;");
        }
    } ## end else [ if ($self->{'FILE_MODE'...})]
    $self->{'DRAW_MODE'} = $old_mode;
    select($self->{'FB'});
    $| = 1;
} ## 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 2

 $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'});

    # If acceleration isn't working, then just set 'ACCELERATED' to zero.
    if ($self->{'ACCELERATED'} && $self->{'DRAW_MODE'} < 1) {
        # accelerated_blit_copy($self->{'FB'}, $x, $y, $w, $h, $xx, $yy);
    } else {
        $self->blit_write({%{$self->blit_read({'x' => $x, 'y' => $y, 'width' => $w, 'height' => $h})}, 'x' => $xx, 'y' => $yy});
    }
} ## end sub blit_copy

=head2 acceleration_disable

Disables all hardware acceleration.  Only needed if blit_copy
is not working.

Note, this is a placeholder for the future.  It really does nothing right
now.

=cut

sub acceleration_disable {
    my $self = shift;
    $self->{'vscreeninfo'}->{'accel_flags'} = FALSE;
    $self->{'vscreeninfo'}->{'accel'}       = FALSE;
    $self->{'ACCELERATED'}                  = FALSE;
} ## end sub acceleration_disable

=head2 blit_read

Reads in a square portion of screen data at x,y,width,height,
and returns a hash reference with information about the block,
including the raw data as a string, ready to be used with
'blit_write'.

=over 2

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

=back

Returns:

=over 2

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

=back

All you have to do is change X and Y, and just pass it to "blit_write"
and it will paste it there.

=cut

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

    my $fb = $self->{'FB'};
    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   = ($self->{'XOFFSET'} + $x) * $self->{'BYTES'};
    my ($index, $scrn, $line);
    map {
        $index = ($self->{'BYTES_PER_LINE'} * ($_ + $self->{'YOFFSET'})) + $XX;
        if ($self->{'FILE_MODE'}) {
            seek($fb, $index, 0);
            my $buf;
            read($fb, $buf, $W);
            $scrn .= $buf;
        } else {
            $scrn .= substr($self->{'SCREEN'}, $index, $W);
        }
    } ($y .. ($yend - 1));

    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.
Note, the "Mask" modes are slower, as it has to go pixel by pixel
to determine if it should or should not write it.

=over 2

 $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 $fb   = $self->{'FB'};
    my $x    = int($params->{'x'})      || 0;
    my $y    = int($params->{'y'})      || 0;
    my $w    = int($params->{'width'})  || 1;
    my $h    = int($params->{'height'}) || 1;
    my $scrn = $params->{'image'};
    my $scan = $w * $self->{'BYTES'};

    $w = $self->{'XRES'}               if ($w > $self->{'XRES'});
    $h = $self->{'YRES'}               if ($h > $self->{'YRES'});
    $w = ($self->{'XX_CLIP'} + 1) - $x if (($x + $w) > $self->{'XX_CLIP'});
    $h = ($self->{'YY_CLIP'} + 1) - $y if (($y + $h) > $self->{'YY_CLIP'});

    my $yend = $y + $h;
    if ($yend > $self->{'YY_CLIP'}) {
        $yend = $self->{'YY_CLIP'};
    } elsif ($yend < $self->{'Y_CLIP'}) {
        $yend = $self->{'Y_CLIP'};
    }
    return unless ($h);
    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'}) {
        $w += $x;
        $x = $self->{'X_CLIP'};
        $scan += $x;
    }
    if ($y < $self->{'Y_CLIP'}) {
        my $sindex = abs($y) * $WW;
        return if ($sindex >= length($scrn));
        $scrn = substr($scrn, (abs($y) * $WW));
        $yend += $y;
        $y = $self->{'Y_CLIP'};
    } ## end if ($y < $self->{'Y_CLIP'...})
    $idx = 0;
    $y    += $self->{'YOFFSET'};
    $yend += $self->{'YOFFSET'};
    my $max = $self->{'fscreeninfo'}->{'smem_len'} - $self->{'BYTES'};
    eval {
        for ($line = $y ; $line < $yend ; $line++) {
            $index = ($self->{'BYTES_PER_LINE'} * $line) + $X_X;
            if ($index >= 0 && $index <= $max && $idx >= 0 && $idx <= (length($scrn) - $self->{'BYTES'})) {
                if ($self->{'DRAW_MODE'} == $self->{'NORMAL_MODE'}) {
                    if ($self - {'FILE_MODE'}) {
                        seek($fb, $index, 0);
                        print $fb substr($scrn, $idx, $scan);
                    } else {
                        substr($self->{'SCREEN'}, $index, $scan) = substr($scrn, $idx, $scan);
                    }
                } elsif ($self->{'DRAW_MODE'} == $self->{'XOR_MODE'}) {
                    if ($self - {'FILE_MODE'}) {
                        seek($fb, $index, 0);
                        my $buf = '';
                        read($fb, $buf, $scan);
                        substr($buf, 0, $scan) ^= substr($scrn, $idx, $scan);
                        seek($fb, $index, 0);
                        print $fb $buf;
                    } else {
                        substr($self->{'SCREEN'}, $index, $scan) ^= substr($scrn, $idx, $scan);
                    }
                } elsif ($self->{'DRAW_MODE'} == $self->{'OR_MODE'}) {
                    if ($self - {'FILE_MODE'}) {
                        seek($fb, $index, 0);
                        my $buf = '';
                        read($fb, $buf, $scan);
                        substr($buf, 0, $scan) |= substr($scrn, $idx, $scan);
                        seek($fb, $index, 0);
                        print $fb $buf;
                    } else {
                        substr($self->{'SCREEN'}, $index, $scan) |= substr($scrn, $idx, $scan);
                    }
                } elsif ($self->{'DRAW_MODE'} == $self->{'ALPHA_MODE'}) {    # Alpha mode not yet implemented, use OR for now
                    if ($self - {'FILE_MODE'}) {
                        seek($fb, $index, 0);
                        my $buf = '';
                        read($fb, $buf, $scan);
                        substr($buf, 0, $scan) |= substr($scrn, $idx, $scan);
                        seek($fb, $index, 0);
                        print $fb $buf;
                    } else {
                        substr($self->{'SCREEN'}, $index, $scan) |= substr($scrn, $idx, $scan);
                    }
                } elsif ($self->{'DRAW_MODE'} == $self->{'AND_MODE'}) {
                    if ($self - {'FILE_MODE'}) {
                        seek($fb, $index, 0);
                        my $buf = '';
                        read($fb, $buf, $scan);
                        substr($buf, 0, $scan) &= substr($scrn, $idx, $scan);
                        seek($fb, $index, 0);
                        print $fb $buf;
                    } else {
                        substr($self->{'SCREEN'}, $index, $scan) &= substr($scrn, $idx, $scan);
                    }
                } elsif ($self->{'DRAW_MODE'} == $self->{'MASK_MODE'}) {
                    for ($px = 0 ; $px < $w ; $px++) {
                        unless ($px > $self->{'XX_CLIP'} || $px < $self->{'X_CLIP'}) {
                            $px4 = $px * $self->{'BYTES'};
                            if ($self - {'FILE_MODE'}) {
                                seek($fb, $index, 0);
                                read($fb, $data, $self->{'BYTES'});
                            } else {
                                $data = substr($self->{'SCREEN'}, ($index + $px4), $self->{'BYTES'}) || chr(0) x $self->{'BYTES'};
                            }
                            if ($self->{'BITS'} == 32) {
                                if (substr($scrn, ($idx + $px4), 3) . chr(255) ne $self->{'B_COLOR'}) {
                                    if ($self - {'FILE_MODE'}) {
                                        seek($fb, $index + $px4, 0);
                                        print $fb substr($scrn, ($idx + $px4), $self->{'BYTES'});
                                    } else {
                                        substr($self->{'SCREEN'}, ($index + $px4), $self->{'BYTES'}) = substr($scrn, ($idx + $px4), $self->{'BYTES'});
                                    }
                                } ## end if (substr($scrn, ($idx...)))
                            } elsif ($self->{'BITS'} == 24) {
                                if (substr($scrn, ($idx + $px4), 3) ne $self->{'B_COLOR'}) {
                                    if ($self - {'FILE_MODE'}) {
                                        seek($fb, $index + $px4, 0);
                                        print $fb substr($scrn, ($idx + $px4), $self->{'BYTES'});
                                    } else {
                                        substr($self->{'SCREEN'}, ($index + $px4), $self->{'BYTES'}) = substr($scrn, ($idx + $px4), $self->{'BYTES'});
                                    }
                                } ## end if (substr($scrn, ($idx...)))
                            } elsif ($self->{'BITS'} == 16) {
                                if (substr($scrn, ($idx + $px4), 2) ne $self->{'B_COLOR'}) {
                                    if ($self - {'FILE_MODE'}) {
                                        seek($fb, $index + $px4, 0);
                                        print $fb substr($scrn, ($idx + $px4), $self->{'BYTES'});
                                    } else {
                                        substr($self->{'SCREEN'}, ($index + $px4), $self->{'BYTES'}) = substr($scrn, ($idx + $px4), $self->{'BYTES'});
                                    }
                                } ## end if (substr($scrn, ($idx...)))
                            } ## end elsif ($self->{'BITS'} ==...)
                        } ## end unless ($px > $self->{'XX_CLIP'...})
                    } ## end for ($px = 0 ; $px < $w...)
                } elsif ($self->{'DRAW_MODE'} == $self->{'UNMASK_MODE'}) {
                    for ($px = 0 ; $px < $w ; $px++) {
                        unless ($px > $self->{'XX_CLIP'} || $px < $self->{'X_CLIP'}) {
                            $px4 = $px * $self->{'BYTES'};
                            if ($self - {'FILE_MODE'}) {
                                seek($fb, $index + $px4, 0);
                                read($fb, $data, $self->{'BYTES'});
                            } else {
                                $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'}) {
                                    if ($self - {'FILE_MODE'}) {
                                        seek($fb, $index + $px4, 0);
                                        print $fb substr($scrn, $idx + $px4, $self->{'BYTES'});
                                    } else {
                                        substr($self->{'SCREEN'}, ($index + $px4), $self->{'BYTES'}) = substr($scrn, ($idx + $px4), $self->{'BYTES'});
                                    }
                                } ## end if (substr($self->{'SCREEN'...}))
                            } elsif ($self->{'BITS'} == 24) {
                                if (substr($self->{'SCREEN'}, ($index + $px4), 3) eq $self->{'B_COLOR'}) {
                                    if ($self - {'FILE_MODE'}) {
                                        seek($fb, $index + $px4, 0);
                                        print $fb substr($scrn, $idx + $px4, $self->{'BYTES'});
                                    } else {
                                        substr($self->{'SCREEN'}, ($index + $px4), $self->{'BYTES'}) = substr($scrn, ($idx + $px4), $self->{'BYTES'});
                                    }
                                } ## end if (substr($self->{'SCREEN'...}))
                            } elsif ($self->{'BITS'} == 16) {
                                if (substr($self->{'SCREEN'}, ($index + $px4), 2) eq $self->{'B_COLOR'}) {
                                    if ($self - {'FILE_MODE'}) {
                                        seek($fb, $index + $px4, 0);
                                        print $fb substr($scrn, $idx + $px4, $self->{'BYTES'});
                                    } else {
                                        substr($self->{'SCREEN'}, ($index + $px4), $self->{'BYTES'}) = substr($scrn, ($idx + $px4), $self->{'BYTES'});
                                    }
                                } ## end if (substr($self->{'SCREEN'...}))
                            } ## end elsif ($self->{'BITS'} ==...)
                        } ## end unless ($px > $self->{'XX_CLIP'...})
                    } ## end for ($px = 0 ; $px < $w...)
                } ## end elsif ($self->{'DRAW_MODE'...})
                $idx += $WW;
            } ## end if ($index >= 0 && $index...)
        } ## end for ($line = $y ; $line...)
        select($self->{'FB'});
        $| = 1;
    };
    my $error = $@;
    print STDERR "$error\n" if ($error && $self->{'SHOW_ERRORS'});
    $self->_fix_mapping() if ($@);
} ## end sub blit_write

=head2 clip_reset

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

=over 2

 $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'} = FALSE;                   # This is merely a flag to see if a clipping
    # region is defined in other code.
} ## end sub clip_reset

=head2 clip_off

Turns off clipping, and resets the clipping values to the full
size of the screen.  It is the same as clip_reset.

=over 2

 $fb->clip_off();

=back
=cut

sub clip_off {
    my $self = shift;
    $self->clip_reset();
}

=head2 clip_set

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

=over 2

 $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'}  = abs(int($params->{'x'}));
    $self->{'Y_CLIP'}  = abs(int($params->{'y'}));
    $self->{'XX_CLIP'} = abs(int($params->{'xx'}));
    $self->{'YY_CLIP'} = abs(int($params->{'yy'}));

    $self->{'X_CLIP'}  = ($self->{'XRES'} - 2) if ($self->{'X_CLIP'} > ($self->{'XRES'} - 1));
    $self->{'Y_CLIP'}  = ($self->{'YRES'} - 2) if ($self->{'Y_CLIP'} > ($self->{'YRES'} - 1));
    $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'} = TRUE;
} ## end sub clip_set

=head2 clip_rset

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

=over 2

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

=back
=cut

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

    $params->{'xx'} = $params->{'x'} + $params->{'width'};
    $params->{'yy'} = $params->{'y'} + $params->{'height'};

    $self->clip_set($params);
} ## end sub clip_rset

=head2 monochrome

Removes all color information from an image, and leaves everything in
greyscale.

=over 2

 Expects two parameters, 'image' and 'bits'.  'image' is a string containing
 the image data.  'bits' is how many bits per pixel make up the image.  Valid
 values are 16, 24, and 32 only.

 It returns 'image' back, but now in greyscale (still the same RGB formnat
 though), ready for using with 'blit_write' (provided it is the same format
 for the screen).

=back
=cut

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

    my ($r, $g, $b);

    my $inc;
    if ($params->{'bits'} == 32) {
        $inc = 4;
    } elsif ($params->{'bits'} == 24) {
        $inc = 3;
    } elsif ($params->{'bits'} == 16) {
        $inc = 2;
    } else {    # Only 32, 24, or 16 bits allowed
        return ();
    }

    for (my $byte = 0 ; $byte < length($params->{'image'}) ; $byte += $inc) {
        if ($inc == 2) {
            my $A = unpack('S', substr($params->{'image'}, $byte, $inc));
            if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
                $b = ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'} == 5)  ? $A & 31 : $A & 63;
                $g = ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'} == 5) ? $A & 31 : $A & 63 >> ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'});
                $r = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'} == 5)   ? $A & 31 : $A & 63 >> ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'});
                my $mono = int(0.2126 * $r + 0.7152 * $g + 0.0722 * $b);
                substr($params->{'image'}, $byte, 2) = pack('S', ($mono << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($mono << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | $mono);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
                $b = ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'} == 5)  ? $A & 31 : $A & 63;
                $r = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'} == 5)   ? $A & 31 : $A & 63 >> ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'});
                $g = ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'} == 5) ? $A & 31 : $A & 63 >> ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'});
                my $mono = int(0.2126 * $r + 0.7152 * $g + 0.0722 * $b);
                substr($params->{'image'}, $byte, 2) = pack('S', ($mono << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($mono << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | $mono);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
                $r = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'} == 5)   ? $A & 31 : $A & 63;
                $g = ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'} == 5) ? $A & 31 : $A & 63 >> ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'});
                $b = ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'} == 5)  ? $A & 31 : $A & 63 >> ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'});
                my $mono = int(0.2126 * $r + 0.7152 * $g + 0.0722 * $b);
                substr($params->{'image'}, $byte, 2) = pack('S', ($mono << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($mono << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | $mono);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
                $r = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'} == 5)   ? $A & 31 : $A & 63;
                $b = ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'} == 5)  ? $A & 31 : $A & 63 >> ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'});
                $g = ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'} == 5) ? $A & 31 : $A & 63 >> ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'});
                my $mono = int(0.2126 * $r + 0.7152 * $g + 0.0722 * $b);
                substr($params->{'image'}, $byte, 2) = pack('S', ($mono << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | ($mono << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | $mono);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
                $g = ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'} == 5) ? $A & 31 : $A & 63;
                $r = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'} == 5)   ? $A & 31 : $A & 63 >> ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'});
                $b = ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'} == 5)  ? $A & 31 : $A & 63 >> ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'});
                my $mono = int(0.2126 * $r + 0.7152 * $g + 0.0722 * $b);
                substr($params->{'image'}, $byte, 2) = pack('S', ($mono << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($mono << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | $mono);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
                $g = ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'} == 5) ? $A & 31 : $A & 63;
                $b = ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'} == 5)  ? $A & 31 : $A & 63 >> ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'});
                $r = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'} == 5)   ? $A & 31 : $A & 63 >> ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'});
                my $mono = int(0.2126 * $r + 0.7152 * $g + 0.0722 * $b);
                substr($params->{'image'}, $byte, 2) = pack('S', ($mono << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | ($mono << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | $mono);
            } ## end elsif ($self->{'COLOR_ORDER'...})
        } else {
            if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
                ($b, $g, $r) = unpack('C3', substr($params->{'image'}, $byte, 3));
            } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
                ($b, $r, $g) = unpack('C3', substr($params->{'image'}, $byte, 3));
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
                ($r, $g, $b) = unpack('C3', substr($params->{'image'}, $byte, 3));
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
                ($r, $b, $g) = unpack('C3', substr($params->{'image'}, $byte, 3));
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
                ($g, $r, $b) = unpack('C3', substr($params->{'image'}, $byte, 3));
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
                ($g, $b, $r) = unpack('C3', substr($params->{'image'}, $byte, 3));
            }
            my $mono = int(0.2126 * $r + 0.7152 * $g + 0.0722 * $b);
            substr($params->{'image'}, $byte, 3) = pack('C3', $mono, $mono, $mono);
        } ## end else [ if ($inc == 2) ]
    } ## end for (my $byte = 0 ; $byte...)
    return ($params->{'image'});
} ## end sub monochrome

=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' (using the Imager library as its
engine).

Note, 'y' is the baseline position, not the top left of the bounding box.  This
is a change from before!!!

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.

If you are trying to print on top of other graphics, then normal drawing mode
would not be the best choice, even though it is the fastest.  Mask mode would
visually be the best choice.  However, it's also the slowest.  Experiment with
AND, OR, and XOR modes instead.

=over 2

 my $bounding_box = $fb->ttf_print({
     'x'            => 20,
     'y'            => 100, # baseline position
     'height'       => 16,
     'color'        => 'FFFF00', # Hex value of color 00-FF (RRGGBB)
     'text'         => 'Hello World!',
     'font_path'    => '/usr/share/fonts/truetype',
     'face'         => 'Arial.ttf',
     'bounding_box' => 1,
     'center'       => $fb->{'CENTER_X'},
     'antialias'    => 1
 });

 $fb->ttf_print($bounding_box);

=back

Here's a shortcut:

=over 2

 $fb->ttf_print(
     $fb->ttf_print({
         'x'            => 20,
         'y'            => 100, # baseline position
         'height'       => 16,
         'color'        => 'FFFF00', # Yellow
         'text'         => 'Hello World!',
         'font_path'    => '/usr/share/fonts/truetype',
         'face'         => 'Arial.ttf',
         'bounding_box' => 1,
         'center'       => $fb->{'CENTER_X'},
         'antialias'    => 1
     })
 );

=back

Failures of this method are usually due to it not being able to find the
font.  Make sure you have the right path and name.

Some versions of Imager have a bug that strips off the path and only reads
the font from the root path.  This is stupid, yes, but the best way to fix
it is either get a fixed version of Imager, or simply create a symbolic
link in '/' to your font file.

This works best in 24 or 32 color modes.  If you are running in 16 bit mode,
then output will be slower, as Imager only works in bit modes >= 24; and this
module has to convert its output to your device's 16 bit colors.  Which means the
larger the characters and wider the string, the longer it will take to display.
The splash screen is an excellent example of this behavior.  In 24/32 bit modes
the text is instantly displayed, but in 16 bit mode the text takes a bit of time
to display, as it has to convert it to 16 bit mode.

=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'})       || 0;
    my $TTF_y       = int($params->{'y'})       || 0;
    my $TTF_pw      = int($params->{'pwidth'})  || 0;
    my $TTF_ph      = int($params->{'pheight'}) || 6;
    my $TTF_h       = int($params->{'height'})  || 6;
    my $P_color     = $params->{'color'}        || 'FFFFFF';
    my $text        = $params->{'text'}         || ' ';
    my $face        = $params->{'face'}         || $self->{'FONT_FACE'};
    my $box_mode    = $params->{'bounding_box'} || FALSE;
    my $center_mode = $params->{'center'}       || 0;
    my $font_path   = $params->{'font_path'}    || $self->{'FONT_PATH'};
    my $aa          = $params->{'antialias'}    || FALSE;
    my $sizew       = $TTF_h;
    $sizew *= $params->{'wscale'} if (exists($params->{'wscale'}) && defined($params->{'wscale'}));
    my $pfont = "$font_path/$face";

    $pfont =~ s#//#/#g;

    my ($data, $font, $neg_width, $global_descent, $pos_width, $global_ascent, $descent, $ascent, $advance_width, $right_bearing);
    unless ($self->{'BITS'} == 16) {
        my ($red, $green, $blue) = (substr($P_color, 0, 2), substr($P_color, 2, 2), substr($P_color, 4, 2));
        if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
            $P_color = $blue . $green . $red;
        } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
            $P_color = $blue . $red . $green;
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
            $P_color = $red . $blue . $green;
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
            $P_color = $green . $red . $blue;
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
            $P_color = $green . $blue . $red;
        }
    } ## end unless ($self->{'BITS'} ==...)

    $font = Imager::Font->new(
        'file'  => $pfont,
        'color' => '#' . $P_color,
        'size'  => $TTF_h
    );
    if (!defined($font)) {
        print STDERR "Can't initialize Imager::Font!\n", Imager->errstr(), "\n" if ($self->{'SHOW_ERRORS'});
        return (undef);
    }

    eval {($neg_width, $global_descent, $pos_width, $global_ascent, $descent, $ascent, $advance_width, $right_bearing) = $font->bounding_box('string' => $text, 'canon' => 1, 'size' => $TTF_h, 'sizew' => $sizew);};
    if ($@) {
        print STDERR "$@\n", Imager->errstr() if ($self->{'SHOW_ERRORS'});
        return (undef);
    }
    $params->{'pwidth'}       = $advance_width;
    $params->{'pheight'}      = abs($global_ascent) + abs($global_descent) + 12;    # int($TTF_h + $global_ascent + abs($global_descent));
    $params->{'bounding_box'} = FALSE;
    $TTF_pw                   = abs($advance_width);
    if ($box_mode) {
        return ($params);
    } elsif ($center_mode == $self->{'CENTER_XY'}) {
        $TTF_x = int((($self->{'XX_CLIP'} - $self->{'X_CLIP'}) - $TTF_pw) / 2) + $self->{'X_CLIP'};
        $TTF_y = int((($self->{'YY_CLIP'} - $self->{'Y_CLIP'}) - $TTF_ph) / 2) + abs($global_ascent);
    } elsif ($center_mode == $self->{'CENTER_X'}) {
        $TTF_x = int((($self->{'XX_CLIP'} - $self->{'X_CLIP'}) - $TTF_pw) / 2) + $self->{'X_CLIP'};
    } elsif ($center_mode == $self->{'CENTER_Y'}) {
        $TTF_y = int((($self->{'YY_CLIP'} - $self->{'Y_CLIP'}) - $TTF_ph) / 2) + abs($global_ascent);
    }
    eval {
        my $img = Imager->new(
            'xsize'    => $TTF_pw,
            'ysize'    => $TTF_ph,    # * 2),
            'channels' => max(3,$self->{'BYTES'})
        );

        $img->string(
            'font'  => $font,
            'text'  => $text,
            'x'     => 0,
            'y'     => abs($global_ascent) + 6,
            'size'  => $TTF_h,
            'sizew' => $sizew,
            'color' => '#' . $P_color,
            'aa'    => $aa
        );

        $img->write(
            'type'          => 'raw',
            'storechannels' => max(3, $self->{'BYTES'}),    # Must be at least 24 bit
            'interleave'    => FALSE,
            'data'          => \$data
        );
    };
    if ($@) {
        print STDERR "ERROR $@\n", Imager->errstr() if ($self->{'SHOW_ERRORS'});
        return (undef);
    }

    $data = $self->_convert_24_to_16($data) if ($self->{'BITS'} == 16);

    $self->blit_write({'x' => $TTF_x, 'y' => ($TTF_y - abs($global_ascent)), 'width' => $TTF_pw, 'height' => $TTF_ph, 'image' => $data});

    return ($params);
} ## 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);
} ## end sub get_face_name

=head2 load_image

Loads an image at point x,y[,width,height].  To display it, pass it
to blit_write.

If you leave out x,y, it automatically centers it.  Although I recommend
using the centering options.  The position to display the image is part
of what is returned, and is ready for blitting.

If 'width' and/or 'height' is given, the image is resized.  Note, resizing
is CPU intensive.  Nevertheless, this is done by the Imager library
(compiled C) so it is fast.

=over 2

 $fb->blit_write(
     $fb->load_image(
         {
             'x'          => 0,    # Optional (only applies if
                                   # CENTER_X or CENTER_XY is not
                                   # used)

             'y'          => 0,    # Optional (only applies if
                                   # CENTER_Y or CENTER_XY is not
                                   # used)

             'width'      => 1920, # Optional. Resizes to this maximum
                                   # width (always [proportional) It
                                   # fits the image to this size.

             'height'     => 1080, # Optional. Resizes to this maximum
                                   # height (always proportional) It
                                   # fits the image to this size

             'scale_type' => 'min',# Optional. Sets the type of scaling
                                   #
                                   #  'min'     = The smaller of the two
                                   #              sizes are used (default)
                                   #  'max'     = The larger of the two
                                   #              sizes are used
                                   #  'nonprop' = Non-proportional sizing
                                   #              The image is scaled to
                                   #              width x height exactly.

             'autolevels' => 0,    # Optional.  It does a color
                                   # correction. Sometimes this
                                   # works well, and sometimes it
                                   # looks quite ugly.  It depends
                                   # on the image

             'center'     => $fb->{'CENTER_XY'},
                                   # Three centering options are available
                                   #  CENTER_X  = center horizontally
                                   #  CENTER_Y  = center vertically
                                   #  CENTER_XY = center horizontally and
                                   #              vertically.  Placing it
                                   #              right in the middle of
                                   #              the screen.

             'file'       => 'RWBY_Faces.png' # Usually needs full path
         }
     )
 );

=back

It returns a reference to an anonymous hash, of the format:

=over 2

 {
      'x'           => horizontal position calculated (or passed through),

      'y'           => vertical position calculated (or passed through),

      'width'       => Width of the image,

      'height'      => Height of the image,

      'orientation' => The image is autorotated if there is
                       orientation information. This is the
                       orientation value given from the image's
                       metadata.

      'image'       => [raw image data]
 }

=back
=cut

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

    my $img = Imager->new('file' => $params->{'file'});    # Set up a 24 bit buffer
    unless (defined($img)) {
        warn "I can't get Imager to set up an image buffer!\n", Imager->errstr(), "\n" if ($self->{'SHOW_ERRORS'});
    } else {                                                                # if ($img->read('file' => $params->{'file'}, 'allow_incomplete' => TRUE)) {
        my $orientation = $img->tags('name' => 'exif_orientation');
        if (defined($orientation) && $orientation) {                        # Automatically rotate the image
            if ($orientation == 3) {                                        # 180
                $img = $img->rotate('degrees' => 180);
            } elsif ($orientation == 6) {                                   # -90
                $img = $img->rotate('degrees' => 90);
            } elsif ($orientation == 8) {                                   # 90
                $img = $img->rotate('degrees' => -90);
            }
        } ## end if (defined($orientation...))
        # Sometimes it works great, sometimes it looks uuuuuugly
        $img->filter('type' => 'autolevels') if ($params->{'autolevels'});

        my ($xs, $ys, $w, $h, %scale);
        $w           = int($img->getwidth());
        $h           = int($img->getheight());
		my $channels = $img->getchannels();
        my $bits     = $img->bits();

        # Scale the image, if asked to
        if ((defined($params->{'width'}) && $params->{'width'} <=> $w) || (defined($params->{'height'}) && $params->{'height'} <=> $h)) {
            $params->{'width'}  = int($params->{'width'});
            $params->{'height'} = int($params->{'height'});
            unless ($w == $params->{'width'} && $h == $params->{'height'}) {
                $scale{'xpixels'} = $params->{'width'};
                $scale{'ypixels'} = $params->{'height'};
                $scale{'type'}    = $params->{'scale_type'} || 'min';
                ($xs, $ys, $w, $h) = $img->scale_calculate(%scale);
                $w = int($w);
                $h = int($h);

                $img = $img->scale(%scale);
            } ## end unless ($w == $params->{'width'...})
        } ## end if ((defined($params->...)))
        $w = int($img->getwidth());
        $h = int($img->getheight());
        my $data = '';
        if ($self->{'BITS'} >= 24) {
            if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
                $img = $img->convert('matrix' => [[0, 0, 1], [0, 1, 0], [1, 0, 0]]);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
                $img = $img->convert('matrix' => [[0, 0, 1], [1, 0, 0], [0, 1, 0]]);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
                $img = $img->convert('matrix' => [[1, 0, 0], [0, 0, 1], [0, 1, 0]]);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
                $img = $img->convert('matrix' => [[0, 1, 0], [1, 0, 0], [0, 0, 1]]);
            } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
                $img = $img->convert('matrix' => [[0, 1, 0], [0, 0, 1], [1, 0, 0]]);
            }
			$channels = $img->getchannels();
            if ($self->{'BITS'} == 32) {

                # Convert it to 32 bit
                $img = $img->convert('preset' => 'addalpha') if ($channels == 3);

                $img->write(
                    'type'          => 'raw',
                    'interleave'    => 0,
                    'datachannels'  => 4,
                    'storechannels' => 4,
                    'data'          => \$data
                );
            } else {
                $img = $img->convert('preset' => 'noalpha') if ($channels == 4);
                $img->write(
                    'type'          => 'raw',
                    'interleave'    => 0,
                    'datachannels'  => 3,
                    'storechannels' => 3,
                    'data'          => \$data
                );
            } ## end else [ if ($self->{'BITS'} ==...)]
        } else {    # 16 bit
            $img = $img->convert('preset' => 'noalpha') if ($channels == 4);
            $img->write(
                'type'          => 'raw',
                'interleave'    => 0,
                'datachannels'  => 3,
                'storechannels' => 3,
                'data'          => \$data
            );
            $data = $self->_convert_24_to_16($data);
        } ## end else [ if ($self->{'BITS'} >=...)]

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

        return (    # return it in a form the blit routines can dig
            {
                'x'           => $x,
                  'y'           => $y,
                  'width'       => $w,
                  'height'      => $h,
                  'image'       => $data,
                  'orientation' => $orientation
            }
        );
    } ## end else
    return(undef);
} ## end sub load_image

sub _convert_24_to_16 {
    my $self = shift;
    my $img  = shift;
    my $size = length($img);

    my $new_img = '';
    my $black24 = chr(0) x 3;
    my $black16 = chr(0) x 2;
    my $white24 = chr(255) x 3;
    my $white16 = chr(255) x 2;
    for (my $idx = 0 ; $idx < $size ; $idx += 3) {
        my $color = substr($img, $idx, 3);

        # Black and white can be optimized
        if ($color eq $black24) {
            $new_img .= $black16;
        } elsif ($color eq $white24) {
            $new_img .= $white16;
        } else {
            $color = $self->RGB_to_16({'color' => $color});
            $new_img .= $color->{'color'};
        }
    } ## end for (my $idx = 0 ; $idx...)
    return ($new_img);
} ## end sub _convert_24_to_16

=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.  It's up to you to save it in a  #
    # specific format after.                                                     #
    ##############################################################################
    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.  There is only
one parameter, 'color' and it must contain a bit encoded 24 bit string.
It returns 'color' converted to an encoded 16 bit string.

This is generally never needed by the programmer, as it is used internally, but
it is exposed here just in case you want to use it.

=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.  RGB888 -> RGB565           #
    ##############################################################################

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

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

    my $n_data;
    if ($big_data ne '') {
        my $pixel_data = substr($big_data, 0, 3);
        my ($r, $g, $b) = unpack('C3', $pixel_data);
        $r = $r >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'});
        $g = $g >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'});
        $b = $b >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'});
        my $color;
        if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
            $color = $b | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}));
        } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
            $color = $b | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}));
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
            $color = $r | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}));
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
            $color = $r | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}));
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
            $color = $g | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}));
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
            $color = $g | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}));
        }
        $n_data .= pack('S', $color);
    } ## end if ($big_data ne '')
    return ({'color' => $n_data});
} ## end sub RGB_to_16

=head2 RGBA_to_16

Converts 32 bit color values to 16 bit color values.  There is only
one parameter, 'color' and it must contain a bit encoded 32 bit string.
It returns 'color' converted to an encoded 16 bit string.

This is generally never needed by the programmer, as it is used internally, but
it is exposed here just in case you want to use it.

=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.  RGB888A -> RGB565                                                #
    ##############################################################################
    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 ($r, $g, $b, $a);
        if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
            ($b, $g, $r, $a) = unpack('L', $pixel_data);
        } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
            ($b, $r, $g, $a) = unpack('L', $pixel_data);
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
            ($r, $g, $b, $a) = unpack('L', $pixel_data);
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
            ($r, $b, $g, $a) = unpack('L', $pixel_data);
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
            ($g, $r, $b, $a) = unpack('L', $pixel_data);
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
            ($g, $b, $r, $a) = unpack('L', $pixel_data);
        }

        $r = $r >> $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'};
        $g = $g >> $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'};
        $b = $b >> $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'};
        my $color;
        if ($self->{'COLOR_ORDER'} == $self->{'BGR'}) {
            $color = $b | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}));
        } elsif ($self->{'COLOR_ORDER'} == $self->{'BRG'}) {
            $color = $b | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}));
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RGB'}) {
            $color = $r | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}));
        } elsif ($self->{'COLOR_ORDER'} == $self->{'RBG'}) {
            $color = $r | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}));
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GRB'}) {
            $color = $g | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}));
        } elsif ($self->{'COLOR_ORDER'} == $self->{'GBR'}) {
            $color = $g | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}));
        }
        $n_data .= pack('S', $color);
    } ## end while ($big_data ne '')
    return ({'color' => $n_data});
} ## end sub RGBA_to_16

=head2 RGB_to_RGBA

Converts 24 bit color to 32 bit color

Converts 24 bit color values to 32 bit color values.  There is only
one parameter, 'color' and it must contain a bit encoded 24 bit string.
It returns 'color' converted to an encoded 32 bit string with a
maximized alpha channel.

This is generally never needed by the programmer, as it is used internally, but
it is exposed here just in case you want to use it.

=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});
} ## end sub RGB_to_RGBA

## Just standard flat subroutines

sub _get_ioctl {
    ##########################################################
    ##                    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_ioctl

sub _set_ioctl {
    ##########################################################
    ##                    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);
    return (ioctl($fb, $command, $data));
} ## end sub _set_ioctl

1;

__END__

=head1 USAGE HINTS

=head2 PERL OPTIMIZATION

This module is highly CPU dependent.  So the more optimized your Perl
installation is, the faster it will run.

=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 to use, and it will work just fine!

See the "examples" directory for "threadstest.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 FORKS

I have never tested with forks.  Do at your own risk, but follow
the same rules as in threads, and it should work.

=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 SPRITES

Someone asked me about sprites.  Well, that's what blitting is
for.  You'll have to do your own collision detection.

=head2 HORIZONTAL "MAGIC"

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

=head2 PIXEL SIZE

Pixel sizes over 1 utilize a filled "box" or "circle" (negative
numbers for circle) to do the drawing.  This is why the larger
the "pixel", the slower the draw.

=head2 MAKING WINDOWS

So, you want to be able to manage some sort of windows...

You just instantiate a new instance of the module per
"Window" and give it its own clipping region.  This region is
your drawing space for your window.

It is up to you to actually decorate (draw) the windows.

Perhaps in the future I may add windowing ability, but not
right now, as it can be pretty involved (especially redraw
tracking and event managing).

Nothing is preventing you from writing your own window handler.

=head2 RUNNING IN MICROSOFT WINDOWS

It doesn't work natively, (other than in emulation mode) and
never will.  However...

You can run Linux inside VirtualBox and it works fine.  Put it
in full screen mode, and voila, it's "running in Windows" in an
indirect kinda sorta way.  Make sure you install the VirtualBox
extensions, as it has the correct video driver for framebuffer
access.  It's as close as you'll ever get to get it running in
MS Windows.  Seriously... EVER.

This isn't a design choice nor preference.  It's simply because
of the fact MS Windows does not allow file mapping of the
display, nor variable memory mapping of the display.  Both
techniques this module uses to achieve its magic.  DirectX is
more like OpenGL in how it works, and thus defeats the purpose of
this module.  You're better off with SDL instead, if you want to
draw in MS Windows from Perl.

However, if someone knows how to access the framebuffer in
MS Windows, and be able to do it reasonable from within Perl,
then send me instructions on how to do it, and I'll do my best
to get it to work.

=head1 TROUBLESHOOTING

Ok, you've installed the module, but can't seem to get it to
work properly.  Here  are some things you can try:

** make sure you turn on the "SHOW_ERRORS" paramentere
when calling "new" to create the object.  This helps with
troubleshooting.

=over 2

=item B< You Have To Run From The Console >

A console window doesn't count as "the console".  You cannot
use this module from within X-Windows.  It won't work, and
likely will only go into emulation mode if you do, or maybe
crash, or even corrupt your X-Windows screen.

If you want to run your program within X-Windows, then you
have the wrong module.  Use SDL or GTK or something similar.

You HAVE to have a framebuffer based video driver for this to
work.  The device ("/dev/fb0" for example) must exist.

If it does exist, but is not "/dev/fb0", then you can define
it in the 'new' method with the "FB_DEVICE" parameter.

=item B< It Just Plain Isn't Working >

Well, either your system doesn't have a framebuffer driver,
or perhaps the module is getting confusing data back from it
and can't properly initialize.

First, make sure your system has a framebuffer by seeing if
"/dev/fb0" (actually "fb" then any number).  If you don't
see any "fb0" - "fb31" files inside "/dev", then you don't
have a framebuffer driver running.  You need to fix that
first.

Second, ok, you have a framebuffer driver, but nothing is
showing, or it's all funky looking.  Now make sure you have
the program "fbset" installed.  It's used as a last resort
by this module to figure out how to draw on the screen when
all else fails.  To see if you have "fbset" installed, just
type "fbset -i" and it should show you information about
the framebuffer.  If you get an error, then you need to
install "fbset".

=item B< The Text Cursor Is Messing Things Up >

It is?  Well then turn it off.  Use the $obj->cls('OFF')
method to do it.  Use $obj->cls('ON') to turn it back on.

If your script exits without turning the cursor back on,
then it will still be off.  To get your cursor back, just
type the command "reset".

=item B< TrueType Printing isn't working >

This is likely caused by the Imager library either being
unable to locate the font file, or when it was compiled,
it couldn't find the FreeType development libraries, and was
thus compiled without TrueType text support.

See the README file for instructions on getting Imager
properly compiled.

=item B< It's Too Slow >

Ok, it does say a PERL graphics library in the description,
if I am not mistaken.  This means Perl is doing all the work.
This also means it is only as fast as your system and its CPU.

You could try recompiling Perl with optimizations specific to
your hardware.  That can help.

You can also try simplifying your drawing to exploit the speed
of horizontal lines.  Horizonal line drawing is incredibly fast,
even for very slow systems.

Only use pixel sizes of 1.  Anything larger requires a box to be
drawn at the pixel size you asked for.  Pixel sizes of 1 only use
plot to draw, no boxes, so it is much faster.

Drawing thick vertical lines?  Try instead drawing thin boxes of
the same size.  One large (even skinny) box draws faster than a
vertical line is drawn.

Try using 'polygon' to draw complex shapes instead of a series of
plot or line commands.

Does your device have more than one core?  Well, how about using
threads?  Just make sure you do it according to the example in
the "examples" directory.

=item B< Ask For Help >

If none of these ideas work, then send me an email, and I may be
able to get it functioning for you.  I may have you run the
"dump.pl" script in the "examples" directory.  So you might as
well send me the output of that anyway:

 perl dump.pl > dump.txt

=back

=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 5.37 (August 31, 2015)

=head1 THANKS

My thanks go out to those using this module and submitting helpful
patches and suggestions for improvement, as well as those who asked
for help.

=head1 TELL ME ABOUT YOUR PROJECT

I'd love to know if you aree using this library in your project.
So send me an email, with pictures and/or a URL (if you have one)
showing what it is.  If you have a YouTube video, then that would
be cool to see too.

=cut
