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, 'alpha' => 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});

 # ... and many many more

=head1 DESCRIPTION

A (mostly) Perl graphics library for exclusive use in a Linux/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 nCurses library, and I did not want the overhead of the X-Windows 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 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, merge, rotate, 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 RGB 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 6

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.

NOTE:  The packaged version of Imager for your distribution should always work.

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 6

 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 should be running this module in for the fastest speed.

=head1 SPECIAL VARIABLES

The following are hash keys to the main object variable.  For example, if you use the variable $fb as the object variable, then the following are $fb->{VARIABLE_NAME}

=over 4

=item B<FONTS>

 List of system fonts

 Contains a hash of every font found in the system in the format:

=back

=over 6

 'FaceName' => {
     'path' => 'Path To Font',
     'font' => 'File Name of Font'
 },
 ...

=back

=over 4

=item B<Imager-Has-TrueType>

If your installation of Imager has TrueType font capability, then this will be 1

=item B<Imager-Has-Type1>

If your installation of Imager has Adobe Type 1 font capability, then this will be 1

=item B<Imager-Has-Freetype2>

If your installation of Imager has the FreeType2 library rendering capability, then this will be 1

=item B<X_CLIP>

The top left-hand corner X location of the clipping region

=item B<Y_CLIP>

The top left-hand corner Y location of the clipping region

=item B<XX_CLIP>

The bottom right-hand corner X location of the clipping region

=item B<YY_CLIP>

The bottom right-hand corner Y location of the clipping region.

=item B<CLIPPED>

If this is true, then the clipping region is smaller than the full screen

If false, then the clipping region is the screen dimensions.

=item B<DRAW_MODE>

The current drawing mode.  This is a numeric value corresponding to the constants described in the method 'draw_mode'

=item B<COLOR>

The current foreground color encoded as a string.

=item B<B_COLOR>

The current background color encoded as a string.

=item B<ACCELERATED>

Indicates if C code or hardware acceleration is being used.

=back

=over 6

=item B<Possible Values>

 0 = Perl code only (Default)
 1 = Some functions accelerated by compiled code
 2 = All of #1 plus additional functions accelerated by hardware

=back

Many of the parameters you pass to the "new" method are also special variables.

=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;         # We have to be as quiet as possible

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

    NORMAL_MODE => 0,    #   Constants for DRAW_MODE
      XOR_MODE    => 1,    #   Constants for DRAW_MODE
      OR_MODE     => 2,    #   Constants for DRAW_MODE
      AND_MODE    => 3,    #   Constants for DRAW_MODE
      MASK_MODE   => 4,    #   Constants for DRAW_MODE
      UNMASK_MODE => 5,    #   Constants for DRAW_MODE
      ALPHA_MODE  => 6,    #   Constants for DRAW_MODE

    ARC      => 0,       #   Constants for "draw_arc" method
      PIE      => 1,       #   Constants for "draw_arc" method
      POLY_ARC => 2,       #   Constants for "draw_arc" method

    RGB => 0,            #   Constants for color mapping
      RBG => 1,            #   Constants for color mapping
      BGR => 2,            #   Constants for color mapping
      BRG => 3,            #   Constants for color mapping
      GBR => 4,            #   Constants for color mapping
      GRB => 5,            #   Constants for color mapping

    CENTER_NONE => 0,    #   Constants for centering
      CENTER_X    => 1,    #   Constants for centering
      CENTER_Y    => 2,    #   Constants for centering
      CENTER_XY   => 3,    #   Constants for centering

    ## Set up the Framebuffer driver "constants" defaults
    # Commands
    FBIOGET_VSCREENINFO => 0x4600,    # These come from "fb.h" in the kernel source
      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,
      VT_GETSTATE         => 0x5603,

    # FLAGS
    FBINFO_HWACCEL_NONE      => 0x0000,    # These come from "fb.h" in the kernel source
      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,
};

use Time::HiRes qw(sleep time);
use Math::Trig;                                                     # Usually only PI is used
use Math::Bezier;                                                   # Bezier curve calculations done here.
use Math::Gradient qw( gradient array_gradient multi_gradient );    # Awesome gradient calculation module
use List::Util qw(min max);                                         # min and max are very handy!
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.
use Imager::Matrix2d;
use Imager::Fill;
use Imager::Fountain;
use Graphics::Framebuffer::Splash;                                  # The splash code is here now

Imager->preload;

## This is for debugging, and should normally be commented out.
# use Data::Dumper::Simple;$Data::Dumper::Sortkeys=1;
# use Carp qw(cluck);

BEGIN {
    require Exporter;

    #    require 'sys/ioctl.ph';

    # set the version for version checking
    our $VERSION   = 5.73;
    our @ISA       = qw(Exporter Graphics::Framebuffer::Splash);
    our @EXPORT_OK = qw(
        FBIOGET_VSCREENINFO
        FBIOPUT_VSCREENINFO
        FBIOGET_FSCREENINFO
        FBIOGETCMAP
        FBIOPUTCMAP
        FBIOPAN_DISPLAY
        FBIO_CURSOR
        FBIOGET_CON2FBMAP
        FBIOPUT_CON2FBMAP
        FBIOBLANK
        FBIOGET_VBLANK
        FBIOGET_GLYPH
        FBIOGET_HWCINFO
        FBIOPUT_MODEINFO
        FBIOGET_DISPINFO
        FBIO_WAITFORVSYNC
        VT_GETSTATE
        FBINFO_HWACCEL_NONE
        FBINFO_HWACCEL_COPYAREA
        FBINFO_HWACCEL_FILLRECT
        FBINFO_HWACCEL_IMAGEBLIT
        FBINFO_HWACCEL_ROTATE
        FBINFO_HWACCEL_XPAN
        FBINFO_HWACCEL_YPAN
        FBINFO_HWACCEL_YWRAP
    );
    our @EXPORT = qw(
        NORMAL_MODE
        XOR_MODE
        OR_MODE
        AND_MODE
        MASK_MODE
        UNMASK_MODE
        ARC
        PIE
        POLY_ARC
        RGB
        RBG
        BGR
        BRG
        GBR
        GRB
        CENTER_NONE
        CENTER_X
        CENTER_Y
        CENTER_XY
        $VERSION
        @HATCHES
    );
} ## end BEGIN

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

our @HATCHES = qw(
    check1x1 check2x2 check4x4
    vline1 vline2 vline4
    hline1 hline2 hline4
    slash1 slash2
    slosh1 slosh2
    grid1 grid2 grid4
    dots1 dots4 dots16
    stipple stipple2
    weave
    cross1 cross2
    vlozenge hlozenge
    scalesdown scalesup scalesleft scalesright
    tile_L
);

=head1 METHODS

=head2 B<new>

This instantiates the framebuffer object

=over 4

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

=back

=head3 PARAMETERS

=over 6

=item B<FB_DEVICE>

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

      *  /dev/fb0 - 31
      *  /dev/graphics/fb0 - 31

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

=item B<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 B<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
 }

Do not use this to change colors, as "set_color" is intended for that.  Use this to set the DEFAULT foreground color for when "attribute_reset" is called.

=item B<BACKGROUND>

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' => 255
 }

Do not use this to change background colors, as "set_b_color" is intended for that.  Use this to set the DEFAULT background color.

=item B<SPLASH>

The splash screen is or is not displayed

A value other than zero turns on the splash screen, and the value is the wait time to show it (default 2 seconds)
A zero value turns it off

=item B<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 B<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 B<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 6

=item B<VXRES>

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

=item B<VYRES>

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

=item B<BITS>

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

=item B<BYTES>

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

=item B<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 (Many video cards are this)

=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,    # Imager foreground color
        'BI_COLOR'  => undef,    # Imager background color
        'X'         => 0,        # Last position plotted X
        'Y'         => 0,        # Last position plotted Y
        'X_CLIP'    => 0,        # Top left clip start X
        'Y_CLIP'    => 0,        # Top left clip start Y
        'YY_CLIP'   => undef,    # Bottom right clip end X
        'XX_CLIP'   => undef,    # Bottom right clip end Y
        'CLIPPED'   => 0,
        'COLOR'     => undef,    # Global foreground color (Raw string)
        'B_COLOR'   => undef,    # Global Background Color
        'DRAW_MODE' => 0,        # Drawing mode (Normal default)

        'NORMAL_MODE' => 0,      #   Constants for DRAW_MODE
        'XOR_MODE'    => 1,      #   Constants for DRAW_MODE
        'OR_MODE'     => 2,      #   Constants for DRAW_MODE
        'AND_MODE'    => 3,      #   Constants for DRAW_MODE
        'MASK_MODE'   => 4,      #   Constants for DRAW_MODE
        'UNMASK_MODE' => 5,      #   Constants for DRAW_MODE
        'ALPHA_MODE'  => 6,      #   Constants for DRAW_MODE

        'CLIPPED'     => FALSE,  # Enabled if Clipping smaller than the full screen is used.
        'ARC'         => 0,      #   Constants for "draw_arc" method
        'PIE'         => 1,      #   Constants for "draw_arc" method
        'POLY_ARC'    => 2,      #   Constants for "draw_arc" method
        'FILE_MODE'   => FALSE,  # If off, system draws to MMAPped string.  If on, system draws using file handle and seeks.
        'SHOW_ERRORS' => FALSE,  # If on, it will output any errors in Imager or elsewhere, else all errors are squelched
        'FOREGROUND'  => {       # Default foreground for "attribute_reset" method
            'red'   => 255,
            'green' => 255,
            'blue'  => 255,
            'alpha' => 255
        },
        'BACKGROUND' => {        # Default background for "attribute_reset" method
            'red'   => 0,
            'green' => 0,
            'blue'  => 0,
            'alpha' => 0
        },
        'FONT_PATH' => '/usr/share/fonts/truetype/freefont',    # Default fonts path
        'FONT_FACE' => 'FreeSans.ttf',                          # Default font face

        'SPLASH' => 2,                                          # Show or not show the splash screen at startup.  Show is default
        ## The value isn't boolean, it's actually a wait value in seconds
        'RGB'         => 0,                                     #   Constants for color mapping
        'RBG'         => 1,                                     #   Constants for color mapping
        'BGR'         => 2,                                     #   Constants for color mapping
        'BRG'         => 3,                                     #   Constants for color mapping
        'GBR'         => 4,                                     #   Constants for color mapping
        'GRB'         => 5,                                     #   Constants for color mapping
        'CENTER_NONE' => 0,                                     #   Constants for centering
        'CENTER_X'    => 1,                                     #   Constants for centering
        'CENTER_Y'    => 2,                                     #   Constants for centering
        'CENTER_XY'   => 3,                                     #   Constants for centering

        ## Set up the Framebuffer driver "constants" defaults
        # Commands
        'FBIOGET_VSCREENINFO' => 0x4600,    # These come from "fb.h" in the kernel source
        '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,
        'VT_GETSTATE'         => 0x5603,

        # FLAGS
        'FBINFO_HWACCEL_NONE'      => 0x0000,    # These come from "fb.h" in the kernel source
        '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
        'vt_stat'             => 'SSS',    # v_active, v_signal, v_state
        '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
        'I' .                            # 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
        'I' .                            # 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

        # Unfortunately, these are not IOCTLs.  Gee, that would be nice if they were.
        '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,                    # Virtual X resolution
        'VYRES'       => 480,                    # Virtual Y resolution
        'BITS'        => 32,                     # Bits per pixel
        'BYTES'       => 4,                      # Bytes per pixel
        'XOFFSET'     => 0,                      # Visible screen X offset
        'YOFFSET'     => 0,                      # Visible screen Y offset
        'FB_DEVICE'   => undef,                  # Framebuffer device name (defined later)
        'COLOR_ORDER' => 'RGB',                  # Default color Order.  Redefined later to be an integer
        'ACCELERATED' => 1,                      # Use accelerated graphics (not supported yet)
        #   0 = Pure Perl
        #   1 = C Accelerated (but still software)
        #   2 = C & Hardware accelerated.
        @_
    };

    unless (defined($self->{'FB_DEVICE'})) {     # We only test device 0 & 1
        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'...}))
    $ENV{'PATH'} = '/usr/bin:/bin';
    if (!defined($ENV{'DISPLAY'}) && defined($self->{'FB_DEVICE'}) && open($self->{'FB'}, '+<', $self->{'FB_DEVICE'})) {    # Can we open the framebuffer device??
        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(FBIOGET_VSCREENINFO, $self->{'FBioget_vscreeninfo'}, $self->{'FB'});

        # Make the IOCTL call to get info on the physical screen
        my $extra = 1;
        do {                                                                                                                # A hacked way to do this, but it seems to work
            my $typedef = '' . $self->{'FBioget_fscreeninfo'};
            if ($extra > 1) {                                                                                               # It turns out it was byte alignment issues, not driver weirdness
                if ($extra == 2) {
                    $typedef =~ s/S1/S$extra/;
                } elsif ($extra == 3) {
                    $typedef =~ s/S1/L/;
                } elsif ($extra == 4) {
                    $typedef =~ s/S1/I/;
                }
                (
                    $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(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(FBIOGET_FSCREENINFO, $typedef, $self->{'FB'});
            } ## end else [ if ($extra > 1) ]

            #            print "$typedef - \n",Dumper($self->{'fscreeninfo'}),"\n";
            $extra++;
        } until (($self->{'fscreeninfo'}->{'line_length'} < $self->{'fscreeninfo'}->{'smem_len'} && $self->{'fscreeninfo'}->{'line_length'} > 0) || $extra > 4);

        #       exit;
        $self->{'ACCELERATED'}    = 1;                                                                                  # ($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'})) {                                             # I really wish I didn't need this
            print STDERR "Unable to detect line length due to improper byte alignment in C structure from IOCTL call, going to 'fbset -i' for more reliable information\n" if ($self->{'SHOW_ERRORS'});

            # Looks like we still have bad data
            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;
            } ## end if ($fbset =~ /Frame buffer device information/i)
        } ## end if ($self->{'BYTES_PER_LINE'...})

        ## 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;
        }

        chomp($self->{'CONSOLE'} = `fgconsole`);
        $self->{'THIS_CONSOLE'} = $self->{'CONSOLE'};

        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'} == 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'} == 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'} == 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'} == 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'} == 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'} == 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;
        } ## end elsif ($self->{'COLOR_ORDER'...})

        # 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'}               = RGB;

        bless($self, $class);

    } ## end else [ if (!defined($ENV{'DISPLAY'...}))]
    $self->_gather_fonts('/usr/share/fonts');
    foreach my $font (qw(FreeSans Ubuntu-R Arial Oxygen-Sans Garuda LiberationSans-Regular Loma)) {
        if (exists($self->{'FONTS'}->{$font})) {
            $self->{'FONT_PATH'} = $self->{'FONTS'}->{$font}->{'path'};
            $self->{'FONT_FACE'} = $self->{'FONTS'}->{$font}->{'font'};
            last;
        }
    } ## end foreach my $font (qw(FreeSans Ubuntu-R Arial Oxygen-Sans Garuda LiberationSans-Regular Loma))
    if ($self->{'SPLASH'}) {
        $self->splash($VERSION);
        sleep $self->{'SPLASH'};
    }
    $self->attribute_reset();
    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'} = RGB;
    } elsif ($bo < $go && $go < $ro) {
        $self->{'COLOR_ORDER'} = BGR;
    } elsif ($go < $ro && $ro < $bo) {
        $self->{'COLOR_ORDER'} = GRB;
    } elsif ($go < $bo && $bo < $ro) {
        $self->{'COLOR_ORDER'} = GBR;
    } elsif ($bo < $ro && $ro < $go) {
        $self->{'COLOR_ORDER'} = BRG;
    } elsif ($ro < $bo && $bo < $go) {
        $self->{'COLOR_ORDER'} = RBG;
    } else {

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

sub _screen_close {
    my $self = shift;
    unless (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 which_console

Returns two values, the current console number and the console number when the module started

This comes in handy for determining whether to draw to the screen or not (which is YOUR job as the programmer to manage).  The reason why the module doesn't manage whether to draw or not is a simple matter of speed and efficiency.  If it had to check before each and every draw operation, it would be considerably slower.  Therefore, it is more efficient for YOU, the programmer, to check this before you call a series of operations to draw a screen.

=over 4

 my ($current_console,$original_console) = $fb->which_console();

=back

* This method only works if the 'fgconsole' program is installed on your system.  It's typically in "console-setup" or "console-utilities" packages, or something similar.

=cut

sub which_console {
    my $self = shift;
    chomp($self->{'THIS_CONSOLE'} = `fgconsole`);
    return ($self->{'THIS_CONSOLE'}, $self->{'CONSOLE'});
}

=head2 screen_dimensions

When called in an array/list context:

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

It also returns the bits per pixel.

=over 4

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

=back

When called in a scalar context, it returns a hash reference:

=over 4

 {
     'width'          => pixel width of physical screen,
     'height'         => pixel height of physical screen,
     'bits_per_pixel' => bits per pixel (16, 24, or 32),
     'bytes_per_line' => Number of bytes per scan line,
     'top_clip'       => top edge of clipping rectangle (Y),
     'left_clip'      => left edge of clipping rectangle (X),
     'bottom_clip'    => bottom edge of clipping rectangle (YY),
     'right_clip'     => right edge of clipping rectangle (XX)
 }

=cut

sub screen_dimensions {
    my $self = shift;
    if (wantarray) {
        return ($self->{'XRES'}, $self->{'YRES'}, $self->{'BITS'});
    } else {
        return(
            {
                'width'          => $self->{'XRES'},
                  'height'         => $self->{'YRES'},
                  'bits_per_pixel' => $self->{'BITS'},
                  'bytes_per_line' => $self->{'BYTES_PER_LINE'},
                  'top_clip'       => $self->{'Y_CLIP'},
                  'left_clip'      => $self->{'X_CLIP'},
                  'bottom_clip'    => $self->{'YY_CLIP'},
                  'right_clip'     => $self->{'XX_CLIP'},
            }
        );
    }
}

# Splash is now pulled in via "Graphics::Framebuffer::Splash"

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

 $fb->splash();

=back

=head2 get_font_list

Returns an anonymous hash containing the font face names as keys and another anonymous hash assigned as the values for each key. This second hash contains the path to the font and the font's file name.

=over 4

 'face name' => {
      'path' => 'path to font',
      'font' => 'file name of font'
 },
 ... The rest of the system fonts here

=back

You may also pass in a face name and it will return that face's information:

=over 4

 my $font_info = $fb->get_font_list('DejaVuSerif');

=back

Would return something like:

=over 4

 {
     'font' => 'dejavuserif.ttf',
     'path' => '/usr/share/fonts/truetype/'
 }

=back

When passing a name, it will return a hash reference (if only one match), or an array reference of hashes of fonts matching that name.  Passing in "Arial" would return the font information for "Arial Black, Arial Narrow, and Arial Rounded (if they are installed on your system).

=cut

sub get_font_list {
    my $self = shift;
    my ($filter) = @_;
    my $fonts;
    if ($filter) {
        foreach my $font (sort(keys %{$self->{'FONTS'}})) {
            if ($font =~ /$filter/i) {
                push(@{$fonts},$self->{'FONTS'}->{$font});
            }
        }
        if (defined($fonts) && scalar(@{$fonts}) == 1) {
            return ($fonts->[0]);
        } else {
            return ($fonts);
        }
    }
    return ($self->{'FONTS'});
} ## end sub get_font_list

=head2 draw_mode

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

=over 4

 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. Imager
                                       # assisted drawing (acceleration)
                                       # only works in this mode.

 $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->{'ALPHA_MODE'});  # Does a bitwise AND with
                                       # the new pixel and the alpha
                                       # value, then a bitwise OR
                                       # with the screen pixel.

 $fb->draw_mode($fb->{'AND_MODE'});    # Does a bitwise AND with
                                       # the new pixel and screen
                                       # pixel.
 ###########################################
 # MASK and UNMASK only apply to blitting  #
 ###########################################
 # You are encouraged to use               #
 # "blit_transform" in "merge" mode for    #
 # much faster results (if in 32 bit mode) #
 ###########################################
 $fb->draw_mode($fb->{'MASK_MODE'});   # If pixels in the source
                                       # are equal to the global
                                       # background color, then they
                                       # are not drawn (transparent).

 $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(NORMAL_MODE)

=over 4

 $fb->normal_mode();

=back

=cut

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

=head2 xor_mode

This is an alias to draw_mode(XOR_MODE)

=over 4

 $fb->xor_mode();

=back

=cut

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

=head2 or_mode

This is an alias to draw_mode(OR_MODE)

=over 4

 $fb->or_mode();

=back

=cut

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

=head2 alpha_mode

This is an alias to draw_mode(ALPHA_MODE)

=over 4

 $fb->alpha_mode();

=back

=cut

sub alpha_mode {
    my $self = shift;
    $self->draw_mode(ALPHA_MODE);
}

=head2 and_mode

This is an alias to draw_mode(AND_MODE)

=over 4

 $fb->and_mode();

=back

=cut

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

=head2 mask_mode

This is an alias to draw_mode(MASK_MODE)

=over 4

 $fb->mask_mode();

=back

=cut

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

=head2 unmask_mode

This is an alias to draw_mode(UNMASK_MODE)

=over 4

 $fb->unmask_mode();

=back

=cut

sub unmask_mode {
    my $self = shift;
    $self->draw_mode(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 4

 $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);
    $|++;
    if ($self->{'CLIPPED'}) {
        my $w = $self->{'W_CLIP'};
        my $h = $self->{'H_CLIP'};
        $self->blit_write({ 'x' => $self->{'X_CLIP'}, 'y' => $self->{'Y_CLIP'}, 'width' => $w, 'height' => $h, 'image' => $self->{'B_COLOR'} x ($w * $h) }, 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'};
    }
    select($self->{'FB'});
    $|++;
} ## end sub clear_screen

=head2 cls

The same as clear_screen

=over 4

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

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

 $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'} = NORMAL_MODE;
    $self->set_b_color({%{$self->{'BACKGROUND'}}});
    $self->clip_reset;
} ## end sub 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.

With '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 4

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

=back

* This is not affected by the Acceleration setting

=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'} == NORMAL_MODE) {
                            $c = $self->{'COLOR'};
                        } elsif ($self->{'DRAW_MODE'} == XOR_MODE) {
                            $c ^= $self->{'COLOR'};
                        } elsif ($self->{'DRAW_MODE'} == OR_MODE) {
                            $c |= $self->{'COLOR'};
                        } elsif ($self->{'DRAW_MODE'} == ALPHA_MODE) {
                            my $back = $self->get_pixel({'x' => $x, 'y' => $y});
                            my $saved = {'main' => $self->{'COLOR'}};
                            foreach my $color (qw( red green blue )) {
                                $saved->{$color} = $self->{'COLOR_' . uc($color)};
                                $back->{$color} = ($self->{'COLOR_' . uc($color)} * $self->{'COLOR_ALPHA'}) + ($back->{$color} * (1 - $self->{'COLOR_ALPHA'}));
                            }
                            $back->{'alpha'} = min(255,$self->{'COLOR_ALPHA'} + $back->{'alpha'});
                            $self->set_color($back);
                            $c = $self->{'COLOR'};
                            $self->{'COLOR'} = $saved->{'main'};
                            foreach my $color (qw( red green blue )) {
                                $self->{'COLOR_' . uc($color)} = $saved->{$color};
                            }
                        } elsif ($self->{'DRAW_MODE'} == AND_MODE) {
                            $c &= $self->{'COLOR'};
                        } elsif ($self->{'DRAW_MODE'} == MASK_MODE) {
                            if ($self->{'BITS'} == 32) {
                                $c = $self->{'COLOR'} if (substr($self->{'COLOR'}, 0, 3) ne substr($self->{'B_COLOR'}, 0, 3));
                            } else {
                                $c = $self->{'COLOR'} if ($self->{'COLOR'} ne $self->{'B_COLOR'});
                            }
                        } elsif ($self->{'DRAW_MODE'} == UNMASK_MODE) {
                            my $pixel = $self->pixel({ 'x' => $x, 'y' => $y });
                            my $raw = $pixel->{'raw'};
                            if ($self->{'BITS'} == 32) {
                                $c = $self->{'COLOR'} if (substr($raw, 0, 3) eq substr($self->{'B_COLOR'}, 0, 3));
                            } else {
                                $c = $self->{'COLOR'} if ($raw eq $self->{'B_COLOR'});
                            }
                        } ## end elsif ($self->{'DRAW_MODE'...})
                        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 4

 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 4

 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'} });
} ## end sub last_plot

=head2 line

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

=over 4

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

=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

sub _adj_plot {
    my ($self, $x, $y, $c, $s) = @_;
    $self->set_color({ 'red' => $s->{'red'} * $c, 'green' => $s->{'green'} * $c, 'blue' => $s->{'blue'} * $c });
    $self->plot({ 'x' => $x, 'y' => $y });
}

sub _draw_line_antialiased {
    my ($self, $x0, $y0, $x1, $y1) = @_;

    my $saved = { %{ $self->{'SET_COLOR'} } };

    my $plot = \&_adj_plot;

    if (abs($y1 - $y0) > abs($x1 - $x0)) {
        $plot = sub { _adj_plot(@_[0, 2, 1, 3, 4]) };
        ($x0, $y0, $x1, $y1) = ($y0, $x0, $y1, $x1);
    }

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

    my $dx       = $x1 - $x0;
    my $dy       = $y1 - $y0;
    my $gradient = $dy / $dx;

    my @xends;
    my $intery;

    # handle the endpoints
    for my $xy ([$x0, $y0], [$x1, $y1]) {
        my ($x, $y) = @{$xy};
        my $xend = _round($x);
        my $yend = $y + $gradient * ($xend - $x);
        my $xgap = _rfpart($x + 0.5);

        my $x_pixel = $xend;
        my $y_pixel = int($yend);
        push @xends, $x_pixel;

        $plot->($self, $x_pixel, $y_pixel,     _rfpart($yend) * $xgap, $saved);
        $plot->($self, $x_pixel, $y_pixel + 1, _fpart($yend) * $xgap,  $saved);
        next if defined $intery;

        # first y-intersection for the main loop
        $intery = $yend + $gradient;
    } ## end for my $xy ([$x0, $y0],...)

    # main loop

    for my $x ($xends[0] + 1 .. $xends[1] - 1) {
        $plot->($self, $x, int($intery),     _rfpart($intery), $saved);
        $plot->($self, $x, int($intery) + 1, _fpart($intery),  $saved);
        $intery += $gradient;
    }
    $self->set_color($saved);
} ## end sub _draw_line_antialiased

=head2 angle_line

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

=over 4

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

=back

* This is not affected by the Acceleration setting

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

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

=back

* This is not affected by the Acceleration setting

=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 $antialiased = $params->{'antialiased'} || 0;
    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
            foreach my $y ($y_end .. $start_y) {
                $self->plot({ 'x' => $start_x, 'y' => $y, 'pixel_size' => $size });
            }
        } else {                      # Draw direction is DOWN
            foreach my $y ($start_y .. $y_end) {
                $self->plot({ 'x' => $start_x, 'y' => $y, 'pixel_size' => $size });
            }
        }
    } 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!
            }
        } 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 ($size == 1) ]
    } elsif ($antialiased) {
        $self->_draw_line_antialiased($start_x, $start_y, $x_end, $y_end);
    } 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 4

 $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
              'colors'    => { # 2 to any number of transitions allowed
                  'red'   => [255,255,0], # Red to yellow to cyan
                  'green' => [0,255,255],
                  'blue'  => [0,0,255]
              }
          }
     }
 );

=back

* This is not affected by the Acceleration setting

=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 else [ if ($closed) ]
} ## end sub bezier

=head2 cubic_bezier

DISCONTINUED, use 'bezier' instead.

=cut

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

=head2 draw_arc

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

=over 4

 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
                      Can have gradients, textures, and hatches
                  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,
    'granularity   => .05,
    'mode'          => 2    # The object hash has 'ARC', 'PIE',
                            # and 'POLY_ARC' as a means of filling
                            # this value.
 });

=back

* Only PIE is affected by the acceleration setting.

=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 $bytes = $self->{'BYTES'};
    unless ($self->{'ACCELERATED'} && $mode == PIE && $self->{'BITS'} > 16) {
        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 == 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);
                        }
                    } ## end else [ if ($mode == ARC) ]
                    $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 == 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);
                    }
                } ## end else [ if ($mode == ARC) ]
                $ox = $sx;
                $oy = $sy;
            } ## end if (($sx <=> $ox) || (...))
            $degrees += $granularity;
        } until ($degrees >= $end_degrees);
        if ($mode != ARC) {
            $params->{'filled'} = ($mode == PIE) ? TRUE : FALSE;
            $params->{'coordinates'} = \@coords;
            $self->polygon($params);
        }
        ($self->{'X'}, $self->{'Y'}) = ($sx, $sy);
    } else {
        my $w = ($radius * 2);
        my $saved = $self->blit_read(
            {
                'x'      => $x - $radius,
                  'y'      => $y - $radius,
                  'width'  => $w,
                  'height' => $w,
            }
        );
        eval {
            my $img = Imager->new(
                'xsize' => $w,
                'ysize' => $w,
                'raw_datachannels'  => $bytes,
                'raw_storechannels' => $bytes,
                'channels'          => $bytes,
                'raw_interleave'    => 0,
            );
            unless($self->{'DRAW_MODE'}) {
                $img->read(
                    'xsize'             => $w,
                    'ysize'             => $w,
                    'raw_datachannels'  => $bytes,
                    'raw_storechannels' => $bytes,
                    'channels'          => $bytes,
                    'raw_interleave'    => 0,
                    'data'              => $saved->{'image'},
                    'type'              => 'raw',
                    'allow_incomplete'  => 1
                );
            }
            my %p = (
                'x'      => $radius,
                'y'      => $radius,
                'd1'     => $start_degrees,
                'd2'     => $end_degrees,
                'r'      => $radius,
                'filled' => TRUE,
                'color'  => $self->{'I_COLOR'},
            );
            my $pattern;
            if (exists($params->{'hatch'})) {
                $p{'fill'}->{'hatch'} = $params->{'hatch'};
                $p{'fill'}->{'fg'}    = $self->{'I_COLOR'};
                $p{'fill'}->{'bg'}    = $self->{'BI_COLOR'};
            } elsif (exists($params->{'texture'})) {
                $pattern = $self->_generate_fill($w, $w, undef, $params->{'texture'});
                my $image = Imager->new(
                    'xsize'             => $w,
                    'ysize'             => $w,
                    'raw_datachannels'  => $bytes,
                    'raw_storechannels' => $bytes,
                    'raw_interleave'    => 0,
                );
                $image->read(
                    'xsize'             => $w,
                    'ysize'             => $w,
                    'raw_datachannels'  => $bytes,
                    'raw_storechannels' => $bytes,
                    'raw_interleave'    => 0,
                    'data'              => $pattern,
                    'type'              => 'raw',
                    'allow_incomplete'  => 1
                );
                $p{'fill'}->{'image'} = $image;
            } elsif (exists($params->{'gradient'})) {
                if (exists($params->{'gradient'}->{'colors'})) {
                    $pattern = $self->_generate_fill($w, $w, $params->{'gradient'}->{'colors'},$params->{'gradient'}->{'direction'} || 'vertical');
                } else {
                    $pattern = $self->_generate_fill(
                        $w,
                        $w,
                        {
                            'red'   => [$params->{'gradient'}->{'start'}->{'red'},   $params->{'gradient'}->{'end'}->{'red'}],
                              'green' => [$params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}],
                              'blue'  => [$params->{'gradient'}->{'start'}->{'blue'},  $params->{'gradient'}->{'end'}->{'blue'}]
                        },
                        $params->{'gradient'}->{'direction'} || 'vertical'
                    );
                } ## end else [ if (exists($params->{'gradient'...}))]
                my $image = Imager->new(
                    'xsize'             => $w,
                    'ysize'             => $w,
                    'raw_datachannels'  => $bytes,
                    'raw_storechannels' => $bytes,
                    'raw_interleave'    => 0,
                );
                $image->read(
                    'xsize'             => $w,
                    'ysize'             => $w,
                    'raw_datachannels'  => $bytes,
                    'raw_storechannels' => $bytes,
                    'raw_interleave'    => 0,
                    'data'              => $pattern,
                    'type'              => 'raw',
                    'allow_incomplete'  => 1
                );
                $p{'fill'}->{'image'} = $image;
            }
            $img->arc(%p);
            $img->write(
                'type'          => 'raw',
                'datachannels'  => max(3,$bytes),
                'storechannels' => max(3,$bytes),
                'interleave'    => 0,
                'data'          => \$saved->{'image'},
            );
        };
        print STDERR "$@\n" if ($@ && $self->{'SHOW_ERRORS'});
        $self->blit_write($saved);
    }
} ## 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 4

 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,
    'granularity   => .05,
 });

=back

* This is not affected by the Acceleration setting

=cut

sub arc {
    my $self   = shift;
    my $params = shift;
    $params->{'mode'} = 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 4

 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,
    'granularity   => .05,
    'gradient' => {  # optional
        'direction' => 'horizontal', # or vertical
        'colors'    => { # 2 to any number of transitions allowed
            'red'   => [255,255,0], # Red to yellow to cyan
            'green' => [0,255,255],
            'blue'  => [0,0,255]
        }
    },
    'texture'  => { # Same as what blit_read or load_image returns
        'width'  => 320,
        'height' => 240,
        'image'  => $raw_image_data
    },
    'hatch'      => 'hatchname' # The exported array @HATCHES contains
                                # the names of all the hatches
 });

=back

* This is affected by the Acceleration setting

=cut

sub filled_pie {
    my $self   = shift;
    my $params = shift;
    $params->{'mode'} = 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 4

 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,
    'granularity   => .05,
 });

=back

* This is not affected by the Acceleration setting

=cut

sub poly_arc {
    my $self   = shift;
    my $params = shift;
    $params->{'mode'} = 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 4

 $fb->ellipse({
    'x'          => 200, # Horizontal center
    'y'          => 250, # Vertical center
    'xradius'    => 50,
    'yradius'    => 100,
    'factor'     => 1, # Anything other than 1 has funkiness
    'pixel_size' => 4, # optional
    'filled'     => 1, # optional

    ## Only one of the following may be used

    'gradient'   => {  # optional, but 'filled' must be set
        'direction' => 'horizontal', # or vertical
        'colors'    => { # 2 to any number of transitions allowed
            'red'   => [255,255,0], # Red to yellow to cyan
            'green' => [0,255,255],
            'blue'  => [0,0,255]
        }
    }
    'texture'    => {  # Same format blit_read or load_image uses.
        'width'   => 320,
        'height'  => 240,
        'image'   => $raw_image_data
    },
    'hatch'      => 'hatchname' # The exported array @HATCHES contains
                                # the names of all the hatches
 });

=back

* This is not affected by the Acceleration setting

=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;
    my $xdiameter = $XRadius * 2;
    my $ydiameter = $YRadius * 2;
    my $bytes = $self->{'BYTES'};
    if (exists($params->{'gradient'})) {
        if ($params->{'gradient'}->{'direction'} !~ /vertical/i) {
            if (exists($params->{'gradient'}->{'colors'})) {
                $pattern = $self->_generate_fill($xdiameter, $ydiameter, $params->{'gradient'}->{'colors'},'horizontal');
            } else {
                $pattern = $self->_generate_fill(
                    $xdiameter,
                    $ydiameter,
                    {
                        'red'   => [$params->{'gradient'}->{'start'}->{'red'},   $params->{'gradient'}->{'end'}->{'red'}],
                          'green' => [$params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}],
                          'blue'  => [$params->{'gradient'}->{'start'}->{'blue'},  $params->{'gradient'}->{'end'}->{'blue'}]
                    },
                    'horizontal'
                );
            } ## end else [ if (exists($params->{'gradient'...}))]
            $plen     = length($pattern);
            $gradient = 2;
        } else {
            my $ydiameter = $YRadius * 2;
            if (exists($params->{'gradient'}->{'colors'})) {
                @rc = multi_gradient($ydiameter, @{ $params->{'gradient'}->{'colors'}->{'red'} });
                @gc = multi_gradient($ydiameter, @{ $params->{'gradient'}->{'colors'}->{'green'} });
                @bc = multi_gradient($ydiameter, @{ $params->{'gradient'}->{'colors'}->{'blue'} });
            } else {
                @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 else [ if ($params->{'gradient'...})]
    } elsif (exists($params->{'texture'})) {
        $pattern = $self->_generate_fill($xdiameter,$ydiameter,undef,$params->{'texture'});
        $gradient = 2;
    } elsif (exists($params->{'hatch'})) {
        $pattern = $self->_generate_fill($xdiameter, $ydiameter, undef,$params->{'hatch'});
        $gradient = 2;
    } ## 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;

        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, $bytes * (min($cxx, $cx_x) - $left) + ($rpy * ($xdiameter * $bytes)), $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 });
                } ## end else [ if ($gradient == 2) ]
                $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, $bytes * (min($cxx, $cx_x) - $left) + ($rmy * ($xdiameter * $bytes)), $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 });
                } ## end else [ if ($gradient == 2) ]
                $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, $bytes * (min($cxx, $cx_x) - $left) + ($rpy * ($xdiameter * $bytes)), $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 });
                } ## end else [ if ($gradient == 2) ]
                $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, $bytes * (min($cxx, $cx_x) - $left) + ($rmy * ($xdiameter * $bytes)), $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 });
                } ## end else [ if ($gradient == 2) ]
                $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 4

 $fb->circle({
    'x'        => 300, # Horizontal center
    'y'        => 300, # Vertical center
    'radius'   => 100,
    'filled'   => 1, # optional
    'gradient' => {  # optional
        'direction' => 'horizontal', # or vertical
        'colors'    => { # 2 to any number of transitions allowed
            'red'   => [255,255,0], # Red to yellow to cyan
            'green' => [0,255,255],
            'blue'  => [0,0,255]
        }
    },
    'texture'  => { # Same as what blit_read or load_image returns
        'width'  => 320,
        'height' => 240,
        'image'  => $raw_image_data
    },
    'hatch'      => 'hatchname' # The exported array @HATCHES contains
                                # the names of all the hatches
 });

=back

* This is not affected by the Acceleration setting

=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 $xstart = $x0 - $r;

    my @coords;
    my $saved = $self->{'COLOR'};
    my $count = ($r * 2) + abs($y1 - $y0);
    my $pattern;
    my $W    = $r * 2;
    my $wdth = ($x1 + $r) - ($x0 - $r);
    my $hgth = ($y1 + $r) - ($y0 - $r);
    my $bytes = $self->{'BYTES'};
    my $plen = $wdth * $bytes;
    $self->{'history'} = {};

    if ($gradient) {
        if (defined($params->{'gradient'}->{'direction'}) && $params->{'gradient'}->{'direction'} !~ /vertical/i) {
            $W = $bxx - $bx unless ($x0 == $x1 && $y0 == $y1);
            if (exists($params->{'gradient'}->{'colors'})) {
                $pattern = $self->_generate_fill($wdth, $hgth, $params->{'gradient'}->{'colors'},$params->{'gradient'}->{'direction'});
            } else {
                $pattern = $self->_generate_fill(
                    $wdth, $hgth,
                    {
                        'red'   => [$params->{'gradient'}->{'start'}->{'red'},   $params->{'gradient'}->{'end'}->{'red'}],
                          'green' => [$params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}],
                          'blue'  => [$params->{'gradient'}->{'start'}->{'blue'},  $params->{'gradient'}->{'end'}->{'blue'}]
                    },
                    $params->{'gradient'}->{'direction'}
                );
            } ## end else [ if (exists($params->{'gradient'...}))]
            $plen     = $wdth * $bytes;
            $gradient = 2;
        } else {
            $W = $byy - $by unless ($x0 == $x1 && $y0 == $y1);
            if (exists($params->{'gradient'}->{'colors'})) {
                @rc = multi_gradient($W, @{ $params->{'gradient'}->{'colors'}->{'red'} });
                @gc = multi_gradient($W, @{ $params->{'gradient'}->{'colors'}->{'green'} });
                @bc = multi_gradient($W, @{ $params->{'gradient'}->{'colors'}->{'blue'} });
            } else {
                @rc = gradient($params->{'gradient'}->{'start'}->{'red'},   $params->{'gradient'}->{'end'}->{'red'},   $W);
                @gc = gradient($params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}, $W);
                @bc = gradient($params->{'gradient'}->{'start'}->{'blue'},  $params->{'gradient'}->{'end'}->{'blue'},  $W);
            }
        } ## end else [ if ($params->{'gradient'...})]
    } elsif (exists($params->{'texture'})) {
        $pattern = $self->_generate_fill($wdth,$hgth,undef,$params->{'texture'});
        $gradient = 2;
    } elsif (exists($params->{'hatch'})) {
        $pattern = $self->_generate_fill($wdth, $hgth, undef,$params->{'hatch'});
        $gradient = 2;
    } # end if ($gradient)
    my ($ymy, $lymy, $ymx, $lymx, $ypy, $lypy, $ypx, $lypx, $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) {
            my $ymy_i = $ymy - $start;
            my $ymx_i = $ymx - $start;
            my $ypy_i = $ypy - $start;
            my $ypx_i = $ypx - $start;

            if ($gradient == 2) {
                my $fxmy = $xmy;
                my $fxmx = $xmx;
                my $fxpy = $xpy;
                my $fxpx = $xpx;

                # Top
                my $fwd = $fxpx - $fxmx;
                my $wd  = $xpx - $xmx;
                if ($ymy != $lymy && $ymy != $lymx && $ymy != $lypx && $ymy != $lypy) {
                    ($params->{'x'}, $params->{'y'}, $params->{'width'}, $params->{'height'}, $params->{'image'}) = ($fxmx, $ymy, $fwd, 1, substr($pattern, (($plen - ($bytes * $wd)) / 2) + ($ymy_i * $plen), $fwd * $bytes));
                    $self->blit_write($params);
                }

                $fwd = $fxpy - $fxmy;
                $wd  = $xpy - $xmy;
                if ($ymx != $lymx && $ymx != $lymy && $ymx != $lypx && $ymx != $lypy) {
                    ($params->{'x'}, $params->{'y'}, $params->{'width'}, $params->{'height'}, $params->{'image'}) = ($fxmy, $ymx, $fwd, 1, substr($pattern, (($plen - ($bytes * $wd)) / 2) + ($ymx_i * $plen), $fwd * $bytes));
                    $self->blit_write($params);
                }

                # Bottom
                $fwd = $fxpx - $fxmx;
                $wd  = $xpx - $xmx;
                if ($ypy != $lypy && $ypy != $lypx && $ypy != $lymy && $ypy != $lymx) {
                    ($params->{'x'}, $params->{'y'}, $params->{'width'}, $params->{'height'}, $params->{'image'}) = ($fxmx, $ypy, $fwd, 1, substr($pattern, (($plen - ($bytes * $wd)) / 2) + ($ypy_i * $plen), $fwd * $bytes));
                    $self->blit_write($params);
                }

                $fwd = $fxpy - $fxmy;
                $wd  = $xpy - $xmy;
                if ($ypx != $lypx && $ypx != $lypy && $ypx != $lymx && $ypx != $lymy) {
                    ($params->{'x'}, $params->{'y'}, $params->{'width'}, $params->{'height'}, $params->{'image'}) = ($fxmy, $ypx, $fwd, 1, substr($pattern, (($plen - ($bytes * $wd)) / 2) + ($ypx_i * $plen), $fwd * $bytes));
                    $self->blit_write($params);
                }
            } elsif ($gradient) {

                # Top
                if ($ymy != $lymy && $ymy != $lymx && $ymy != $lypx && $ymy != $lypy) {
                    $self->set_color({ 'red' => $rc[$ymy_i], 'green' => $gc[$ymy_i], 'blue' => $bc[$ymy_i] });
                    ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmx, $ymy, $xpx, $ymy);
                    $self->line($params);
                }
                if ($ymx != $lymx && $ymx != $lymy && $ymx != $lypx && $ymx != $lypy) {
                    $self->set_color({ 'red' => $rc[$ymx_i], 'green' => $gc[$ymx_i], 'blue' => $bc[$ymx_i] });
                    ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmy, $ymx, $xpy, $ymx);
                    $self->line($params);
                }

                # Bottom
                if ($ypy != $lypy && $ypy != $lypx && $ypy != $lymy && $ypy != $lymx) {
                    $self->set_color({ 'red' => $rc[$ypy_i], 'green' => $gc[$ypy_i], 'blue' => $bc[$ypy_i] });
                    ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmx, $ypy, $xpx, $ypy);
                    $self->line($params);
                }
                if ($ypx != $lypx && $ypx != $lypy && $ypx != $lymx && $ypx != $lymy) {
                    $self->set_color({ 'red' => $rc[$ypx_i], 'green' => $gc[$ypx_i], 'blue' => $bc[$ypx_i] });
                    ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmy, $ypx, $xpy, $ypx);
                    $self->line($params);
                }
            } else {

                # Top
                if ($ymy != $lymy && $ymy != $lymx && $ymy != $lypx && $ymy != $lypy) {
                    ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmx, $ymy, $xpx, $ymy);
                    $self->line($params);
                }
                if ($ymx != $lymx && $ymx != $lymy && $ymx != $lypx && $ymx != $lypy) {
                    ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmy, $ymx, $xpy, $ymx);
                    $self->line($params);
                }

                # Bottom
                if ($ypy != $lypy && $ypy != $lypx && $ypy != $lymy && $ypy != $lymx) {
                    ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmx, $ypy, $xpx, $ypy);
                    $self->line($params);
                }
                if ($ypx != $lypx && $ypx != $lypy && $ypx != $lymx && $ypx != $lymy) {
                    ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmy, $ypx, $xpy, $ypx);
                    $self->line($params);
                }
            } ## end else [ if ($gradient == 2) ]
            $lymy = $ymy;
            $lymx = $ymx;
            $lypy = $ypy;
            $lypx = $ypx;
        } 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);

            $lymy = $ymy;
            $lymx = $ymx;
            $lypy = $ypy;
            $lypx = $ypx;
        } ## 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) {
                my $x      = $x0 - $r;
                my $y      = $y0;
                my $width  = ($x1 + $r) - ($x0 - $r);
                my $height = $y1 - $y0;
                my $index  = ($y0 - $start) * $plen;
                my $sz     = $plen * $height;
                $self->blit_write({ 'x' => $x, 'y' => $y, 'width' => $width, 'height' => $height, 'image' => substr($pattern, $index, $sz) }) if ($height && $width);
            } elsif ($gradient) {
                foreach my $v ($y0 .. $y1) {
                    my $offset = $v - $start;
                    $self->set_color({ 'red' => $rc[$offset], 'green' => $gc[$offset], 'blue' => $bc[$offset] });
                    $self->line({ 'x' => $x0 - $r, 'y' => $v, 'xx' => $x1 + $r, 'yy' => $v, 'pixel_size' => 1 });
                }
            } 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;
    delete($self->{'history'});
} ## 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 4

 $fb->polygon({
    'coordinates' => [
        5,5,
        23,34,
        70,7
    ],
    'pixel_size'  => 1, # optional
    'antialiased' => 1, # optional only for non-filled
    'filled'      => 1, # optional

    ## Only one of the following, "filled" must be set

    'gradient'    => {  # optional
        'direction' => 'horizontal', # or vertical
        'colors'    => { # 2 to any number of transitions allowed
            'red'   => [255,255,0], # Red to yellow to cyan
            'green' => [0,255,255],
            'blue'  => [0,0,255]
        }
    },
    'texture'     => { # Same as what blit_read or load_image returns
        'width'  => 320,
        'height' => 240,
        'image'  => $raw_image_data
    },
    'hatch'      => 'hatchname' # The exported array @HATCHES contains
                                # the names of all the hatches
 });

=back

* Filled polygons are affected by the acceleration setting.

=cut

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

    my $size = int($params->{'pixel_size'} || 1);
    my $aa = $params->{'antialiased'} || 0;
    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 = int(shift(@coords));
            $y = int(shift(@coords));
            $self->drawto({ 'x' => $x, 'y' => $y, 'pixel_size' => $size, 'antialiased' => $aa });
        }
        $self->drawto({ 'x' => $xx, 'y' => $yy, 'pixel_size' => $size, 'antialiased' => $aa });
        $self->plot({ 'x' => $xx, 'y' => $yy, 'pixel_size' => $size }) if ($self->{'DRAW_MODE'} == 1);
        delete($self->{'history'}) unless ($history_on);
    } ## end else [ if ($params->{'filled'...})]
} ## 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;
    } ## end for (my $i = 0; $i < $poly_corners...)
    return ($odd_nodes);
} ## end sub _point_in_polygon

sub _fill_polygon {
    my $self   = shift;
    my $params = shift;
    my $bytes        = $self->{'BYTES'};

    unless ($self->{'ACCELERATED'} && $params->{'filled'} && $self->{'BITS'} > 16 && scalar(@{$params->{'coordinates'}}) > 8) {
        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, int($params->{'coordinates'}->[$idx]));
            push(@polyY, int($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);
        my $W            = $width * $bytes;
        if (exists($params->{'gradient'})) {
            if (defined($params->{'gradient'}->{'direction'}) && $params->{'gradient'}->{'direction'} !~ /vertical/i) {
                if (exists($params->{'gradient'}->{'colors'})) {
                    $pattern = $self->_generate_fill($width, $height, $params->{'gradient'}->{'colors'},$params->{'gradient'}->{'direction'});
                } else {
                    $pattern = $self->_generate_fill(
                        $width, $height,
                        {
                            'red'   => [$params->{'gradient'}->{'start'}->{'red'},   $params->{'gradient'}->{'end'}->{'red'}],
                              'green' => [$params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}],
                              'blue'  => [$params->{'gradient'}->{'start'}->{'blue'},  $params->{'gradient'}->{'end'}->{'blue'}]
                        },
                        $params->{'gradient'}->{'direction'},
                    );
                } ## end else [ if (exists($params->{'gradient'...}))]
                $gradient = 2;
            } else {
                if (exists($params->{'gradient'}->{'colors'})) {
                    @rc = multi_gradient($height, @{ $params->{'gradient'}->{'colors'}->{'red'} });
                    @gc = multi_gradient($height, @{ $params->{'gradient'}->{'colors'}->{'green'} });
                    @bc = multi_gradient($height, @{ $params->{'gradient'}->{'colors'}->{'blue'} });
                } else {
                    @rc = gradient($params->{'gradient'}->{'start'}->{'red'},   $params->{'gradient'}->{'end'}->{'red'},   $height);
                    @gc = gradient($params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}, $height);
                    @bc = gradient($params->{'gradient'}->{'start'}->{'blue'},  $params->{'gradient'}->{'end'}->{'blue'},  $height);
                }
                $gradient = 1;
            } ## end else [ if ($params->{'gradient'...})]
        } elsif (exists($params->{'texture'})) {
            $pattern = $self->_generate_fill($width,$height,undef,$params->{'texture'});
            $gradient = 2;
        } elsif (exists($params->{'hatch'})) {
            $pattern = $self->_generate_fill($width, $height, undef,$params->{'hatch'});
            $gradient = 2;
        } ## end if (exists($params->{'gradient'...}))
        my $i = 0;

        #    my $nodes = 0;
        my $index = 0;
        foreach my $pixelY (min(@polyY) .. max(@polyY)) {
            my $nodes = 0;
            my $j     = $poly_corners - 1;
            my @nodeX = ();
            foreach my $c (0 .. ($poly_corners - 1)) {
                if (($polyY[$c] <= $pixelY && $polyY[$j] > $pixelY) || ($polyY[$j] <= $pixelY && $polyY[$c] > $pixelY)) {
                    $nodeX[$nodes++] = int(($polyX[$c] + (($pixelY - $polyY[$c]) / ($polyY[$j] - $polyY[$c]) * ($polyX[$j] - $polyX[$c]))));
                }
                $j = $c;
            } ## end foreach my $c (0 .. ($poly_corners...))
            @nodeX = sort(@nodeX);

            if ($gradient == 1) {
                $self->set_color({ 'red' => shift(@rc), 'green' => shift(@gc), 'blue' => shift(@bc), 'alpha' => 255 });
            }
            my $minX = min(@polyX);
            for ($i = 0; $i < $nodes; $i += 2) {
                if ($gradient == 2) {
                    my $begin = $index * $width;
                    $begin += abs(($i * $W) + ($nodeX[$i] - $minX));
                    $begin *= $bytes;
                    my $size = abs(($nodeX[$i + 1] - $nodeX[$i])) * $bytes;
                    my $wdth = abs($nodeX[$i + 1] - $nodeX[$i]);
                    $self->blit_write(
                        {
                            'x'      => $nodeX[$i],
                              'y'      => $pixelY,
                              'width'  => $wdth,
                              'height' => 1,
                              'image'  => substr($pattern, $begin, $size)
                        }
                    );
                } else {
                    $self->line(
                        {
                            'x'  => $nodeX[$i],
                              'y'  => $pixelY,
                              'xx' => $nodeX[$i + 1],
                              'yy' => $pixelY
                        }
                    );
                } ## end else [ if ($gradient == 2) ]
            } ## end for ($i = 0; $i < $nodes...)
            $index++;
        } ## end foreach my $pixelY (min(@polyY...))
        $self->{'COLOR'} = $saved;
    } else {
        my $points = [];
        my $left = 0;
        my $right = 0;
        my $top = 0;
        my $bottom = 0;
        while (scalar(@{$params->{'coordinates'}})) {
            my $x = int(shift(@{$params->{'coordinates'}})) - $self->{'X_CLIP'}; # Compensate for the smaller area in Imager
            my $y = int(shift(@{$params->{'coordinates'}})) - $self->{'Y_CLIP'};
            $left   = min($left,$x);
            $right  = max($right,$x);
            $top    = min($top,$y);
            $bottom = max($bottom,$y);
            push(@{$points},[$x,$y]);
        }
        my $width  = $right - $left;
        my $height = $bottom - $top;
        my $pattern;
        if (exists($params->{'gradient'})) {
            $params->{'gradient'}->{'direction'} ||= 'vertical';
            if (exists($params->{'gradient'}->{'colors'})) {
                $pattern = $self->_generate_fill($width, $height, $params->{'gradient'}->{'colors'},$params->{'gradient'}->{'direction'});
            } else {
                $pattern = $self->_generate_fill(
                    $width, $height,
                    {
                        'red'   => [$params->{'gradient'}->{'start'}->{'red'},   $params->{'gradient'}->{'end'}->{'red'}],
                          'green' => [$params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}],
                          'blue'  => [$params->{'gradient'}->{'start'}->{'blue'},  $params->{'gradient'}->{'end'}->{'blue'}]
                    },
                    $params->{'gradient'}->{'direction'}
                );
            } ## end else [ if (exists($params->{'gradient'...}))]
        } elsif (exists($params->{'texture'})) {
            $pattern = $self->_generate_fill($width,$height,undef,$params->{'texture'});
        } elsif (exists($params->{'hatch'})) {
            $pattern = $self->_generate_fill($width,$height,undef,$params->{'hatch'});
        }

        my $saved = $self->blit_read(
            {
                'x' => $left,
                  'y' => $top,
                  'width' => $width,
                  'height' => $height
            }
        );

        eval {
            my $img = Imager->new(
                'xsize'             => $width,
                'ysize'             => $height,
                'raw_datachannels'  => $bytes,
                'raw_storechannels' => $bytes,
                'channels'          => $bytes,
            );
            unless($self->{'DRAW_MODE'}) {
                $img->read(
                    'xsize'             => $width,
                    'ysize'             => $height,
                    'raw_datachannels'  => $bytes,
                    'raw_storechannels' => $bytes,
                    'channels'          => $bytes,
                    'raw_interleave'    => 0,
                    'data'              => $saved->{'image'},
                    'type'              => 'raw',
                    'allow_incomplete'  => 1
                );
            }
            my $fill;
            if (defined($pattern)) {
                my $pimg = Imager->new();
                    $pimg->read(
                        'xsize'             => $width,
                        'ysize'             => $height,
                        'raw_datachannels'  => $bytes,
                        'raw_storechannels' => $bytes,
                        'raw_interleave'    => 0,
                        'channels'          => $bytes,
                        'data'              => $pattern,
                        'type'              => 'raw',
                        'allow_incomplete'  => 1
                    );

                $fill = Imager::Fill->new(
                    'image' => $pimg
                );
            } else {
                $fill = Imager::Fill->new(
                    'solid' => $self->{'I_COLOR'}
                );
            }
            $img->polygon(
                'points' => $points,
                'color'  => $self->{'I_COLOR'},
                'aa'     => $params->{'antialiased'} || 0,
                'filled' => TRUE,
                'fill'   => $fill,
            );
            $img->write(
                'type'          => 'raw',
                'datachannels'  => max(3,$bytes),
                'storechannels' => max(3,$bytes),
                'interleave'    => 0,
                'data'          => \$saved->{'image'},
            );
        };
        print STDERR "$@\n" if ($@ && $self->{'SHOW_ERRORS'});
        $self->blit_write($saved);
    }
} ## end sub _fill_polygon

sub _generate_fill {
    my $self   = shift;
    my $width  = shift;
    my $height = shift;
    my $colors = shift;
    my $type   = shift;

    my $gradient = '';
    my $bytes = $self->{'BYTES'};
    if (ref($type) eq 'HASH') {
        if ($type->{'width'} != $width || $type->{'height'} != $height) {
            if ($self->{'BITS'} > 16) {
                my $new = $self->blit_transform(
                    {
                        'blit_data' => $type,
                          'scale'     => {
                              'scale_type' => 'nonprop',
                              'x'          => 0,
                              'y'          => 0,
                              'width'      => $width,
                              'height'     => $height
                          }
                    }
                );
                $gradient = $new->{'image'};
            } else {
                my $w = $type->{'width'};
                my $h = $type->{'height'};
                $gradient = $type->{'image'};
                if ($w > $width) {
                    my $new = '';
                    foreach my $line (0 .. ($h - 1)) {
                        $new .= substr($gradient,$line * ($w * $bytes),$width * $bytes);
                    }
                    $gradient = $new;
                    $w = $width;
                } elsif ($w < $width) {
                    my $new = '';
                    foreach my $line (0 .. ($h - 1)) {
                        my $index = $line * ($w * $bytes);
                        my $l = '';
                        while (length($l) < ($width * $bytes)) {
                            $l .= substr($gradient,$index,$w * $bytes);
                        }
                        $new .= substr($l,0,$width * $bytes);
                    }
                    $gradient = $new;
                    $w = $width;
                }
                if ($h > $height) {
                    $gradient = substr($gradient,0,($width * $bytes) * $height);
                    $h = $height;
                } elsif ($h < $height) {
                    my $new = '';
                    my $bline = $width * $bytes;
                    $new = $gradient x ($height / $h);
                    $new = substr($new,0,$bline * $height);
                    $gradient = $new;
                    $h = $height;
                }
            }
        } else {
            $gradient = $type->{'image'};
        }
    } elsif ($type =~ /horizontal/i) {
        my (@rc, @gc, @bc);
        @rc = multi_gradient($width, @{ $colors->{'red'} });
        @gc = multi_gradient($width, @{ $colors->{'green'} });
        @bc = multi_gradient($width, @{ $colors->{'blue'} });
        while (scalar(@rc) < $width) {
            unshift(@rc, $rc[0]);
            unshift(@gc, $gc[0]);
            unshift(@bc, $bc[0]);
        }
        while (scalar(@rc) > $width) {
            pop(@rc);
            pop(@gc);
            pop(@bc);
        }
        my $end = scalar(@rc) - 1;
        foreach my $gcc (0 .. $end) {
            if ($self->{'BITS'} == 32) {
                if ($self->{'COLOR_ORDER'} == BGR) {
                    $gradient .= pack('CCCC',$bc[$gcc],$gc[$gcc],$rc[$gcc],255);
                } elsif ($self->{'COLOR_ORDER'} == BRG) {
                    $gradient .= pack('CCCC',$bc[$gcc],$rc[$gcc],$gc[$gcc],255);
                } elsif ($self->{'COLOR_ORDER'} == RGB) {
                    $gradient .= pack('CCCC',$rc[$gcc],$gc[$gcc],$bc[$gcc],255);
                } elsif ($self->{'COLOR_ORDER'} == RBG) {
                    $gradient .= pack('CCCC',$rc[$gcc],$bc[$gcc],$gc[$gcc],255);
                } elsif ($self->{'COLOR_ORDER'} == GRB) {
                    $gradient .= pack('CCCC',$gc[$gcc],$rc[$gcc],$bc[$gcc],255);
                } elsif ($self->{'COLOR_ORDER'} == GBR) {
                    $gradient .= pack('CCCC',$gc[$gcc],$bc[$gcc],$rc[$gcc],255);
                }
            } elsif ($self->{'BITS'} == 24) {
                if ($self->{'COLOR_ORDER'} == BGR) {
                    $gradient .= pack('CCC',$bc[$gcc],$gc[$gcc],$rc[$gcc]);
                } elsif ($self->{'COLOR_ORDER'} == BRG) {
                    $gradient .= pack('CCC',$bc[$gcc],$rc[$gcc],$gc[$gcc]);
                } elsif ($self->{'COLOR_ORDER'} == RGB) {
                    $gradient .= pack('CCC',$gc[$gcc],$gc[$gcc],$bc[$gcc]);
                } elsif ($self->{'COLOR_ORDER'} == RBG) {
                    $gradient .= pack('CCC',$gc[$gcc],$bc[$gcc],$gc[$gcc]);
                } elsif ($self->{'COLOR_ORDER'} == GRB) {
                    $gradient .= pack('CCC',$gc[$gcc],$rc[$gcc],$bc[$gcc]);
                } elsif ($self->{'COLOR_ORDER'} == GBR) {
                    $gradient .= pack('CCC',$gc[$gcc],$bc[$gcc],$rc[$gcc]);
                }
            } elsif ($self->{'BITS'} == 16) {
                my $temp;
                # Color conversion is done in the pixel conversion
                $temp = $self->RGB888_to_RGB565({ 'color' => pack('CCC',$rc[$gcc], $gc[$gcc], $bc[$gcc]) });
                $gradient .= $temp->{'color'};
            } ## end elsif ($self->{'BITS'} ==...)
        } ## end foreach my $gc (0 .. $end)
        $gradient = $gradient x $height;
    } elsif ($type =~ /vertical/i) {
        my (@rc, @gc, @bc);
        @rc = multi_gradient($height, @{ $colors->{'red'} });
        @gc = multi_gradient($height, @{ $colors->{'green'} });
        @bc = multi_gradient($height, @{ $colors->{'blue'} });
        while (scalar(@rc) < $height) {
            unshift(@rc, $rc[0]);
            unshift(@gc, $gc[0]);
            unshift(@bc, $bc[0]);
        }
        while (scalar(@rc) > $height) {
            pop(@rc);
            pop(@gc);
            pop(@bc);
        }
        my $end = scalar(@rc) - 1;
        foreach my $gcc (0 .. $end) {
            if ($self->{'BITS'} == 32) {
                if ($self->{'COLOR_ORDER'} == BGR) {
                    $gradient .= pack('CCCC',$bc[$gcc],$gc[$gcc],$rc[$gcc],255) x $width;
                } elsif ($self->{'COLOR_ORDER'} == BRG) {
                    $gradient .= pack('CCCC',$bc[$gcc],$rc[$gcc],$gc[$gcc],255) x $width;
                } elsif ($self->{'COLOR_ORDER'} == RGB) {
                    $gradient .= pack('CCCC',$rc[$gcc],$gc[$gcc],$bc[$gcc],255) x $width;
                } elsif ($self->{'COLOR_ORDER'} == RBG) {
                    $gradient .= pack('CCCC',$rc[$gcc],$bc[$gcc],$gc[$gcc],255) x $width;
                } elsif ($self->{'COLOR_ORDER'} == GRB) {
                    $gradient .= pack('CCCC',$gc[$gcc],$rc[$gcc],$bc[$gcc],255) x $width;
                } elsif ($self->{'COLOR_ORDER'} == GBR) {
                    $gradient .= pack('CCCC',$gc[$gcc],$bc[$gcc],$rc[$gcc],255) x $width;
                }
            } elsif ($self->{'BITS'} == 24) {
                if ($self->{'COLOR_ORDER'} == BGR) {
                    $gradient .= pack('CCC',$bc[$gcc],$gc[$gcc],$rc[$gcc]) x $width;
                } elsif ($self->{'COLOR_ORDER'} == BRG) {
                    $gradient .= pack('CCC',$bc[$gcc],$rc[$gcc],$gc[$gcc]) x $width;
                } elsif ($self->{'COLOR_ORDER'} == RGB) {
                    $gradient .= pack('CCC',$gc[$gcc],$gc[$gcc],$bc[$gcc]) x $width;
                } elsif ($self->{'COLOR_ORDER'} == RBG) {
                    $gradient .= pack('CCC',$gc[$gcc],$bc[$gcc],$gc[$gcc]) x $width;
                } elsif ($self->{'COLOR_ORDER'} == GRB) {
                    $gradient .= pack('CCC',$gc[$gcc],$rc[$gcc],$bc[$gcc]) x $width;
                } elsif ($self->{'COLOR_ORDER'} == GBR) {
                    $gradient .= pack('CCC',$gc[$gcc],$bc[$gcc],$rc[$gcc]) x $width;
                }
            } elsif ($self->{'BITS'} == 16) {
                my $temp;
                # Color conversion is done in the pixel conversion
                $temp = $self->RGB888_to_RGB565({ 'color' => pack('CCC',$rc[$gcc], $gc[$gcc], $bc[$gcc]) });
                $gradient .= $temp->{'color'} x $width;
            } ## end elsif ($self->{'BITS'} ==...)
        } ## end foreach my $gc (0 .. $end)
    } else {
        if ($width && $height) {
            eval {
                my $img = Imager->new(
                    'xsize'             => $width,
                    'ysize'             => $height,
                    'channels'          => max(3,$bytes)
                );

                # Hatch types:
                #
                # Checkerboards               -> check1x1, check2x2, check4x4
                # Vertical Lines              -> vline1, vline2, vline4
                # Horizontal Lines            -> hline1, hline2, hline4
                # 45 deg Lines                -> slash1, slash2
                # -45 deg Lines               -> slosh1, slosh2
                # Vertical & Horizontal Lines -> grid1, grid2, grid4
                # Dots                        -> dots1, dots4, dots16
                # Stipples                    -> stipple, stipple2
                # Weave                       -> weave
                # Crosshatch                  -> cross1, cross2
                # Lozenge Tiles               -> vlozenge, hlozenge
                # Scales                      -> scalesdown, scalesup, scalesleft, scalesright
                # L Shaped Tiles              -> tile_L

                my $fill = Imager::Fill->new(
                    'hatch' => $type || 'dots16',
                    'fg'    => $self->{'I_COLOR'},
                    'bg'    => $self->{'BI_COLOR'}
                );
                $img->box(
#            'filled' => 1,
                    'fill'   => $fill
                );
                $img->write(
                    'type'          => 'raw',
                    'datachannels'  => max(3,$bytes),
                    'storechannels' => max(3,$bytes),
                    'interleave'    => 0,
                    'data'          => \$gradient
                );
                $gradient = $self->_convert_24_to_16($gradient, $self->{'COLOR_ORDER'}) if ($self->{'BITS'} == 16);
            };
            print STDERR "$@\n" if ($@ && $self->{'SHOW_ERRORS'});
        }
    }
    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 or texture.

=over 4

 $fb->box({
    'x'          => 20,
    'y'          => 50,
    'xx'         => 70,
    'yy'         => 100,
    'rounded'    => 0, # optional
    'pixel_size' => 1, # optional
    'filled'     => 1, # optional

    ## Only one of the following, "filled" must be set

    'gradient'    => {  # optional
        'direction' => 'horizontal', # or vertical
        'colors'    => { # 2 to any number of transitions allowed
            'red'   => [255,255,0], # Red to yellow to cyan
            'green' => [0,255,255],
            'blue'  => [0,0,255]
        }
    },
    'texture'     => { # Same as what blit_read or load_image returns
        'width'  => 320,
        'height' => 240,
        'image'  => $raw_image_data
    },
    'hatch'      => 'hatchname' # The exported array @HATCHES contains
                                # the names of all the hatches
 });

=back

* This is not affected by the Acceleration setting

=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'}) || exists($params->{'texture'}) || exists($params->{'hatch'}) || !$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 elsif ($filled)
} ## 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 or textures are also allowed.

=over 4

 $fb->rbox({
    'x'          => 100,
    'y'          => 100,
    'width'      => 200,
    'height'     => 150,
    'rounded'    => 0, # optional
    'pixel_size' => 2, # optional
    'filled'     => 0, # optional

    ## Only one of the following, "filled" must be set

    'gradient'    => {  # optional
        'direction' => 'horizontal', # or vertical
        'colors'    => { # 2 to any number of transitions allowed
            'red'   => [255,255,0], # Red to yellow to cyan
            'green' => [0,255,255],
            'blue'  => [0,0,255]
        }
    },
    'texture'     => { # Same as what blit_read or load_image returns
        'width'  => 320,
        'height' => 240,
        'image'  => $raw_image_data
    },
    'hatch'      => 'hatchname' # The exported array @HATCHES contains
                                # the names of all the hatches
 });

=back

* This is not affected by the Acceleration setting

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

 $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 $bytes = $self->{'BYTES'};
    my $R = int($params->{'red'})   & 255;
    my $G = int($params->{'green'}) & 255;
    my $B = int($params->{'blue'})  & 255;
    my $def_alpha = ($name eq 'COLOR') ? 255 : 0;
    my $A = int($params->{'alpha'} || $def_alpha) & 255;

    map { $self->{ $name . '_' . uc($_) } = $params->{$_} } (keys %{$params});
    $params->{'red'}   = $R;
    $params->{'green'} = $G;
    $params->{'blue'}  = $B;
    $params->{'alpha'} = $A;
    if ($self->{'BITS'} > 16) {
        if ($self->{'COLOR_ORDER'} == BGR) {
            ($R,$G,$B) = ($B,$G,$R);
        } elsif ($self->{'COLOR_ORDER'} == BRG) {
            ($R,$G,$B) = ($B,$R,$G);
#       } elsif ($self->{'COLOR_ORDER'} == RGB) {
        } elsif ($self->{'COLOR_ORDER'} == RBG) {
            ($R,$G,$B) = ($R,$B,$G);
        } elsif ($self->{'COLOR_ORDER'} == GRB) {
            ($R,$G,$B) = ($G,$R,$B);
        } elsif ($self->{'COLOR_ORDER'} == GBR) {
            ($R,$G,$B) = ($G,$B,$R);
        }
        $self->{$name} = pack("C$bytes", $R, $G, $B, $A);
    } elsif ($self->{'BITS'} == 16) {
        my $r = $R >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'});
        my $g = $G >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'});
        my $b = $B >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'});
        if ($self->{'COLOR_ORDER'} == BGR) {
            $self->{$name} = pack('S', $b | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})));
        } elsif ($self->{'COLOR_ORDER'} == BRG) {
            $self->{$name} = pack('S', $b | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}))   | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})));
        } elsif ($self->{'COLOR_ORDER'} == RGB) {
            $self->{$name} = pack('S', $r | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})));
        } elsif ($self->{'COLOR_ORDER'} == RBG) {
            $self->{$name} = pack('S', $r | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}))  | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})));
        } elsif ($self->{'COLOR_ORDER'} == GRB) {
            $self->{$name} = pack('S', $g | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}))   | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})));
        } elsif ($self->{'COLOR_ORDER'} == GBR) {
            $self->{$name} = pack('S', $g | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}))  | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})));
        }
    } ## end elsif ($self->{'BITS'} ==...)

    $self->{"SET_$name"} = $params;
    if ($name eq 'COLOR') {
        $self->{'I_COLOR'}  = ($self->{'BITS'} == 32) ? Imager::Color->new($R, $G, $B, $A) : Imager::Color->new($R, $G, $B);
    } else {
        $self->{'BI_COLOR'} = ($self->{'BITS'} == 32) ? Imager::Color->new($R, $G, $B, $A) : Imager::Color->new($R, $G, $B);
    }
} ## 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 4

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

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

 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'   => 16/24/32bit encoded string
 }

=back
=cut

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

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

    # 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) * $bytes);
        if ($self->{'FILE_MODE'}) {
            seek($fb, $index, 0);
            read($fb, $color, $bytes);
        } else {
            $color = substr($self->{'SCREEN'}, $index, $bytes);
        }
        if ($self->{'BITS'} == 32) {
            if ($color_order == BGR) {
                ($B, $G, $R, $A) = unpack("C$bytes", $color);
            } elsif ($color_order == BRG) {
                ($B, $R, $G, $A) = unpack("C$bytes", $color);
            } elsif ($color_order == RGB) {
                ($R, $G, $B, $A) = unpack("C$bytes", $color);
            } elsif ($color_order == RBG) {
                ($R, $B, $G, $A) = unpack("C$bytes", $color);
            } elsif ($color_order == GRB) {
                ($G, $R, $B, $A) = unpack("C$bytes", $color);
            } elsif ($color_order == GBR) {
                ($G, $B, $R, $A) = unpack("C$bytes", $color);
            }
        } else {
            my $C = unpack('S', $color);
            if ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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.

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

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

=back

* This one is greatly affected by the acceleration setting, and likely the one that may give the most trouble.  I have found on some systems Imager just doesn't do what it is asked to, but on others it works fine.  Go figure.  Some if you are getting your entire screen filled and know you are placing the X,Y coordinate correctly, then disabling acceleration before calling this should fix it.  Don't forget to re-enable acceleration when done.

=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'};
    my $bytes = $self->{'BYTES'};

    return if ($back eq $self->{'COLOR'});
    unless($self->{'ACCELERATED'} && $self->{'BITS'} > 16) {
        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))
    } else {
        my $width = $self->{'W_CLIP'};
        my $height = $self->{'H_CLIP'};
        my $pattern;
        if (exists($params->{'gradient'})) {
            $params->{'gradient'}->{'direction'} ||= 'vertical';
            if (exists($params->{'gradient'}->{'colors'})) {
                $pattern = $self->_generate_fill($width, $height, $params->{'gradient'}->{'colors'},$params->{'gradient'}->{'direction'});
            } else {
                $pattern = $self->_generate_fill(
                    $width, $height,
                    {
                        'red'   => [$params->{'gradient'}->{'start'}->{'red'},   $params->{'gradient'}->{'end'}->{'red'}],
                          'green' => [$params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}],
                          'blue'  => [$params->{'gradient'}->{'start'}->{'blue'},  $params->{'gradient'}->{'end'}->{'blue'}]
                    },
                    $params->{'gradient'}->{'direction'}
                );
            } ## end else [ if (exists($params->{'gradient'...}))]
        } elsif (exists($params->{'texture'})) {
            $pattern = $self->_generate_fill($width,$height,undef,$params->{'texture'});
        } elsif (exists($params->{'hatch'})) {
            $pattern = $self->_generate_fill($width,$height,undef,$params->{'hatch'});
        }

        my $saved = $self->blit_read(
            {
                'x'      => $self->{'X_CLIP'},
                  'y'      => $self->{'Y_CLIP'},
                  'width'  => $width,
                  'height' => $height,
            }
        );
        eval {
            my $img = Imager->new(
                'xsize'             => $width,
                'ysize'             => $height,
                'raw_datachannels'  => $bytes,
                'raw_storechannels' => $bytes,
                'channels'          => $bytes,
            );
            unless($self->{'DRAW_MODE'}) {
                $img->read(
                    'xsize'             => $width,
                    'ysize'             => $height,
                    'raw_datachannels'  => $bytes,
                    'raw_storechannels' => $bytes,
                    'channels'          => $bytes,
                    'raw_interleave'    => 0,
                    'data'              => $saved->{'image'},
                    'type'              => 'raw',
                    'allow_incomplete'  => 1
                );
            }

            my $fill;
            if (defined($pattern)) {
                my $pimg = Imager->new();
                $pimg->read(
                    'xsize'             => $width,
                    'ysize'             => $height,
                    'raw_datachannels'  => $bytes,
                    'raw_storechannels' => $bytes,
                    'raw_interleave'    => 0,
                    'channels'          => $bytes,
                    'data'              => $pattern,
                    'type'              => 'raw',
                    'allow_incomplete'  => 1
                );
                $img->flood_fill(
                    'x'      => $x - $self->{'X_CLIP'},
                    'y'      => $y - $self->{'Y_CLIP'},
                    'color'  => $self->{'I_COLOR'},
                    'fill'   => {
                        'image' => $pimg
                    }
                );
            } else {
                $img->flood_fill(
                    'x'      => $x - $self->{'X_CLIP'},
                    'y'      => $y - $self->{'Y_CLIP'},
                    'color'  => $self->{'I_COLOR'},
                );
            }
            $img->write(
                'type'          => 'raw',
                'datachannels'  => max(3,$bytes),
                'storechannels' => max(3,$bytes),
                'interleave'    => 0,
                'data'          => \$saved->{'image'},
            );
        };
        print STDERR "$@\n" if ($@ && $self->{'SHOW_ERRORS'});

        $self->blit_write($saved);
    }
} ## end sub fill

=head2 replace_color

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

In 32 bit mode, the replaced alpha channel is ALWAYS set to 255.

=over 4

 $fb->replace_color({
    'old' => { # Changed as of 5.56
        'red'   => 23,
        'green' => 48,
        'blue'  => 98
    },
    'new' => {
        'red'   => 255,
        'green' => 255,
        'blue'  => 0
    }
 });

=back

* This is not affected by the Acceleration setting, and is just as fast in 16 bit as it is in 24 and 32 bit modes.  Which means, very fast.

=cut

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

    my $old_r = int($params->{'old'}->{'red'})   || 0;
    my $old_g = int($params->{'old'}->{'green'}) || 0;
    my $old_b = int($params->{'old'}->{'blue'})  || 0;
    my $new_r = int($params->{'new'}->{'red'})   || 0;
    my $new_g = int($params->{'new'}->{'green'}) || 0;
    my $new_b = int($params->{'new'}->{'blue'})  || 0;

    my $color_order = $self->{'COLOR_ORDER'};
    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'} = NORMAL_MODE;

    my ($old, $new);
    if ($self->{'BITS'} == 32) {
        if ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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 ($color_order == 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'} ==...)
    my $save = $self->blit_read(
        {
            'x'      => $self->{'X_CLIP'},
              'y'      => $self->{'Y_CLIP'},
              'width'  => $self->{'W_CLIP'},
              'height' => $self->{'H_CLIP'}
        }
    );

    eval("\$save->{'image'} =~ s/$old/$new/sg;");
    $self->blit_write($save);

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

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

=back

* This is not affected by the Acceleration setting

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

Plays an animation sequence loaded from "load_image"

=over 4

 my $animation = $fb->load_image(
     {
         'file'   => 'filename.gif',
         'center' => CENTER_XY
     }
 );

 $fb->play_animation($animation);

=back

The animation is played at the speed described by the file's metadata.

You need to enclose this in a loop if you wish it to play more than once.

=cut

sub play_animation {
    my $self  = shift;
    my $image = shift;

    foreach my $frame (0 .. (scalar(@{$image}) - 1)) {
        my $begin = time;
        $self->blit_write($image->[$frame]);

        my $delay = (($image->[$frame]->{'tags'}->{'gif_delay'} * .01)) - (time - $begin);
        if ($delay > 0) {
            sleep $delay;
        }
    }
}

=head2 acceleration

Enables/Disables all Imager acceleration.

In 24 and 32 bit modes, GFB uses the Imager library to do some drawing.  In some cases, these may not function as they should on some systems.  This method allows you to toggle this acceleration on or off.

When acceleration is off, the underlying (slower) Perl algorithms are used.  It is advisable to leave acceleration on for those methods which it functions correctly, and only shut it off when calling the problem ones.

When called without parameters, it returns the current setting.

=over 4

 $fb->acceleration(1); # Turn acceleration ON

 $fb->acceleration(0); # Turn acceleration OFF

 my $accel = $fb->acceleration(); # Get current acceleration state.

=back

=cut

sub acceleration {
    my $self = shift;
    if (scalar(@_)) {
        my $set = shift;
        $self->{'ACCELERATED'} = $set;
    }
    return($self->{'ACCELERATED'});
} ## 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'.

Passing no parameters automatically grabs the clipping region (the whole screen if clipping is off).

=over 4

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

=back

Returns:

=over 4

 {
     '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.

* Not Imager accelerated, but pretty darn fast regardless.

=cut

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

    my $fb = $self->{'FB'};
    my $x  = int($params->{'x'} || $self->{'X_CLIP'});
    my $y  = int($params->{'y'} || $self->{'Y_CLIP'});
    my $clipw = $self->{'W_CLIP'};
    my $cliph = $self->{'H_CLIP'};
    my $w  = int($params->{'width'} || $clipw);
    my $h  = int($params->{'height'} || $cliph);
    my $bytes = $self->{'BYTES'};
    my $bytes_per_line   = $self->{'BYTES_PER_LINE'};
    my $yoffset = $self->{'YOFFSET'};
    my $fm = $self->{'FILE_MODE'};
    my $buf;

    $x = 0 if ($x < 0);
    $y = 0 if ($y < 0);
    $w = $self->{'XX_CLIP'} - $x if ($w > ($clipw));
    $h = $self->{'YY_CLIP'} - $y if ($h > ($cliph));

    my $yend = $y + $h;
    my $W    = $w * $bytes;
    my $XX   = ($self->{'XOFFSET'} + $x) * $bytes;
    my ($index, $scrn, $line);
    foreach my $line ($y .. ($yend - 1)) {
        $index = ($bytes_per_line * ($line + $yoffset)) + $XX;
        if ($fm) {
            seek($fb, $index, 0);
            read($fb, $buf, $W);
            $scrn .= $buf;
        } else {
            $scrn .= substr($self->{'SCREEN'}, $index, $W);
        }
    } ## end foreach my $line ($y .. ($yend...))

    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 4

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

=back

* Not Imager accelerated, but pretty darn fast regardless.

=cut

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

    my $fb     = $self->{'FB'};
    my $params = $self->_blit_adjust_for_clipping($pparams);
    return unless (defined($params));
    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 $draw_mode      = $self->{'DRAW_MODE'};
    my $bytes          = $self->{'BYTES'};
    my $bytes_per_line = $self->{'BYTES_PER_LINE'};
    my $scrn           = $params->{'image'};
    return unless(defined($scrn));
    my $scan           = $w * $bytes;
    my $yend           = $y + $h;

    #    my $WW = $scan * $h;
    my $WW = int((length($scrn) / $h));
    my $X_X = ($x + $self->{'XOFFSET'}) * $bytes;
    my ($index, $data, $px, $line, $idx, $px4, $buf);

    $idx = 0;
    $y    += $self->{'YOFFSET'};
    $yend += $self->{'YOFFSET'};
    my $max = $self->{'fscreeninfo'}->{'smem_len'} - $bytes;
    eval {
        foreach $line ($y .. ($yend - 1)) {
            $index = ($bytes_per_line * $line) + $X_X;
            if ($index >= 0 && $index <= $max && $idx >= 0 && $idx <= (length($scrn) - $bytes)) {
                if ($draw_mode == 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 ($draw_mode == XOR_MODE) {
                    if ($self->{'FILE_MODE'}) {
                        seek($fb, $index, 0);
                        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 ($draw_mode == OR_MODE) {
                    if ($self->{'FILE_MODE'}) {
                        seek($fb, $index, 0);
                        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 ($draw_mode == ALPHA_MODE) {
                    foreach $px (0 .. ($w - 1)) {
                        $px4 = $px * $bytes;
                        if ($self->{'FILE_MODE'}) {
                            seek($fb, $index, 0);
                            read($fb, $data, $bytes);
                        } else {
                            $data = substr($self->{'SCREEN'}, ($index + $px4), $bytes) || chr(0) x $bytes;
                        }
                        if ($self->{'BITS'} == 32) {
                            my ($r,$g,$b,$a) = unpack("C$bytes",$data);
                            my ($R,$G,$B,$A) = unpack("C$bytes",substr($scrn, ($idx + $px4), $bytes));
                            my $invA = (255 - $A);
                            $r = int(($R * $A) + ($r * $invA)) >> 8;
                            $g = int(($G * $A) + ($g * $invA)) >> 8;
                            $b = int(($B * $A) + ($b * $invA)) >> 8;

                            $a = int($a + $A) & 255;
                            my $c = pack("C$bytes",$r,$g,$b,$a);
                            if (substr($scrn, ($idx + $px4), $bytes) ne $c) {
                                if ($self->{'FILE_MODE'}) {
                                    seek($fb, $index + $px4, 0);
                                    print $fb $c;
                                } else {
                                    substr($self->{'SCREEN'}, ($index + $px4), $bytes) = $c;
                                }
                            } ## end if (substr($scrn, ($idx...)))
                        } elsif ($self->{'BITS'} == 24) {
                            my ($r,$g,$b) = unpack("C$bytes",$data);
                            my ($R,$G,$B) = unpack("C$bytes",substr($scrn, ($idx + $px4), $bytes));
                            my $A = $self->{'COLOR_ALPHA'};
                            my $invA = (255 - $A);
                            $r = int(($R * $A) + ($r * $invA)) >> 8;
                            $g = int(($G * $A) + ($g * $invA)) >> 8;
                            $b = int(($B * $A) + ($b * $invA)) >> 8;
                            my $c = pack('C3',$r,$g,$b);
                            if (substr($scrn, ($idx + $px4), $bytes) ne $c) {
                                if ($self->{'FILE_MODE'}) {
                                    seek($fb, $index + $px4, 0);
                                    print $fb $c;
                                } else {
                                    substr($self->{'SCREEN'}, ($index + $px4), $bytes) = $c;
                                }
                            } ## end if (substr($scrn, ($idx...)))
                        } elsif ($self->{'BITS'} == 16) {
                            my $big = $self->RGB565_to_RGB888({'color' => $data});
                            my ($r,$g,$b) = unpack('C3',$big->{'color'});
                            $big = $self->RGB565_to_RGB888({'color' => substr($scrn,($idx + $px4, $bytes))});
                            my ($R,$G,$B) = unpack('C3',$big->{'color'});
                            my $A = $self->{'COLOR_ALPHA'};
                            my $invA = (255 - $A);
                            $r = int(($R * $A) + ($r * $invA)) >> 8;
                            $g = int(($G * $A) + ($g * $invA)) >> 8;
                            $b = int(($B * $A) + ($b * $invA)) >> 8;
                            my $c = $self->RGB888_to_RGB565({'color' => pack('C3',$r,$g,$b)});
                            $c = $c->{'color'};
                            if (substr($scrn, ($idx + $px4), $bytes) ne $c) {
                                if ($self->{'FILE_MODE'}) {
                                    seek($fb, $index + $px4, 0);
                                    print $fb $c;
                                } else {
                                    substr($self->{'SCREEN'}, ($index + $px4), $bytes) = $c;
                                }
                            } ## end if (substr($scrn, ($idx...)))
                        } ## end elsif ($self->{'BITS'} ==...)
                    } ## end for ($px = 0; $px < $w;...)
                } elsif ($draw_mode == AND_MODE) {
                    if ($self->{'FILE_MODE'}) {
                        seek($fb, $index, 0);
                        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 ($draw_mode == MASK_MODE) {
                    foreach $px (0 .. ($w - 1)) {
                        $px4 = $px * $bytes;
                        if ($self->{'FILE_MODE'}) {
                            seek($fb, $index, 0);
                            read($fb, $data, $bytes);
                        } else {
                            $data = substr($self->{'SCREEN'}, ($index + $px4), $bytes) || chr(0) x $bytes;
                        }
                        if ($self->{'BITS'} == 32) {
                            if (substr($scrn, ($idx + $px4), 3) ne substr($self->{'B_COLOR'}, 0, 3)) {
                                if ($self->{'FILE_MODE'}) {
                                    seek($fb, $index + $px4, 0);
                                    print $fb substr($scrn, ($idx + $px4), $bytes);
                                } else {
                                    substr($self->{'SCREEN'}, ($index + $px4), $bytes) = substr($scrn, ($idx + $px4), $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), $bytes);
                                } else {
                                    substr($self->{'SCREEN'}, ($index + $px4), $bytes) = substr($scrn, ($idx + $px4), $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), $bytes);
                                } else {
                                    substr($self->{'SCREEN'}, ($index + $px4), $bytes) = substr($scrn, ($idx + $px4), $bytes);
                                }
                            } ## end if (substr($scrn, ($idx...)))
                        } ## end elsif ($self->{'BITS'} ==...)
                    } ## end for ($px = 0; $px < $w;...)
                } elsif ($draw_mode == UNMASK_MODE) {
                    foreach $px (0 .. ($w - 1)) {
                        $px4 = $px * $bytes;
                        if ($self->{'FILE_MODE'}) {
                            seek($fb, $index + $px4, 0);
                            read($fb, $data, $bytes);
                        } else {
                            $data = substr($self->{'SCREEN'}, ($index + $px4), $bytes);
                        }
                        if ($self->{'BITS'} == 32) {
                            if (substr($self->{'SCREEN'}, ($index + $px4), 3) eq substr($self->{'B_COLOR'}, 0, 3)) {
                                if ($self->{'FILE_MODE'}) {
                                    seek($fb, $index + $px4, 0);
                                    print $fb substr($scrn, $idx + $px4, $bytes);
                                } else {
                                    substr($self->{'SCREEN'}, ($index + $px4), $bytes) = substr($scrn, ($idx + $px4), $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, $bytes);
                                } else {
                                    substr($self->{'SCREEN'}, ($index + $px4), $bytes) = substr($scrn, ($idx + $px4), $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, $bytes);
                                } else {
                                    substr($self->{'SCREEN'}, ($index + $px4), $bytes) = substr($scrn, ($idx + $px4), $bytes);
                                }
                            } ## end if (substr($self->{'SCREEN'...}))
                        } ## end elsif ($self->{'BITS'} ==...)
                    } ## end for ($px = 0; $px < $w;...)
                } ## end elsif ($draw_mode == UNMASK_MODE)
                $idx += $WW;
            } ## end if ($index >= 0 && $index...)
        } ## end for ($line = $y; $line ...)
        select($self->{'FB'});
        $|++;
    };
    my $error = $@;
    print STDERR "$error\n" if ($error && $self->{'SHOW_ERRORS'});
    $self->_fix_mapping() if ($@);
} ## end sub blit_write

# Chops up the blit image to stay within the clipping (and screen) boundaries
# This prevents nasty crashes
sub _blit_adjust_for_clipping {
    my $self    = shift;
    my $pparams = shift;
    my $bytes = $self->{'BYTES'};
    my $yclip = $self->{'Y_CLIP'};
    my $xclip = $self->{'X_CLIP'};
    my $yyclip = $self->{'YY_CLIP'};
    my $xxclip = $self->{'XX_CLIP'};
    my $params;

    # Make a copy so the original isn't modified.
    %{$params} = %{$pparams};

    # First fix the vertical errors
    my $XX = $params->{'x'} + $params->{'width'};
    my $YY = $params->{'y'} + $params->{'height'};
    return (undef) if ($YY < $yclip || $params->{'height'} < 1 || $XX < $xclip || $params->{'x'} > $xxclip);
    if ($params->{'y'} < $yclip) {    # Top
        $params->{'image'} = substr($params->{'image'}, ($yclip - $params->{'y'}) * ($params->{'width'} * $bytes));
        $params->{'height'} -= ($yclip - $params->{'y'});
        $params->{'y'} = $yclip;
    }
    $YY = $params->{'y'} + $params->{'height'};
    return (undef) if ($params->{'height'} < 1);
    if ($YY > $yyclip) {              # Bottom
        $params->{'image'} = substr($params->{'image'}, 0, ($yyclip - $params->{'y'}) * ($params->{'width'} * $bytes));
        $params->{'height'} = $yyclip - $params->{'y'};
    }

    # Now we fix the horizontal errors
    if ($params->{'x'} < $xclip) {    # Left
        my $line  = $params->{'width'} * $bytes;
        my $index = ($xclip - $params->{'x'}) * $bytes;
        my $w     = $params->{'width'} - ($xclip - $params->{'x'});
        my $new   = '';
        foreach my $yl (0 .. ($params->{'height'} - 1)) {
            $new .= substr($params->{'image'}, ($line * $yl) + $index, $w * $bytes);
        }
        $params->{'image'} = $new;
        $params->{'width'} = $w;
        $params->{'x'}     = $xclip;
    } ## end if ($params->{'x'} < $self...)
    $XX = $params->{'x'} + $params->{'width'};
    if ($XX > $xxclip) {              # Right
        my $line = $params->{'width'} * $bytes;
        my $new  = '';
        my $w    = $xxclip - $params->{'x'};
        foreach my $yl (0 .. ($params->{'height'} - 1)) {
            $new .= substr($params->{'image'}, $line * $yl, $w * $bytes);
        }
        $params->{'image'} = $new;
        $params->{'width'} = $w;
    } ## end if ($XX > $self->{'XX_CLIP'...})
#    return($params);
    my $size = ($params->{'width'} * $params->{'height'}) * $bytes;
    if (length($params->{'image'}) < $size) {
        $params->{'image'} .= chr(0) x ($size - length($params->{'image'}));
    } elsif (length($params->{'image'}) > $size) {
        $params->{'image'} = substr($params->{'image'},0,$size);
    }
    return ($params);
} ## end sub _blit_adjust_for_clipping

=head2 blit_transform

This performs transformations on your blit objects.

You can only have one of "rotate", "scale", "merge" or "flip".

=head3 B<blit_data> (mandatory)

Used by all transformations.  It's the image data to process, in the format that "blit_write" uses.  See the example below.

=head3 B<flip> (works in 16 bit too)

Flips the image either "horizontally, "vertically, or "both"

=head3 B<merge> (works fast only in 24/32 bit modes)

Merges one image on top of the other.  "blit_data" is the top image, and "dest_blit_data" is the background image.  This takes into account alpha data values for each pixel (if in 32 bit mode).

This is very usefull in 32 bit mode due to its alpha channel capabilities.

=head3 B<rotate> (accelerated in 24/32 bit mode)

Rotates the "blit_data" image an arbitrary degree.  Positive degree values are counterclockwise and negative degree values are clockwise.

Due to the limitations of the Imager library, 16 bit mode uses a Perl rotate routine, which is obviously slower.  Hence another reason to use 32 bit mode, if it's available to your display device.  Nevertheless, on low resolution TFTs, even the Perl rotate is pretty darn fast.

=head3 B<scale> (works fast only in 24/32 bit modes)

Scales the image to "width" x "height".  This is the same as how scale works in "load_image".  The "type" value tells it how to scale (see the example).

* For 16 bit scaling, scale the image at loading time with the "load_image" method and its scaling.

=over 4

 $fb->blit_transform(
     {
         # blit_data is mandatory
         'blit_data' => { # Same as what blit_read or load_image returns
             'x'      => 0, # This is relative to the dimensions of "dest_blit_data" for "merge"
             'y'      => 0, # ^^
             'width'  => 300,
             'height' => 200,
             'image'  => $image_data
         },

         'merge'  => {
             'dest_blit_data' => { # MUST have same or greater dimensions as 'blit_data'
                 'x'      => 0,
                 'y'      => 0,
                 'width'  => 300,
                 'height' => 200,
                 'image'  => $image_data
             }
         },

         'rotate' => {
             'degrees' => 45, # 0-360 degrees. Negative numbers rotate clockwise.
         },

         'flip' => 'horizontal', # or "vertical" or "both"

         'scale'  => {
             'x'          => 0,
             'y'          => 0,
             'width'      => 500,
             'height'     => 300,
             'scale_type' => 'min' #  '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.
         },

         'monochrome' => 1         # Makes the image data monochrome
     }
 );

=back

It returns the transformed image in the same format the other BLIT methods use.  Note, the width and height may be changed!

=over 4

 {
     'x'      => 0,     # copied from "blit_data"
     'y'      => 0,     # copied from "blit_data"
     'width'  => 100,   # width of transformed image data
     'height' => 100,   # height of transformed image data
     'image'  => $image # image data
 }

=back

* Rotate and Flip is affected by the acceleration setting.

=cut

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

    my $width     = $params->{'blit_data'}->{'width'};
    my $height    = $params->{'blit_data'}->{'height'};
    my $bytes     = $self->{'BYTES'};
    my $bline     = $width * $bytes;
    my $image     = $params->{'blit_data'}->{'image'};
    my $xclip     = $self->{'X_CLIP'};
    my $yclip     = $self->{'Y_CLIP'};
    my $data;

    if (exists($params->{'merge'})) {
        $image = $self->_convert_16_to_24($image,$self->{'COLOR_ORDER'}) if ($self->{'BITS'} == 16);
        eval {
            my $img = Imager->new();
            $img->read(
                'xsize'             => $width,
                'ysize'             => $height,
                'raw_datachannels'  => $bytes,
                'raw_storechannels' => $bytes,
                'raw_interleave'    => 0,
                'data'              => $image,
                'type'              => 'raw',
                'allow_incomplete'  => 1
            );
            my $dest = Imager->new();
            $dest->read(
                'xsize'             => $params->{'merge'}->{'dest_blit_data'}->{'width'},
                'ysize'             => $params->{'merge'}->{'dest_blit_data'}->{'height'},
                'raw_datachannels'  => $bytes,
                'raw_storechannels' => $bytes,
                'raw_interleave'    => 0,
                'data'              => $params->{'merge'}->{'dest_blit_data'}->{'image'},
                'type'              => 'raw',
                'allow_incomplete'  => 1
            );
            $dest->compose(
                'src' => $img,
                'tx'  => $params->{'blit_data'}->{'x'},
                'ty'  => $params->{'blit_data'}->{'y'},
            );
            $width  = $dest->getwidth();
            $height = $dest->getheight();
            $dest->write(
                'type'          => 'raw',
                'datachannels'  => $bytes,
                'storechannels' => $bytes,
                'interleave'    => 0,
                'data'          => \$data
            );
        };
        print STDERR "$@\n" if ($@ && $self->{'SHOW_ERRORS'});

        $data = $self->_convert_24_to_16($image,$self->{'COLOR_ORDER'}) if ($self->{'BITS'} == 16);
        return (
            {
                'x'      => $params->{'merge'}->{'dest_blit_data'}->{'x'},
                  'y'      => $params->{'merge'}->{'dest_blit_data'}->{'y'},
                  'width'  => $width,
                  'height' => $height,
                  'image'  => $data
            }
        );
    } ## end if (exists($params->{'merge'...}))
    if (exists($params->{'flip'})) {
        if ($self->{'ACCELERATED'} && $self->{'BITS'} > 16) {
            eval {
                my $img = Imager->new();
                $img->read(
                    'xsize'             => $width,
                    'ysize'             => $height,
                    'raw_storechannels' => $bytes,
                    'raw_datachannels'  => $bytes,
                    'raw_interleave'    => 0,
                    'data'              => $image,
                    'type'              => 'raw',
                    'allow_incomplete'  => 1
                );
                my $dir = lc($params->{'flip'});
                if ($dir eq 'vertical') {
                    $img->flip('dir' => 'v');
                } elsif ($dir eq 'horizontal') {
                    $img->flip('dir' => 'h');
                } elsif ($dir eq 'both') {
                    $img->flip('dir' => 'vh');
                }
                $width  = $img->getwidth();
                $height = $img->getheight();
                $img->write(
                    'type'          => 'raw',
                    'storechannels' => $bytes,
                    'interleave'    => 0,
                    'data'          => \$data
                );
            };
            print STDERR "$@\n" if ($@ && $self->{'SHOW_ERRORS'});
            return (
                {
                    'x'      => $params->{'blit_data'}->{'x'},
                      'y'      => $params->{'blit_data'}->{'y'},
                      'width'  => $width,
                      'height' => $height,
                      'image'  => $data
                }
            );
        } else {
            my $image = $params->{'blit_data'}->{'image'};
            my $new   = '';
            if (lc($params->{'flip'}) eq 'vertical') {

                for (my $y = ($height - 1); $y >= 0; $y--) {
                    $new .= substr($image, ($y * $bline), $bline);
                }
            } elsif (lc($params->{'flip'}) eq 'horizontal') {
                foreach my $y (0 .. ($height - 1)) {
                    for (my $x = ($width - 1); $x >= 0; $x--) {
                        $new .= substr($image, (($x * $bytes) + ($y * $bline)), $bytes);
                    }
                }
            } else {
                $new = "$image";
            }
            return (
                {
                    'x'      => $params->{'blit_data'}->{'x'},
                      'y'      => $params->{'blit_data'}->{'y'},
                      'width'  => $width,
                      'height' => $height,
                      'image'  => $new
                }
            );
        }
    } elsif (exists($params->{'rotate'})) {
        my $degrees = $params->{'rotate'}->{'degrees'};
        return ($params->{'blit_data'}) if (abs($degrees) == 360 || $degrees == 0);    # 0 and 360 are not a rotation
#        my $img;
        unless ($self->{'ACCELERATED'} && $self->{'BITS'} > 16) {                      # Imager doesn't work in 16 bit mode. So we do this in Perl
            # Multiples of 90 can be rotated quicker
            if (abs($degrees) == 90) {
                if ($degrees == 90) {
                    for(my $x=($width - 1); $x>=0; $x--) {
                        foreach my $y (0 .. ($height - 1)) {
                            $data .= substr($image,($x * $bytes) + ($y * $bline),$bytes);
                        }
                    }
                } else {
                    foreach my $x (0 .. ($width - 1)) {
                        for(my $y=($height - 1); $y>=0; $y--) {
                            $data .= substr($image,($x * $bytes) + ($y * $bline),$bytes);
                        }
                    }
                }
                return (
                    {
                        'x'      => $params->{'blit_data'}->{'x'},
                          'y'      => $params->{'blit_data'}->{'y'},
                          'width'  => $height,
                          'height' => $width,
                          'image'  => $data
                    }
                );
            } elsif (abs($degrees) == 180) {
                my $new = '';
                for (my $y = ($height - 1); $y >= 0; $y--) {
                    $new .= substr($image, ($y * $bline), $bline);
                }
                foreach my $y (0 .. ($height - 1)) {
                    for (my $x = ($width - 1); $x >= 0; $x--) {
                        $data .= substr($new, (($x * $bytes) + ($y * $bline)), $bytes);
                    }
                }
                return (
                    {
                        'x'      => $params->{'blit_data'}->{'x'},
                          'y'      => $params->{'blit_data'}->{'y'},
                          'width'  => $width,
                          'height' => $height,
                          'image'  => $data
                    }
                );
            } else { # Not a multiple of 90, so rotate the slow way
                my $wh = max(int(sqrt($width**2 + $height**2)+.5),$width, $height);
                # Try to define as much as possible before the loop to optimize
                my $hwh = int($wh / 2 + .5);
                my $bbline = $wh * $bytes;
                $data = $self->{'B_COLOR'} x (($wh * $wh) * $bytes);
                my $hwidth  = int($width / 2 + .5);
                my $hheight = int($height / 2 + .5);
                my $sinma   = sin(($degrees * pi) / 180);
                my $cosma   = cos(($degrees * pi) / 180);

                foreach my $x (0 .. ($wh - 1)) { # This is faster than for(x=0
                    my $xt = int($x - $hwh);
                    foreach my $y (0 .. ($wh - 1)) {
                        my $yt = int($y - $hwh);
                        my $xs = int(($cosma * $xt - $sinma * $yt) + $hwidth);
                        my $ys = int(($sinma * $xt + $cosma * $yt) + $hheight);
                        if ($xs >= 0 && $xs < $width && $ys >= 0 && $ys < $height) { # Pixel by stinking pixel.  ZZZZzzzz....
                            substr($data, ($x * $bytes) + ($y * $bbline), $bytes) = substr($image, ($xs * $bytes) + ($ys * $bline), $bytes);
                        }
                    } ## end for (my $y = 0; $y < $wh...)
                } ## end for (my $x = 0; $x < $wh...)
                return (
                    {
                        'x'      => $params->{'blit_data'}->{'x'},
                          'y'      => $params->{'blit_data'}->{'y'},
                          'width'  => $wh,
                          'height' => $wh,
                          'image'  => $data
                    }
                );
            }
        } else {
            eval {
                my $img = Imager->new();
                $img->read(
                    'xsize'             => $width,
                    'ysize'             => $height,
                    'raw_storechannels' => $bytes,
                    'raw_datachannels'  => $bytes,
                    'raw_interleave'    => 0,
                    'data'              => $image,
                    'type'              => 'raw',
                    'allow_incomplete'  => 1
                );
                my $rotated;
                if (abs($degrees) == 90 || abs($degrees) == 180 || abs($degrees) == 270) {
                    $rotated = $img->rotate('right' => 360 - $degrees, 'back' => $self->{'BI_COLOR'});
                } else {
                    $rotated = $img->rotate('degrees' => 360 - $degrees, 'back' => $self->{'BI_COLOR'});
                }
                $width  = $rotated->getwidth();
                $height = $rotated->getheight();
                $img    = $rotated;
                $img->write(
                    'type'          => 'raw',
                    'storechannels' => $bytes,
                    'interleave'    => 0,
                    'data'          => \$data
                );
            };
            print STDERR "$@\n" if ($@ && $self->{'SHOW_ERRORS'});
        }
        return (
            {
                'x'      => $params->{'blit_data'}->{'x'},
                  'y'      => $params->{'blit_data'}->{'y'},
                  'width'  => $width,
                  'height' => $height,
                  'image'  => $data
            }
        );
    } elsif (exists($params->{'scale'})) {
        $image = $self->_convert_16_to_24($image,$self->{'COLOR_ORDER'}) if ($self->{'BITS'} == 16);
#        return($params->{'blit_data'}) if ($self->{'BITS'} == 16); # Scaling no workie in 16.  So send back the original
        eval {
            my $img = Imager->new();
            $img->read(
                'xsize'             => $width,
                'ysize'             => $height,
                'raw_storechannels' => max(3,$bytes),
                'raw_datachannels'  => max(3,$bytes),
                'raw_interleave'    => 0,
                'data'              => $image,
                'type'              => 'raw',
                'allow_incomplete'  => 1
            );

            $img = $img->convert('preset' => 'addalpha') if ($self->{'BITS'} == 32);
            my %scale = (
                'xpixels' => $params->{'scale'}->{'width'},
                'ypixels' => $params->{'scale'}->{'height'},
                'type'    => $params->{'scale'}->{'scale_type'} || 'min'
            );
            my ($xs, $ys);

            ($xs, $ys, $width, $height) = $img->scale_calculate(%scale);
            my $scaledimg = $img->scale(%scale);
            $scaledimg->write(
                'type'          => 'raw',
                'storechannels' => max(3,$bytes),
                'interleave'    => 0,
                'data'          => \$data
            );
        };
        print STDERR "$@\n" if ($@ && $self->{'SHOW_ERRORS'});
        $data = $self->_convert_24_to_16($image,$self->{'COLOR_ORDER'}) if ($self->{'BITS'} == 16);
        return (
            {
                'x'      => $params->{'blit_data'}->{'x'},
                  'y'      => $params->{'blit_data'}->{'y'},
                  'width'  => $width,
                  'height' => $height,
                  'image'  => $data
            }
        );
    } elsif (exists($params->{'monochrome'})) {
        return ($self->monochrome({ 'image' => $params->{'blit_data'}, 'bits' => $self->{'BITS'} }));
    } elsif (exists($params->{'center'})) {
        my $XX = $self->{'W_CLIP'};
        my $YY = $self->{'H_CLIP'};
        my ($x,$y) = ($params->{'blit_data'}->{'x'},$params->{'blit_data'}->{'y'});
        if ($params->{'center'} == CENTER_X || $params->{'center'} == CENTER_XY) {
            $x  = $xclip + int(($XX - $width) / 2);
        }
        if ($params->{'center'} == CENTER_Y || $params->{'center'} == CENTER_XY) {
            $y  = $self->{'Y_CLIP'} + int(($YY - $height) / 2);
        }
        return(
            {
                'x'      => $x,
                  'y'      => $y,
                  'width'  => $width,
                  'height' => $height,
                  'image'  => $params->{'blit_data'}->{'image'}
            }
        );

    }
} ## end sub blit_transform

=head2 clip_reset

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

=over 4

 $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->{'W_CLIP'}  = $self->{'XX_CLIP'} - $self->{'X_CLIP'};
    $self->{'H_CLIP'}  = $self->{'YY_CLIP'} - $self->{'Y_CLIP'};
    $self->{'CLIPPED'} = FALSE;                   # This is merely a flag to see if a clipping
    # region is defined under the screen dimensions.
} ## 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 4

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

 $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->{'W_CLIP'}  = $self->{'XX_CLIP'} - $self->{'X_CLIP'};
    $self->{'H_CLIP'}  = $self->{'YY_CLIP'} - $self->{'Y_CLIP'};
    $self->{'CLIPPED'} = TRUE;
} ## end sub clip_set

=head2 clip_rset

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

=over 4

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

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

 $fb->monochrome({
     'image' => "image data",
     'bits'  => 32
 });

 It returns 'image' back, but now in greyscale (still the same RGB formnat though).

 {
     'image' => "monochrome image data"
 }

=back
=cut

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

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

    my ($ro, $go, $bo) = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}, $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}, $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'});
    my ($rl, $gl, $bl) = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'}, $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'}, $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'});
    my $color_order = $self->{'COLOR_ORDER'};
    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 $rgb565 = unpack('S', substr($params->{'image'}, $byte, $inc));
            if ($color_order == RGB) {
                $r = $rgb565 & 31;
                $g = (($rgb565 >> 5) & 63) / 2;    # Normalize green
                $b = ($rgb565 >> 11) & 31;
            } elsif ($color_order == BGR) {
                $b = $rgb565 & 31;
                $g = (($rgb565 >> 5) & 63) / 2;    # Normalize green
                $r = ($rgb565 >> 11) & 31;
            }
            my $mono = int(0.2126 * $r + 0.7152 * $g + 0.0722 * $b);
            substr($params->{'image'}, $byte, $inc) = pack('S', ($go ? ($mono * 2) << $go : ($mono * 2)) | ($ro ? $mono << $ro : $mono) | ($bo ? $mono << $bo : $mono));
        } else {
            if ($color_order == BGR) {
                ($b, $g, $r) = unpack('C3', substr($params->{'image'}, $byte, 3));
            } elsif ($color_order == BRG) {
                ($b, $r, $g) = unpack('C3', substr($params->{'image'}, $byte, 3));
            } elsif ($color_order == RGB) {
                ($r, $g, $b) = unpack('C3', substr($params->{'image'}, $byte, 3));
            } elsif ($color_order == RBG) {
                ($r, $b, $g) = unpack('C3', substr($params->{'image'}, $byte, 3));
            } elsif ($color_order == GRB) {
                ($g, $r, $b) = unpack('C3', substr($params->{'image'}, $byte, 3));
            } elsif ($color_order == 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 4

 my $bounding_box = $fb->ttf_print({
     'x'            => 20,
     'y'            => 100, # baseline position
     'height'       => 16,
     'wscale'       => 1,   # Scales the width.  1 is normal
     'color'        => 'FFFF00FF', # Hex value of color 00-FF (RRGGBBAA)
     '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 4

 $fb->ttf_print(
     $fb->ttf_print({
         'x'            => 20,
         'y'            => 100, # baseline position
         'height'       => 16,
         'color'        => 'FFFF00FF', # RRGGBBAA
         'text'         => 'Hello World!',
         'font_path'    => '/usr/share/fonts/truetype',
         'face'         => 'Arial.ttf',
         'bounding_box' => 1,
         'rotate'       => 45,    # optonal
         'center'       => 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.

This works best in 24 or 32 bit 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.

=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.   #
    ##############################################################################
    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'})  || 6;
    my $TTF_ph      = int($params->{'pheight'}) || 6;
    my $TTF_h       = int($params->{'height'})  || 6;
    my $P_color     = $params->{'color'}        || 'FFFFFFFF';
    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 $color_order = $self->{'COLOR_ORDER'};
    my $bytes       = $self->{'BYTES'};
    my ($data, $shadow_font, $neg_width, $global_descent, $pos_width, $global_ascent, $descent, $ascent, $advance_width, $right_bearing); # = ('','',0,0,0,0,0,0,0,0);
    $P_color .= 'FF' if (length($P_color) < 8);    # Add opague alpha if it is not defined
    my ($red, $green, $blue, $alpha) = (substr($P_color, 0, 2), substr($P_color, 2, 2), substr($P_color, 4, 2), substr($P_color, 6, 2));
    if ($color_order == BGR) {
        $P_color = $blue . $green . $red . $alpha;
    } elsif ($color_order == BRG) {
        $P_color = $blue . $red . $green . $alpha;
    } elsif ($color_order == RBG) {
        $P_color = $red . $blue . $green . $alpha;
    } elsif ($color_order == GRB) {
        $P_color = $green . $red . $blue . $alpha;
    } elsif ($color_order == GBR) {
        $P_color = $green . $blue . $red . $alpha;
    }

    my $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);
    }
    if (defined($params->{'rotate'}) && abs($params->{'rotate'}) > 0 && abs($params->{'rotate'} < 360)) {
        my $matrix;
        eval { $matrix = Imager::Matrix2d->rotate('degrees' => $params->{'rotate'}); };
        if ($@ && $self->{'SHOW_ERRORS'}) {
            print STDERR "Can't rotate font\n", Imager->errstr(), "\n";
        }
        eval { $font->transform('matrix' => $matrix); };
        if ($@ && $self->{'SHOW_ERRORS'}) {
            print STDERR "Can't transform font\n", Imager->errstr(), "\n";
        }
        my $bbox;
        eval { $bbox = $font->bounding_box('string' => $text, 'canon' => 1, 'size' => $TTF_h, 'sizew' => $sizew); };
        if ($@ && $self->{'SHOW_ERRORS'}) {
            print STDERR "Can't get prliminary bounding box for rotated text\n", Imager->errstr(), "\n";
        }

        my ($left, $miny, $right, $maxy) = _transformed_bounds($bbox, $matrix);
        my ($top, $bottom) = (-$maxy, -$miny);
        ($TTF_pw, $TTF_ph) = ($right - $left, $bottom - $top);
        $params->{'pwidth'}  = $TTF_pw;
        $params->{'pheight'} = $TTF_ph;
#        $TTF_x = $left;
#        $TTF_y = $miny;

    } else {
        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));
        $TTF_pw              = abs($advance_width);
    }
    if ($center_mode == CENTER_XY) {
        $TTF_x = int(($self->{'W_CLIP'} - $TTF_pw) / 2) + $self->{'X_CLIP'};
        $TTF_y = int(($self->{'H_CLIP'} - $TTF_ph) / 2) + abs($global_ascent);
    } elsif ($center_mode == CENTER_X) {
        $TTF_x = int(($self->{'W_CLIP'} - $TTF_pw) / 2) + $self->{'X_CLIP'};
    } elsif ($center_mode == CENTER_Y) {
        $TTF_y = int(($self->{'H_CLIP'} - $TTF_ph) / 2) + abs($global_ascent);
    }
    $params->{'bounding_box'} = FALSE;
    if ($box_mode) {
        $params->{'x'} = $TTF_x;
        $params->{'y'} = $TTF_y;
        return ($params);
    }
    eval {
        my $img = Imager->new(
            'xsize'    => $TTF_pw,
            'ysize'    => $TTF_ph,
            'channels' => max(3, $bytes)
        );
        if ($self->{'BITS'} >= 24) {
            my $image = $self->blit_read({ 'x' => $TTF_x, 'y' => ($TTF_y - abs($global_ascent)), 'width' => $TTF_pw, 'height' => $TTF_ph });
            unless($self->{'DRAW_MODE'}) {
                $img->read(
                    'data'              => $image->{'image'},
                    'type'              => 'raw',
                    'raw_datachannels'  => $bytes,
                    'raw_storechannels' => $bytes,
                    'raw_interleave'    => 0,
                    'xsize'             => $TTF_pw,
                    'ysize'             => $TTF_ph
                );
            }
        } else {
            $img->box('xmin' => 0, 'ymin' => 0, 'xmax' => ($TTF_pw - 1), 'ymax' => ($TTF_ph - 1), 'filled' => 1, 'color' => $self->{'BI_COLOR'});
        }
        $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, $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, $self->{'COLOR_ORDER'}) 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

sub _gather_fonts {
    my $self = shift;
    my $path = shift;

    opendir(my $DIR, $path);
    chomp(my @dir = readdir($DIR));
    closedir($DIR);

    foreach my $file (@dir) {
        next if ($file =~ /^\./);
        if (-d "$path/$file") {
            $self->_gather_fonts("$path/$file");
        } elsif ($file =~ /\.(ttf|afb)$/i) {
            my $face = $self->get_face_name({ 'font_path' => $path, 'face' => $file });
            $self->{'FONTS'}->{$face} = { 'path' => $path, 'font' => $file };
        }
    } ## end foreach my $file (@dir)
} ## end sub _gather_fonts

=head2 get_face_name

Returns the TrueType face name based on the parameters passed.

 my $face_name = $fb->get_face_name({
     'font_path' => '/usr/share/fonts/TrueType/',
     'face'      => 'FontFileName.ttf'
 });

=cut

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

    my $file = $params->{'font_path'} . '/' . $params->{'face'};
    my $face = Imager::Font->new('file' => $file);
    if ($face->can('face_name')) {
        my $face_name = $face->face_name();
        if ($face_name eq '') {
            $face_name = $params->{'face'};
            $face_name =~ s/\.(ttf|pfb)$//i;
        }
        return ($face_name);
    } ## end if ($face->can('face_name'...))
    return ($file);
} ## 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 give 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 relatively fast.

=over 4

 $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.  It fits the image to this
                                   # size.

             'height'     => 1080, # Optional. Resizes to this maximum
                                   # height.  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
             'convertalpha' => 1   # Converts the color matching the global
                                   # background color to have the same alpha
                                   # channel value as the global background,
                                   # which is beneficial for using 'merge'
                                   # in 'blit_transform'.
         }
     )
 );

=back

If a single image is loaded, it returns a reference to an anonymous hash, of the format:

=over 4

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

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

      'width'       => Width of the image,

      'height'      => Height of the image,

      'tags'        => The tags of the image (hashref)

      'image'       => [raw image data]
 }

=back

If the image has multiple frames, then a reference to an array of hashes is returned:

=over 4

 # NOTE:  X and Y positions can change frame to frame, so use them for each frame!
 #        Also, X and Y are based upon what was originally passed through, else they
 #        reference 0,0 (but only if you didn't give an X,Y value initially).

 [
     { # Frame 1
         'x'           => horizontal position calculated (or passed through),

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

         'width'       => Width of the image,

         'height'      => Height of the image,

         'tags'        => The tags of the image (hashref)

         'image'       => [raw image data]
     },
     { # Frame 2 (and so on)
         'x'           => horizontal position calculated (or passed through),

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

         'width'       => Width of the image,

         'height'      => Height of the image,

         'tags'        => The tags of the image (hashref)

         'image'       => [raw image data]
     }
 ]

=back

=cut

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

    my @odata;
    my @Img;
    my ($x, $y, $xs, $ys, $w, $h, $last_img);
    my $bench_scale;
    my $bench_rotate;
    my $bench_convert;
    my $bench_total = time;
    my $bench_load  = time;
    my $color_order = $self->{'COLOR_ORDER'};
    if ($params->{'file'} =~ /\.gif$/i) {
        eval {
            @Img = Imager->read_multi('file' => $params->{'file'},);
        };
        print STDERR "$@\n" if ($@ && $self->{'SHOW_ERRORS'});
    } else {
        eval {
            $Img[0] = Imager->new(
                'file'       => $params->{'file'},
                'interleave' => 0
            );
        };
        print STDERR "$@\n" if ($@ && $self->{'SHOW_ERRORS'});
    } ## end else [ if ($params->{'file'} ...)]
    $bench_load = sprintf('%.03f', time - $bench_load);
    unless (defined($Img[0])) {
        warn "I can't get Imager to set up an image buffer!\n", Imager->errstr(), "\n" if ($self->{'SHOW_ERRORS'});
    } else {
        foreach my $img (@Img) {
            next unless (defined($img));
            my %tags = map(@$_, $img->tags());
            if (exists($tags{'gif_trans_color'}) && defined($last_img)) {
                $last_img->compose(
                    'src' => $img,
                    'tx'  => $tags{'gif_left'},
                    'ty'  => $tags{'gif_top'},
                );
                $img = $last_img;
            } ## end if (exists($tags{'gif_trans_color'...}))
            $last_img = $img->copy() unless (defined($last_img));
            $bench_rotate = time;
            if (exists($tags{'exif_orientation'})) {
                my $orientation = $tags{'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...))
            } ## end if (exists($tags{'exif_orientation'...}))
            $bench_rotate = sprintf('%.03f', time - $bench_rotate);

            # Sometimes it works great, sometimes it looks uuuuuugly
            $img->filter('type' => 'autolevels') if ($params->{'autolevels'});

            $bench_scale = time;
            my %scale;
            $w = int($img->getwidth());
            $h = int($img->getheight());
            my $channels = $img->getchannels();
            my $bits     = $img->bits();

            # Scale the image, if asked to
            if ($params->{'file'} =~ /\.gif$/i && !exists($params->{'width'}) && !exists($params->{'height'})) {
                ($params->{'width'}, $params->{'height'}) = ($w + .1, $h + .1);
            }
            $params->{'width'}  = min($self->{'XRES'},int($params->{'width'} || $w));
            $params->{'height'} = min($self->{'YRES'},int($params->{'height'} || $h));
            if (defined($xs)) {
                $scale{'xscalefactor'} = $xs;
                $scale{'yscalefactor'} = $ys;
                $scale{'type'}         = $params->{'scale_type'} || 'min';
                $img                   = $img->scale(%scale);
            } else {
                $scale{'xpixels'} = int($params->{'width'});
                $scale{'ypixels'} = int($params->{'height'});
                $scale{'type'}    = $params->{'scale_type'} || 'min';
                ($xs, $ys, $w, $h) = $img->scale_calculate(%scale);
                $img = $img->scale(%scale);
            } ## end else [ if (defined($xs)) ]
            $w           = int($img->getwidth());
            $h           = int($img->getheight());
            $bench_scale = sprintf('%.03f', time - $bench_scale);
            my $data = '';
            $bench_convert = time;
            if ($self->{'BITS'} >= 24) {
                if ($color_order == BGR) {
                    $img = $img->convert('matrix' => [[0, 0, 1, 0], [0, 1, 0, 0], [1, 0, 0, 0], [0, 0, 0, 1]]);
                } elsif ($color_order == BRG) {
                    $img = $img->convert('matrix' => [[0, 0, 1, 0], [1, 0, 0, 0], [0, 1, 0, 0], [0, 0, 0, 1]]);
                } elsif ($color_order == RBG) {
                    $img = $img->convert('matrix' => [[1, 0, 0, 0], [0, 0, 1, 0], [0, 1, 0, 0], [0, 0, 0, 1]]);
                } elsif ($color_order == GRB) {
                    $img = $img->convert('matrix' => [[0, 1, 0, 0], [1, 0, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]]);
                } elsif ($color_order == GBR) {
                    $img = $img->convert('matrix' => [[0, 1, 0, 0], [0, 0, 1, 0], [1, 0, 0, 0], [0, 0, 0, 1]]);
                }
            } ## end if ($self->{'BITS'} >=...)
            if ($self->{'BITS'} >= 24) {
                $img = $img->convert('preset' => 'addalpha') if ($channels == 3);
                if ($self->{'BITS'} == 32) {
                    $img->write(
                        'type'          => 'raw',
                        'interleave'    => 0,
                        'datachannels'  => 4,
                        'storechannels' => 4,
                        'data'          => \$data
                    );
                    if ($params->{'convertalpha'}) {
                        my $oback = substr($self->{'B_COLOR'}, 0, 3);
                        my $nback = $self->{'B_COLOR'};
                        $data =~ s/$oback./$nback/g;
                    }
                } 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
                $channels = $img->getchannels();
                $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, RGB);
            } ## end else [ if ($self->{'BITS'} >=...)]

            if (exists($params->{'center'})) {
                if ($params->{'center'} == CENTER_X) {
                    $x = ($w < $self->{'XRES'}) ? int(($self->{'XRES'} - $w) / 2) : 0;
                } elsif ($params->{'center'} == CENTER_Y) {
                    $y = ($h < $self->{'YRES'}) ? int(($self->{'YRES'} - $h) / 2) : 0;
                } elsif ($params->{'center'} == CENTER_XY) {
                    $x = ($w < $self->{'XRES'}) ? int(($self->{'XRES'} - $w) / 2) : 0;
                    $y = ($h < $self->{'YRES'}) ? int(($self->{'YRES'} - $h) / 2) : 0;
                }
            } else {
                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->{...}))]
            } ## end else [ if (exists($params->{'center'...}))]
            if (exists($tags->{'gif_left'})) {
                $x += $tags->{'gif_left'};
                $y += $tags->{'gif_top'};
            }
            $bench_convert = sprintf('%.03f', time - $bench_convert);
            $bench_total   = sprintf('%.03f', time - $bench_total);
            push(
                @odata,
                {
                    'x'         => $x,
                      'y'         => $y,
                      'width'     => $w,
                      'height'    => $h,
                      'image'     => $data,
                      'tags'      => \%tags,
                      'benchmark' => {
                          'load'    => $bench_load,
                          'rotate'  => $bench_rotate,
                          'scale'   => $bench_scale,
                          'convert' => $bench_convert,
                          'total'   => $bench_total
                      }
                }
            );
        } ## end foreach my $img (@Img)

        if (scalar(@odata) > 1) {
            return (    # return it in a form the blit routines can dig
                \@odata
            );
        } else {
            return (    # return it in a form the blit routines can dig
                pop(@odata)
            );
        }
    } ## end else
    return (undef);
} ## end sub load_image

sub _convert_16_to_24 {
    my $self        = shift;
    my $img         = shift;
    my $color_order = 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;
    my $idx = 0;
    while($idx < $size) {
        my $color = substr($img, $idx, 2);

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

sub _convert_24_to_16 {
    my $self        = shift;
    my $img         = shift;
    my $color_order = shift;

    my $size    = length($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;
    my $new_img = '';

    my $idx = 0;
    while ($idx < $size) {
        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->RGB888_to_RGB565({ 'color' => $color, 'color_order' => $co });
            $new_img .= $color->{'color'};
        }
        $idx += 3;
    }

    return ($new_img);
} ## end sub _convert_24_to_16


=head2 screen_dump

Dumps the screen to a file given in 'file' in the format given in 'format'

Formats can be (they are case-insensitive):

=over 4

=item B<JPEG>

The most widely used format.  This is a "lossy" format.  The default quality setting is 75%, but it can be overriden with the "quality" parameter.

=item B<GIF>

The CompuServe "Graphics Interchange Format".  A very old and outdated format, but still widely used.  It only allows 256 "indexed" colors, so quality is very lacking.  The "dither" paramter determines how colors are translated from 24 bit truecolor to 8 bit indexed.

=item B<PNG>

The Portable Network Graphics format.  Widely used, very high quality.

=item B<PNM>

The Portable aNy Map format.  These are typically "PPM" files.  Not widely used.

=item B<TGA>

The Targa image format.  This is a high-color, lossless format, typically used in photography

=item B<TIFF>

The Tagged Image File Format.  Sort of an older version of PNG (but not the same, just similar in capability).  Sometimes used in FAX formats.

=back

 $fb->screen_dump(
     {
     	 'file'   => '/path/filename', # name of file to be written
 	 	 'format' => 'jpeg',           # jpeg, gif, png, pnm, tga, or tiff

 	 	 # for JPEG formats only
 	 	 'quality' => 75,              # quality of the JPEG file 1-100% (the
 	 	                               # higher the number, the better the
 	 	                               # quality, but the larger the file)

 	 	 # for GIF formats only
 	 	 'dither'  => 'floyd',         # Can be "floyd", "jarvis" or "stucki"
     }
 );

=cut

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

    my $filename = $params->{'file'} || 'screendump.jpg';
    my $bytes    = $self->{'BYTES'};
    my ($width, $height) = ($self->{'XRES'}, $self->{'YRES'});
    my $scrn = $self->blit_read({ 'x' => 0, 'y' => 0, 'width' => $width, 'height' => $height });

    $scrn->{'image'} = $self->_convert_16_to_24($scrn->{'image'},$self->{'COLOR_ORDER'}) if ($self->{'BITS'} == 16);

    my $type = lc($params->{'format'} || 'jpeg');
    $type =~ s/jpg/jpeg/;
    my $img = Imager::new();
    $img->read(
        'xsize'             => $scrn->{'width'},
        'ysize'             => $scrn->{'height'},
        'raw_datachannels'  => max(3,$bytes),
        'raw_storechannels' => max(3,$bytes),
        'raw_interleave'    => 0,
        'data'              => $scrn->{'image'},
        'type'              => 'raw',
        'allow_incomplete'  => 1
    );
    my %p = (
        'type' => $type || 'raw',
        'datachannels'  => max(3,$bytes),
        'storechannels' => max(3,$bytes),
        'interleave'    => 0,
        'file'          => $filename
    );

    if ($type eq 'jpeg') {
        $p{'jpegquality'} = $params->{'quality'} if (exists($params->{'quality'}));
        $p{'jpegoptimize'} = 1;
    } elsif ($type eq 'gif') {
        $p{'translate'} = 'errdiff';
        $p{'errdiff'} = lc($params->{'dither'} || 'floyd');
    }
    $img->write(%p);
} ## end sub screen_dump

=head2 RGB565_to_RGB888

Converts a 16 bit color value to a 24 bit color value.  It takes into account the current set color order (RGB, BGR etc)

It takes just one parameter.

 {
     'color' => "rgb565 encoded string",
 }

=cut

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

    my $rgb565 = unpack('S', $params->{'color'});
    my ($r, $g, $b);
    my $color_order = $params->{'color_order'};
    if ($color_order == RGB) {
        $r = $rgb565 & 31;
        $g = ($rgb565 >> 5) & 63;
        $b = ($rgb565 >> 11) & 31;
    } elsif ($color_order == BGR) {
        $b = $rgb565 & 31;
        $g = ($rgb565 >> 5) & 63;
        $r = ($rgb565 >> 11) & 31;
    }
    $r = int($r * 255 / 31 + .5);
    $g = int($g * 255 / 63 + .5);
    $b = int($b * 255 / 31 + .5);

    my $color;
    if ($color_order == BGR) {
        ($r,$g,$b) = ($b,$g,$r);
    } elsif ($color_order == BRG) {
        ($r,$g,$b) = ($b,$r,$g);
#    } elsif ($color_order == RGB) {
    } elsif ($color_order == RBG) {
        ($r,$g,$b) = ($r,$b,$g);
    } elsif ($color_order == GRB) {
        ($r,$g,$b) = ($g,$r,$b);
    } elsif ($color_order == GBR) {
        ($r,$g,$b) = ($g,$b,$r);
    }
    $color = pack('CCC', $r, $g, $b);
    return ({ 'color' => $color });
} ## end sub RGB565_to_RGB888

=head2 RGB565_to_RGBA8888

Converts a 16 bit color value to a 32 bit color value.

It takes two parameters, with 'alpha' being optional.  It takes into account the current set color order (RGB, BGR etc)

 {
     'color' => "rgb565 encoded string",
     'alpha' => 0 - 255 # Default is 255 if this is left out
 }

=cut

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

    my $rgb565 = unpack('S', $params->{'color'});
    my $a = $params->{'alpha'} || 255;
    my $color_order = $self->{'COLOR_ORDER'};
    my ($r, $g, $b);
    if ($color_order == RGB) {
        $r = $rgb565 & 31;
        $g = ($rgb565 >> 5) & 63;
        $b = ($rgb565 >> 11) & 31;
    } elsif ($color_order == BGR) {
        $b = $rgb565 & 31;
        $g = ($rgb565 >> 5) & 63;
        $r = ($rgb565 >> 11) & 31;
    }
    $r = int($r * 255 / 31 + .5);
    $g = int($g * 255 / 63 + .5);
    $b = int($b * 255 / 31 + .5);

    my $color;
    if ($color_order == BGR) {
        ($r,$g,$b) = ($b,$g,$r);
#    } elsif ($color_order == RGB) {
    } elsif ($color_order == BRG) {
        ($r,$g,$b) = ($b,$r,$g);
    } elsif ($color_order == RBG) {
        ($r,$g,$b) = ($r,$b,$g);
    } elsif ($color_order == GRB) {
        ($r,$g,$b) = ($g,$r,$b);
    } elsif ($color_order == GBR) {
        ($r,$g,$b) = ($g,$b,$r);
    }
    $color = pack('CCCC', $r, $g, $b, $a);
    return ({ 'color' => $color });
} ## end sub RGB565_to_RGBA8888

=head2 RGB888_to_RGB565

Converts 24 bit color values to 16 bit color values.  It takes into account the current set color order (RGB, BGR etc)

There are two parameters, 'color' and it must contain a bit encoded 24 bit string, and 'color_order'.

 {
     'color'       => "RGB888 encoded string",
     'color_order' => $fb->{'RGB'} # RGB, RBG, GBR, GRB, BGR, BRG
 }

It returns 'color' converted to an encoded 16 bit string.

 {
     'color' => "RGB565 encoded 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 RGB888_to_RGB565 {
    ##############################################################################
    ##                               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 $in_color_order = defined($params->{'color_order'}) ? $params->{'color_order'} : RGB;
    my $color_order    = $self->{'COLOR_ORDER'};

    my $n_data;
    if ($big_data ne '') {
        my $pixel_data = substr($big_data, 0, 3);
        my ($r, $g, $b);
        if ($in_color_order == BGR) {
            ($b, $g, $r) = unpack('C3', $pixel_data);
        } elsif ($in_color_order == RGB) {
            ($r, $g, $b) = unpack('C3', $pixel_data);
        } elsif ($in_color_order == BRG) {
            ($b, $r, $g) = unpack('C3', $pixel_data);
        } elsif ($in_color_order == RBG) {
            ($r, $b, $g) = unpack('C3', $pixel_data);
        } elsif ($in_color_order == GRB) {
            ($g, $r, $b) = unpack('C3', $pixel_data);
        } elsif ($in_color_order == GBR) {
            ($g, $b, $r) = 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 ($color_order == BGR) {
            $color = $b | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}));
        } elsif ($color_order == RGB) {
            $color = $r | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}));
        } elsif ($color_order == BRG) {
            $color = $b | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}));
        } elsif ($color_order == RBG) {
            $color = $r | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}));
        } elsif ($color_order == GRB) {
            $color = $g | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}));
        } elsif ($color_order == 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 RGB888_to_RGB565

=head2 RGBA8888_to_RGB565

Converts 32 bit color values to 16 bit color values.

There are two parameters, 'color' and it must contain a bit encoded 32 bit string, and 'color_order'.

 {
     'color'       => "RGBA8888 encoded string",
     'color_order' => $fb->{'RGB'} # RGB, RBG, GBR, GRB, BGR, BRG
 }

It returns 'color' converted to an encoded 16 bit string.

 {
     'color' => "RGB565 encoded 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 RGBA8888_to_RGB565 {
    ##############################################################################
    ##                              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 $in_color_order = defined($params->{'color_order'}) ? $params->{'color_order'} : RGB;
    my $color_order    = $self->{'COLOR_ORDER'};

    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 ($in_color_order == BGR) {
            ($b, $g, $r, $a) = unpack('C4', $pixel_data);
        } elsif ($in_color_order == RGB) {
            ($r, $g, $b, $a) = unpack('C4', $pixel_data);
        } elsif ($in_color_order == BRG) {
            ($b, $r, $g, $a) = unpack('C4', $pixel_data);
        } elsif ($in_color_order == RBG) {
            ($r, $b, $g, $a) = unpack('C4', $pixel_data);
        } elsif ($in_color_order == GRB) {
            ($g, $r, $b, $a) = unpack('C4', $pixel_data);
        } elsif ($in_color_order == GBR) {
            ($g, $b, $r, $a) = unpack('C4', $pixel_data);
        }

        # Alpha is tossed
        $r = $r >> $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'};
        $g = $g >> $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'};
        $b = $b >> $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'};

        my $color;
        if ($color_order == BGR) {
            $color = $b | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}));
        } elsif ($color_order == RGB) {
            $color = $r | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}));
        } elsif ($color_order == BRG) {
            $color = $b | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}));
        } elsif ($color_order == RBG) {
            $color = $r | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) | ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}));
        } elsif ($color_order == GRB) {
            $color = $g | ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) | ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}));
        } elsif ($color_order == 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 RGBA8888_to_RGB565

=head2 RGB888_to_RGBA8888

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 RGB888_to_RGBA8888 {
    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 RGB888_to_RGBA8888

##############################################################################
####################### NON-METHODS, FLAT SUBROUTINES ########################
##############################################################################

sub _get_ioctl {
    ##########################################################
    ##                    GET IOCTL INFO                    ##
    ##########################################################
    # 'sys/ioctl.ph' is flakey.  Not used at the moment.     #
    ##########################################################
    # Used to return an array specific to the ioctl function #
    ##########################################################
    my $command = shift;
    my $format  = shift;
    my $fb      = shift;
    my $data    = '';
    my @array;
    eval {
        if (defined($fb)) {
            ioctl($fb, $command, $data);
        } else {
            ioctl(STDOUT, $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);
    eval { return (ioctl($fb, $command, $data)); };
} ## end sub _set_ioctl

sub _round {
    return (int(0.5 + shift));
}

sub _fpart {
    my $x = shift;
    return ($x - int $x);
}

sub _rfpart {
    return (1 - _fpart(shift));
}

sub _transformed_bounds {
    my $bbox   = shift;
    my $matrix = shift;

    my $bounds;
    foreach my $point ([$bbox->start_offset, $bbox->ascent], [$bbox->start_offset, $bbox->descent], [$bbox->end_offset, $bbox->ascent], [$bbox->end_offset, $bbox->descent]) {
        $bounds = _add_bound($bounds, _transform_point(@{$point}, $matrix));
    }
    return (@{$bounds});
} ## end sub _transformed_bounds

sub _add_bound {
    my $bounds = shift;
    my $x      = shift;
    my $y      = shift;

    $bounds or return ([$x, $y, $x, $y]);

    $x < $bounds->[0] and $bounds->[0] = $x;
    $y < $bounds->[1] and $bounds->[1] = $y;
    $x > $bounds->[2] and $bounds->[2] = $x;
    $y > $bounds->[3] and $bounds->[3] = $y;

    return ($bounds);
} ## end sub _add_bound

sub _transform_point {
    my $x      = shift;
    my $y      = shift;
    my $matrix = shift;

    return ($x * $matrix->[0] + $y * $matrix->[1] + $matrix->[2], $x * $matrix->[3] + $y * $matrix->[4] + $matrix->[5]);
} ## end sub _transform_point

1;

__END__

=head1 USAGE HINTS

=head2 GRADIENTS

Gradients can have any number (actually 2 or greater) of color key points (transitions).  Vertical gradients cannot have more key points than the object is high.  Horizontal gradients cannot have more key points that the object is wide.  Just keep your gradients "sane" and things will go just fine.

Make sure the number of color key points matches for each primary color (red, green, and blue);

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

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 (that I know of), both are the 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" parameter when calling "new" to create the object.  This helps with troubleshooting.

=over 4

=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" (and make sure you turn it back on before your code exits).

=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.  If you have a package based Perl installation, then installing the Imager (usually "libimager-perl") package will always work.  If you already installed Imager via CPAN, then you should uninstall it via CPAN, then go install the package version, in that order.

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

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 "threadstest.pl" in the "examples" directory.

Are you in 16 bit color mode?  Type 'fbset -i' and it will tell you.  Switch to 32 bit mode (if possible) and things will run faster.  I know this sounds weird.  Accessing twice the memory being faster?  Well... yes.  First of all, 32 and 64 bit CPUs are optimized for accessing memory in 32 bit blocks, not 16.  Second, there is far less complex code to draw in 32 bit mode, and thus it's faster.  16 bit requires complex bit shifting.

Plain and simple, your device just may be too slow for some CPU intensive operations, specifically anything involving images and blitting.  If you must use images, then make sure they are already the right size for your needs.  Don't force the module to resize them when loading.

=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 2> dump.txt

=back

=head1 AUTHOR

Richard Kelsch <rich@rk-internet.com>

=head1 COPYRIGHT

Copyright 2003-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.73 (April 24, 2016)

=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.  Your requests for help actually gave me ideas.

=head1 TELL ME ABOUT YOUR PROJECT

I'd love to know if you are 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.

=head1 YOUTUBE

There is a YouTube channel with demonstrations of the module's capabilities.  Eventually it will have examples of output from a variety of different types of hardware.

https://youtu.be/4Yzs55Wpr7E

=cut
