Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Initial revision

  • Loading branch information...
commit 02d1d62827cef86398edc2013f7d2ff04bf21c63 0 parents
Arnar Mar Hrafnkelsson authored
Showing with 24,002 additions and 0 deletions.
  1. +404 −0 Changes
  2. +2,270 −0 Imager.pm
  3. +1,813 −0 Imager.xs
  4. +95 −0 MANIFEST
  5. +371 −0 Makefile.PL
  6. +217 −0 README
  7. +34 −0 bench/benchform.perl
  8. BIN  bench/kscdisplay.png
  9. +41 −0 bench/makegrad.perl
  10. +105 −0 bench/quantbench.perl
  11. +90 −0 bench/quantone.perl
  12. +113 −0 bigtest.perl
  13. +68 −0 conv.c
  14. +255 −0 datatypes.c
  15. +122 −0 datatypes.h
  16. +76 −0 doco.perl
  17. +859 −0 draw.c
  18. +24 −0 draw.h
  19. +301 −0 dynaload.c
  20. +73 −0 dynaload.h
  21. +92 −0 dynfilt/Makefile.PL
  22. +2 −0  dynfilt/compile.txt
  23. +54 −0 dynfilt/dt2.c
  24. +73 −0 dynfilt/dyntest.c
  25. +72 −0 dynfilt/flines.c
  26. +103 −0 dynfilt/mandelbrot.c
  27. +17 −0 dynfilt/pluginst.h
  28. +96 −0 errep.perl
  29. +18 −0 ext.h
  30. +10 −0 feat.c
  31. +25 −0 feat.h
  32. +12 −0 filterlist.perl
  33. +951 −0 filters.c
  34. +1,176 −0 font.c
  35. +751 −0 fontfiles/dcr10.afm
  36. BIN  fontfiles/dcr10.pfb
  37. BIN  fontfiles/dodge.ttf
  38. +71 −0 gaussian.c
  39. +839 −0 gif.c
  40. +1,153 −0 image.c
  41. +445 −0 image.h
  42. +48 −0 imio.h
  43. +246 −0 io.c
  44. +846 −0 iolayer.c
  45. +148 −0 iolayer.h
  46. +715 −0 jpeg.c
  47. +107 −0 lib/Imager/Color.pm
  48. +624 −0 lib/Imager/Expr.pm
  49. +277 −0 lib/Imager/Expr/Assem.pm
  50. +315 −0 lib/Imager/Font.pm
  51. +426 −0 lib/Imager/Regops.pm
  52. +519 −0 lib/Imager/Transform.pm
  53. +103 −0 lib/Imager/regmach.pod
  54. +95 −0 log.c
  55. +26 −0 log.h
  56. +38 −0 plug.h
  57. +484 −0 png.c
  58. +417 −0 pnm.c
  59. +286 −0 ppport.h
  60. +1,416 −0 quant.c
  61. +98 −0 raw.c
  62. +394 −0 regmach.c
  63. +83 −0 regmach.h
  64. +88 −0 regops.perl
  65. +45 −0 spot.perl
  66. +49 −0 stackmach.c
  67. +25 −0 stackmach.h
  68. +28 −0 t/t00basic.t
  69. +362 −0 t/t10formats.t
  70. +30 −0 t/t15color.t
  71. +86 −0 t/t30t1font.t
  72. +71 −0 t/t35ttfont.t
  73. +96 −0 t/t36oofont.t
  74. +36 −0 t/t40scale.t
  75. +50 −0 t/t50basicoo.t
  76. +53 −0 t/t55trans.t
  77. +28 −0 t/t56postfix.t
  78. +43 −0 t/t57infix.t
  79. +55 −0 t/t58trans2.t
  80. +38 −0 t/t59assem.t
  81. +29 −0 t/t60dyntest.t
  82. +33 −0 t/t65crop.t
  83. +28 −0 t/t66paste.t
  84. +40 −0 t/t70newgif.t
  85. +60 −0 t/t75polyaa.t
  86. +27 −0 t/t90cc.t
  87. +1,005 −0 testimg/penguin-base.ppm
  88. BIN  testimg/scale.gif
  89. +58 −0 testimg/scale.ppm
  90. BIN  testimg/scalei.gif
  91. +346 −0 tiff.c
  92. +42 −0 trans2.c
  93. +27 −0 transbench.perl
  94. +100 −0 transform.perl
  95. +22 −0 typemap
404 Changes
@@ -0,0 +1,404 @@
+Revision history for Perl extension Imager.
+
+0.01 Thu May 6 15:25:03 1999
+ - original version; created by h2xs 1.18
+
+0.02 Mon May 10 20:20:20 1999
+ - Added PPM writer, and a new return type to
+ be used to return undef() from a function returning
+ (int)0.
+
+0.03 Thu May 20 23:23:23 1999
+ - Added Pseudo image handling thingies, now
+ you can use your own get and put pixel routines.
+
+0.04 Mon May 24 22:14:55 1999
+ - Rewrote parts of jpeg support.
+
+0.05 Tue May 25 23:40:01 1999
+ - Added png support with libpng
+ fixed error reporting and return types from
+ some format routines.
+
+0.06 Wed May 26 19:05:39 1999
+ - Fixed Data::Dumper being used when it shouldn't have
+ added feature checking to see at run time if
+ certain formats are avaliable.
+ removed some ancient C++ style comments that hadn't
+ been properly removed, some out of bounds errors in ppm.c
+ fixed tests so missing features are skipped.
+
+0.07 Thu May 27 03:15:00 1999
+ - Fixed the typemap for i_img and i_color so that you can pass
+ a null pointer to them without getting a warning when warnings
+ are enabled. Maybe this is counter perl but it greatly increases
+ the usability of the functions.
+
+0.08 Fri May 28 14:13:21 1999
+ - Added support for gif via, giflib or libungif.
+ gif is so ridden with patent issues but the user
+ can decide which library to use since they have the same
+ include files and calling interface.
+
+0.09 Mon May 31 17:52:32 1999
+ - Added image scaling per axis - faster than doing both
+ axes at the same time. The current method uses lancoz
+ kernel and filtering. But more types should be added -
+ including: nearest neighbor, linear, and bicubic.
+
+0.10 Mon Jun 7 03:25:54 1999
+ - Added T1 postscript font handling. It's very primitive
+ at the moment but creative people can do nice stuff
+ with it. Currently it is not possible to have it
+ generate an image of the correct size for a given string
+ but that is on the way.
+
+0.11 Mon Jun 7 14:43:35 1999
+ - Added T1 features for direct to image rendering in
+ a single color. fixed some debug messages going to
+ stderr instead of a log file.
+
+0.12 Tue Jun 8 02:58:43 1999
+ - Fixed bugs in jpeg.c when loading images. Also specified
+ prototype behaviour to on in the Imager.xs file. The
+ Makefile.PL step doesn't complain anymore so that is
+ hopefully fixed.
+
+0.13 Wed Jun 9 06:55:58 1999
+ - Fixed Imager.xs for init_log call. Minor fixes here
+ and there.
+
+0.14 Thu Jun 10 14:11:22 1999
+ - Rewrote most of the logging stuff so that it is now
+ possible to remove all logging from the XS part of the
+ module. Also some primitive check of memory usage was
+ added. Claes Jacobsson sent in some filters, inverter,
+ contrast and a noise filter.
+
+0.15 Mon Jun 14 08:13:29 1999
+ - Wrote minor enhancement on the calling syntax list.
+ Started on the object interface - added better support
+ for quering avaliable filetypes. Fixed memory leaks in
+ most loaders. New filters from Claes in this version
+ are bumpmap, postlevels and mosaic.
+
+0.16 Wed Jun 16 20:54:33 1999
+ - Added fixes to the BEGIN and END parts, added writer
+ function for the OO interface. Also added basic IPTC
+ reading support for jpegs. Also a few filters have been
+ added to the OO interface.
+
+0.17 Thu Jun 24 11:09:15 1999
+ - Added dynamic loading stuff - It's still missing a nice
+ global symbol table. This will be fixed in next release.
+ also calling the plugins is not all to easy at the moment.
+
+
+0.18 Mon Jun 28 12:31:33 1999
+ - Added global symbol table - plugins now need a symbol
+ table pointer in them. When the module is loaded it is
+ set to point at the global symbol table. Also some barebones
+ Makefile.PL has been made in the dynfilt directory - it works
+ on my system - I hope it does on yours.
+
+
+0.19 Fri Jul 1 15:00:03 1999
+ - Added a way new scaling method for creating easy previews.
+ It only uses nearest neighbor, so it's doesn't look very nice
+ but it may be better for applications like remote sensing.
+
+0.20 Mon Jul 5 10:15:37 1999
+ - Added and rewrote documentation.
+
+0.21 Mon Jul 6 19:15:37 1999
+ - Fixed a bug in the scaling routine - it wasn't
+ handling 0< cases.
+
+0.22 Sat Oct 9 07:04:14 1999
+ - Added a new method to write gif images - now
+ it is possible to have a part of a palette fixed.
+ this is very usefull if one needs to make sure that
+ some color like white is in the pallete. This method
+ also allows some ditherding and gives better colormap
+ than the mediancut from the gif libraries. It does
+ need much more cpu power though. Hopefully later versions
+ will be faster.
+
+0.23 **************** Internal release only
+ - Fixed the %instances bug - caused ALL memory to be leaked.
+ Added real noise function - need feedback on how it should
+ be used. Also box(), and polyline are now in place. Polygon
+ is missing but antialiased line drawing with integer endpoints are
+ done but should be replaced with a version that can have
+ floating point endvalues. Two noise filters addded.
+
+0.24 **************** Internal release only
+ - Converted i_color into an object from a reference, so now it's
+ giving an object instead of a void ptr or an integer or something.
+
+0.25 **************** Internal release only
+ - Added basic Truetype functionality - still needs a rewrite
+ to be decent. Currently it's a port of a demo program that
+ uses an awful amount of global variables and there is much IO since
+ no caching of glyphs is done.
+
+0.26 Tue Nov 23 03:57:00 1999 > Development release <
+ - Added transformations so that an image can be wrapped.
+ To achive decent speed a C based stackmachine is included. As a result
+ transformations need to be specified in rpn (postfix) notation. It
+ also can use the Affix::Infix2Postfix class to do the conversion for it.
+
+0.27 Tue Dec 28 03:57:00 1999 > CPAN release <
+ - This is a bugfix version mostly, thanks to claes for pointing
+ out the problems - fixed palette saving wasn't working correctly after
+ version 0.24 - rather surprised this didn't crash everything.
+ Also fixed that for t1 fonts the bounding box wasn't being reported
+ unless the font had been used before. This is either a bug in t1lib
+ or a mistake in it's documentation. Another lingering bug since 0.24
+ what that $img->box() wasn't creating it's default color properly.
+ Added i_tt_text() method and more debuging to the truetype routines.
+ truetype testcase fixed and old debug rubish removed.
+
+0.28 Tue Jan 4 05:25:58 2000 > CPAN release <
+ - Only fixes to truetype test and transformation tests.
+ Thanks to schinder of cpan testers for testing and reporting.
+
+0.29 Tue Jan 4 21:49:57 2000 > CPAN release <
+ - fixes to get rid of warnings under pre 5.005,
+ Fixed broken preproccessor directives to work on non gnu
+ compilers. Fixed DSO test on HPUX - both code errors and
+ HPUX creates .sl instead of .so so the tests were failing.
+
+0.30 Sun Jan 7 05:00:06 2000 > Bunch of Alpha releases <
+ - An attempt to automate installation.
+
+0.31 Sat Jan 15 03:58:29 2000 > Fixes fixes fixes <
+ - Fixed a bug pointed out by Leolo where loading gifs
+ skips the first line of the imageload() has been
+ by read() - for now load is an alias for read. It will
+ be removed in the future. Also, fixes dynamic loading on
+ systems that prepend an underscore to symbols. At the present
+ the only system that I know of that needs this is OpenBSD.
+ BUT YOU MUST RECOMPILE ALL OF YOUR OLD MODULES AGAINST THIS BUILD.
+ Added getchannels() method ( How did I manage to delay this
+ untill now ). Some document changes but nothing substantial.
+ Also fixed the png read/write routines to handle all colorspaces
+ and images with alpha information. Also now it's possible to
+ have Imager guess the format of the files to load or save
+ when passing files to read or save from the filename.
+ Also all of the tests except dynamic loading now pass on OS/2.
+
+0.32 Tue Feb 29 17:26:00 2000 CPAN RELEASE
+ - Added the getcolorcount method. Fixed interlace handling
+ on png images. Fixed the missing channel count in crop()
+ method. Rewrote most of t1lib database stuff - created color
+ and font classes. T1 stuff is mostly done - TT things were
+ rewritten too and now include most of what is needed for
+ pixmap caching. Added documentation for fonts. Comments have
+ been added to some of the relevant c-routines. Added a copy()
+ function in Imager.xs and a corresponding method name.
+ Changed the underlying data type for the raw XS images from
+ pointers to objects - this will hopefully catch the most
+ basic errors and keep the segfaulting down. This means that
+ all of the underlying XS calls for readjpeg, readgif, readpng
+ and readraw do not take the first parameter any more.
+ Made fixes to keep it not spewing warning on 5.004 perl.
+
+ **** If you had any code that didn't use the OO interface ****
+ **** It will probably not work any longer ****
+
+0.33 Beta -- No final
+ - Fixed the end message from Imager 0.32. Destroy called
+ on an empty image. Did some work on the polygon method.
+ Some clean up in the Makefile.PL script. Fixed a buffer
+ overrun in the t_transform in Imager.XS. Fixed the
+ error handling in the jpeg loader. It now correctly
+ returns undef if a load on an image fails. It also
+ sends the error messages to the log file. Added errstr()
+ method to the image object. Added a new way to read()
+ objects from scalars. So far this is only implemented for
+ jpeg, png and gif. ppm and raw soon - as always if someone
+ wants to do an overhaul on the ppm stuff feel free. It seems
+ like such a basic format that interfacing with a library is more
+ work than implementing all of the needed routines instead.
+
+0.34 Beta -- No final
+ - Bunch of documentation fixes, backed out ppm code.
+ Put in TonyC's giant transform2 patch. Fixed the patch
+ to make it ansi compliant. Fixed a bunch of bugs in the
+ Freetype code with regard to vertical and horizontal
+ positioning and bounding boxes. Cleaned up a lot of the
+ code so it runs under -Wall. Code that is still in
+ development such as the polygon converter do not compile
+ cleanly. Fixed the non antialiased versions of truetype
+ dump to image routines. Also removed the FIXME for the
+ hardcoding of antialias in the Imager string method.
+ Fixed sign error and a missing cache of the bounding box
+ calculation for the rasterize function. Removed some
+ debugging code I forgot to remove. Added iolayer.h
+ and iolayer.c but they don't do anything for now.
+
+0.35 pre2 -- No time yet
+ - Fixed some compile warnings for various files under -Wall.
+ Added functionality for jpeg reading of seekable files, it's not
+ really working yet. This version is pretty much *not* working.
+ Do not install unless you intend to do a lot of development.
+ Repeat - it doesn't even pass tests (but it compiles). Ok now reading
+ jpegs works from scalars, my guess is that it also works from non
+ seeking sources such as sockets or pipes.
+
+0.35 pre3 - No time yet
+ - Added the *right* patch from Tony which combines
+ the common code from i_readgif and i_readgif_scalar into
+ i_readgif_low. Added tiff reading support through iolayer.
+
+0.35 pre4 - No time yet
+ - Added tiff writing (no options) support through
+ iolayer. Also made some small fixes for the iolayer reading
+ (was always doing two reads when one was needed). Patched the
+ Imager::read() call so that it now uses a mixture of old and new
+ functions.
+
+0.35 pre5 - No time yet
+ - Fixed various gnu'isms in the c code (some bugs in the link list
+ implmentation). Fixed missing #skip codes when gif format is not
+ present in any form. Added fixes for 5.004_04 in the transform2 function.
+ Made sure it compiles cleanly with sun's cc. Switched from a .jpeg
+ for transform2 check to a .ppm file so it runs when jpeg is not
+ present. Added a test for tiff files in t10formats.t.
+
+
+0.35 pre6 - No time yet
+ - Fixes to Makefile.PL. Should find freetype includes on more
+ distributions now. Ran tests on Solaris and Hpux, minor fixes.
+ Compiles with some warnings on with both hpux and solaris' cc.
+ Made some minor changes to the documentation. Fixes to tiff.c log
+ code.
+
+0.35 pre7 - No time yet
+ - Fixes 64 bit bug on freebsd. While libtiff mirrors the effects of
+ lseek it's toff_t is a uint32, while lseek uses off_t which can be a 64
+ bit quantity. Added the IM_LFLAGS environment variable to help
+ people with broken libgifs (that want to link with X).
+
+0.35 Sun Jan 28 19:42:59 EST 2001
+ - More makefile fixes, fixed a few signedness warnings.
+ Checked to see if it compiled cleanly on Solaris and HPUX.
+ Fixed a 5.004_04 warning and added more ENV flags for makefile.
+
+0.36 Mon Jan 29 09:36:11 EST 2001
+ - String as 0 or "" caused an error in $img->string(). Fixed a
+ documentation error invoving string() method syntax. Merged a patch
+ for non antialised truetype fonts. Fixed an error in the Makefile.PL
+ which caused a makefile to be generated that bombed with sgi's make.
+
+0.37 Mon Tue 30 09:36:11 EST 2001
+ - Several documentation fixes. Pod documentation for almost every
+ function in image.c. Added sys/types.h include in iolayer which was
+ causing problems on various linux systems.
+
+0.38 pre1 - No time yet
+ - Fixed a braindamaged fix on the Makefile.PL file. Moved the
+ code for Imager::Color into lib/Imager/Color.pm. Wrote some pod
+ about how it works. Made the names of Imager::Color XS routines
+ all begin with ICL_ and used the prefix rules of XS to get nice names
+ in perl. Found a bug (not fixed) in how XS handles
+ returning an object to an object it had as a parameter (double
+ free).
+
+0.38 pre2 - No time yet
+ - Fixes lots of for documentation, patch for freetype bounding
+ box handling. Split put code for Imager::Font into Font.pm and added
+ more documentation for Font.pm. Added string local ascender and
+ descender for tt fonts. Note that this needs to be added to t1 fonts
+ before 0.38 final.
+
+0.38 pre3 - No time yet
+ - Fixed an in consistency in the bounding box functions for t1
+ fonts. Now both versions get the 6 argument bounding_box method
+ described in Imager::Font. Started converting the comments in
+ font.c so that they are viewable by doco.perl. Added two examples
+ of filters. Need to make them more usefull and then add more
+ notes than are in compile.txt.
+
+
+0.38 pre4 - No time yet
+ - Completed adding pod comments to font.c, tiff.c and iolayer.c.
+ Those along with image.c should now have every single function
+ described in pod format.
+
+0.38 pre5 - No time yet
+ - Replaced ppm.c with pnm.c which adds support for pbm/pgm/ppm
+ files ascii and binary formats. Added patches for the gif routines.
+ Patched some of the color quantizing routines (Leolo and TonyC).
+ There is one bomb and one warning in this test, and frankly I don't
+ see why they are suddenly there.
+
+0.38 pre6 - No time yet
+ - Patch from Tony that fixes infix when Parse::RecDescent is present.
+ Checked some cases where malloc/free were used instead of mymalloc/myfree.
+ Added bufchain iolayer code. You can now write to a chain of buffers and
+ later slurp it all into a single perl scalar. Found some oddity of t/t10
+ test not giving the right return value when malloc debugging was enabled.
+ Fixed some of the logging code and the malloc debugging options. Added
+ more tests for tiffs.
+
+0.38 pre7 - No time yet
+ - Added i_gradgen code and put it into the filters hash. Think a
+ seperate pod for filters would be a good idea. Also removed some of the
+ debugging code from the iolayer. Added pod comments to filters.c and
+ looked over the code.
+
+0.38 pre8 - No time yet
+ - limited Win32 support, Imager installs and builds using VC++,
+ but there's no image/font format support yet.
+
+0.38 pre9 - No time yet
+ - Added lots of color quantization code from Tony with benchmarks.
+ Also fixes ugly stack overrun in old version. Added fixes for the lmfixed
+ problem. Four of them, let's see which is fastest. This version adds
+ some voronoi partitioning - it's dog slow but it's a reference implementation
+ to check if faster algorithms are doing the right thing [tm]. Added a check
+ for giflib 3.
+
+
+
+~~~~~~~~~~~~~^ ^ ^~~~~~~~~~~~~~
+
+
+0.40 TODO list
+ iolayer:
+ - Add scalar/mmap to iolayer
+ - Add close() code to iolayer
+ - Merge callback interface into iolayer
+ - Add interface for writing to all formats but tiff
+ - Add interface for reading for png (started),
+ gif (merge with cb patch), ppm and raw
+ - Add make new tests once all formats support io_layer
+ - Implment the maxread threshold (Indicates how far
+ a library can read before it indicates that it's done).
+
+ MultiImage & metadata support:
+ - Figure what interface should be between C and perl?
+ - How to store data in the C interface for tags/metadata?
+
+ Old sins:
+ - Make sure everything is doable with the OO interface
+ - Split the other classes into seperate files
+ - Compile with memory debugging enabled and fix leaks
+ - Check if hashbox code is choosing the wrong closest color
+
+ Documentation:
+ - Add to the documentation
+ - Write a tutorial?
+ - Write a guide to installing the helper libraries
+ - Go through the entire project and add comments in pod
+ so doco.perl can be used to read them.
+
+===================================================
+
+ For latest versions check the Imager-devel pages:
+ http://www.eecs.umich.edu/~addi/perl/Imager/devel/
+
+===================================================
+
2,270 Imager.pm
@@ -0,0 +1,2270 @@
+package Imager;
+
+
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS %formats $DEBUG %filters %DSOs $ERRSTR $fontstate %OPCODES $I2P $FORMATGUESS);
+use IO::File;
+
+use Imager::Color;
+use Imager::Font;
+
+@EXPORT_OK = qw(
+ init
+ init_log
+ DSO_open
+ DSO_close
+ DSO_funclist
+ DSO_call
+
+ load_plugin
+ unload_plugin
+
+ i_list_formats
+ i_has_format
+
+ i_color_new
+ i_color_set
+ i_color_info
+
+ i_img_empty
+ i_img_empty_ch
+ i_img_exorcise
+ i_img_destroy
+
+ i_img_info
+
+ i_img_setmask
+ i_img_getmask
+
+ i_draw
+ i_line_aa
+ i_box
+ i_box_filled
+ i_arc
+
+ i_bezier_multi
+ i_poly_aa
+
+ i_copyto
+ i_rubthru
+ i_scaleaxis
+ i_scale_nn
+ i_haar
+ i_count_colors
+
+
+ i_gaussian
+ i_conv
+
+ i_img_diff
+
+ i_init_fonts
+ i_t1_new
+ i_t1_destroy
+ i_t1_set_aa
+ i_t1_cp
+ i_t1_text
+ i_t1_bbox
+
+
+ i_tt_set_aa
+ i_tt_cp
+ i_tt_text
+ i_tt_bbox
+
+ i_readjpeg
+ i_writejpeg
+
+ i_readjpeg_wiol
+ i_writejpeg_wiol
+
+ i_readtiff_wiol
+ i_writetiff_wiol
+
+ i_readpng
+ i_writepng
+
+ i_readgif
+ i_readgif_callback
+ i_writegif
+ i_writegifmc
+ i_writegif_gen
+ i_writegif_callback
+
+ i_readpnm_wiol
+ i_writeppm
+
+ i_readraw
+ i_writeraw
+
+ i_contrast
+ i_hardinvert
+ i_noise
+ i_bumpmap
+ i_postlevels
+ i_mosaic
+ i_watermark
+
+ malloc_state
+
+ list_formats
+
+ i_gifquant
+
+ newfont
+ newcolor
+ newcolour
+ NC
+ NF
+
+);
+
+
+
+@EXPORT=qw(
+ init_log
+ i_list_formats
+ i_has_format
+ malloc_state
+ i_color_new
+
+ i_img_empty
+ i_img_empty_ch
+ );
+
+%EXPORT_TAGS=
+ (handy => [qw(
+ newfont
+ newcolor
+ NF
+ NC
+ )],
+ all => [@EXPORT_OK],
+ default => [qw(
+ load_plugin
+ unload_plugin
+ )]);
+
+
+BEGIN {
+ require Exporter;
+ require DynaLoader;
+
+ $VERSION = '0.38pre9';
+ @ISA = qw(Exporter DynaLoader);
+ bootstrap Imager $VERSION;
+}
+
+BEGIN {
+ i_init_fonts(); # Initialize font engines
+ for(i_list_formats()) { $formats{$_}++; }
+
+ if ($formats{'t1'}) {
+ i_t1_set_aa(1);
+ }
+
+ if (!$formats{'t1'} and !$formats{'tt'}) {
+ $fontstate='no font support';
+ }
+
+ %OPCODES=(Add=>[0],Sub=>[1],Mult=>[2],Div=>[3],Parm=>[4],'sin'=>[5],'cos'=>[6],'x'=>[4,0],'y'=>[4,1]);
+
+ $DEBUG=0;
+
+ $filters{contrast}={
+ callseq => ['image','intensity'],
+ callsub => sub { my %hsh=@_; i_contrast($hsh{image},$hsh{intensity}); }
+ };
+
+ $filters{noise} ={
+ callseq => ['image', 'amount', 'subtype'],
+ defaults => { amount=>3,subtype=>0 },
+ callsub => sub { my %hsh=@_; i_noise($hsh{image},$hsh{amount},$hsh{subtype}); }
+ };
+
+ $filters{hardinvert} ={
+ callseq => ['image'],
+ defaults => { },
+ callsub => sub { my %hsh=@_; i_hardinvert($hsh{image}); }
+ };
+
+ $filters{autolevels} ={
+ callseq => ['image','lsat','usat','skew'],
+ defaults => { lsat=>0.1,usat=>0.1,skew=>0.0 },
+ callsub => sub { my %hsh=@_; i_autolevels($hsh{image},$hsh{lsat},$hsh{usat},$hsh{skew}); }
+ };
+
+ $filters{turbnoise} ={
+ callseq => ['image'],
+ defaults => { xo=>0.0,yo=>0.0,scale=>10.0 },
+ callsub => sub { my %hsh=@_; i_turbnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{scale}); }
+ };
+
+ $filters{radnoise} ={
+ callseq => ['image'],
+ defaults => { xo=>100,yo=>100,ascale=>17.0,rscale=>0.02 },
+ callsub => sub { my %hsh=@_; i_radnoise($hsh{image},$hsh{xo},$hsh{yo},$hsh{rscale},$hsh{ascale}); }
+ };
+
+ $filters{conv} ={
+ callseq => ['image', 'coef'],
+ defaults => { },
+ callsub => sub { my %hsh=@_; i_conv($hsh{image},$hsh{coef}); }
+ };
+
+ $filters{gradgen} ={
+ callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
+ defaults => { },
+ callsub => sub { my %hsh=@_; i_gradgen($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
+ };
+
+ $filters{nearest_color} ={
+ callseq => ['image', 'xo', 'yo', 'colors', 'dist'],
+ defaults => { },
+ callsub => sub { my %hsh=@_; i_nearest_color($hsh{image}, $hsh{xo}, $hsh{yo}, $hsh{colors}, $hsh{dist}); }
+ };
+
+ $FORMATGUESS=\&def_guess_type;
+}
+
+#
+# Non methods
+#
+
+# initlize Imager
+# NOTE: this might be moved to an import override later on
+
+#sub import {
+# my $pack = shift;
+# (look through @_ for special tags, process, and remove them);
+# use Data::Dumper;
+# print Dumper($pack);
+# print Dumper(@_);
+#}
+
+sub init {
+ my %parms=(loglevel=>1,@_);
+ if ($parms{'log'}) {
+ init_log($parms{'log'},$parms{'loglevel'});
+ }
+
+# if ($parms{T1LIB_CONFIG}) { $ENV{T1LIB_CONFIG}=$parms{T1LIB_CONFIG}; }
+# if ( $ENV{T1LIB_CONFIG} and ( $fontstate eq 'missing conf' )) {
+# i_init_fonts();
+# $fontstate='ok';
+# }
+}
+
+END {
+ if ($DEBUG) {
+ print "shutdown code\n";
+ # for(keys %instances) { $instances{$_}->DESTROY(); }
+ malloc_state(); # how do decide if this should be used? -- store something from the import
+ print "Imager exiting\n";
+ }
+}
+
+# Load a filter plugin
+
+sub load_plugin {
+ my ($filename)=@_;
+ my $i;
+ my ($DSO_handle,$str)=DSO_open($filename);
+ if (!defined($DSO_handle)) { $Imager::ERRSTR="Couldn't load plugin '$filename'\n"; return undef; }
+ my %funcs=DSO_funclist($DSO_handle);
+ if ($DEBUG) { print "loading module $filename\n"; $i=0; for(keys %funcs) { printf(" %2d: %s\n",$i++,$_); } }
+ $i=0;
+ for(keys %funcs) { if ($filters{$_}) { $ERRSTR="filter '$_' already exists\n"; DSO_close($DSO_handle); return undef; } }
+
+ $DSOs{$filename}=[$DSO_handle,\%funcs];
+
+ for(keys %funcs) {
+ my $evstr="\$filters{'".$_."'}={".$funcs{$_}.'};';
+ $DEBUG && print "eval string:\n",$evstr,"\n";
+ eval $evstr;
+ print $@ if $@;
+ }
+ return 1;
+}
+
+# Unload a plugin
+
+sub unload_plugin {
+ my ($filename)=@_;
+
+ if (!$DSOs{$filename}) { $ERRSTR="plugin '$filename' not loaded."; return undef; }
+ my ($DSO_handle,$funcref)=@{$DSOs{$filename}};
+ for(keys %{$funcref}) {
+ delete $filters{$_};
+ $DEBUG && print "unloading: $_\n";
+ }
+ my $rc=DSO_close($DSO_handle);
+ if (!defined($rc)) { $ERRSTR="unable to unload plugin '$filename'."; return undef; }
+ return 1;
+}
+
+
+#
+# Methods to be called on objects.
+#
+
+# Create a new Imager object takes very few parameters.
+# usually you call this method and then call open from
+# the resulting object
+
+sub new {
+ my $class = shift;
+ my $self ={};
+ my %hsh=@_;
+ bless $self,$class;
+ $self->{IMG}=undef; # Just to indicate what exists
+ $self->{ERRSTR}=undef; #
+ $self->{DEBUG}=$DEBUG;
+ $self->{DEBUG} && print "Initialized Imager\n";
+ if ($hsh{xsize} && $hsh{ysize}) { $self->img_set(%hsh); }
+ return $self;
+}
+
+
+# Copy an entire image with no changes
+# - if an image has magic the copy of it will not be magical
+
+sub copy {
+ my $self = shift;
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ my $newcopy=Imager->new();
+ $newcopy->{IMG}=i_img_new();
+ i_copy($newcopy->{IMG},$self->{IMG});
+ return $newcopy;
+}
+
+# Paste a region
+
+sub paste {
+ my $self = shift;
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+ my %input=(left=>0, top=>0, @_);
+ unless($input{img}) {
+ $self->{ERRSTR}="no source image";
+ return;
+ }
+ $input{left}=0 if $input{left} <= 0;
+ $input{top}=0 if $input{top} <= 0;
+ my $src=$input{img};
+ my($r,$b)=i_img_info($src->{IMG});
+
+ i_copyto($self->{IMG}, $src->{IMG},
+ 0,0, $r, $b, $input{left}, $input{top});
+ return $self; # What should go here??
+}
+
+# Crop an image - i.e. return a new image that is smaller
+
+sub crop {
+ my $self=shift;
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+ my %hsh=(left=>0,right=>0,top=>0,bottom=>0,@_);
+
+ my ($w,$h,$l,$r,$b,$t)=($self->getwidth(),$self->getheight(),
+ @hsh{qw(left right bottom top)});
+ $l=0 if not defined $l;
+ $t=0 if not defined $t;
+ $r=$self->getwidth if not defined $r;
+ $b=$self->getheight if not defined $b;
+
+ ($l,$r)=($r,$l) if $l>$r;
+ ($t,$b)=($b,$t) if $t>$b;
+
+ if ($hsh{'width'}) {
+ $l=int(0.5+($w-$hsh{'width'})/2);
+ $r=$l+$hsh{'width'};
+ } else {
+ $hsh{'width'}=$r-$l;
+ }
+ if ($hsh{'height'}) {
+ $b=int(0.5+($h-$hsh{'height'})/2);
+ $t=$h+$hsh{'height'};
+ } else {
+ $hsh{'height'}=$b-$t;
+ }
+
+# print "l=$l, r=$r, h=$hsh{'width'}\n";
+# print "t=$t, b=$b, w=$hsh{'height'}\n";
+
+ my $dst=Imager->new(xsize=>$hsh{'width'},ysize=>$hsh{'height'},channels=>$self->getchannels());
+
+ i_copyto($dst->{IMG},$self->{IMG},$l,$t,$r,$b,0,0);
+ return $dst;
+}
+
+# Sets an image to a certain size and channel number
+# if there was previously data in the image it is discarded
+
+sub img_set {
+ my $self=shift;
+
+ my %hsh=(xsize=>100,ysize=>100,channels=>3,@_);
+
+ if (defined($self->{IMG})) {
+ i_img_destroy($self->{IMG});
+ undef($self->{IMG});
+ }
+
+ $self->{IMG}=Imager::ImgRaw::new($hsh{'xsize'},$hsh{'ysize'},$hsh{'channels'});
+}
+
+# Read an image from file
+
+sub read {
+ my $self = shift;
+ my %input=@_;
+ my ($fh, $fd, $IO);
+
+ if (defined($self->{IMG})) {
+ i_img_destroy($self->{IMG});
+ undef($self->{IMG});
+ }
+
+ if (!$input{fd} and !$input{file} and !$input{data}) { $self->{ERRSTR}='no file, fd or data parameter'; return undef; }
+ if ($input{file}) {
+ $fh = new IO::File($input{file},"r");
+ if (!defined $fh) { $self->{ERRSTR}='Could not open file'; return undef; }
+ binmode($fh);
+ $fd = $fh->fileno();
+ }
+ if ($input{fd}) { $fd=$input{fd} };
+
+ # FIXME: Find the format here if not specified
+ # yes the code isn't here yet - next week maybe?
+
+ if (!$input{type} and $input{file}) { $input{type}=$FORMATGUESS->($input{file}); }
+ if (!$formats{$input{type}}) { $self->{ERRSTR}='format not supported'; return undef; }
+
+ my %iolready=(jpeg=>1, tiff=>1, pnm=>1);
+
+ if ($iolready{$input{type}}) {
+ # Setup data source
+ $IO = io_new_fd($fd); # sort of simple for now eh?
+
+ if ( $input{type} eq 'jpeg' ) {
+ ($self->{IMG},$self->{IPTCRAW})=i_readjpeg_wiol( $IO );
+ if ( !defined($self->{IMG}) ) { $self->{ERRSTR}='unable to read jpeg image'; return undef; }
+ $self->{DEBUG} && print "loading a jpeg file\n";
+ return $self;
+ }
+
+ if ( $input{type} eq 'tiff' ) {
+ $self->{IMG}=i_readtiff_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
+ if ( !defined($self->{IMG}) ) { $self->{ERRSTR}='unable to read tiff image'; return undef; }
+ $self->{DEBUG} && print "loading a tiff file\n";
+ return $self;
+ }
+
+ if ( $input{type} eq 'pnm' ) {
+ $self->{IMG}=i_readpnm_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
+ if ( !defined($self->{IMG}) ) { $self->{ERRSTR}='unable to read pnm image'; return undef; }
+ $self->{DEBUG} && print "loading a pnm file\n";
+ return $self;
+ }
+
+ } else {
+
+ # Old code for reference while changing the new stuff
+
+
+ if (!$input{type} and $input{file}) { $input{type}=$FORMATGUESS->($input{file}); }
+ if (!$input{type}) { $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef; }
+
+ if (!$formats{$input{type}}) { $self->{ERRSTR}='format not supported'; return undef; }
+
+ if ($input{file}) {
+ $fh = new IO::File($input{file},"r");
+ if (!defined $fh) { $self->{ERRSTR}='Could not open file'; return undef; }
+ binmode($fh);
+ $fd = $fh->fileno();
+ }
+ if ($input{fd}) { $fd=$input{fd} };
+
+ if ( $input{type} eq 'gif' ) {
+ if (exists $input{data}) { $self->{IMG}=i_readgif_scalar($input{data}); }
+ else { $self->{IMG}=i_readgif( $fd ) }
+ if ( !defined($self->{IMG}) ) { $self->{ERRSTR}='unable to read gif image'; return undef; }
+ $self->{DEBUG} && print "loading a gif file\n";
+ } elsif ( $input{type} eq 'jpeg' ) {
+ if (exists $input{data}) { ($self->{IMG},$self->{IPTCRAW})=i_readjpeg_scalar($input{data}); }
+ else { ($self->{IMG},$self->{IPTCRAW})=i_readjpeg( $fd ); }
+ if ( !defined($self->{IMG}) ) { $self->{ERRSTR}='unable to read jpeg image'; return undef; }
+ $self->{DEBUG} && print "loading a jpeg file\n";
+ } elsif ( $input{type} eq 'png' ) {
+ if (exists $input{data}) { $self->{IMG}=i_readpng_scalar($input{data}); }
+ else { $self->{IMG}=i_readpng( $fd ); }
+ if ( !defined($self->{IMG}) ) { $self->{ERRSTR}='unable to read png image'; return undef; }
+ $self->{DEBUG} && print "loading a png file\n";
+ } elsif ( $input{type} eq 'raw' ) {
+ my %params=(datachannels=>3,storechannels=>3,interleave=>1);
+ for(keys(%input)) { $params{$_}=$input{$_}; }
+
+ if ( !($params{xsize} && $params{ysize}) ) { $self->{ERRSTR}='missing xsize or ysize parameter for raw'; return undef; }
+ $self->{IMG}=i_readraw( $fd, $params{xsize}, $params{ysize},
+ $params{datachannels}, $params{storechannels}, $params{interleave});
+ if ( !defined($self->{IMG}) ) { $self->{ERRSTR}='unable to read raw image'; return undef; }
+ $self->{DEBUG} && print "loading a raw file\n";
+ }
+ return $self;
+ }
+}
+
+
+# Write an image to file
+
+sub write {
+ my $self = shift;
+ my %input=(jpegquality=>75, gifquant=>'mc', lmdither=>6.0, lmfixed=>[], @_);
+ my ($fh, $rc, $fd, $IO);
+
+ my %iolready=( tiff=>1 ); # this will be SO MUCH BETTER once they are all in there
+
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ if (!$input{file} and !$input{'fd'} and !$input{'data'}) { $self->{ERRSTR}='file/fd/data parameter missing'; return undef; }
+ if (!$input{type}) { $input{type}=$FORMATGUESS->($input{file}); }
+ if (!$input{type}) { $self->{ERRSTR}='type parameter missing and not possible to guess from extension'; return undef; }
+
+ if (!$formats{$input{type}}) { $self->{ERRSTR}='format not supported'; return undef; }
+
+ if (exists $input{'fd'}) {
+ $fd=$input{'fd'};
+ } elsif (exists $input{'data'}) {
+ $IO = Imager::io_new_bufchain();
+ } else {
+ $fh = new IO::File($input{file},"w+");
+ if (!defined $fh) { $self->{ERRSTR}='Could not open file'; return undef; }
+ binmode($fh);
+ $fd = $fh->fileno();
+ }
+
+
+
+ if ($iolready{$input{type}}) {
+ if ($fd) {
+ $IO = io_new_fd($fd);
+ }
+
+ if ($input{type} eq 'tiff') {
+ if (!i_writetiff_wiol($self->{IMG}, $IO)) { $self->{ERRSTR}='Could not write to buffer'; return undef; }
+ }
+
+ my $data = io_slurp($IO);
+ if (!$data) { $self->{ERRSTR}='Could not slurp from buffer'; return undef; }
+
+ ${$input{data}} = $data;
+ return $self;
+ } else {
+
+ if ( $input{type} eq 'gif' ) {
+ if (not $input{gifplanes}) {
+ my $gp;
+ my $count=i_count_colors($self->{IMG}, 256);
+ $gp=8 if $count == -1;
+ $gp=1 if not $gp and $count <= 2;
+ $gp=2 if not $gp and $count <= 4;
+ $gp=3 if not $gp and $count <= 8;
+ $gp=4 if not $gp and $count <= 16;
+ $gp=5 if not $gp and $count <= 32;
+ $gp=6 if not $gp and $count <= 64;
+ $gp=7 if not $gp and $count <= 128;
+ $input{gifplanes} = $gp || 8;
+ }
+
+ if ($input{gifplanes}>8) {
+ $input{gifplanes}=8;
+ }
+ if ($input{gifquant} eq 'gen' || $input{callback}) {
+
+
+ if ($input{gifquant} eq 'lm') {
+
+ $input{make_colors} = 'addi';
+ $input{translate} = 'perturb';
+ $input{perturb} = $input{lmdither};
+ } elsif ($input{gifquant} eq 'gen') {
+ # just pass options through
+ } else {
+ $input{make_colors} = 'webmap'; # ignored
+ $input{translate} = 'giflib';
+ }
+
+ if ($input{callback}) {
+ defined $input{maxbuffer} or $input{maxbuffer} = -1;
+ $rc = i_writegif_callback($input{callback}, $input{maxbuffer},
+ \%input, $self->{IMG});
+ } else {
+ $rc = i_writegif_gen($fd, \%input, $self->{IMG});
+ }
+
+
+
+ } elsif ($input{gifquant} eq 'lm') {
+ $rc=i_writegif($self->{IMG},$fd,$input{gifplanes},$input{lmdither},$input{lmfixed});
+ } else {
+ $rc=i_writegifmc($self->{IMG},$fd,$input{gifplanes});
+ }
+ if ( !defined($rc) ) {
+ $self->{ERRSTR}='unable to write gif image'; return undef;
+ }
+ $self->{DEBUG} && print "writing a gif file\n";
+
+ } elsif ( $input{type} eq 'jpeg' ) {
+ $rc=i_writejpeg($self->{IMG},$fd,$input{jpegquality});
+ if ( !defined($rc) ) {
+ $self->{ERRSTR}='unable to write jpeg image'; return undef;
+ }
+ $self->{DEBUG} && print "writing a jpeg file\n";
+ } elsif ( $input{type} eq 'png' ) {
+ $rc=i_writepng($self->{IMG},$fd);
+ if ( !defined($rc) ) {
+ $self->{ERRSTR}='unable to write png image'; return undef;
+ }
+ $self->{DEBUG} && print "writing a png file\n";
+ } elsif ( $input{type} eq 'pnm' ) {
+ $rc=i_writeppm($self->{IMG},$fd);
+ if ( !defined($rc) ) {
+ $self->{ERRSTR}='unable to write pnm image'; return undef;
+ }
+ $self->{DEBUG} && print "writing a pnm file\n";
+ } elsif ( $input{type} eq 'raw' ) {
+ $rc=i_writeraw($self->{IMG},$fd);
+ if ( !defined($rc) ) {
+ $self->{ERRSTR}='unable to write raw image'; return undef;
+ }
+ $self->{DEBUG} && print "writing a raw file\n";
+ } elsif ( $input{type} eq 'tiff' ) {
+ $rc=i_writetiff_wiol($self->{IMG},io_new_fd($fd) );
+ if ( !defined($rc) ) {
+ $self->{ERRSTR}='unable to write tiff image'; return undef;
+ }
+ $self->{DEBUG} && print "writing a tiff file\n";
+ }
+
+ }
+ return $self;
+}
+
+sub write_multi {
+ my ($class, $opts, @images) = @_;
+
+ if ($opts->{type} eq 'gif') {
+ # translate to ImgRaw
+ if (grep !UNIVERSAL::isa($_, 'Imager') || !$_->{IMG}, @images) {
+ $ERRSTR = "Usage: Imager->write_multi({ options }, @images)";
+ return 0;
+ }
+ my @work = map $_->{IMG}, @images;
+ if ($opts->{callback}) {
+ # Note: you may need to fix giflib for this one to work
+ my $maxbuffer = $opts->{maxbuffer};
+ defined $maxbuffer or $maxbuffer = -1; # max by default
+ return i_writegif_callback($opts->{callback}, $maxbuffer,
+ $opts, @work);
+ }
+ if ($opts->{fd}) {
+ return i_writegif_gen($opts->{fd}, $opts, @work);
+ }
+ else {
+ my $fh = IO::File->new($opts->{file}, "w+");
+ unless ($fh) {
+ $ERRSTR = "Error creating $opts->{file}: $!";
+ return 0;
+ }
+ binmode($fh);
+ return i_writegif_gen(fileno($fh), $opts, @work);
+ }
+ }
+ else {
+ $ERRSTR = "Sorry, write_multi doesn't support $opts->{type} yet";
+ return 0;
+ }
+}
+
+# Destroy an Imager object
+
+sub DESTROY {
+ my $self=shift;
+ # delete $instances{$self};
+ if (defined($self->{IMG})) {
+ i_img_destroy($self->{IMG});
+ undef($self->{IMG});
+ } else {
+# print "Destroy Called on an empty image!\n"; # why did I put this here??
+ }
+}
+
+# Perform an inplace filter of an image
+# that is the image will be overwritten with the data
+
+sub filter {
+ my $self=shift;
+ my %input=@_;
+ my %hsh;
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ if (!$input{type}) { $self->{ERRSTR}='type parameter missing'; return undef; }
+
+ if ( (grep { $_ eq $input{type} } keys %filters) != 1) {
+ $self->{ERRSTR}='type parameter not matching any filter'; return undef;
+ }
+
+ if (defined($filters{$input{type}}{defaults})) {
+ %hsh=('image',$self->{IMG},%{$filters{$input{type}}{defaults}},%input);
+ } else {
+ %hsh=('image',$self->{IMG},%input);
+ }
+
+ my @cs=@{$filters{$input{type}}{callseq}};
+
+ for(@cs) {
+ if (!defined($hsh{$_})) {
+ $self->{ERRSTR}="missing parameter '$_' for filter ".$input{type}; return undef;
+ }
+ }
+
+ &{$filters{$input{type}}{callsub}}(%hsh);
+
+ my @b=keys %hsh;
+
+ $self->{DEBUG} && print "callseq is: @cs\n";
+ $self->{DEBUG} && print "matching callseq is: @b\n";
+
+ return $self;
+}
+
+# Scale an image to requested size and return the scaled version
+
+sub scale {
+ my $self=shift;
+ my %opts=(scalefactor=>0.5,type=>'max',qtype=>'normal',@_);
+ my $img = Imager->new();
+ my $tmp = Imager->new();
+
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ if ($opts{xpixels} and $opts{ypixels} and $opts{type}) {
+ my ($xpix,$ypix)=( $opts{xpixels}/$self->getwidth() , $opts{ypixels}/$self->getheight() );
+ if ($opts{type} eq 'min') { $opts{scalefactor}=min($xpix,$ypix); }
+ if ($opts{type} eq 'max') { $opts{scalefactor}=max($xpix,$ypix); }
+ } elsif ($opts{xpixels}) { $opts{scalefactor}=$opts{xpixels}/$self->getwidth(); }
+ elsif ($opts{ypixels}) { $opts{scalefactor}=$opts{ypixels}/$self->getheight(); }
+
+ if ($opts{qtype} eq 'normal') {
+ $tmp->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
+ if ( !defined($tmp->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
+ $img->{IMG}=i_scaleaxis($tmp->{IMG},$opts{scalefactor},1);
+ if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
+ return $img;
+ }
+ if ($opts{'qtype'} eq 'preview') {
+ $img->{IMG}=i_scale_nn($self->{IMG},$opts{'scalefactor'},$opts{'scalefactor'});
+ if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
+ return $img;
+ }
+ $self->{ERRSTR}='scale: invalid value for qtype'; return undef;
+}
+
+# Scales only along the X axis
+
+sub scaleX {
+ my $self=shift;
+ my %opts=(scalefactor=>0.5,@_);
+
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ my $img = Imager->new();
+
+ if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getwidth(); }
+
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+ $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},0);
+
+ if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
+ return $img;
+}
+
+# Scales only along the Y axis
+
+sub scaleY {
+ my $self=shift;
+ my %opts=(scalefactor=>0.5,@_);
+
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ my $img = Imager->new();
+
+ if ($opts{pixels}) { $opts{scalefactor}=$opts{pixels}/$self->getheight(); }
+
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+ $img->{IMG}=i_scaleaxis($self->{IMG},$opts{scalefactor},1);
+
+ if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='unable to scale image'; return undef; }
+ return $img;
+}
+
+
+# Transform returns a spatial transformation of the input image
+# this moves pixels to a new location in the returned image.
+# NOTE - should make a utility function to check transforms for
+# stack overruns
+
+sub transform {
+ my $self=shift;
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+ my %opts=@_;
+ my (@op,@ropx,@ropy,$iop,$or,@parm,$expr,@xt,@yt,@pt,$numre);
+
+# print Dumper(\%opts);
+# xopcopdes
+
+ if ( $opts{'xexpr'} and $opts{'yexpr'} ) {
+ if (!$I2P) {
+ eval ("use Affix::Infix2Postfix;");
+ print $@;
+ if ( $@ ) {
+ $self->{ERRSTR}='transform: expr given and Affix::Infix2Postfix is not avaliable.';
+ return undef;
+ }
+ $I2P=Affix::Infix2Postfix->new('ops'=>[{op=>'+',trans=>'Add'},
+ {op=>'-',trans=>'Sub'},
+ {op=>'*',trans=>'Mult'},
+ {op=>'/',trans=>'Div'},
+ {op=>'-',type=>'unary',trans=>'u-'},
+ {op=>'**'},
+ {op=>'func',type=>'unary'}],
+ 'grouping'=>[qw( \( \) )],
+ 'func'=>[qw( sin cos )],
+ 'vars'=>[qw( x y )]
+ );
+ }
+
+ @xt=$I2P->translate($opts{'xexpr'});
+ @yt=$I2P->translate($opts{'yexpr'});
+
+ $numre=$I2P->{'numre'};
+ @pt=(0,0);
+
+ for(@xt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'xopcodes'}},'Parm',$#pt); } else { push(@{$opts{'xopcodes'}},$_); } }
+ for(@yt) { if (/$numre/) { push(@pt,$_); push(@{$opts{'yopcodes'}},'Parm',$#pt); } else { push(@{$opts{'yopcodes'}},$_); } }
+ @{$opts{'parm'}}=@pt;
+ }
+
+# print Dumper(\%opts);
+
+ if ( !exists $opts{'xopcodes'} or @{$opts{'xopcodes'}}==0) {
+ $self->{ERRSTR}='transform: no xopcodes given.';
+ return undef;
+ }
+
+ @op=@{$opts{'xopcodes'}};
+ for $iop (@op) {
+ if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
+ $self->{ERRSTR}="transform: illegal opcode '$_'.";
+ return undef;
+ }
+ push(@ropx,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
+ }
+
+
+# yopcopdes
+
+ if ( !exists $opts{'yopcodes'} or @{$opts{'yopcodes'}}==0) {
+ $self->{ERRSTR}='transform: no yopcodes given.';
+ return undef;
+ }
+
+ @op=@{$opts{'yopcodes'}};
+ for $iop (@op) {
+ if (!defined ($OPCODES{$iop}) and ($iop !~ /^\d+$/) ) {
+ $self->{ERRSTR}="transform: illegal opcode '$_'.";
+ return undef;
+ }
+ push(@ropy,(exists $OPCODES{$iop}) ? @{$OPCODES{$iop}} : $iop );
+ }
+
+#parameters
+
+ if ( !exists $opts{'parm'}) {
+ $self->{ERRSTR}='transform: no parameter arg given.';
+ return undef;
+ }
+
+# print Dumper(\@ropx);
+# print Dumper(\@ropy);
+# print Dumper(\@ropy);
+
+ my $img = Imager->new();
+ $img->{IMG}=i_transform($self->{IMG},\@ropx,\@ropy,$opts{'parm'});
+ if ( !defined($img->{IMG}) ) { $self->{ERRSTR}='transform: failed'; return undef; }
+ return $img;
+}
+
+
+{
+ my $got_expr;
+ sub transform2 {
+ my ($opts, @imgs) = @_;
+
+ if (!$got_expr) {
+ # this is fairly big, delay loading it
+ eval "use Imager::Expr";
+ die $@ if $@;
+ ++$got_expr;
+ }
+
+ $opts->{variables} = [ qw(x y) ];
+ my ($width, $height) = @{$opts}{qw(width height)};
+ if (@imgs) {
+ $width ||= $imgs[0]->getwidth();
+ $height ||= $imgs[0]->getheight();
+ my $img_num = 1;
+ for my $img (@imgs) {
+ $opts->{constants}{"w$img_num"} = $img->getwidth();
+ $opts->{constants}{"h$img_num"} = $img->getheight();
+ $opts->{constants}{"cx$img_num"} = $img->getwidth()/2;
+ $opts->{constants}{"cy$img_num"} = $img->getheight()/2;
+ ++$img_num;
+ }
+ }
+ if ($width) {
+ $opts->{constants}{w} = $width;
+ $opts->{constants}{cx} = $width/2;
+ }
+ else {
+ $Imager::ERRSTR = "No width supplied";
+ return;
+ }
+ if ($height) {
+ $opts->{constants}{h} = $height;
+ $opts->{constants}{cy} = $height/2;
+ }
+ else {
+ $Imager::ERRSTR = "No height supplied";
+ return;
+ }
+ my $code = Imager::Expr->new($opts);
+ if (!$code) {
+ $Imager::ERRSTR = Imager::Expr::error();
+ return;
+ }
+
+ my $img = Imager->new();
+ $img->{IMG} = i_transform2($opts->{width}, $opts->{height}, $code->code(),
+ $code->nregs(), $code->cregs(),
+ [ map { $_->{IMG} } @imgs ]);
+ if (!defined $img->{IMG}) {
+ $Imager::ERRSTR = "transform2 failed";
+ return;
+ }
+
+ return $img;
+ }
+}
+
+
+
+
+
+
+
+
+sub rubthrough {
+ my $self=shift;
+ my %opts=(tx=>0,ty=>0,@_);
+
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+ unless ($opts{src} && $opts{src}->{IMG}) { $self->{ERRSTR}='empty input image for source'; return undef; }
+
+ i_rubthru($self->{IMG}, $opts{src}->{IMG}, $opts{tx},$opts{ty});
+ return $self;
+}
+
+
+
+# These two are supported for legacy code only
+
+sub i_color_new {
+ return Imager::Color->new($_[0], $_[1], $_[2], $_[3]);
+}
+
+sub i_color_set {
+ return Imager::Color::set($_[0], $_[1], $_[2], $_[3], $_[4]);
+}
+
+
+
+# Draws a box between the specified corner points.
+
+sub box {
+ my $self=shift;
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+ my $dflcl=i_color_new(255,255,255,255);
+ my %opts=(color=>$dflcl,xmin=>0,ymin=>0,xmax=>$self->getwidth()-1,ymax=>$self->getheight()-1,@_);
+
+ if (exists $opts{'box'}) {
+ $opts{'xmin'} = min($opts{'box'}->[0],$opts{'box'}->[2]);
+ $opts{'xmax'} = max($opts{'box'}->[0],$opts{'box'}->[2]);
+ $opts{'ymin'} = min($opts{'box'}->[1],$opts{'box'}->[3]);
+ $opts{'ymax'} = max($opts{'box'}->[1],$opts{'box'}->[3]);
+ }
+
+ if ($opts{filled}) { i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},$opts{color}); }
+ else { i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},$opts{color}); }
+ return $self;
+}
+
+# Draws an arc - this routine SUCKS and is buggy - it sometimes doesn't work when the arc is a convex polygon
+
+sub arc {
+ my $self=shift;
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+ my $dflcl=i_color_new(255,255,255,255);
+ my %opts=(color=>$dflcl,
+ 'r'=>min($self->getwidth(),$self->getheight())/3,
+ 'x'=>$self->getwidth()/2,
+ 'y'=>$self->getheight()/2,
+ 'd1'=>0, 'd2'=>361, @_);
+ i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},$opts{'d2'},$opts{'color'});
+ return $self;
+}
+
+# Draws a line from one point to (but not including) the destination point
+
+sub line {
+ my $self=shift;
+ my $dflcl=i_color_new(0,0,0,0);
+ my %opts=(color=>$dflcl,@_);
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
+ unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
+
+ if ($opts{antialias}) {
+ i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
+ } else {
+ i_draw($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
+ }
+ return $self;
+}
+
+# Draws a line between an ordered set of points - It more or less just transforms this
+# into a list of lines.
+
+sub polyline {
+ my $self=shift;
+ my ($pt,$ls,@points);
+ my $dflcl=i_color_new(0,0,0,0);
+ my %opts=(color=>$dflcl,@_);
+
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ if (exists($opts{points})) { @points=@{$opts{points}}; }
+ if (!exists($opts{points}) and exists($opts{'x'}) and exists($opts{'y'}) ) {
+ @points=map { [ $opts{'x'}->[$_],$opts{'y'}->[$_] ] } (0..(scalar @{$opts{'x'}}-1));
+ }
+
+# print Dumper(\@points);
+
+ if ($opts{antialias}) {
+ for $pt(@points) {
+ if (defined($ls)) { i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
+ $ls=$pt;
+ }
+ } else {
+ for $pt(@points) {
+ if (defined($ls)) { i_draw($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
+ $ls=$pt;
+ }
+ }
+ return $self;
+}
+
+# this the multipoint bezier curve
+# this is here more for testing that actual usage since
+# this is not a good algorithm. Usually the curve would be
+# broken into smaller segments and each done individually.
+
+sub polybezier {
+ my $self=shift;
+ my ($pt,$ls,@points);
+ my $dflcl=i_color_new(0,0,0,0);
+ my %opts=(color=>$dflcl,@_);
+
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ if (exists $opts{points}) {
+ $opts{'x'}=map { $_->[0]; } @{$opts{'points'}};
+ $opts{'y'}=map { $_->[1]; } @{$opts{'points'}};
+ }
+
+ unless ( @{$opts{'x'}} and @{$opts{'x'}} == @{$opts{'y'}} ) {
+ $self->{ERRSTR}='Missing or invalid points.';
+ return;
+ }
+
+ i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$opts{'color'});
+ return $self;
+}
+
+
+# destructive border - image is shrunk by one pixel all around
+
+sub border {
+ my ($self,%opts)=@_;
+ my($tx,$ty)=($self->getwidth()-1,$self->getheight()-1);
+ $self->polyline('x'=>[0,$tx,$tx,0,0],'y'=>[0,0,$ty,$ty,0],%opts);
+}
+
+
+# Get the width of an image
+
+sub getwidth {
+ my $self = shift;
+ if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
+ return (i_img_info($self->{IMG}))[0];
+}
+
+# Get the height of an image
+
+sub getheight {
+ my $self = shift;
+ if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
+ return (i_img_info($self->{IMG}))[1];
+}
+
+# Get number of channels in an image
+
+sub getchannels {
+ my $self = shift;
+ if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
+ return i_img_getchannels($self->{IMG});
+}
+
+# Get channel mask
+
+sub getmask {
+ my $self = shift;
+ if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
+ return i_img_getmask($self->{IMG});
+}
+
+# Set channel mask
+
+sub setmask {
+ my $self = shift;
+ my %opts = @_;
+ if (!defined($self->{IMG})) { $self->{ERRSTR} = 'image is empty'; return undef; }
+ i_img_setmask( $self->{IMG} , $opts{mask} );
+}
+
+# Get number of colors in an image
+
+sub getcolorcount {
+ my $self=shift;
+ my %opts=(maxcolors=>2**30,@_);
+ if (!defined($self->{IMG})) { $self->{ERRSTR}='image is empty'; return undef; }
+ my $rc=i_count_colors($self->{IMG},$opts{'maxcolors'});
+ return ($rc==-1? undef : $rc);
+}
+
+# draw string to an image
+
+sub string {
+ my $self = shift;
+ unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
+
+ my %input=('x'=>0, 'y'=>0, @_);
+ $input{string}||=$input{text};
+
+ unless(exists $input{string}) {
+ $self->{ERRSTR}="missing required parameter 'string'";
+ return;
+ }
+
+ unless($input{font}) {
+ $self->{ERRSTR}="missing required parameter 'font'";
+ return;
+ }
+
+ my $aa=1;
+ my $font=$input{'font'};
+ my $align=$font->{'align'} unless exists $input{'align'};
+ my $color=$input{'color'} || $font->{'color'};
+ my $size=$input{'size'} || $font->{'size'};
+
+ if (!defined($size)) { $self->{ERRSTR}='No size parameter and no default in font'; return undef; }
+
+ $aa=$font->{'aa'} if exists $font->{'aa'};
+ $aa=$input{'aa'} if exists $input{'aa'};
+
+
+
+# unless($font->can('text')) {
+# $self->{ERRSTR}="font is unable to do what we need";
+# return;
+# }
+
+# use Data::Dumper;
+# warn Dumper($font);
+
+# print "Channel=".$input{'channel'}."\n";
+
+ if ( $font->{'type'} eq 't1' ) {
+ if ( exists $input{'channel'} ) {
+ Imager::Font::t1_set_aa_level($aa);
+ i_t1_cp($self->{IMG},$input{'x'},$input{'y'},
+ $input{'channel'},$font->{'id'},$size,
+ $input{'string'},length($input{'string'}),1);
+ } else {
+ Imager::Font::t1_set_aa_level($aa);
+ i_t1_text($self->{IMG},$input{'x'},$input{'y'},
+ $color,$font->{'id'},$size,
+ $input{'string'},length($input{'string'}),1);
+ }
+ }
+
+ if ( $font->{'type'} eq 'tt' ) {
+ if ( exists $input{'channel'} ) {
+ i_tt_cp($font->{'id'},$self->{IMG},$input{'x'},$input{'y'},$input{'channel'},
+ $size,$input{'string'},length($input{'string'}),$aa);
+ } else {
+ i_tt_text($font->{'id'},$self->{IMG},$input{'x'},$input{'y'},$color,$size,
+ $input{'string'},length($input{'string'}),$aa);
+ }
+ }
+
+ return $self;
+}
+
+
+
+
+
+# Shortcuts that can be exported
+
+sub newcolor { Imager::Color->new(@_); }
+sub newfont { Imager::Font->new(@_); }
+
+*NC=*newcolour=*newcolor;
+*NF=*newfont;
+
+*open=\&read;
+*circle=\&arc;
+
+
+#### Utility routines
+
+sub errstr { $_[0]->{ERRSTR} }
+
+
+
+
+
+
+# Default guess for the type of an image from extension
+
+sub def_guess_type {
+ my $name=lc(shift);
+ my $ext;
+ $ext=($name =~ m/\.([^\.]+)$/)[0];
+ return 'tiff' if ($ext =~ m/^tiff?$/);
+ return 'jpeg' if ($ext =~ m/^jpe?g$/);
+ return 'pnm' if ($ext =~ m/^p[pgb]m$/);
+ return 'png' if ($ext eq "png");
+ return 'gif' if ($ext eq "gif");
+ return ();
+}
+
+# get the minimum of a list
+
+sub min {
+ my $mx=shift;
+ for(@_) { if ($_<$mx) { $mx=$_; }}
+ return $mx;
+}
+
+# get the maximum of a list
+
+sub max {
+ my $mx=shift;
+ for(@_) { if ($_>$mx) { $mx=$_; }}
+ return $mx;
+}
+
+# string stuff for iptc headers
+
+sub clean {
+ my($str)=$_[0];
+ $str = substr($str,3);
+ $str =~ s/[\n\r]//g;
+ $str =~ s/\s+/ /g;
+ $str =~ s/^\s//;
+ $str =~ s/\s$//;
+ return $str;
+}
+
+# A little hack to parse iptc headers.
+
+sub parseiptc {
+ my $self=shift;
+ my(@sar,$item,@ar);
+ my($caption,$photogr,$headln,$credit);
+
+ my $str=$self->{IPTCRAW};
+
+ #print $str;
+
+ @ar=split(/8BIM/,$str);
+
+ my $i=0;
+ foreach (@ar) {
+ if (/^\004\004/) {
+ @sar=split(/\034\002/);
+ foreach $item (@sar) {
+ if ($item =~ m/^x/) {
+ $caption=&clean($item);
+ $i++;
+ }
+ if ($item =~ m/^P/) {
+ $photogr=&clean($item);
+ $i++;
+ }
+ if ($item =~ m/^i/) {
+ $headln=&clean($item);
+ $i++;
+ }
+ if ($item =~ m/^n/) {
+ $credit=&clean($item);
+ $i++;
+ }
+ }
+ }
+ }
+ return (caption=>$caption,photogr=>$photogr,headln=>$headln,credit=>$credit);
+}
+
+
+
+
+
+
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+1;
+__END__
+# Below is the stub of documentation for your module. You better edit it!
+
+=head1 NAME
+
+Imager - Perl extension for Generating 24 bit Images
+
+=head1 SYNOPSIS
+
+ use Imager qw(init);
+
+ init();
+ $img = Imager->new();
+ $img->open(file=>'image.ppm',type=>'pnm')
+ || print "failed: ",$img->{ERRSTR},"\n";
+ $scaled=$img->scale(xpixels=>400,ypixels=>400);
+ $scaled->write(file=>'sc_image.ppm',type=>'pnm')
+ || print "failed: ",$scaled->{ERRSTR},"\n";
+
+=head1 DESCRIPTION
+
+Imager is a module for creating and altering images - It is not meant
+as a replacement or a competitor to ImageMagick or GD. Both are
+excellent packages and well supported.
+
+=head2 API
+
+Almost all functions take the parameters in the hash fashion.
+Example:
+
+ $img->open(file=>'lena.png',type=>'png');
+
+or just:
+
+ $img->open(file=>'lena.png');
+
+=head2 Basic concept
+
+An Image object is created with C<$img = Imager-E<gt>new()> Should
+this fail for some reason an explanation can be found in
+C<$Imager::ERRSTR> usually error messages are stored in
+C<$img-E<gt>{ERRSTR}>, but since no object is created this is the only
+way to give back errors. C<$Imager::ERRSTR> is also used to report
+all errors not directly associated with an image object. Examples:
+
+ $img=Imager->new(); # This is an empty image (size is 0 by 0)
+ $img->open(file=>'lena.png',type=>'png'); # initializes from file
+
+or if you want to create an empty image:
+
+ $img=Imager->new(xsize=>400,ysize=>300,channels=>4);
+
+This example creates a completely black image of width 400 and
+height 300 and 4 channels.
+
+If you have an existing image, use img_set() to change it's dimensions
+- this will destroy any existing image data:
+
+ $img->img_set(xsize=>500, ysize=>500, channels=>4);
+
+Color objects are created by calling the Imager::Color->new()
+method:
+
+ $color = Imager::Color->new($red, $green, $blue);
+ $color = Imager::Color->new($red, $green, $blue, $alpha);
+ $color = Imager::Color->new("#C0C0FF"); # html color specification
+
+This object can then be passed to functions that require a color parameter.
+
+Coordinates in Imager have the origin in the upper left corner. The
+horizontal coordinate increases to the right and the vertical
+downwards.
+
+=head2 Reading and writing images
+
+C<$img-E<gt>read()> generally takes two parameters, 'file' and 'type'.
+If the type of the file can be determined from the suffix of the file
+it can be omitted. Format dependant parameters are: For images of
+type 'raw' two extra parameters are needed 'xsize' and 'ysize', if the
+'channel' parameter is omitted for type 'raw' it is assumed to be 3.
+gif and png images might have a palette are converted to truecolor bit
+when read. Alpha channel is preserved for png images irregardless of
+them being in RGB or gray colorspace. Similarly grayscale jpegs are
+one channel images after reading them. For jpeg images the iptc
+header information (stored in the APP13 header) is avaliable to some
+degree. You can get the raw header with C<$img-E<gt>{IPTCRAW}>, but
+you can also retrieve the most basic information with
+C<%hsh=$img-E<gt>parseiptc()> as always patches are welcome. Neither
+pnm nor tiff have extra options. Examples:
+
+ $img = Imager->new();
+ $img->read(file=>"cover.jpg") or die $img->errstr; # gets type from name
+
+ $img = Imager->new();
+ { local(*FH,$/); open(FH,"file.gif") or die $!; $a=<FH>; }
+ $img->read(data=>$a,type=>'gif') or die $img->errstr;
+
+The second example shows how to read an image from a scalar, this is
+usefull if your data originates from somewhere else than a filesystem
+such as a database over a DBI connection.
+
+*Note that load() is now an alias for read but will be removed later*
+
+C<$img-E<gt>write> has the same interface as C<read()>. The earlier
+comments on C<read()> for autodetecting filetypes apply. For jpegs
+quality can be adjusted via the 'jpegquality' parameter (0-100). The
+number of colorplanes in gifs are set with 'gifplanes' and should be
+between 1 (2 color) and 8 (256 colors). It is also possible to choose
+between two quantizing methods with the parameter 'gifquant'. If set
+to mc it uses the mediancut algorithm from either giflibrary. If set
+to lm it uses a local means algorithm. It is then possible to give
+some extra settings. lmdither is the dither deviation amount in pixels
+(manhattan distance). lmfixed can be an array ref who holds an array
+of Imager::Color objects. Note that the local means algorithm needs
+much more cpu time but also gives considerable better results than the
+median cut algorithm.
+
+Currently just for gif files, you can specify various options for the
+conversion from Imager's internal RGB format to the target's indexed
+file format. If you set the gifquant option to 'gen', you can use the
+options specified under L<Quantization options>.
+
+To see what Imager is compiled to support the following code snippet
+is sufficient:
+
+ use Imager;
+ print "@{[keys %Imager::formats]}";
+
+=head2 Multi-image files
+
+Currently just for gif files, you can create files that contain more
+than one image.
+
+To do this:
+
+ Imager->write_multi(\%opts, @images)
+
+Where %opts describes 3 possible types of outputs:
+
+=over 4
+
+=item callback
+
+A code reference which is called with a single parameter, the data to
+be written. You can also specify $opts{maxbuffer} which is the
+maximum amount of data buffered. Note that there can be larger writes
+than this if the file library writes larger blocks. A smaller value
+maybe useful for writing to a socket for incremental display.
+
+=item fd
+
+The file descriptor to save the images to.
+
+=item file
+
+The name of the file to write to.
+
+%opts may also include the keys from L<Gif options> and L<Quantization
+options>.
+
+=back
+
+The current aim is to support other multiple image formats in the
+future, such as TIFF, and to support reading multiple images from a
+single file.
+
+A simple example:
+
+ my @images;
+ # ... code to put images in @images
+ Imager->write_multi({type=>'gif',
+ file=>'anim.gif',
+ gif_delays=>[ 10 x @images ] },
+ @images)
+ or die "Oh dear!";
+
+=head2 Gif options
+
+These options can be specified when calling write_multi() for gif
+files, when writing a single image with the gifquant option set to
+'gen', or for direct calls to i_writegif_gen and i_writegif_callback.
+
+Note that some viewers will ignore some of these options
+(gif_user_input in particular).
+
+=over 4
+
+=item gif_each_palette
+
+Each image in the gif file has it's own palette if this is non-zero.
+All but the first image has a local colour table (the first uses the
+global colour table.
+
+=item interlace
+
+The images are written interlaced if this is non-zero.
+
+=item gif_delays
+
+A reference to an array containing the delays between images, in 1/100
+seconds.
+
+=item gif_user_input
+
+A reference to an array contains user input flags. If the given flag
+is non-zero the image viewer should wait for input before displaying
+the next image.
+
+=item gif_disposal
+
+A reference to an array of image disposal methods. These define what
+should be done to the image before displaying the next one. These are
+integers, where 0 means unspecified, 1 means the image should be left
+in place, 2 means restore to background colour and 3 means restore to
+the previous value.
+
+=item gif_tran_color
+
+A reference to an Imager::Color object, which is the colour to use for
+the palette entry used to represent transparency in the palette.
+
+=item gif_positions
+
+A reference to an array of references to arrays which represent screen
+positions for each image.
+
+=item gif_loop_count
+
+If this is non-zero the Netscape loop extension block is generated,
+which makes the animation of the images repeat.
+
+This is currently unimplemented due to some limitations in giflib.
+
+=back
+
+=head2 Quantization options
+
+These options can be specified when calling write_multi() for gif
+files, when writing a single image with the gifquant option set to
+'gen', or for direct calls to i_writegif_gen and i_writegif_callback.
+
+=over 4
+
+=item colors
+
+A arrayref of colors that are fixed. Note that some color generators
+will ignore this.
+
+=item transp
+
+The type of transparency processing to perform for images with an
+alpha channel where the output format does not have a proper alpha
+channel (eg. gif). This can be any of:
+
+=over 4
+
+=item none
+
+No transparency processing is done. (default)
+
+=item threshold
+
+Pixels more transparent that tr_threshold are rendered as transparent.
+
+=item errdiff
+
+An error diffusion dither is done on the alpha channel. Note that
+this is independent of the translation performed on the colour
+channels, so some combinations may cause undesired artifacts.
+
+=item ordered
+
+The ordered dither specified by tr_orddith is performed on the alpha
+channel.
+
+=back
+
+=item tr_threshold
+
+The highest alpha value at which a pixel will be made transparent when
+transp is 'threshold'. (0-255, default 127)
+
+=item tr_errdiff
+
+The type of error diffusion to perform on the alpha channel when
+transp is 'errdiff'. This can be any defined error diffusion type
+except for custom (see errdiff below).
+
+=item tr_ordered
+
+The type of ordered dither to perform on the alpha channel when transp
+is 'orddith'. Possible values are:
+
+=over 4
+
+=item random
+
+A semi-random map is used. The map is the same each time. Currently
+the default (which may change.)
+
+=item dot8
+
+8x8 dot dither.
+
+=item dot4
+
+4x4 dot dither
+
+=item hline
+
+horizontal line dither.
+
+=item vline
+
+vertical line dither.
+
+=item "/line"
+
+=item slashline
+
+diagonal line dither
+
+=item '\line'
+
+=item backline
+
+diagonal line dither
+
+=item custom
+
+A custom dither matrix is used - see tr_map
+
+=back
+
+=item tr_map
+
+When tr_orddith is custom this defines an 8 x 8 matrix of integers
+representing the transparency threshold for pixels corresponding to
+each position. This should be a 64 element array where the first 8
+entries correspond to the first row of the matrix. Values should be
+betweern 0 and 255.
+
+=item make_colors
+
+Defines how the quantization engine will build the palette(s).
+Currently this is ignored if 'translate' is 'giflib', but that may
+change. Possible values are:
+
+=over 4
+
+=item none
+
+Only colors supplied in 'colors' are used.
+
+=item webmap
+
+The web color map is used (need url here.)
+
+=item addi
+
+The original code for generating the color map (Addi's code) is used.
+
+=back
+
+Other methods may be added in the future.
+
+=item colors
+
+A arrayref containing Imager::Color objects, which represents the
+starting set of colors to use in translating the images. webmap will
+ignore this. The final colors used are copied back into this array
+(which is expanded if necessary.)
+
+=item max_colors
+
+The maximum number of colors to use in the image.
+
+=item translate
+
+The method used to translate the RGB values in the source image into
+the colors selected by make_colors. Note that make_colors is ignored
+whene translate is 'giflib'.
+
+Possible values are:
+
+=over 4
+
+=item giflib
+
+The giflib native quantization function is used.
+
+=item closest
+
+The closest color available is used.
+
+=item perturb
+
+The pixel color is modified by perturb, and the closest color is chosen.
+
+=item errdiff
+
+An error diffusion dither is performed.
+
+=back
+
+It's possible other transate values will be added.
+
+=item errdiff
+
+The type of error diffusion dither to perform. These values (except
+for custom) can also be used in tr_errdif.
+
+=over 4
+
+=item floyd
+
+Floyd-Steinberg dither
+
+=item jarvis
+
+Jarvis, Judice and Ninke dither
+
+=item stucki
+
+Stucki dither
+
+=item custom
+
+Custom. If you use this you must also set errdiff_width,
+errdiff_height and errdiff_map.
+
+=back
+
+=item errdiff_width
+
+=item errdiff_height
+
+=item errdiff_orig
+
+=item errdiff_map
+
+When translate is 'errdiff' and errdiff is 'custom' these define a
+custom error diffusion map. errdiff_width and errdiff_height define
+the size of the map in the arrayref in errdiff_map. errdiff_orig is
+an integer which indicates the current pixel position in the top row
+of the map.
+
+=item perturb
+
+When translate is 'perturb' this is the magnitude of the random bias
+applied to each channel of the pixel before it is looked up in the
+color table.
+
+=back
+
+=head2 Obtaining/setting attributes of images
+
+To get the size of an image in pixels the C<$img-E<gt>getwidth()> and
+C<$img-E<gt>getheight()> are used.
+
+To get the number of channels in
+an image C<$img-E<gt>getchannels()> is used. $img-E<gt>getmask() and
+$img-E<gt>setmask() are used to get/set the channel mask of the image.
+
+ $mask=$img->getmask();
+ $img->setmask(mask=>1+2); # modify red and green only
+ $img->setmask(mask=>8); # modify alpha only
+ $img->setmask(mask=>$mask); # restore previous mask
+
+The mask of an image describes which channels are updated when some
+operation is performed on an image. Naturally it is not possible to
+apply masks to operations like scaling that alter the dimensions of
+images.
+
+It is possible to have Imager find the number of colors in an image
+by using C<$img-E<gt>getcolorcount()>. It requires memory proportionally
+to the number of colors in the image so it is possible to have it
+stop sooner if you only need to know if there are more than a certain number
+of colors in the image. If there are more colors than asked for
+the function return undef. Examples:
+
+ if (!defined($img->getcolorcount(maxcolors=>512)) {
+ print "Less than 512 colors in image\n";
+ }
+
+=head2 Drawing Methods
+
+IMPLEMENTATION MORE OR LESS DONE CHECK THE TESTS
+
+DOCUMENTATION OF THIS SECTION OUT OF SYNC
+
+It is possible to draw with graphics primitives onto images. Such
+primitives include boxes, arcs, circles and lines. A reference
+oriented list follows.
+
+Box:
+ $img->box(color=>$blue,xmin=>10,ymin=>30,xmax=>200,ymax=>300,filled=>1);
+