File Coverage

blib/lib/Graphics/Framebuffer.pm
Criterion Covered Total %
statement 258 2468 10.4
branch 50 1196 4.1
condition 27 635 4.2
subroutine 38 129 29.4
pod 1 75 1.3
total 374 4503 8.3


line stmt bran cond sub pod time code
1             package Graphics::Framebuffer;
2              
3              
4              
5             =head1 NAME
6              
7             Graphics::Framebuffer - A Simple Framebuffer Graphics Library
8              
9             =head1 SYNOPSIS
10              
11             Direct drawing for 32/24/16 bit framebuffers (others would be supported if asked for)
12              
13             use Graphics::Framebuffer;
14              
15             our $fb = Graphics::Framebuffer->new();
16              
17             Drawing is this simple
18              
19             $fb->cls('OFF'); # Clear screen and turn off the console cursor
20              
21             $fb->set_color({'red' => 255, 'green' => 255, 'blue' => 255, 'alpha' => 255});
22             $fb->plot({'x' => 28, 'y' => 79,'pixel_size' => 1});
23             $fb->drawto({'x' => 405,'y' => 681,'pixel_size' => 1});
24             $fb->circle({'x' => 200, 'y' => 200, 'radius' => 100, 'filled' => 1});
25             $fb->polygon({'coordinates' => [20,20, 53,3, 233,620], 'pixel_size' => 5});
26             $fb->box({'x' => 95, 'y' => 100, 'xx' => 400, 'yy' => 600, 'filled' => 1});
27             # ... and many many more
28              
29             $fb->cls('ON'); # Clear screen and turn on the console cursor
30              
31             Methods requiring parameters require a hash (or anonymous hash) reference passed to the method. All parameters have easy to understand english names, all lower case, to understand exactly what the method is doing.
32              
33             =head1 DESCRIPTION
34              
35             A (mostly) Perl graphics library for exclusive use in a Linux/FreeBSD/Unix console framebuffer environment. It is written for simplicity, without the need for complex API's and drivers with "surfaces" and such.
36              
37             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.
38              
39             There are places where Perl just won't cut it. So I use the Imager library to take up the slack, or my own C code. Imager is just used to load images,, save images, merge, rotate, and draw TrueType/Type1 text. I am also incorporating compiled C to further assist with speed. That is being implemented step by step, but "acceleration" will always be optional, and pure Perl routines always available for those systems without a C compiler or "Inline:C" available.
40              
41             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 (with DRM) 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.
42              
43             NOTE:
44              
45             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'
46              
47             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.
48              
49             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.
50              
51             Make sure you have read/write access to the framebuffer device. Usually this just means adding your account to the "video" group (make sure you log out and log in again after doing that). Alternately, you can just run your script as root. Although I don't recommend it.
52              
53             =head1 INSTALLATION
54              
55             Read the file "installing/INSTALL" and follow its instructions.
56              
57             =back
58              
59             When you install this module, please do it within a console, not a console window in X-Windows, but the actual Linux/FreeBSD console outside of X-Windows.
60              
61             If you are in X-Windows, and don't know how to get to a console, then just hit CTRL-ALT-F1 (actually CTRL-ALT-F1 through CTRL-ALT-F6 works) and it should show you a console. ALT-F7 or ALT-F8 will get you back to X-Windows.
62              
63             =head1 OPERATIONAL THEORY
64              
65             How many Perl modules actually tell you how they work? Well, I will tell you how this one works.
66              
67             The framebuffer is simply a special file that is mapped to the screen. How the driver does this can be different. Some may actually directly map the display memory to this file, and some install a second copy of the display to normal memory and copy it to the display on every vertical blank, usually with a fast DMA transfer.
68              
69             This module maps that file to a string, and that ends up making the string exactly the same size as the physical display. Plotting is simply a matter of calculating where in the string that pixel is and modifying it, via "substr" (never using "=" directly). It's that simple.
70              
71             Drawing lines etc. requires some algorithmic magic though, but they all call the plot routine to do their eventual magic.
72              
73             Originally everything was done in Perl, and the module's speed was mostly acceptable, unless you had a really slow system. It still can run in pure Perl, if you turn off the acceleration feature, although I do not recommend it, if you want speed.
74              
75             =head1 SPECIAL VARIABLES
76              
77             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}
78              
79             =over 4
80              
81             =item B
82              
83             List of system fonts
84              
85             Contains a hash of every font found in the system in the format:
86              
87             =back
88              
89             =over 6
90              
91             # 'FaceName' => {
92             # 'path' => 'Path To Font',
93             # 'font' => 'File Name of Font'
94             # },
95             # ...
96              
97             =back
98              
99             =over 4
100              
101             =item B
102              
103             If your installation of Imager has TrueType font capability, then this will be 1
104              
105             =item B
106              
107             If your installation of Imager has Adobe Type 1 font capability, then this will be 1
108              
109             =item B
110              
111             If your installation of Imager has the FreeType2 library rendering capability, then this will be 1
112              
113             =item B
114              
115             An anonymous array of supported image file types.
116              
117             =item B
118              
119             An anomyous array of hatch names for hatch fills.
120              
121             This is also exported as @HATCHES
122              
123             =item B
124              
125             The top left-hand corner X location of the clipping region
126              
127             =item B
128              
129             The top left-hand corner Y location of the clipping region
130              
131             =item B
132              
133             The bottom right-hand corner X location of the clipping region
134              
135             =item B
136              
137             The bottom right-hand corner Y location of the clipping region.
138              
139             =item B
140              
141             If this is true, then the clipping region is smaller than the full screen
142              
143             If false, then the clipping region is the screen dimensions.
144              
145             =item B
146              
147             The current drawing mode. This is a numeric value corresponding to the constants described in the method 'draw_mode'
148              
149             =item B
150              
151             The current foreground color encoded as a string.
152              
153             =item B
154              
155             The current background color encoded as a string.
156              
157             =item B
158              
159             Indicates if C code or hardware acceleration is being used.
160              
161             =back
162              
163             =over 6
164              
165             =item B
166              
167             0 = Perl code only
168             1 = Some functions accelerated by compiled code (Default)
169             2 = All of #1 plus additional functions accelerated by hardware (currently not supported)
170              
171             =back
172              
173             Many of the parameters you pass to the "new" method are also special variables.
174              
175             =cut
176              
177 1     1   72221 use strict;
  1         2  
  1         31  
178 1     1   5 no strict 'vars'; # We have to map a variable as the screen. So strict is going to whine about what we do with it.
  1         1  
  1         23  
179              
180 1     1   4 no warnings; # We have to be as quiet as possible
  1         2  
  1         171  
181              
182             =head1 CONSTANTS
183              
184             The following constants can be used in the various methods. Each method example will have the possible constants to use for that method.
185              
186             The value of the constant is in parenthesis:
187              
188             B (value)
189              
190             Boolean constants
191              
192             =over 8
193              
194             =item B ( 1 )
195             =item B ( 0 )
196              
197             =back
198              
199             Draw mode constants
200              
201             =over 8
202              
203             =item B ( 0 )
204             =item B ( 1 )
205             =item B ( 2 )
206             =item B ( 3 )
207             =item B ( 4 )
208             =item B ( 5 )
209             =item B ( 6 )
210             =item B ( 7 )
211             =item B ( 8 )
212             =item B ( 9 )
213             =item B ( 10 )
214              
215             =back
216              
217             Draw Arc constants
218              
219             =over 8
220              
221             =item B ( 0 )
222             =item B ( 1 )
223             =item B ( 2 )
224              
225             =back
226              
227             Virtual framebuffer color mode constants
228              
229             =over 8
230              
231             =item B ( 0 )
232             =item B ( 1 )
233             =item B ( 2 )
234             =item B ( 3 )
235             =item B ( 4 )
236             =item B ( 5 )
237              
238             =back
239              
240             Text rendering centering constants
241              
242             =over 8
243              
244             =item B ( 0 )
245             =item B ( 1 )
246             =item B ( 2 )
247             =item B ( 3 )
248              
249             =back
250              
251             Acceleration method constants
252              
253             =over 8
254              
255             =item B ( 0 )
256             =item B ( 1 )
257             =item B ( 2 )
258              
259             =back
260              
261             =cut
262              
263             use constant {
264 1         533 TRUE => 1,
265             FALSE => 0,
266              
267             NORMAL_MODE => 0, # Constants for DRAW_MODE
268             XOR_MODE => 1,
269             OR_MODE => 2,
270             AND_MODE => 3,
271             MASK_MODE => 4,
272             UNMASK_MODE => 5,
273             ALPHA_MODE => 6,
274             ADD_MODE => 7,
275             SUBTRACT_MODE => 8,
276             MULTIPLY_MODE => 9,
277             DIVIDE_MODE => 10,
278              
279             ARC => 0, # Constants for "draw_arc" method
280             PIE => 1,
281             POLY_ARC => 2,
282              
283             RGB => 0, # Constants for color mapping
284             RBG => 1,
285             BGR => 2,
286             BRG => 3,
287             GBR => 4,
288             GRB => 5,
289              
290             CENTER_NONE => 0, # Constants for centering
291             CENTER_X => 1,
292             CENTER_Y => 2,
293             CENTER_XY => 3,
294             CENTRE_NONE => 0, # Constants for centering (for British and Canadian folks)
295             CENTRE_X => 1,
296             CENTRE_Y => 2,
297             CENTRE_XY => 3,
298              
299             PERL => 0,
300             SOFTWARE => 1,
301             HARDWARE => 2,
302              
303             ## Set up the Framebuffer driver "constants" defaults
304             # Commands
305             FBIOGET_VSCREENINFO => 0x4600, # These come from "fb.h" in the kernel source
306             FBIOPUT_VSCREENINFO => 0x4601,
307             FBIOGET_FSCREENINFO => 0x4602,
308             FBIOGETCMAP => 0x4604,
309             FBIOPUTCMAP => 0x4605,
310             FBIOPAN_DISPLAY => 0x4606,
311             FBIO_CURSOR => 0x4608,
312             FBIOGET_CON2FBMAP => 0x460F,
313             FBIOPUT_CON2FBMAP => 0x4610,
314             FBIOBLANK => 0x4611,
315             FBIOGET_VBLANK => 0x4612,
316             FBIOGET_GLYPH => 0x4615,
317             FBIOGET_HWCINFO => 0x4616,
318             FBIOPUT_MODEINFO => 0x4617,
319             FBIOGET_DISPINFO => 0x4618,
320             FBIO_WAITFORVSYNC => 0x4620,
321             VT_GETSTATE => 0x5603,
322             KDSETMODE => 0x4B3A,
323             KD_GRAPHICS => 1,
324             KD_TEXT => 0,
325              
326             # FLAGS
327             FBINFO_HWACCEL_NONE => 0x0000, # These come from "fb.h" in the kernel source
328             FBINFO_HWACCEL_COPYAREA => 0x0100,
329             FBINFO_HWACCEL_FILLRECT => 0x0200,
330             FBINFO_HWACCEL_IMAGEBLIT => 0x0400,
331             FBINFO_HWACCEL_ROTATE => 0x0800,
332             FBINFO_HWACCEL_XPAN => 0x1000,
333             FBINFO_HWACCEL_YPAN => 0x2000,
334             FBINFO_HWACCEL_YWRAP => 0x4000,
335 1     1   7 };
  1         6  
336              
337             ### THREADS ###
338 1     1   668 use if ($Config{'useithreads'}), 'threads', 'yield', 'stringify', 'stack_size' => 131076, 'exit' => 'threads_only';
  1         14  
  1         6  
339 1     1   51 use if ($Config{'useithreads'}), 'threads::shared';
  1         2  
  1         6  
340              
341 1     1   561 use POSIX ();
  1         6679  
  1         31  
342 1     1   7 use POSIX qw(modf);
  1         2  
  1         5  
343 1     1   2044 use Time::HiRes qw(sleep time); # The time accuracy has to be milliseconds on many routines
  1         1496  
  1         4  
344 1     1   838 use Math::Trig ':pi'; # Usually only PI is used
  1         16782  
  1         133  
345 1     1   494 use Math::Bezier; # Bezier curve calculations done here.
  1         788  
  1         31  
346 1     1   451 use Math::Gradient qw( gradient array_gradient multi_gradient ); # Awesome gradient calculation module
  1         1046  
  1         75  
347 1     1   7 use List::Util qw(min max); # min and max are very handy!
  1         2  
  1         88  
348 1     1   524 use File::Map ':map'; # Absolutely necessary to map the screen to a string.
  1         2722  
  1         4  
349 1     1   1119 use Imager; # This is used for TrueType font printing, image loading.
  1         52026  
  1         7  
350 1     1   600 use Imager::Matrix2d;
  1         2397  
  1         47  
351 1     1   519 use Imager::Fill; # For hatch fills
  1         1396  
  1         32  
352 1     1   477 use Imager::Fountain; #
  1         1527  
  1         32  
353 1     1   505 use Imager::Font::Wrap;
  1         1510  
  1         34  
354 1     1   458 use Graphics::Framebuffer::Mouse; # The mouse handler
  1         3  
  1         67  
355 1     1   508 use Graphics::Framebuffer::Splash; # The splash code is here
  1         2  
  1         147  
356              
357             Imager->preload; # The Imager documentation says to do this, but doesn't give much of an explanation why. However, I assume it is to initialize global variables ahead of time.
358              
359             ## This is for debugging, and should normally be commented out.
360             # use Data::Dumper::Simple;$Data::Dumper::Sortkeys=1;$Data::Dumper::Purity=1;
361              
362             BEGIN {
363 1     1   8 require Exporter;
364              
365             # set the version for version checking
366 1         3 our $VERSION = '6.51';
367 1         32 our @ISA = qw(Exporter);
368 1         7 our @EXPORT_OK = qw(
369             FBIOGET_VSCREENINFO
370             FBIOPUT_VSCREENINFO
371             FBIOGET_FSCREENINFO
372             FBIOGETCMAP
373             FBIOPUTCMAP
374             FBIOPAN_DISPLAY
375             FBIO_CURSOR
376             FBIOGET_CON2FBMAP
377             FBIOPUT_CON2FBMAP
378             FBIOBLANK
379             FBIOGET_VBLANK
380             FBIOGET_GLYPH
381             FBIOGET_HWCINFO
382             FBIOPUT_MODEINFO
383             FBIOGET_DISPINFO
384             FBIO_WAITFORVSYNC
385             VT_GETSTATE
386             FBINFO_HWACCEL_NONE
387             FBINFO_HWACCEL_COPYAREA
388             FBINFO_HWACCEL_FILLRECT
389             FBINFO_HWACCEL_IMAGEBLIT
390             FBINFO_HWACCEL_ROTATE
391             FBINFO_HWACCEL_XPAN
392             FBINFO_HWACCEL_YPAN
393             FBINFO_HWACCEL_YWRAP
394             $VERSION
395             );
396 1         839 our @EXPORT = qw(
397             TRUE
398             FALSE
399             NORMAL_MODE
400             XOR_MODE
401             OR_MODE
402             AND_MODE
403             MASK_MODE
404             UNMASK_MODE
405             ALPHA_MODE
406             ADD_MODE
407             SUBTRACT_MODE
408             MULTIPLY_MODE
409             DIVIDE_MODE
410             ARC
411             PIE
412             POLY_ARC
413             RGB
414             RBG
415             BGR
416             BRG
417             GBR
418             GRB
419             CENTER_NONE
420             CENTER_X
421             CENTER_Y
422             CENTER_XY
423             CENTRE_NONE
424             CENTRE_X
425             CENTRE_Y
426             CENTRE_XY
427             PERL
428             SOFTWARE
429             HARDWARE
430             @HATCHES
431             @COLORORDER
432             );
433             }
434              
435             sub DESTROY { # Always clean up after yourself before exiting
436 2     2   35 my $self = shift;
437 2         45 $self->text_mode();
438 2         48 $self->_screen_close();
439 2 50       940 _reset() if ($self->{'RESET'}); # Exit by calling 'reset' first
440             }
441              
442             # use Inline 'info', 'noclean', 'noisy'; # Only needed for debugging
443              
444 1     1   636 use Inline C => <<'C_CODE','name' => 'Graphics::Framebuffer', 'VERSION' => $VERSION;
  1         35217  
  1         7  
445             /* Copyright 2018-2021 Richard Kelsch, All Rights Reserved
446             See the Perl documentation for Graphics::Framebuffer for licensing information.
447              
448             Version: 6.48
449              
450             You may wonder why the stack is so heavily used when the global structures
451             have the needed values. Well, the module can emulate another graphics mode
452             that may not be the one being displayed. This means using the two structures
453             would break functionality. Therefore, the data from Perl is passed along.
454             */
455              
456             #include
457             #include
458             #include
459             #include
460             #include
461             #include
462             #include
463             #include
464             #include
465              
466             #define NORMAL_MODE 0
467             #define XOR_MODE 1
468             #define OR_MODE 2
469             #define AND_MODE 3
470             #define MASK_MODE 4
471             #define UNMASK_MODE 5
472             #define ALPHA_MODE 6
473             #define ADD_MODE 7
474             #define SUBTRACT_MODE 8
475             #define MULTIPLY_MODE 9
476             #define DIVIDE_MODE 10
477              
478             #define RGB 0
479             #define RBG 1
480             #define BGR 2
481             #define BRG 3
482             #define GBR 4
483             #define GRB 5
484              
485             #define integer_(X) ((int)(X))
486             #define round_(X) ((int)(((double)(X))+0.5))
487             #define decimal_(X) (((double)(X))-(double)integer_(X))
488             #define rdecimal_(X) (1.0-decimal_(X))
489             #define swap_(a, b) do { __typeof__(a) tmp; tmp = a; a = b; b = tmp; } while(0)
490              
491             /* Global Structures */
492             struct fb_var_screeninfo vinfo;
493             struct fb_fix_screeninfo finfo;
494              
495             // This gets the framebuffer info and populates the above structures, then sends them to Perl
496             void c_get_screen_info(char *fb_file) {
497             int fbfd = open(fb_file,O_RDWR);
498             ioctl(fbfd, FBIOGET_FSCREENINFO, &finfo);
499             ioctl(fbfd, FBIOGET_VSCREENINFO, &vinfo);
500             close(fbfd);
501              
502             // This monstrosity pushes the needed values on Perl's stack, like "return" does.
503              
504             Inline_Stack_Vars;
505             Inline_Stack_Reset;
506              
507             Inline_Stack_Push(sv_2mortal(newSVpvn(finfo.id,16)));
508             Inline_Stack_Push(sv_2mortal(newSVnv(finfo.smem_start)));
509             Inline_Stack_Push(sv_2mortal(newSVuv(finfo.smem_len)));
510             Inline_Stack_Push(sv_2mortal(newSVuv(finfo.type)));
511             Inline_Stack_Push(sv_2mortal(newSVuv(finfo.type_aux)));
512             Inline_Stack_Push(sv_2mortal(newSVuv(finfo.visual)));
513             Inline_Stack_Push(sv_2mortal(newSVuv(finfo.xpanstep)));
514             Inline_Stack_Push(sv_2mortal(newSVuv(finfo.ypanstep)));
515             Inline_Stack_Push(sv_2mortal(newSVuv(finfo.ywrapstep)));
516             Inline_Stack_Push(sv_2mortal(newSVuv(finfo.line_length)));
517             Inline_Stack_Push(sv_2mortal(newSVnv(finfo.mmio_start)));
518             Inline_Stack_Push(sv_2mortal(newSVuv(finfo.mmio_len)));
519             Inline_Stack_Push(sv_2mortal(newSVuv(finfo.accel)));
520              
521             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.xres)));
522             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.yres)));
523             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.xres_virtual)));
524             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.yres_virtual)));
525             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.xoffset)));
526             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.yoffset)));
527             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.bits_per_pixel)));
528             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.grayscale)));
529             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.red.offset)));
530             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.red.length)));
531             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.red.msb_right)));
532             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.green.offset)));
533             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.green.length)));
534             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.green.msb_right)));
535             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.blue.offset)));
536             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.blue.length)));
537             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.blue.msb_right)));
538             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.transp.offset)));
539             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.transp.length)));
540             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.transp.msb_right)));
541             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.nonstd)));
542             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.activate)));
543             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.height)));
544             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.accel_flags)));
545             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.pixclock)));
546             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.left_margin)));
547             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.right_margin)));
548             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.upper_margin)));
549             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.lower_margin)));
550             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.hsync_len)));
551             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.vsync_len)));
552             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.sync)));
553             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.vmode)));
554             Inline_Stack_Push(sv_2mortal(newSVnv(vinfo.rotate)));
555              
556             Inline_Stack_Done;
557             }
558              
559             // Sets the framebuffer to text mode, which enables the cursor
560             void c_text_mode(char *tty_file)
561             {
562             int tty_fd = open(tty_file,O_RDWR);
563             ioctl(tty_fd,KDSETMODE,KD_TEXT);
564             close(tty_fd);
565             }
566              
567             // Sets the framebuffer to graphics mode, which disables the cursor
568             void c_graphics_mode(char *tty_file)
569             {
570             int tty_fd = open(tty_file,O_RDWR);
571             ioctl(tty_fd,KDSETMODE,KD_GRAPHICS);
572             close(tty_fd);
573             }
574              
575              
576             /* The other routines call this. It handles all draw modes
577             *
578             * Normally I would add code to properly place the RGB values according to
579             * color order, but in reality, that can be done solely when the color value
580             * itself is defined, so the colors are in the correct order before even
581             * arriving at this routine.
582             */
583             void c_plot(
584             char *framebuffer,
585             short x, short y,
586             short x_clip, short y_clip, short xx_clip, short yy_clip,
587             unsigned int color,
588             unsigned int bcolor,
589             unsigned char alpha,
590             unsigned char draw_mode,
591             unsigned char bytes_per_pixel,
592             unsigned char bits_per_pixel,
593             unsigned int bytes_per_line,
594             short xoffset, short yoffset)
595             {
596             if (x >= x_clip && x <= xx_clip && y >= y_clip && y <= yy_clip) { // Make sure the pixel is within the clipped area
597             x += xoffset;
598             y += yoffset;
599             unsigned int index = (x * bytes_per_pixel) + (y * bytes_per_line);
600             switch(draw_mode) {
601             case NORMAL_MODE :
602             switch(bits_per_pixel) {
603             case 32 :
604             {
605             *((unsigned int*)(framebuffer + index)) = color; // 32 bit drawing can send a long word in one operation. Which is why it is the fastest.
606             }
607             break;
608             case 24 :
609             {
610             *(framebuffer + index) = color & 255; // 24 Bit requites one byte at a time. Not as efficient as 32 bit.
611             *(framebuffer + index + 1) = (color >> 8) & 255;
612             *(framebuffer + index + 2) = (color >> 16) & 255;
613             }
614             break;
615             case 16 :
616             {
617             *((unsigned short*)(framebuffer + index)) = (short) color; // 16 bit can send a word at a time, the second most efficient method.
618             }
619             break;
620             }
621             break;
622             case XOR_MODE :
623             switch(bits_per_pixel) {
624             case 32 :
625             {
626             *((unsigned int*)(framebuffer + index)) ^= color;
627             }
628             break;
629             case 24 :
630             {
631             *(framebuffer + index) ^= color & 255;
632             *(framebuffer + index + 1) ^= (color >> 8) & 255;
633             *(framebuffer + index + 2) ^= (color >> 16) & 255;
634             }
635             break;
636             case 16 :
637             {
638             *((unsigned short*)(framebuffer + index)) ^= (short) color;
639             }
640             break;
641             }
642             break;
643             case OR_MODE :
644             switch(bits_per_pixel) {
645             case 32 :
646             {
647             *((unsigned int*)(framebuffer + index)) |= color;
648             }
649             break;
650             case 24 :
651             {
652             *(framebuffer + index) |= color & 255;
653             *(framebuffer + index + 1) |= (color >> 8) & 255;
654             *(framebuffer + index + 2) |= (color >> 16) & 255;
655             }
656             break;
657             case 16 :
658             {
659             *((unsigned short*)(framebuffer + index)) |= (short) color;
660             }
661             break;
662             }
663             break;
664             case AND_MODE :
665             switch(bits_per_pixel) {
666             case 32 :
667             {
668             *((unsigned int*)(framebuffer + index)) &= color;
669             }
670             break;
671             case 24 :
672             {
673             *(framebuffer + index) &= color & 255;
674             *(framebuffer + index + 1) &= (color >> 8) & 255;
675             *(framebuffer + index + 2) &= (color >> 16) & 255;
676             }
677             break;
678             case 16 :
679             {
680             *((unsigned short*)(framebuffer + index)) &= (short) color;
681             }
682             break;
683             }
684             break;
685             case MASK_MODE :
686             switch(bits_per_pixel) {
687             case 32 :
688             {
689             if ((*((unsigned int*)(framebuffer + index )) & 0xFFFFFF00) != (bcolor & 0xFFFFFF00)) { // Ignore alpha channel
690             *((unsigned int*)(framebuffer + index )) = color;
691             }
692             }
693             break;
694             case 24 :
695             {
696             if ((*((unsigned int*)(framebuffer + index )) & 0xFFFFFF00) != (bcolor & 0xFFFFFF00)) { // Ignore alpha channel
697             *(framebuffer + index ) = color & 255;
698             *(framebuffer + index + 1) = (color >> 8) & 255;
699             *(framebuffer + index + 2) = (color >> 16) & 255;
700             }
701             }
702             break;
703             case 16 :
704             {
705             if (*((unsigned short*)(framebuffer + index)) != (bcolor & 0xFFFF)) {
706             *((unsigned short*)(framebuffer + index )) = color;
707             }
708             }
709             break;
710             }
711             break;
712             case UNMASK_MODE :
713             switch(bits_per_pixel) {
714             case 32 :
715             {
716             if ((*((unsigned int*)(framebuffer + index )) & 0xFFFFFF00) == (bcolor & 0xFFFFFF00)) { // Ignore alpha channel
717             *((unsigned int*)(framebuffer + index )) = color;
718             }
719             }
720             break;
721             case 24 :
722             {
723             if ((*((unsigned int*)(framebuffer + index )) & 0xFFFFFF00) == (bcolor & 0xFFFFFF00)) { // Ignore alpha channel
724             *(framebuffer + index ) = color & 255;
725             *(framebuffer + index + 1) = (color >> 8) & 255;
726             *(framebuffer + index + 2) = (color >> 16) & 255;
727             }
728             }
729             break;
730             case 16 :
731             {
732             if (*((unsigned short*)(framebuffer + index)) == (bcolor & 0xFFFF)) {
733             *((unsigned short*)(framebuffer + index )) = color;
734             }
735             }
736             break;
737             }
738             break;
739             case ALPHA_MODE :
740             switch(bits_per_pixel) {
741             case 32 :
742             {
743             unsigned int fb_rgb = *((unsigned int*)(framebuffer + index));
744             unsigned char fb_r = fb_rgb & 255;
745             unsigned char fb_g = (fb_rgb >> 8) & 255;
746             unsigned char fb_b = (fb_rgb >> 16) & 255;
747             unsigned char R = color & 255;
748             unsigned char G = (color >> 8) & 255;
749             unsigned char B = (color >> 16) & 255;
750             unsigned char A = (color >> 24) & 255;
751             unsigned char invA = (255 - A);
752              
753             fb_r = ((R * A) + (fb_r * invA)) >> 8;
754             fb_g = ((G * A) + (fb_g * invA)) >> 8;
755             fb_b = ((B * A) + (fb_b * invA)) >> 8;
756              
757             *((unsigned int*)(framebuffer + index)) = fb_r | (fb_g << 8) | (fb_b << 16) | (A << 24);
758             }
759             break;
760             case 24 :
761             {
762             unsigned char fb_r = *(framebuffer + index);
763             unsigned char fb_g = *(framebuffer + index + 1);
764             unsigned char fb_b = *(framebuffer + index + 2);
765             unsigned char invA = (255 - alpha);
766             unsigned char R = color & 255;
767             unsigned char G = (color >> 8) & 255;
768             unsigned char B = (color >> 16) & 255;
769              
770             fb_r = ((R * alpha) + (fb_r * invA)) >> 8;
771             fb_g = ((G * alpha) + (fb_g * invA)) >> 8;
772             fb_b = ((B * alpha) + (fb_b * invA)) >> 8;
773              
774             *(framebuffer + index) = fb_r;
775             *(framebuffer + index + 1) = fb_g;
776             *(framebuffer + index + 2) = fb_b;
777             }
778             break;
779             case 16 :
780             {
781             unsigned short rgb565 = *((unsigned short*)(framebuffer + index));
782             unsigned short fb_r = rgb565 & 31;
783             unsigned short fb_g = (rgb565 >> 5) & 63;
784             unsigned short fb_b = (rgb565 >> 11) & 31;
785             unsigned short R = color & 31;
786             unsigned short G = (color >> 5) & 63;
787             unsigned short B = (color >> 11) & 31;
788             unsigned char invA = (255 - alpha);
789             fb_r = ((R * alpha) + (fb_r * invA)) >> 8;
790             fb_g = ((G * alpha) + (fb_g * invA)) >> 8;
791             fb_b = ((B * alpha) + (fb_b * invA)) >> 8;
792             rgb565 = (fb_b << 11) | (fb_g << 5) | fb_r;
793             *((unsigned short*)(framebuffer + index)) = rgb565;
794             }
795             break;
796             }
797             break;
798             case ADD_MODE :
799             switch(bits_per_pixel) {
800             case 32 :
801             {
802             *((unsigned int*)(framebuffer + index)) += color;
803             }
804             break;
805             case 24 :
806             {
807             *(framebuffer + index) += color & 255;
808             *(framebuffer + index + 1) += (color >> 8) & 255;
809             *(framebuffer + index + 2) += (color >> 16) & 255;
810             }
811             break;
812             case 16 :
813             {
814             *((unsigned short*)(framebuffer + index)) += (short) color;
815             }
816             break;
817             }
818             break;
819             case SUBTRACT_MODE :
820             switch(bits_per_pixel) {
821             case 32 :
822             {
823             *((unsigned int*)(framebuffer + index)) -= color;
824             }
825             break;
826             case 24 :
827             {
828             *(framebuffer + index) -= color & 255;
829             *(framebuffer + index + 1) -= (color >> 8) & 255;
830             *(framebuffer + index + 2) -= (color >> 16) & 255;
831             }
832             break;
833             case 16 :
834             {
835             *((unsigned short*)(framebuffer + index)) -= (short) color;
836             }
837             break;
838             }
839             break;
840             case MULTIPLY_MODE :
841             switch(bits_per_pixel) {
842             case 32 :
843             {
844             *((unsigned int*)(framebuffer + index)) *= color;
845             }
846             break;
847             case 24 :
848             {
849             *(framebuffer + index) *= color & 255;
850             *(framebuffer + index + 1) *= (color >> 8) & 255;
851             *(framebuffer + index + 2) *= (color >> 16) & 255;
852             }
853             break;
854             case 16 :
855             {
856             *((unsigned short*)(framebuffer + index)) *= (short) color;
857             }
858             break;
859             }
860             break;
861             case DIVIDE_MODE :
862             switch(bits_per_pixel) {
863             case 32 :
864             {
865             *((unsigned int*)(framebuffer + index)) /= color;
866             }
867             break;
868             case 24 :
869             {
870             *(framebuffer + index) /= color & 255;
871             *(framebuffer + index + 1) /= (color >> 8) & 255;
872             *(framebuffer + index + 2) /= (color >> 16) & 255;
873             }
874             break;
875             case 16 :
876             {
877             *((unsigned short*)(framebuffer + index)) /= (short) color;
878             }
879             break;
880             }
881             break;
882             }
883             }
884             }
885              
886             // Draws a line
887             void c_line(
888             char *framebuffer,
889             short x1, short y1, short x2, short y2,
890             short x_clip, short y_clip, short xx_clip, short yy_clip,
891             unsigned int color,
892             unsigned int bcolor,
893             unsigned char alpha,
894             unsigned char draw_mode,
895             unsigned char bytes_per_pixel,
896             unsigned char bits_per_pixel,
897             unsigned int bytes_per_line,
898             short xoffset, short yoffset)
899             {
900             short shortLen = y2 - y1;
901             short longLen = x2 - x1;
902             int yLonger = false;
903              
904             if (abs(shortLen) > abs(longLen)) {
905             short swap = shortLen;
906             shortLen = longLen;
907             longLen = swap;
908             yLonger = true;
909             }
910             int decInc;
911             if (longLen == 0) {
912             decInc = 0;
913             } else {
914             decInc = (shortLen << 16) / longLen;
915             }
916             int count;
917             if (yLonger) {
918             if (longLen > 0) {
919             longLen += y1;
920             for (count = 0x8000 + (x1 << 16); y1 <= longLen; ++y1) {
921             c_plot(framebuffer, count >> 16, y1, x_clip, y_clip, xx_clip, yy_clip, color, bcolor, alpha, draw_mode, bytes_per_pixel, bits_per_pixel, bytes_per_line, xoffset, yoffset);
922             count += decInc;
923             }
924             return;
925             }
926             longLen += y1;
927             for (count = 0x8000 + (x1 << 16); y1 >= longLen; --y1) {
928             c_plot(framebuffer, count >> 16, y1, x_clip, y_clip, xx_clip, yy_clip, color, bcolor, alpha, draw_mode, bytes_per_pixel, bits_per_pixel, bytes_per_line, xoffset, yoffset);
929             count -= decInc;
930             }
931             return;
932             }
933             if (longLen > 0) {
934             longLen += x1;
935             for (count = 0x8000 + (y1 << 16); x1 <= longLen; ++x1) {
936             c_plot(framebuffer, x1, count >> 16, x_clip, y_clip, xx_clip, yy_clip, color, bcolor, alpha, draw_mode, bytes_per_pixel, bits_per_pixel, bytes_per_line, xoffset, yoffset);
937             count += decInc;
938             }
939             return;
940             }
941             longLen += x1;
942             for (count = 0x8000 + (y1 << 16); x1 >= longLen; --x1) {
943             c_plot(framebuffer, x1, count >> 16, x_clip, y_clip, xx_clip, yy_clip, color, bcolor, alpha, draw_mode, bytes_per_pixel, bits_per_pixel, bytes_per_line, xoffset, yoffset);
944             count -= decInc;
945             }
946             }
947              
948             // Reads in rectangular screen data as a string to a previously allocated buffer
949             void c_blit_read(
950             char *framebuffer,
951             short screen_width, short screen_height,
952             unsigned int bytes_per_line,
953             short xoffset, short yoffset,
954             char *blit_data,
955             short x, short y, short w, short h,
956             unsigned char bytes_per_pixel,
957             unsigned char draw_mode,
958             unsigned char alpha,
959             unsigned int bcolor,
960             short x_clip, short y_clip, short xx_clip, short yy_clip)
961             {
962             short fb_x = xoffset + x;
963             short fb_y = yoffset + y;
964             short xx = x + w;
965             short yy = y + h;
966             short horizontal;
967             short vertical;
968             unsigned int bline = w * bytes_per_pixel;
969              
970             for (vertical = 0; vertical < h; vertical++) {
971             unsigned int vbl = vertical * bline;
972             unsigned short yv = fb_y + vertical;
973             unsigned int yvbl = yv * bytes_per_line;
974             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
975             for (horizontal = 0; horizontal < w; horizontal++) {
976             unsigned short xh = fb_x + horizontal;
977             unsigned int xhbp = xh * bytes_per_pixel;
978             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
979             unsigned int hzpixel = horizontal * bytes_per_pixel;
980             unsigned int vhz = vbl + hzpixel;
981             unsigned int yvhz = yvbl + hzpixel;
982             unsigned int xhbp_yvbl = xhbp + yvbl;
983             if (bytes_per_pixel == 4) {
984             *((unsigned int*)(blit_data + vhz)) = *((unsigned int*)(framebuffer + xhbp_yvbl));
985             } else if (bytes_per_pixel == 3) {
986             *(blit_data + vhz ) = *(framebuffer + xhbp_yvbl );
987             *(blit_data + vhz + 1) = *(framebuffer + xhbp_yvbl + 1);
988             *(blit_data + vhz + 2) = *(framebuffer + xhbp_yvbl + 2);
989             } else {
990             *((unsigned short*)(blit_data + vhz )) = *((unsigned short*)(framebuffer + xhbp_yvbl ));
991             }
992             }
993             }
994             }
995             }
996             }
997              
998             // Blits a rectangle of graphics to the screen using the specified draw mode
999             void c_blit_write(
1000             char *framebuffer,
1001             short screen_width, short screen_height,
1002             unsigned int bytes_per_line,
1003             short xoffset, short yoffset,
1004             char *blit_data,
1005             short x, short y, short w, short h,
1006             unsigned char bytes_per_pixel,
1007             unsigned char draw_mode,
1008             unsigned char alpha,
1009             unsigned int bcolor,
1010             short x_clip, short y_clip, short xx_clip, short yy_clip)
1011             {
1012             short fb_x = xoffset + x;
1013             short fb_y = yoffset + y;
1014             short xx = x + w;
1015             short yy = y + h;
1016             short horizontal;
1017             short vertical;
1018             unsigned int bline = w * bytes_per_pixel;
1019              
1020             // Fastest is unclipped normal mode
1021             if (draw_mode == NORMAL_MODE && x >= x_clip && xx <= xx_clip && y >= y_clip && yy <= yy_clip) {
1022             unsigned char *source = blit_data;
1023             unsigned char *dest = &framebuffer[(fb_y * bytes_per_line) + (fb_x * bytes_per_pixel)];
1024             for (vertical = 0; vertical < h; vertical++) {
1025             memcpy(dest, source, bline);
1026             source += bline;
1027             dest += bytes_per_line;
1028             }
1029             } else {
1030             switch(draw_mode) {
1031             case NORMAL_MODE :
1032             switch(bytes_per_pixel) {
1033             case 4 :
1034             for (vertical = 0; vertical < h; vertical++) {
1035             unsigned int vbl = vertical * bline;
1036             unsigned short yv = fb_y + vertical;
1037             unsigned int yvbl = yv * bytes_per_line;
1038             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1039             for (horizontal = 0; horizontal < w; horizontal++) {
1040             unsigned short xh = fb_x + horizontal;
1041             unsigned int xhbp = xh * bytes_per_pixel;
1042             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1043             unsigned int hzpixel = horizontal * bytes_per_pixel;
1044             unsigned int vhz = vbl + hzpixel;
1045             unsigned int yvhz = yvbl + hzpixel;
1046             unsigned int xhbp_yvbl = xhbp + yvbl;
1047             *((unsigned int*)(framebuffer + xhbp_yvbl)) = *((unsigned int*)(blit_data + vhz));
1048             }
1049             }
1050             }
1051             }
1052             break;
1053             case 3 :
1054             for (vertical = 0; vertical < h; vertical++) {
1055             unsigned int vbl = vertical * bline;
1056             unsigned short yv = fb_y + vertical;
1057             unsigned int yvbl = yv * bytes_per_line;
1058             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1059             for (horizontal = 0; horizontal < w; horizontal++) {
1060             unsigned short xh = fb_x + horizontal;
1061             unsigned int xhbp = xh * bytes_per_pixel;
1062             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1063             unsigned int hzpixel = horizontal * bytes_per_pixel;
1064             unsigned int vhz = vbl + hzpixel;
1065             unsigned int yvhz = yvbl + hzpixel;
1066             unsigned int xhbp_yvbl = xhbp + yvbl;
1067             *(framebuffer + xhbp_yvbl ) = *(blit_data + vhz );
1068             *(framebuffer + xhbp_yvbl + 1) = *(blit_data + vhz + 1);
1069             *(framebuffer + xhbp_yvbl + 2) = *(blit_data + vhz + 2);
1070             }
1071             }
1072             }
1073             }
1074             break;
1075             case 2 :
1076             for (vertical = 0; vertical < h; vertical++) {
1077             unsigned int vbl = vertical * bline;
1078             unsigned short yv = fb_y + vertical;
1079             unsigned int yvbl = yv * bytes_per_line;
1080             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1081             for (horizontal = 0; horizontal < w; horizontal++) {
1082             unsigned short xh = fb_x + horizontal;
1083             unsigned int xhbp = xh * bytes_per_pixel;
1084             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1085             unsigned int hzpixel = horizontal * bytes_per_pixel;
1086             unsigned int vhz = vbl + hzpixel;
1087             unsigned int yvhz = yvbl + hzpixel;
1088             unsigned int xhbp_yvbl = xhbp + yvbl;
1089             *((unsigned short*)(framebuffer + xhbp_yvbl )) = *((unsigned short*)(blit_data + vhz ));
1090             }
1091             }
1092             }
1093             }
1094             break;
1095             }
1096             break;
1097             case XOR_MODE :
1098             switch(bytes_per_pixel) {
1099             case 4 :
1100             for (vertical = 0; vertical < h; vertical++) {
1101             unsigned int vbl = vertical * bline;
1102             unsigned short yv = fb_y + vertical;
1103             unsigned int yvbl = yv * bytes_per_line;
1104             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1105             for (horizontal = 0; horizontal < w; horizontal++) {
1106             unsigned short xh = fb_x + horizontal;
1107             unsigned int xhbp = xh * bytes_per_pixel;
1108             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1109             unsigned int hzpixel = horizontal * bytes_per_pixel;
1110             unsigned int vhz = vbl + hzpixel;
1111             unsigned int yvhz = yvbl + hzpixel;
1112             unsigned int xhbp_yvbl = xhbp + yvbl;
1113             *((unsigned int*)(framebuffer + xhbp_yvbl)) ^= *((unsigned int*)(blit_data + vhz));
1114             }
1115             }
1116             }
1117             }
1118             break;
1119             case 3 :
1120             for (vertical = 0; vertical < h; vertical++) {
1121             unsigned int vbl = vertical * bline;
1122             unsigned short yv = fb_y + vertical;
1123             unsigned int yvbl = yv * bytes_per_line;
1124             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1125             for (horizontal = 0; horizontal < w; horizontal++) {
1126             unsigned short xh = fb_x + horizontal;
1127             unsigned int xhbp = xh * bytes_per_pixel;
1128             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1129             unsigned int hzpixel = horizontal * bytes_per_pixel;
1130             unsigned int vhz = vbl + hzpixel;
1131             unsigned int yvhz = yvbl + hzpixel;
1132             unsigned int xhbp_yvbl = xhbp + yvbl;
1133             *(framebuffer + xhbp_yvbl ) ^= *(blit_data + vhz );
1134             *(framebuffer + xhbp_yvbl + 1) ^= *(blit_data + vhz + 1);
1135             *(framebuffer + xhbp_yvbl + 2) ^= *(blit_data + vhz + 2);
1136             }
1137             }
1138             }
1139             }
1140             break;
1141             case 2 :
1142             for (vertical = 0; vertical < h; vertical++) {
1143             unsigned int vbl = vertical * bline;
1144             unsigned short yv = fb_y + vertical;
1145             unsigned int yvbl = yv * bytes_per_line;
1146             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1147             for (horizontal = 0; horizontal < w; horizontal++) {
1148             unsigned short xh = fb_x + horizontal;
1149             unsigned int xhbp = xh * bytes_per_pixel;
1150             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1151             unsigned int hzpixel = horizontal * bytes_per_pixel;
1152             unsigned int vhz = vbl + hzpixel;
1153             unsigned int yvhz = yvbl + hzpixel;
1154             unsigned int xhbp_yvbl = xhbp + yvbl;
1155             *((unsigned short*)(framebuffer + xhbp_yvbl )) ^= *((unsigned short*)(blit_data + vhz ));
1156             }
1157             }
1158             }
1159             }
1160             break;
1161             }
1162             break;
1163             case OR_MODE :
1164             switch(bytes_per_pixel) {
1165             case 4 :
1166             for (vertical = 0; vertical < h; vertical++) {
1167             unsigned int vbl = vertical * bline;
1168             unsigned short yv = fb_y + vertical;
1169             unsigned int yvbl = yv * bytes_per_line;
1170             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1171             for (horizontal = 0; horizontal < w; horizontal++) {
1172             unsigned short xh = fb_x + horizontal;
1173             unsigned int xhbp = xh * bytes_per_pixel;
1174             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1175             unsigned int hzpixel = horizontal * bytes_per_pixel;
1176             unsigned int vhz = vbl + hzpixel;
1177             unsigned int yvhz = yvbl + hzpixel;
1178             unsigned int xhbp_yvbl = xhbp + yvbl;
1179             *((unsigned int*)(framebuffer + xhbp_yvbl)) |= *((unsigned int*)(blit_data + vhz));
1180             }
1181             }
1182             }
1183             }
1184             break;
1185             case 3 :
1186             for (vertical = 0; vertical < h; vertical++) {
1187             unsigned int vbl = vertical * bline;
1188             unsigned short yv = fb_y + vertical;
1189             unsigned int yvbl = yv * bytes_per_line;
1190             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1191             for (horizontal = 0; horizontal < w; horizontal++) {
1192             unsigned short xh = fb_x + horizontal;
1193             unsigned int xhbp = xh * bytes_per_pixel;
1194             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1195             unsigned int hzpixel = horizontal * bytes_per_pixel;
1196             unsigned int vhz = vbl + hzpixel;
1197             unsigned int yvhz = yvbl + hzpixel;
1198             unsigned int xhbp_yvbl = xhbp + yvbl;
1199             *(framebuffer + xhbp_yvbl ) |= *(blit_data + vhz );
1200             *(framebuffer + xhbp_yvbl + 1) |= *(blit_data + vhz + 1);
1201             *(framebuffer + xhbp_yvbl + 2) |= *(blit_data + vhz + 2);
1202             }
1203             }
1204             }
1205             }
1206             break;
1207             case 2 :
1208             for (vertical = 0; vertical < h; vertical++) {
1209             unsigned int vbl = vertical * bline;
1210             unsigned short yv = fb_y + vertical;
1211             unsigned int yvbl = yv * bytes_per_line;
1212             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1213             for (horizontal = 0; horizontal < w; horizontal++) {
1214             unsigned short xh = fb_x + horizontal;
1215             unsigned int xhbp = xh * bytes_per_pixel;
1216             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1217             unsigned int hzpixel = horizontal * bytes_per_pixel;
1218             unsigned int vhz = vbl + hzpixel;
1219             unsigned int yvhz = yvbl + hzpixel;
1220             unsigned int xhbp_yvbl = xhbp + yvbl;
1221             *((unsigned short*)(framebuffer + xhbp_yvbl )) |= *((unsigned short*)(blit_data + vhz ));
1222             }
1223             }
1224             }
1225             }
1226             break;
1227             }
1228             break;
1229             case AND_MODE :
1230             switch(bytes_per_pixel) {
1231             case 4 :
1232             for (vertical = 0; vertical < h; vertical++) {
1233             unsigned int vbl = vertical * bline;
1234             unsigned short yv = fb_y + vertical;
1235             unsigned int yvbl = yv * bytes_per_line;
1236             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1237             for (horizontal = 0; horizontal < w; horizontal++) {
1238             unsigned short xh = fb_x + horizontal;
1239             unsigned int xhbp = xh * bytes_per_pixel;
1240             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1241             unsigned int hzpixel = horizontal * bytes_per_pixel;
1242             unsigned int vhz = vbl + hzpixel;
1243             unsigned int yvhz = yvbl + hzpixel;
1244             unsigned int xhbp_yvbl = xhbp + yvbl;
1245             *((unsigned int*)(framebuffer + xhbp_yvbl)) &= *((unsigned int*)(blit_data + vhz));
1246             }
1247             }
1248             }
1249             }
1250             break;
1251             case 3 :
1252             for (vertical = 0; vertical < h; vertical++) {
1253             unsigned int vbl = vertical * bline;
1254             unsigned short yv = fb_y + vertical;
1255             unsigned int yvbl = yv * bytes_per_line;
1256             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1257             for (horizontal = 0; horizontal < w; horizontal++) {
1258             unsigned short xh = fb_x + horizontal;
1259             unsigned int xhbp = xh * bytes_per_pixel;
1260             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1261             unsigned int hzpixel = horizontal * bytes_per_pixel;
1262             unsigned int vhz = vbl + hzpixel;
1263             unsigned int yvhz = yvbl + hzpixel;
1264             unsigned int xhbp_yvbl = xhbp + yvbl;
1265             *(framebuffer + xhbp_yvbl ) &= *(blit_data + vhz );
1266             *(framebuffer + xhbp_yvbl + 1) &= *(blit_data + vhz + 1);
1267             *(framebuffer + xhbp_yvbl + 2) &= *(blit_data + vhz + 2);
1268             }
1269             }
1270             }
1271             }
1272             break;
1273             case 2 :
1274             for (vertical = 0; vertical < h; vertical++) {
1275             unsigned int vbl = vertical * bline;
1276             unsigned short yv = fb_y + vertical;
1277             unsigned int yvbl = yv * bytes_per_line;
1278             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1279             for (horizontal = 0; horizontal < w; horizontal++) {
1280             unsigned short xh = fb_x + horizontal;
1281             unsigned int xhbp = xh * bytes_per_pixel;
1282             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1283             unsigned int hzpixel = horizontal * bytes_per_pixel;
1284             unsigned int vhz = vbl + hzpixel;
1285             unsigned int yvhz = yvbl + hzpixel;
1286             unsigned int xhbp_yvbl = xhbp + yvbl;
1287             *((unsigned short*)(framebuffer + xhbp_yvbl )) &= *((unsigned short*)(blit_data + vhz ));
1288             }
1289             }
1290             }
1291             }
1292             break;
1293             }
1294             break;
1295             case MASK_MODE :
1296             switch(bytes_per_pixel) {
1297             case 4 :
1298             for (vertical = 0; vertical < h; vertical++) {
1299             unsigned int vbl = vertical * bline;
1300             unsigned short yv = fb_y + vertical;
1301             unsigned int yvbl = yv * bytes_per_line;
1302             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1303             for (horizontal = 0; horizontal < w; horizontal++) {
1304             unsigned short xh = fb_x + horizontal;
1305             unsigned int xhbp = xh * bytes_per_pixel;
1306             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1307             unsigned int hzpixel = horizontal * bytes_per_pixel;
1308             unsigned int vhz = vbl + hzpixel;
1309             unsigned int yvhz = yvbl + hzpixel;
1310             unsigned int xhbp_yvbl = xhbp + yvbl;
1311             unsigned int rgb = *((unsigned int*)(blit_data + vhz ));
1312             if (( rgb & 0xFFFFFF00) != (bcolor & 0xFFFFFF00)) { // Ignore alpha channel
1313             *((unsigned int*)(framebuffer + xhbp_yvbl )) = rgb;
1314             }
1315             }
1316             }
1317             }
1318             }
1319             break;
1320             case 3 :
1321             for (vertical = 0; vertical < h; vertical++) {
1322             unsigned int vbl = vertical * bline;
1323             unsigned short yv = fb_y + vertical;
1324             unsigned int yvbl = yv * bytes_per_line;
1325             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1326             for (horizontal = 0; horizontal < w; horizontal++) {
1327             unsigned short xh = fb_x + horizontal;
1328             unsigned int xhbp = xh * bytes_per_pixel;
1329             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1330             unsigned int hzpixel = horizontal * bytes_per_pixel;
1331             unsigned int vhz = vbl + hzpixel;
1332             unsigned int yvhz = yvbl + hzpixel;
1333             unsigned int xhbp_yvbl = xhbp + yvbl;
1334             if ((*((unsigned int*)(blit_data + vhz )) & 0xFFFFFF00) != (bcolor & 0xFFFFFF00)) { // Ignore alpha channel
1335             *(framebuffer + xhbp_yvbl ) = *(blit_data + vhz );
1336             *(framebuffer + xhbp_yvbl + 1) = *(blit_data + vhz + 1);
1337             *(framebuffer + xhbp_yvbl + 2) = *(blit_data + vhz + 2);
1338             }
1339             }
1340             }
1341             }
1342             }
1343             break;
1344             case 2 :
1345             for (vertical = 0; vertical < h; vertical++) {
1346             unsigned int vbl = vertical * bline;
1347             unsigned short yv = fb_y + vertical;
1348             unsigned int yvbl = yv * bytes_per_line;
1349             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1350             for (horizontal = 0; horizontal < w; horizontal++) {
1351             unsigned short xh = fb_x + horizontal;
1352             unsigned int xhbp = xh * bytes_per_pixel;
1353             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1354             unsigned int hzpixel = horizontal * bytes_per_pixel;
1355             unsigned int vhz = vbl + hzpixel;
1356             unsigned int yvhz = yvbl + hzpixel;
1357             unsigned int xhbp_yvbl = xhbp + yvbl;
1358             unsigned int rgb = *((unsigned short*)(blit_data + vhz ));
1359             if (rgb != (bcolor & 0xFFFF)) {
1360             *((unsigned short*)(framebuffer + xhbp_yvbl )) = rgb;
1361             }
1362             }
1363             }
1364             }
1365             }
1366             break;
1367             }
1368             break;
1369             case UNMASK_MODE :
1370             switch(bytes_per_pixel) {
1371             case 4 :
1372             for (vertical = 0; vertical < h; vertical++) {
1373             unsigned int vbl = vertical * bline;
1374             unsigned short yv = fb_y + vertical;
1375             unsigned int yvbl = yv * bytes_per_line;
1376             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1377             for (horizontal = 0; horizontal < w; horizontal++) {
1378             unsigned short xh = fb_x + horizontal;
1379             unsigned int xhbp = xh * bytes_per_pixel;
1380             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1381             unsigned int hzpixel = horizontal * bytes_per_pixel;
1382             unsigned int vhz = vbl + hzpixel;
1383             unsigned int yvhz = yvbl + hzpixel;
1384             unsigned int xhbp_yvbl = xhbp + yvbl;
1385             if ((*((unsigned int*)(framebuffer + xhbp_yvbl )) & 0xFFFFFF00) == (bcolor & 0xFFFFFF00)) { // Ignore alpha channel for color testing
1386             *((unsigned int*)(framebuffer + xhbp_yvbl )) = *((unsigned int*)(blit_data + vhz ));
1387             }
1388             }
1389             }
1390             }
1391             }
1392             break;
1393             case 3 :
1394             for (vertical = 0; vertical < h; vertical++) {
1395             unsigned int vbl = vertical * bline;
1396             unsigned short yv = fb_y + vertical;
1397             unsigned int yvbl = yv * bytes_per_line;
1398             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1399             for (horizontal = 0; horizontal < w; horizontal++) {
1400             unsigned short xh = fb_x + horizontal;
1401             unsigned int xhbp = xh * bytes_per_pixel;
1402             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1403             unsigned int hzpixel = horizontal * bytes_per_pixel;
1404             unsigned int vhz = vbl + hzpixel;
1405             unsigned int yvhz = yvbl + hzpixel;
1406             unsigned int xhbp_yvbl = xhbp + yvbl;
1407             if (*((unsigned int*)(framebuffer + xhbp + yvhz )) == (bcolor & 0xFFFFFF00)) {
1408             *(framebuffer + xhbp_yvbl ) = *(blit_data + vhz );
1409             *(framebuffer + xhbp_yvbl + 1) = *(blit_data + vhz + 1);
1410             *(framebuffer + xhbp_yvbl + 2) = *(blit_data + vhz + 2);
1411             }
1412             }
1413             }
1414             }
1415             }
1416             break;
1417             case 2 :
1418             for (vertical = 0; vertical < h; vertical++) {
1419             unsigned int vbl = vertical * bline;
1420             unsigned short yv = fb_y + vertical;
1421             unsigned int yvbl = yv * bytes_per_line;
1422             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1423             for (horizontal = 0; horizontal < w; horizontal++) {
1424             unsigned short xh = fb_x + horizontal;
1425             unsigned int xhbp = xh * bytes_per_pixel;
1426             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1427             unsigned int hzpixel = horizontal * bytes_per_pixel;
1428             unsigned int vhz = vbl + hzpixel;
1429             unsigned int yvhz = yvbl + hzpixel;
1430             unsigned int xhbp_yvbl = xhbp + yvbl;
1431             if (*((unsigned short*)(framebuffer + xhbp + yvhz )) == (bcolor & 0xFFFF)) {
1432             *((unsigned short*)(framebuffer + xhbp_yvbl )) = *((unsigned short*)(blit_data + vhz ));
1433             }
1434             }
1435             }
1436             }
1437             }
1438             break;
1439             }
1440             break;
1441             case ALPHA_MODE :
1442             switch(bytes_per_pixel) {
1443             case 4 :
1444             for (vertical = 0; vertical < h; vertical++) {
1445             unsigned int vbl = vertical * bline;
1446             unsigned short yv = fb_y + vertical;
1447             unsigned int yvbl = yv * bytes_per_line;
1448             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1449             for (horizontal = 0; horizontal < w; horizontal++) {
1450             unsigned short xh = fb_x + horizontal;
1451             unsigned int xhbp = xh * bytes_per_pixel;
1452             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1453             unsigned int hzpixel = horizontal * bytes_per_pixel;
1454             unsigned int vhz = vbl + hzpixel;
1455             unsigned int yvhz = yvbl + hzpixel;
1456             unsigned int xhbp_yvbl = xhbp + yvbl;
1457              
1458             unsigned int fb_rgb = *((unsigned int*)(framebuffer + xhbp_yvbl));
1459             unsigned char fb_r = fb_rgb & 255;
1460             unsigned char fb_g = (fb_rgb >> 8) & 255;
1461             unsigned char fb_b = (fb_rgb >> 16) & 255;
1462              
1463             unsigned int blit_rgb = *((unsigned int*)(blit_data + vhz));
1464             unsigned char R = blit_rgb & 255;
1465             unsigned char G = (blit_rgb >> 8) & 255;
1466             unsigned char B = (blit_rgb >> 16) & 255;
1467             unsigned char A = (blit_rgb >> 24) & 255;
1468             unsigned char invA = (255 - A);
1469              
1470             fb_r = ((R * A) + (fb_r * invA)) >> 8;
1471             fb_g = ((G * A) + (fb_g * invA)) >> 8;
1472             fb_b = ((B * A) + (fb_b * invA)) >> 8;
1473              
1474             *((unsigned int*)(framebuffer + xhbp_yvbl)) = fb_r | (fb_g << 8) | (fb_b << 16) | (A << 24);
1475             }
1476             }
1477             }
1478             }
1479             break;
1480             case 3 :
1481             for (vertical = 0; vertical < h; vertical++) {
1482             unsigned int vbl = vertical * bline;
1483             unsigned short yv = fb_y + vertical;
1484             unsigned int yvbl = yv * bytes_per_line;
1485             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1486             for (horizontal = 0; horizontal < w; horizontal++) {
1487             unsigned short xh = fb_x + horizontal;
1488             unsigned int xhbp = xh * bytes_per_pixel;
1489             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1490             unsigned int hzpixel = horizontal * bytes_per_pixel;
1491             unsigned int vhz = vbl + hzpixel;
1492             unsigned int yvhz = yvbl + hzpixel;
1493             unsigned int xhbp_yvbl = xhbp + yvbl;
1494              
1495             unsigned char fb_r = *(framebuffer + xhbp_yvbl );
1496             unsigned char fb_g = *(framebuffer + xhbp_yvbl + 1);
1497             unsigned char fb_b = *(framebuffer + xhbp_yvbl + 2);
1498             unsigned char R = *(blit_data + vhz );
1499             unsigned char G = *(blit_data + vhz + 1);
1500             unsigned char B = *(blit_data + vhz + 2);
1501             unsigned char invA = (255 - alpha);
1502              
1503             fb_r = ((R * alpha) + (fb_r * invA)) >> 8;
1504             fb_g = ((G * alpha) + (fb_g * invA)) >> 8;
1505             fb_b = ((B * alpha) + (fb_b * invA)) >> 8;
1506              
1507             *(framebuffer + xhbp_yvbl ) = fb_r;
1508             *(framebuffer + xhbp_yvbl + 1) = fb_g;
1509             *(framebuffer + xhbp_yvbl + 2) = fb_b;
1510             }
1511             }
1512             }
1513             }
1514             break;
1515             case 2 :
1516             for (vertical = 0; vertical < h; vertical++) {
1517             unsigned int vbl = vertical * bline;
1518             unsigned short yv = fb_y + vertical;
1519             unsigned int yvbl = yv * bytes_per_line;
1520             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1521             for (horizontal = 0; horizontal < w; horizontal++) {
1522             unsigned short xh = fb_x + horizontal;
1523             unsigned int xhbp = xh * bytes_per_pixel;
1524             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1525             unsigned int hzpixel = horizontal * bytes_per_pixel;
1526             unsigned int vhz = vbl + hzpixel;
1527             unsigned int yvhz = yvbl + hzpixel;
1528             unsigned int xhbp_yvbl = xhbp + yvbl;
1529             unsigned short rgb565 = *((unsigned short*)(framebuffer + xhbp_yvbl ));
1530              
1531             unsigned short fb_r = rgb565 & 31;
1532             unsigned short fb_g = (rgb565 >> 5) & 63;
1533             unsigned short fb_b = (rgb565 >> 11) & 31;
1534             rgb565 = *((unsigned short*)(blit_data + vhz ));
1535             unsigned short R = rgb565 & 31;
1536             unsigned short G = (rgb565 >> 5) & 63;
1537             unsigned short B = (rgb565 >> 11) & 31;
1538             unsigned char invA = (255 - alpha);
1539             fb_r = ((R * alpha) + (fb_r * invA)) >> 8;
1540             fb_g = ((G * alpha) + (fb_g * invA)) >> 8;
1541             fb_b = ((B * alpha) + (fb_b * invA)) >> 8;
1542              
1543             *((unsigned short*)(framebuffer + xhbp_yvbl )) = (fb_b << 11) | (fb_g << 5) | fb_r;
1544              
1545             }
1546             }
1547             }
1548             }
1549             break;
1550             }
1551             break;
1552             case ADD_MODE :
1553             switch(bytes_per_pixel) {
1554             case 4 :
1555             for (vertical = 0; vertical < h; vertical++) {
1556             unsigned int vbl = vertical * bline;
1557             unsigned short yv = fb_y + vertical;
1558             unsigned int yvbl = yv * bytes_per_line;
1559             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1560             for (horizontal = 0; horizontal < w; horizontal++) {
1561             unsigned short xh = fb_x + horizontal;
1562             unsigned int xhbp = xh * bytes_per_pixel;
1563             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1564             unsigned int hzpixel = horizontal * bytes_per_pixel;
1565             unsigned int vhz = vbl + hzpixel;
1566             unsigned int yvhz = yvbl + hzpixel;
1567             unsigned int xhbp_yvbl = xhbp + yvbl;
1568             *((unsigned int*)(framebuffer + xhbp_yvbl)) += *((unsigned int*)(blit_data + vhz));
1569             }
1570             }
1571             }
1572             }
1573             break;
1574             case 3 :
1575             for (vertical = 0; vertical < h; vertical++) {
1576             unsigned int vbl = vertical * bline;
1577             unsigned short yv = fb_y + vertical;
1578             unsigned int yvbl = yv * bytes_per_line;
1579             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1580             for (horizontal = 0; horizontal < w; horizontal++) {
1581             unsigned short xh = fb_x + horizontal;
1582             unsigned int xhbp = xh * bytes_per_pixel;
1583             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1584             unsigned int hzpixel = horizontal * bytes_per_pixel;
1585             unsigned int vhz = vbl + hzpixel;
1586             unsigned int yvhz = yvbl + hzpixel;
1587             unsigned int xhbp_yvbl = xhbp + yvbl;
1588             *(framebuffer + xhbp_yvbl ) += *(blit_data + vhz );
1589             *(framebuffer + xhbp_yvbl + 1) += *(blit_data + vhz + 1);
1590             *(framebuffer + xhbp_yvbl + 2) += *(blit_data + vhz + 2);
1591             }
1592             }
1593             }
1594             }
1595             break;
1596             case 2 :
1597             for (vertical = 0; vertical < h; vertical++) {
1598             unsigned int vbl = vertical * bline;
1599             unsigned short yv = fb_y + vertical;
1600             unsigned int yvbl = yv * bytes_per_line;
1601             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1602             for (horizontal = 0; horizontal < w; horizontal++) {
1603             unsigned short xh = fb_x + horizontal;
1604             unsigned int xhbp = xh * bytes_per_pixel;
1605             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1606             unsigned int hzpixel = horizontal * bytes_per_pixel;
1607             unsigned int vhz = vbl + hzpixel;
1608             unsigned int yvhz = yvbl + hzpixel;
1609             unsigned int xhbp_yvbl = xhbp + yvbl;
1610             *((unsigned short*)(framebuffer + xhbp_yvbl )) += *((unsigned short*)(blit_data + vhz ));
1611             }
1612             }
1613             }
1614             }
1615             break;
1616             }
1617             break;
1618             case SUBTRACT_MODE :
1619             switch(bytes_per_pixel) {
1620             case 4 :
1621             for (vertical = 0; vertical < h; vertical++) {
1622             unsigned int vbl = vertical * bline;
1623             unsigned short yv = fb_y + vertical;
1624             unsigned int yvbl = yv * bytes_per_line;
1625             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1626             for (horizontal = 0; horizontal < w; horizontal++) {
1627             unsigned short xh = fb_x + horizontal;
1628             unsigned int xhbp = xh * bytes_per_pixel;
1629             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1630             unsigned int hzpixel = horizontal * bytes_per_pixel;
1631             unsigned int vhz = vbl + hzpixel;
1632             unsigned int yvhz = yvbl + hzpixel;
1633             unsigned int xhbp_yvbl = xhbp + yvbl;
1634             *((unsigned int*)(framebuffer + xhbp_yvbl)) -= *((unsigned int*)(blit_data + vhz));
1635             }
1636             }
1637             }
1638             }
1639             break;
1640             case 3 :
1641             for (vertical = 0; vertical < h; vertical++) {
1642             unsigned int vbl = vertical * bline;
1643             unsigned short yv = fb_y + vertical;
1644             unsigned int yvbl = yv * bytes_per_line;
1645             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1646             for (horizontal = 0; horizontal < w; horizontal++) {
1647             unsigned short xh = fb_x + horizontal;
1648             unsigned int xhbp = xh * bytes_per_pixel;
1649             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1650             unsigned int hzpixel = horizontal * bytes_per_pixel;
1651             unsigned int vhz = vbl + hzpixel;
1652             unsigned int yvhz = yvbl + hzpixel;
1653             unsigned int xhbp_yvbl = xhbp + yvbl;
1654             *(framebuffer + xhbp_yvbl ) -= *(blit_data + vhz );
1655             *(framebuffer + xhbp_yvbl + 1) -= *(blit_data + vhz + 1);
1656             *(framebuffer + xhbp_yvbl + 2) -= *(blit_data + vhz + 2);
1657             }
1658             }
1659             }
1660             }
1661             break;
1662             case 2 :
1663             for (vertical = 0; vertical < h; vertical++) {
1664             unsigned int vbl = vertical * bline;
1665             unsigned short yv = fb_y + vertical;
1666             unsigned int yvbl = yv * bytes_per_line;
1667             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1668             for (horizontal = 0; horizontal < w; horizontal++) {
1669             unsigned short xh = fb_x + horizontal;
1670             unsigned int xhbp = xh * bytes_per_pixel;
1671             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1672             unsigned int hzpixel = horizontal * bytes_per_pixel;
1673             unsigned int vhz = vbl + hzpixel;
1674             unsigned int yvhz = yvbl + hzpixel;
1675             unsigned int xhbp_yvbl = xhbp + yvbl;
1676             *((unsigned short*)(framebuffer + xhbp_yvbl )) -= *((unsigned short*)(blit_data + vhz ));
1677             }
1678             }
1679             }
1680             }
1681             break;
1682             }
1683             break;
1684             case MULTIPLY_MODE :
1685             switch(bytes_per_pixel) {
1686             case 4 :
1687             for (vertical = 0; vertical < h; vertical++) {
1688             unsigned int vbl = vertical * bline;
1689             unsigned short yv = fb_y + vertical;
1690             unsigned int yvbl = yv * bytes_per_line;
1691             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1692             for (horizontal = 0; horizontal < w; horizontal++) {
1693             unsigned short xh = fb_x + horizontal;
1694             unsigned int xhbp = xh * bytes_per_pixel;
1695             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1696             unsigned int hzpixel = horizontal * bytes_per_pixel;
1697             unsigned int vhz = vbl + hzpixel;
1698             unsigned int yvhz = yvbl + hzpixel;
1699             unsigned int xhbp_yvbl = xhbp + yvbl;
1700             *((unsigned int*)(framebuffer + xhbp_yvbl)) *= *((unsigned int*)(blit_data + vhz));
1701             }
1702             }
1703             }
1704             }
1705             break;
1706             case 3 :
1707             for (vertical = 0; vertical < h; vertical++) {
1708             unsigned int vbl = vertical * bline;
1709             unsigned short yv = fb_y + vertical;
1710             unsigned int yvbl = yv * bytes_per_line;
1711             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1712             for (horizontal = 0; horizontal < w; horizontal++) {
1713             unsigned short xh = fb_x + horizontal;
1714             unsigned int xhbp = xh * bytes_per_pixel;
1715             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1716             unsigned int hzpixel = horizontal * bytes_per_pixel;
1717             unsigned int vhz = vbl + hzpixel;
1718             unsigned int yvhz = yvbl + hzpixel;
1719             unsigned int xhbp_yvbl = xhbp + yvbl;
1720             *(framebuffer + xhbp_yvbl ) *= *(blit_data + vhz );
1721             *(framebuffer + xhbp_yvbl + 1) *= *(blit_data + vhz + 1);
1722             *(framebuffer + xhbp_yvbl + 2) *= *(blit_data + vhz + 2);
1723             }
1724             }
1725             }
1726             }
1727             break;
1728             case 2 :
1729             for (vertical = 0; vertical < h; vertical++) {
1730             unsigned int vbl = vertical * bline;
1731             unsigned short yv = fb_y + vertical;
1732             unsigned int yvbl = yv * bytes_per_line;
1733             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1734             for (horizontal = 0; horizontal < w; horizontal++) {
1735             unsigned short xh = fb_x + horizontal;
1736             unsigned int xhbp = xh * bytes_per_pixel;
1737             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1738             unsigned int hzpixel = horizontal * bytes_per_pixel;
1739             unsigned int vhz = vbl + hzpixel;
1740             unsigned int yvhz = yvbl + hzpixel;
1741             unsigned int xhbp_yvbl = xhbp + yvbl;
1742             *((unsigned short*)(framebuffer + xhbp_yvbl )) *= *((unsigned short*)(blit_data + vhz ));
1743             }
1744             }
1745             }
1746             }
1747             break;
1748             }
1749             break;
1750             case DIVIDE_MODE :
1751             switch(bytes_per_pixel) {
1752             case 4 :
1753             for (vertical = 0; vertical < h; vertical++) {
1754             unsigned int vbl = vertical * bline;
1755             unsigned short yv = fb_y + vertical;
1756             unsigned int yvbl = yv * bytes_per_line;
1757             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1758             for (horizontal = 0; horizontal < w; horizontal++) {
1759             unsigned short xh = fb_x + horizontal;
1760             unsigned int xhbp = xh * bytes_per_pixel;
1761             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1762             unsigned int hzpixel = horizontal * bytes_per_pixel;
1763             unsigned int vhz = vbl + hzpixel;
1764             unsigned int yvhz = yvbl + hzpixel;
1765             unsigned int xhbp_yvbl = xhbp + yvbl;
1766             *((unsigned int*)(framebuffer + xhbp_yvbl)) /= *((unsigned int*)(blit_data + vhz));
1767             }
1768             }
1769             }
1770             }
1771             break;
1772             case 3 :
1773             for (vertical = 0; vertical < h; vertical++) {
1774             unsigned int vbl = vertical * bline;
1775             unsigned short yv = fb_y + vertical;
1776             unsigned int yvbl = yv * bytes_per_line;
1777             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1778             for (horizontal = 0; horizontal < w; horizontal++) {
1779             unsigned short xh = fb_x + horizontal;
1780             unsigned int xhbp = xh * bytes_per_pixel;
1781             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1782             unsigned int hzpixel = horizontal * bytes_per_pixel;
1783             unsigned int vhz = vbl + hzpixel;
1784             unsigned int yvhz = yvbl + hzpixel;
1785             unsigned int xhbp_yvbl = xhbp + yvbl;
1786             *(framebuffer + xhbp_yvbl ) /= *(blit_data + vhz );
1787             *(framebuffer + xhbp_yvbl + 1) /= *(blit_data + vhz + 1);
1788             *(framebuffer + xhbp_yvbl + 2) /= *(blit_data + vhz + 2);
1789             }
1790             }
1791             }
1792             }
1793             break;
1794             case 2 :
1795             for (vertical = 0; vertical < h; vertical++) {
1796             unsigned int vbl = vertical * bline;
1797             unsigned short yv = fb_y + vertical;
1798             unsigned int yvbl = yv * bytes_per_line;
1799             if (yv >= (yoffset + y_clip) && yv <= (yoffset + yy_clip)) {
1800             for (horizontal = 0; horizontal < w; horizontal++) {
1801             unsigned short xh = fb_x + horizontal;
1802             unsigned int xhbp = xh * bytes_per_pixel;
1803             if (xh >= (xoffset + x_clip) && xh <= (xoffset + xx_clip)) {
1804             unsigned int hzpixel = horizontal * bytes_per_pixel;
1805             unsigned int vhz = vbl + hzpixel;
1806             unsigned int yvhz = yvbl + hzpixel;
1807             unsigned int xhbp_yvbl = xhbp + yvbl;
1808             *((unsigned short*)(framebuffer + xhbp_yvbl )) /= *((unsigned short*)(blit_data + vhz ));
1809             }
1810             }
1811             }
1812             }
1813             break;
1814             }
1815             break;
1816             }
1817             }
1818             }
1819              
1820             // Fast rotate blit graphics data
1821             void c_rotate(
1822             char *image,
1823             char *new_img,
1824             short width, short height,
1825             unsigned short wh,
1826             double degrees,
1827             unsigned char bytes_per_pixel)
1828             {
1829             unsigned int hwh = floor(wh / 2 + 0.5);
1830             unsigned int bbline = wh * bytes_per_pixel;
1831             unsigned int bline = width * bytes_per_pixel;
1832             unsigned short hwidth = floor(width / 2 + 0.5);
1833             unsigned short hheight = floor(height / 2 + 0.5);
1834             double sinma = sin((degrees * M_PI) / 180);
1835             double cosma = cos((degrees * M_PI) / 180);
1836             short x;
1837             short y;
1838              
1839             for (x = 0; x < wh; x++) {
1840             short xt = x - hwh;
1841             for (y = 0; y < wh; y++) {
1842             short yt = y - hwh;
1843             short xs = ((cosma * xt - sinma * yt) + hwidth);
1844             short ys = ((sinma * xt + cosma * yt) + hheight);
1845             if (xs >= 0 && xs < width && ys >= 0 && ys < height) {
1846             switch(bytes_per_pixel) {
1847             case 4 :
1848             {
1849             *((unsigned int*)(new_img + (x * bytes_per_pixel) + (y * bbline))) = *((unsigned int*)(image + (xs * bytes_per_pixel) + (ys * bline)));
1850             }
1851             break;
1852             case 3 :
1853             {
1854             *(new_img + (x * bytes_per_pixel) + (y * bbline)) = *(image + (xs * bytes_per_pixel) + (ys * bline));
1855             *(new_img + (x * bytes_per_pixel) + (y * bbline) + 1) = *(image + (xs * bytes_per_pixel) + (ys * bline) + 1);
1856             *(new_img + (x * bytes_per_pixel) + (y * bbline) + 2) = *(image + (xs * bytes_per_pixel) + (ys * bline) + 2);
1857             }
1858             break;
1859             case 2 :
1860             {
1861             *((unsigned short*)(new_img + (x * bytes_per_pixel) + (y * bbline))) = *((unsigned short*)(image + (xs * bytes_per_pixel) + (ys * bline)));
1862             }
1863             break;
1864             }
1865             }
1866             }
1867             }
1868             }
1869              
1870             // Horizontally mirror blit graphics data
1871             void c_flip_horizontal(char* pixels, short width, short height, unsigned char bytes_per_pixel) {
1872             short y;
1873             short x;
1874             unsigned short offset;
1875             unsigned char left;
1876             unsigned int bpl = width * bytes_per_pixel;
1877             unsigned short hwidth = width / 2;
1878             for ( y = 0; y < height; y++ ) {
1879             unsigned int ydx = y * bpl;
1880             for (x = 0; x < hwidth ; x++) { // Stop when you reach the middle
1881             for (offset = 0; offset < bytes_per_pixel; offset++) {
1882             left = *(pixels + (x * bytes_per_pixel) + ydx + offset);
1883             *(pixels + (x * bytes_per_pixel) + ydx + offset) = *(pixels + ((width - x) * bytes_per_pixel) + ydx + offset);
1884             *(pixels + ((width - x) * bytes_per_pixel) + ydx + offset) = left;
1885             }
1886             }
1887             }
1888             }
1889              
1890             // Vertically flip blit graphics data
1891             void c_flip_vertical(char *pixels, short width, short height, unsigned char bytes_per_pixel) {
1892             unsigned int bufsize = width * bytes_per_pixel; // Bytes per line
1893             unsigned char *row = malloc(bufsize); // Allocate a temporary buffer
1894             unsigned char *low = pixels; // Pointer to the beginning of the image
1895             unsigned char *high = &pixels[(height - 1) * bufsize]; // Pointer to the last line in the image
1896              
1897             for (; low < high; low += bufsize, high -= bufsize) { // Stop when you reach the middle
1898             memcpy(row,low,bufsize); // Make a copy of the lower line
1899             memcpy(low,high,bufsize); // Copy the upper line to the lower
1900             memcpy(high, row, bufsize); // Copy the saved copy to the upper line
1901             }
1902             free(row); // Release the temporary buffer
1903             }
1904              
1905             // Horizontally and vertically flip blit graphics data
1906             void c_flip_both(char* pixels, short width, short height, unsigned char bytes_per_pixel) {
1907             c_flip_vertical(
1908             pixels,
1909             width,height,
1910             bytes_per_pixel
1911             );
1912             c_flip_horizontal(
1913             pixels,
1914             width,height,
1915             bytes_per_pixel
1916             );
1917             }
1918              
1919             /* bitmap conversions */
1920              
1921             // Convert an RGB565 bitmap to an RGB888 bitmap
1922             void c_convert_16_24( char* buf16, unsigned int size16, char* buf24, unsigned char color_order ) {
1923             unsigned int loc16 = 0;
1924             unsigned int loc24 = 0;
1925             unsigned char r5;
1926             unsigned char g6;
1927             unsigned char b5;
1928              
1929             while(loc16 < size16) {
1930             unsigned short rgb565 = *((unsigned short*)(buf16 + loc16));
1931             loc16 += 2;
1932             if (color_order == RGB) {
1933             b5 = (rgb565 & 0xf800) >> 11;
1934             r5 = (rgb565 & 0x001f);
1935             } else {
1936             r5 = (rgb565 & 0xf800) >> 11;
1937             b5 = (rgb565 & 0x001f);
1938             }
1939             g6 = (rgb565 & 0x07e0) >> 5;
1940             unsigned char r8 = (r5 * 527 + 23) >> 6;
1941             unsigned char g8 = (g6 * 259 + 33) >> 6;
1942             unsigned char b8 = (b5 * 527 + 23) >> 6;
1943             *((unsigned char*)(buf24 + loc24++)) = r8;
1944             *((unsigned char*)(buf24 + loc24++)) = g8;
1945             *((unsigned char*)(buf24 + loc24++)) = b8;
1946             }
1947             }
1948              
1949             // Convert an RGB565 bitmap to a RGB8888 bitmap
1950             void c_convert_16_32( char* buf16, unsigned int size16, char* buf32, unsigned char color_order ) {
1951             unsigned int loc16 = 0;
1952             unsigned int loc32 = 0;
1953             unsigned char r5;
1954             unsigned char g6;
1955             unsigned char b5;
1956              
1957             while(loc16 < size16) {
1958             unsigned short rgb565 = *((unsigned short*)(buf16 + loc16));
1959             loc16 += 2;
1960             if (color_order == 0) {
1961             b5 = (rgb565 & 0xf800) >> 11;
1962             r5 = (rgb565 & 0x001f);
1963             } else {
1964             r5 = (rgb565 & 0xf800) >> 11;
1965             b5 = (rgb565 & 0x001f);
1966             }
1967             g6 = (rgb565 & 0x07e0) >> 5;
1968             unsigned char r8 = (r5 * 527 + 23) >> 6;
1969             unsigned char g8 = (g6 * 259 + 33) >> 6;
1970             unsigned char b8 = (b5 * 527 + 23) >> 6;
1971             *((unsigned int*)(buf32 + loc32)) = r8 | (g8 << 8) | (b8 << 16);
1972             loc32 += 3;
1973             if (r8 == 0 && g8 == 0 && b8 ==0) { // Black is always treated as a clear mask
1974             *((unsigned char*)(buf32 + loc32++)) = 0;
1975             } else { // Anything but black is opague
1976             *((unsigned char*)(buf32 + loc32++)) = 255;
1977             }
1978             }
1979             }
1980              
1981             // Convert a RGB888 bitmap to a RGB565 bitmap
1982             void c_convert_24_16(char* buf24, unsigned int size24, char* buf16, unsigned char color_order) {
1983             unsigned int loc16 = 0;
1984             unsigned int loc24 = 0;
1985             unsigned short rgb565 = 0;
1986             while(loc24 < size24) {
1987             unsigned char r8 = *(buf24 + loc24++);
1988             unsigned char g8 = *(buf24 + loc24++);
1989             unsigned char b8 = *(buf24 + loc24++);
1990             unsigned char r5 = ( r8 * 249 + 1014 ) >> 11;
1991             unsigned char g6 = ( g8 * 253 + 505 ) >> 10;
1992             unsigned char b5 = ( b8 * 249 + 1014 ) >> 11;
1993             if (color_order == RGB) {
1994             rgb565 = (b5 << 11) | (g6 << 5) | r5;
1995             } else {
1996             rgb565 = (r5 << 11) | (g6 << 5) | b5;
1997             }
1998             *((unsigned short*)(buf16 + loc16)) = rgb565;
1999             loc16 += 2;
2000             }
2001             }
2002              
2003             // Convert a RGB8888 bitmap to a RGB565 bitmap
2004             void c_convert_32_16(char* buf32, unsigned int size32, char* buf16, unsigned char color_order) {
2005             unsigned int loc16 = 0;
2006             unsigned int loc32 = 0;
2007             unsigned short rgb565 = 0;
2008             while(loc32 < size32) {
2009             unsigned int crgb = *((unsigned int*)(buf32 + loc32));
2010             unsigned char r8 = crgb & 255;
2011             unsigned char g8 = (crgb >> 8) & 255;
2012             unsigned char b8 = (crgb >> 16) & 255;
2013             unsigned char r5 = ( r8 * 249 + 1014 ) >> 11;
2014             unsigned char g6 = ( g8 * 253 + 505 ) >> 10;
2015             unsigned char b5 = ( b8 * 249 + 1014 ) >> 11;
2016             if (color_order == RGB) {
2017             rgb565 = (b5 << 11) | (g6 << 5) | r5;
2018             } else {
2019             rgb565 = (r5 << 11) | (g6 << 5) | b5;
2020             }
2021             *((unsigned short*)(buf16 + loc16)) = rgb565;
2022             loc16 += 2;
2023             }
2024             }
2025              
2026             // Convert a RGB8888 bitmap to a RGB888 bitmap
2027             void c_convert_32_24(char* buf32, unsigned int size32, char* buf24, unsigned char color_order) {
2028             unsigned int loc24 = 0;
2029             unsigned int loc32 = 0;
2030             while(loc32 < size32) {
2031             *(buf24 + loc24++) = *(buf32 + loc32++);
2032             *(buf24 + loc24++) = *(buf32 + loc32++);
2033             *(buf24 + loc24++) = *(buf32 + loc32++);
2034             loc32++; // Toss the alpha
2035             }
2036             }
2037              
2038             // Convert a RGB888 bitmap to a RGB8888 bitmap
2039             void c_convert_24_32(char* buf24, unsigned int size24, char* buf32, unsigned char color_order) {
2040             unsigned int loc32 = 0;
2041             unsigned int loc24 = 0;
2042             while(loc24 < size24) {
2043             unsigned char r = *(buf24 + loc24++);
2044             unsigned char g = *(buf24 + loc24++);
2045             unsigned char b = *(buf24 + loc24++);
2046             *((unsigned int*)(buf32 + loc32++)) = r | (g << 8) | (b << 16);
2047             loc32 += 3;
2048             if (r == 0 && g == 0 && b == 0) {
2049             *(buf32 + loc32++) = 0;
2050             } else {
2051             *(buf32 + loc32++) = 255;
2052             }
2053             }
2054             }
2055              
2056             // Convert any type RGB bitmap to a monochrome bitmap of the same type
2057             void c_monochrome(char *pixels, unsigned int size, unsigned char color_order, unsigned char bytes_per_pixel) {
2058             unsigned int idx;
2059             unsigned char r;
2060             unsigned char g;
2061             unsigned char b;
2062             unsigned char m;
2063             unsigned short rgb565;
2064              
2065             for (idx = 0; idx < size; idx += bytes_per_pixel) {
2066             if (bytes_per_pixel >= 3) {
2067             switch(color_order) {
2068             case RBG : // RBG
2069             r = *(pixels + idx);
2070             b = *(pixels + idx + 1);
2071             g = *(pixels + idx + 2);
2072             break;
2073             case BGR : // BGR
2074             b = *(pixels + idx);
2075             g = *(pixels + idx + 1);
2076             r = *(pixels + idx + 2);
2077             break;
2078             case BRG : // BRG
2079             b = *(pixels + idx);
2080             r = *(pixels + idx + 1);
2081             g = *(pixels + idx + 2);
2082             break;
2083             case GBR : // GBR
2084             g = *(pixels + idx);
2085             b = *(pixels + idx + 1);
2086             r = *(pixels + idx + 2);
2087             break;
2088             case GRB : // GRB
2089             g = *(pixels + idx);
2090             r = *(pixels + idx + 1);
2091             b = *(pixels + idx + 2);
2092             break;
2093             default : // RGB
2094             r = *(pixels + idx);
2095             g = *(pixels + idx + 1);
2096             b = *(pixels + idx + 2);
2097             }
2098             } else {
2099             rgb565 = *((unsigned short*)(pixels + idx));
2100             g = (rgb565 >> 6) & 31;
2101             if (color_order == 0) { // RGB
2102             r = rgb565 & 31;
2103             b = (rgb565 >> 11) & 31;
2104             } else { // BGR
2105             b = rgb565 & 31;
2106             r = (rgb565 >> 11) & 31;
2107             }
2108             }
2109             m = (unsigned char) round(0.2126 * r + 0.7152 * g + 0.0722 * b);
2110              
2111             switch(bytes_per_pixel) {
2112             case 4 :
2113             if (m == 0) {
2114             *((unsigned int*)(pixels + idx)) = m | (m << 8) | (m << 16);
2115             } else {
2116             *((unsigned int*)(pixels + idx)) = m | (m << 8) | (m << 16) | 0xFF000000;
2117             }
2118             break;
2119             case 3 :
2120             *(pixels + idx) = m;
2121             *(pixels + idx + 1) = m;
2122             *(pixels + idx + 2) = m;
2123             break;
2124             case 2 :
2125             rgb565 = 0;
2126             rgb565 = (m << 11) | (m << 6) | m;
2127             *((unsigned short*)(pixels + idx)) = rgb565;
2128             break;
2129             }
2130             }
2131             }
2132              
2133             C_CODE
2134              
2135             our @HATCHES = Imager::Fill->hatches;
2136             our @COLORORDER = (qw( RGB RBG BGR BRG GBR GRB ));
2137              
2138             =head1 METHODS
2139              
2140             With the exception of "new" and some other methods that only expect one parameter, the methods expect a single hash reference to be passed. This may seem unusual, but it was chosen for speed, and speed is important in a Perl graphics module.
2141              
2142             =cut
2143              
2144             sub new {
2145             =head2 B
2146              
2147             This instantiates the framebuffer object
2148              
2149             =over 4
2150              
2151             my $fb = Graphics::Framebuffer->new(parameter => value);
2152              
2153             =back
2154              
2155             =head3 PARAMETERS
2156              
2157             =over 6
2158              
2159             =item B
2160              
2161             Framebuffer device name. If this is not defined, then it tries the following devices in the following order:
2162              
2163             * /dev/fb0 - 31
2164             * /dev/graphics/fb0 - 31
2165              
2166             If none of these work, then the module goes into emulation mode.
2167              
2168             You really only need to define this if there is more than one framebuffer device in your system, and you want a specific one (else it always chooses the first it finds). If you have only one framebuffer device, then you likely do not need to define this.
2169              
2170             Use "EMULATED" instead of an actual framebuffer device, and it will open a memory only or "emulated" framebuffer. You can use this mode to have multiple "layers" for loading and manipulating images, but a single main framebuffer for displaying them.
2171              
2172             =item B
2173              
2174             Sets the default (global) foreground color for when 'attribute_reset' is called. It is in the same format as "set_color" expects:
2175              
2176             { # This is the default value
2177             'red' => 255,
2178             'green' => 255,
2179             'blue' => 255,
2180             'alpha' => 255
2181             }
2182              
2183             * 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.
2184              
2185             =item B
2186              
2187             Sets the default (global) background color for when 'attribute_reset' is called. It is in the same format as "set_b_color" expects:
2188              
2189             { # This is the default value
2190             'red' => 0,
2191             'green' => 0,
2192             'blue' => 0,
2193             'alpha' => 0
2194             }
2195              
2196             * Do not use this to change background colors, as "set_b_color" is intended for that. Use this to set the DEFAULT background color for when "attribute_reset" is called.
2197              
2198             =item B
2199              
2200             The splash screen is or is not displayed
2201              
2202             A value other than zero turns on the splash screen, and the value is the wait time to show it (default 2 seconds)
2203             A zero value turns it off
2204              
2205             =item B
2206              
2207             Bypasses the X-Windows check and loads anyway (dangerous).
2208             Set to 1 to disable X-Windows check. Default is 0.
2209              
2210             =item B
2211              
2212             Overrides the default font path for TrueType/Type1 fonts
2213              
2214             If 'ttf_print' is not displaying any text, then this may need to be overridden.
2215              
2216             =item B
2217              
2218             Overrides the default font filename for TrueType/Type 1 fonts.
2219              
2220             If 'ttf_print' is not displaying any text, then this may need to be overridden.
2221              
2222             =item B
2223              
2224             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.
2225              
2226             This is helpful for troubleshooting.
2227              
2228             =item B
2229              
2230             If true, it shows images as they load, and displays benchmark informtion in the loading process.
2231              
2232             =item B [0 or 1 (default)]
2233              
2234             When the object is created, it automatically creates a simple signal handler for B and B to run B as a clean way of exiting your script and restoring the screen to defaults.
2235              
2236             Also, when the object is destroyed, it is assumed you are exiting your script. This causes Graphics::Framebuffer to execute "exec('reset')" as its method of exiting instead of having you use "exit".
2237              
2238             You can disable this behavior by setting this to 0.
2239              
2240             =back
2241              
2242             =head3 EMULATION MODE OPTIONS
2243              
2244             =over 6
2245              
2246             The options here only apply to emulation mode.
2247              
2248             Emulation mode can be used as a secondary off-screen drawing surface, if you are clever.
2249              
2250             =back
2251              
2252             =over 12
2253              
2254             =item B => 'EMULATED'
2255              
2256             Sets this object to be in emulation mode.
2257              
2258             Emulation mode special variables for "new" method:
2259              
2260             =item B
2261              
2262             Width of the emulation framebuffer in pixels. Default is 640.
2263              
2264             =item B
2265              
2266             Height of the emulation framebuffer in pixels. Default is 480.
2267              
2268             =item B
2269              
2270             Number of bits per pixel in the emulation framebuffer. Default is 32.
2271              
2272             =item B
2273              
2274             Number of bytes per pixel in the emulation framebuffer. It's best to keep it BITS/8. Default is 4.
2275              
2276             =item B
2277              
2278             Defines the colorspace for the graphics routines to draw in. The possible (and only accepted) string values are:
2279              
2280             'RGB' for Red-Green-Blue (the default)
2281             'RBG' for Red-Blue-Green
2282             'GRB' for Green-Red-Blue
2283             'GBR' for Green-Blue-Red
2284             'BRG' for Blue-Red-Green
2285             'BGR' for Blue-Green-Red (Many video cards are this)
2286              
2287             Why do many video cards use the BGR color order? Simple, their GPUs operate with the high to low byte order for long words. To the video card, it is RGB, but to a CPU that stores bytes in low to high byte order.
2288              
2289             =back
2290              
2291             ##############################################################################
2292              
2293             =cut
2294              
2295 2     2 0 6001820 my $class = shift;
2296              
2297             # I would have liked to make this a lot more organized, but over the years it
2298             # kind of became this mess. I could change it, but it likely would break any
2299             # code that directly uses values.
2300 2         10 my $this;
2301 2         195 $ENV{'PATH'} = '/usr/bin:/bin:/usr/local/bin'; # Testing doesn't work in taint mode unless this is here.
2302             my $self = {
2303             'SCREEN' => '', # The all mighty framebuffer that is mapped to the real framebuffer later
2304              
2305             'RESET' => TRUE, # Default to use 'reset' on destroy
2306             'VERSION' => $VERSION, # Helps with debugging for people sending me dumps
2307             'HATCHES' => [@HATCHES], # Pull in hatches from Imager
2308              
2309             # Set up the user defined graphics primitives and attributes default values
2310             'Imager-Has-TrueType' => $Imager::formats{'tt'} || 0,
2311             'Imager-Has-Type1' => $Imager::formats{'t1'} || 0,
2312             'Imager-Has-Freetype2' => $Imager::formats{'ft2'} || 0,
2313 2   50     144 'Imager-Image-Types' => [ map( {uc($_) } Imager->read_types()) ],
  14   50     3695  
      50        
2314              
2315             'X' => 0, # Last position plotted X
2316             'Y' => 0, # Last position plotted Y
2317             'X_CLIP' => 0, # Top left clip start X
2318             'Y_CLIP' => 0, # Top left clip start Y
2319             'YY_CLIP' => undef, # Bottom right clip end X
2320             'XX_CLIP' => undef, # Bottom right clip end Y
2321             'CLIPPED' => FALSE, # Indicates if clipping is less than the full screen
2322             'IMAGER_FOREGROUND_COLOR' => undef, # Imager foreground color
2323             'IMAGER_BACKGROUND_COLOR' => undef, # Imager background color
2324             'RAW_FOREGROUND_COLOR' => undef, # Global foreground color (Raw string)
2325             'RAW_BACKGROUND_COLOR' => undef, # Global Background Color
2326             'DRAW_MODE' => NORMAL_MODE, # Drawing mode (Normal default)
2327             'DIAGNOSTICS' => FALSE, # Determines if diagnostics are shown when images are loaded.
2328             'IGNORE_X_WINDOWS' => FALSE, # Forces load inside X-Windows (dangerous)
2329              
2330             'SHOW_ERRORS' => FALSE, # If on, it will output any errors in Imager or elsewhere, else all errors are squelched
2331              
2332             'FOREGROUND' => { # Default foreground for "attribute_reset" method
2333             'red' => 255,
2334             'green' => 255,
2335             'blue' => 255,
2336             'alpha' => 255
2337             },
2338             'BACKGROUND' => { # Default background for "attribute_reset" method
2339             'red' => 0,
2340             'green' => 0,
2341             'blue' => 0,
2342             'alpha' => 0
2343             },
2344              
2345             'FONT_PATH' => '/usr/share/fonts/truetype/freefont', # Default fonts path
2346             'FONT_FACE' => 'FreeSans.ttf', # Default font face
2347              
2348             'SPLASH' => 2, # Time in seconds to show the splash screen
2349              
2350             'WAIT_FOR_CONSOLE' => FALSE,
2351             'THIS_CONSOLE' => 1,
2352             'CONSOLE' => 1,
2353              
2354             'NORMAL_MODE' => NORMAL_MODE, # Constants for DRAW_MODE
2355             'XOR_MODE' => XOR_MODE,
2356             'OR_MODE' => OR_MODE,
2357             'AND_MODE' => AND_MODE,
2358             'MASK_MODE' => MASK_MODE,
2359             'UNMASK_MODE' => UNMASK_MODE,
2360             'ALPHA_MODE' => ALPHA_MODE,
2361             'ADD_MODE' => ADD_MODE,
2362             'SUBTRACT_MODE' => SUBTRACT_MODE,
2363             'MULTIPLY_MODE' => MULTIPLY_MODE,
2364             'DIVIDE_MODE' => DIVIDE_MODE,
2365              
2366             'ARC' => ARC, # Constants for "draw_arc" method
2367             'PIE' => PIE,
2368             'POLY_ARC' => POLY_ARC,
2369              
2370             'RGB' => RGB, # Constants for color mapping
2371             'RBG' => RBG, # Constants for color mapping
2372             'BGR' => BGR, # Constants for color mapping
2373             'BRG' => BRG, # Constants for color mapping
2374             'GBR' => GBR, # Constants for color mapping
2375             'GRB' => GRB, # Constants for color mapping
2376              
2377             'CENTER_NONE' => CENTER_NONE, # Constants for centering
2378             'CENTER_X' => CENTER_X, # Constants for centering
2379             'CENTER_Y' => CENTER_Y, # Constants for centering
2380             'CENTER_XY' => CENTER_XY, # Constants for centering
2381             'CENTRE_NONE' => CENTRE_NONE, # Constants for centering
2382             'CENTRE_X' => CENTRE_X, # Constants for centering
2383             'CENTRE_Y' => CENTRE_Y, # Constants for centering
2384             'CENTRE_XY' => CENTRE_XY, # Constants for centering
2385             ####################################################################
2386              
2387             'KD_GRAPHICS' => 1,
2388             'KD_TEXT' => 0,
2389              
2390             # I=32.64,L=32,S=16,C=8,A=string
2391             # Structure Definitions
2392             'vt_stat' => 'SSS', # v_active, v_signal, v_state
2393             'FBioget_vscreeninfo' => 'L' . # 32 bits for xres
2394             'L' . # 32 bits for yres
2395             'L' . # 32 bits for xres_virtual
2396             'L' . # 32 bits for yres_vortual
2397             'L' . # 32 bits for xoffset
2398             'L' . # 32 bits for yoffset
2399             'L' . # 32 bits for bits per pixel
2400             'L' . # 32 bits for grayscale (0=color)
2401             'L' . # 32 bits for red bit offset
2402             'L' . # 32 bits for red bit length
2403             'L' . # 32 bits for red msb_right (!0 msb is right)
2404             'L' . # 32 bits for green bit offset
2405             'L' . # 32 bits for green bit length
2406             'L' . # 32 bits for green msb_right (!0 msb is right)
2407             'L' . # 32 bits for blue bit offset
2408             'L' . # 32 bits for blue bit length
2409             'L' . # 32 bits for blue msb_right (!0 msb is right)
2410             'L' . # 32 bits for alpha bit offset
2411             'L' . # 32 bits for alpha bit length
2412             'L' . # 32 bits for alpha msb_right (!0 msb is right)
2413             'L' . # 32 bits for nonstd (!0 non standard pixel format)
2414             'L' . # 32 bits for activate
2415             'L' . # 32 bits for height in mm
2416             'L' . # 32 bits for width in mm
2417             'L' . # 32 bits for accel_flags (obsolete)
2418             'L' . # 32 bits for pixclock
2419             'L' . # 32 bits for left margin
2420             'L' . # 32 bits for right margin
2421             'L' . # 32 bits for upper margin
2422             'L' . # 32 bits for lower margin
2423             'L' . # 32 bits for hsync length
2424             'L' . # 32 bits for vsync length
2425             'L' . # 32 bits for sync
2426             'L' . # 32 bits for vmode
2427             'L' . # 32 bits for rotate (angle we rotate counter clockwise)
2428             'L' . # 32 bits for colorspace
2429             'L4', # 32 bits x 4 reserved
2430              
2431             'FBioget_fscreeninfo' => 'A16' . # 16 bytes for ID name
2432             'I' . # 32/64 bits unsigned address
2433             'L' . # 32 bits for smem_len
2434             'L' . # 32 bits for type
2435             'L' . # 32 bits for type_aux (interleave)
2436             'L' . # 32 bits for visual
2437             'S' . # 16 bits for xpanstep
2438             'S' . # 16 bits for ypanstep
2439             'S1' . # 16 bits for ywrapstep (extra 16 bits added on if system is 8 byte aligned)
2440             'L' . # 32 bits for line length in bytes
2441             'I' . # 32/64 bits for mmio_start
2442             'L' . # 32 bits for mmio_len
2443             'L' . # 32 bits for accel
2444             'S' . # 16 bits for capabilities
2445             'S2', # 16 bits x 2 reserved
2446              
2447             # Default values
2448             'GARBAGE' => FALSE, # Load extra unneeded FB info if true
2449             'VXRES' => 640, # Virtual X resolution
2450             'VYRES' => 480, # Virtual Y resolution
2451             'BITS' => 32, # Bits per pixel
2452             'BYTES' => 4, # Bytes per pixel
2453             'XOFFSET' => 0, # Visible screen X offset
2454             'YOFFSET' => 0, # Visible screen Y offset
2455             'FB_DEVICE' => undef, # Framebuffer device name (defined later)
2456             'COLOR_ORDER' => 'RGB', # Default color Order. Redefined later to be an integer
2457             'ACCELERATED' => SOFTWARE, # Use accelerated graphics
2458             # 0 = Pure Perl
2459             # 1 = C Accelerated (but still software)
2460             # 2 = C & Hardware accelerated.
2461             'FBIO_WAITFORVSYNC' => 0x4620,
2462             'VT_GETSTATE' => 0x5603,
2463             'KDSETMODE' => 0x4B3A,
2464             'FBIOGET_VSCREENINFO' => 0x4600, # These come from "fb.h" in the kernel source
2465             'FBIOGET_FSCREENINFO' => 0x4602,
2466             @_ # Pull in the overrides
2467             };
2468 2 50       23 if ($self->{'GARBAGE'}) {
2469 0         0 my $garbage = {
2470              
2471             'PIXEL_TYPES' => [
2472             'Packed Pixels',
2473             'Planes',
2474             'Interleaved Planes',
2475             'Text',
2476             'VGA Planes',
2477             ],
2478             'PIXEL_TYPES_AUX' => {
2479             'Packed Pixels' => [
2480             '',
2481             ],
2482             'Planes' => [
2483             '',
2484             ],
2485             'Interleaved Planes' => [
2486             '',
2487             ],
2488             'Text' => [
2489             'MDA',
2490             'CGA',
2491             'S3 MMIO',
2492             'MGA Step 16',
2493             'MGA Step 8',
2494             'SVGA Group',
2495             'SVGA Mask',
2496             'SVGA Step 2',
2497             'SVGA Step 4',
2498             'SVGA Step 8',
2499             'SVGA Step 16',
2500             'SVGA Last',
2501             ],
2502             'VGA Planes' => [
2503             'VGA 4',
2504             'CFB 4',
2505             'CFB 8',
2506             ],
2507             },
2508             'VISUAL_TYPES' => [
2509             'Mono 01',
2510             'Mono 10',
2511             'True Color',
2512             'Pseudo Color',
2513             'Direct Color',
2514             'Static Pseudo Color',
2515             ],
2516             'ACCEL_TYPES' => [
2517             'NONE',
2518             'Atari Blitter',
2519             'Amiga Blitter',
2520             'S3 Trio64',
2521             'NCR 77C32BLT',
2522             'S3 Virge',
2523             'ATI Mach 64 GX',
2524             'ATI DEC TGA',
2525             'ATI Mach 64 CT',
2526             'ATI Mach 64 VT',
2527             'ATI Mach 64 GT',
2528             'Sun Creator',
2529             'Sun CG Six',
2530             'Sun Leo',
2531             'IWS Twin Turbo',
2532             '3D Labs Permedia2',
2533             'Matrox MGA 2064W',
2534             'Matrox MGA 1064SG',
2535             'Matrox MGA 2164W',
2536             'Matrox MGA 2164W AGP',
2537             'Matrox MGA G100',
2538             'Matrox MGA G200',
2539             'Sun CG14',
2540             'Sun BW Two',
2541             'Sun CG Three',
2542             'Sun TCX',
2543             'Matrox MGA G400',
2544             'NV3',
2545             'NV4',
2546             'NV5',
2547             'CT 6555x',
2548             '3DFx Banshee',
2549             'ATI Rage 128',
2550             'IGS Cyber 2000',
2551             'IGS Cyber 2010',
2552             'IGS Cyber 5000',
2553             'SIS Glamour',
2554             '3D Labs Permedia',
2555             'ATI Radeon',
2556             'i810',
2557             'NV 10',
2558             'NV 20',
2559             'NV 30',
2560             'NV 40',
2561             'XGI Volari V',
2562             'XGI Volari Z',
2563             'OMAP i610',
2564             'Trident TGUI',
2565             'Trident 3D Image',
2566             'Trident Blade 3D',
2567             'Trident Blade XP',
2568             'Cirrus Alpine',
2569             'Neomagic NM2070',
2570             'Neomagic NM2090',
2571             'Neomagic NM2093',
2572             'Neomagic NM2097',
2573             'Neomagic NM2160',
2574             'Neomagic NM2200',
2575             'Neomagic NM2230',
2576             'Neomagic NM2360',
2577             'Neomagic NM2380',
2578             'PXA3XX', # 99
2579             '','','','','','','','','','','','','','','','','','','','','','','','','','','','',
2580             'Savage 4',
2581             'Savage 3D',
2582             'Savage 3D MV',
2583             'Savage 2000',
2584             'Savage MX MV',
2585             'Savage MX',
2586             'Savage IX MV',
2587             'Savage IX',
2588             'Pro Savage PM',
2589             'Pro Savage KM',
2590             'S3 Twister P',
2591             'S3 Twister K',
2592             'Super Savage',
2593             'Pro Savage DDR',
2594             'Pro Savage DDRX',
2595             ],
2596             # Unfortunately, these are not IOCTLs. Gee, that would be nice if they were.
2597             'FBinfo_hwaccel_fillrect' => 'L6', # dx(32),dy(32),width(32),height(32),color(32),rop(32)?
2598             'FBinfo_hwaccel_copyarea' => 'L6', # dx(32),dy(32),width(32),height(32),sx(32),sy(32)
2599             'FBinfo_hwaccel_fillrect' => 'L6', # dx(32),dy(32),width(32),height(32),color(32),rop(32)
2600             '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)
2601             # COLOR MAP:
2602             # start(32),length(32),red(16),green(16),blue(16),alpha(16)
2603             # FLAGS
2604             'FBINFO_HWACCEL_NONE' => 0x0000, # These come from "fb.h" in the kernel source
2605             'FBINFO_HWACCEL_COPYAREA' => 0x0100,
2606             'FBINFO_HWACCEL_FILLRECT' => 0x0200,
2607             'FBINFO_HWACCEL_IMAGEBLIT' => 0x0400,
2608             'FBINFO_HWACCEL_ROTATE' => 0x0800,
2609             'FBINFO_HWACCEL_XPAN' => 0x1000,
2610             'FBINFO_HWACCEL_YPAN' => 0x2000,
2611             'FBINFO_HWACCEL_YWRAP' => 0x4000,
2612              
2613             ## Set up the Framebuffer driver "constants" defaults
2614             # These "fb.h" constants may go away in future versions, as the data needed to get from these
2615             # Is available from Inline::C now.
2616             # Commands
2617             'FBIOPUT_VSCREENINFO' => 0x4601,
2618             'FBIOGETCMAP' => 0x4604,
2619             'FBIOPUTCMAP' => 0x4605,
2620             'FBIOPAN_DISPLAY' => 0x4606,
2621             'FBIO_CURSOR' => 0x4608,
2622             'FBIOGET_CON2FBMAP' => 0x460F,
2623             'FBIOPUT_CON2FBMAP' => 0x4610,
2624             'FBIOBLANK' => 0x4611,
2625             'FBIOGET_VBLANK' => 0x4612,
2626             'FBIOGET_GLYPH' => 0x4615,
2627             'FBIOGET_HWCINFO' => 0x4616,
2628             'FBIOPUT_MODEINFO' => 0x4617,
2629             'FBIOGET_DISPINFO' => 0x4618,
2630             };
2631 0         0 $self = { %{$self},%{$garbage} };
  0         0  
  0         0  
2632             }
2633 2 50       13 unless (defined($self->{'FB_DEVICE'})) { # We scan for all 32 possible devices at both possible locations
2634 2         22 foreach my $dev (0 .. 31) {
2635 64         128 foreach my $prefix (qw(/dev/fb /dev/fb/ /dev/graphics/fb)) {
2636 192 50       2483 if (-e "$prefix$dev") {
2637 0         0 $self->{'FB_DEVICE'} = "$prefix$dev";
2638 0         0 last;
2639             }
2640             }
2641 64 50       246 last if (defined($self->{'FB_DEVICE'}));
2642             }
2643             }
2644 2         12 $self->{'CONSOLE'} = 1;
2645 2         10 eval {
2646 2         27 $self->{'CONSOLE'} = _slurp('/sys/class/tty/tty0/active');
2647 2         28 $self->{'CONSOLE'} =~ s/\D+//gs;
2648 2         15 $self->{'CONSOLE'} += 0;
2649 2         13 $self->{'THIS_CONSOLE'} = $self->{'CONSOLE'};
2650             };
2651 2         12 my $has_X = FALSE;
2652 2 50 33     23 $has_X = TRUE if (defined($ENV{'DISPLAY'}) && $self->{'IGNORE_X_WINDOWS'} == FALSE);
2653 2 50 33     44 if ( (! $has_X) && defined($self->{'FB_DEVICE'}) && (-e $self->{'FB_DEVICE'}) && open($self->{'FB'}, '+<', $self->{'FB_DEVICE'})) { # Can we open the framebuffer device??
    50 33        
      33        
      33        
2654 0         0 binmode($self->{'FB'}); # We have to be in binary mode first
2655 0         0 $|++;
2656 0 0       0 if ($self->{'ACCELERATED'}) {
2657             (
2658             $self->{'fscreeninfo'}->{'id'},
2659             $self->{'fscreeninfo'}->{'smem_start'},
2660             $self->{'fscreeninfo'}->{'smem_len'},
2661             $self->{'fscreeninfo'}->{'type'},
2662             $self->{'fscreeninfo'}->{'type_aux'},
2663             $self->{'fscreeninfo'}->{'visual'},
2664             $self->{'fscreeninfo'}->{'xpanstep'},
2665             $self->{'fscreeninfo'}->{'ypanstep'},
2666             $self->{'fscreeninfo'}->{'ywrapstep'},
2667             $self->{'fscreeninfo'}->{'line_length'},
2668             $self->{'fscreeninfo'}->{'mmio_start'},
2669             $self->{'fscreeninfo'}->{'mmio_len'},
2670             $self->{'fscreeninfo'}->{'accel'},
2671              
2672             $self->{'vscreeninfo'}->{'xres'},
2673             $self->{'vscreeninfo'}->{'yres'},
2674             $self->{'vscreeninfo'}->{'xres_virtual'},
2675             $self->{'vscreeninfo'}->{'yres_virtual'},
2676             $self->{'vscreeninfo'}->{'xoffset'},
2677             $self->{'vscreeninfo'}->{'yoffset'},
2678             $self->{'vscreeninfo'}->{'bits_per_pixel'},
2679             $self->{'vscreeninfo'}->{'grayscale'},
2680             $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'},
2681             $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'},
2682             $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'msb_right'},
2683             $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'},
2684             $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'},
2685             $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'msb_right'},
2686             $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'},
2687             $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'},
2688             $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'msb_right'},
2689             $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'},
2690             $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'length'},
2691             $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'msb_right'},
2692             $self->{'vscreeninfo'}->{'nonstd'},
2693             $self->{'vscreeninfo'}->{'activate'},
2694             $self->{'vscreeninfo'}->{'height'},
2695             $self->{'vscreeninfo'}->{'width'},
2696             $self->{'vscreeninfo'}->{'accel_flags'},
2697             $self->{'vscreeninfo'}->{'pixclock'},
2698             $self->{'vscreeninfo'}->{'left_margin'},
2699             $self->{'vscreeninfo'}->{'right_margin'},
2700             $self->{'vscreeninfo'}->{'upper_margin'},
2701             $self->{'vscreeninfo'}->{'lower_margin'},
2702             $self->{'vscreeninfo'}->{'hsync_len'},
2703             $self->{'vscreeninfo'}->{'vsync_len'},
2704             $self->{'vscreeninfo'}->{'sync'},
2705             $self->{'vscreeninfo'}->{'vmode'},
2706             $self->{'vscreeninfo'}->{'rotate'},
2707 0         0 ) = (c_get_screen_info($self->{'FB_DEVICE'}));
2708             } else { # Fallback if not accelerated. Do it the old way
2709             # Make the IOCTL call to get info on the virtual (viewable) screen (Sometimes different than physical)
2710             (
2711             $self->{'vscreeninfo'}->{'xres'}, # (32)
2712             $self->{'vscreeninfo'}->{'yres'}, # (32)
2713             $self->{'vscreeninfo'}->{'xres_virtual'}, # (32)
2714             $self->{'vscreeninfo'}->{'yres_virtual'}, # (32)
2715             $self->{'vscreeninfo'}->{'xoffset'}, # (32)
2716             $self->{'vscreeninfo'}->{'yoffset'}, # (32)
2717             $self->{'vscreeninfo'}->{'bits_per_pixel'}, # (32)
2718             $self->{'vscreeninfo'}->{'grayscale'}, # (32)
2719             $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}, # (32)
2720             $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'}, # (32)
2721             $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'msb_right'}, # (32)
2722             $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}, # (32)
2723             $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'}, # (32)
2724             $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'msb_right'}, # (32)
2725             $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}, # (32)
2726             $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'}, # (32)
2727             $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'msb_right'}, # (32)
2728             $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'}, # (32)
2729             $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'length'}, # (32)
2730             $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'msb_right'}, # (32)
2731             $self->{'vscreeninfo'}->{'nonstd'}, # (32)
2732             $self->{'vscreeninfo'}->{'activate'}, # (32)
2733             $self->{'vscreeninfo'}->{'height'}, # (32)
2734             $self->{'vscreeninfo'}->{'width'}, # (32)
2735             $self->{'vscreeninfo'}->{'accel_flags'}, # (32)
2736             $self->{'vscreeninfo'}->{'pixclock'}, # (32)
2737             $self->{'vscreeninfo'}->{'left_margin'}, # (32)
2738             $self->{'vscreeninfo'}->{'right_margin'}, # (32)
2739             $self->{'vscreeninfo'}->{'upper_margin'}, # (32)
2740             $self->{'vscreeninfo'}->{'lower_margin'}, # (32)
2741             $self->{'vscreeninfo'}->{'hsync_len'}, # (32)
2742             $self->{'vscreeninfo'}->{'vsync_len'}, # (32)
2743             $self->{'vscreeninfo'}->{'sync'}, # (32)
2744             $self->{'vscreeninfo'}->{'vmode'}, # (32)
2745             $self->{'vscreeninfo'}->{'rotate'}, # (32)
2746             $self->{'vscreeninfo'}->{'colorspace'}, # (32)
2747 0         0 @{ $self->{'vscreeninfo'}->{'reserved_fb_vir'} } # (32) x 4
2748 0         0 ) = _get_ioctl(FBIOGET_VSCREENINFO, $self->{'FBioget_vscreeninfo'}, $self->{'FB'});
2749             # Make the IOCTL call to get info on the physical screen
2750 0         0 my $extra = 1;
2751             do { # A hacked way to do this, but it seems to work
2752 0         0 my $typedef = '' . $self->{'FBioget_fscreeninfo'};
2753 0 0       0 if ($extra > 1) { # It turns out it was byte alignment issues, not driver weirdness
2754 0 0       0 if ($extra == 2) {
    0          
    0          
2755 0         0 $typedef =~ s/S1/S$extra/;
2756             } elsif ($extra == 3) {
2757 0         0 $typedef =~ s/S1/L/;
2758             } elsif ($extra == 4) {
2759 0         0 $typedef =~ s/S1/I/;
2760             }
2761             (
2762             $self->{'fscreeninfo'}->{'id'}, # (8) x 16
2763             $self->{'fscreeninfo'}->{'smem_start'}, # LONG
2764             $self->{'fscreeninfo'}->{'smem_len'}, # (32)
2765             $self->{'fscreeninfo'}->{'type'}, # (32)
2766             $self->{'fscreeninfo'}->{'type_aux'}, # (32)
2767             $self->{'fscreeninfo'}->{'visual'}, # (32)
2768             $self->{'fscreeninfo'}->{'xpanstep'}, # (16)
2769             $self->{'fscreeninfo'}->{'ypanstep'}, # (16)
2770             $self->{'fscreeninfo'}->{'ywrapstep'}, # (16)
2771             $self->{'fscreeninfo'}->{'filler'}, # (16) - Just a filler
2772             $self->{'fscreeninfo'}->{'line_length'}, # (32)
2773             $self->{'fscreeninfo'}->{'mmio_start'}, # LONG
2774             $self->{'fscreeninfo'}->{'mmio_len'}, # (32)
2775             $self->{'fscreeninfo'}->{'accel'}, # (32)
2776             $self->{'fscreeninfo'}->{'capailities'}, # (16)
2777 0         0 @{ $self->{'fscreeninfo'}->{'reserved_fb_phys'} } # (16) x 2
2778 0         0 ) = _get_ioctl(FBIOGET_FSCREENINFO, $typedef, $self->{'FB'});
2779             } else {
2780             (
2781             $self->{'fscreeninfo'}->{'id'}, # (8) x 16
2782             $self->{'fscreeninfo'}->{'smem_start'}, # LONG
2783             $self->{'fscreeninfo'}->{'smem_len'}, # (32)
2784             $self->{'fscreeninfo'}->{'type'}, # (32)
2785             $self->{'fscreeninfo'}->{'type_aux'}, # (32)
2786             $self->{'fscreeninfo'}->{'visual'}, # (32)
2787             $self->{'fscreeninfo'}->{'xpanstep'}, # (16)
2788             $self->{'fscreeninfo'}->{'ypanstep'}, # (16)
2789             $self->{'fscreeninfo'}->{'ywrapstep'}, # (16)
2790             $self->{'fscreeninfo'}->{'line_length'}, # (32)
2791             $self->{'fscreeninfo'}->{'mmio_start'}, # LONG
2792             $self->{'fscreeninfo'}->{'mmio_len'}, # (32)
2793             $self->{'fscreeninfo'}->{'accel'}, # (32)
2794             $self->{'fscreeninfo'}->{'capailities'}, # (16)
2795 0         0 @{ $self->{'fscreeninfo'}->{'reserved_fb_phys'} } # (16) x 2
2796 0         0 ) = _get_ioctl(FBIOGET_FSCREENINFO, $typedef, $self->{'FB'});
2797             }
2798              
2799 0         0 $extra++;
2800 0   0     0 } until (($self->{'fscreeninfo'}->{'line_length'} < $self->{'fscreeninfo'}->{'smem_len'} && $self->{'fscreeninfo'}->{'line_length'} > 0) || $extra > 4);
      0        
2801             }
2802 0         0 $self->{'fscreeninfo'}->{'id'} =~ s/[\x00-\x1F,\x7F-\xFF]//gs;
2803 0 0       0 if ($self->{'fscreeninfo'}->{'id'} eq '') {
2804 0         0 chomp(my $model = `cat /proc/device-tree/model`);
2805 0         0 $model =~ s/[\x00-\x1F,\x7F-\xFF]//gs;
2806 0 0       0 if ($model ne '') {
2807 0         0 $self->{'fscreeninfo'}->{'id'} = $model;
2808             } else {
2809 0         0 $self->{'fscreeninfo'}->{'id'} = $self->{'FB_DEVICE'};
2810             }
2811             }
2812              
2813 0         0 $self->{'GPU'} = $self->{'fscreeninfo'}->{'id'}; # The name of the GPU or video driver
2814 0         0 $self->{'VXRES'} = $self->{'vscreeninfo'}->{'xres_virtual'}; # The virtual width of the screen
2815 0         0 $self->{'VYRES'} = $self->{'vscreeninfo'}->{'yres_virtual'}; # The virtual height of the screen
2816 0         0 $self->{'XRES'} = $self->{'vscreeninfo'}->{'xres'}; # The physical width of the screen
2817 0         0 $self->{'YRES'} = $self->{'vscreeninfo'}->{'yres'}; # The physical height of the screen
2818 0   0     0 $self->{'XOFFSET'} = $self->{'vscreeninfo'}->{'xoffset'} || 0; # The horizontal offset of the screen from the beginning of the virtual screen
2819 0   0     0 $self->{'YOFFSET'} = $self->{'vscreeninfo'}->{'yoffset'} || 0; # The vertical offset of the screen from the beginning of the virtual screen
2820 0         0 $self->{'BITS'} = $self->{'vscreeninfo'}->{'bits_per_pixel'}; # The bits per pixel of the screen
2821 0         0 $self->{'BYTES'} = $self->{'BITS'} / 8; # The number of bytes per pixel
2822 0         0 $self->{'BYTES_PER_LINE'} = $self->{'fscreeninfo'}->{'line_length'}; # The length of a single scan line in bytes
2823 0         0 $self->{'PIXELS'} = (($self->{'XOFFSET'} + $self->{'VXRES'}) * ($self->{'YOFFSET'} + $self->{'VYRES'}));
2824 0         0 $self->{'SIZE'} = $self->{'PIXELS'} * $self->{'BYTES'};
2825 0 0 0     0 $self->{'fscreeninfo'}->{'smem_len'} = $self->{'BYTES_PER_LINE'} * $self->{'VYRES'} if (!defined($self->{'fscreeninfo'}->{'smem_len'}) || $self->{'fscreeninfo'}->{'smem_len'} <= 0);
2826              
2827 0         0 $self->{'fscreeninfo'}->{'type'} = $self->{'PIXEL_TYPES'}->[$self->{'fscreeninfo'}->{'type'}];
2828 0         0 $self->{'fscreeninfo'}->{'type_aux'} = $self->{'PIXEL_TYPES_AUX'}->{$self->{'fscreeninfo'}->{'type'}}->[$self->{'fscreeninfo'}->{'type_aux'}];
2829 0         0 $self->{'fscreeninfo'}->{'visual'} = $self->{'VISUAL_TYPES'}->[$self->{'fscreeninfo'}->{'visual'}];
2830 0         0 $self->{'fscreeninfo'}->{'accel'} = $self->{'ACCEL_TYPES'}->[$self->{'fscreeninfo'}->{'accel'}];
2831              
2832 0 0 0     0 if ($self->{'BITS'} == 32 && $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'length'} == 0) {
2833             # The video driver doesn't use the alpha channel, but we do, so force it.
2834 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'length'} = 8;
2835 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'} = 24;
2836             }
2837             ## For debugging only
2838             # print Dumper($self,\%Config),"\n"; exit;
2839              
2840             # Only useful for debugging and for troubleshooting the module for specific display resolutions
2841 0 0       0 if (defined($self->{'SIMULATED_X'})) {
2842 0         0 my $w = $self->{'XRES'};
2843 0         0 $self->{'XRES'} = $self->{'SIMULATED_X'};
2844 0         0 $self->{'XOFFSET'} += ($w - $self->{'SIMULATED_X'}) / 2;
2845             }
2846 0 0       0 if (defined($self->{'SIMULATED_Y'})) {
2847 0         0 my $h = $self->{'YRES'};
2848 0         0 $self->{'YRES'} = $self->{'SIMULATED_Y'};
2849 0         0 $self->{'YOFFSET'} += ($h - $self->{'SIMULATED_Y'}) / 2;
2850             }
2851 0         0 bless($self, $class);
2852 0         0 $self->_color_order(); # Automatically determine color mode
2853 0         0 $self->attribute_reset();
2854              
2855             # Now that everything is set up, let's map the framebuffer to SCREEN
2856              
2857 0         0 eval { # We use the more stable File::Map now
2858             $self->{'SCREEN_ADDRESS'} = map_handle(
2859             $self->{'SCREEN'},
2860             $self->{'FB'},
2861             '+<',
2862             0,
2863 0         0 $self->{'fscreeninfo'}->{'smem_len'},
2864             );
2865             };
2866 0 0       0 if ($@) {
2867 0         0 print STDERR qq{
2868             OUCH! Graphics::Framebuffer cannot memory map the framebuffer!
2869              
2870             This is usually caused by one or more of the following:
2871              
2872             * Your account does not have proper permission to access the framebuffer
2873             device.
2874              
2875             This usually requires adding the "video" group to your account. This is
2876             usually accomplished via the following command (replace "username" with
2877             your actual username):
2878              
2879             \tsudo usermod -a -G video username
2880              
2881             * You could be attempting to run this inside X-Windows, which doesn't work.
2882             You MUST run your script outside of X-Windows from the system Console.
2883             If you are inside X-Windows, and you do not know how to get to your
2884             console, just hit CTRL-ALT-F2 to access one of the consoles. This has
2885             no windows or mouse functionality. It is command line only (similar to
2886             old DOS).
2887              
2888             To get back into X-Windows, you just hit ALT-F7 (or ALT-F8 on some
2889             systems).
2890              
2891             Actual error reported:\n\n$@\n};
2892 0 0       0 sleep ($self->{'RESET'}) ? 10 : 1;
2893 0         0 exit(1);
2894             }
2895             } elsif (exists($ENV{'DISPLAY'}) && (-e $self->{'FB_DEVICE'})) {
2896 0         0 print STDERR qq{
2897             OUCH! Graphics::Framebuffer cannot memory map the framebuffer!
2898              
2899             You are attempting to run this inside X-Windows, which doesn't work. You MUST
2900             run your script outside of X-Windows from the system Console. If you are
2901             inside X-Windows, and you do not know how to get to your console, just hit
2902             CTRL-ALT-F2 to access one of the consoles. This has no windows or mouse
2903             functionality. It is command line only (similar to old DOS).
2904              
2905             To get back into X-Windows, you just hit ALT-F7 (or ALT-F8 on some systems).
2906             };
2907 0 0       0 sleep ($self->{'RESET'}) ? 10 : 1;
2908 0         0 exit(1);
2909             } else { # Go into emulation mode if no actual framebuffer available
2910 2         8 $self->{'FB_DEVICE'} = 'EMULATED';
2911 2         8 $self->{'SPLASH'} = FALSE;
2912 2         8 $self->{'RESET'} = FALSE;
2913 2         9 $self->{'ERROR'} = 'Framebuffer Device Not Found! Emulation mode. EXPERIMENTAL!!';
2914 2         19 $self->{'COLOR_ORDER'} = $self->{ uc($self->{'COLOR_ORDER'}) }; # Translate the color order
2915              
2916 2         11 $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'} = 8;
2917 2         9 $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'msb_right'} = 0;
2918 2         9 $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'} = 8;
2919 2         7 $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'msb_right'} = 0;
2920 2         8 $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'} = 8;
2921 2         7 $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'msb_right'} = 0;
2922 2         7 $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'length'} = 8;
2923 2         14 $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'msb_right'} = 0;
2924              
2925 2 50       15 if ($self->{'COLOR_ORDER'} == BGR) {
    50          
    0          
    0          
    0          
    0          
2926 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'} = 16;
2927 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'} = 8;
2928 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'} = 0;
2929 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'} = 24;
2930             } elsif ($self->{'COLOR_ORDER'} == RGB) {
2931 2         9 $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'} = 0;
2932 2         7 $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'} = 8;
2933 2         6 $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'} = 16;
2934 2         7 $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'} = 24;
2935             } elsif ($self->{'COLOR_ORDER'} == BRG) {
2936 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'} = 8;
2937 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'} = 16;
2938 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'} = 0;
2939 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'} = 24;
2940             } elsif ($self->{'COLOR_ORDER'} == RBG) {
2941 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'} = 0;
2942 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'} = 16;
2943 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'} = 8;
2944 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'} = 24;
2945             } elsif ($self->{'COLOR_ORDER'} == GRB) {
2946 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'} = 8;
2947 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'} = 0;
2948 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'} = 16;
2949 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'} = 24;
2950             } elsif ($self->{'COLOR_ORDER'} == GBR) {
2951 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'} = 16;
2952 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'} = 0;
2953 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'} = 8;
2954 0         0 $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'} = 24;
2955             }
2956              
2957             # Set the resolution. Either the defaults, or whatever the user passed in.
2958              
2959 2         3167 $self->{'SCREEN'} = chr(0) x ($self->{'VXRES'} * $self->{'VYRES'} * $self->{'BYTES'}); # This is the fake framebuffer
2960 2         20 $self->{'XRES'} = $self->{'VXRES'}; # Virtual and physical are the same
2961 2         50 $self->{'YRES'} = $self->{'VYRES'};
2962 2         8 $self->{'XOFFSET'} = 0;
2963 2         5 $self->{'YOFFSET'} = 0;
2964 2         12 $self->{'PIXELS'} = (($self->{'XOFFSET'} + $self->{'VXRES'}) * ($self->{'YOFFSET'} + $self->{'VYRES'}));
2965 2         8 $self->{'SIZE'} = $self->{'PIXELS'} * $self->{'BYTES'};
2966 2         10 $self->{'fscreeninfo'}->{'id'} = 'Virtual Framebuffer';
2967 2         31 $self->{'GPU'} = $self->{'fscreeninfo'}->{'id'};
2968 2 50 33     22 $self->{'fscreeninfo'}->{'smem_len'} = $self->{'BYTES'} * ($self->{'VXRES'} * $self->{'VYRES'}) if (!defined($self->{'fscreeninfo'}->{'smem_len'}) || $self->{'fscreeninfo'}->{'smem_len'} <= 0);
2969 2         16 $self->{'BYTES_PER_LINE'} = int($self->{'fscreeninfo'}->{'smem_len'} / $self->{'VYRES'});
2970              
2971 2         15 bless($self, $class);
2972             }
2973 2         27 $self->{'X_FACTOR'} = 3840 / $self->{'XRES'};
2974 2         12 $self->{'Y_FACTOR'} = 2160 / $self->{'YRES'};
2975 2 50       10 if ($self->{'RESET'}) {
2976 0         0 $SIG{'QUIT'} = $SIG{'INT'} = $SIG{'KILL'} = \&_reset;
2977             }
2978 2         22 $self->_gather_fonts('/usr/share/fonts');
2979             # Loop and find the default font. One of these should work for Debian and Redhat variants.
2980 2         13 foreach my $font (qw(FreeSans Ubuntu-R Arial Oxygen-Sans Garuda LiberationSans-Regular Loma Helvetica)) {
2981 16 50       47 if (exists($self->{'FONTS'}->{$font})) {
2982 0         0 $self->{'FONT_PATH'} = $self->{'FONTS'}->{$font}->{'path'};
2983 0         0 $self->{'FONT_FACE'} = $self->{'FONTS'}->{$font}->{'font'};
2984 0         0 last;
2985             }
2986             }
2987 2         49 $self->_flush_screen();
2988 2         11203 chomp($self->{'this_tty'} = `tty`);
2989 2 50       63 if ($self->{'SPLASH'} > 0) {
2990 0         0 $self->splash($VERSION);
2991 0         0 sleep $self->{'SPLASH'};
2992             }
2993 2         57 $self->attribute_reset();
2994 2 50       14 if (wantarray) { # For the temporarily supported (but no longer) double buffering mode
2995 0         0 return ($self, $self); # For those that coded for double buffering
2996             }
2997 2         42 return ($self);
2998             }
2999              
3000             sub _reset {
3001 0     0   0 system('reset');
3002             }
3003              
3004             sub _fix_mapping { # File::Map SHOULD make this obsolete
3005             # Fixes the mapping if Perl garbage collects (naughty Perl)
3006 0     0   0 my $self = shift;
3007 0         0 unmap($self->{'SCREEN'}); # Unmap missing on some File::Maps
3008 0 0       0 unless (defined($self->{'FB'})) {
3009 0         0 eval { close($self->{'FB'}); };
  0         0  
3010 0         0 open($self->{'FB'}, '+<', $self->{'FB_DEVICE'});
3011 0         0 binmode($self->{'FB'});
3012 0         0 $self->_flush_screen();
3013             }
3014 0         0 $self->{'MAP_ATTEMPTS'}++;
3015             # We don't eval, because it worked originally
3016 0         0 $self->{'SCREEN_ADDRESS'} = map_handle($self->{'SCREEN'}, $self->{'FB'}, '+<', 0, $self->{'fscreeninfo'}->{'smem_len'});
3017             }
3018              
3019             sub _color_order {
3020             # Determine the color order the video card uses
3021 0     0   0 my $self = shift;
3022              
3023 0         0 my $ro = $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'};
3024 0         0 my $go = $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'};
3025 0         0 my $bo = $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'};
3026              
3027 0 0 0     0 if ($ro < $go && $go < $bo) {
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
3028 0         0 $self->{'COLOR_ORDER'} = RGB;
3029             } elsif ($bo < $go && $go < $ro) {
3030 0         0 $self->{'COLOR_ORDER'} = BGR;
3031             } elsif ($go < $ro && $ro < $bo) {
3032 0         0 $self->{'COLOR_ORDER'} = GRB;
3033             } elsif ($go < $bo && $bo < $ro) {
3034 0         0 $self->{'COLOR_ORDER'} = GBR;
3035             } elsif ($bo < $ro && $ro < $go) {
3036 0         0 $self->{'COLOR_ORDER'} = BRG;
3037             } elsif ($ro < $bo && $bo < $go) {
3038 0         0 $self->{'COLOR_ORDER'} = RBG;
3039             } else {
3040             # UNKNOWN - default to RGB
3041 0         0 $self->{'COLOR_ORDER'} = RGB;
3042             }
3043             }
3044              
3045             sub _screen_close {
3046 2     2   7 my $self = shift;
3047 2 50       17 unless (defined($self->{'ERROR'})) { # Only do it if not in emulation mode
3048 0 0       0 unmap($self->{'SCREEN'}) if (defined($self->{'SCREEN'})); # unmap had issues with File::Map.
3049 0 0       0 close($self->{'FB'}) if (defined($self->{'FB'}));
3050 0         0 delete($self->{'FB'}); # We leave no remnants
3051             }
3052 2         134 delete($self->{'SCREEN'});
3053             }
3054              
3055             sub text_mode {
3056             =head2 text_mode
3057              
3058             Sets the TTY into text mode, where text can interfere with the display
3059              
3060             =cut
3061              
3062 2     2 0 15 my $self = shift;
3063 2         102 c_text_mode($self->{'this_tty'});
3064             }
3065              
3066             sub graphics_mode {
3067             =head2 graphics_mode
3068              
3069             Sets the TTY in exclusive graphics mode, where text and cursor cannot interfere with the display. Please remember, you must call text_mode before exiting, else your console will not show any text!
3070              
3071             =cut
3072              
3073 0     0 0 0 my $self = shift;
3074 0         0 c_graphics_mode($self->{'this_tty'});
3075             }
3076              
3077             sub screen_dimensions {
3078             =head2 screen_dimensions
3079              
3080             When called in an array/list context:
3081              
3082             Returns the size and nature of the framebuffer in X,Y pixel values.
3083              
3084             It also returns the bits per pixel.
3085              
3086             =over 4
3087              
3088             my ($width,$height,$bits_per_pixel) = $fb->screen_dimensions();
3089              
3090             =back
3091              
3092             When called in a scalar context, it returns a hash reference:
3093              
3094             =over 4
3095              
3096             {
3097             'width' => pixel width of physical screen,
3098             'height' => pixel height of physical screen,
3099             'bits_per_pixel' => bits per pixel (16, 24, or 32),
3100             'bytes_per_line' => Number of bytes per scan line,
3101             'top_clip' => top edge of clipping rectangle (Y),
3102             'left_clip' => left edge of clipping rectangle (X),
3103             'bottom_clip' => bottom edge of clipping rectangle (YY),
3104             'right_clip' => right edge of clipping rectangle (XX),
3105             'width_clip' => width of clipping rectangle,
3106             'height_clip' => height of clipping rectangle,
3107             'color_order' => RGB, BGR, etc,
3108             }
3109              
3110             =back
3111              
3112             =cut
3113              
3114 1     1 0 1233 my $self = shift;
3115 1 50       4 if (wantarray) {
3116 0         0 return ($self->{'XRES'}, $self->{'YRES'}, $self->{'BITS'});
3117             } else {
3118             return (
3119             {
3120             'width' => $self->{'XRES'},
3121             'height' => $self->{'YRES'},
3122             'bits_per_pixel' => $self->{'BITS'},
3123             'bytes_per_line' => $self->{'BYTES_PER_LINE'},
3124             'top_clip' => $self->{'Y_CLIP'},
3125             'left_clip' => $self->{'X_CLIP'},
3126             'bottom_clip' => $self->{'YY_CLIP'},
3127             'right_clip' => $self->{'XX_CLIP'},
3128             'clip_width' => $self->{'W_CLIP'},
3129             'clip_height' => $self->{'H_CLIP'},
3130 1         31 'color_order' => $COLORORDER[$self->{'COLOR_ORDER'}],
3131             }
3132             );
3133             }
3134             }
3135              
3136             sub get_font_list {
3137             # Splash is now pulled in via "Graphics::Framebuffer::Splash"
3138              
3139             =head2 splash
3140              
3141             Displays the Splash screen. It automatically scales and positions to the clipping region.
3142              
3143             This is automatically displayed when this module is initialized, and the variable 'SPLASH' is true (which is the default).
3144              
3145             =over 4
3146              
3147             $fb->splash();
3148              
3149             =back
3150              
3151             =head2 get_font_list
3152              
3153             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.
3154              
3155             =over 4
3156              
3157             'face name' => {
3158             'path' => 'path to font',
3159             'font' => 'file name of font'
3160             },
3161             ... The rest of the system fonts here
3162              
3163             =back
3164              
3165             You may also pass in a face name and it will return that face's information:
3166              
3167             =over 4
3168              
3169             my $font_info = $fb->get_font_list('DejaVuSerif');
3170              
3171             =back
3172              
3173             Would return something like:
3174              
3175             =over 4
3176              
3177             {
3178             'font' => 'dejavuserif.ttf',
3179             'path' => '/usr/share/fonts/truetype/'
3180             }
3181              
3182             =back
3183              
3184             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).
3185              
3186             =cut
3187              
3188 0     0 1 0 my $self = shift;
3189 0         0 my ($filter) = @_;
3190              
3191 0         0 my $fonts;
3192 0 0       0 if ($filter) {
3193 0         0 foreach my $font (sort(keys %{ $self->{'FONTS'} })) {
  0         0  
3194 0 0       0 if ($font =~ /$filter/i) {
3195 0         0 push(@{$fonts}, $self->{'FONTS'}->{$font});
  0         0  
3196             }
3197             }
3198 0 0 0     0 if (defined($fonts) && scalar(@{$fonts}) == 1) {
  0         0  
3199 0         0 return ($fonts->[0]);
3200             } else {
3201 0         0 return ($fonts);
3202             }
3203             }
3204 0         0 return ($self->{'FONTS'});
3205             }
3206              
3207             sub draw_mode {
3208             =head2 draw_mode
3209              
3210             Sets or returns the drawing mode, depending on how it is called.
3211              
3212             =over 4
3213              
3214             my $draw_mode = $fb->draw_mode(); # Returns the current
3215             # Drawing mode.
3216              
3217             # Modes explained. These settings are global
3218              
3219             # When you draw it...
3220              
3221             $fb->draw_mode(NORMAL_MODE); # Replaces the screen pixel
3222             # with the new pixel. Imager
3223             # assisted drawing (acceleration)
3224             # only works in this mode.
3225              
3226             $fb->draw_mode(XOR_MODE); # Does a bitwise XOR with
3227             # the new pixel and screen
3228             # pixel.
3229              
3230             $fb->draw_mode(OR_MODE); # Does a bitwise OR with
3231             # the new pixel and screen
3232             # pixel.
3233              
3234             $fb->draw_mode(AND_MODE); # Does a bitwise AND with
3235             # the new pixel and screen
3236             # pixel.
3237              
3238             $fb->draw_mode(MASK_MODE); # If pixels in the source
3239             # are equal to the global
3240             # background color, then they
3241             # are not drawn (transparent).
3242              
3243             $fb->draw_mode(UNMASK_MODE); # Draws the new pixel on
3244             # screen areas only equal to
3245             # the background color.
3246              
3247             $fb->draw_mode(ALPHA_MODE); # Draws the new pixel on the screen
3248             # using the alpha channel value as
3249             # a transparency value. This means
3250             # the new pixel will not be
3251             # opague.
3252              
3253             $fb->draw_mode(ADD_MODE); # Draws the new pixel on the screen
3254             # by mathematically adding its pixel
3255             # value to the existing pixel value
3256              
3257             $fb->draw_mode(SUBTRACT_MODE); # Draws the new pixel on the screen
3258             # by mathematically subtracting the
3259             # the new pixel value from the existing
3260             # value
3261              
3262             $fb->draw_mode(MULTIPLY_MODE); # Draws the new pixel on the screen
3263             # by mathematically multiplying it with
3264             # the existing pixel value (usually not
3265             # too useful, but here for completeness)
3266              
3267             $fb->draw_mode(DIVIDE_MODE); # Draws the new pixel on the screen
3268             # by mathematically dividing it with the
3269             # existing pixel value (usually not too
3270             # useful, but here for completeness)
3271              
3272             =back
3273             =cut
3274              
3275 0     0 0 0 my $self = shift;
3276 0 0       0 if (@_) {
3277 0         0 my $mode = int(shift);
3278             # If not a valid value, then it defaults to normal mode
3279 0 0 0     0 $self->{'DRAW_MODE'} = ($mode <= 10 && $mode >= 0) ? $mode : NORMAL_MODE;
3280             } else {
3281 0         0 return ($self->{'DRAW_MODE'});
3282             }
3283             }
3284              
3285             sub normal_mode {
3286             =head2 normal_mode
3287              
3288             This is an alias to draw_mode(NORMAL_MODE)
3289              
3290             =over 4
3291              
3292             $fb->normal_mode();
3293              
3294             =back
3295              
3296             =cut
3297              
3298 0     0 0 0 my $self = shift;
3299 0         0 $self->draw_mode(NORMAL_MODE);
3300             }
3301              
3302             sub xor_mode {
3303             =head2 xor_mode
3304              
3305             This is an alias to draw_mode(XOR_MODE)
3306              
3307             =over 4
3308              
3309             $fb->xor_mode();
3310              
3311             =back
3312              
3313             =cut
3314              
3315 0     0 0 0 my $self = shift;
3316 0         0 $self->draw_mode(XOR_MODE);
3317             }
3318              
3319             sub or_mode {
3320             =head2 or_mode
3321              
3322             This is an alias to draw_mode(OR_MODE)
3323              
3324             =over 4
3325              
3326             $fb->or_mode();
3327              
3328             =back
3329              
3330             =cut
3331              
3332 0     0 0 0 my $self = shift;
3333 0         0 $self->draw_mode(OR_MODE);
3334             }
3335              
3336             sub alpha_mode {
3337             =head2 alpha_mode
3338              
3339             This is an alias to draw_mode(ALPHA_MODE)
3340              
3341             =over 4
3342              
3343             $fb->alpha_mode();
3344              
3345             =back
3346              
3347             =cut
3348              
3349 0     0 0 0 my $self = shift;
3350 0         0 $self->draw_mode(ALPHA_MODE);
3351             }
3352              
3353             sub and_mode {
3354             =head2 and_mode
3355              
3356             This is an alias to draw_mode(AND_MODE)
3357              
3358             =over 4
3359              
3360             $fb->and_mode();
3361              
3362             =back
3363              
3364             =cut
3365              
3366 0     0 0 0 my $self = shift;
3367 0         0 $self->draw_mode(AND_MODE);
3368             }
3369              
3370             sub mask_mode {
3371             =head2 mask_mode
3372              
3373             This is an alias to draw_mode(MASK_MODE)
3374              
3375             =over 4
3376              
3377             $fb->mask_mode();
3378              
3379             =back
3380              
3381             =cut
3382              
3383 0     0 0 0 my $self = shift;
3384 0         0 $self->draw_mode(MASK_MODE);
3385             }
3386              
3387             sub unmask_mode {
3388             =head2 unmask_mode
3389              
3390             This is an alias to draw_mode(UNMASK_MODE)
3391              
3392             =over 4
3393              
3394             $fb->unmask_mode();
3395              
3396             =back
3397              
3398             =cut
3399              
3400 0     0 0 0 my $self = shift;
3401 0         0 $self->draw_mode(UNMASK_MODE);
3402             }
3403              
3404             sub add_mode {
3405             =head2 add_mode
3406              
3407             This is an alias to draw_mode(ADD_MODE)
3408              
3409             =over 4
3410              
3411             $fb->add_mode();
3412              
3413             =back
3414              
3415             =cut
3416              
3417 0     0 0 0 my $self = shift;
3418 0         0 $self->draw_mode(ADD_MODE);
3419             }
3420              
3421             sub subtract_mode {
3422             =head2 subtract_mode
3423              
3424             This is an alias to draw_mode(SUBTRACT_MODE)
3425              
3426             =over 4
3427              
3428             $fb->subtract_mode();
3429              
3430             =back
3431              
3432             =cut
3433              
3434 0     0 0 0 my $self = shift;
3435 0         0 $self->draw_mode(SUBTRACT_MODE);
3436             }
3437              
3438             sub multiply_mode {
3439             =head2 multiply_mode
3440              
3441             This is an alias to draw_mode(MULTIPLY_MODE)
3442              
3443             =over 4
3444              
3445             $fb->multiply_mode();
3446              
3447             =back
3448              
3449             =cut
3450              
3451 0     0 0 0 my $self = shift;
3452 0         0 $self->draw_mode(MULTIPLY_MODE);
3453             }
3454              
3455             sub divide_mode {
3456             =head2 divide_mode
3457              
3458             This is an alias to draw_mode(DIVIDE_MODE)
3459              
3460             =over 4
3461              
3462             $fb->divide_mode();
3463              
3464             =back
3465              
3466             =cut
3467              
3468 0     0 0 0 my $self = shift;
3469 0         0 $self->draw_mode(DIVIDE_MODE);
3470             }
3471              
3472             sub clear_screen {
3473             =head2 clear_screen
3474              
3475             Fills the entire screen with the background color
3476              
3477             You can add an optional parameter to turn the console cursor on or off too.
3478              
3479             =over 4
3480              
3481             $fb->clear_screen(); # Leave cursor as is.
3482             $fb->clear_screen('OFF'); # Turn cursor OFF (Does nothing with emulated framebuffer mode).
3483             $fb->clear_screen('ON'); # Turn cursor ON (Does nothing with emulated framebuffer mode).
3484              
3485             =back
3486              
3487             =cut
3488              
3489             # Fills the entire screen with the background color fast #
3490 3     3 0 12 my $self = shift;
3491 3   100     50 my $cursor = shift || '';
3492              
3493 3 50       28 unless($self->{'DEVICE'} eq 'EMULATED') { # We only do this stuff to real framebuffers
3494 3 100       70 if ($cursor =~ /off/i) {
    100          
3495 1         5960 system('clear && tput civis -- invisible');
3496             } elsif ($cursor =~ /on/i) {
3497 1         12660 system('tput cnorm -- normal && clear');
3498             }
3499 3         110 select(STDOUT);
3500 3         67 $|++;
3501             }
3502 3 50       42 if ($self->{'CLIPPED'}) {
3503 0         0 my $w = $self->{'W_CLIP'};
3504 0         0 my $h = $self->{'H_CLIP'};
3505 0         0 $self->blit_write({ 'x' => $self->{'X_CLIP'}, 'y' => $self->{'Y_CLIP'}, 'width' => $w, 'height' => $h, 'image' => $self->{'RAW_BACKGROUND_COLOR'} x ($w * $h) }, 0);
3506             } else {
3507 3         7256 substr($self->{'SCREEN'}, 0) = $self->{'RAW_BACKGROUND_COLOR'} x ($self->{'fscreeninfo'}->{'smem_len'} / $self->{'BYTES'});
3508             }
3509 3         84 $self->_flush_screen();
3510             }
3511              
3512             sub cls {
3513             =head2 cls
3514              
3515             This is an alias to 'clear_screen'
3516              
3517             =cut
3518              
3519 3     3 0 1277 my $self = shift;
3520 3         35 $self->clear_screen(@_);
3521             }
3522              
3523             sub attribute_reset {
3524             =head2 attribute_reset
3525              
3526             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.
3527              
3528             =over 4
3529              
3530             $fb->attribute_reset();
3531              
3532             =back
3533              
3534             =cut
3535              
3536 2     2 0 19 my $self = shift;
3537              
3538 2         18 $self->{'X'} = 0;
3539 2         18 $self->{'Y'} = 0;
3540 2         10 $self->set_color({ %{ $self->{'FOREGROUND'} } });
  2         116  
3541 2         146 $self->{'DRAW_MODE'} = NORMAL_MODE;
3542 2         5 $self->set_b_color({ %{ $self->{'BACKGROUND'} } });
  2         49  
3543 2         81 $self->clip_reset;
3544             }
3545              
3546             sub plot {
3547             =head2 plot
3548              
3549             Set a single pixel in the set foreground color at position x,y with the given pixel size (or default). Clipping applies.
3550              
3551             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.
3552              
3553             =over 4
3554              
3555             $fb->plot(
3556             {
3557             'x' => 20,
3558             'y' => 30,
3559             'pixel_size' => 3
3560             }
3561             );
3562              
3563             =back
3564              
3565             =cut
3566              
3567 0     0 0 0 my $self = shift;
3568 0         0 my $params = shift;
3569              
3570 0   0     0 my $x = int($params->{'x'} || 0); # Ignore decimals
3571 0   0     0 my $y = int($params->{'y'} || 0);
3572 0   0     0 my $size = int($params->{'pixel_size'} || 1);
3573 0         0 my ($c, $index);
3574 0 0       0 if (abs($size) > 1) {
    0          
3575 0 0       0 if ($size < -1) {
3576 0         0 $size = abs($size);
3577 0         0 $self->circle({ 'x' => $x, 'y' => $y, 'radius' => ($size / 2), 'filled' => 1, 'pixel_size' => 1 });
3578             } else {
3579 0         0 $self->rbox({ 'x' => $x - ($width / 2), 'y' => $y - ($height / 2), 'width' => $size, 'height' => $size, 'filled' => TRUE, 'pixel_size' => 1 });
3580             }
3581             } elsif ($self->{'ACCELERATED'}) {
3582             c_plot(
3583             $self->{'SCREEN'},
3584             $x, $y,
3585             $self->{'X_CLIP'}, $self->{'Y_CLIP'}, $self->{'XX_CLIP'}, $self->{'YY_CLIP'},
3586             $self->{'INT_RAW_FOREGROUND_COLOR'},
3587             $self->{'INT_RAW_BACKGROUND_COLOR'},
3588             $self->{'COLOR_ALPHA'},
3589             $self->{'DRAW_MODE'},
3590             $self->{'BYTES'},
3591             $self->{'BITS'},
3592             $self->{'BYTES_PER_LINE'},
3593 0         0 $self->{'XOFFSET'}, $self->{'YOFFSET'},
3594             );
3595             } else {
3596             # Only plot if the pixel is within the clipping region
3597 0 0 0     0 unless (($x > $self->{'XX_CLIP'}) || ($y > $self->{'YY_CLIP'}) || ($x < $self->{'X_CLIP'}) || ($y < $self->{'Y_CLIP'})) {
      0        
      0        
3598             # The 'history' is a 'draw_arc' optimization and beautifier for xor mode. It only draws pixels not in
3599             # the history buffer.
3600 0 0 0     0 unless (exists($self->{'history'}) && defined($self->{'history'}->{$y}->{$x})) {
3601 0         0 $index = ($self->{'BYTES_PER_LINE'} * ($y + $self->{'YOFFSET'})) + (($self->{'XOFFSET'} + $x) * $self->{'BYTES'});
3602 0 0 0     0 if ($index >= 0 && $index <= ($self->{'fscreeninfo'}->{'smem_len'} - $self->{'BYTES'})) {
3603 0         0 eval {
3604 0   0     0 $c = substr($self->{'SCREEN'}, $index, $self->{'BYTES'}) || chr(0) x $self->{'BYTES'};
3605 0 0       0 if ($self->{'DRAW_MODE'} == NORMAL_MODE) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
3606 0         0 $c = $self->{'RAW_FOREGROUND_COLOR'};
3607             } elsif ($self->{'DRAW_MODE'} == XOR_MODE) {
3608 0         0 $c ^= $self->{'RAW_FOREGROUND_COLOR'};
3609             } elsif ($self->{'DRAW_MODE'} == OR_MODE) {
3610 0         0 $c |= $self->{'RAW_FOREGROUND_COLOR'};
3611             } elsif ($self->{'DRAW_MODE'} == ALPHA_MODE) {
3612 0         0 my $back = $self->get_pixel({ 'x' => $x, 'y' => $y });
3613 0         0 my $saved = { 'main' => $self->{'RAW_FOREGROUND_COLOR'} };
3614 0         0 foreach my $color (qw( red green blue )) {
3615 0         0 $saved->{$color} = $self->{ 'COLOR_' . uc($color) };
3616 0         0 $back->{$color} = ($self->{ 'COLOR_' . uc($color) } * $self->{'COLOR_ALPHA'}) + ($back->{$color} * (1 - $self->{'COLOR_ALPHA'}));
3617             }
3618 0         0 $back->{'alpha'} = min(255, $self->{'COLOR_ALPHA'} + $back->{'alpha'});
3619 0         0 $self->set_color($back);
3620 0         0 $c = $self->{'RAW_FOREGROUND_COLOR'};
3621 0         0 $self->{'RAW_FOREGROUND_COLOR'} = $saved->{'main'};
3622 0         0 foreach my $color (qw( red green blue )) {
3623 0         0 $self->{ 'COLOR_' . uc($color) } = $saved->{$color};
3624             }
3625             } elsif ($self->{'DRAW_MODE'} == AND_MODE) {
3626 0         0 $c &= $self->{'RAW_FOREGROUND_COLOR'};
3627             } elsif ($self->{'DRAW_MODE'} == ADD_MODE) {
3628 0         0 $c += $self->{'RAW_FOREGROUND_COLOR'};
3629             } elsif ($self->{'DRAW_MODE'} == SUBTRACT_MODE) {
3630 0         0 $c -= $self->{'RAW_FOREGROUND_COLOR'};
3631             } elsif ($self->{'DRAW_MODE'} == MULTIPLY_MODE) {
3632 0         0 $c *= $self->{'RAW_FOREGROUND_COLOR'};
3633             } elsif ($self->{'DRAW_MODE'} == DIVIDE_MODE) {
3634 0         0 $c /= $self->{'RAW_FOREGROUND_COLOR'};
3635             } elsif ($self->{'DRAW_MODE'} == MASK_MODE) {
3636 0 0       0 if ($self->{'BITS'} == 32) {
3637 0 0       0 $c = $self->{'RAW_FOREGROUND_COLOR'} if (substr($self->{'RAW_FOREGROUND_COLOR'}, 0, 3) ne substr($self->{'RAW_BACKGROUND_COLOR'}, 0, 3));
3638             } else {
3639 0 0       0 $c = $self->{'RAW_FOREGROUND_COLOR'} if ($self->{'RAW_FOREGROUND_COLOR'} ne $self->{'RAW_BACKGROUND_COLOR'});
3640             }
3641             } elsif ($self->{'DRAW_MODE'} == UNMASK_MODE) {
3642 0         0 my $pixel = $self->pixel({ 'x' => $x, 'y' => $y });
3643 0         0 my $raw = $pixel->{'raw'};
3644 0 0       0 if ($self->{'BITS'} == 32) {
3645 0 0       0 $c = $self->{'RAW_FOREGROUND_COLOR'} if (substr($raw, 0, 3) eq substr($self->{'RAW_BACKGROUND_COLOR'}, 0, 3));
3646             } else {
3647 0 0       0 $c = $self->{'RAW_FOREGROUND_COLOR'} if ($raw eq $self->{'RAW_BACKGROUND_COLOR'});
3648             }
3649             }
3650 0         0 substr($self->{'SCREEN'}, $index, $self->{'BYTES'}) = $c;
3651             };
3652 0         0 my $error = $@;
3653 0 0 0     0 warn __LINE__ . " $error" if ($error && $self->{'SHOW_ERRORS'});
3654 0 0       0 $self->_fix_mapping() if ($error);
3655             }
3656 0 0       0 $self->{'history'}->{$y}->{$x} = 1 if (exists($self->{'history'}));
3657             }
3658             }
3659             }
3660              
3661 0         0 $self->{'X'} = $x;
3662 0         0 $self->{'Y'} = $y;
3663             }
3664              
3665             sub setpixel {
3666             =head2 setpixel
3667              
3668             Same as 'plot' above
3669              
3670             =cut
3671              
3672 0     0 0 0 my $self = shift;
3673 0         0 $self->plot(shift);
3674             }
3675              
3676             sub pixel {
3677             =head2 pixel
3678              
3679             Returns the color of the pixel at coordinate x,y, if it lies within the clipping region. It returns undefined if outside of the clipping region.
3680              
3681             =over 4
3682              
3683             my $pixel = $fb->pixel({'x' => 20,'y' => 25});
3684              
3685             $pixel is a hash reference in the form:
3686              
3687             {
3688             'red' => integer value, # 0 - 255
3689             'green' => integer value, # 0 - 255
3690             'blue' => integer value, # 0 - 255
3691             'alpha' => integer value, # 0 - 255
3692             'hex' => hexadecimal string of the values from 00000000 to FFFFFFFF
3693             'raw' => 16/24/32bit encoded string (depending on screen mode)
3694             }
3695              
3696             =back
3697             =cut
3698              
3699 0     0 0 0 my $self = shift;
3700 0         0 my $params = shift;
3701              
3702 0         0 my $x = int($params->{'x'});
3703 0         0 my $y = int($params->{'y'});
3704 0         0 my $bytes = $self->{'BYTES'};
3705              
3706             # Values outside of the clipping area return undefined.
3707 0 0 0     0 unless (($x > $self->{'XX_CLIP'}) || ($y > $self->{'YY_CLIP'}) || ($x < $self->{'X_CLIP'}) || ($y < $self->{'Y_CLIP'})) {
      0        
      0        
3708 0         0 my ($R, $G, $B);
3709 0         0 my $index = ($self->{'BYTES_PER_LINE'} * ($y + $self->{'YOFFSET'})) + (($self->{'XOFFSET'} + $x) * $bytes);
3710 0         0 my $color = substr($self->{'SCREEN'}, $index, $bytes);
3711              
3712 0 0       0 return($color) if (exists($params->{'raw'})); # Bypass the mess below if floodfill is using this
3713              
3714 0         0 my $color_order = $self->{'COLOR_ORDER'};
3715 0         0 my $A = $self->{'COLOR_ALPHA'};
3716 0 0       0 if ($self->{'BITS'} == 32) {
    0          
    0          
3717 0 0       0 if ($color_order == BGR) {
    0          
    0          
    0          
    0          
    0          
3718 0         0 ($B, $G, $R, $A) = unpack("C$bytes", $color);
3719             } elsif ($color_order == BRG) {
3720 0         0 ($B, $R, $G, $A) = unpack("C$bytes", $color);
3721             } elsif ($color_order == RGB) {
3722 0         0 ($R, $G, $B, $A) = unpack("C$bytes", $color);
3723             } elsif ($color_order == RBG) {
3724 0         0 ($R, $B, $G, $A) = unpack("C$bytes", $color);
3725             } elsif ($color_order == GRB) {
3726 0         0 ($G, $R, $B, $A) = unpack("C$bytes", $color);
3727             } elsif ($color_order == GBR) {
3728 0         0 ($G, $B, $R, $A) = unpack("C$bytes", $color);
3729             }
3730             } elsif ($self->{'BITS'} == 24) {
3731 0 0       0 if ($color_order == BGR) {
    0          
    0          
    0          
    0          
    0          
3732 0         0 ($B, $G, $R) = unpack("C$bytes", $color);
3733             } elsif ($color_order == BRG) {
3734 0         0 ($B, $R, $G) = unpack("C$bytes", $color);
3735             } elsif ($color_order == RGB) {
3736 0         0 ($R, $G, $B) = unpack("C$bytes", $color);
3737             } elsif ($color_order == RBG) {
3738 0         0 ($R, $B, $G) = unpack("C$bytes", $color);
3739             } elsif ($color_order == GRB) {
3740 0         0 ($G, $R, $B) = unpack("C$bytes", $color);
3741             } elsif ($color_order == GBR) {
3742 0         0 ($G, $B, $R) = unpack("C$bytes", $color);
3743             }
3744             } elsif ($self->{'BITS'} == 16) {
3745 0         0 my $C = unpack('S', $color);
3746              
3747 0 0       0 $B = ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'} < 6) ? ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) & 31 : ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'})) & 63;
3748 0 0       0 $G = ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'} < 6) ? ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) & 31 : ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) & 63;
3749 0 0       0 $R = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'} < 6) ? ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) & 31 : ($C >> ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) & 63;
3750 0         0 $R = $R << (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'});
3751 0         0 $G = $G << (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'});
3752 0         0 $B = $B << (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'});
3753             }
3754 0         0 return ({ 'red' => $R, 'green' => $G, 'blue' => $B, 'alpha' => $A, 'raw' => $color, 'hex' => sprintf('%02x%02x%02x%02x',$R,$G,$B,$A) });
3755             }
3756 0         0 return (undef);
3757             }
3758              
3759             sub get_pixel {
3760             =head2 get_pixel
3761              
3762             Alias for 'pixel'.
3763              
3764             =cut
3765              
3766 0     0 0 0 my $self = shift;
3767 0         0 return ($self->pixel(shift));
3768             }
3769              
3770             sub last_plot {
3771             =head2 last_plot
3772              
3773             Returns the last plotted position
3774              
3775             =over 4
3776              
3777             my $last_plot = $fb->last_plot();
3778              
3779             This returns an anonymous hash reference in the form:
3780              
3781             {
3782             'x' => x position,
3783             'y' => y position
3784             }
3785              
3786             =back
3787              
3788             Or, if you want a simple array returned:
3789              
3790             =over 4
3791              
3792             my ($x,$y) = $fb->last_plot();
3793              
3794             This returns the position as a two element array:
3795              
3796             ( x position, y position )
3797              
3798             =back
3799              
3800             =cut
3801              
3802 0     0 0 0 my $self = shift;
3803 0 0       0 if (wantarray) {
3804 0         0 return ($self->{'X'}, $self->{'Y'});
3805             }
3806 0         0 return ({ 'x' => $self->{'X'}, 'y' => $self->{'Y'} });
3807             }
3808              
3809             sub line {
3810             =head2 line
3811              
3812             Draws a line, in the foreground color, from point x,y to point xx,yy. Clipping applies.
3813              
3814             =over 4
3815              
3816             $fb->line({
3817             'x' => 50,
3818             'y' => 60,
3819             'xx' => 100,
3820             'yy' => 332
3821             'pixel_size' => 1,
3822             'antialiased' => TRUE
3823             });
3824              
3825             =back
3826              
3827             =cut
3828              
3829 0     0 0 0 my $self = shift;
3830 0         0 my $params = shift;
3831              
3832 0         0 $self->plot($params);
3833 0         0 $params->{'x'} = $params->{'xx'};
3834 0         0 $params->{'y'} = $params->{'yy'};
3835 0         0 $self->drawto($params);
3836             }
3837              
3838             sub angle_line {
3839             =head2 angle_line
3840              
3841             Draws a line, in the global foreground color, from point x,y at an angle of 'angle', of length 'radius'. Clipping applies.
3842              
3843             =over 4
3844              
3845             $fb->angle_line({
3846             'x' => 50,
3847             'y' => 60,
3848             'radius' => 50,
3849             'angle' => 30.3, # Compass coordinates (0-360)
3850             'pixel_size' => 3,
3851             'antialiased' => FALSE
3852             });
3853              
3854             =back
3855              
3856             * This is not affected by the Acceleration setting
3857              
3858             =cut
3859              
3860 0     0 0 0 my $self = shift;
3861 0         0 my $params = shift;
3862              
3863 0         0 my ($dp_cos, $dp_sin);
3864 0         0 my $index = int($params->{'angle'} * 100);
3865              
3866 0 0       0 if (defined($self->{'dp_cache'}->[$index])) {
3867 0         0 ($dp_cos, $dp_sin) = (@{ $self->{'dp_cache'}->[$index] });
  0         0  
3868             } else {
3869 0         0 my $dp = ($params->{'angle'} * pi) / 180;
3870 0         0 ($dp_cos, $dp_sin) = (cos($dp), sin($dp));
3871 0         0 $self->{'dp_cache'}->[$index] = [$dp_cos, $dp_sin];
3872             }
3873 0         0 $params->{'xx'} = int($params->{'x'} - ($params->{'radius'} * $dp_sin));
3874 0         0 $params->{'yy'} = int($params->{'y'} - ($params->{'radius'} * $dp_cos));
3875 0         0 $self->line($params);
3876             }
3877              
3878             sub drawto {
3879             =head2 drawto
3880              
3881             Draws a line, in the foreground color, from the last plotted position to the position x,y. Clipping applies.
3882              
3883             =over 4
3884              
3885             $fb->drawto({
3886             'x' => 50,
3887             'y' => 60,
3888             'pixel_size' => 2,
3889             'antialiased' => TRUE
3890             });
3891              
3892             =back
3893              
3894             * Antialiased lines are not accelerated
3895              
3896             =cut
3897              
3898             ##########################################################################
3899             # For Perl, Perfectly horizontal line drawing is optimized by using the #
3900             # BLIT functions. This assists greatly with drawing filled objects. In #
3901             # fact, it's hundreds of times faster! #
3902             ##########################################################################
3903 0     0 0 0 my $self = shift;
3904 0         0 my $params = shift;
3905              
3906 0         0 my $x_end = int($params->{'x'});
3907 0         0 my $y_end = int($params->{'y'});
3908 0   0     0 my $size = int($params->{'pixel_size'} || 1);
3909              
3910 0         0 my $start_x = $self->{'X'};
3911 0         0 my $start_y = $self->{'Y'};
3912 0   0     0 my $antialiased = $params->{'antialiased'} || 0;
3913 0 0       0 $size = $params->{'pixel_size'} = 1 if ($antialiased);
3914 0         0 my $XX = $x_end;
3915 0         0 my $YY = $y_end;
3916              
3917 0 0 0     0 if ($self->{'ACCELERATED'} && $size == 1 && !$antialiased) {
      0        
3918             c_line(
3919             $self->{'SCREEN'},
3920             $start_x, $start_y, $x_end, $y_end,
3921             $self->{'X_CLIP'}, $self->{'Y_CLIP'}, $self->{'XX_CLIP'}, $self->{'YY_CLIP'},
3922             $self->{'INT_RAW_FOREGROUND_COLOR'},
3923             $self->{'INT_RAW_BACKGROUND_COLOR'},
3924             $self->{'COLOR_ALPHA'},
3925             $self->{'DRAW_MODE'},
3926             $self->{'BYTES'},
3927             $self->{'BITS'},
3928             $self->{'BYTES_PER_LINE'},
3929 0         0 $self->{'XOFFSET'}, $self->{'YOFFSET'},
3930             # $antialiased,
3931             );
3932             } else {
3933 0         0 my ($width, $height);
3934             # Determines if the coordinates sent were right-side-up or up-side-down.
3935 0 0       0 if ($start_x > $x_end) {
3936 0         0 $width = $start_x - $x_end;
3937             } else {
3938 0         0 $width = $x_end - $start_x;
3939             }
3940 0 0       0 if ($start_y > $y_end) {
3941 0         0 $height = $start_y - $y_end;
3942             } else {
3943 0         0 $height = $y_end - $start_y;
3944             }
3945              
3946             # We need only plot if start and end are the same
3947 0 0 0     0 if (($x_end == $start_x) && ($y_end == $start_y)) {
    0          
    0          
    0          
    0          
    0          
3948 0         0 $self->plot({ 'x' => $x_end, 'y' => $y_end, 'pixel_size' => $size });
3949              
3950             # Else, let's get to drawing
3951             } elsif ($x_end == $start_x) { # Draw a perfectly verticle line
3952 0 0       0 if ($start_y > $y_end) { # Draw direction is UP
3953 0         0 foreach my $y ($y_end .. $start_y) {
3954 0         0 $self->plot({ 'x' => $start_x, 'y' => $y, 'pixel_size' => $size });
3955             }
3956             } else { # Draw direction is DOWN
3957 0         0 foreach my $y ($start_y .. $y_end) {
3958 0         0 $self->plot({ 'x' => $start_x, 'y' => $y, 'pixel_size' => $size });
3959             }
3960             }
3961             } elsif ($y_end == $start_y) { # Draw a perfectly horizontal line (fast)
3962 0         0 $x_end = max($self->{'X_CLIP'}, min($x_end, $self->{'XX_CLIP'}));
3963 0         0 $start_x = max($self->{'X_CLIP'}, min($start_x, $self->{'XX_CLIP'}));
3964 0         0 $width = abs($x_end - $start_x);
3965 0 0       0 if ($size == 1) {
3966 0 0       0 if ($start_x > $x_end) {
3967 0         0 $self->blit_write({ 'x' => $x_end, 'y' => $y_end, 'width' => $width, 'height' => 1, 'image' => $self->{'RAW_FOREGROUND_COLOR'} x $width }); # Blitting a horizontal line is much faster!
3968             } else {
3969 0         0 $self->blit_write({ 'x' => $start_x, 'y' => $start_y, 'width' => $width, 'height' => 1, 'image' => $self->{'RAW_FOREGROUND_COLOR'} x $width }); # Blitting a horizontal line is much faster!
3970             }
3971             } else {
3972 0 0       0 if ($start_x > $x_end) {
3973 0         0 $self->blit_write({ 'x' => $x_end, 'y' => ($y_end - ($size / 2)), 'width' => $width, 'height' => $size, 'image' => $self->{'RAW_FOREGROUND_COLOR'} x ($width * $size) }); # Blitting a horizontal line is much faster!
3974             } else {
3975 0         0 $self->blit_write({ 'x' => $start_x, 'y' => ($y_end - ($size / 2)), 'width' => $width, 'height' => $size, 'image' => $self->{'RAW_FOREGROUND_COLOR'} x ($width * $size) }); # Blitting a horizontal line is much faster!
3976             }
3977             }
3978             } elsif ($antialiased) {
3979 0         0 $self->_draw_line_antialiased($start_x, $start_y, $x_end, $y_end);
3980             } elsif ($width > $height) { # Wider than it is high
3981 0         0 my $factor = $height / $width;
3982 0 0 0     0 if (($start_x < $x_end) && ($start_y < $y_end)) { # Draw UP and to the RIGHT
    0 0        
    0 0        
    0 0        
3983 0         0 while ($start_x < $x_end) {
3984 0         0 $self->plot({ 'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size });
3985 0         0 $start_y += $factor;
3986 0         0 $start_x++;
3987             }
3988             } elsif (($start_x > $x_end) && ($start_y < $y_end)) { # Draw UP and to the LEFT
3989 0         0 while ($start_x > $x_end) {
3990 0         0 $self->plot({ 'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size });
3991 0         0 $start_y += $factor;
3992 0         0 $start_x--;
3993             }
3994             } elsif (($start_x < $x_end) && ($start_y > $y_end)) { # Draw DOWN and to the RIGHT
3995 0         0 while ($start_x < $x_end) {
3996 0         0 $self->plot({ 'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size });
3997 0         0 $start_y -= $factor;
3998 0         0 $start_x++;
3999             }
4000             } elsif (($start_x > $x_end) && ($start_y > $y_end)) { # Draw DOWN and to the LEFT
4001 0         0 while ($start_x > $x_end) {
4002 0         0 $self->plot({ 'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size });
4003 0         0 $start_y -= $factor;
4004 0         0 $start_x--;
4005             }
4006             }
4007             } elsif ($width < $height) { # Higher than it is wide
4008 0         0 my $factor = $width / $height;
4009 0 0 0     0 if (($start_x < $x_end) && ($start_y < $y_end)) { # Draw UP and to the RIGHT
    0 0        
    0 0        
    0 0        
4010 0         0 while ($start_y < $y_end) {
4011 0         0 $self->plot({ 'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size });
4012 0         0 $start_x += $factor;
4013 0         0 $start_y++;
4014             }
4015             } elsif (($start_x > $x_end) && ($start_y < $y_end)) { # Draw UP and to the LEFT
4016 0         0 while ($start_y < $y_end) {
4017 0         0 $self->plot({ 'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size });
4018 0         0 $start_x -= $factor;
4019 0         0 $start_y++;
4020             }
4021             } elsif (($start_x < $x_end) && ($start_y > $y_end)) { # Draw DOWN and to the RIGHT
4022 0         0 while ($start_y > $y_end) {
4023 0         0 $self->plot({ 'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size });
4024 0         0 $start_x += $factor;
4025 0         0 $start_y--;
4026             }
4027             } elsif (($start_x > $x_end) && ($start_y > $y_end)) { # Draw DOWN and to the LEFT
4028 0         0 while ($start_y > $y_end) {
4029 0         0 $self->plot({ 'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size });
4030 0         0 $start_x -= $factor;
4031 0         0 $start_y--;
4032             }
4033             }
4034             } else { # $width == $height
4035 0 0 0     0 if (($start_x < $x_end) && ($start_y < $y_end)) { # Draw UP and to the RIGHT
    0 0        
    0 0        
    0 0        
4036 0         0 while ($start_y < $y_end) {
4037 0         0 $self->plot({ 'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size });
4038 0         0 $start_x++;
4039 0         0 $start_y++;
4040             }
4041             } elsif (($start_x > $x_end) && ($start_y < $y_end)) { # Draw UP and to the LEFT
4042 0         0 while ($start_y < $y_end) {
4043 0         0 $self->plot({ 'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size });
4044 0         0 $start_x--;
4045 0         0 $start_y++;
4046             }
4047             } elsif (($start_x < $x_end) && ($start_y > $y_end)) { # Draw DOWN and to the RIGHT
4048 0         0 while ($start_y > $y_end) {
4049 0         0 $self->plot({ 'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size });
4050 0         0 $start_x++;
4051 0         0 $start_y--;
4052             }
4053             } elsif (($start_x > $x_end) && ($start_y > $y_end)) { # Draw DOWN and to the LEFT
4054 0         0 while ($start_y > $y_end) {
4055 0         0 $self->plot({ 'x' => $start_x, 'y' => $start_y, 'pixel_size' => $size });
4056 0         0 $start_x--;
4057 0         0 $start_y--;
4058             }
4059             }
4060              
4061             }
4062             }
4063 0         0 $self->{'X'} = $XX;
4064 0         0 $self->{'Y'} = $YY;
4065             }
4066              
4067             sub _flush_screen {
4068             # Since the framebuffer is mappeed as a string device, Perl buffers the output, and this must be flushed.
4069 5     5   31 my $self = shift;
4070 5 50       34 unless ($self->{'DEVICE'} eq 'EMULATED') {
4071 5         83 select(STDERR);
4072 5         39 $|++;
4073             }
4074 5         58 select($self->{'FB'});
4075 5         251 $|++;
4076             }
4077              
4078             sub _adj_plot {
4079             # Part of antialiased drawing
4080 0     0   0 my $self = shift;
4081 0         0 my $x = shift;
4082 0         0 my $y = shift;
4083 0         0 my $c = shift;
4084 0         0 my $s = shift;
4085              
4086 0         0 $self->set_color({ 'red' => $s->{'red'} * $c, 'green' => $s->{'green'} * $c, 'blue' => $s->{'blue'} * $c });
4087 0         0 $self->plot({ 'x' => $x, 'y' => $y });
4088             }
4089              
4090             sub _draw_line_antialiased {
4091 0     0   0 my $self = shift;
4092 0         0 my $x0 = shift;
4093 0         0 my $y0 = shift;
4094 0         0 my $x1 = shift;
4095 0         0 my $y1 = shift;
4096              
4097 0         0 my $saved = { %{ $self->{'SET_RAW_FOREGROUND_COLOR'} } };
  0         0  
4098              
4099 0         0 my $plot = \&_adj_plot;
4100              
4101 0 0       0 if (abs($y1 - $y0) > abs($x1 - $x0)) {
4102 0     0   0 $plot = sub { _adj_plot(@_[0, 2, 1, 3, 4]) };
  0         0  
4103 0         0 ($x0, $y0, $x1, $y1) = ($y0, $x0, $y1, $x1);
4104             }
4105              
4106 0 0       0 if ($x0 > $x1) {
4107 0         0 ($x0, $x1, $y0, $y1) = ($x1, $x0, $y1, $y0);
4108             }
4109              
4110 0         0 my $dx = $x1 - $x0;
4111 0         0 my $dy = $y1 - $y0;
4112 0         0 my $gradient = $dy / $dx;
4113              
4114 0         0 my @xends;
4115             my $intery;
4116              
4117             # handle the endpoints
4118 0         0 foreach my $xy ([$x0, $y0], [$x1, $y1]) {
4119 0         0 my ($x, $y) = @{$xy};
  0         0  
4120 0         0 my $xend = int($x + 0.5); # POSIX::lround($x);
4121 0         0 my $yend = $y + $gradient * ($xend - $x);
4122 0         0 my $xgap = _rfpart($x + 0.5);
4123              
4124 0         0 my $x_pixel = $xend;
4125 0         0 my $y_pixel = int($yend);
4126 0         0 push(@xends, $x_pixel);
4127              
4128 0         0 $plot->($self, $x_pixel, $y_pixel, _rfpart($yend) * $xgap, $saved);
4129 0         0 $plot->($self, $x_pixel, $y_pixel + 1, _fpart($yend) * $xgap, $saved);
4130 0 0       0 next if (defined($intery));
4131              
4132             # first y-intersection for the main loop
4133 0         0 $intery = $yend + $gradient;
4134             }
4135              
4136             # main loop
4137              
4138 0         0 foreach my $x ($xends[0] + 1 .. $xends[1] - 1) {
4139 0         0 $plot->($self, $x, int($intery), _rfpart($intery), $saved);
4140 0         0 $plot->($self, $x, int($intery) + 1, _fpart($intery), $saved);
4141 0         0 $intery += $gradient;
4142             }
4143 0         0 $self->set_color($saved);
4144             }
4145              
4146             sub bezier {
4147             =head2 bezier
4148              
4149             Draws a Bezier curve, based on a list of control points.
4150              
4151             =over 4
4152              
4153             $fb->bezier(
4154             {
4155             'coordinates' => [
4156             x0,y0,
4157             x1,y1,
4158             ... # As many as needed
4159             ],
4160             'points' => 100, # Number of total points plotted for curve
4161             # The higher the number, the smoother the curve.
4162             'pixel_size' => 2, # optional
4163             'closed' => 1, # optional, close it and make it a full shape.
4164             'filled' => 1 # Results may vary, optional
4165             'gradient' => {
4166             'direction' => 'horizontal', # or vertical
4167             'colors' => { # 2 to any number of transitions allowed
4168             'red' => [255,255,0], # Red to yellow to cyan
4169             'green' => [0,255,255],
4170             'blue' => [0,0,255]
4171             }
4172             }
4173             }
4174             );
4175              
4176             =back
4177              
4178             * This is not affected by the Acceleration setting
4179              
4180             =cut
4181              
4182 0     0 0 0 my $self = shift;
4183 0         0 my $params = shift;
4184              
4185 0   0     0 my $size = $params->{'pixel_size'} || 1;
4186 0   0     0 my $closed = $params->{'closed'} || 0;
4187 0   0     0 my $filled = $params->{'filled'} || 0;
4188              
4189 0 0       0 push(@{ $params->{'coordinates'} }, $params->{'coordinates'}->[0], $params->{'coordinates'}->[1]) if ($closed);
  0         0  
4190              
4191 0         0 my $bezier = Math::Bezier->new($params->{'coordinates'});
4192 0   0     0 my @coords = $bezier->curve($params->{'points'} || (scalar(@{ $params->{'coordinates'} }) / 2));
4193 0 0       0 if ($closed) {
4194 0         0 $params->{'coordinates'} = \@coords;
4195 0         0 $self->polygon($params);
4196             } else {
4197 0         0 $self->plot({ 'x' => shift(@coords), 'y' => shift(@coords), 'pixel_size' => $size });
4198 0         0 while (scalar(@coords)) {
4199 0         0 $self->drawto({ 'x' => shift(@coords), 'y' => shift(@coords), 'pixel_size' => $size });
4200             }
4201             }
4202             }
4203              
4204             sub cubic_bezier {
4205             =head2 cubic_bezier
4206              
4207             DISCONTINUED, use 'bezier' instead (now just an alias to 'bezier')
4208              
4209             =cut
4210              
4211 0     0 0 0 my $self = shift;
4212 0         0 $self->bezier(shift);
4213             }
4214              
4215             sub draw_arc {
4216             =head2 draw_arc
4217              
4218             Draws an arc/pie/poly arc of a circle at point x,y.
4219              
4220             =over 4
4221              
4222             x = x of center of circle
4223             y = y of center of circle
4224             radius = radius of circle
4225              
4226             start_degrees = starting point, in degrees, of arc
4227              
4228             end_degrees = ending point, in degrees, of arc
4229              
4230             granularity = This is used for accuracy in drawing
4231             the arc. The smaller the number, the
4232             more accurate the arc is drawn, but it
4233             is also slower. Values between 0.1
4234             and 0.01 are usually good. Valid values
4235             are any positive floating point number
4236             down to 0.0001. Anything smaller than
4237             that is just silly.
4238              
4239             mode = Specifies the drawing mode.
4240             0 > arc only
4241             1 > Filled pie section
4242             Can have gradients, textures, and hatches
4243             2 > Poly arc. Draws a line from x,y to the
4244             beginning and ending arc position.
4245              
4246             $fb->draw_arc({
4247             'x' => 100,
4248             'y' => 100,
4249             'radius' => 100,
4250             'start_degrees' => -40, # Compass coordinates
4251             'end_degrees' => 80,
4252             'granularity => .05,
4253             'mode' => 2 # The object hash has 'ARC', 'PIE',
4254             # and 'POLY_ARC' as a means of filling
4255             # this value.
4256             });
4257              
4258             =back
4259              
4260             * Only PIE is affected by the acceleration setting.
4261              
4262             =cut
4263              
4264             # 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.
4265 0     0 0 0 my $self = shift;
4266 0         0 my $params = shift;
4267              
4268 0         0 my $x = int($params->{'x'});
4269 0         0 my $y = int($params->{'y'});
4270 0   0     0 my $radius = int($params->{'radius'} || 1);
4271 0         0 $radius = max($radius, 1);
4272 0   0     0 my $start_degrees = $params->{'start_degrees'} || 0;
4273 0   0     0 my $end_degrees = $params->{'end_degrees'} || 360;
4274 0   0     0 my $granularity = $params->{'granularity'} || .1;
4275              
4276 0   0     0 my $mode = int($params->{'mode'} || 0);
4277 0   0     0 my $size = int($params->{'pixel_size'} || 1);
4278 0         0 my $bytes = $self->{'BYTES'};
4279              
4280 0         0 $start_degrees -= 90;
4281 0         0 $end_degrees -= 90;
4282 0 0       0 $start_degrees += 360 if ($start_degrees < 0);
4283 0 0       0 $end_degrees += 360 if ($end_degrees < 0);
4284              
4285 0 0 0     0 unless ($self->{'ACCELERATED'} && $mode == PIE) { # ($mode == PIE || $mode == ARC)) {
4286 0         0 my ($sx, $sy, $degrees, $ox, $oy) = (0, 0, 1, 1, 1);
4287 0         0 my @coords;
4288              
4289 0         0 my $plotted = FALSE;
4290 0         0 $degrees = $start_degrees;
4291 0         0 my ($dp_cos, $dp_sin);
4292 0 0       0 if ($start_degrees > $end_degrees) {
4293 0         0 do {
4294 0         0 my $index = int($degrees * 100);
4295 0 0       0 if (defined($self->{'dp_cache'}->[$index])) {
4296 0         0 ($dp_cos, $dp_sin) = (@{ $self->{'dp_cache'}->[$index] });
  0         0  
4297             } else {
4298 0         0 my $dp = ($degrees * pi) / 180;
4299 0         0 ($dp_cos, $dp_sin) = (cos($dp), sin($dp));
4300 0         0 $self->{'dp_cache'}->[$index] = [$dp_cos, $dp_sin];
4301             }
4302 0         0 $sx = int($x - ($radius * $dp_sin));
4303 0         0 $sy = int($y - ($radius * $dp_cos));
4304 0 0 0     0 if (($sx <=> $ox) || ($sy <=> $oy)) {
4305 0 0       0 if ($mode == ARC) { # Ordinary arc
4306 0 0       0 if ($plotted) { # Fills in the gaps better this way
4307 0         0 $self->drawto({ 'x' => $sx, 'y' => $sy, 'pixel_size' => $size });
4308             } else {
4309 0         0 $self->plot({ 'x' => $sx, 'y' => $sy, 'pixel_size' => $size });
4310 0         0 $plotted = TRUE;
4311             }
4312             } else {
4313 0 0       0 if ($degrees == $start_degrees) {
4314 0         0 push(@coords, $x, $y, $sx, $sy);
4315             } else {
4316 0         0 push(@coords, $sx, $sy);
4317             }
4318             }
4319 0         0 $ox = $sx;
4320 0         0 $oy = $sy;
4321             }
4322 0         0 $degrees += $granularity;
4323             } until ($degrees >= 360);
4324 0         0 $degrees = 0;
4325             }
4326 0         0 $plotted = FALSE;
4327 0         0 do {
4328 0         0 my $index = int($degrees * 100);
4329 0 0       0 if (defined($self->{'dp_cache'}->[$index])) {
4330 0         0 ($dp_cos, $dp_sin) = (@{ $self->{'dp_cache'}->[$index] });
  0         0  
4331             } else {
4332 0         0 my $dp = ($degrees * pi) / 180;
4333 0         0 ($dp_cos, $dp_sin) = (cos($dp), sin($dp));
4334 0         0 $self->{'dp_cache'}->[$index] = [$dp_cos, $dp_sin];
4335             }
4336 0         0 $sx = int($x - ($radius * $dp_sin));
4337 0         0 $sy = int($y - ($radius * $dp_cos));
4338 0 0 0     0 if (($sx <=> $ox) || ($sy <=> $oy)) {
4339 0 0       0 if ($mode == ARC) { # Ordinary arc
4340 0 0       0 if ($plotted) { # Fills in the gaps better this way
4341 0         0 $self->drawto({ 'x' => $sx, 'y' => $sy, 'pixel_size' => $size });
4342             } else {
4343 0         0 $self->plot({ 'x' => $sx, 'y' => $sy, 'pixel_size' => $size });
4344 0         0 $plotted = TRUE;
4345             }
4346             } else { # Filled pie arc
4347 0 0       0 if ($degrees == $start_degrees) {
4348 0         0 push(@coords, $x, $y, $sx, $sy);
4349             } else {
4350 0         0 push(@coords, $sx, $sy);
4351             }
4352             }
4353 0         0 $ox = $sx;
4354 0         0 $oy = $sy;
4355             }
4356 0         0 $degrees += $granularity;
4357             } until ($degrees >= $end_degrees);
4358 0 0       0 if ($mode != ARC) {
4359 0 0       0 $params->{'filled'} = ($mode == PIE) ? TRUE : FALSE;
4360 0         0 $params->{'coordinates'} = \@coords;
4361 0         0 $self->polygon($params);
4362             }
4363 0         0 ($self->{'X'}, $self->{'Y'}) = ($sx, $sy);
4364              
4365             } else {
4366 0         0 my $w = ($radius * 2);
4367 0         0 my $pattern;
4368 0         0 my $saved = {
4369             'x' => $x - $radius,
4370             'y' => $y - $radius,
4371             'width' => $w,
4372             'height' => $w,
4373             'image' => '',
4374             };
4375 0         0 my $draw_mode;
4376             my $image;
4377 0         0 my $fill;
4378              
4379 0         0 eval { # Imager can crash.
4380 0         0 my $img = Imager->new(
4381             'xsize' => $w,
4382             'ysize' => $w,
4383             'raw_datachannels' => max(3, $bytes),
4384             'raw_storechannels' => max(3, $bytes),
4385             'channels' => max(3, $bytes),
4386             'raw_interleave' => 0,
4387             );
4388 0 0       0 unless ($self->{'DRAW_MODE'}) {
4389 0 0       0 if ($self->{'ACCELERATED'}) {
4390 0         0 $draw_mode = $self->{'DRAW_MODE'};
4391 0         0 $self->{'DRAW_MODE'} = MASK_MODE;
4392             } else {
4393 0         0 $saved = $self->blit_read($saved);
4394 0 0       0 $saved->{'image'} = $self->_convert_16_to_24($saved->{'image'}, RGB) if ($self->{'BITS'} == 16);
4395             $img->read(
4396             'xsize' => $w,
4397             'ysize' => $w,
4398             'raw_datachannels' => max(3, $bytes),
4399             'raw_storechannels' => max(3, $bytes),
4400             'channels' => max(3, $bytes),
4401             'raw_interleave' => 0,
4402 0         0 'data' => $saved->{'image'},
4403             'type' => 'raw',
4404             'allow_incomplete' => 1
4405             );
4406             }
4407             }
4408             my %p = (
4409             'x' => $radius,
4410             'y' => $radius,
4411             'd1' => $start_degrees,
4412             'd2' => $end_degrees,
4413             'r' => $radius,
4414             'filled' => TRUE,
4415 0         0 'color' => $self->{'IMAGER_FOREGROUND_COLOR'},
4416             );
4417 0 0       0 if (exists($params->{'hatch'})) {
    0          
    0          
4418             $fill = Imager::Fill->new(
4419             'hatch' => $params->{'hatch'} || 'dots16',
4420             'fg' => $self->{'IMAGER_FOREGROUND_COLOR'},
4421 0   0     0 'bg' => $self->{'IMAGER_BACKGROUND_COLOR'}
4422             );
4423 0         0 $p{'fill'} = $fill;
4424             } elsif (exists($params->{'texture'})) {
4425 0         0 $pattern = $self->_generate_fill($w, $w, undef, $params->{'texture'});
4426 0 0       0 $pattern = $self->_convert_16_to_24($pattern, RGB) if ($self->{'BITS'} == 16);
4427 0         0 $image = Imager->new(
4428             'xsize' => $w,
4429             'ysize' => $w,
4430             'raw_datachannels' => max(3, $bytes),
4431             'raw_storechannels' => max(3, $bytes),
4432             'raw_interleave' => 0,
4433             );
4434 0         0 $image->read(
4435             'xsize' => $w,
4436             'ysize' => $w,
4437             'raw_datachannels' => max(3, $bytes),
4438             'raw_storechannels' => max(3, $bytes),
4439             'raw_interleave' => 0,
4440             'data' => $pattern,
4441             'type' => 'raw',
4442             'allow_incomplete' => 1
4443             );
4444 0         0 $p{'fill'}->{'image'} = $image;
4445             } elsif (exists($params->{'gradient'})) {
4446 0 0       0 if (exists($params->{'gradient'}->{'colors'})) {
4447 0   0     0 $pattern = $self->_generate_fill($w, $w, $params->{'gradient'}->{'colors'}, $params->{'gradient'}->{'direction'} || 'vertical');
4448             } else {
4449             $pattern = $self->_generate_fill(
4450             $w, $w,
4451             {
4452             'red' => [$params->{'gradient'}->{'start'}->{'red'}, $params->{'gradient'}->{'end'}->{'red'}],
4453             'green' => [$params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}],
4454             'blue' => [$params->{'gradient'}->{'start'}->{'blue'}, $params->{'gradient'}->{'end'}->{'blue'}],
4455             'alpha' => (exists($params->{'gradient'}->{'start'}->{'alpha'})) ? [$params->{'gradient'}->{'start'}->{'alpha'},$params->{'gradient'}->{'end'}->{'alpha'}] : [$self->{'COLOR_ALPHA'},$self->{'COLOR_ALPHA'}],
4456             },
4457 0 0 0     0 $params->{'gradient'}->{'direction'} || 'vertical'
4458             );
4459             }
4460 0 0       0 $pattern = $self->_convert_16_to_24($pattern, RGB) if ($self->{'BITS'} == 16);
4461 0         0 $image = Imager->new(
4462             'xsize' => $w,
4463             'ysize' => $w,
4464             'raw_datachannels' => max(3, $bytes),
4465             'raw_storechannels' => max(3, $bytes),
4466             'raw_interleave' => 0,
4467             );
4468 0         0 $image->read(
4469             'xsize' => $w,
4470             'ysize' => $w,
4471             'raw_datachannels' => max(3, $bytes),
4472             'raw_storechannels' => max(3, $bytes),
4473             'raw_interleave' => 0,
4474             'data' => $pattern,
4475             'type' => 'raw',
4476             'allow_incomplete' => 1
4477             );
4478 0         0 $p{'fill'}->{'image'} = $image;
4479             }
4480 0         0 $img->arc(%p);
4481             $img->write(
4482             'type' => 'raw',
4483             'datachannels' => max(3, $bytes),
4484             'storechannels' => max(3, $bytes),
4485             'interleave' => 0,
4486 0         0 'data' => \$saved->{'image'},
4487             );
4488 0 0       0 $saved->{'image'} = $self->_convert_24_to_16($saved->{'image'}, RGB) if ($self->{'BITS'} == 16);
4489             };
4490 0 0 0     0 warn __LINE__ . " $@\n", Imager->errstr() if ($@ && $self->{'SHOW_ERRORS'});
4491 0         0 $self->blit_write($saved);
4492 0 0       0 $self->{'DRAW_MODE'} = $draw_mode if (defined($draw_mode));
4493             }
4494             }
4495              
4496             sub arc {
4497             =head2 arc
4498              
4499             Draws an arc of a circle at point x,y. This is an alias to draw_arc above, but no mode parameter needed.
4500              
4501             =over 4
4502              
4503             x = x of center of circle
4504              
4505             y = y of center of circle
4506              
4507             radius = radius of circle
4508              
4509             start_degrees = starting point, in degrees, of arc
4510              
4511             end_degrees = ending point, in degrees, of arc
4512              
4513             granularity = This is used for accuracy in drawing
4514             the arc. The smaller the number, the
4515             more accurate the arc is drawn, but it
4516             is also slower. Values between 0.1
4517             and 0.01 are usually good. Valid values
4518             are any positive floating point number
4519             down to 0.0001.
4520              
4521             $fb->arc({
4522             'x' => 100,
4523             'y' => 100,
4524             'radius' => 100,
4525             'start_degrees' => -40,
4526             'end_degrees' => 80,
4527             'granularity => .05,
4528             });
4529              
4530             =back
4531              
4532             * This is not affected by the Acceleration setting
4533              
4534             =cut
4535              
4536 0     0 0 0 my $self = shift;
4537 0         0 my $params = shift;
4538              
4539 0         0 $params->{'mode'} = ARC;
4540 0         0 $self->draw_arc($params);
4541             }
4542              
4543             sub filled_pie {
4544             =head2 filled_pie
4545              
4546             Draws a filled pie wedge at point x,y. This is an alias to draw_arc above, but no mode parameter needed.
4547              
4548             =over 4
4549              
4550             x = x of center of circle
4551              
4552             y = y of center of circle
4553              
4554             radius = radius of circle
4555              
4556             start_degrees = starting point, in degrees, of arc
4557              
4558             end_degrees = ending point, in degrees, of arc
4559              
4560             granularity = This is used for accuracy in drawing
4561             the arc. The smaller the number, the
4562             more accurate the arc is drawn, but it
4563             is also slower. Values between 0.1
4564             and 0.01 are usually good. Valid values
4565             are any positive floating point number
4566             down to 0.0001.
4567              
4568             $fb->filled_pie({
4569             'x' => 100,
4570             'y' => 100,
4571             'radius' => 100,
4572             'start_degrees' => -40,
4573             'end_degrees' => 80,
4574             'granularity' => .05,
4575             'gradient' => { # optional
4576             'direction' => 'horizontal', # or vertical
4577             'colors' => { # 2 to any number of transitions allowed
4578             'red' => [255,255,0], # Red to yellow to cyan
4579             'green' => [0,255,255],
4580             'blue' => [0,0,255],
4581             'alpha' => [255,255,255],
4582             }
4583             },
4584             'texture' => { # Same as what blit_read or load_image returns
4585             'width' => 320,
4586             'height' => 240,
4587             'image' => $raw_image_data
4588             },
4589             'hatch' => 'hatchname' # The exported array @HATCHES contains
4590             # the names of all the hatches
4591             });
4592              
4593             =back
4594              
4595             * This is affected by the Acceleration setting
4596              
4597             =cut
4598              
4599 0     0 0 0 my $self = shift;
4600 0         0 my $params = shift;
4601              
4602 0         0 $params->{'mode'} = PIE;
4603 0         0 $self->draw_arc($params);
4604             }
4605              
4606             sub poly_arc {
4607             =head2 poly_arc
4608              
4609             Draws a poly arc of a circle at point x,y. This is an alias to draw_arc above, but no mode parameter needed.
4610              
4611             =over 4
4612              
4613             x = x of center of circle
4614              
4615             y = y of center of circle
4616              
4617             radius = radius of circle
4618              
4619             start_degrees = starting point, in degrees, of arc
4620              
4621             end_degrees = ending point, in degrees, of arc
4622              
4623             granularity = This is used for accuracy in drawing
4624             the arc. The smaller the number, the
4625             more accurate the arc is drawn, but it
4626             is also slower. Values between 0.1
4627             and 0.01 are usually good. Valid values
4628             are any positive floating point number
4629             down to 0.0001.
4630              
4631             $fb->poly_arc({
4632             'x' => 100,
4633             'y' => 100,
4634             'radius' => 100,
4635             'start_degrees' => -40,
4636             'end_degrees' => 80,
4637             'granularity' => .05,
4638             });
4639              
4640             =back
4641              
4642             * This is not affected by the Acceleration setting
4643              
4644             =cut
4645              
4646 0     0 0 0 my $self = shift;
4647 0         0 my $params = shift;
4648              
4649 0         0 $params->{'mode'} = POLY_ARC;
4650 0         0 $self->draw_arc($params);
4651             }
4652              
4653             sub ellipse {
4654             =head2 ellipse
4655              
4656             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.
4657              
4658             =over 4
4659              
4660             $fb->ellipse({
4661             'x' => 200, # Horizontal center
4662             'y' => 250, # Vertical center
4663             'xradius' => 50,
4664             'yradius' => 100,
4665             'factor' => 1, # Anything other than 1 has funkiness
4666             'pixel_size' => 4, # optional
4667             'filled' => 1, # optional
4668              
4669             ## Only one of the following may be used
4670              
4671             'gradient' => { # optional, but 'filled' must be set
4672             'direction' => 'horizontal', # or vertical
4673             'colors' => { # 2 to any number of transitions allowed
4674             'red' => [255,255,0], # Red to yellow to cyan
4675             'green' => [0,255,255],
4676             'blue' => [0,0,255],
4677             'alpha' => [255,255,255],
4678             }
4679             }
4680             'texture' => { # Same format blit_read or load_image uses.
4681             'width' => 320,
4682             'height' => 240,
4683             'image' => $raw_image_data
4684             },
4685             'hatch' => 'hatchname' # The exported array @HATCHES contains
4686             # the names of all the hatches
4687             });
4688              
4689             =back
4690              
4691             * This is not affected by the Acceleration setting
4692              
4693             =cut
4694              
4695             # 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.
4696 0     0 0 0 my $self = shift;
4697 0         0 my $params = shift;
4698              
4699 0         0 my $cx = int($params->{'x'});
4700 0         0 my $cy = int($params->{'y'});
4701 0   0     0 my $XRadius = int($params->{'xradius'} || 1);
4702 0   0     0 my $YRadius = int($params->{'yradius'} || 1);
4703              
4704 0 0       0 $XRadius = 1 if ($XRadius < 1);
4705 0 0       0 $YRadius = 1 if ($YRadius < 1);
4706              
4707 0   0     0 my $filled = int($params->{'filled'} || 0);
4708 0   0     0 my $fact = $params->{'factor'} || 1;
4709 0   0     0 my $size = int($params->{'pixel_size'} || 1);
4710 0 0       0 $size = 1 if ($filled);
4711              
4712 0         0 my ($old_cyy, $old_cy_y) = (0, 0);
4713 0 0       0 if ($fact == 0) { # We don't allow zero values for this
4714 0         0 $fact = 1;
4715             }
4716 0         0 my $xsq = $XRadius * $XRadius;
4717 0         0 my $ysq = $YRadius * $YRadius;
4718 0         0 my $TwoASquare = (2 * $xsq) * $fact;
4719 0         0 my $TwoBSquare = (2 * $ysq) * $fact;
4720 0         0 my $x = $XRadius;
4721 0         0 my $y = 0;
4722 0         0 my $XChange = $ysq * (1 - (2 * $XRadius));
4723 0         0 my $YChange = $xsq;
4724 0         0 my $EllipseError = 0;
4725 0         0 my $StoppingX = $TwoBSquare * $XRadius;
4726 0         0 my $StoppingY = 0;
4727 0 0       0 my $history_on = (exists($self->{'history'})) ? TRUE : FALSE;
4728              
4729             # The history prevents double drawing
4730 0 0 0     0 $self->{'history'} = {} unless ($history_on || !$filled || $size > 1);
      0        
4731 0         0 my ($red, $green, $blue, $pattern, $plen, @rc, @gc, @bc);
4732 0         0 my $gradient = FALSE;
4733 0         0 my $saved = $self->{'RAW_FOREGROUND_COLOR'};
4734 0         0 my $xdiameter = $XRadius * 2;
4735 0         0 my $ydiameter = $YRadius * 2;
4736 0         0 my $bytes = $self->{'BYTES'};
4737 0 0       0 if (exists($params->{'gradient'})) {
    0          
    0          
4738 0 0       0 if ($params->{'gradient'}->{'direction'} !~ /vertical/i) {
4739 0 0       0 if (exists($params->{'gradient'}->{'colors'})) {
4740 0         0 $pattern = $self->_generate_fill($xdiameter, $ydiameter, $params->{'gradient'}->{'colors'}, 'horizontal');
4741             } else {
4742             $pattern = $self->_generate_fill(
4743             $xdiameter,
4744             $ydiameter,
4745             {
4746             'red' => [$params->{'gradient'}->{'start'}->{'red'}, $params->{'gradient'}->{'end'}->{'red'}],
4747             'green' => [$params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}],
4748             'blue' => [$params->{'gradient'}->{'start'}->{'blue'}, $params->{'gradient'}->{'end'}->{'blue'}],
4749 0 0       0 'alpha' => (exists($params->{'gradient'}->{'start'}->{'alpha'})) ? [$params->{'gradient'}->{'start'}->{'alpha'},$params->{'gradient'}->{'end'}->{'alpha'}] : [$self->{'COLOR_ALPHA'},$self->{'COLOR_ALPHA'}],
4750             },
4751             'horizontal'
4752             );
4753             }
4754 0         0 $plen = length($pattern);
4755 0         0 $gradient = 2;
4756             } else {
4757 0         0 my $ydiameter = $YRadius * 2;
4758 0 0       0 if (exists($params->{'gradient'}->{'colors'})) {
4759 0         0 @rc = multi_gradient($ydiameter, @{ $params->{'gradient'}->{'colors'}->{'red'} });
  0         0  
4760 0         0 @gc = multi_gradient($ydiameter, @{ $params->{'gradient'}->{'colors'}->{'green'} });
  0         0  
4761 0         0 @bc = multi_gradient($ydiameter, @{ $params->{'gradient'}->{'colors'}->{'blue'} });
  0         0  
4762 0 0       0 if (exists($params->{'gradient'}->{'colors'}->{'alpha'})) {
4763 0         0 @ac = multi_gradient($ydiameter, @{ $params->{'gradient'}->{'colors'}->{'alpha'} });
  0         0  
4764             } else {
4765 0         0 @ac = map {$_ = $self->{'COLOR_ALPHA'}} (1..(scalar(@bc)));
  0         0  
4766             }
4767             } else {
4768 0         0 @rc = gradient($params->{'gradient'}->{'start'}->{'red'}, $params->{'gradient'}->{'end'}->{'red'}, $ydiameter);
4769 0         0 @gc = gradient($params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}, $ydiameter);
4770 0         0 @bc = gradient($params->{'gradient'}->{'start'}->{'blue'}, $params->{'gradient'}->{'end'}->{'blue'}, $ydiameter);
4771 0 0       0 if (exists($params->{'gradient'}->{'start'}->{'alpha'})) {
4772 0         0 @ac = gradient($params->{'gradient'}->{'start'}->{'alpha'}, $params->{'gradient'}->{'end'}->{'alpha'}, $ydiameter);
4773             } else {
4774 0         0 @ac = map {$_ = $self->{'COLOR_ALPHA'}} (1..2);
  0         0  
4775             }
4776             }
4777 0         0 $gradient = 1;
4778             }
4779             } elsif (exists($params->{'texture'})) {
4780 0         0 $pattern = $self->_generate_fill($xdiameter, $ydiameter, undef, $params->{'texture'});
4781 0         0 $gradient = 2;
4782             } elsif (exists($params->{'hatch'})) {
4783 0         0 $pattern = $self->_generate_fill($xdiameter, $ydiameter, undef, $params->{'hatch'});
4784 0         0 $gradient = 2;
4785             }
4786              
4787 0         0 my $left = $cx - $XRadius;
4788 0         0 while ($StoppingX >= $StoppingY) {
4789 0         0 my $cxx = int($cx + $x);
4790 0         0 my $cx_x = int($cx - $x);
4791 0         0 my $cyy = int($cy + $y);
4792 0         0 my $cy_y = int($cy - $y);
4793 0         0 my $rpy = $YRadius + $y;
4794 0         0 my $rmy = $YRadius - $y;
4795              
4796 0 0       0 if ($filled) {
4797 0 0       0 if ($cyy <=> $old_cyy) {
4798 0 0       0 if ($gradient == 2) {
4799 0         0 my $wd = max($cx_x, $cxx) - min($cxx, $cx_x);
4800 0         0 $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)) });
4801             } else {
4802 0 0       0 if ($gradient) {
4803 0         0 $self->set_color({ 'red' => $rc[$rpy], 'green' => $gc[$rpy], 'blue' => $bc[$rpy] });
4804             }
4805 0         0 $self->line({ 'x' => $cxx, 'y' => $cyy, 'xx' => $cx_x, 'yy' => $cyy });
4806             }
4807 0         0 $old_cyy = $cyy;
4808             }
4809 0 0 0     0 if (($cy_y <=> $old_cy_y) && ($cyy <=> $cy_y)) {
4810 0 0       0 if ($gradient == 2) {
4811 0         0 my $wd = max($cx_x, $cxx) - min($cxx, $cx_x);
4812 0         0 $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)) });
4813             } else {
4814 0 0       0 if ($gradient) {
4815 0         0 $self->set_color({ 'red' => $rc[$rmy], 'green' => $gc[$rmy], 'blue' => $bc[$rmy] });
4816             }
4817 0         0 $self->line({ 'x' => $cx_x, 'y' => $cy_y, 'xx' => $cxx, 'yy' => $cy_y });
4818             }
4819 0         0 $old_cy_y = $cy_y;
4820             }
4821             } else {
4822 0         0 $self->plot({ 'x' => $cxx, 'y' => $cyy, 'pixel_size' => $size });
4823 0         0 $self->plot({ 'x' => $cx_x, 'y' => $cyy, 'pixel_size' => $size });
4824 0 0       0 $self->plot({ 'x' => $cx_x, 'y' => $cy_y, 'pixel_size' => $size }) if (int($cyy) <=> int($cy_y));
4825 0 0       0 $self->plot({ 'x' => $cxx, 'y' => $cy_y, 'pixel_size' => $size }) if (int($cyy) <=> int($cy_y));
4826             }
4827 0         0 $y++;
4828 0         0 $StoppingY += $TwoASquare;
4829 0         0 $EllipseError += $YChange;
4830 0         0 $YChange += $TwoASquare;
4831 0 0       0 if ((($EllipseError * 2) + $XChange) > 0) {
4832 0         0 $x--;
4833 0         0 $StoppingX -= $TwoBSquare;
4834 0         0 $EllipseError += $XChange;
4835 0         0 $XChange += $TwoBSquare;
4836             }
4837             }
4838 0         0 $x = 0;
4839 0         0 $y = $YRadius;
4840 0         0 $XChange = $ysq;
4841 0         0 $YChange = $xsq * (1 - 2 * $YRadius);
4842 0         0 $EllipseError = 0;
4843 0         0 $StoppingX = 0;
4844 0         0 $StoppingY = $TwoASquare * $YRadius;
4845              
4846 0         0 while ($StoppingX <= $StoppingY) {
4847 0         0 my $cxx = int($cx + $x);
4848 0         0 my $cx_x = int($cx - $x);
4849 0         0 my $cyy = int($cy + $y);
4850 0         0 my $cy_y = int($cy - $y);
4851 0         0 my $rpy = $YRadius + $y;
4852 0         0 my $rmy = $YRadius - $y;
4853 0 0       0 if ($filled) {
4854 0 0       0 if ($cyy <=> $old_cyy) {
4855 0 0       0 if ($gradient == 2) {
4856 0         0 my $wd = max($cx_x, $cxx) - min($cxx, $cx_x);
4857 0         0 $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)) });
4858             } else {
4859 0 0       0 if ($gradient) {
4860 0         0 $self->set_color({ 'red' => $rc[$rpy], 'green' => $gc[$rpy], 'blue' => $bc[$rpy] });
4861             }
4862 0         0 $self->line({ 'x' => $cxx, 'y' => $cyy, 'xx' => $cx_x, 'yy' => $cyy });
4863             }
4864 0         0 $old_cyy = $cyy;
4865             }
4866 0 0 0     0 if (($cy_y <=> $old_cy_y) && ($cyy <=> $cy_y)) {
4867 0 0       0 if ($gradient == 2) {
4868 0         0 my $wd = max($cx_x, $cxx) - min($cxx, $cx_x);
4869 0         0 $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)) });
4870             } else {
4871 0 0       0 if ($gradient) {
4872 0         0 $self->set_color({ 'red' => $rc[$rmy], 'green' => $gc[$rmy], 'blue' => $bc[$rmy] });
4873             }
4874 0         0 $self->line({ 'x' => $cx_x, 'y' => $cy_y, 'xx' => $cxx, 'yy' => $cy_y });
4875             }
4876 0         0 $old_cy_y = $cy_y;
4877             }
4878             } else {
4879 0         0 $self->plot({ 'x' => $cxx, 'y' => $cyy, 'pixel_size' => $size });
4880 0 0       0 $self->plot({ 'x' => $cx_x, 'y' => $cyy, 'pixel_size' => $size }) if (int($cxx) <=> int($cx_x));
4881 0 0       0 $self->plot({ 'x' => $cx_x, 'y' => $cy_y, 'pixel_size' => $size }) if (int($cxx) <=> int($cx_x));
4882 0         0 $self->plot({ 'x' => $cxx, 'y' => $cy_y, 'pixel_size' => $size });
4883             }
4884 0         0 $x++;
4885 0         0 $StoppingX += $TwoBSquare;
4886 0         0 $EllipseError += $XChange;
4887 0         0 $XChange += $TwoBSquare;
4888 0 0       0 if ((($EllipseError * 2) + $YChange) > 0) {
4889 0         0 $y--;
4890 0         0 $StoppingY -= $TwoASquare;
4891 0         0 $EllipseError += $YChange;
4892 0         0 $YChange += $TwoASquare;
4893             }
4894             }
4895 0 0 0     0 delete($self->{'history'}) if (exists($self->{'history'}) && !$history_on);
4896 0         0 $self->{'RAW_FOREGROUND_COLOR'} = $saved;
4897             }
4898              
4899             sub circle {
4900             =head2 circle
4901              
4902             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.
4903              
4904             =over 4
4905              
4906             $fb->circle({
4907             'x' => 300, # Horizontal center
4908             'y' => 300, # Vertical center
4909             'radius' => 100,
4910             'filled' => 1, # optional
4911             'gradient' => { # optional
4912             'direction' => 'horizontal', # or vertical
4913             'colors' => { # 2 to any number of transitions allowed
4914             'red' => [255,255,0], # Red to yellow to cyan
4915             'green' => [0,255,255],
4916             'blue' => [0,0,255],
4917             'alpha' => [255,255,255],
4918             }
4919             },
4920             'texture' => { # Same as what blit_read or load_image returns
4921             'width' => 320,
4922             'height' => 240,
4923             'image' => $raw_image_data
4924             },
4925             'hatch' => 'hatchname' # The exported array @HATCHES contains
4926             # the names of all the hatches
4927             });
4928              
4929             =back
4930              
4931             * This is affected by the Acceleration setting
4932              
4933             =cut
4934              
4935             # This also doubles as the rounded box routine.
4936              
4937 0     0 0 0 my $self = shift;
4938 0         0 my $params = shift;
4939              
4940 0         0 my $x0 = int($params->{'x'});
4941 0         0 my $y0 = int($params->{'y'});
4942 0   0     0 my $x1 = int($params->{'xx'}) || $x0;
4943 0   0     0 my $y1 = int($params->{'yy'}) || $y0;
4944 0   0     0 my $bx = int($params->{'bx'}) || 0;
4945 0   0     0 my $by = int($params->{'by'}) || 0;
4946 0   0     0 my $bxx = int($params->{'bxx'}) || 1;
4947 0   0     0 my $byy = int($params->{'byy'}) || 1;
4948 0         0 my $r = int($params->{'radius'});
4949 0   0     0 my $filled = $params->{'filled'} || FALSE;
4950 0 0       0 my $gradient = (defined($params->{'gradient'})) ? TRUE : FALSE;
4951 0   0     0 my $size = $params->{'pixel_size'} || 1;
4952 0         0 my $start = $y0 - $r;
4953 0         0 my $x = $r;
4954 0         0 my $y = 0;
4955 0         0 my $decisionOver2 = 1 - $x;
4956 0         0 my (@rc, @gc, @bc, @ac);
4957              
4958 0 0       0 ($x0, $x1) = ($x1, $x0) if ($x0 > $x1);
4959 0 0       0 ($y0, $y1) = ($y1, $y0) if ($y0 > $y1);
4960 0         0 my $_x = $x0 - $r;
4961 0         0 my $_xx = $x1 + $r;
4962 0         0 my $_y = $y0 - $r;
4963 0         0 my $_yy = $y1 + $r;
4964 0         0 my $xstart = $_x;
4965              
4966 0         0 my @coords;
4967 0         0 my $saved = $self->{'RAW_FOREGROUND_COLOR'};
4968 0         0 my $W = $r * 2;
4969 0         0 my $count = $W + abs($y1 - $y0);
4970 0         0 my $pattern;
4971 0         0 my $wdth = $_xx - $_x;
4972 0         0 my $hgth = $_yy - $_y;
4973 0         0 my $bytes = $self->{'BYTES'};
4974 0         0 my $plen = $wdth * $bytes;
4975 0         0 $self->{'history'} = {};
4976              
4977 0 0       0 if ($gradient) {
    0          
    0          
4978 0 0 0     0 $W = $bxx - $bx unless ($x0 == $x1 && $y0 == $y1);
4979 0 0       0 if (exists($params->{'gradient'}->{'colors'})) {
4980 0         0 $pattern = $self->_generate_fill($wdth, $hgth, $params->{'gradient'}->{'colors'}, $params->{'gradient'}->{'direction'});
4981             } else {
4982             $pattern = $self->_generate_fill(
4983             $wdth, $hgth,
4984             {
4985             'red' => [$params->{'gradient'}->{'start'}->{'red'}, $params->{'gradient'}->{'end'}->{'red'}],
4986             'green' => [$params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}],
4987             'blue' => [$params->{'gradient'}->{'start'}->{'blue'}, $params->{'gradient'}->{'end'}->{'blue'}],
4988             'alpha' => (exists($params->{'gradient'}->{'start'}->{'alpha'})) ? [$params->{'gradient'}->{'start'}->{'alpha'},$params->{'gradient'}->{'end'}->{'alpha'}] : [$self->{'COLOR_ALPHA'},$self->{'COLOR_ALPHA'}],
4989             },
4990 0 0       0 $params->{'gradient'}->{'direction'}
4991             );
4992             }
4993 0         0 $plen = $wdth * $bytes;
4994 0         0 $gradient = 2;
4995             } elsif (exists($params->{'texture'})) {
4996 0         0 $pattern = $self->_generate_fill($wdth, $hgth, undef, $params->{'texture'});
4997 0         0 $gradient = 2;
4998             } elsif (exists($params->{'hatch'})) {
4999 0         0 $pattern = $self->_generate_fill($wdth, $hgth, undef, $params->{'hatch'});
5000 0         0 $gradient = 2;
5001             }
5002 0         0 my ($ymy, $lymy, $ymx, $lymx, $ypy, $lypy, $ypx, $lypx, $xmy, $xmx, $xpy, $xpx);
5003 0         0 while ($x >= ($y - 1)) {
5004 0         0 $ymy = $y0 - $y; # Top
5005 0         0 $ymx = $y0 - $x;
5006 0         0 $ypy = $y1 + $y; # Bottom
5007 0         0 $ypx = $y1 + $x;
5008 0         0 $xmy = $x0 - $y; # Left
5009 0         0 $xmx = $x0 - $x;
5010 0         0 $xpy = $x1 + $y; # Right
5011 0         0 $xpx = $x1 + $x;
5012              
5013 0 0       0 if ($filled) {
5014 0         0 my $ymy_i = $ymy - $start;
5015 0         0 my $ymx_i = $ymx - $start;
5016 0         0 my $ypy_i = $ypy - $start;
5017 0         0 my $ypx_i = $ypx - $start;
5018              
5019 0 0       0 if ($gradient == 2) {
    0          
5020 0         0 my $fxmy = $xmy;
5021 0         0 my $fxmx = $xmx;
5022 0         0 my $fxpy = $xpy;
5023 0         0 my $fxpx = $xpx;
5024              
5025             # Top
5026 0         0 my $fwd = $fxpx - $fxmx;
5027 0         0 my $wd = $xpx - $xmx;
5028 0 0 0     0 if ($ymy != $lymy && $ymy != $lymx && $ymy != $lypx && $ymy != $lypy) {
      0        
      0        
5029 0         0 ($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));
5030 0         0 $self->blit_write($params);
5031             }
5032              
5033 0         0 $fwd = $fxpy - $fxmy;
5034 0         0 $wd = $xpy - $xmy;
5035 0 0 0     0 if ($ymx != $lymx && $ymx != $lymy && $ymx != $lypx && $ymx != $lypy) {
      0        
      0        
5036 0         0 ($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));
5037 0         0 $self->blit_write($params);
5038             }
5039              
5040             # Bottom
5041 0         0 $fwd = $fxpx - $fxmx;
5042 0         0 $wd = $xpx - $xmx;
5043 0 0 0     0 if ($ypy != $lypy && $ypy != $lypx && $ypy != $lymy && $ypy != $lymx) {
      0        
      0        
5044 0         0 ($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));
5045 0         0 $self->blit_write($params);
5046             }
5047              
5048 0         0 $fwd = $fxpy - $fxmy;
5049 0         0 $wd = $xpy - $xmy;
5050 0 0 0     0 if ($ypx != $lypx && $ypx != $lypy && $ypx != $lymx && $ypx != $lymy) {
      0        
      0        
5051 0         0 ($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));
5052 0         0 $self->blit_write($params);
5053             }
5054             } elsif ($gradient) {
5055             # Top
5056 0 0 0     0 if ($ymy != $lymy && $ymy != $lymx && $ymy != $lypx && $ymy != $lypy) {
      0        
      0        
5057 0         0 $self->set_color({ 'red' => $rc[$ymy_i], 'green' => $gc[$ymy_i], 'blue' => $bc[$ymy_i] });
5058 0         0 ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmx, $ymy, $xpx, $ymy);
5059 0         0 $self->line($params);
5060             }
5061 0 0 0     0 if ($ymx != $lymx && $ymx != $lymy && $ymx != $lypx && $ymx != $lypy) {
      0        
      0        
5062 0         0 $self->set_color({ 'red' => $rc[$ymx_i], 'green' => $gc[$ymx_i], 'blue' => $bc[$ymx_i] });
5063 0         0 ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmy, $ymx, $xpy, $ymx);
5064 0         0 $self->line($params);
5065             }
5066              
5067             # Bottom
5068 0 0 0     0 if ($ypy != $lypy && $ypy != $lypx && $ypy != $lymy && $ypy != $lymx) {
      0        
      0        
5069 0         0 $self->set_color({ 'red' => $rc[$ypy_i], 'green' => $gc[$ypy_i], 'blue' => $bc[$ypy_i] });
5070 0         0 ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmx, $ypy, $xpx, $ypy);
5071 0         0 $self->line($params);
5072             }
5073 0 0 0     0 if ($ypx != $lypx && $ypx != $lypy && $ypx != $lymx && $ypx != $lymy) {
      0        
      0        
5074 0         0 $self->set_color({ 'red' => $rc[$ypx_i], 'green' => $gc[$ypx_i], 'blue' => $bc[$ypx_i] });
5075 0         0 ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmy, $ypx, $xpy, $ypx);
5076 0         0 $self->line($params);
5077             }
5078             } else {
5079             # Top
5080 0 0 0     0 if ($ymy != $lymy && $ymy != $lymx && $ymy != $lypx && $ymy != $lypy) {
      0        
      0        
5081 0         0 ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmx, $ymy, $xpx, $ymy);
5082 0         0 $self->line($params);
5083             }
5084 0 0 0     0 if ($ymx != $lymx && $ymx != $lymy && $ymx != $lypx && $ymx != $lypy) {
      0        
      0        
5085 0         0 ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmy, $ymx, $xpy, $ymx);
5086 0         0 $self->line($params);
5087             }
5088              
5089             # Bottom
5090 0 0 0     0 if ($ypy != $lypy && $ypy != $lypx && $ypy != $lymy && $ypy != $lymx) {
      0        
      0        
5091 0         0 ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmx, $ypy, $xpx, $ypy);
5092 0         0 $self->line($params);
5093             }
5094 0 0 0     0 if ($ypx != $lypx && $ypx != $lypy && $ypx != $lymx && $ypx != $lymy) {
      0        
      0        
5095 0         0 ($params->{'x'}, $params->{'y'}, $params->{'xx'}, $params->{'yy'}) = ($xmy, $ypx, $xpy, $ypx);
5096 0         0 $self->line($params);
5097             }
5098             }
5099 0         0 $lymy = $ymy;
5100 0         0 $lymx = $ymx;
5101 0         0 $lypy = $ypy;
5102 0         0 $lypx = $ypx;
5103             } else {
5104             # Top left
5105 0         0 ($params->{'x'}, $params->{'y'}) = ($xmx, $ymy);
5106 0         0 $self->plot($params);
5107 0         0 ($params->{'x'}, $params->{'y'}) = ($xmy, $ymx);
5108 0         0 $self->plot($params);
5109              
5110             # Top right
5111 0         0 ($params->{'x'}, $params->{'y'}) = ($xpx, $ymy);
5112 0         0 $self->plot($params);
5113 0         0 ($params->{'x'}, $params->{'y'}) = ($xpy, $ymx);
5114 0         0 $self->plot($params);
5115              
5116             # Bottom right
5117 0         0 ($params->{'x'}, $params->{'y'}) = ($xpx, $ypy);
5118 0         0 $self->plot($params);
5119 0         0 ($params->{'x'}, $params->{'y'}) = ($xpy, $ypx);
5120 0         0 $self->plot($params);
5121              
5122             # Bottom left
5123 0         0 ($params->{'x'}, $params->{'y'}) = ($xmx, $ypy);
5124 0         0 $self->plot($params);
5125 0         0 ($params->{'x'}, $params->{'y'}) = ($xmy, $ypx);
5126 0         0 $self->plot($params);
5127              
5128 0         0 $lymy = $ymy;
5129 0         0 $lymx = $ymx;
5130 0         0 $lypy = $ypy;
5131 0         0 $lypx = $ypx;
5132             }
5133 0         0 $y++;
5134 0 0       0 if ($decisionOver2 <= 0) {
5135 0         0 $decisionOver2 += 2 * $y + 1;
5136             } else {
5137 0         0 $x--;
5138 0         0 $decisionOver2 += 2 * ($y - $x) + 1;
5139             }
5140             }
5141 0 0 0     0 unless ($x0 == $x1 && $y0 == $y1) {
5142 0 0       0 if ($filled) {
5143 0 0       0 if ($gradient == 2) {
    0          
5144 0         0 my $x = $_x;
5145 0         0 my $y = $y0;
5146 0         0 my $width = $wdth;
5147 0         0 my $height = $y1 - $y0;
5148 0         0 my $index = ($y0 - $start) * $plen;
5149 0         0 my $sz = $plen * $height;
5150 0 0 0     0 $self->blit_write({ 'x' => $x, 'y' => $y, 'width' => $width, 'height' => $height, 'image' => substr($pattern, $index, $sz) }) if ($height && $width);
5151             } elsif ($gradient) {
5152 0         0 foreach my $v ($y0 .. $y1) {
5153 0         0 my $offset = $v - $start;
5154 0         0 $self->set_color({ 'red' => $rc[$offset], 'green' => $gc[$offset], 'blue' => $bc[$offset] });
5155 0         0 $self->line({ 'x' => $_x, 'y' => $v, 'xx' => $_xx, 'yy' => $v, 'pixel_size' => 1 });
5156             }
5157             } else {
5158 0         0 $self->{'RAW_FOREGROUND_COLOR'} = $saved;
5159 0         0 $self->box({ 'x' => $_x, 'y' => $y0, 'xx' => $_xx, 'yy' => $y1, 'filled' => 1 });
5160             }
5161             } else {
5162             # top
5163 0         0 $self->line({ 'x' => $x0, 'y' => $_y, 'xx' => $x1, 'yy' => $_y, 'pixel_size' => $size });
5164              
5165             # right
5166 0         0 $self->line({ 'x' => $_xx, 'y' => $y0, 'xx' => $_xx, 'yy' => $y1, 'pixel_size' => $size });
5167              
5168             # bottom
5169 0         0 $self->line({ 'x' => $x0, 'y' => $_yy, 'xx' => $x1, 'yy' => $_yy, 'pixel_size' => $size });
5170              
5171             # left
5172 0         0 $self->line({ 'x' => $_x, 'y' => $y0, 'xx' => $_x, 'yy' => $y1, 'pixel_size' => $size });
5173             }
5174             }
5175 0         0 $self->{'RAW_FOREGROUND_COLOR'} = $saved;
5176 0         0 delete($self->{'history'});
5177             }
5178              
5179             sub _fpart {
5180 0     0   0 return ((POSIX::modf(shift))[0]);
5181             }
5182              
5183             sub _rfpart {
5184 0     0   0 return (1 - _fpart(shift));
5185             }
5186              
5187             sub polygon {
5188             =head2 polygon
5189              
5190             Creates a polygon drawn in the foreground 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.
5191              
5192             It is up to you to make sure the coordinates are "sane". Weird things can result from twisted or complex filled polygons.
5193              
5194             =over 4
5195              
5196             $fb->polygon({
5197             'coordinates' => [
5198             5,5,
5199             23,34,
5200             70,7
5201             ],
5202             'pixel_size' => 1, # optional
5203             'antialiased' => 1, # optional only for non-filled
5204             'filled' => 1, # optional
5205              
5206             ## Only one of the following, "filled" must be set
5207              
5208             'gradient' => { # optional
5209             'direction' => 'horizontal', # or vertical
5210             'colors' => { # 2 to any number of transitions allowed
5211             'red' => [255,255,0], # Red to yellow to cyan
5212             'green' => [0,255,255],
5213             'blue' => [0,0,255],
5214             'alpha' => [255,255,255],
5215             }
5216             },
5217             'texture' => { # Same as what blit_read or load_image returns
5218             'width' => 320,
5219             'height' => 240,
5220             'image' => $raw_image_data
5221             },
5222             'hatch' => 'hatchname' # The exported array @HATCHES contains
5223             # the names of all the hatches
5224             });
5225              
5226             =back
5227              
5228             * Filled polygons are affected by the acceleration setting.
5229              
5230             =cut
5231              
5232 0     0 0 0 my $self = shift;
5233 0         0 my $params = shift;
5234              
5235 0   0     0 my $size = int($params->{'pixel_size'} || 1);
5236 0   0     0 my $aa = $params->{'antialiased'} || 0;
5237 0 0       0 $size = $params->{'pixel_size'} = 1 if ($aa);
5238 0 0       0 my $history_on = (exists($self->{'history'})) ? TRUE : FALSE;
5239              
5240 0 0       0 if ($params->{'filled'}) {
5241 0         0 $self->_fill_polygon($params);
5242             } else {
5243 0 0       0 $self->{'history'} = {} unless ($history_on);
5244 0         0 my @coords = @{ $params->{'coordinates'} };
  0         0  
5245 0         0 my ($xx, $yy) = (int(shift(@coords)), int(shift(@coords)));
5246 0         0 $self->plot({ 'x' => $xx, 'y' => $yy, 'pixel_size' => $size });
5247 0         0 while (scalar(@coords)) {
5248 0         0 my ($x, $y) = (int(shift(@coords)), int(shift(@coords)));
5249 0         0 $self->drawto({ 'x' => $x, 'y' => $y, 'pixel_size' => $size, 'antialiased' => $aa });
5250             }
5251 0         0 $self->drawto({ 'x' => $xx, 'y' => $yy, 'pixel_size' => $size, 'antialiased' => $aa });
5252 0 0       0 $self->plot({ 'x' => $xx, 'y' => $yy, 'pixel_size' => $size }) if ($self->{'DRAW_MODE'} == 1);
5253 0 0       0 delete($self->{'history'}) unless ($history_on);
5254             }
5255             }
5256              
5257             sub _point_in_polygon {
5258             # Does point x,y fall inside the polygon described in coordinates? Not yet used.
5259 0     0   0 my $self = shift;
5260 0         0 my $params = shift;
5261              
5262 0         0 my $poly_corners = (scalar(@{ $params->{'coordinates'} }) / 2);
  0         0  
5263 0         0 my ($x, $y) = (int($params->{'x'}), int($params->{'y'}));
5264 0         0 my $j = $poly_corners - 1;
5265 0         0 my $odd_nodes = FALSE;
5266              
5267 0         0 for (my $i = 0; $i < $poly_corners; $i += 2) {
5268 0         0 my ($ip, $jp) = ($i + 1, $j + 1);
5269 0 0 0     0 if (($params->{'coordinates'}->[$ip] < $y && $params->{'coordinates'}->[$jp] >= $y || $params->{'coordinates'}->[$jp] < $y && $params->{'coordinates'}->[$ip] >= $y) && ($params->{'coordinates'}->[$i] <= $x || $params->{'coordinates'}->[$j] <= $x)) {
      0        
      0        
5270 0         0 $odd_nodes ^= ($params->{'coordinates'}->[$i] + ($y - $params->{'coordinates'}->[$ip]) / ($params->{'coordinates'}->[$jp] - $params->{'coordinates'}->[$ip]) * ($params->{'coordinates'}->[$j] - $params->{'coordinates'}->[$i]) < $x);
5271             }
5272 0         0 $j = $i;
5273             }
5274 0         0 return ($odd_nodes);
5275             }
5276              
5277             sub _fill_polygon {
5278 0     0   0 my $self = shift;
5279 0         0 my $params = shift;
5280 0         0 my $bytes = $self->{'BYTES'};
5281              
5282 0         0 my $points = [];
5283 0         0 my $left = 0;
5284 0         0 my $right = 0;
5285 0         0 my $top = 0;
5286 0         0 my $bottom = 0;
5287 0         0 my $fill;
5288 0         0 while (scalar(@{ $params->{'coordinates'} })) {
  0         0  
5289 0         0 my $x = int(shift(@{ $params->{'coordinates'} })) - $self->{'X_CLIP'}; # Compensate for the smaller area in Imager
  0         0  
5290 0         0 my $y = int(shift(@{ $params->{'coordinates'} })) - $self->{'Y_CLIP'};
  0         0  
5291 0         0 $left = min($left, $x);
5292 0         0 $right = max($right, $x);
5293 0         0 $top = min($top, $y);
5294 0         0 $bottom = max($bottom, $y);
5295 0         0 push(@{$points}, [$x, $y]);
  0         0  
5296             }
5297 0         0 my $width = abs($right - $left);
5298 0         0 my $height = abs($bottom - $top);
5299 0         0 my $pattern;
5300 0 0       0 if (exists($params->{'gradient'})) {
    0          
5301 0   0     0 $params->{'gradient'}->{'direction'} ||= 'vertical';
5302 0 0       0 if (exists($params->{'gradient'}->{'colors'})) {
5303 0         0 $pattern = $self->_generate_fill($width, $height, $params->{'gradient'}->{'colors'}, $params->{'gradient'}->{'direction'});
5304             } else {
5305             $pattern = $self->_generate_fill(
5306             $width, $height,
5307             {
5308             'red' => [$params->{'gradient'}->{'start'}->{'red'}, $params->{'gradient'}->{'end'}->{'red'}],
5309             'green' => [$params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}],
5310             'blue' => [$params->{'gradient'}->{'start'}->{'blue'}, $params->{'gradient'}->{'end'}->{'blue'}],
5311             'alpha' => (exists($params->{'gradient'}->{'start'}->{'alpha'})) ? [$params->{'gradient'}->{'start'}->{'alpha'},$params->{'gradient'}->{'end'}->{'alpha'}] : [$self->{'COLOR_ALPHA'},$self->{'COLOR_ALPHA'}],
5312             },
5313 0 0       0 $params->{'gradient'}->{'direction'}
5314             );
5315             }
5316             } elsif (exists($params->{'texture'})) {
5317 0         0 $pattern = $self->_generate_fill($width, $height, undef, $params->{'texture'});
5318             # } elsif (exists($params->{'hatch'})) {
5319             # $pattern = $self->_generate_fill($width, $height, undef, $params->{'hatch'});
5320             }
5321 0         0 my $saved = { 'x' => $left, 'y' => $top, 'width' => $width, 'height' => $height };
5322 0         0 my $saved_mode = $self->{'DRAW_MODE'};
5323 0 0       0 unless ($self->{'DRAW_MODE'}) {
5324 0 0       0 if ($self->{'ACCELERATED'}) {
5325 0         0 $self->{'DRAW_MODE'} = MASK_MODE;
5326             } else {
5327 0         0 $saved = $self->blit_read($saved);
5328 0 0       0 $saved->{'image'} = $self->_convert_16_to_24($saved->{'image'}, RGB) if ($self->{'BITS'} == 16);
5329             }
5330             }
5331 0         0 my $img;
5332             my $pimg;
5333 0         0 eval {
5334 0         0 $img = Imager->new(
5335             'xsize' => $width,
5336             'ysize' => $height,
5337             'raw_datachannels' => max(3, $bytes),
5338             'raw_storechannels' => max(3, $bytes),
5339             'channels' => max(3, $bytes),
5340             );
5341 0 0 0     0 if (exists($saved->{'image'}) && defined($saved->{'image'})) {
5342             $img->read(
5343             'xsize' => $width,
5344             'ysize' => $height,
5345             'raw_datachannels' => max(3, $bytes),
5346             'raw_storechannels' => max(3, $bytes),
5347             'channels' => max(3, $bytes),
5348             'raw_interleave' => 0,
5349 0         0 'data' => $saved->{'image'},
5350             'type' => 'raw',
5351             'allow_incomplete' => 1
5352             );
5353             }
5354 0 0 0     0 if (defined($pattern)) {
    0          
5355 0 0       0 $pattern = $self->_convert_16_to_24($pattern, RGB) if ($self->{'BITS'} == 16);
5356 0         0 $pimg = Imager->new();
5357 0         0 $pimg->read(
5358             'xsize' => $width,
5359             'ysize' => $height,
5360             'raw_datachannels' => max(3, $bytes),
5361             'raw_storechannels' => max(3, $bytes),
5362             'raw_interleave' => 0,
5363             'channels' => max(3, $bytes),
5364             'data' => $pattern,
5365             'type' => 'raw',
5366             'allow_incomplete' => 1
5367             );
5368 0         0 $fill = Imager::Fill->new('image' => $pimg);
5369             } elsif (exists($params->{'hatch'}) && defined($params->{'hatch'})) {
5370             $fill = Imager::Fill->new(
5371             'hatch' => $params->{'hatch'} || 'dots16',
5372             'fg' => $self->{'IMAGER_FOREGROUND_COLOR'},
5373 0   0     0 'bg' => $self->{'IMAGER_BACKGROUND_COLOR'}
5374             );
5375             } else {
5376 0         0 $fill = Imager::Fill->new('solid' => $self->{'IMAGER_FOREGROUND_COLOR'});
5377             }
5378             $img->polygon(
5379             'points' => $points,
5380             'color' => $self->{'IMAGER_FOREGROUND_COLOR'},
5381 0   0     0 'aa' => $params->{'antialiased'} || 0,
5382             'filled' => TRUE,
5383             'fill' => $fill,
5384             );
5385             $img->write(
5386             'type' => 'raw',
5387             'datachannels' => max(3, $bytes),
5388             'storechannels' => max(3, $bytes),
5389             'interleave' => 0,
5390 0         0 'data' => \$saved->{'image'},
5391             );
5392 0 0       0 $saved->{'image'} = $self->_convert_24_to_16($saved->{'image'}, RGB) if ($self->{'BITS'} == 16);
5393             };
5394 0 0 0     0 warn __LINE__ . " $@\n", Imager->errstr() if ($@ && $self->{'SHOW_ERRORS'});
5395 0         0 $self->blit_write($saved);
5396 0         0 $self->{'DRAW_MODE'} = $saved_mode;
5397             }
5398              
5399             sub _generate_fill {
5400 0     0   0 my $self = shift;
5401 0         0 my $width = shift;
5402 0         0 my $height = shift;
5403 0         0 my $colors = shift;
5404 0         0 my $type = shift;
5405              
5406 0         0 my $gradient = '';
5407 0         0 my $bytes = $self->{'BYTES'};
5408 0 0       0 if (ref($type) eq 'HASH') { # texture
    0          
5409 0 0 0     0 if ($type->{'width'} != $width || $type->{'height'} != $height) {
5410 0         0 my $new = $self->blit_transform(
5411             {
5412             'blit_data' => $type,
5413             'scale' => {
5414             'scale_type' => 'nonprop',
5415             'x' => 0,
5416             'y' => 0,
5417             'width' => $width,
5418             'height' => $height
5419             }
5420             }
5421             );
5422 0         0 $gradient = $new->{'image'};
5423             } else {
5424 0         0 $gradient = $type->{'image'};
5425             }
5426             } elsif ($type =~ /vertical|horizontal/i) {
5427 0         0 my $r_offset = $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'};
5428 0         0 my $g_offset = $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'};
5429 0         0 my $b_offset = $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'};
5430 0         0 my $a_offset = $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'};
5431              
5432 0         0 my $r_length = $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'};
5433 0         0 my $g_length = $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'};
5434 0         0 my $b_length = $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'};
5435 0         0 my $a_length = $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'length'};
5436              
5437 0 0       0 my $count = ($type =~ /horizontal/i) ? $width : $height;
5438 0         0 my (@red,@green,@blue,@alpha);
5439 0         0 @red = @{ $colors->{'red'} };
  0         0  
5440 0         0 @green = @{ $colors->{'green'} };
  0         0  
5441 0         0 @blue = @{ $colors->{'blue'} };
  0         0  
5442 0 0       0 if ($self->{'BITS'} == 32) {
5443 0 0       0 unless (exists($colors->{'alpha'})) {
5444 0         0 @alpha = map {$_ = $self->{'COLOR_ALPHA'}} (1..$count);
  0         0  
5445             } else {
5446 0         0 @alpha = @{ $colors->{'alpha'} };
  0         0  
5447             }
5448             }
5449 0         0 my @rc = multi_gradient($count, @red);
5450 0         0 my @gc = multi_gradient($count, @green);
5451 0         0 my @bc = multi_gradient($count, @blue);
5452 0 0       0 my @ac = multi_gradient($count, @alpha) if ($self->{'BITS'} == 32);
5453 0 0       0 if ($type =~ /horizontal/i) { # Gradient
    0          
5454 0         0 my $end = $width - 1;
5455 0         0 foreach my $gcc (0 .. $end) {
5456 0 0       0 if ($self->{'BITS'} == 32) {
    0          
    0          
5457 0         0 $gradient .= pack('L', (
5458             ($rc[$gcc] << $r_offset) |
5459             ($gc[$gcc] << $g_offset) |
5460             ($bc[$gcc] << $b_offset) |
5461             ($ac[$gcc] << $a_offset)
5462             ));
5463             } elsif ($self->{'BITS'} == 24) {
5464 0         0 $gradient .= pack('L', (
5465             ($rc[$gcc] << $r_offset) |
5466             ($gc[$gcc] << $g_offset) |
5467             ($bc[$gcc] << $b_offset)
5468             ));
5469             } elsif ($self->{'BITS'} == 16) {
5470 0         0 $gradient .= pack('S', (
5471             (($rc[$gcc] >> 3) << $r_offset) |
5472             (($gc[$gcc] >> 2) << $g_offset) |
5473             (($bc[$gcc] >> 3) << $b_offset)
5474             ));
5475             }
5476             }
5477 0         0 $gradient = $gradient x $height;
5478             } elsif ($type =~ /vertical/i) { # gradient
5479 0         0 my $end = $height - 1;
5480 0         0 foreach my $gcc (0 .. $end) {
5481 0 0       0 if ($self->{'BITS'} == 32) {
    0          
    0          
5482 0         0 $gradient .= pack('L', (
5483             ($rc[$gcc] << $r_offset) |
5484             ($gc[$gcc] << $g_offset) |
5485             ($bc[$gcc] << $b_offset) |
5486             ($ac[$gcc] << $a_offset)
5487             )) x $width;
5488             } elsif ($self->{'BITS'} == 24) {
5489 0         0 $gradient .= pack('L', (
5490             ($rc[$gcc] << $r_offset) |
5491             ($gc[$gcc] << $g_offset) |
5492             ($bc[$gcc] << $b_offset)
5493             )) x $width;
5494             } elsif ($self->{'BITS'} == 16) {
5495 0         0 $gradient .= pack('S', (
5496             (($rc[$gcc] >> 3) << $r_offset) |
5497             (($gc[$gcc] >> 2) << $g_offset) |
5498             (($bc[$gcc] >> 3) << $b_offset)
5499             )) x $width;
5500             }
5501             }
5502             }
5503             } else {
5504 0 0 0     0 if ($width && $height) {
5505 0         0 my $img;
5506 0         0 eval {
5507 0         0 $img = Imager->new(
5508             'xsize' => $width,
5509             'ysize' => $height,
5510             'channels' => max(3, $bytes)
5511             );
5512              
5513             # Hatch types:
5514             #
5515             # Checkerboards -> check1x1, check2x2, check4x4
5516             # Vertical Lines -> vline1, vline2, vline4
5517             # Horizontal Lines -> hline1, hline2, hline4
5518             # 45 deg Lines -> slash1, slash2
5519             # -45 deg Lines -> slosh1, slosh2
5520             # Vertical & Horizontal Lines -> grid1, grid2, grid4
5521             # Dots -> dots1, dots4, dots16
5522             # Stipples -> stipple, stipple2
5523             # Weave -> weave
5524             # Crosshatch -> cross1, cross2
5525             # Lozenge Tiles -> vlozenge, hlozenge
5526             # Scales -> scalesdown, scalesup, scalesleft, scalesright
5527             # L Shaped Tiles -> tile_L
5528              
5529             my $fill = Imager::Fill->new(
5530             'hatch' => $type || 'dots16',
5531             'fg' => $self->{'IMAGER_FOREGROUND_COLOR'},
5532 0   0     0 'bg' => $self->{'IMAGER_BACKGROUND_COLOR'}
5533             );
5534 0         0 $img->box('fill' => $fill);
5535 0         0 $img->write(
5536             'type' => 'raw',
5537             'datachannels' => max(3, $bytes),
5538             'storechannels' => max(3, $bytes),
5539             'interleave' => 0,
5540             'data' => \$gradient
5541             );
5542             };
5543 0 0 0     0 warn __LINE__ . " $@\n", Imager->errstr() if ($@ && $self->{'SHOW_ERRORS'});
5544 0 0       0 $gradient = $self->_convert_24_to_16($gradient, RGB) if ($self->{'BITS'} == 16);
5545             }
5546             }
5547 0         0 return ($gradient);
5548             }
5549              
5550             sub box {
5551             =head2 box
5552              
5553             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.
5554              
5555             =over 4
5556              
5557             $fb->box({
5558             'x' => 20,
5559             'y' => 50,
5560             'xx' => 70,
5561             'yy' => 100,
5562             'radius' => 0, # if rounded, optional
5563             'pixel_size' => 1, # optional
5564             'filled' => 1, # optional
5565              
5566             ## Only one of the following, "filled" must be set
5567              
5568             'gradient' => { # optional
5569             'direction' => 'horizontal', # or vertical
5570             'colors' => { # 2 to any number of transitions allowed, and all colors must have the same number of transitions
5571             'red' => [255,255,0], # Red to yellow to cyan
5572             'green' => [0,255,255],
5573             'blue' => [0,0,255],
5574             'alpha' => [255,255,255], # Yes, even alpha transparency can vary
5575             }
5576             },
5577             'texture' => { # Same as what blit_read or load_image returns
5578             'width' => 320,
5579             'height' => 240,
5580             'image' => $raw_image_data
5581             },
5582             'hatch' => 'hatchname' # The exported array @HATCHES contains
5583             # the names of all the hatches
5584             });
5585              
5586             =back
5587              
5588             =cut
5589              
5590 0     0 0 0 my $self = shift;
5591 0         0 my $params = shift;
5592              
5593 0         0 my $x = int($params->{'x'});
5594 0         0 my $y = int($params->{'y'});
5595 0         0 my $xx = int($params->{'xx'});
5596 0         0 my $yy = int($params->{'yy'});
5597 0   0     0 my $filled = int($params->{'filled'}) || 0;
5598 0   0     0 my $size = int($params->{'pixel_size'}) || 1;
5599 0   0     0 my $radius = int($params->{'radius'}) || 0;
5600 0 0       0 $size = 1 if ($filled);
5601 0         0 my ($count, $data, $w, $h);
5602              
5603             # This puts $x,$y,$xx,$yy in their correct order if backwards.
5604             # $x must always be less than $xx
5605             # $y must always be less than $yy
5606 0 0       0 if ($x > $xx) {
5607 0         0 ($x, $xx) = ($xx, $x);
5608             }
5609 0 0       0 if ($y > $yy) {
5610 0         0 ($y, $yy) = ($yy, $y);
5611             }
5612 0         0 my $width = $xx - $y;
5613 0         0 my $height = $yy - $y;
5614 0         0 my $vc = $height / 2;
5615 0         0 my $hc = $width / 2;
5616 0 0       0 if ($radius) {
    0          
5617             # Keep the radius sane
5618 0 0       0 $radius = $hc if ($hc < $radius);
5619 0 0       0 $radius = $vc if ($vc < $radius);
5620              
5621 0         0 my $p = $params;
5622 0         0 $p->{'radius'} = $radius;
5623 0         0 $p->{'x'} = ($x + $radius);
5624 0         0 $p->{'y'} = ($y + $radius);
5625 0         0 $p->{'xx'} = ($xx - $radius);
5626 0         0 $p->{'yy'} = ($yy - $radius);
5627 0         0 $p->{'bx'} = $x;
5628 0         0 $p->{'by'} = $y;
5629 0         0 $p->{'bxx'} = $xx;
5630 0         0 $p->{'byy'} = $yy;
5631 0         0 $self->circle($p); # Yep, circle
5632             } elsif ($filled) {
5633 0         0 my $X = $xx;
5634 0         0 my $Y = $yy;
5635 0         0 $x = max($self->{'X_CLIP'}, min($self->{'XX_CLIP'}, $x));
5636 0         0 $y = max($self->{'Y_CLIP'}, min($self->{'YY_CLIP'}, $y));
5637 0         0 $xx = max($self->{'X_CLIP'}, min($self->{'XX_CLIP'}, $xx));
5638 0         0 $yy = max($self->{'Y_CLIP'}, min($self->{'YY_CLIP'}, $yy));
5639 0         0 $w = abs($xx - $x);
5640 0         0 $h = abs($yy - $y);
5641 0         0 my $pattern;
5642              
5643 0 0       0 if (exists($params->{'gradient'})) {
    0          
    0          
5644 0 0       0 if (exists($params->{'gradient'}->{'colors'})) {
5645 0         0 $pattern = $self->_generate_fill($w, $h, $params->{'gradient'}->{'colors'}, $params->{'gradient'}->{'direction'});
5646             } else {
5647             $pattern = $self->_generate_fill(
5648             $w, $h,
5649             {
5650             'red' => [$params->{'gradient'}->{'start'}->{'red'}, $params->{'gradient'}->{'end'}->{'red'}],
5651             'green' => [$params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}],
5652             'blue' => [$params->{'gradient'}->{'start'}->{'blue'}, $params->{'gradient'}->{'end'}->{'blue'}],
5653             'alpha' => (exists($params->{'gradient'}->{'start'}->{'alpha'})) ? [$params->{'gradient'}->{'start'}->{'alpha'},$params->{'gradient'}->{'end'}->{'alpha'}] : [$self->{'COLOR_ALPHA'},$self->{'COLOR_ALPHA'}],
5654             },
5655 0 0       0 $params->{'gradient'}->{'direction'},
5656             );
5657             }
5658             } elsif (exists($params->{'texture'})) {
5659 0         0 $pattern = $self->_generate_fill($w, $h, undef, $params->{'texture'});
5660             } elsif (exists($params->{'hatch'})) {
5661 0         0 $pattern = $self->_generate_fill($w, $h, undef, $params->{'hatch'});
5662             } else {
5663 0         0 $pattern = $self->{'RAW_FOREGROUND_COLOR'} x ($w * $h);
5664             }
5665 0         0 $self->blit_write({ 'x' => $x, 'y' => $y, 'width' => $w, 'height' => $h, 'image' => $pattern });
5666 0         0 $self->{'X'} = $X;
5667 0         0 $self->{'Y'} = $Y;
5668             } else {
5669 0         0 $self->polygon({ 'coordinates' => [$x, $y, $xx, $y, $xx, $yy, $x, $yy], 'pixel_size' => $size });
5670             }
5671             }
5672              
5673             sub rbox {
5674             =head2 rbox
5675              
5676             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.
5677              
5678             =over 4
5679              
5680             $fb->rbox({
5681             'x' => 100,
5682             'y' => 100,
5683             'width' => 200,
5684             'height' => 150,
5685             'radius' => 0, # if rounded, optional
5686             'pixel_size' => 2, # optional
5687             'filled' => 0, # optional
5688              
5689             ## Only one of the following, "filled" must be set
5690              
5691             'gradient' => { # optional
5692             'direction' => 'horizontal', # or vertical
5693             'colors' => { # 2 to any number of transitions allowed
5694             'red' => [255,255,0], # Red to yellow to cyan
5695             'green' => [0,255,255],
5696             'blue' => [0,0,255],
5697             'alpha' => [255,255,255],
5698             }
5699             },
5700             'texture' => { # Same as what blit_read or load_image returns
5701             'width' => 320,
5702             'height' => 240,
5703             'image' => $raw_image_data
5704             },
5705             'hatch' => 'hatchname' # The exported array @HATCHES contains
5706             # the names of all the hatches
5707             });
5708              
5709             =back
5710              
5711             =cut
5712              
5713 0     0 0 0 my $self = shift;
5714 0         0 my $params = shift;
5715              
5716 0         0 $params->{'xx'} = $params->{'x'} + $params->{'width'};
5717 0         0 $params->{'yy'} = $params->{'y'} + $params->{'height'};
5718 0         0 $self->box($params);
5719             }
5720              
5721             sub set_color {
5722             =head2 set_color
5723              
5724             Sets the drawing color in red, green, and blue, absolute 8 bit values.
5725              
5726             Even if you are in 16 bit color mode, use 8 bit values. They will be automatically scaled.
5727              
5728             =over 4
5729              
5730             $fb->set_color({
5731             'red' => 255,
5732             'green' => 255,
5733             'blue' => 0,
5734             'alpha' => 255
5735             });
5736              
5737             =back
5738             =cut
5739              
5740 4     4 0 16 my $self = shift;
5741 4         13 my $params = shift;
5742 4   100     62 my $name = shift || 'RAW_FOREGROUND_COLOR';
5743              
5744 4         20 my $bytes = $self->{'BYTES'};
5745 4         22 my $R = int($params->{'red'}) & 255; # Color forced to fit within 0-255 value
5746 4         22 my $G = int($params->{'green'}) & 255;
5747 4         17 my $B = int($params->{'blue'}) & 255;
5748 4 100       25 my $def_alpha = ($name eq 'RAW_FOREGROUND_COLOR') ? 255 : 0;
5749 4   66     33 my $A = int($params->{'alpha'} || $def_alpha) & 255;
5750 4         15 my $color_order = $self->{'COLOR_ORDER'};
5751              
5752 4         12 map { $self->{ $name . '_' . uc($_) } = $params->{$_} } (keys %{$params});
  16         129  
  4         57  
5753 4         14 $params->{'red'} = $R;
5754 4         8 $params->{'green'} = $G;
5755 4         10 $params->{'blue'} = $B;
5756 4         12 $params->{'alpha'} = $A;
5757 4         11 my $r_offset = $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'};
5758 4         13 my $g_offset = $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'};
5759 4         13 my $b_offset = $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'};
5760 4         9 my $a_offset = $self->{'vscreeninfo'}->{'bitfields'}->{'alpha'}->{'offset'};
5761 4         19 $self->{'COLOR_ALPHA'} = $A;
5762 4 50       20 if ($self->{'BITS'} >= 24) {
    0          
5763 4         33 $self->{$name} = pack('L',(
5764             ($R << $r_offset) |
5765             ($G << $g_offset) |
5766             ($B << $b_offset) |
5767             ($A << $a_offset)
5768             ));
5769 4 50       16 $self->{$name} = substr($self->{$name},0,3) if ($self->{'BITS'} == 24);
5770 4         48 $self->{"INT_$name"} = unpack('L', $self->{$name});
5771             } elsif ($self->{'BITS'} == 16) {
5772 0         0 my $r = $R >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'});
5773 0         0 my $g = $G >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'});
5774 0         0 my $b = $B >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'});
5775 0         0 $self->{$name} = pack('S', ($r << $r_offset) | ($g << $g_offset) | ($b << $b_offset));
5776              
5777 0         0 $self->{"INT_$name"} = unpack('S', $self->{$name});
5778             }
5779              
5780 4         54 $self->{"SET_$name"} = $params;
5781             # This swapping is only for Imager
5782 4 50       46 if ($color_order == BGR) {
    50          
    50          
    50          
    50          
5783 0         0 ($B, $G, $R) = ($R,$G,$B);
5784             } elsif ($color_order == BRG) {
5785 0         0 ($B, $R, $G) = ($R,$G,$B);
5786             } elsif ($color_order == RBG) {
5787 0         0 ($R, $B, $G) = ($R,$G,$B);
5788             } elsif ($color_order == GRB) {
5789 0         0 ($G, $R, $B) = ($R,$G,$B);
5790             } elsif ($color_order == GBR) {
5791 0         0 ($G, $B, $R) = ($R,$G,$B);
5792             }
5793 4 100       16 if ($name eq 'RAW_FOREGROUND_COLOR') {
5794 2 50       77 $self->{'IMAGER_FOREGROUND_COLOR'} = ($self->{'BITS'} == 32) ? Imager::Color->new($R, $G, $B, $A) : Imager::Color->new($R, $G, $B);
5795             } else {
5796 2 50       18 $self->{'IMAGER_BACKGROUND_COLOR'} = ($self->{'BITS'} == 32) ? Imager::Color->new($R, $G, $B, $A) : Imager::Color->new($R, $G, $B);
5797             }
5798             }
5799              
5800             sub set_foreground_color {
5801             =head2 set_foreground_color
5802              
5803             This is an alias to 'set_color'
5804              
5805             =cut
5806              
5807 0     0 0 0 my $self = shift;
5808 0         0 $self->set_color(shift);
5809             }
5810              
5811             sub set_b_color {
5812             =head2 set_b_color
5813              
5814             Sets the background color in red, green, and blue values.
5815              
5816             The same rules as set_color apply.
5817              
5818             =over 4
5819              
5820             $fb->set_b_color({
5821             'red' => 0,
5822             'green' => 0,
5823             'blue' => 255,
5824             'alpha' => 255
5825             });
5826              
5827             =back
5828             =cut
5829              
5830 2     2 0 12 my $self = shift;
5831 2         39 $self->set_color(shift, 'RAW_BACKGROUND_COLOR');
5832             }
5833              
5834             sub set_background_color {
5835             =head2 set_background_color
5836              
5837             This is an alias to 'set_b_color'
5838              
5839             =cut
5840              
5841 0     0 0 0 my $self = shift;
5842 0         0 $self->set_color(shift, 'RAW_BACKGROUND_COLOR');
5843             }
5844              
5845             sub fill {
5846             =head2 fill
5847              
5848             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 foreground color, until the "background" color is replaced with the new color.
5849              
5850             NOTE: The accelerated version of this routine may (and it is a small may) have issues. If you find any issues, then temporarily turn off C-acceleration when calling this method.
5851              
5852             =over 4
5853              
5854             $fb->fill({'x' => 334, 'y' => 23});
5855              
5856             =back
5857              
5858             * 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.
5859              
5860             =cut
5861              
5862 0     0 0 0 my $self = shift;
5863 0         0 my $params = shift;
5864              
5865 0         0 my $x = int($params->{'x'});
5866 0         0 my $y = int($params->{'y'});
5867              
5868 0         0 my $pixel = $self->pixel({ 'x' => $x, 'y' => $y });
5869 0         0 my $bytes = $self->{'BYTES'};
5870              
5871 0 0       0 return if ($back eq $self->{'RAW_FOREGROUND_COLOR'});
5872 0 0       0 unless ($self->{'ACCELERATED'}) {
5873 0         0 my $background = $pixel->{'raw'};
5874 0         0 my %visited = ();
5875 0         0 my @queue = ();
5876              
5877 0         0 push(@queue, [$x, $y]);
5878              
5879 0         0 while (scalar(@queue)) {
5880 0         0 my $pointref = shift(@queue);
5881 0         0 ($x, $y) = @{$pointref};
  0         0  
5882 0 0 0     0 next if (($x < $self->{'X_CLIP'}) || ($x > $self->{'XX_CLIP'}) || ($y < $self->{'Y_CLIP'}) || ($y > $self->{'YY_CLIP'}));
      0        
      0        
5883 0 0       0 unless (exists($visited{"$x,$y"})) {
5884 0         0 $pixel = $self->pixel({ 'x' => $x, 'y' => $y, 'raw' => TRUE });
5885 0 0       0 if ($pixel eq $background) {
5886 0         0 $self->plot({ 'x' => $x, 'y' => $y });
5887 0         0 $visited{"$x,$y"}++;
5888 0         0 push(@queue, [$x + 1, $y]);
5889 0         0 push(@queue, [$x - 1, $y]);
5890 0         0 push(@queue, [$x, $y + 1]);
5891 0         0 push(@queue, [$x, $y - 1]);
5892             }
5893             }
5894             }
5895             } else {
5896 0         0 my $width = int($self->{'W_CLIP'});
5897 0         0 my $height = int($self->{'H_CLIP'});
5898 0         0 my $pattern;
5899 0 0       0 if (exists($params->{'gradient'})) {
    0          
    0          
5900 0   0     0 $params->{'gradient'}->{'direction'} ||= 'vertical';
5901 0 0       0 if (exists($params->{'gradient'}->{'colors'})) {
5902 0         0 $pattern = $self->_generate_fill($width, $height, $params->{'gradient'}->{'colors'}, $params->{'gradient'}->{'direction'});
5903             } else {
5904             $pattern = $self->_generate_fill(
5905             $width, $height,
5906             {
5907             'red' => [$params->{'gradient'}->{'start'}->{'red'}, $params->{'gradient'}->{'end'}->{'red'}],
5908             'green' => [$params->{'gradient'}->{'start'}->{'green'}, $params->{'gradient'}->{'end'}->{'green'}],
5909             'blue' => [$params->{'gradient'}->{'start'}->{'blue'}, $params->{'gradient'}->{'end'}->{'blue'}],
5910             'alpha' => (exists($params->{'gradient'}->{'start'}->{'alpha'})) ? [$params->{'gradient'}->{'start'}->{'alpha'},$params->{'gradient'}->{'end'}->{'alpha'}] : [$self->{'COLOR_ALPHA'},$self->{'COLOR_ALPHA'}],
5911             },
5912 0 0       0 $params->{'gradient'}->{'direction'}
5913             );
5914             }
5915             } elsif (exists($params->{'texture'})) {
5916 0         0 $pattern = $self->_generate_fill($width, $height, undef, $params->{'texture'});
5917             } elsif (exists($params->{'hatch'})) {
5918 0         0 $pattern = $self->_generate_fill($width, $height, undef, $params->{'hatch'});
5919             }
5920              
5921             my $saved = $self->blit_read(
5922             {
5923             'x' => $self->{'X_CLIP'},
5924 0         0 'y' => $self->{'Y_CLIP'},
5925             'width' => $width,
5926             'height' => $height,
5927             }
5928             );
5929 0 0       0 if ($self->{'BITS'} == 16) {
5930 0         0 $saved->{'image'} = $self->_convert_16_to_24($saved->{'image'}, RGB);
5931 0 0       0 $pattern = $self->_convert_16_to_24($pattern, RGB) if (defined($pattern));
5932             }
5933 0         0 eval {
5934 0         0 my $img = Imager->new(
5935             'xsize' => $width,
5936             'ysize' => $height,
5937             'raw_datachannels' => max(3, $bytes),
5938             'raw_storechannels' => max(3, $bytes),
5939             'channels' => max(3, $bytes),
5940             );
5941              
5942             # unless ($self->{'DRAW_MODE'}) {
5943             $img->read(
5944             'xsize' => $width,
5945             'ysize' => $height,
5946             'raw_datachannels' => max(3, $bytes),
5947             'raw_storechannels' => max(3, $bytes),
5948             'channels' => max(3, $bytes),
5949             'raw_interleave' => 0,
5950 0         0 'data' => $saved->{'image'},
5951             'type' => 'raw',
5952             'allow_incomplete' => 1
5953             );
5954              
5955 0         0 my $fill;
5956 0 0       0 if (defined($pattern)) {
5957 0         0 my $pimg = Imager->new();
5958 0         0 $pimg->read(
5959             'xsize' => $width,
5960             'ysize' => $height,
5961             'raw_datachannels' => max(3, $bytes),
5962             'raw_storechannels' => max(3, $bytes),
5963             'raw_interleave' => 0,
5964             'channels' => max(3, $bytes),
5965             'data' => $pattern,
5966             'type' => 'raw',
5967             'allow_incomplete' => 1
5968             );
5969             $img->flood_fill(
5970             'x' => int($x - $self->{'X_CLIP'}),
5971             'y' => int($y - $self->{'Y_CLIP'}),
5972 0         0 'color' => $self->{'IMAGER_FOREGROUND_COLOR'},
5973             'fill' => { 'image' => $pimg }
5974             );
5975             } else {
5976             $img->flood_fill(
5977             'x' => int($x - $self->{'X_CLIP'}),
5978             'y' => int($y - $self->{'Y_CLIP'}),
5979 0         0 'color' => $self->{'IMAGER_FOREGROUND_COLOR'},
5980             );
5981             }
5982             $img->write(
5983             'type' => 'raw',
5984             'datachannels' => max(3, $bytes),
5985             'storechannels' => max(3, $bytes),
5986             'interleave' => 0,
5987 0         0 'data' => \$saved->{'image'},
5988             );
5989 0 0       0 $saved->{'image'} = $self->_convert_24_to_16($saved->{'image'}, RGB) if ($self->{'BITS'} == 16);
5990             };
5991 0 0 0     0 warn __LINE__ . " $@\n", Imager->errstr() if ($@ && $self->{'SHOW_ERRORS'});
5992              
5993 0         0 $self->blit_write($saved);
5994             }
5995             }
5996              
5997             sub replace_color {
5998             =head2 replace_color
5999              
6000             This replaces one color with another inside the clipping region. Sort of like a fill without boundary checking.
6001              
6002             In 32 bit mode, the replaced alpha channel is ALWAYS set to 255.
6003              
6004             =over 4
6005              
6006             $fb->replace_color({
6007             'old' => { # Changed as of 5.56
6008             'red' => 23,
6009             'green' => 48,
6010             'blue' => 98
6011             },
6012             'new' => {
6013             'red' => 255,
6014             'green' => 255,
6015             'blue' => 0
6016             }
6017             });
6018              
6019             =back
6020              
6021             * 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.
6022              
6023             =cut
6024              
6025 0     0 0 0 my $self = shift;
6026 0         0 my $params = shift;
6027              
6028 0   0     0 my $old_r = int($params->{'old'}->{'red'}) || 0;
6029 0   0     0 my $old_g = int($params->{'old'}->{'green'}) || 0;
6030 0   0     0 my $old_b = int($params->{'old'}->{'blue'}) || 0;
6031 0 0       0 my $old_a = int($params->{'old'}->{'alpha'}) if (exists($params->{'old'}->{'alpha'}));
6032 0   0     0 my $new_r = int($params->{'new'}->{'red'}) || 0;
6033 0   0     0 my $new_g = int($params->{'new'}->{'green'}) || 0;
6034 0   0     0 my $new_b = int($params->{'new'}->{'blue'}) || 0;
6035 0   0     0 my $new_a = int($params->{'new'}->{'alpha'}) || $self->{'COLOR_ALPHA'};
6036              
6037 0         0 my $color_order = $self->{'COLOR_ORDER'};
6038 0         0 my ($sx, $start) = (0, 0);
6039 0         0 $self->set_color({ 'red' => $new_r, 'green' => $new_g, 'blue' => $new_b });
6040 0         0 my $old_mode = $self->{'DRAW_MODE'};
6041 0         0 $self->{'DRAW_MODE'} = NORMAL_MODE;
6042              
6043 0         0 my ($old, $new);
6044 0 0       0 if ($self->{'BITS'} == 32) {
    0          
    0          
6045 0 0       0 if ($color_order == BGR) {
    0          
    0          
    0          
    0          
    0          
6046 0 0       0 $old = (defined($old_a)) ? sprintf('\x%02x\x%02x\x%02x\x%02x', $old_b, $old_g, $old_r, $old_a) : sprintf('\x%02x\x%02x\x%02x.', $old_b, $old_g, $old_r);
6047 0         0 $new = sprintf('\x%02x\x%02x\x%02x\x%02x', $new_b, $new_g, $new_r, $new_a);
6048             } elsif ($color_order == BRG) {
6049 0 0       0 $old = (defined($old_a)) ? sprintf('\x%02x\x%02x\x%02x\x%02x', $old_b, $old_r, $old_g, $old_a) : sprintf('\x%02x\x%02x\x%02x.', $old_b, $old_r, $old_g);
6050 0         0 $new = sprintf('\x%02x\x%02x\x%02x\x%02x', $new_b, $new_r, $new_g, $new_a);
6051             } elsif ($color_order == RGB) {
6052 0 0       0 $old = (defined($old_a)) ? sprintf('\x%02x\x%02x\x%02x\x%02x', $old_r, $old_g, $old_b, $old_a) : sprintf('\x%02x\x%02x\x%02x.', $old_r, $old_g, $old_b);
6053 0         0 $new = sprintf('\x%02x\x%02x\x%02x\x%02x', $new_r, $new_g, $new_b, $new_a);
6054             } elsif ($color_order == RBG) {
6055 0 0       0 $old = (defined($old_a)) ? sprintf('\x%02x\x%02x\x%02x\x%02x', $old_r, $old_b, $old_g, $old_a) : sprintf('\x%02x\x%02x\x%02x.', $old_r, $old_b, $old_g);
6056 0         0 $new = sprintf('\x%02x\x%02x\x%02x\x%02x', $new_r, $new_b, $new_g, $new_a);
6057             } elsif ($color_order == GRB) {
6058 0 0       0 $old = (defined($old_a)) ? sprintf('\x%02x\x%02x\x%02x\x%02x', $old_g, $old_r, $old_b, $old_a) : sprintf('\x%02x\x%02x\x%02x.', $old_g, $old_r, $old_b);
6059 0         0 $new = sprintf('\x%02x\x%02x\x%02x\x%02x', $new_g, $new_r, $new_b, $new_a);
6060             } elsif ($color_order == GBR) {
6061 0 0       0 $old = (defined($old_a)) ? sprintf('\x%02x\x%02x\x%02x\x%02x', $old_g, $old_b, $old_r, $old_a) : sprintf('\x%02x\x%02x\x%02x.', $old_g, $old_b, $old_r);
6062 0         0 $new = sprintf('\x%02x\x%02x\x%02x\x%02x', $new_g, $new_b, $new_r, $new_a);
6063             }
6064             } elsif ($self->{'BITS'} == 24) {
6065 0 0       0 if ($color_order == BGR) {
    0          
    0          
    0          
    0          
    0          
6066 0         0 $old = sprintf('\x%02x\x%02x\x%02x', $old_b, $old_g, $old_r);
6067 0         0 $new = sprintf('\x%02x\x%02x\x%02x', $new_b, $new_g, $new_r);
6068             } elsif ($color_order == BRG) {
6069 0         0 $old = sprintf('\x%02x\x%02x\x%02x', $old_b, $old_r, $old_g);
6070 0         0 $new = sprintf('\x%02x\x%02x\x%02x', $new_b, $new_r, $new_g);
6071             } elsif ($color_order == RGB) {
6072 0         0 $old = sprintf('\x%02x\x%02x\x%02x.', $old_r, $old_g, $old_b);
6073 0         0 $new = sprintf('\x%02x\x%02x\x%02x', $new_r, $new_g, $new_b);
6074             } elsif ($color_order == RBG) {
6075 0         0 $old = sprintf('\x%02x\x%02x\x%02x.', $old_r, $old_b, $old_g);
6076 0         0 $new = sprintf('\x%02x\x%02x\x%02x', $new_r, $new_b, $new_g);
6077             } elsif ($color_order == GRB) {
6078 0         0 $old = sprintf('\x%02x\x%02x\x%02x.', $old_g, $old_r, $old_b);
6079 0         0 $new = sprintf('\x%02x\x%02x\x%02x', $new_g, $new_r, $new_b);
6080             } elsif ($color_order == GBR) {
6081 0         0 $old = sprintf('\x%02x\x%02x\x%02x.', $old_g, $old_b, $old_r);
6082 0         0 $new = sprintf('\x%02x\x%02x\x%02x', $new_g, $new_b, $new_r);
6083             }
6084             } elsif ($self->{'BITS'} == 16) {
6085 0         0 $old_b = $old_b >> (8 - ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'}));
6086 0         0 $old_g = $old_g >> (8 - ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'}));
6087 0         0 $old_r = $old_r >> (8 - ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'}));
6088 0         0 $new_b = $new_b >> (8 - ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'}));
6089 0         0 $new_g = $new_g >> (8 - ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'}));
6090 0         0 $new_r = $new_r >> (8 - ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'}));
6091             $old = pack('S',
6092             (
6093             ($old_b << $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}) |
6094             ($old_g << $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}) |
6095 0         0 ($old_r << $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})
6096             )
6097             );
6098             $new = pack('S',
6099             (
6100             ($new_b << $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}) |
6101             ($new_g << $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}) |
6102 0         0 ($new_r << $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})
6103             )
6104             );
6105 0         0 $old = sprintf('\x%02x\x%02x', unpack('C2', $old));
6106 0         0 $new = sprintf('\x%02x\x%02x', unpack('C2', $new));
6107             }
6108             my $save = $self->blit_read(
6109             {
6110             'x' => $self->{'X_CLIP'},
6111             'y' => $self->{'Y_CLIP'},
6112             'width' => $self->{'W_CLIP'},
6113 0         0 'height' => $self->{'H_CLIP'}
6114             }
6115             );
6116              
6117 0         0 eval(" \$save->{'image'} =~ s/$old/$new/sg; ");
6118 0         0 $self->blit_write($save);
6119              
6120 0         0 $self->{'DRAW_MODE'} = $old_mode;
6121             }
6122              
6123             sub blit_copy {
6124             =head2 blit_copy
6125              
6126             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.
6127              
6128             =over 4
6129              
6130             $fb->blit_copy({
6131             'x' => 20,
6132             'y' => 20,
6133             'width' => 30,
6134             'height' => 30,
6135             'x_dest' => 200,
6136             'y_dest' => 200
6137             });
6138              
6139             =back
6140              
6141             =cut
6142              
6143 0     0 0 0 my $self = shift;
6144 0         0 my $params = shift;
6145              
6146 0         0 $self->blit_write({ %{ $self->blit_read({ 'x' => int($params->{'x'}), 'y' => int($params->{'y'}), 'width' => int($params->{'width'}), 'height' => int($params->{'height'}) }) }, 'x' => int($params->{'x_dest'}), 'y' => int($params->{'y_dest'}) });
  0         0  
6147             }
6148              
6149             sub blit_move {
6150             =head2 blit_move
6151              
6152             Moves a square portion of screen graphic data from x,y,w,h to x_dest,y_dest. It moves in the current drawing mode. It differs from "blit_copy" in that it removes the graphic from the original location (via XOR).
6153              
6154             It also returns the data moved like "blit_read"
6155              
6156             =over 4
6157              
6158             $fb->blit_move({
6159             'x' => 20,
6160             'y' => 20,
6161             'width' => 30,
6162             'height' => 30,
6163             'x_dest' => 200,
6164             'y_dest' => 200,
6165             'image' => $raw_image_data, # This is optional, but can speed things up
6166             });
6167              
6168             =back
6169              
6170             =cut
6171              
6172 0     0 0 0 my $self = shift;
6173 0         0 my $params = shift;
6174              
6175 0         0 my $old_mode = $self->{'DRAW_MODE'};
6176             my $image = (exists($params->{'image'})) ?
6177             $params
6178             :
6179 0 0       0 $self->blit_read({ 'x' => int($params->{'x'}), 'y' => int($params->{'y'}), 'width' => int($params->{'width'}), 'height' => int($params->{'height'}) });
6180 0         0 $self->xor_mode();
6181 0         0 $self->blit_write($image);
6182 0         0 $self->{'DRAW_MODE'} = $old_mode;
6183 0         0 $image->{'x'} = int($params->{'x_dest'});
6184 0         0 $image->{'y'} = int($params->{'y_dest'});
6185 0         0 $self->vsync();
6186 0         0 $self->blit_write($image);
6187 0         0 delete($image->{'x_dest'});
6188 0         0 delete($image->{'y_dest'});
6189 0         0 return($image);
6190             }
6191              
6192             sub play_animation {
6193             =head2 play_animation
6194              
6195             Plays an animation sequence loaded from "load_image"
6196              
6197             =over 4
6198              
6199             my $animation = $fb->load_image(
6200             {
6201             'file' => 'filename.gif',
6202             'center' => CENTER_XY,
6203             }
6204             );
6205              
6206             $fb->play_animation($animation,$rate_multiplier);
6207              
6208             =back
6209              
6210             The animation is played at the speed described by the file's metadata multiplied by "rate_multiplier".
6211              
6212             You need to enclose this in a loop if you wish it to play more than once.
6213              
6214             =cut
6215              
6216 0     0 0 0 my $self = shift;
6217 0         0 my $image = shift;
6218 0   0     0 my $rate = shift || 1;
6219              
6220 0         0 foreach my $frame (0 .. (scalar(@{$image}) - 1)) {
  0         0  
6221 0         0 my $begin = time;
6222 0         0 $self->blit_write($image->[$frame]);
6223              
6224 0         0 my $delay = (($image->[$frame]->{'tags'}->{'gif_delay'} * .01) * $rate) - (time - $begin);
6225 0 0       0 if ($delay > 0) {
6226 0         0 sleep $delay;
6227             }
6228             }
6229             }
6230              
6231             sub acceleration {
6232             =head2 acceleration
6233              
6234             Enables/Disables all Imager or C language acceleration.
6235              
6236             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.
6237              
6238             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.
6239              
6240             When called without parameters, it returns the current setting.
6241              
6242             =over 4
6243              
6244             $fb->acceleration(HARDWARE); # Turn hardware acceleration ON, along with some C acceleration (HARDWARE IS NOT YET IMPLEMENTED!)
6245              
6246             $fb->acceleration(SOFTWARE); # Turn C (software) acceleration ON
6247              
6248             $fb->acceleration(PERL); # Turn acceleration OFF, using Perl
6249              
6250             my $accel = $fb->acceleration(); # Get current acceleration state. 0 = PERL, 1 = SOFTWARE, 2 = HARDWARE (not yet implemented)
6251              
6252             my $accel = $fb->acceleration('english'); # Get current acceleration state in an english string.
6253             # "PERL" = PERL = 0
6254             # "SOFTWARE" = SOFTWARE = 1
6255             # "HARDWARE" = HARDWARE = 2
6256              
6257             =back
6258              
6259             * The "Mask" and "Unmask" drawing modes are greatly affected by acceleration, as well as 16 bit conversions in image loading and ttf_print(ing).
6260              
6261             =cut
6262              
6263 0     0 0 0 my $self = shift;
6264 0 0       0 if (scalar(@_)) {
6265 0         0 my $set = shift;
6266 0 0 0     0 if ($set =~ /^\d+$/ && $set >= PERL && $set <= HARDWARE) {
    0 0        
6267 0         0 $self->{'ACCELERATED'} = $set;
6268             } elsif ($set =~ /english|string/i) {
6269 0         0 foreach my $name (qw( PERL SOFTWARE HARDWARE )) {
6270 0 0       0 if ($self->{'ACCELERATED'} == $self->{$name}) {
6271 0         0 return($name);
6272             }
6273             }
6274             }
6275             }
6276 0         0 return ($self->{'ACCELERATED'});
6277             }
6278              
6279             sub perl {
6280             =head2 perl
6281              
6282             This is an alias to "acceleration(PERL)"
6283              
6284             =cut
6285              
6286 0     0 0 0 my $self = shift;
6287 0         0 $self->acceleration(PERL);
6288             }
6289              
6290             sub software {
6291             =head2 software
6292              
6293             This is an alias to "acceleration(SOFTWARE)"
6294              
6295             =cut
6296              
6297 0     0 0 0 my $self = shift;
6298 0         0 $self->acceleration(SOFTWARE);
6299             }
6300              
6301             sub hardware {
6302             =head2 hardware
6303              
6304             This is an alias to "acceleration(HARDWARE)"
6305              
6306             =cut
6307              
6308 0     0 0 0 my $self = shift;
6309 0         0 $self->acceleration(HARDWARE);
6310             }
6311              
6312             sub blit_read {
6313             =head2 blit_read
6314              
6315             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'.
6316              
6317             Passing no parameters automatically grabs the clipping region (the whole screen if clipping is off).
6318              
6319             =over 4
6320              
6321             my $blit_data = $fb->blit_read({
6322             'x' => 30,
6323             'y' => 50,
6324             'width' => 100,
6325             'height' => 100
6326             });
6327              
6328             =back
6329              
6330             Returns:
6331              
6332             =over 4
6333              
6334             {
6335             'x' => original X position,
6336             'y' => original Y position,
6337             'width' => width,
6338             'height' => height,
6339             'image' => string of image data for the block
6340             }
6341              
6342             =back
6343              
6344             All you have to do is change X and Y, and just pass it to "blit_write" and it will paste it there.
6345              
6346             =cut
6347              
6348 0     0 0 0 my $self = shift;
6349 0         0 my $params = shift; # $self->_blit_adjust_for_clipping(shift);
6350              
6351 0   0     0 my $x = int($params->{'x'} || $self->{'X_CLIP'});
6352 0   0     0 my $y = int($params->{'y'} || $self->{'Y_CLIP'});
6353 0         0 my $clipw = $self->{'W_CLIP'};
6354 0         0 my $cliph = $self->{'H_CLIP'};
6355 0   0     0 my $w = int($params->{'width'} || $clipw);
6356 0   0     0 my $h = int($params->{'height'} || $cliph);
6357 0         0 my $buf;
6358              
6359 0 0       0 $x = 0 if ($x < 0);
6360 0 0       0 $y = 0 if ($y < 0);
6361 0 0       0 $w = $self->{'XX_CLIP'} - $x if ($w > ($clipw));
6362 0 0       0 $h = $self->{'YY_CLIP'} - $y if ($h > ($cliph));
6363              
6364 0         0 my $W = $w * $self->{'BYTES'};
6365 0         0 my $scrn = '';
6366 0 0 0     0 if ($h > 1 && $self->{'ACCELERATED'} == SOFTWARE) {
6367 0         0 $scrn = chr(0) x ($W * $h);
6368             c_blit_read(
6369             $self->{'SCREEN'},
6370             $self->{'XRES'}, $self->{'YRES'},
6371             $self->{'BYTES_PER_LINE'},
6372             $self->{'XOFFSET'}, $self->{'YOFFSET'},
6373             $scrn,
6374             $x, $y, $w, $h,
6375             $self->{'BYTES'},
6376             $draw_mode,
6377             $self->{'COLOR_ALPHA'},
6378             $self->{'RAW_BACKGROUND_COLOR'},
6379 0         0 $self->{'X_CLIP'}, $self->{'Y_CLIP'}, $self->{'XX_CLIP'}, $self->{'YY_CLIP'}
6380             );
6381             } else {
6382 0         0 my $yend = $y + $h;
6383 0         0 my $XX = ($self->{'XOFFSET'} + $x) * $self->{'BYTES'};
6384 0         0 foreach my $line ($y .. ($yend - 1)) {
6385 0         0 my $index = ($self->{'BYTES_PER_LINE'} * ($line + $self->{'YOFFSET'})) + $XX;
6386 0         0 $scrn .= substr($self->{'SCREEN'}, $index, $W);
6387             }
6388             }
6389 0         0 return ({ 'x' => $x, 'y' => $y, 'width' => $w, 'height' => $h, 'image' => $scrn });
6390             }
6391              
6392             sub blit_write {
6393             =head2 blit_write
6394              
6395             Writes a previously read block of screen data at x,y,width,height.
6396              
6397             It takes a hash reference. It draws in the current drawing mode.
6398              
6399             =over 4
6400              
6401             $fb->blit_write({
6402             'x' => 0,
6403             'y' => 0,
6404             'width' => 100,
6405             'height' => 100,
6406             'image' => $blit_data
6407             });
6408              
6409             =back
6410              
6411             =cut
6412              
6413 0     0 0 0 my $self = shift;
6414 0         0 my $pparams = shift;
6415 0 0       0 return unless(defined($pparams));
6416              
6417 0         0 my $params = $self->_blit_adjust_for_clipping($pparams);
6418 0 0       0 return unless (defined($params));
6419              
6420 0   0     0 my $x = int($params->{'x'} || 0);
6421 0   0     0 my $y = int($params->{'y'} || 0);
6422 0   0     0 my $w = int($params->{'width'} || 1);
6423 0   0     0 my $h = int($params->{'height'} || 1);
6424              
6425 0         0 my $draw_mode = $self->{'DRAW_MODE'};
6426 0         0 my $bytes = $self->{'BYTES'};
6427              
6428 0 0 0     0 return unless (defined($params->{'image'}) && $params->{'image'} ne '' && $h && $w);
      0        
      0        
6429              
6430 0 0       0 if ($self->{'ACCELERATED'} == SOFTWARE) { # && $h > 1) {
6431             c_blit_write(
6432             $self->{'SCREEN'},
6433             $self->{'XRES'}, $self->{'YRES'},
6434             $self->{'BYTES_PER_LINE'},
6435             $self->{'XOFFSET'}, $self->{'YOFFSET'},
6436             $params->{'image'},
6437             $x, $y, $w, $h,
6438             $bytes,
6439             $draw_mode,
6440             $self->{'COLOR_ALPHA'},
6441             $self->{'RAW_BACKGROUND_COLOR'},
6442 0         0 $self->{'X_CLIP'}, $self->{'Y_CLIP'}, $self->{'XX_CLIP'}, $self->{'YY_CLIP'}
6443             );
6444             } else {
6445 0         0 my $scrn = $params->{'image'};
6446 0         0 my $max = $self->{'fscreeninfo'}->{'smem_len'} - $bytes;
6447 0         0 my $scan = $w * $bytes;
6448 0         0 my $yend = $y + $h;
6449              
6450             # my $WW = $scan * $h;
6451 0         0 my $WW = int((length($scrn) / $h));
6452 0         0 my $X_X = ($x + $self->{'XOFFSET'}) * $bytes;
6453 0         0 my ($index, $data, $px, $line, $idx, $px4, $buf, $ipx);
6454              
6455 0         0 $idx = 0;
6456 0         0 $y += $self->{'YOFFSET'};
6457 0         0 $yend += $self->{'YOFFSET'};
6458              
6459 0         0 eval {
6460 0         0 foreach $line ($y .. ($yend - 1)) {
6461 0         0 $index = ($self->{'BYTES_PER_LINE'} * $line) + $X_X;
6462 0 0 0     0 if ($index >= 0 && $index <= $max && $idx >= 0 && $idx <= (length($scrn) - $bytes)) {
      0        
      0        
6463 0 0       0 if ($draw_mode == NORMAL_MODE) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
6464 0         0 substr($self->{'SCREEN'}, $index, $scan) = substr($scrn, $idx, $scan);
6465             } elsif ($draw_mode == XOR_MODE) {
6466 0         0 substr($self->{'SCREEN'}, $index, $scan) ^= substr($scrn, $idx, $scan);
6467             } elsif ($draw_mode == OR_MODE) {
6468 0         0 substr($self->{'SCREEN'}, $index, $scan) |= substr($scrn, $idx, $scan);
6469             } elsif ($draw_mode == ADD_MODE) {
6470 0         0 substr($self->{'SCREEN'}, $index, $scan) += substr($scrn, $idx, $scan);
6471             } elsif ($draw_mode == SUBTRACT_MODE) {
6472 0         0 substr($self->{'SCREEN'}, $index, $scan) -= substr($scrn, $idx, $scan);
6473             } elsif ($draw_mode == MULTIPLY_MODE) {
6474 0         0 substr($self->{'SCREEN'}, $index, $scan) *= substr($scrn, $idx, $scan);
6475             } elsif ($draw_mode == DIVIDE_MODE) {
6476 0         0 substr($self->{'SCREEN'}, $index, $scan) /= substr($scrn, $idx, $scan);
6477             } elsif ($draw_mode == ALPHA_MODE) {
6478 0         0 foreach $px (0 .. ($w - 1)) {
6479 0         0 $px4 = $px * $bytes;
6480 0         0 $ipx = $index + $px4;
6481 0   0     0 $data = substr($self->{'SCREEN'}, $ipx, $bytes) || chr(0) x $bytes;
6482 0 0       0 if ($self->{'BITS'} == 32) {
    0          
    0          
6483 0         0 my ($r, $g, $b, $a) = unpack("C$bytes", $data);
6484 0         0 my ($R, $G, $B, $A) = unpack("C$bytes", substr($scrn, ($idx + $px4), $bytes));
6485 0         0 my $invA = (255 - $A);
6486 0         0 $r = int(($R * $A) + ($r * $invA)) >> 8;
6487 0         0 $g = int(($G * $A) + ($g * $invA)) >> 8;
6488 0         0 $b = int(($B * $A) + ($b * $invA)) >> 8;
6489              
6490 0         0 my $c = pack("C$bytes", $r, $g, $b, $A);
6491 0 0       0 if (substr($scrn, ($idx + $px4), $bytes) ne $c) {
6492 0         0 substr($self->{'SCREEN'}, $ipx, $bytes) = $c;
6493             }
6494             } elsif ($self->{'BITS'} == 24) {
6495 0         0 my ($r, $g, $b) = unpack("C$bytes", $data);
6496 0         0 my ($R, $G, $B) = unpack("C$bytes", substr($scrn, ($idx + $px4), $bytes));
6497 0         0 my $A = $self->{'COLOR_ALPHA'};
6498 0         0 my $invA = (255 - $A);
6499 0         0 $r = int(($R * $A) + ($r * $invA)) >> 8;
6500 0         0 $g = int(($G * $A) + ($g * $invA)) >> 8;
6501 0         0 $b = int(($B * $A) + ($b * $invA)) >> 8;
6502 0         0 my $c = pack('C3', $r, $g, $b);
6503              
6504 0 0       0 if (substr($scrn, ($idx + $px4), $bytes) ne $c) {
6505 0         0 substr($self->{'SCREEN'}, $ipx, $bytes) = $c;
6506             }
6507             } elsif ($self->{'BITS'} == 16) {
6508 0         0 my $big = $self->RGB565_to_RGB888({ 'color' => $data });
6509 0         0 my ($r, $g, $b) = unpack('C3', $big->{'color'});
6510 0         0 $big = $self->RGB565_to_RGB888({ 'color' => substr($scrn, ($idx + $px4, $bytes)) });
6511 0         0 my ($R, $G, $B) = unpack('C3', $big->{'color'});
6512 0         0 my $A = $self->{'COLOR_ALPHA'};
6513 0         0 my $invA = (255 - $A);
6514 0         0 $r = int(($R * $A) + ($r * $invA)) >> 8;
6515 0         0 $g = int(($G * $A) + ($g * $invA)) >> 8;
6516 0         0 $b = int(($B * $A) + ($b * $invA)) >> 8;
6517 0         0 my $c = $self->RGB888_to_RGB565({ 'color' => pack('C3', $r, $g, $b) });
6518 0         0 $c = $c->{'color'};
6519              
6520 0 0       0 if (substr($scrn, ($idx + $px4), $bytes) ne $c) {
6521 0         0 substr($self->{'SCREEN'}, $ipx, $bytes) = $c;
6522             }
6523             }
6524             }
6525             } elsif ($draw_mode == AND_MODE) {
6526 0         0 substr($self->{'SCREEN'}, $index, $scan) &= substr($scrn, $idx, $scan);
6527             } elsif ($draw_mode == MASK_MODE) {
6528 0         0 foreach $px (0 .. ($w - 1)) {
6529 0         0 $px4 = $px * $bytes;
6530 0         0 $ipx = $index + $px4;
6531 0   0     0 $data = substr($self->{'SCREEN'}, $ipx, $bytes) || chr(0) x $bytes;
6532 0 0       0 if ($self->{'BITS'} == 32) {
    0          
    0          
6533 0 0       0 if (substr($scrn, ($idx + $px4), 3) ne substr($self->{'RAW_BACKGROUND_COLOR'}, 0, 3)) {
6534 0         0 substr($self->{'SCREEN'}, $ipx, $bytes) = substr($scrn, ($idx + $px4), $bytes);
6535             }
6536             } elsif ($self->{'BITS'} == 24) {
6537 0 0       0 if (substr($scrn, ($idx + $px4), 3) ne $self->{'RAW_BACKGROUND_COLOR'}) {
6538 0         0 substr($self->{'SCREEN'}, $ipx, $bytes) = substr($scrn, ($idx + $px4), $bytes);
6539             }
6540             } elsif ($self->{'BITS'} == 16) {
6541 0 0       0 if (substr($scrn, ($idx + $px4), 2) ne $self->{'RAW_BACKGROUND_COLOR'}) {
6542 0         0 substr($self->{'SCREEN'}, $ipx, $bytes) = substr($scrn, ($idx + $px4), $bytes);
6543             }
6544             }
6545             }
6546             } elsif ($draw_mode == UNMASK_MODE) {
6547 0         0 foreach $px (0 .. ($w - 1)) {
6548 0         0 $px4 = $px * $bytes;
6549 0         0 $ipx = $index + $px4;
6550 0         0 $data = substr($self->{'SCREEN'}, $ipx, $bytes);
6551 0 0       0 if ($self->{'BITS'} == 32) {
    0          
    0          
6552 0 0       0 if (substr($self->{'SCREEN'}, $ipx, 3) eq substr($self->{'RAW_BACKGROUND_COLOR'}, 0, 3)) {
6553 0         0 substr($self->{'SCREEN'}, $ipx, $bytes) = substr($scrn, ($idx + $px4), $bytes);
6554             }
6555             } elsif ($self->{'BITS'} == 24) {
6556 0 0       0 if (substr($self->{'SCREEN'}, $ipx, 3) eq $self->{'RAW_BACKGROUND_COLOR'}) {
6557 0         0 substr($self->{'SCREEN'}, $ipx, $bytes) = substr($scrn, ($idx + $px4), $bytes);
6558             }
6559             } elsif ($self->{'BITS'} == 16) {
6560 0 0       0 if (substr($self->{'SCREEN'}, $ipx, 2) eq $self->{'RAW_BACKGROUND_COLOR'}) {
6561 0         0 substr($self->{'SCREEN'}, $ipx, $bytes) = substr($scrn, ($idx + $px4), $bytes);
6562             }
6563             }
6564             }
6565             }
6566 0         0 $idx += $WW;
6567             }
6568             }
6569             };
6570 0 0       0 if ($@) {
6571 0 0       0 warn __LINE__ . " $@" if ($self->{'SHOW_ERRORS'});
6572 0         0 $self->_fix_mapping();
6573             }
6574             }
6575             }
6576              
6577             sub _blit_adjust_for_clipping {
6578             # Chops up the blit image to stay within the clipping (and screen) boundaries
6579             # This prevents nasty crashes
6580 0     0   0 my $self = shift;
6581 0         0 my $pparams = shift;
6582              
6583 0         0 my $bytes = $self->{'BYTES'};
6584 0         0 my $yclip = $self->{'Y_CLIP'};
6585 0         0 my $xclip = $self->{'X_CLIP'};
6586 0         0 my $yyclip = $self->{'YY_CLIP'};
6587 0         0 my $xxclip = $self->{'XX_CLIP'};
6588 0         0 my $params;
6589              
6590             # Make a copy so the original isn't modified.
6591 0         0 %{$params} = %{$pparams};
  0         0  
  0         0  
6592              
6593             # First fix the vertical errors
6594 0         0 my $XX = $params->{'x'} + $params->{'width'};
6595 0         0 my $YY = $params->{'y'} + $params->{'height'};
6596 0 0 0     0 return (undef) if ($YY < $yclip || $params->{'height'} < 1 || $XX < $xclip || $params->{'x'} > $xxclip);
      0        
      0        
6597 0 0       0 if ($params->{'y'} < $yclip) { # Top
6598 0         0 $params->{'image'} = substr($params->{'image'}, ($yclip - $params->{'y'}) * ($params->{'width'} * $bytes));
6599 0         0 $params->{'height'} -= ($yclip - $params->{'y'});
6600 0         0 $params->{'y'} = $yclip;
6601             }
6602 0         0 $YY = $params->{'y'} + $params->{'height'};
6603 0 0       0 return (undef) if ($params->{'height'} < 1);
6604 0 0       0 if ($YY > $yyclip) { # Bottom
6605 0         0 $params->{'image'} = substr($params->{'image'}, 0, ($yyclip - $params->{'y'}) * ($params->{'width'} * $bytes));
6606 0         0 $params->{'height'} = $yyclip - $params->{'y'};
6607             }
6608              
6609             # Now we fix the horizontal errors
6610 0 0       0 if ($params->{'x'} < $xclip) { # Left
6611 0         0 my $line = $params->{'width'} * $bytes;
6612 0         0 my $index = ($xclip - $params->{'x'}) * $bytes;
6613 0         0 my $w = $params->{'width'} - ($xclip - $params->{'x'});
6614 0         0 my $new = '';
6615 0         0 foreach my $yl (0 .. ($params->{'height'} - 1)) {
6616 0         0 $new .= substr($params->{'image'}, ($line * $yl) + $index, $w * $bytes);
6617             }
6618 0         0 $params->{'image'} = $new;
6619 0         0 $params->{'width'} = $w;
6620 0         0 $params->{'x'} = $xclip;
6621             }
6622 0         0 $XX = $params->{'x'} + $params->{'width'};
6623 0 0       0 if ($XX > $xxclip) { # Right
6624 0         0 my $line = $params->{'width'} * $bytes;
6625 0         0 my $new = '';
6626 0         0 my $w = $xxclip - $params->{'x'};
6627 0         0 foreach my $yl (0 .. ($params->{'height'} - 1)) {
6628 0         0 $new .= substr($params->{'image'}, $line * $yl, $w * $bytes);
6629             }
6630 0         0 $params->{'image'} = $new;
6631 0         0 $params->{'width'} = $w;
6632             }
6633              
6634 0         0 my $size = ($params->{'width'} * $params->{'height'}) * $bytes;
6635 0 0       0 if (length($params->{'image'}) < $size) {
    0          
6636 0         0 $params->{'image'} .= chr(0) x ($size - length($params->{'image'}));
6637             } elsif (length($params->{'image'}) > $size) {
6638 0         0 $params->{'image'} = substr($params->{'image'}, 0, $size);
6639             }
6640 0         0 return ($params);
6641             }
6642              
6643             sub blit_transform {
6644             =head2 blit_transform
6645              
6646             This performs transformations on your blit objects.
6647              
6648             You can only have one of "rotate", "scale", "merge", "flip", or make "monochrome". You may use only one transformation per call.
6649              
6650             =head3 B (mandatory)
6651              
6652             Used by all transformations. It's the image data to process, in the format that "blit_write" uses. See the example below.
6653              
6654             =head3 B
6655              
6656             Flips the image either "horizontally, "vertically, or "both"
6657              
6658             =head3 B
6659              
6660             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).
6661              
6662             This is very usefull in 32 bit mode due to its alpha channel capabilities.
6663              
6664             =head3 B
6665              
6666             Rotates the "blit_data" image an arbitrary degree. Positive degree values are counterclockwise and negative degree values are clockwise.
6667              
6668             Two types of rotate methods are available, an extrememly fast, but visually slightly less appealing method, and a slower, but looks better, method. Seriously though, the fast method looks pretty darn good anyway. I recommend "fast".
6669              
6670             =head3 B
6671              
6672             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).
6673              
6674             =over 4
6675              
6676             $fb->blit_transform(
6677             {
6678             # blit_data is mandatory
6679             'blit_data' => { # Same as what blit_read or load_image returns
6680             'x' => 0, # This is relative to the dimensions of "dest_blit_data" for "merge"
6681             'y' => 0, # ^^
6682             'width' => 300,
6683             'height' => 200,
6684             'image' => $image_data
6685             },
6686              
6687             'merge' => {
6688             'dest_blit_data' => { # MUST have same or greater dimensions as 'blit_data'
6689             'x' => 0,
6690             'y' => 0,
6691             'width' => 300,
6692             'height' => 200,
6693             'image' => $image_data
6694             }
6695             },
6696              
6697             'rotate' => {
6698             'degrees' => 45, # 0-360 degrees. Negative numbers rotate clockwise.
6699             'quality' => 'high', # "high" or "fast" are your choices, with "fast" being the default
6700             },
6701              
6702             'flip' => 'horizontal', # or "vertical" or "both"
6703              
6704             'scale' => {
6705             'x' => 0,
6706             'y' => 0,
6707             'width' => 500,
6708             'height' => 300,
6709             'scale_type' => 'min' # 'min' = The smaller of the two
6710             # sizes are used (default)
6711             # 'max' = The larger of the two
6712             # sizes are used
6713             # 'nonprop' = Non-proportional sizing
6714             # The image is scaled to
6715             # width x height exactly.
6716             },
6717              
6718             'monochrome' => TRUE # Makes the image data monochrome
6719             }
6720             );
6721              
6722             =back
6723              
6724             It returns the transformed image in the same format the other BLIT methods use. Note, the width and height may be changed! So always use the returned data as the correct new data.
6725              
6726             =over 4
6727              
6728             {
6729             'x' => 0, # copied from "blit_data"
6730             'y' => 0, # copied from "blit_data"
6731             'width' => 100, # width of transformed image data
6732             'height' => 100, # height of transformed image data
6733             'image' => $image # image data
6734             }
6735              
6736             =back
6737              
6738             * Rotate and Flip is affected by the acceleration setting.
6739              
6740             =cut
6741              
6742 0     0 0 0 my $self = shift;
6743 0         0 my $params = shift;
6744              
6745 0         0 my $width = $params->{'blit_data'}->{'width'};
6746 0         0 my $height = $params->{'blit_data'}->{'height'};
6747 0         0 my $bytes = $self->{'BYTES'};
6748 0         0 my $bline = $width * $bytes;
6749 0         0 my $image = $params->{'blit_data'}->{'image'};
6750 0         0 my $xclip = $self->{'X_CLIP'};
6751 0         0 my $yclip = $self->{'Y_CLIP'};
6752 0         0 my $data;
6753              
6754 0 0       0 if (exists($params->{'merge'})) {
6755 0 0       0 $image = $self->_convert_16_to_24($image, RGB) if ($self->{'BITS'} == 16);
6756 0         0 eval {
6757 0         0 my $img = Imager->new();
6758 0         0 $img->read(
6759             'xsize' => $width,
6760             'ysize' => $height,
6761             'raw_datachannels' => max(3, $bytes),
6762             'raw_storechannels' => max(3, $bytes),
6763             'raw_interleave' => FALSE,
6764             'data' => $image,
6765             'type' => 'raw',
6766             'allow_incomplete' => TRUE
6767             );
6768 0         0 my $dest = Imager->new();
6769             $dest->read(
6770             'xsize' => $params->{'merge'}->{'dest_blit_data'}->{'width'},
6771             'ysize' => $params->{'merge'}->{'dest_blit_data'}->{'height'},
6772             'raw_datachannels' => max(3, $bytes),
6773             'raw_storechannels' => max(3, $bytes),
6774             'raw_interleave' => FALSE,
6775 0         0 'data' => $params->{'merge'}->{'dest_blit_data'}->{'image'},
6776             'type' => 'raw',
6777             'allow_incomplete' => TRUE
6778             );
6779             $dest->compose(
6780             'src' => $img,
6781             'tx' => $params->{'blit_data'}->{'x'},
6782 0         0 'ty' => $params->{'blit_data'}->{'y'},
6783             );
6784 0         0 $width = $dest->getwidth();
6785 0         0 $height = $dest->getheight();
6786 0         0 $dest->write(
6787             'type' => 'raw',
6788             'datachannels' => max(3, $bytes),
6789             'storechannels' => max(3, $bytes),
6790             'interleave' => FALSE,
6791             'data' => \$data
6792             );
6793             };
6794 0 0 0     0 warn __LINE__ . " $@\n", Imager->errstr() if ($@ && $self->{'SHOW_ERRORS'});
6795              
6796 0 0       0 $data = $self->_convert_24_to_16($data, RGB) if ($self->{'BITS'} == 16);
6797             return (
6798             {
6799             'x' => $params->{'merge'}->{'dest_blit_data'}->{'x'},
6800 0         0 'y' => $params->{'merge'}->{'dest_blit_data'}->{'y'},
6801             'width' => $width,
6802             'height' => $height,
6803             'image' => $data
6804             }
6805             );
6806             }
6807 0 0       0 if (exists($params->{'flip'})) {
    0          
    0          
    0          
    0          
6808 0         0 my $image = "$params->{'blit_data'}->{'image'}";
6809 0         0 my $new = '';
6810 0 0       0 if ($self->{'ACCELERATED'}) {
6811 0         0 $new = "$image";
6812 0 0       0 if (lc($params->{'flip'}) eq 'vertical') {
    0          
    0          
6813 0         0 c_flip_vertical($new, $width, $height, $bytes);
6814             } elsif (lc($params->{'flip'}) eq 'horizontal') {
6815 0         0 c_flip_horizontal($new, $width, $height, $bytes);
6816             } elsif (lc($params->{'flip'}) eq 'both') {
6817 0         0 c_flip_both($new, $width, $height, $bytes);
6818             }
6819             } else {
6820 0 0       0 if (lc($params->{'flip'}) eq 'vertical') {
    0          
6821 0         0 for (my $y = ($height - 1); $y >= 0; $y--) {
6822 0         0 $new .= substr($image, ($y * $bline), $bline);
6823             }
6824             } elsif (lc($params->{'flip'}) eq 'horizontal') {
6825 0         0 foreach my $y (0 .. ($height - 1)) {
6826 0         0 for (my $x = ($width - 1); $x >= 0; $x--) {
6827 0         0 $new .= substr($image, (($x * $bytes) + ($y * $bline)), $bytes);
6828             }
6829             }
6830             } else {
6831 0         0 $new = "$image";
6832             }
6833             }
6834             return (
6835             {
6836             'x' => $params->{'blit_data'}->{'x'},
6837 0         0 'y' => $params->{'blit_data'}->{'y'},
6838             'width' => $width,
6839             'height' => $height,
6840             'image' => $new
6841             }
6842             );
6843             } elsif (exists($params->{'rotate'})) {
6844 0         0 my $degrees = $params->{'rotate'}->{'degrees'};
6845 0         0 while (abs($degrees) > 360) { # normalize
6846 0 0       0 if ($degrees > 360) {
6847 0         0 $degrees -= 360;
6848             } else {
6849 0         0 $degrees += 360;
6850             }
6851             }
6852 0 0 0     0 return ($params->{'blit_data'}) if (abs($degrees) == 360 || $degrees == 0); # 0 and 360 are not a rotation
6853 0 0 0     0 unless ($params->{'rotate'}->{'quality'} eq 'high' || $self->{'ACCELERATED'} == PERL) {
6854 0 0       0 if (abs($degrees) == 180) {
6855 0         0 my $new = "$image";
6856 0         0 c_flip_both($new, $width, $height, $bytes);
6857             return (
6858             {
6859             'x' => $params->{'blit_data'}->{'x'},
6860 0         0 'y' => $params->{'blit_data'}->{'y'},
6861             'width' => $width,
6862             'height' => $height,
6863             'image' => $new
6864             }
6865             );
6866             } else {
6867 0         0 my $wh = int(sqrt($width**2 + $height**2) + .5);
6868              
6869             # Try to define as much as possible before the loop to optimize
6870 0         0 $data = $self->{'RAW_BACKGROUND_COLOR'} x (($wh**2) * $bytes);
6871              
6872 0         0 c_rotate($image, $data, $width, $height, $wh, $degrees, $bytes);
6873             return (
6874             {
6875             'x' => $params->{'blit_data'}->{'x'},
6876 0         0 'y' => $params->{'blit_data'}->{'y'},
6877             'width' => $wh,
6878             'height' => $wh,
6879             'image' => $data
6880             }
6881             );
6882             }
6883             } else {
6884 0         0 eval {
6885 0         0 my $img = Imager->new();
6886 0 0       0 $image = $self->_convert_16_to_24($image, RGB) if ($self->{'BITS'} == 16);
6887 0         0 $img->read(
6888             'xsize' => $width,
6889             'ysize' => $height,
6890             'raw_storechannels' => max(3, $bytes),
6891             'raw_datachannels' => max(3, $bytes),
6892             'raw_interleave' => FALSE,
6893             'data' => $image,
6894             'type' => 'raw',
6895             'allow_incomplete' => TRUE
6896             );
6897 0         0 my $rotated;
6898 0 0 0     0 if (abs($degrees) == 90 || abs($degrees) == 180 || abs($degrees) == 270) {
      0        
6899 0         0 $rotated = $img->rotate('right' => 0 - $degrees, 'back' => $self->{'IMAGER_BACKGROUND_COLOR'});
6900             } else {
6901 0         0 $rotated = $img->rotate('degrees' => 0 - $degrees, 'back' => $self->{'IMAGER_BACKGROUND_COLOR'});
6902             }
6903 0         0 $width = $rotated->getwidth();
6904 0         0 $height = $rotated->getheight();
6905 0         0 $img = $rotated;
6906 0         0 $img->write(
6907             'type' => 'raw',
6908             'storechannels' => max(3, $bytes),
6909             'interleave' => FALSE,
6910             'data' => \$data
6911             );
6912 0 0       0 $data = $self->_convert_24_to_16($data, RGB) if ($self->{'BITS'} == 16);
6913             };
6914 0 0 0     0 warn __LINE__ . " $@\n", Imager->errstr() if ($@ && $self->{'SHOW_ERRORS'});
6915             }
6916             return (
6917             {
6918             'x' => $params->{'blit_data'}->{'x'},
6919 0         0 'y' => $params->{'blit_data'}->{'y'},
6920             'width' => $width,
6921             'height' => $height,
6922             'image' => $data
6923             }
6924             );
6925             } elsif (exists($params->{'scale'})) {
6926 0 0       0 $image = $self->_convert_16_to_24($image, $self->{'COLOR_ORDER'}) if ($self->{'BITS'} == 16);
6927              
6928 0         0 eval {
6929 0         0 my $img = Imager->new();
6930 0         0 $img->read(
6931             'xsize' => $width,
6932             'ysize' => $height,
6933             'raw_storechannels' => max(3, $bytes),
6934             'raw_datachannels' => max(3, $bytes),
6935             'raw_interleave' => FALSE,
6936             'data' => $image,
6937             'type' => 'raw',
6938             'allow_incomplete' => TRUE
6939             );
6940              
6941 0 0       0 $img = $img->convert('preset' => 'addalpha') if ($self->{'BITS'} == 32);
6942             my %scale = (
6943             'xpixels' => $params->{'scale'}->{'width'},
6944             'ypixels' => $params->{'scale'}->{'height'},
6945 0   0     0 'type' => $params->{'scale'}->{'scale_type'} || 'min'
6946             );
6947 0         0 my ($xs, $ys);
6948              
6949 0         0 ($xs, $ys, $width, $height) = $img->scale_calculate(%scale);
6950 0         0 my $scaledimg = $img->scale(%scale);
6951 0         0 $scaledimg->write(
6952             'type' => 'raw',
6953             'storechannels' => max(3, $bytes),
6954             'interleave' => FALSE,
6955             'data' => \$data
6956             );
6957             };
6958 0 0 0     0 warn __LINE__ . " $@\n", Imager->errstr() if ($@ && $self->{'SHOW_ERRORS'});
6959 0 0       0 $data = $self->_convert_24_to_16($data, $self->{'COLOR_ORDER'}) if ($self->{'BITS'} == 16);
6960             return (
6961             {
6962             'x' => $params->{'blit_data'}->{'x'},
6963 0         0 'y' => $params->{'blit_data'}->{'y'},
6964             'width' => $width,
6965             'height' => $height,
6966             'image' => $data
6967             }
6968             );
6969             } elsif (exists($params->{'monochrome'})) {
6970 0         0 return ($self->monochrome({ 'image' => $params->{'blit_data'}, 'bits' => $self->{'BITS'} }));
6971             } elsif (exists($params->{'center'})) {
6972 0         0 my $XX = $self->{'W_CLIP'};
6973 0         0 my $YY = $self->{'H_CLIP'};
6974 0         0 my ($x, $y) = ($params->{'blit_data'}->{'x'}, $params->{'blit_data'}->{'y'});
6975 0 0 0     0 if ($params->{'center'} == CENTER_X || $params->{'center'} == CENTER_XY) {
6976 0         0 $x = $xclip + int(($XX - $width) / 2);
6977             }
6978 0 0 0     0 if ($params->{'center'} == CENTER_Y || $params->{'center'} == CENTER_XY) {
6979 0         0 $y = $self->{'Y_CLIP'} + int(($YY - $height) / 2);
6980             }
6981             return (
6982             {
6983             'x' => $x,
6984             'y' => $y,
6985             'width' => $width,
6986             'height' => $height,
6987 0         0 'image' => $params->{'blit_data'}->{'image'}
6988             }
6989             );
6990              
6991             }
6992             }
6993              
6994             sub clip_reset {
6995             =head2 clip_reset
6996              
6997             Turns off clipping, and resets the clipping values to the full size of the screen.
6998              
6999             =over 4
7000              
7001             $fb->clip_reset();
7002              
7003             =back
7004             =cut
7005              
7006             # Clipping is not really turned off. It's just set to the screen borders. To turn off clipping for real is asking for crashes.
7007 2     2 0 10 my $self = shift;
7008              
7009 2         8 $self->{'X_CLIP'} = 0;
7010 2         5 $self->{'Y_CLIP'} = 0;
7011 2         7 $self->{'XX_CLIP'} = ($self->{'XRES'} - 1);
7012 2         10 $self->{'YY_CLIP'} = ($self->{'YRES'} - 1);
7013 2         21 $self->{'W_CLIP'} = $self->{'XRES'};
7014 2         24 $self->{'H_CLIP'} = $self->{'YRES'};
7015 2         10 $self->{'CLIPPED'} = FALSE; ## This is merely a flag to see if a clipping
7016             ## region is defined under the screen dimensions.
7017             }
7018              
7019             sub clip_off {
7020             =head2 clip_off
7021              
7022             This is an alias to 'clip_reset'
7023              
7024             =cut
7025              
7026 0     0 0 0 my $self = shift;
7027 0         0 $self->clip_reset();
7028             }
7029              
7030             sub clip_set {
7031             =head2 clip_set
7032              
7033             Sets the clipping rectangle starting at the top left point x,y and ending at bottom right point xx,yy.
7034              
7035             =over 4
7036              
7037             $fb->clip_set({
7038             'x' => 10,
7039             'y' => 10,
7040             'xx' => 300,
7041             'yy' => 300
7042             });
7043              
7044             =back
7045             =cut
7046              
7047 0     0 0 0 my $self = shift;
7048 0         0 my $params = shift;
7049              
7050 0         0 $self->{'X_CLIP'} = abs(int($params->{'x'}));
7051 0         0 $self->{'Y_CLIP'} = abs(int($params->{'y'}));
7052 0         0 $self->{'XX_CLIP'} = abs(int($params->{'xx'}));
7053 0         0 $self->{'YY_CLIP'} = abs(int($params->{'yy'}));
7054              
7055 0 0       0 $self->{'X_CLIP'} = ($self->{'XRES'} - 2) if ($self->{'X_CLIP'} > ($self->{'XRES'} - 1));
7056 0 0       0 $self->{'Y_CLIP'} = ($self->{'YRES'} - 2) if ($self->{'Y_CLIP'} > ($self->{'YRES'} - 1));
7057 0 0       0 $self->{'XX_CLIP'} = ($self->{'XRES'} - 1) if ($self->{'XX_CLIP'} >= $self->{'XRES'});
7058 0 0       0 $self->{'YY_CLIP'} = ($self->{'YRES'} - 1) if ($self->{'YY_CLIP'} >= $self->{'YRES'});
7059 0         0 $self->{'W_CLIP'} = $self->{'XX_CLIP'} - $self->{'X_CLIP'};
7060 0         0 $self->{'H_CLIP'} = $self->{'YY_CLIP'} - $self->{'Y_CLIP'};
7061 0         0 $self->{'CLIPPED'} = TRUE;
7062             }
7063              
7064             sub clip_rset {
7065             =head2 clip_rset
7066              
7067             Sets the clipping rectangle to point x,y,width,height
7068              
7069             =over 4
7070              
7071             $fb->clip_rset({
7072             'x' => 10,
7073             'y' => 10,
7074             'width' => 600,
7075             'height' => 400
7076             });
7077              
7078             =back
7079             =cut
7080              
7081 0     0 0 0 my $self = shift;
7082 0         0 my $params = shift;
7083              
7084 0         0 $params->{'xx'} = $params->{'x'} + $params->{'width'};
7085 0         0 $params->{'yy'} = $params->{'y'} + $params->{'height'};
7086              
7087 0         0 $self->clip_set($params);
7088             }
7089              
7090             sub monochrome {
7091             =head2 monochrome
7092              
7093             Removes all color information from an image, and leaves everything in greyscale.
7094              
7095             It applies the following formula to calculate greyscale:
7096              
7097             grey_color = (red * 0.2126) + (green * 0.7155) + (blue * 0.0722)
7098              
7099             =over 4
7100              
7101             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.
7102              
7103             $fb->monochrome({
7104             'image' => "image data",
7105             'bits' => 32
7106             });
7107              
7108             It returns 'image' back, but now in greyscale (still the same RGB format though).
7109              
7110             {
7111             'image' => "monochrome image data"
7112             }
7113              
7114             =back
7115              
7116             * You should normally use "blit_transform", but this is a more raw way of affecting the data
7117              
7118             =cut
7119              
7120 0     0 0 0 my $self = shift;
7121 0         0 my $params = shift;
7122              
7123 0         0 my ($r, $g, $b);
7124              
7125 0         0 my ($ro, $go, $bo) = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'}, $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'}, $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'});
7126 0         0 my ($rl, $gl, $bl) = ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'}, $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'}, $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'});
7127              
7128 0         0 my $color_order = $self->{'COLOR_ORDER'};
7129 0         0 my $size = length($params->{'image'});
7130              
7131 0         0 my $inc;
7132 0 0       0 if ($params->{'bits'} == 32) {
    0          
    0          
7133 0         0 $inc = 4;
7134             } elsif ($params->{'bits'} == 24) {
7135 0         0 $inc = 3;
7136             } elsif ($params->{'bits'} == 16) {
7137 0         0 $inc = 2;
7138             } else { # Only 32, 24, or 16 bits allowed
7139 0         0 return ();
7140             }
7141 0 0       0 if ($self->{'ACCELERATED'}) {
7142 0         0 c_monochrome($params->{'image'}, $size, $color_order, $inc);
7143 0         0 return ($params->{'image'});
7144             } else {
7145 0         0 for (my $byte = 0; $byte < length($params->{'image'}); $byte += $inc) {
7146 0 0       0 if ($inc == 2) {
7147 0         0 my $rgb565 = unpack('S', substr($params->{'image'}, $byte, $inc));
7148 0 0       0 if ($color_order == RGB) {
    0          
7149 0         0 $r = $rgb565 & 31;
7150 0         0 $g = (($rgb565 >> 5) & 63) / 2; # Normalize green
7151 0         0 $b = ($rgb565 >> 11) & 31;
7152             } elsif ($color_order == BGR) {
7153 0         0 $b = $rgb565 & 31;
7154 0         0 $g = (($rgb565 >> 5) & 63) / 2; # Normalize green
7155 0         0 $r = ($rgb565 >> 11) & 31;
7156             }
7157 0         0 my $mono = int(0.2126 * $r + 0.7155 * $g + 0.0722 * $b);
7158 0 0       0 substr($params->{'image'}, $byte, $inc) = pack('S', ($go ? ($mono * 2) << $go : ($mono * 2)) | ($ro ? $mono << $ro : $mono) | ($bo ? $mono << $bo : $mono));
    0          
    0          
7159             } else {
7160 0 0       0 if ($color_order == BGR) {
    0          
    0          
    0          
    0          
    0          
7161 0         0 ($b, $g, $r) = unpack('C3', substr($params->{'image'}, $byte, 3));
7162             } elsif ($color_order == BRG) {
7163 0         0 ($b, $r, $g) = unpack('C3', substr($params->{'image'}, $byte, 3));
7164             } elsif ($color_order == RGB) {
7165 0         0 ($r, $g, $b) = unpack('C3', substr($params->{'image'}, $byte, 3));
7166             } elsif ($color_order == RBG) {
7167 0         0 ($r, $b, $g) = unpack('C3', substr($params->{'image'}, $byte, 3));
7168             } elsif ($color_order == GRB) {
7169 0         0 ($g, $r, $b) = unpack('C3', substr($params->{'image'}, $byte, 3));
7170             } elsif ($color_order == GBR) {
7171 0         0 ($g, $b, $r) = unpack('C3', substr($params->{'image'}, $byte, 3));
7172             }
7173 0         0 my $mono = int(0.2126 * $r + 0.7155 * $g + 0.0722 * $b);
7174 0         0 substr($params->{'image'}, $byte, 3) = pack('C3', $mono, $mono, $mono);
7175             }
7176             }
7177             }
7178 0         0 return ($params->{'image'});
7179             }
7180              
7181             sub ttf_print {
7182             =head2 ttf_print
7183              
7184             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).
7185              
7186             Note, 'y' is the baseline position, not the top left of the bounding box. This is a change from before!!!
7187              
7188             This is best called twice, first in bounding box mode, and then in normal mode.
7189              
7190             Bounding box mode gets the actual values needed to display the text.
7191              
7192             If draw mode is "normal", then mask mode is automatically used for best output.
7193              
7194             =over 4
7195              
7196             my $bounding_box = $fb->ttf_print({
7197             'x' => 20,
7198             'y' => 100, # baseline position
7199             'height' => 16,
7200             'wscale' => 1, # Scales the width. 1 is normal
7201             'color' => 'FFFF00FF', # Hex value of color 00-FF (RRGGBBAA)
7202             'text' => 'Hello World!',
7203             'font_path' => '/usr/share/fonts/truetype', # Optional
7204             'face' => 'Arial.ttf', # Optional
7205             'bounding_box' => TRUE,
7206             'center' => CENTER_X,
7207             'antialias' => TRUE
7208             });
7209              
7210             $fb->ttf_print($bounding_box);
7211              
7212             =back
7213              
7214             Here's a shortcut:
7215              
7216             =over 4
7217              
7218             $fb->ttf_print(
7219             $fb->ttf_print({
7220             'x' => 20,
7221             'y' => 100, # baseline position
7222             'height' => 16,
7223             'color' => 'FFFF00FF', # RRGGBBAA
7224             'text' => 'Hello World!',
7225             'font_path' => '/usr/share/fonts/truetype', # Optional
7226             'face' => 'Arial.ttf', # Optional
7227             'bounding_box' => TRUE,
7228             'rotate' => 45, # optonal
7229             'center' => CENTER_X,
7230             'antialias' => 1,
7231             'shadow' => shadow size
7232             })
7233             );
7234              
7235             =back
7236              
7237             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.
7238              
7239             =cut
7240              
7241             ##############################################################################
7242             # Yes, this is a "hack". #
7243             # -------------------------------------------------------------------------- #
7244             # This uses the 'Imager' package. It allocates a temporary screen buffer #
7245             # and prints to it, then this buffer is dumped to the screen at the x,y #
7246             # coordinates given. Since no decent True Type packages or libraries are #
7247             # available for Perl, this turned out to be the best and easiest solution. #
7248             ##############################################################################
7249 4     4 0 107 my $self = shift;
7250 4         14 my $params = shift;
7251              
7252 4 100       32 return ($params) unless (defined($params));
7253              
7254 2   50     45 my $TTF_x = int($params->{'x'}) || 0;
7255 2   50     30 my $TTF_y = int($params->{'y'}) || 0;
7256 2   50     25 my $TTF_pw = int($params->{'pwidth'}) || 6;
7257 2   50     20 my $TTF_ph = int($params->{'pheight'}) || 6;
7258 2   50     12 my $TTF_h = int($params->{'height'}) || 6;
7259 2   50     16 my $text = $params->{'text'} || ' ';
7260 2   33     23 my $face = $params->{'face'} || $self->{'FONT_FACE'};
7261 2   50     15 my $box_mode = $params->{'bounding_box'} || FALSE;
7262 2   50     7 my $center_mode = $params->{'center'} || 0;
7263 2   33     49 my $font_path = $params->{'font_path'} || $self->{'FONT_PATH'};
7264 2   50     15 my $aa = $params->{'antialias'} || FALSE;
7265 2 50       21 my $P_color = $params->{'color'} if (exists($params->{'color'}));
7266 2         9 my $sizew = $TTF_h;
7267 2 50 33     19 $sizew *= $params->{'wscale'} if (exists($params->{'wscale'}) && defined($params->{'wscale'}));
7268 2         13 my $pfont = "$font_path/$face";
7269              
7270 2         41 $pfont =~ s#/+#/#g; # Get rid of doubled up slashes
7271              
7272 2         8 my $color_order = $self->{'COLOR_ORDER'};
7273 2         5 my $bytes = $self->{'BYTES'};
7274 2         24 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);
7275              
7276 2 50       8 if (defined($P_color)) {
7277 2 50       23 $P_color .= 'FF' if (length($P_color) < 8); # Add opague alpha if it is not defined
7278 2         13 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));
7279 2 50       27 if ($color_order == BGR) {
    50          
    50          
    50          
    50          
7280 0         0 $P_color = $blue . $green . $red . $alpha;
7281             } elsif ($color_order == BRG) {
7282 0         0 $P_color = $blue . $red . $green . $alpha;
7283             } elsif ($color_order == RBG) {
7284 0         0 $P_color = $red . $blue . $green . $alpha;
7285             } elsif ($color_order == GRB) {
7286 0         0 $P_color = $green . $red . $blue . $alpha;
7287             } elsif ($color_order == GBR) {
7288 0         0 $P_color = $green . $blue . $red . $alpha;
7289             }
7290             } else {
7291 0         0 $P_color = $self->{'IMAGER_FOREGROUND_COLOR'};
7292             }
7293              
7294 2         42 my $font = Imager::Font->new(
7295             'file' => $pfont,
7296             'color' => $P_color,
7297             'size' => $TTF_h
7298             );
7299 2 50       932 unless (defined($font)) {
7300 2 50       13 warn __LINE__ . " Can't initialize Imager::Font!\n", Imager->errstr() if ($self->{'SHOW_ERRORS'});
7301 2         21 return (undef);
7302             }
7303 0 0 0     0 if (defined($params->{'rotate'}) && abs($params->{'rotate'}) > 0 && abs($params->{'rotate'} < 360)) {
      0        
7304 0         0 my $matrix;
7305 0         0 eval {
7306 0         0 $matrix = Imager::Matrix2d->rotate('degrees' => $params->{'rotate'});
7307 0         0 $font->transform('matrix' => $matrix);
7308 0         0 my $bbox = $font->bounding_box('string' => $text, 'canon' => 1, 'size' => $TTF_h, 'sizew' => $sizew);
7309 0         0 my ($left, $miny, $right, $maxy) = _transformed_bounds($bbox, $matrix);
7310 0         0 my ($top, $bottom) = (-$maxy, -$miny);
7311 0         0 ($TTF_pw, $TTF_ph) = ($right - $left, $bottom - $top);
7312 0         0 $params->{'pwidth'} = $TTF_pw;
7313 0         0 $params->{'pheight'} = $TTF_ph;
7314             };
7315 0 0 0     0 warn __LINE__ . " $@\n", Imager->errstr() if ($@ && $self->{'SHOW_ERRORS'});
7316             } else {
7317 0         0 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); };
  0         0  
7318 0 0       0 if ($@) {
7319 0 0       0 warn __LINE__ . " $@\n", Imager->errstr() if ($self->{'SHOW_ERRORS'});
7320 0         0 return (undef);
7321             }
7322 0         0 $params->{'pwidth'} = $advance_width;
7323 0         0 $params->{'pheight'} = abs($global_ascent) + abs($global_descent) + 12; # int($TTF_h + $global_ascent + abs($global_descent));
7324 0         0 $TTF_pw = abs($advance_width);
7325             }
7326 0 0       0 if ($center_mode == CENTER_XY) {
    0          
    0          
7327 0         0 $TTF_x = int(($self->{'W_CLIP'} - $TTF_pw) / 2) + $self->{'X_CLIP'};
7328 0         0 $TTF_y = int(($self->{'H_CLIP'} - $TTF_ph) / 2) + abs($global_ascent);
7329             } elsif ($center_mode == CENTER_X) {
7330 0         0 $TTF_x = int(($self->{'W_CLIP'} - $TTF_pw) / 2) + $self->{'X_CLIP'};
7331             } elsif ($center_mode == CENTER_Y) {
7332 0         0 $TTF_y = int(($self->{'H_CLIP'} - $TTF_ph) / 2) + abs($global_ascent);
7333             }
7334 0         0 $params->{'bounding_box'} = FALSE;
7335 0 0       0 if ($box_mode) {
7336 0         0 $params->{'x'} = $TTF_x;
7337 0         0 $params->{'y'} = $TTF_y;
7338 0         0 return ($params);
7339             }
7340 0         0 my $img;
7341             my $image;
7342 0         0 my $draw_mode;
7343 0 0 0     0 if ($TTF_pw <= 0 || $TTF_ph <= 0) {
7344 0 0       0 warn __LINE__ . " Calculated size of font width/height is less than or equal to zero! Cannot render font." if ($self->{'SHOW_ERRORS'});
7345 0         0 return (undef);
7346             }
7347 0         0 eval {
7348 0         0 $img = Imager->new(
7349             'xsize' => $TTF_pw,
7350             'ysize' => $TTF_ph,
7351             'channels' => max(3, $bytes)
7352             );
7353 0 0       0 unless ($self->{'DRAW_MODE'}) {
7354 0 0 0     0 if ($self->{'ACCELERATED'} && !$aa) {
7355 0         0 $draw_mode = $self->{'DRAW_MODE'};
7356 0         0 $self->{'DRAW_MODE'} = MASK_MODE;
7357             } else {
7358 0         0 my $ty = $TTF_y - abs($global_ascent);
7359 0 0       0 $ty = 0 if ($ty < 0);
7360 0         0 $image = $self->blit_read({ 'x' => $TTF_x, 'y' => $ty, 'width' => $TTF_pw, 'height' => $TTF_ph });
7361 0 0       0 $image->{'image'} = $self->_convert_16_to_24($image->{'image'}, RGB) if ($self->{'BITS'} == 16);
7362             $img->read(
7363 0         0 'data' => $image->{'image'},
7364             'type' => 'raw',
7365             'raw_datachannels' => max(3, $bytes),
7366             'raw_storechannels' => max(3, $bytes),
7367             'raw_interleave' => FALSE,
7368             'xsize' => $TTF_pw,
7369             'ysize' => $TTF_ph
7370             );
7371             }
7372             }
7373             $img->string(
7374 0         0 'font' => $font,
7375             'text' => $text,
7376             'x' => 0,
7377             'y' => abs($ascent),
7378             'size' => $TTF_h,
7379             'sizew' => $sizew,
7380             'color' => $P_color,
7381             'aa' => $aa,
7382             );
7383 0         0 $img->write(
7384             'type' => 'raw',
7385             'storechannels' => max(3, $bytes), # Must be at least 24 bit
7386             'interleave' => FALSE,
7387             'data' => \$data
7388             );
7389             };
7390 0 0       0 if ($@) {
7391 0 0       0 warn __LINE__ . " ERROR $@\n", Imager->errstr() . "\n$TTF_pw,$TTF_ph" if ($self->{'SHOW_ERRORS'});
7392 0         0 return (undef);
7393             }
7394 0 0       0 $data = $self->_convert_24_to_16($data, RGB) if ($self->{'BITS'} == 16);
7395 0         0 $self->blit_write({ 'x' => $TTF_x, 'y' => ($TTF_y - abs($global_ascent)), 'width' => $TTF_pw, 'height' => $TTF_ph, 'image' => $data });
7396 0 0       0 $self->{'DRAW_MODE'} = $draw_mode if (defined($draw_mode));
7397 0         0 return ($params);
7398             }
7399              
7400             sub ttf_paragraph {
7401             =head2 ttf_paragraph
7402              
7403             Very similar to an ordinary Perl "print", but uses TTF fonts instead. It will automatically wrap text like a terminal.
7404              
7405             This uses no bounding boxes, and is only needed to be called once. It uses a very simple wrapping model.
7406              
7407             It uses the clipping rectangle. All text will be fit and wrapped within the clipping rectangle.
7408              
7409             Text is started at "x" and wrapped to "x" for each line, no indentation.
7410              
7411             * This does NOT scroll text. It merely truncates what doesn't fit. It returns where in the text string it last printed before truncation. It's also quite slow.
7412              
7413             =over 4
7414              
7415             $fb->ttf_paragraph(
7416             {
7417             'text' => 'String to print',
7418              
7419             'x' => 0, # Where to start printing
7420             'y' => 20, #
7421              
7422             'size' => 12, # Optional Font size, default is 16
7423              
7424             'color' => 'FFFF00FF', # RRGGBBAA
7425              
7426             'justify' => 'justified' # Optional justification, default
7427             # is "left". Posible values are:
7428             # "left", "right", "center", and
7429             # "justified"
7430              
7431             'line_spacing' => 5, # This adjusts the default line
7432             # spacing by positive or negative
7433             # amounts. The default is 0.
7434              
7435             'face' => 'Ariel', # Optional, overrides the default
7436              
7437             'font_path' => '/usr/share/fonts', # Optional, else uses the default
7438             }
7439             );
7440              
7441             =back
7442              
7443             =cut
7444              
7445 0     0 0 0 my $self = shift;
7446 0         0 my $params = shift;
7447              
7448 0 0       0 return ($params) unless (defined($params));
7449              
7450 0   0     0 my $TTF_x = int($params->{'x'}) || 0;
7451 0   0     0 my $TTF_y = int($params->{'y'}) || 0;
7452 0   0     0 my $TTF_size = int($params->{'size'}) || 16;
7453 0   0     0 my $text = $params->{'text'} || ' ';
7454 0   0     0 my $face = $params->{'face'} || $self->{'FONT_FACE'};
7455 0   0     0 my $justify = $params->{'justify'} || 'left';
7456 0         0 $justify =~ s/centre/center/; # Wacky Brits and Canadians
7457 0   0     0 my $linegap = int($params->{'line_spacing'}) || 0;
7458 0   0     0 my $font_path = $params->{'font_path'} || $self->{'FONT_PATH'};
7459 0 0       0 my $P_color = $params->{'color'} if (exists($params->{'color'}));
7460 0         0 my $pfont = "$font_path/$face";
7461              
7462 0         0 $TTF_x -= $self->{'X_CLIP'};
7463 0         0 $TTF_y -= $self->{'Y_CLIP'};
7464 0         0 $justify = lc($justify);
7465 0         0 $justify =~ s/justified/fill/;
7466 0         0 $pfont =~ s#/+#/#g; # Get rid of doubled up slashes
7467              
7468 0         0 my $color_order = $self->{'COLOR_ORDER'};
7469 0         0 my $bytes = $self->{'BYTES'};
7470 0         0 my $data;
7471              
7472 0 0       0 if (defined($P_color)) {
7473 0 0       0 $P_color .= 'FF' if (length($P_color) < 8); # Add opague alpha if it is not defined
7474 0         0 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));
7475 0 0       0 if ($color_order == BGR) {
    0          
    0          
    0          
    0          
7476 0         0 $P_color = $blue . $green . $red . $alpha;
7477             } elsif ($color_order == BRG) {
7478 0         0 $P_color = $blue . $red . $green . $alpha;
7479             } elsif ($color_order == RBG) {
7480 0         0 $P_color = $red . $blue . $green . $alpha;
7481             } elsif ($color_order == GRB) {
7482 0         0 $P_color = $green . $red . $blue . $alpha;
7483             } elsif ($color_order == GBR) {
7484 0         0 $P_color = $green . $blue . $red . $alpha;
7485             }
7486             } else {
7487 0         0 $P_color = $self->{'IMAGER_FOREGROUND_COLOR'};
7488             }
7489              
7490 0         0 my $font = Imager::Font->new(
7491             'file' => $pfont,
7492             'color' => $P_color,
7493             );
7494 0 0       0 unless (defined($font)) {
7495 0 0       0 warn __LINE__ . " Can't initialize Imager::Font!\n", Imager->errstr() if ($self->{'SHOW_ERRORS'});
7496 0         0 return (undef);
7497             }
7498 0         0 my $img;
7499             my $image;
7500 0         0 my $draw_mode;
7501 0         0 my $savepos;
7502 0         0 eval {
7503             $img = Imager->new(
7504             'xsize' => $self->{'W_CLIP'},
7505 0         0 'ysize' => $self->{'H_CLIP'},
7506             'channels' => max(3, $bytes)
7507             );
7508 0 0       0 unless ($self->{'DRAW_MODE'}) { # If normal mode, then don't bother
7509 0 0       0 if ($self->{'ACCELERATED'}) {
7510 0         0 $draw_mode = $self->{'DRAW_MODE'};
7511 0         0 $self->{'DRAW_MODE'} = MASK_MODE;
7512             } else {
7513 0         0 $image = $self->blit_read({ 'x' => $self->{'X_CLIP'}, 'y' => $self->{'Y_CLIP'}, 'width' => $self->{'W_CLIP'}, 'height' => $self->{'H_CLIP'}});
7514 0 0       0 $image->{'image'} = $self->_convert_16_to_24($image->{'image'}, RGB) if ($self->{'BITS'} == 16);
7515             $img->read(
7516             'data' => $image->{'image'},
7517             'type' => 'raw',
7518             'raw_datachannels' => max(3, $bytes),
7519             'raw_storechannels' => max(3, $bytes),
7520             'raw_interleave' => FALSE,
7521             'xsize' => $self->{'W_CLIP'},
7522 0         0 'ysize' => $self->{'H_CLIP'},
7523             );
7524             }
7525             }
7526             Imager::Font::Wrap->wrap_text(
7527 0         0 'x' => $TTF_x,
7528             'y' => $TTF_y,
7529             'size' => $TTF_size,
7530             'string' => $text,
7531             'font' => $font,
7532             'image' => $img,
7533             'justify' => $justify,
7534             'linegap' => $linegap,
7535             'savepos' => \$savepos,
7536             );
7537 0         0 $img->write(
7538             'type' => 'raw',
7539             'storechannels' => max(3, $bytes), # Must be at least 24 bit
7540             'interleave' => FALSE,
7541             'data' => \$data
7542             );
7543             };
7544 0 0       0 if ($@) {
7545 0 0       0 warn __LINE__ . " ERROR $@\n", Imager->errstr() if ($self->{'SHOW_ERRORS'});
7546 0         0 return (undef);
7547             }
7548 0 0       0 $data = $self->_convert_24_to_16($data, RGB) if ($self->{'BITS'} == 16);
7549 0         0 $self->blit_write({ 'x' => $self->{'X_CLIP'}, 'y' => $self->{'Y_CLIP'}, 'width' => $self->{'W_CLIP'}, 'height' => $self->{'H_CLIP'}, 'image' => $data });
7550 0 0       0 $self->{'DRAW_MODE'} = $draw_mode if (defined($draw_mode));
7551 0         0 return ($savepos);
7552             }
7553              
7554             sub _gather_fonts {
7555             # Gather in and find all the fonts
7556 2     2   15 my $self = shift;
7557 2         10 my $path = shift;
7558              
7559 2         92 opendir(my $DIR, $path);
7560 2         19 chomp(my @dir = readdir($DIR));
7561 2         9 closedir($DIR);
7562              
7563 2         17 foreach my $file (@dir) {
7564 0 0       0 next if ($file =~ /^\./);
7565 0 0 0     0 if (-d "$path/$file") {
    0          
7566 0         0 $self->_gather_fonts("$path/$file");
7567             } elsif (-f "$path/$file" && -s "$path/$file") { # Makes sure font is non-zero length
7568 0 0 0     0 if ($file =~ /\.ttf$/i && ($self->{'Imager-Has-TrueType'} || $self->{'Imager-Has-Freetype2'})) {
    0 0        
      0        
7569 0         0 my $face = $self->get_face_name({ 'font_path' => $path, 'face' => $file });
7570 0         0 $self->{'FONTS'}->{$face} = { 'path' => $path, 'font' => $file };
7571             } elsif ($file =~ /\.afb$/i && $self->{'Imager-Has-Type1'}) {
7572 0         0 my $face = $self->get_face_name({ 'font_path' => $path, 'face' => $file });
7573 0         0 $self->{'FONTS'}->{$face} = { 'path' => $path, 'font' => $file };
7574             }
7575             }
7576             }
7577             }
7578              
7579             sub get_face_name {
7580             =head2 get_face_name
7581              
7582             Returns the TrueType face name based on the parameters passed.
7583              
7584             my $face_name = $fb->get_face_name({
7585             'font_path' => '/usr/share/fonts/TrueType/',
7586             'face' => 'FontFileName.ttf'
7587             });
7588              
7589             =cut
7590              
7591 0     0 0 0 my $self = shift;
7592 0         0 my $params = shift;
7593              
7594 0         0 my $file = $params->{'font_path'} . '/' . $params->{'face'};
7595 0         0 my $face = Imager::Font->new('file' => $file);
7596 0 0       0 if ($face->can('face_name')) {
7597 0         0 my $face_name = $face->face_name();
7598 0 0       0 if ($face_name eq '') {
7599 0         0 $face_name = $params->{'face'};
7600 0         0 $face_name =~ s/\.(ttf|pfb)$//i;
7601             }
7602 0         0 return ($face_name);
7603             }
7604 0         0 return ($file);
7605             }
7606              
7607             sub load_image {
7608             =head2 load_image
7609              
7610             Loads an image at point x,y[,width,height]. To display it, pass it to blit_write.
7611              
7612             If you give centering options, the position to display the image is part of what is returned, and is ready for blitting.
7613              
7614             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.
7615              
7616             =over 4
7617              
7618             $fb->blit_write(
7619             $fb->load_image(
7620             {
7621             'x' => 0, # Optional (only applies if
7622             # CENTER_X or CENTER_XY is not
7623             # used)
7624              
7625             'y' => 0, # Optional (only applies if
7626             # CENTER_Y or CENTER_XY is not
7627             # used)
7628              
7629             'width' => 1920, # Optional. Resizes to this maximum
7630             # width. It fits the image to this
7631             # size.
7632              
7633             'height' => 1080, # Optional. Resizes to this maximum
7634             # height. It fits the image to this
7635             # size
7636              
7637             'scale_type' => 'min',# Optional. Sets the type of scaling
7638             #
7639             # 'min' = The smaller of the two
7640             # sizes are used (default)
7641             # 'max' = The larger of the two
7642             # sizes are used
7643             # 'nonprop' = Non-proportional sizing
7644             # The image is scaled to
7645             # width x height exactly.
7646              
7647             'autolevels' => FALSE,# Optional. It does a color
7648             # correction. Sometimes this
7649             # works well, and sometimes it
7650             # looks quite ugly. It depends
7651             # on the image
7652              
7653             'center' => CENTER_XY, # Optional
7654             # Three centering options are available
7655             # CENTER_X = center horizontally
7656             # CENTER_Y = center vertically
7657             # CENTER_XY = center horizontally and
7658             # vertically. Placing it
7659             # right in the middle of
7660             # the screen.
7661              
7662             'file' => 'RWBY_Faces.png', # Usually needs full path
7663              
7664             'convertalpha' => TRUE, # Converts the color matching the global
7665             # background color to have the same alpha
7666             # channel value as the global background,
7667             # which is beneficial for using 'merge'
7668             # in 'blit_transform'.
7669              
7670             'preserve_transparency' => FALSE,
7671             # Preserve the transparency of GIFs for
7672             # use with "mask_mode" playback.
7673             # This can allow for slightly faster
7674             # playback of animated GIFs on systems
7675             # using the acceration features of this
7676             # module. However, not all animated
7677             # GIFs look right when this is done.
7678             # the safest setting is to not use this,
7679             # and playback using normal_mode.
7680             }
7681             )
7682             );
7683              
7684             =back
7685              
7686             If a single image is loaded, it returns a reference to an anonymous hash, of the format:
7687              
7688             =over 4
7689              
7690             {
7691             'x' => horizontal position calculated (or passed through),
7692             'y' => vertical position calculated (or passed through),
7693             'width' => Width of the image,
7694             'height' => Height of the image,
7695             'tags' => The tags of the image (hashref)
7696             'image' => [raw image data]
7697             }
7698              
7699             =back
7700              
7701             If the image has multiple frames, then a reference to an array of hashes is returned:
7702              
7703             =over 4
7704              
7705             # NOTE: X and Y positions can change frame to frame, so use them for each frame!
7706             # Also, X and Y are based upon what was originally passed through, else they
7707             # reference 0,0 (but only if you didn't give an X,Y value initially).
7708              
7709             # ALSO: The tags may also specify offsets, and they will be taken into account.
7710              
7711             [
7712             { # Frame 1
7713             'x' => horizontal position calculated (or passed through),
7714             'y' => vertical position calculated (or passed through),
7715             'width' => Width of the image,
7716             'height' => Height of the image,
7717             'tags' => The tags of the image (hashref)
7718             'image' => [raw image data]
7719             },
7720             { # Frame 2 (and so on)
7721             'x' => horizontal position calculated (or passed through),
7722             'y' => vertical position calculated (or passed through),
7723             'width' => Width of the image,
7724             'height' => Height of the image,
7725             'tags' => The tags of the image (hashref)
7726             'image' => [raw image data]
7727             }
7728             ]
7729              
7730             =back
7731              
7732             =cut
7733              
7734 0     0 0 0 my $self = shift;
7735 0         0 my $params = shift;
7736              
7737 0         0 my @odata;
7738             my @Img;
7739 0         0 my ($x, $y, $xs, $ys, $w, $h, $last_img, $bench_scale, $bench_rotate, $bench_convert);
7740 0         0 my $bench_start = time;
7741 0         0 my $bench_total = $bench_start;
7742 0         0 my $bench_subtotal = $bench_start;
7743 0         0 my $bench_load = $bench_start;
7744 0         0 my $color_order = $self->{'COLOR_ORDER'};
7745 0 0       0 if ($params->{'file'} =~ /\.(gif|png|apng)$/i) {
7746 0         0 eval {
7747             @Img = Imager->read_multi(
7748             'file' => $params->{'file'},
7749             'allow_incomplete' => TRUE,
7750             'raw_datachannels' => max(3, $self->{'BYTES'}), # One of these is bound to work
7751 0         0 'datachannels' => max(3, $self->{'BYTES'}),
7752             );
7753             };
7754 0 0 0     0 warn __LINE__ . " $@" if ($@ && $self->{'SHOW_ERRORS'});
7755             } else {
7756 0         0 eval {
7757             push(@Img,Imager->new(
7758             'file' => $params->{'file'},
7759             'interleave' => FALSE,
7760             'allow_incomplete' => TRUE,
7761             'datachannels' => max(3, $self->{'BYTES'}), # One of these is bound to work.
7762 0         0 'raw_datachannels' => max(3, $self->{'BYTES'}),
7763             ));
7764             };
7765 0 0 0     0 warn __LINE__ . " $@" if ($@ && $self->{'SHOW_ERRORS'});
7766             }
7767 0         0 $bench_load = sprintf('%.03f', time - $bench_load);
7768 0 0       0 unless (defined($Img[0])) {
7769 0 0       0 warn __LINE__ . " I can't get Imager to set up an image buffer $params->{'file'}! Check your Imager installation.\n", Imager->errstr() if ($self->{'SHOW_ERRORS'});
7770             } else {
7771 0         0 foreach my $img (@Img) {
7772 0 0       0 next unless (defined($img));
7773 0         0 $bench_subtotal = time;
7774 0         0 my %tags = map(@$_, $img->tags());
7775             # Must loop and layer the frames on top of each other to get full frames.
7776 0 0       0 unless (exists($params->{'gif_left'})) {
7777 0 0       0 if (defined($last_img)) {
7778             $last_img->compose(
7779             'src' => $img,
7780             'tx' => $tags{'gif_left'},
7781 0         0 'ty' => $tags{'gif_top'},
7782             );
7783 0         0 $img = $last_img;
7784             }
7785 0 0       0 $last_img = $img->copy() unless (defined($last_img));
7786             }
7787 0         0 $bench_rotate = time;
7788 0 0       0 if (exists($tags{'exif_orientation'})) {
7789 0         0 my $orientation = $tags{'exif_orientation'};
7790 0 0 0     0 if (defined($orientation) && $orientation) { # Automatically rotate the image to correct
7791 0 0       0 if ($orientation == 3) { # 180 (It's upside down)
    0          
    0          
7792 0         0 $img = $img->rotate('degrees' => 180);
7793             } elsif ($orientation == 6) { # -90 (It's on its left side)
7794 0         0 $img = $img->rotate('degrees' => 90);
7795             } elsif ($orientation == 8) { # 90 (It's on its right size)
7796 0         0 $img = $img->rotate('degrees' => -90);
7797             }
7798             }
7799             }
7800 0         0 $bench_rotate = sprintf('%.03f', time - $bench_rotate);
7801              
7802             # Sometimes it works great, sometimes it looks uuuuuugly
7803 0 0       0 $img->filter('type' => 'autolevels') if ($params->{'autolevels'});
7804              
7805 0         0 $bench_scale = time;
7806 0         0 my %scale;
7807 0         0 $w = int($img->getwidth());
7808 0         0 $h = int($img->getheight());
7809 0         0 my $channels = $img->getchannels();
7810 0 0       0 if ($channels == 1) { # Monochrome
7811 0         0 $img = $img->convert('preset' => 'rgb');
7812 0         0 $channels = $img->getchannels();
7813             }
7814 0         0 my $bits = $img->bits();
7815              
7816             # Scale the image, if asked to
7817 0 0 0     0 if ($params->{'file'} =~ /\.(gif|png)$/i && ! exists($params->{'width'}) && ! exists($params->{'height'})) {
      0        
7818 0         0 ($params->{'width'}, $params->{'height'}) = ($w, $h);
7819             }
7820 0   0     0 $params->{'width'} = min($self->{'XRES'}, int($params->{'width'} || $w));
7821 0   0     0 $params->{'height'} = min($self->{'YRES'}, int($params->{'height'} || $h));
7822 0 0       0 if (defined($xs)) {
7823 0         0 $scale{'xscalefactor'} = $xs;
7824 0         0 $scale{'yscalefactor'} = $ys;
7825 0   0     0 $scale{'type'} = $params->{'scale_type'} || 'min';
7826 0         0 $img = $img->scale(%scale);
7827             } else {
7828 0         0 $scale{'xpixels'} = int($params->{'width'});
7829 0         0 $scale{'ypixels'} = int($params->{'height'});
7830 0   0     0 $scale{'type'} = $params->{'scale_type'} || 'min';
7831 0         0 ($xs, $ys, $w, $h) = $img->scale_calculate(%scale);
7832 0         0 $img = $img->scale(%scale);
7833             }
7834 0         0 $w = int($img->getwidth());
7835 0         0 $h = int($img->getheight());
7836 0         0 $bench_scale = sprintf('%.03f', time - $bench_scale);
7837 0         0 my $data = '';
7838 0         0 $bench_convert = time;
7839              
7840             # Remap colors
7841 0 0       0 if ($color_order == BGR) {
    0          
    0          
    0          
    0          
7842 0         0 $img = $img->convert('matrix' => [[0, 0, 1, 0], [0, 1, 0, 0], [1, 0, 0, 0], [0, 0, 0, 1]]);
7843             } elsif ($color_order == BRG) {
7844 0         0 $img = $img->convert('matrix' => [[0, 0, 1, 0], [1, 0, 0, 0], [0, 1, 0, 0], [0, 0, 0, 1]]);
7845             } elsif ($color_order == RBG) {
7846 0         0 $img = $img->convert('matrix' => [[1, 0, 0, 0], [0, 0, 1, 0], [0, 1, 0, 0], [0, 0, 0, 1]]);
7847             } elsif ($color_order == GRB) {
7848 0         0 $img = $img->convert('matrix' => [[0, 1, 0, 0], [1, 0, 0, 0], [0, 0, 1, 0], [0, 0, 0, 1]]);
7849             } elsif ($color_order == GBR) {
7850 0         0 $img = $img->convert('matrix' => [[0, 1, 0, 0], [0, 0, 1, 0], [1, 0, 0, 0], [0, 0, 0, 1]]);
7851             }
7852 0 0       0 if ($self->{'BITS'} == 32) {
    0          
7853 0 0       0 $img = $img->convert('preset' => 'addalpha') if ($channels == 3);
7854 0         0 $img->write(
7855             'type' => 'raw',
7856             'interleave' => FALSE,
7857             'raw_datachannels' => 4,
7858             'raw_storechannels' => 4,
7859             'datachannels' => 4,
7860             'storechannels' => 4,
7861             'data' => \$data
7862             );
7863 0 0       0 if ($params->{'convertalpha'}) {
7864 0         0 my $oback = substr($self->{'RAW_BACKGROUND_COLOR'}, 0, 3);
7865 0         0 my $nback = $self->{'RAW_BACKGROUND_COLOR'};
7866 0         0 $data =~ s/$oback./$nback/g;
7867             }
7868             } elsif ($self->{'BITS'} == 24 ) {
7869 0 0       0 $img = $img->convert('preset' => 'noalpha') if ($channels == 4);
7870 0         0 $img->write(
7871             'type' => 'raw',
7872             'interleave' => FALSE,
7873             'raw_datachannels' => 3,
7874             'raw_storechannels' => 3,
7875             'datachannels' => 3,
7876             'storechannels' => 3,
7877             'data' => \$data
7878             );
7879             } else { # 16 bit
7880 0         0 $channels = $img->getchannels();
7881 0 0       0 $img = $img->convert('preset' => 'noalpha') if ($channels == 4);
7882 0         0 $img->write(
7883             'type' => 'raw',
7884             'interleave' => FALSE,
7885             'raw_datachannels' => 3,
7886             'raw_storechannels' => 3,
7887             'datachannels' => 3,
7888             'storechannels' => 3,
7889             'data' => \$data
7890             );
7891 0         0 $data = $self->_convert_24_to_16($data, RGB);
7892             }
7893              
7894 0 0 0     0 if (exists($params->{'center'})) { # Only accepted values are processed
    0          
7895 0 0       0 if ($params->{'center'} == CENTER_X) {
    0          
    0          
7896 0 0       0 $x = ($w < $self->{'W_CLIP'}) ? int(($self->{'W_CLIP'} - $w) / 2) + $self->{'X_CLIP'} : $self->{'X_CLIP'};
7897             } elsif ($params->{'center'} == CENTER_Y) {
7898 0 0       0 $y = ($h < $self->{'H_CLIP'}) ? int(($self->{'H_CLIP'} - $h) / 2) + $self->{'Y_CLIP'} : $self->{'Y_CLIP'};
7899             } elsif ($params->{'center'} == CENTER_XY) {
7900 0 0       0 $x = ($w < $self->{'W_CLIP'}) ? int(($self->{'W_CLIP'} - $w) / 2) + $self->{'X_CLIP'} : $self->{'X_CLIP'};
7901 0 0       0 $y = ($h < $self->{'H_CLIP'}) ? int(($self->{'H_CLIP'} - $h) / 2) + $self->{'Y_CLIP'} : $self->{'Y_CLIP'};
7902             }
7903             } elsif (defined($params->{'x'}) && defined($params->{'y'})) {
7904 0         0 $x = int($params->{'x'});
7905 0         0 $y = int($params->{'y'});
7906             } else {
7907 0 0       0 if ($w < $self->{'W_CLIP'}) {
    0          
7908 0         0 $x = int(($self->{'W_CLIP'} - $w) / 2) + $self->{'X_CLIP'};
7909 0         0 $y = 0;
7910             } elsif ($h < $self->{'H_CLIP'}) {
7911 0         0 $x = 0;
7912 0         0 $y = int(($self->{'H_CLIP'} - $h) / 2) + $self->{'Y_CLIP'};
7913             } else {
7914 0         0 $x = 0;
7915 0         0 $y = 0;
7916             }
7917             }
7918 0         0 $bench_convert = sprintf('%.03f', time - $bench_convert);
7919 0         0 $bench_total = sprintf('%.03f', time - $bench_start);
7920 0         0 $bench_subtotal = sprintf('%.03f', time - $bench_subtotal);
7921 0         0 my $temp_image = {
7922             'x' => $x,
7923             'y' => $y,
7924             'width' => $w,
7925             'height' => $h,
7926             'image' => $data,
7927             'tags' => \%tags,
7928             'benchmark' => {
7929             'load' => $bench_load,
7930             'rotate' => $bench_rotate,
7931             'scale' => $bench_scale,
7932             'convert' => $bench_convert,
7933             'sub-total' => $bench_subtotal,
7934             'total' => $bench_total
7935             }
7936             };
7937 0         0 push(@odata,$temp_image);
7938 0 0       0 if ($self->{'DIAGNOSTICS'}) {
7939 0         0 my $saved = $self->{'DRAW_MODE'};
7940 0 0       0 $self->mask_mode() if ($self->{'ACCELERATED'});
7941 0         0 $self->blit_write($odata[-1]);
7942 0         0 print STDERR "LOAD: $bench_load, ROTATE: $bench_rotate, SCALE: $bench_scale, CONVERT: $bench_convert, IMGTIME: $bench_subtotal, TOTAL: $bench_total \r";
7943 0         0 $self->{'DRAW_MODE'} = $saved;
7944             }
7945             }
7946              
7947 0 0       0 if (scalar(@odata) > 1) { # Animation
7948             return ( # return it in a form the blit routines can dig
7949             \@odata
7950 0         0 );
7951             } else { # Single image
7952             return ( # return it in a form the blit routines can dig
7953 0         0 pop(@odata)
7954             );
7955             }
7956             }
7957 0         0 return (undef); # Ouch
7958             }
7959              
7960             sub screen_dump {
7961             =head2 screen_dump
7962              
7963             Dumps the screen to a file given in 'file' in the format given in 'format'
7964              
7965             Formats can be (they are case-insensitive):
7966              
7967             =over 4
7968              
7969             =item B
7970              
7971             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.
7972              
7973             =item B
7974              
7975             The CompuServe "Graphics Interchange Format". A very old and outdated format made specifically for VGA graphics modes, but still widely used. It only allows up to 256 "indexed" colors, so quality is very lacking. The "dither" paramter determines how colors are translated from 24 bit truecolor to 8 bit indexed.
7976              
7977             =item B
7978              
7979             The Portable Network Graphics format. Widely used, very high quality.
7980              
7981             =item B
7982              
7983             The Portable aNy Map format. These are typically "PPM" files. Not widely used.
7984              
7985             =item B
7986              
7987             The Targa image format. This is a high-color, lossless format, typically used in photography
7988              
7989             =item B
7990              
7991             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.
7992              
7993             =back
7994              
7995             $fb->screen_dump(
7996             {
7997             'file' => '/path/filename', # name of file to be written
7998             'format' => 'jpeg', # jpeg, gif, png, pnm, tga, or tiff
7999              
8000             # for JPEG formats only
8001             'quality' => 75, # quality of the JPEG file 1-100% (the
8002             # higher the number, the better the
8003             # quality, but the larger the file)
8004              
8005             # for GIF formats only
8006             'dither' => 'floyd', # Can be "floyd", "jarvis" or "stucki"
8007             }
8008             );
8009              
8010             =cut
8011              
8012 0     0 0 0 my $self = shift;
8013 0         0 my $params = shift;
8014              
8015 0   0     0 my $filename = $params->{'file'} || 'screendump.jpg';
8016 0         0 my $bytes = $self->{'BYTES'};
8017 0         0 my ($width, $height) = ($self->{'XRES'}, $self->{'YRES'});
8018 0         0 my $scrn = $self->blit_read({ 'x' => 0, 'y' => 0, 'width' => $width, 'height' => $height });
8019              
8020 0 0       0 $scrn->{'image'} = $self->_convert_16_to_24($scrn->{'image'}, $self->{'COLOR_MODE'}) if ($self->{'BITS'} == 16);
8021              
8022 0   0     0 my $type = lc($params->{'format'} || 'jpeg');
8023 0         0 $type =~ s/jpg/jpeg/;
8024 0         0 my $img = Imager::new();
8025             $img->read(
8026             'xsize' => $scrn->{'width'},
8027             'ysize' => $scrn->{'height'},
8028             'raw_datachannels' => max(3, $bytes),
8029             'raw_storechannels' => max(3, $bytes),
8030             'raw_interleave' => FALSE,
8031 0         0 'data' => $scrn->{'image'},
8032             'type' => 'raw',
8033             'allow_incomplete' => TRUE
8034             );
8035 0   0     0 my %p = (
8036             'type' => $type || 'raw',
8037             'datachannels' => max(3, $bytes),
8038             'storechannels' => max(3, $bytes),
8039             'interleave' => FALSE,
8040             'file' => $filename
8041             );
8042              
8043 0 0       0 if ($type eq 'jpeg') {
    0          
8044 0 0       0 $p{'jpegquality'} = $params->{'quality'} if (exists($params->{'quality'}));
8045 0         0 $p{'jpegoptimize'} = TRUE;
8046             } elsif ($type eq 'gif') {
8047 0         0 $p{'translate'} = 'errdiff';
8048 0   0     0 $p{'errdiff'} = lc($params->{'dither'} || 'floyd');
8049             }
8050 0         0 $img->write(%p);
8051             }
8052              
8053             ### Bitmap conversion routines ###
8054              
8055             sub _convert_16_to_24 {
8056             # Convert 16 bit bitmap to 24 bit bitmap
8057 0     0   0 my $self = shift;
8058 0         0 my $img = shift;
8059 0         0 my $color_order = shift;
8060              
8061 0         0 my $size = length($img);
8062 0         0 my $new_img = '';
8063 0 0       0 if ($self->{'ACCELERATED'}) {
8064 0         0 $new_img = chr(0) x (int(($size / 2) * 3) + 3);
8065 0         0 c_convert_16_24($img, $size, $new_img, $color_order);
8066             } else {
8067 0         0 my $black24 = chr(0) x 3;
8068 0         0 my $black16 = chr(0) x 2;
8069 0         0 my $white24 = chr(255) x 3;
8070 0         0 my $white16 = chr(255) x 2;
8071 0         0 my $idx = 0;
8072 0         0 while ($idx < $size) {
8073 0         0 my $color = substr($img, $idx, 2);
8074              
8075             # Black and white can be optimized
8076 0 0       0 if ($color eq $black16) {
    0          
8077 0         0 $new_img .= $black24;
8078             } elsif ($color eq $white16) {
8079 0         0 $new_img .= $white24;
8080             } else {
8081 0         0 $color = $self->RGB565_to_RGB888({ 'color' => $color, 'color_order' => $color_order });
8082 0         0 $new_img .= $color->{'color'};
8083             }
8084 0         0 $idx += 2;
8085             }
8086             }
8087 0         0 return ($new_img);
8088             }
8089              
8090             sub _convert_8_to_32 {
8091             # Convert 8 bit bitmap to 32 bit bitmap
8092 0     0   0 my $self = shift;
8093 0         0 my $img = shift;
8094 0         0 my $color_order = shift;
8095 0         0 my $pallette = shift; # Reference to an array of 256 pallette entries
8096              
8097 0         0 my $size = length($img);
8098 0         0 my $new_img = '';
8099 0         0 my $idx = 0;
8100 0         0 while ($idx < $size) {
8101 0         0 my $color = $self->RGB888_to_RGB8888({'color' => $pallette->[unpack('C',substr($img,$idx,1))]});
8102 0         0 $new_img .= $color->{'color'};
8103 0         0 $idx++;
8104             }
8105 0         0 return($new_img);
8106             }
8107              
8108             sub _convert_8_to_24 {
8109             # Convert 8 bit bitmap to 24 bit bitmap
8110 0     0   0 my $self = shift;
8111 0         0 my $img = shift;
8112 0         0 my $color_order = shift;
8113 0         0 my $pallette = shift; # Reference to an array of 256 pallette entries
8114              
8115 0         0 my $size = length($img);
8116 0         0 my $new_img = '';
8117 0         0 my $idx = 0;
8118 0         0 while ($idx < $size) {
8119 0         0 my $color = $pallette->[unpack('C',substr($img,$idx,1))];
8120 0         0 $new_img .= $color;
8121 0         0 $idx++;
8122             }
8123 0         0 return($new_img);
8124             }
8125              
8126             sub _convert_8_to_16 {
8127             # Convert 8 bit bitmap to 16 bit bitmap
8128 0     0   0 my $self = shift;
8129 0         0 my $img = shift;
8130 0         0 my $color_order = shift;
8131 0         0 my $pallette = shift; # Reference to an array of 256 pallette entries
8132              
8133 0         0 my $size = length($img);
8134 0         0 my $new_img = '';
8135 0         0 my $idx = 0;
8136 0         0 while ($idx < $size) {
8137 0         0 my $color = $self->RGB888_to_RGB565({'color' => $pallette->[unpack('C',substr($img,$idx,1))]});
8138 0         0 $new_img .= $color->{'color'};
8139 0         0 $idx++;
8140             }
8141 0         0 return($new_img);
8142             }
8143              
8144             sub _convert_16_to_32 {
8145             # Convert 16 bit bitmap to 32 bit bitmap
8146 0     0   0 my $self = shift;
8147 0         0 my $img = shift;
8148 0         0 my $color_order = shift;
8149              
8150 0         0 my $size = length($img);
8151 0         0 my $new_img = '';
8152 0 0       0 if ($self->{'ACCELERATED'}) {
8153 0         0 $new_img = chr(0) x (int($size * 2) + 4);
8154 0         0 c_convert_16_32($img, $size, $new_img, $color_order);
8155             } else {
8156 0         0 my $black32 = chr(0) x 4;
8157 0         0 my $black16 = chr(0) x 2;
8158 0         0 my $white32 = chr(255) x 4;
8159 0         0 my $white16 = chr(255) x 2;
8160 0         0 my $idx = 0;
8161 0         0 while ($idx < $size) {
8162 0         0 my $color = substr($img, $idx, 2);
8163              
8164             # Black and white can be optimized
8165 0 0       0 if ($color eq $black16) {
    0          
8166 0         0 $new_img .= $black32;
8167             } elsif ($color eq $white16) {
8168 0         0 $new_img .= $white32;
8169             } else {
8170 0         0 $color = $self->RGB565_to_RGBA8888({ 'color' => $color, 'color_order' => $color_order });
8171 0         0 $new_img .= $color->{'color'};
8172             }
8173 0         0 $idx += 2;
8174             }
8175             }
8176 0         0 return ($new_img);
8177             }
8178              
8179             sub _convert_24_to_16 {
8180             # Convert 24 bit bitmap to 16 bit bitmap
8181 0     0   0 my $self = shift;
8182 0         0 my $img = shift;
8183 0         0 my $color_order = shift;
8184              
8185 0         0 my $size = length($img);
8186 0         0 my $new_img = '';
8187 0 0       0 if ($self->{'ACCELERATED'}) {
8188 0         0 $new_img = chr(0) x (int(($size / 3) * 2) + 2);
8189 0         0 c_convert_24_16($img, $size, $new_img, $color_order);
8190             } else {
8191 0         0 my $black24 = chr(0) x 3;
8192 0         0 my $black16 = chr(0) x 2;
8193 0         0 my $white24 = chr(255) x 3;
8194 0         0 my $white16 = chr(255) x 2;
8195              
8196 0         0 my $idx = 0;
8197 0         0 while ($idx < $size) {
8198 0         0 my $color = substr($img, $idx, 3);
8199              
8200             # Black and white can be optimized
8201 0 0       0 if ($color eq $black24) {
    0          
8202 0         0 $new_img .= $black16;
8203             } elsif ($color eq $white24) {
8204 0         0 $new_img .= $white16;
8205             } else {
8206 0         0 $color = $self->RGB888_to_RGB565({ 'color' => $color, 'color_order' => $color_order });
8207 0         0 $new_img .= $color->{'color'};
8208             }
8209 0         0 $idx += 3;
8210             }
8211             }
8212 0         0 return ($new_img);
8213             }
8214              
8215             sub _convert_32_to_16 {
8216             # Convert 32 bit bitmap to a 16 bit bitmap
8217 0     0   0 my $self = shift;
8218 0         0 my $img = shift;
8219 0         0 my $color_order = shift;
8220              
8221 0         0 my $size = length($img);
8222 0         0 my $new_img = '';
8223 0 0       0 if ($self->{'ACCELERATED'}) {
8224 0         0 $new_img = chr(0) x (int($size / 2) + 2);
8225 0         0 c_convert_32_16($img, $size, $new_img, $color_order);
8226             } else {
8227 0         0 my $black32 = chr(0) x 4;
8228 0         0 my $black16 = chr(0) x 2;
8229 0         0 my $white32 = chr(255) x 4;
8230 0         0 my $white16 = chr(255) x 2;
8231              
8232 0         0 my $idx = 0;
8233 0         0 while ($idx < $size) {
8234 0         0 my $color = substr($img, $idx, 4);
8235              
8236             # Black and white can be optimized
8237 0 0       0 if ($color eq $black32) {
    0          
8238 0         0 $new_img .= $black16;
8239             } elsif ($color eq $white32) {
8240 0         0 $new_img .= $white16;
8241             } else {
8242 0         0 $color = $self->RGBA8888_to_RGB565({ 'color' => $color, 'color_order' => $color_order });
8243 0         0 $new_img .= $color->{'color'};
8244             }
8245 0         0 $idx += 4;
8246             }
8247             }
8248 0         0 return ($new_img);
8249             }
8250              
8251             sub _convert_32_to_24 {
8252             # Convert a 32 bit bitmap to a 24 bit bitmap.
8253 0     0   0 my $self = shift;
8254 0         0 my $img = shift;
8255 0         0 my $color_order = shift;
8256              
8257 0         0 my $size = length($img);
8258 0         0 my $new_img = '';
8259 0 0       0 if ($self->{'ACCELERATED'}) {
8260 0         0 $new_img = chr(0) x (int(($size / 4) * 3) + 3);
8261 0         0 c_convert_32_24($img, $size, $new_img, $color_order);
8262             } else {
8263 0         0 my $black32 = chr(0) x 4;
8264 0         0 my $black24 = chr(0) x 3;
8265 0         0 my $white32 = chr(255) x 4;
8266 0         0 my $white24 = chr(255) x 3;
8267              
8268 0         0 my $idx = 0;
8269 0         0 while ($idx < $size) {
8270 0         0 my $color = substr($img, $idx, 4);
8271              
8272             # Black and white can be optimized
8273 0 0       0 if ($color eq $black32) {
    0          
8274 0         0 $new_img .= $black24;
8275             } elsif ($color eq $white32) {
8276 0         0 $new_img .= $white24;
8277             } else {
8278 0         0 $color = $self->RGBA8888_to_RGB888({ 'color' => $color, 'color_order' => $color_order });
8279 0         0 $new_img .= $color->{'color'};
8280             }
8281 0         0 $idx += 4;
8282             }
8283             }
8284 0         0 return ($new_img);
8285             }
8286              
8287             sub _convert_24_to_32 {
8288             # Convert a 24 bit bitmap to a 32 bit bipmap
8289 0     0   0 my $self = shift;
8290 0         0 my $img = shift;
8291 0         0 my $color_order = shift;
8292              
8293 0         0 my $size = length($img);
8294 0         0 my $new_img = '';
8295 0 0       0 if ($self->{'ACCELERATED'}) {
8296 0         0 $new_img = chr(0) x (int(($size / 3) * 4) + 4);
8297 0         0 c_convert_24_32($img, $size, $new_img, $color_order);
8298             } else {
8299 0         0 my $black32 = chr(0) x 4;
8300 0         0 my $black24 = chr(0) x 3;
8301 0         0 my $white32 = chr(255) x 4;
8302 0         0 my $white24 = chr(255) x 3;
8303              
8304 0         0 my $idx = 0;
8305 0         0 while ($idx < $size) {
8306 0         0 my $color = substr($img, $idx, 4);
8307              
8308             # Black and white can be optimized
8309 0 0       0 if ($color eq $black24) {
    0          
8310 0         0 $new_img .= $black32;
8311             } elsif ($color eq $white24) {
8312 0         0 $new_img .= $white32;
8313             } else {
8314 0         0 $color = $self->RGB888_to_RGBA8888({ 'color' => $color, 'color_order' => $color_order });
8315 0         0 $new_img .= $color->{'color'};
8316             }
8317 0         0 $idx += 3;
8318             }
8319             }
8320 0         0 return ($new_img);
8321             }
8322              
8323             sub RGB565_to_RGB888 {
8324             =head2 RGB565_to_RGB888
8325              
8326             Convert a 16 bit color value to a 24 bit color value. This requires the color to be a two byte packed string.
8327              
8328             my $color24 = $fb->RGB565_to_RGB888(
8329             {
8330             'color' => $color16
8331             }
8332             );
8333              
8334             =cut
8335              
8336 0     0 0 0 my $self = shift;
8337 0         0 my $params = shift;
8338              
8339 0         0 my $rgb565 = unpack('S', $params->{'color'});
8340 0         0 my ($r, $g, $b);
8341 0         0 my $color_order = $params->{'color_order'};
8342 0 0       0 if ($color_order == RGB) {
    0          
    0          
    0          
    0          
    0          
8343 0         0 $r = $rgb565 & 31;
8344 0         0 $g = ($rgb565 >> 5) & 63;
8345 0         0 $b = ($rgb565 >> 11) & 31;
8346             } elsif ($color_order == BGR) {
8347 0         0 $b = $rgb565 & 31;
8348 0         0 $g = ($rgb565 >> 5) & 63;
8349 0         0 $r = ($rgb565 >> 11) & 31;
8350             } elsif ($color_order == BRG) {
8351 0         0 $b = $rgb565 & 31;
8352 0         0 $r = ($rgb565 >> 5) & 63;
8353 0         0 $g = ($rgb565 >> 11) & 31;
8354             } elsif ($color_order == RBG) {
8355 0         0 $r = $rgb565 & 31;
8356 0         0 $b = ($rgb565 >> 5) & 63;
8357 0         0 $g = ($rgb565 >> 11) & 31;
8358             } elsif ($color_order == GRB) {
8359 0         0 $g = $rgb565 & 31;
8360 0         0 $r = ($rgb565 >> 5) & 63;
8361 0         0 $b = ($rgb565 >> 11) & 31;
8362             } elsif ($color_order == GBR) {
8363 0         0 $g = $rgb565 & 31;
8364 0         0 $b = ($rgb565 >> 5) & 63;
8365 0         0 $r = ($rgb565 >> 11) & 31;
8366             }
8367 0         0 $r = int($r * 527 + 23) >> 6;
8368 0         0 $g = int($g * 259 + 33) >> 6;
8369 0         0 $b = int($b * 527 + 23) >> 6;
8370              
8371 0         0 my $color;
8372 0 0       0 if ($color_order == BGR) {
    0          
    0          
    0          
    0          
8373 0         0 ($r, $g, $b) = ($b, $g, $r);
8374             } elsif ($color_order == BRG) {
8375 0         0 ($r, $g, $b) = ($b, $r, $g);
8376             # } elsif ($color_order == RGB) { # Redundant, but here for clarity
8377             } elsif ($color_order == RBG) {
8378 0         0 ($r, $g, $b) = ($r, $b, $g);
8379             } elsif ($color_order == GRB) {
8380 0         0 ($r, $g, $b) = ($g, $r, $b);
8381             } elsif ($color_order == GBR) {
8382 0         0 ($r, $g, $b) = ($g, $b, $r);
8383             }
8384 0         0 $color = pack('CCC', $r, $g, $b);
8385 0         0 return ({ 'color' => $color });
8386             }
8387              
8388             sub RGB565_to_RGBA8888 {
8389             =head2 RGB565_to_RGB8888
8390              
8391             Convert a 16 bit color value to a 32 bit color value. This requires the color to be a two byte packed string. The alpha value is either a value passed in or the default 255.
8392              
8393             my $color32 = $fb->RGB565_to_RGB8888(
8394             {
8395             'color' => $color16, # Required
8396             'alpha' => 128 # Optional
8397             }
8398             );
8399              
8400             =cut
8401              
8402 0     0 0 0 my $self = shift;
8403 0         0 my $params = shift;
8404              
8405 0         0 my $rgb565 = unpack('S', $params->{'color'});
8406 0   0     0 my $a = $params->{'alpha'} || 255;
8407 0         0 my $color_order = $self->{'COLOR_ORDER'};
8408 0         0 my ($r, $g, $b);
8409 0 0       0 if ($color_order == RGB) {
    0          
    0          
    0          
    0          
    0          
8410 0         0 $r = $rgb565 & 31;
8411 0         0 $g = ($rgb565 >> 5) & 63;
8412 0         0 $b = ($rgb565 >> 11) & 31;
8413             } elsif ($color_order == BGR) {
8414 0         0 $b = $rgb565 & 31;
8415 0         0 $g = ($rgb565 >> 5) & 63;
8416 0         0 $r = ($rgb565 >> 11) & 31;
8417             } elsif ($color_order == BRG) {
8418 0         0 $b = $rgb565 & 31;
8419 0         0 $r = ($rgb565 >> 5) & 63;
8420 0         0 $g = ($rgb565 >> 11) & 31;
8421             } elsif ($color_order == RBG) {
8422 0         0 $r = $rgb565 & 31;
8423 0         0 $b = ($rgb565 >> 5) & 63;
8424 0         0 $g = ($rgb565 >> 11) & 31;
8425             } elsif ($color_order == GRB) {
8426 0         0 $g = $rgb565 & 31;
8427 0         0 $r = ($rgb565 >> 5) & 63;
8428 0         0 $b = ($rgb565 >> 11) & 31;
8429             } elsif ($color_order == GBR) {
8430 0         0 $g = $rgb565 & 31;
8431 0         0 $b = ($rgb565 >> 5) & 63;
8432 0         0 $r = ($rgb565 >> 11) & 31;
8433             }
8434 0         0 $r = int($r * 527 + 23) >> 6;
8435 0         0 $g = int($g * 259 + 33) >> 6;
8436 0         0 $b = int($b * 527 + 23) >> 6;
8437              
8438 0         0 my $color;
8439 0 0       0 if ($color_order == BGR) {
    0          
    0          
    0          
    0          
8440 0         0 ($r, $g, $b) = ($b, $g, $r);
8441             # } elsif ($color_order == RGB) { # Redundant
8442             } elsif ($color_order == BRG) {
8443 0         0 ($r, $g, $b) = ($b, $r, $g);
8444             } elsif ($color_order == RBG) {
8445 0         0 ($r, $g, $b) = ($r, $b, $g);
8446             } elsif ($color_order == GRB) {
8447 0         0 ($r, $g, $b) = ($g, $r, $b);
8448             } elsif ($color_order == GBR) {
8449 0         0 ($r, $g, $b) = ($g, $b, $r);
8450             }
8451 0         0 $color = pack('CCCC', $r, $g, $b, $a);
8452 0         0 return ({ 'color' => $color });
8453             }
8454              
8455             sub RGB888_to_RGB565 {
8456             =head2 RGB888_to_RGB565
8457              
8458             Convert 24 bit color value to a 16 bit color value. This requires a three byte packed string.
8459              
8460             my $color16 = $fb->RGB888_to_RGB565(
8461             {
8462             'color' => $color24
8463             }
8464             );
8465              
8466             This simply does a bitshift, nothing more.
8467              
8468             =cut
8469              
8470 0     0 0 0 my $self = shift;
8471 0         0 my $params = shift;
8472              
8473 0         0 my $big_data = $params->{'color'};
8474 0 0       0 my $in_color_order = defined($params->{'color_order'}) ? $params->{'color_order'} : $self->{'COLOR_ORDER'};
8475 0         0 my $color_order = $self->{'COLOR_ORDER'};
8476              
8477 0         0 my $n_data;
8478 0 0       0 if ($big_data ne '') {
8479 0         0 my $pixel_data = substr($big_data, 0, 3);
8480 0         0 my ($r, $g, $b);
8481 0 0       0 if ($in_color_order == BGR) {
    0          
    0          
    0          
    0          
    0          
8482 0         0 ($b, $g, $r) = unpack('C3', $pixel_data);
8483             } elsif ($in_color_order == RGB) {
8484 0         0 ($r, $g, $b) = unpack('C3', $pixel_data);
8485             } elsif ($in_color_order == BRG) {
8486 0         0 ($b, $r, $g) = unpack('C3', $pixel_data);
8487             } elsif ($in_color_order == RBG) {
8488 0         0 ($r, $b, $g) = unpack('C3', $pixel_data);
8489             } elsif ($in_color_order == GRB) {
8490 0         0 ($g, $r, $b) = unpack('C3', $pixel_data);
8491             } elsif ($in_color_order == GBR) {
8492 0         0 ($g, $b, $r) = unpack('C3', $pixel_data);
8493             }
8494 0         0 $r = $r >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'});
8495 0         0 $g = $g >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'});
8496 0         0 $b = $b >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'});
8497             my $color =
8498             ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) |
8499             ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) |
8500 0         0 ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}));
8501 0         0 $n_data = pack('S', $color);
8502             }
8503 0         0 return ({ 'color' => $n_data });
8504             }
8505              
8506             sub RGBA8888_to_RGB565 {
8507             =head2 RGBA8888_to_RGB565
8508              
8509             Convert 32 bit color value to a 16 bit color value. This requires a four byte packed string.
8510              
8511             my $color16 = $fb->RGB8888_to_RGB565(
8512             {
8513             'color' => $color32,
8514             }
8515             );
8516              
8517             This simply does a bitshift, nothing more
8518              
8519             =cut
8520              
8521 0     0 0 0 my $self = shift;
8522 0         0 my $params = shift;
8523              
8524 0         0 my $big_data = $params->{'color'};
8525 0 0       0 my $in_color_order = defined($params->{'color_order'}) ? $params->{'color_order'} : $self->{'COLOR_ORDER'};
8526 0         0 my $color_order = $self->{'COLOR_ORDER'};
8527              
8528 0         0 my $n_data;
8529 0         0 while ($big_data ne '') {
8530 0         0 my $pixel_data = substr($big_data, 0, 4);
8531 0         0 $big_data = substr($big_data, 4);
8532 0         0 my ($r, $g, $b, $a);
8533 0 0       0 if ($in_color_order == BGR) {
    0          
    0          
    0          
    0          
    0          
8534 0         0 ($b, $g, $r, $a) = unpack('C4', $pixel_data);
8535             } elsif ($in_color_order == RGB) {
8536 0         0 ($r, $g, $b, $a) = unpack('C4', $pixel_data);
8537             } elsif ($in_color_order == BRG) {
8538 0         0 ($b, $r, $g, $a) = unpack('C4', $pixel_data);
8539             } elsif ($in_color_order == RBG) {
8540 0         0 ($r, $b, $g, $a) = unpack('C4', $pixel_data);
8541             } elsif ($in_color_order == GRB) {
8542 0         0 ($g, $r, $b, $a) = unpack('C4', $pixel_data);
8543             } elsif ($in_color_order == GBR) {
8544 0         0 ($g, $b, $r, $a) = unpack('C4', $pixel_data);
8545             }
8546              
8547             # Alpha is tossed
8548 0         0 $r = $r >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'length'});
8549 0         0 $g = $g >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'length'});
8550 0         0 $b = $b >> (8 - $self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'length'});
8551              
8552             my $color =
8553             ($r << ($self->{'vscreeninfo'}->{'bitfields'}->{'red'}->{'offset'})) |
8554             ($g << ($self->{'vscreeninfo'}->{'bitfields'}->{'green'}->{'offset'})) |
8555 0         0 ($b << ($self->{'vscreeninfo'}->{'bitfields'}->{'blue'}->{'offset'}));
8556 0         0 $n_data .= pack('S', $color);
8557             }
8558 0         0 return ({ 'color' => $n_data });
8559             }
8560              
8561             sub RGB888_to_RGBA8888 {
8562             =head2 RGB888_to_RGBA8888
8563              
8564             Convert 24 bit color value to a 32 bit color value. This requires a three byte packed string. The alpha value is either a value passed in or the default 255.
8565              
8566             my $color32 = $fb->RGB888_to_RGBA8888(
8567             {
8568             'color' => $color24,
8569             'alpha' => 64
8570             }
8571             );
8572              
8573             This just simply adds an alpha value. No actual color conversion is done.
8574              
8575             =cut
8576              
8577 0     0 0 0 my $self = shift;
8578 0         0 my $params = shift;
8579              
8580 0 0       0 my $alpha = (exists($params->{'alpha'})) ? $params->{'alpha'} : 255;
8581 0         0 my $big_data = $params->{'color'};
8582 0         0 my $bsize = length($big_data);
8583 0         0 my $n_data = chr($alpha) x (($bsize / 3) * 4);
8584 0         0 my $index = 0;
8585 0         0 for (my $count = 0; $count < $bsize; $count += 3) {
8586 0         0 substr($n_data, $index, 3) = substr($big_data, $count + 2, 1) . substr($big_data, $count + 1, 1) . substr($big_data, $count, 1);
8587 0         0 $index += 4;
8588             }
8589 0         0 return ({ 'color' => $n_data });
8590             }
8591              
8592             sub RGBA8888_to_RGB888 {
8593             =head2 RGBA8888_to_RGB888
8594              
8595             Convert 32 bit color value to a 24 bit color value. This requires a four byte packed string.
8596              
8597             my $color24 = $fb->RGBA8888_to_RGB888(
8598             {
8599             'color' => $color32
8600             }
8601             );
8602              
8603             This just removes the alpha value. No color conversion is actually done.
8604              
8605             =cut
8606              
8607 0     0 0 0 my $self = shift;
8608 0         0 my $params = shift;
8609              
8610 0         0 my $big_data = $params->{'color'};
8611 0         0 my $bsize = length($big_data);
8612 0         0 my $n_data = chr(255) x (($bsize / 4) * 3);
8613 0         0 my $index = 0;
8614 0         0 for (my $count = 0; $count < $bsize; $count += 4) {
8615 0         0 substr($n_data, $index, 3) = substr($big_data, $count + 2, 1) . substr($big_data, $count + 1, 1) . substr($big_data, $count, 1);
8616 0         0 $index += 3;
8617             }
8618 0         0 return ({ 'color' => $n_data });
8619             }
8620              
8621             sub vsync {
8622             =head2 vsync
8623              
8624             Waits for vertical sync
8625              
8626             * Not all framebuffer drivers have this capability and ignore this call. Results may vary, as this cannot be emulated.
8627              
8628             Waits for the vertical blank before returning
8629              
8630             =cut
8631              
8632 0     0 0 0 my $self = shift;
8633 0         0 _set_ioctl(FBIO_WAITFORVSYNC, 'I', $self->{'FB'}, 0);
8634             }
8635              
8636             sub which_console {
8637             =head2 which_console
8638              
8639             Returns the active console and the expected console
8640              
8641             my ($active_console, $expected_console) = $fb->which_console();
8642              
8643             =cut
8644              
8645 0     0 0 0 my $self = shift;
8646 0         0 $self->{'THIS_CONSOLE'} = _slurp('/sys/class/tty/tty0/active');
8647 0         0 $self->{'THIS_CONSOLE'} =~ s/\D+//gs;
8648 0         0 $self->{'THIS_CONSOLE'} += 0; # Force numeric
8649 0         0 return ($self->{'THIS_CONSOLE'}, $self->{'CONSOLE'});
8650             }
8651              
8652             sub active_console {
8653             =head2 active_console
8654              
8655             Indicates if the current console is the expected console. It returns true or false.
8656              
8657             if ($self->active_console()) {
8658             # Do something
8659             }
8660              
8661             =cut
8662              
8663 0     0 0 0 my $self = shift;
8664 0         0 my ($current, $original) = $self->which_console();
8665 0 0       0 if ($current == $original) {
8666 0         0 return (TRUE);
8667             }
8668 0         0 return (FALSE);
8669             }
8670              
8671             sub wait_for_console {
8672             =head2 wait_for_console
8673              
8674             Blocks actions until the expected console is active. The expected console is determined at the time the module is initialized.
8675              
8676             Due to speed considerations, YOU must do use this to do blocking, if desired. If you expect to be changing active consoles, then you will need to use this. However, if you do not plan to do ever change consoles when running this module, then don't use this feature, as your results will be faster.
8677              
8678             If a TRUE or FALSE is passed to this, then you can enable or disable blocking for subsequent calls.
8679              
8680             =cut
8681              
8682 0     0 0 0 my $self = shift;
8683 0 0       0 if (scalar(@_)) {
8684 0 0       0 $self->{'WAIT_FOR_CONSOLE'} = (shift =~ /^(true|on|1|enable)$/i) ? TRUE : FALSE;
8685             } else {
8686 0   0     0 while ($self->{'WAIT_FOR_CONSOLE'} && !$self->active_console()) {
8687 0         0 sleep .1;
8688             }
8689             }
8690             }
8691              
8692             ## These are pulled in via the Mouse module
8693              
8694             =head2 initialize_mouse
8695              
8696             Turns on/off the mouse handler.
8697              
8698             Note: This uses Perl's "alarm" feature. If you want to use threads, then don't use this to turn on the mouse.
8699              
8700             # $fb->initialize_mouse(1); # Turn on the mouse handler
8701              
8702             or
8703              
8704             # $fb->initialize_mouse(0); # Turn off the mouse handler
8705              
8706             =head2 poll_mouse
8707              
8708             The mouse handler. The "initialize_mouse" routine sets this as the "alarm" routine to handle mouse events.
8709              
8710             An alarm handler just works, but can possibly block if used as ... an alarm handler.
8711              
8712             I suggest running it in a thread instead, using your own code.
8713              
8714             =head2 get_mouse
8715              
8716             Returns the mouse coordinates.
8717              
8718             Return as an array:
8719              
8720             # my ($mouseb, $mousex, $mousey) = $fb->get_mouse();
8721              
8722             Return as a hash reference:
8723              
8724             # my $mouse = $fb->get_mouse();
8725              
8726             Returns
8727              
8728             {
8729             'button' => button value, # Button state according to bits
8730             # Bit 0 = Left
8731             # Bit 1 = Right
8732             # Other bits according to driver
8733             'x' => Mouse X coordinate,
8734             'y' => Mouse Y coordinate,
8735             }
8736              
8737             =head2 set_mouse
8738              
8739             Sets the mouse position
8740              
8741             $fb->set_mouse(
8742             {
8743             'x' => 0,
8744             'y' => 0,
8745             }
8746             );
8747              
8748             =cut
8749              
8750             ##############################################################################
8751             ####################### NON-METHODS, FLAT SUBROUTINES ########################
8752             ##############################################################################
8753             sub _transformed_bounds {
8754 0     0   0 my $bbox = shift;
8755 0         0 my $matrix = shift;
8756              
8757 0         0 my $bounds;
8758 0         0 foreach my $point ([$bbox->start_offset, $bbox->ascent], [$bbox->start_offset, $bbox->descent], [$bbox->end_offset, $bbox->ascent], [$bbox->end_offset, $bbox->descent]) {
8759 0         0 $bounds = _add_bound($bounds, _transform_point(@{$point}, $matrix));
  0         0  
8760             }
8761 0         0 return (@{$bounds});
  0         0  
8762             }
8763              
8764             sub _add_bound {
8765 0     0   0 my $bounds = shift;
8766 0         0 my $x = shift;
8767 0         0 my $y = shift;
8768              
8769 0 0       0 $bounds or return ([$x, $y, $x, $y]);
8770              
8771 0 0       0 $x < $bounds->[0] and $bounds->[0] = $x;
8772 0 0       0 $y < $bounds->[1] and $bounds->[1] = $y;
8773 0 0       0 $x > $bounds->[2] and $bounds->[2] = $x;
8774 0 0       0 $y > $bounds->[3] and $bounds->[3] = $y;
8775              
8776 0         0 return ($bounds);
8777             }
8778              
8779             sub _transform_point {
8780 0     0   0 my $x = shift;
8781 0         0 my $y = shift;
8782 0         0 my $matrix = shift;
8783              
8784 0         0 return ($x * $matrix->[0] + $y * $matrix->[1] + $matrix->[2], $x * $matrix->[3] + $y * $matrix->[4] + $matrix->[5]);
8785             }
8786              
8787             sub _get_ioctl {
8788             ##########################################################
8789             ## GET IOCTL INFO ##
8790             ##########################################################
8791             # 'sys/ioctl.ph' is flakey. Not used at the moment. #
8792             ##########################################################
8793             # Used to return an array specific to the ioctl function #
8794             ##########################################################
8795              
8796             # This really needs to be moved over to the C routines, as the structure really is hard to parse for different processor long types
8797             # ... aaaaand ... I did
8798 0     0   0 my $command = shift;
8799 0         0 my $format = shift;
8800 0         0 my $fb = shift;
8801 0         0 my $data = '';
8802 0         0 my @array;
8803 0         0 eval {
8804 0 0       0 if (defined($fb)) {
8805 0         0 ioctl($fb, $command, $data);
8806             } else {
8807 0         0 ioctl(STDOUT, $command, $data);
8808             }
8809             };
8810 0         0 @array = unpack($format, $data);
8811 0         0 return (@array);
8812             }
8813              
8814             sub _set_ioctl {
8815             ##########################################################
8816             ## SET IOCTL INFO ##
8817             ##########################################################
8818             # Used to call or set ioctl specific functions #
8819             ##########################################################
8820 0     0   0 my $command = shift;
8821 0         0 my $format = shift;
8822 0         0 my $fb = shift;
8823 0         0 my @array = @_;
8824              
8825 0         0 my $data = pack($format, @array);
8826 0         0 eval { return (ioctl($fb, $command, $data)); };
  0         0  
8827             }
8828              
8829             sub _slurp { # Just used for /proc
8830 2     2   16 my $file = shift;
8831 2         7 my $buffer = '';
8832 2         7 eval {
8833 2         279 open(my $sl,'<',$file);
8834 2         138 read($sl,$buffer,10);
8835 2         47 close($sl);
8836 2         31 $buffer = chomp($buffer);
8837             };
8838 2         43 return($buffer);
8839             }
8840              
8841             1;
8842              
8843             __END__