Image-Imlib2-2.03000755001750001750 011303051420 12556 5ustar00acmeacme000000000000META.yml000444001750001750 75511303051420 14074 0ustar00acmeacme000000000000Image-Imlib2-2.03--- name: Image-Imlib2 version: 2.03 author: - 'Leon Brocard, acme@astray.com' abstract: Interface to the Imlib2 image library license: perl resources: license: http://dev.perl.org/licenses/ requires: Module::Build: 0.20 Test::More: 0.01 configure_requires: Module::Build: 0.35 provides: Image::Imlib2: file: lib/Image/Imlib2.pm version: 2.03 generated_by: Module::Build version 0.35 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 README000444001750001750 4013511303051420 13537 0ustar00acmeacme000000000000Image-Imlib2-2.03NAME Image::Imlib2 - Interface to the Imlib2 image library SYNOPSIS use Image::Imlib2; # create a new image my $image = Image::Imlib2->new(200, 200); # or load an image $image = Image::Imlib2->load("foo.png"); # Enable the alpha channel support $image->has_alpha(1); # set a colour (rgba, so this is transparent orange) $image->set_color(255, 127, 0, 127); # draw a rectangle $image->draw_rectangle(50, 50, 50, 50); # draw a filled rectangle $image->fill_rectangle(150, 50, 50, 50); # draw a line $image->draw_line(0, 0, 200, 50); # set quality before saving $image->set_quality(50); # save out $image->save('out.png'); # create a polygon my $poly = Image::Imlib2::Polygon->new(); # add some points $poly->add_point(0, 0); $poly->add_point(100, 0); $poly->add_point(100, 100); $poly->add_point(0, 100); # fill the polygon $poly->fill(); # draw it closed on image $image->draw_polygon($poly, 1); # create a color range my $cr = Image::Imlib2::ColorRange->new(); # add a color my ($distance, $red, $green, $blue, $alpha) = (15, 200, 100, 50, 20); $cr->add_color($distance, $red, $green, $blue, $alpha); # draw it my($x, $y, $width, $height, $angle) = (20, 30, 200, 200, 1); $image->fill_color_range_rectangle($cr, $x, $y, $width, $height, $angle); DESCRIPTION Image::Imlib2 is a Perl port of Imlib2, a graphics library that does image file loading and saving as well as manipulation, arbitrary polygon support, etc. It does ALL of these operations FAST. It allows you to create colour images using a large number of graphics primitives, and output the images in a range of formats. Image::Imlib2::Polygon and Image::Imlib2::ColorRange are described following Image::Imlib2 but may be referenced before their description. Note that this is an early version of my attempt at a Perl interface to Imlib2. Currently, the API is just to test things out. Not everything is supported, but a great deal of functionality already exists. If you think the API can be tweaked to be a bit more intuitive, drop me a line! Note that a development version of Imlib2 must be installed before installing this module. Exported constants TEXT_TO_RIGHT TEXT_TO_LEFT TEXT_TO_UP TEXT_TO_DOWN TEXT_TO_ANGLE To be used as the direction parameter for text functions that accept it. METHODS (Image::Imlib2) new This will create a new, blank image. If the dimensions aren't specified, it will default to 256 x 256. my $image = Image::Imlib2->new(100, 100); The contents of this image at creation time are undefined - they could be garbage memory. You should clear the image if necessary. new_transparent This will create a new fully-transparent image. If the dimensions aren't specified, it will default to 256 x 256. my $image = Image::Imlib2->new_transparent(100, 100); new_using_data This will create a new image with the specified pixel data, which must be a packed string. If the dimensions are not specified, it will default to 256 x 256. my $pixel = pack('CCCC', 255, 127, 0, 255); # ARGB my $image = Image::Imlib2->new_using_data(100, 100, $pixel x (100*100)); load This will load an existing graphics file and create a new image object. It reads quite a few different image formats. my $image = Image::Imlib2->load("foo.png"); save This saves the current image out. Currently this is in PNG if the format has not been set using image_set_format(). $image->save("out.png"); image_set_format (format) This will set the image format for future save operations. format is a string and may be "jpeg", "tiff", "png", etc. The exact number of formats supported depends on how you built imlib2. $image->image_set_format("jpeg"); # Convert image to JPG set_quality This sets the quality of the saved picture - lower the quality to get smaller filesizes. $image->set_quality(50); set_color (r, g, b, a) or set_colour (r, g, b, a) This sets the colour that the drawing primitives will use. You specify the red, green, blue and alpha components, which should all range from 0 to 255. The alpha component specified how transparent the colour is: 0 is fully transparent (so drawing with it will be pointless), 127 is half-transparent, and 255 is fully opaque. Many examples: $image->set_colour(255, 255, 255, 255); # white $image->set_colour( 0, 0, 0, 255); # black $image->set_colour(127, 127, 127, 255); # 50% gray $image->set_colour(255, 0, 0, 255); # red $image->set_colour( 0, 255, 0, 255); # green $image->set_colour( 0, 0, 255, 255); # blue $image->set_colour(255, 127, 0, 127); # transparent orange Warning: this sets a global variable for the draw color. draw_point (x, y) This colours a point in the image in the currently-selected colour. Note that the coordinate system used has (0, 0) at the top left, with (50, 0) to the right of the top left, (0, 50) below the top left, and (50, 50) to the bottom right of the top left. $image->draw_point(50, 50); query_pixel (x, y) This returns the colour of a pixel in the image. It returns the red, green, blue and alpha components: my($r, $g, $b, $a) = $image->query_pixel(50,50); draw_line (x1, y1, x2, y2) This draws a line between two points in the currently-selected colour. The following draws between the (0, 0) and (100, 100) points: $image->draw_line(0, 0, 100, 100); draw_rectangle (x, y, w, h) This draws a the outline of a rectangle with the top left point at (x, y) and having width w and height h in the current colour. $image->draw_rectangle(0, 0, 50, 50); fill_rectangle (x, y, w, h) This draws a filled rectangle with the top left point at (x, y) and having width w and height h in the current colour. $image->fill_rectangle(0, 0, 50, 50); draw_ellipse (x, y, w, h) This draws an ellipse which has center (x, y) and horizontal amplitude of w and vertical amplitude of h in the current colour. Note that setting w and h to the same value will draw a circle. $image->draw_ellipse(100, 100, 50, 50); fill_ellipse (x, y, w, h) This draws a filled ellipse which has center (x, y) and horizontal amplitude of w and vertical amplitude of h in the current colour. Note that setting w and h to the same value will draw a filled circle. $image->fill_ellipse(100, 100, 50, 50); add_font_path (dir) This function adds the directory path to the end of the current list of directories to scan for truetype (TTF) fonts. $image->add_font_path("./ttfonts"); load_font (font) This function will load a truetype font from the first directory in the font path that contains that font. The font name format is "font_name/size". For example. If there is a font file called cinema.ttf somewhere in the font path you might use "cinema/20" to load a 20 pixel sized font of cinema. Note that this font will be used from now on, much like set_colour does for colours. $image->load_font("cinema/20"); Warning: this sets a global variable for the current font. get_text_size (text, direction, angle) This function returns the width and height in pixels the text string would use up if drawn with the current font. direction and angle are optional and deault to TEXT_TO_RIGHT and 0, respectively. my($w, $h) = $image->get_text_size("Imlib2 and Perl!"); my($w1, $w2) = $image->get_text_size("Crazy text", TEXT_TO_UP, 1); draw_text (x, y, text, direction, angle) This draws the text using the current font and colour onto the image at position (x, y). direction and angle are optional and deault to TEXT_TO_RIGHT and 0, respectively. $image->draw_text(50, 50, "Groovy, baby, yeah!"); $image->draw_text(50, 50, "Sweet, baby, yeah!", TEXT_TO_UP, 1.571); autocrop This creates a duplicate of the image which is automatically cropped to remove the background colour from the outside of the image: my $cropped_image = $image->autocrop; autocrop_dimensions This returns the x, y, width and height rectangle in an image which would hold the results of the autocrop method: my($x, $y, $w, $h) = $image->autocrop_dimensions; crop (x, y, w, h) This creates a duplicate of a x, y, width, height rectangle in the current image and returns another image. my $cropped_image = $image->crop(0, 0, 50, 50); blend (source_image, merge_alpha, sx, sy, sw, sh, dx, dy, dw, dh) This will blend the source rectangle x, y, width, height from the source_image onto the current image at the destination x, y location scaled to the width and height specified. If merge_alpha is set to 1 it will also modify the destination image alpha channel, otherwise the destination alpha channel is left untouched. $image->blend($cropped_image, 0, 0, 0, 50, 50, 200, 0, 50, 50); blur (radius) This will blur the image. A radius of 0 has no effect, 1 and above determine the blur matrix radius that determine how much to blur the image. $image->blur(1); sharpen (radius) This sharpens the image. The radius affects how much to sharpen by. $image->sharpen(1); clone () This creates an exact duplicate of the current image. $cloned = $image->clone; draw_polygon (polygon, closed) This will draw polygon (of type Imlib2::Image::Polygon) on the the image. The the polygon is drawn closed is closed is 1 and open if closed is 0. $image->draw_polygon($poly, 1); fill_color_range_rectangle(color_range, x, y, w, h, angle); This uses the color range color_range to fille a rectangle with points x, y, x+width, y+width. $image->fill_color_range_rectangle($cr, 10, 20, 100, 150, 0); image_orientate (steps) This will rotate the image by steps*90 degrees, so to rotate by 90 degrees set to 1, for 180 degrees set to 2, etc. $image->image_orientate(1); # Rotate by 90 degrees. create_rotated_image(radians) Create a new image, rotated from the original by a number of radians. For example, to rotate 45 degrees: my $rotated = $image->create_rotated_image(45 / 360 * 3.141519*2); create_scaled_image (x, y) Create a new image, scaled from the original to the dimensions given in x and y. If x or y are 0, then retain the aspect ratio given in the other. $image2=$image->create_scaled_image(100,100); # Scale to 100x100 pixels create_transparent_image (alpha) Create a new image, based upon the original but with a fixed alpha value. This will create a transparent image that you can then blend onto other images. Alpha ranges from 0 to 255: my $new = $image->create_transparent_image(64); create_blended_image (percent) Create a new image, which is percent% of source1 and (100-percent)% of source2. This is used for fading bedtween two images. Percent ranges from 0 to 100: my $new = $source1->create_blended_image($source2, 50); flip_horizontal () This will flip/mirror the image horizontally. $image->flip_horizontal(); flip_vertical () This will flip/mirror the image vertically. $image->flip_vertical(); flip_diagonal () This will flip/mirror the current image diagonally (good for quick and dirty 90 degree rotations if used before to after a horizontal or vertical flip). $image->flip_diagonal(); has_alpha (BOOLEAN) Queries and/or sets the alpha support flag for the image. Note that alpha is on by default when you create an image: if ($image->has_alpha) { # do something requiring alpha support } # Enable the alpha channel $image->has_alpha(1); set_cache_size (INT) By default, Imlib2 will not cache any images loaded from disk. If you set a cache size then Imlib2 will cache all loaded images (up to this size) and will use this cache to avoid loading images from disk. Sets the size of the image cache. Reducing this value will cause the cache to be emptied. You can turn off caching all together by setting this to zero. Even without a cache, as long as you have a reference to an image in memory that image will be returned immediately without checking the disk. Image::Imlib2->set_cache_size(1024 * 1024); my $image = Image::Imlib2->load("foo.jpg"); # image loaded from disk ... later, somewhere else, after $image has gone away ... my $image = Image::Imlib2->load("foo.jpg"); # same image, even if changed on disk ... later, somewhere else, after $image has gone away ... Image::Imlib2->set_cache_size(0); my $image = Image::Imlib2->load("foo.jpg"); # image loaded from disk my $image2 = Image::Imlib2->load("foo.jpg"); # same image as before, not reloaded get_cache_size () Returns the maximum size of the Image cache. set_changes_on_disk () Called on an Image::Imlib2 instance that you have loaded from disk, this method tells imlib that it should take extra care when caching the image for this filename. Next time the load method is called for this image's file name Imlib will check the modification time for the file on disk compared to the cached version and take appropriate action. my $image = Image::Imlib2->load("foo.jpg"); $image->set_changes_on_disk(); ...later... # reloads image from disk if mod time has changed (otherwise use cached) my $image = Image::Imlib2->load("foo.jpg"); Calling this method on a loaded image tells Imlib2 to look at the disk and compare mtimes with it's loaded copy - by default, this is not the case, so even if a file changes on disk, it won't be re-loaded. will_blend (BOOL) Changes the setting for whether drawing blends with existing pixels in the image or overwrites those pixels. Defaults to true. Returns the new value. If no argument is passed, just returns the current value. Warning: this sets a global variable for blending. find_colour This returns the x and y coordinates for the first pixel of the current colour it finds in the image. It returns undef if it doesn't find the colour: # find a red pixel $i->set_colour(255, 0, 0, 255); my($rx, $ry) = $i->find_red; fill This flood fills the image, starting at the x and y coordinates and filling every pixel under it with the current colour: $i->fill($x, $y); METHODS (Image::Imlib2::Polygon) new This will create a new polygon for use with Image::Imlib2::draw_polygon. my $poly = Image::Imlib2::Polygon->new(); add_point (x, y) Adds a point to the polygonal construct. $poly->add_point(10,10); fill Fills polygon in the current context. $poly->fill(); METHODS (Image::Imlib2::ColorRange) new Creates a new color range. my $cr = Image::Imlib2::ColorRange->new(); add_color (distance, red, green, blue, alpha) Similar to set_colour, but adds the color to the color range at the specified distance. $cr->add_color(10, 255, 127, 0, 66); Warning: this sets a global variable for the draw color. width Returns the current width of the image. my $width = $image->width; height Returns the current height of the image. my $height = $image->height; DEPRECATED METHOS get_width Returns the current width of the image. Use width() instead. my $width = $image->get_width; get_height Returns the current height of the image. Use height() instead. my $height = $image->get_height; AUTHOR Leon Brocard, acme@astray.com COPYRIGHT Copyright (c) 2000-9 Leon Brocard. All rights reserved. LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Makefile.PL000444001750001750 233311303051420 14607 0ustar00acmeacme000000000000Image-Imlib2-2.03# Note: this file was auto-generated by Module::Build::Compat version 0.35 unless (eval "use Module::Build::Compat 0.02; 1" ) { print "This module requires Module::Build to install itself.\n"; require ExtUtils::MakeMaker; my $yn = ExtUtils::MakeMaker::prompt (' Install Module::Build now from CPAN?', 'y'); unless ($yn =~ /^y/i) { die " *** Cannot install without Module::Build. Exiting ...\n"; } require Cwd; require File::Spec; require CPAN; # Save this 'cause CPAN will chdir all over the place. my $cwd = Cwd::cwd(); CPAN::Shell->install('Module::Build::Compat'); CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate or die "Couldn't install Module::Build, giving up.\n"; chdir $cwd or die "Cannot chdir() back to $cwd: $!"; } eval "use Module::Build::Compat 0.02; 1" or die $@; Module::Build::Compat->run_build_pl(args => \@ARGV); my $build_script = 'Build'; $build_script .= '.com' if $^O eq 'VMS'; exit(0) unless(-e $build_script); # cpantesters convention require Module::Build; Module::Build::Compat->write_makefile(build_class => 'Module::Build'); NINJA000444001750001750 20711303051420 13375 0ustar00acmeacme000000000000Image-Imlib2-2.03--- #YAML:1.0 attributes: charisma: 0.13 constitution: 0.93 dexterity: 0.07 intelligence: 0.33 strength: 0.87 wisdom: 0.80 typemap000444001750001750 17211303051420 14216 0ustar00acmeacme000000000000Image-Imlib2-2.03TYPEMAP Image::Imlib2 T_PTROBJ Image::Imlib2::Polygon T_PTROBJ Image::Imlib2::ColorRange T_PTROBJ DATA32 * T_OPAQUEPTR CHANGES000444001750001750 1004111303051420 13643 0ustar00acmeacme000000000000Image-Imlib2-2.03Revision history for Perl extension Image::Imlib2. 2.03 Tue Nov 24 21:40:49 GMT 2009 - add a new_transparent method - add a create_rotated_image method - add a human-readable license 2.02 Mon Dec 1 11:55:06 GMT 2008 - update documentation to clarify cache_size - note that new images have undefined content (thanks to barbie) 2.01 Sun Jun 8 10:05:46 BST 2008 - in Build.PL, exit 0 when we can't find libimlib2 2.00 Fri Dec 7 11:29:47 GMT 2007 - make the cache size 0 by default 1.13 Fri Oct 13 19:08:41 BST 2006 - optimise autocropping (thanks to Sergey Mende) - find_colour now returns undef if it doesn't find the colour 1.12 Tue Aug 15 10:14:55 BST 2006 - added find_colour method - added fill method 1.11 Thu Aug 3 10:53:33 BST 2006 - endianness fixes for new_using_data (thanks to Chris Dolan) - added autocrop method 1.10 Wed Jun 28 12:11:47 BST 2006 - added new_using_data and will_blend (thanks to Chris Dolan) - new_using_data is endianness specific - fixed documentation bug, it's called get_text_size not get_font_size - added create_transparent_image method - added create_blended_image - added POD tests - added width/height as synonyms to get_width/get_height - disable buggy imlib_image_draw_pixel wrapper - if you have a version of imlib2 1.0.5 or earlier you will now see the bug 1.09 Thu Jun 15 16:43:10 GMT 2006 - lose AUTOLOAD and define the constants in their own right code by Mark Fowler. this also means that random calls for non-existant methods fail properly now 1.08 Wed Mar 1 19:10:05 GMT 2006 - fix build instructions (noticed by JPIERCE) 1.07 Fri Apr 15 11:57:47 BST 2005 - Add clone, sharpen and blur (thanks to Christian Hansen) 1.06 Fri Apr 8 22:58:26 CST 2005 - added missing test file to MANIFEST 1.05 Thu Apr 7 16:55:01 GMT 2005 - added support for defeating caching, namely: set_cache_size get_cache_size set_changed_on_disk (Thanks to Tom Insam and Mark Fowler) 1.04 Thu Feb 3 15:27:41 GMT 2005 - Imlib2 1.1.2 broke our tests as it doesn't enable alpha by default (for optimisation purposes). The module now enables alpha by default when you create an image, but you can turn it off with has_alpha (thanks to Don Armstrong) - tested with Imlib2 1.2.0 1.03 Tue Jul 13 11:30:47 IST 2004 - fixed minor POD tyop - new flip_horizontal, flip_vertical, flip_diagonal (thanks to Tuomas Jormola) 1.02 Tue May 25 22:18:32 BST 2004 - renamed Changes to CHANGES - new set_quality function (thanks to Andreas Plesner) 1.01 Mon Nov 3 19:18:14 GMT 2003 - document get_width and get_height methods (thanks to Andreas Plesner) - added NINJA support 1.00 Sun Sep 14 09:47:42 BST 2003 - applied patch to make the module work under threaded perls (thanks to Mathieu Jondet, Andreas Plesner Jacobsen, zak3) - applied patch to make the module work without X (spotted by Mike Castle, Jens Gassmann) - applied patch to pass the correct compiler flags (thanks to Christian Laursen) - bumped up to version 1.00 0.12 Sun Aug 31 16:07:52 BST 2003 - now use c_source to find ppport.h thanks to Mathieu Jondet - use Build.PL's passthrough mechanism to generate the Makefile.PL - now report loading and saving errors, as suggested by michael j pan - added image_set_format thanks to Joel Rowbottom 0.11 Sun Mar 23 19:06:29 GMT 2003 - Added query_pixel thanks to Sebastian BoeBhm - Changed test suite to use Test::More - The module is now built with Module::Build 0.10 Mon Sep 16 15:57:04 BST 2002 - Added image_orientate, create_scaled_image thanks to Joel Rowbottom 0.03 Sat Sep 7 10:00:06 BST 2002 - incorporate color ranges, polygons and updated docs thanks to Theo Schlossnagle - better warning if imlib2 hasn't been installed 0.02 Wed Aug 29 10:40:56 BST 2001 - mention that imlib2 is out. I intend to rewrite this with Inline::C to make it more maintainable 0.01 Thu Oct 5 16:58:52 BST 2000 - released initial version MANIFEST000444001750001750 45111303051420 13745 0ustar00acmeacme000000000000Image-Imlib2-2.03Build.PL CHANGES examples/benchmark.pl examples/benchmark.txt examples/maeda.pl lib/Image/Imlib2.pm lib/Image/Imlib2.xs lib/Image/ppport.h Makefile.PL MANIFEST META.yml NINJA README t/autocrop.t t/blob.png t/cache.t t/data.t t/findfill.t t/findfill.png t/simple.t t/pod.t t/pod_coverage.t typemap Build.PL000444001750001750 202511303051420 14127 0ustar00acmeacme000000000000Image-Imlib2-2.03use Module::Build; use strict; # We need to find imlib2-config my $CONFIG = "imlib2-config"; my $version = `$CONFIG --version`; if (!$version) { warn 'You must install the imlib2 library before you can install Image::Imlib2. You can obtain imlib2 from http://sourceforge.net/projects/enlightenment/ Alternatively, if you have downloaded and installed imlib2 and this still will not work, modify the $CONFIG variable inside Build.PL to point to the imlib2-config program that provides. '; exit 0; } else { print "Found imlib2 $version"; } my $libs = `$CONFIG --libs`; my $cflags = "-DX_DISPLAY_MISSING " . `$CONFIG --cflags`; my $build = Module::Build->new( c_source => './lib/Image', create_makefile_pl => 'passthrough', extra_compiler_flags => $cflags, extra_linker_flags => $libs, license => 'perl', module_name => 'Image::Imlib2', requires => { 'Module::Build' => '0.20', 'Test::More' => '0.01', }, add_to_cleanup => [qw( t/test1.jpg t/test2.jpg t/test3.jpg )], ); $build->create_build_script; lib000755001750001750 011303051420 13245 5ustar00acmeacme000000000000Image-Imlib2-2.03Image000755001750001750 011303051420 14267 5ustar00acmeacme000000000000Image-Imlib2-2.03/libppport.h000444001750001750 1716311303051420 16151 0ustar00acmeacme000000000000Image-Imlib2-2.03/lib/Image #ifndef _P_P_PORTABILITY_H_ #define _P_P_PORTABILITY_H_ /* Perl/Pollution/Portability Version 1.0007 */ /* Copyright (C) 1999, Kenneth Albanowski. This code may be used and distributed under the same license as any version of Perl. */ /* For the latest version of this code, please retreive the Devel::PPPort module from CPAN, contact the author at , or check with the Perl maintainers. */ /* If you needed to customize this file for your project, please mention your changes, and visible alter the version number. */ /* In order for a Perl extension module to be as portable as possible across differing versions of Perl itself, certain steps need to be taken. Including this header is the first major one, then using dTHR is all the appropriate places and using a PL_ prefix to refer to global Perl variables is the second. */ /* If you use one of a few functions that were not present in earlier versions of Perl, please add a define before the inclusion of ppport.h for a static include, or use the GLOBAL request in a single module to produce a global definition that can be referenced from the other modules. Function: Static define: Extern define: newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL */ /* To verify whether ppport.h is needed for your module, and whether any special defines should be used, ppport.h can be run through Perl to check your source code. Simply say: perl -x ppport.h *.c *.h *.xs foo/*.c [etc] The result will be a list of patches suggesting changes that should at least be acceptable, if not necessarily the most efficient solution, or a fix for all possible problems. It won't catch where dTHR is needed, and doesn't attempt to account for global macro or function definitions, nested includes, typemaps, etc. In order to test for the need of dTHR, please try your module under a recent version of Perl that has threading compiled-in. */ /* #!/usr/bin/perl @ARGV = ("*.xs") if !@ARGV; %badmacros = %funcs = %macros = (); $replace = 0; foreach () { $funcs{$1} = 1 if /Provide:\s+(\S+)/; $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/; $replace = $1 if /Replace:\s+(\d+)/; $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/; $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/; } foreach $filename (map(glob($_),@ARGV)) { unless (open(IN, "<$filename")) { warn "Unable to read from $file: $!\n"; next; } print "Scanning $filename...\n"; $c = ""; while () { $c .= $_; } close(IN); $need_include = 0; %add_func = (); $changes = 0; $has_include = ($c =~ /#.*include.*ppport/m); foreach $func (keys %funcs) { if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) { if ($c !~ /\b$func\b/m) { print "If $func isn't needed, you don't need to request it.\n" if $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m); } else { print "Uses $func\n"; $need_include = 1; } } else { if ($c =~ /\b$func\b/m) { $add_func{$func} =1 ; print "Uses $func\n"; $need_include = 1; } } } if (not $need_include) { foreach $macro (keys %macros) { if ($c =~ /\b$macro\b/m) { print "Uses $macro\n"; $need_include = 1; } } } foreach $badmacro (keys %badmacros) { if ($c =~ /\b$badmacro\b/m) { $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm); print "Uses $badmacros{$badmacro} (instead of $badmacro)\n"; $need_include = 1; } } if (scalar(keys %add_func) or $need_include != $has_include) { if (!$has_include) { $inc = join('',map("#define NEED_$_\n", sort keys %add_func)). "#include \"ppport.h\"\n"; $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m; } elsif (keys %add_func) { $inc = join('',map("#define NEED_$_\n", sort keys %add_func)); $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m; } if (!$need_include) { print "Doesn't seem to need ppport.h.\n"; $c =~ s/^.*#.*include.*ppport.*\n//m; } $changes++; } if ($changes) { open(OUT,">/tmp/ppport.h.$$"); print OUT $c; close(OUT); open(DIFF, "diff -u $filename /tmp/ppport.h.$$|"); while () { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; } close(DIFF); unlink("/tmp/ppport.h.$$"); } else { print "Looks OK\n"; } } __DATA__ */ #ifndef PERL_REVISION # ifndef __PATCHLEVEL_H_INCLUDED__ # include "patchlevel.h" # endif # ifndef PERL_REVISION # define PERL_REVISION (5) /* Replace: 1 */ # define PERL_VERSION PATCHLEVEL # define PERL_SUBVERSION SUBVERSION /* Replace PERL_PATCHLEVEL with PERL_VERSION */ /* Replace: 0 */ # endif #endif #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) #ifndef ERRSV # define ERRSV perl_get_sv("@",FALSE) #endif #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) /* Replace: 1 */ # define PL_sv_undef sv_undef # define PL_sv_yes sv_yes # define PL_sv_no sv_no # define PL_na na # define PL_stdingv stdingv # define PL_hints hints # define PL_curcop curcop # define PL_curstash curstash # define PL_copline copline # define PL_Sv Sv /* Replace: 0 */ #endif #ifndef dTHR # ifdef WIN32 # define dTHR extern int Perl___notused # else # define dTHR extern int errno # endif #endif #ifndef boolSV # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) #endif #ifndef gv_stashpvn # define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) #endif #ifndef newSVpvn # define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0)) #endif #ifndef newRV_inc /* Replace: 1 */ # define newRV_inc(sv) newRV(sv) /* Replace: 0 */ #endif #ifndef newRV_noinc # ifdef __GNUC__ # define newRV_noinc(sv) \ ({ \ SV *nsv = (SV*)newRV(sv); \ SvREFCNT_dec(sv); \ nsv; \ }) # else # if defined(CRIPPLED_CC) || defined(USE_THREADS) static SV * newRV_noinc (SV * sv) { SV *nsv = (SV*)newRV(sv); SvREFCNT_dec(sv); return nsv; } # else # define newRV_noinc(sv) \ ((PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv) # endif # endif #endif /* Provide: newCONSTSUB */ /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63)) #if defined(NEED_newCONSTSUB) static #else extern void newCONSTSUB _((HV * stash, char * name, SV *sv)); #endif #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) void newCONSTSUB(stash,name,sv) HV *stash; char *name; SV *sv; { U32 oldhints = PL_hints; HV *old_cop_stash = PL_curcop->cop_stash; HV *old_curstash = PL_curstash; line_t oldline = PL_curcop->cop_line; PL_curcop->cop_line = PL_copline; PL_hints &= ~HINT_BLOCK_SCOPE; if (stash) PL_curstash = PL_curcop->cop_stash = stash; newSUB( #if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)) /* before 5.003_22 */ start_subparse(), #else # if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22) /* 5.003_22 */ start_subparse(0), # else /* 5.003_23 onwards */ start_subparse(FALSE, 0), # endif #endif newSVOP(OP_CONST, 0, newSVpv(name,0)), newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) ); PL_hints = oldhints; PL_curcop->cop_stash = old_cop_stash; PL_curstash = old_curstash; PL_curcop->cop_line = oldline; } #endif #endif /* newCONSTSUB */ #endif /* _P_P_PORTABILITY_H_ */ Imlib2.xs000444001750001750 6600111303051420 16141 0ustar00acmeacme000000000000Image-Imlib2-2.03/lib/Image#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #include #include #include typedef Imlib_Image Image__Imlib2; typedef ImlibPolygon Image__Imlib2__Polygon; typedef Imlib_Color_Range Image__Imlib2__ColorRange; bool colours_equal(Imlib_Color col1, Imlib_Color col2) { return col1.red == col2.red && col1.green == col2.green && col1.blue == col2.blue; } static double TEXT_TO_RIGHT(void) { return IMLIB_TEXT_TO_RIGHT; } static double TEXT_TO_LEFT(void) { return IMLIB_TEXT_TO_LEFT; } static double TEXT_TO_UP(void) { return IMLIB_TEXT_TO_UP; } static double TEXT_TO_DOWN(void) { return IMLIB_TEXT_TO_DOWN; } static double TEXT_TO_ANGLE(void) { return IMLIB_TEXT_TO_ANGLE; } MODULE = Image::Imlib2 PACKAGE = Image::Imlib2 double TEXT_TO_RIGHT() double TEXT_TO_LEFT() double TEXT_TO_UP() double TEXT_TO_DOWN() double TEXT_TO_ANGLE() MODULE = Image::Imlib2 PACKAGE = Image::Imlib2 PREFIX= Imlib2_ Image::Imlib2 Imlib2_new(packname="Image::Imlib2", x=256, y=256) char * packname int x int y PROTOTYPE: $;$$ CODE: { Imlib_Image image; image = imlib_create_image(x, y); imlib_context_set_image(image); imlib_image_set_has_alpha(1); RETVAL = image; } OUTPUT: RETVAL Image::Imlib2 Imlib2__new_using_data(packname="Image::Imlib2", x=256, y=256, data) char * packname int x int y DATA32 * data PROTOTYPE: $;$$$ CODE: { Imlib_Image image; image = imlib_create_image_using_copied_data(x, y, data); imlib_context_set_image(image); imlib_image_set_has_alpha(1); RETVAL = image; } OUTPUT: RETVAL char Imlib2_will_blend(packname="Image::Imlib2", ...) char * packname PREINIT: char value; PROTOTYPE: $;$ CODE: { if (items > 1) { value = SvTRUE(ST(1))?1:0; imlib_context_set_blend(value); } RETVAL = imlib_context_get_blend(); } OUTPUT: RETVAL void Imlib2_DESTROY(image) Image::Imlib2 image PROTOTYPE: $ CODE: { imlib_context_set_image(image); imlib_free_image(); } Image::Imlib2 Imlib2_load(packname="Image::Imlib2", filename) char * packname char * filename PROTOTYPE: $$ CODE: { Imlib_Image image; Imlib_Load_Error err; image = imlib_load_image_with_error_return (filename, &err); if (err == IMLIB_LOAD_ERROR_FILE_DOES_NOT_EXIST) { Perl_croak(aTHX_ "Image::Imlib2 load error: File does not exist"); } if (err == IMLIB_LOAD_ERROR_FILE_IS_DIRECTORY) { Perl_croak(aTHX_ "Image::Imlib2 load error: File is directory"); } if (err == IMLIB_LOAD_ERROR_PERMISSION_DENIED_TO_READ) { Perl_croak(aTHX_ "Image::Imlib2 load error: Permission denied"); } if (err == IMLIB_LOAD_ERROR_NO_LOADER_FOR_FILE_FORMAT) { Perl_croak(aTHX_ "Image::Imlib2 load error: No loader for file format"); } RETVAL = image; } OUTPUT: RETVAL void Imlib2_save(image, filename) Image::Imlib2 image char * filename PROTOTYPE: $$ CODE: { Imlib_Load_Error err; imlib_context_set_image(image); imlib_save_image_with_error_return(filename, &err); if (err != IMLIB_LOAD_ERROR_NONE) { Perl_croak(aTHX_ "Image::Imlib2 save error: Unknown error"); } } int Imlib2_get_width(image) Image::Imlib2 image PROTOTYPE: $ CODE: { imlib_context_set_image(image); RETVAL = imlib_image_get_width(); } OUTPUT: RETVAL int Imlib2_width(image) Image::Imlib2 image PROTOTYPE: $ CODE: { imlib_context_set_image(image); RETVAL = imlib_image_get_width(); } OUTPUT: RETVAL int Imlib2_get_height(image) Image::Imlib2 image PROTOTYPE: $ CODE: { imlib_context_set_image(image); RETVAL = imlib_image_get_height(); } OUTPUT: RETVAL int Imlib2_height(image) Image::Imlib2 image PROTOTYPE: $ CODE: { imlib_context_set_image(image); RETVAL = imlib_image_get_height(); } OUTPUT: RETVAL void Imlib2_set_color(image, r, g, b, a) Image::Imlib2 image int r int g int b int a PROTOTYPE: $$$$$ CODE: { imlib_context_set_image(image); imlib_context_set_color(r, g, b, a); } void Imlib2_set_colour(image, r, g, b, a) Image::Imlib2 image int r int g int b int a PROTOTYPE: $$$$$ CODE: { imlib_context_set_image(image); imlib_context_set_color(r, g, b, a); } void Imlib2_draw_point(image, x, y) Image::Imlib2 image int x int y PROTOTYPE: $$$ CODE: { imlib_context_set_image(image); imlib_image_draw_pixel(x, y, 0); } void Imlib2_draw_line(image, x1, y1, x2, y2) Image::Imlib2 image int x1 int y1 int x2 int y2 PROTOTYPE: $$$$$ CODE: { imlib_context_set_image(image); imlib_image_draw_line(x1, y1, x2, y2, 0); } void Imlib2_query_pixel(image, x, y) Image::Imlib2 image int x int y PROTOTYPE: $$ PREINIT: Imlib_Color color_return; PPCODE: imlib_context_set_image(image); imlib_image_query_pixel(x, y, &color_return); XPUSHs(sv_2mortal(newSViv(color_return.red))); XPUSHs(sv_2mortal(newSViv(color_return.green))); XPUSHs(sv_2mortal(newSViv(color_return.blue))); XPUSHs(sv_2mortal(newSViv(color_return.alpha))); void Imlib2_autocrop_dimensions(image) Image::Imlib2 image PROTOTYPE: $$ PREINIT: Imlib_Color c, bg, tl, tr, bl, br; int width, height; int cx = 0; int cy = 0; int cw, ch; int x1, y1, x2, y2; int i; bool abort; PPCODE: imlib_context_set_image(image); width = imlib_image_get_width(); height = imlib_image_get_height(); cw = width; ch = height; /* guess the background colour algorithm from gimp's autocrop.c, originally pinched from pnmcrop: first see if three corners are equal, then if two are equal, otherwise give up */ imlib_image_query_pixel(0, 0, &tl); imlib_image_query_pixel(width - 1, 0, &tr); imlib_image_query_pixel(0, height - 1, &bl); imlib_image_query_pixel(width -1 , height - 1, &br); if (colours_equal(tr, bl) && colours_equal(tr, br)) { bg = tr; } else if (colours_equal(tl, bl) && colours_equal(tl, br)) { bg = tl; } else if (colours_equal(tl, tr) && colours_equal(tl, br)) { bg = tl; } else if (colours_equal(tl, tr) && colours_equal(tl, bl)) { bg = tl; } else if (colours_equal(tl, tr) || colours_equal(tl, bl) || colours_equal(tl, br)) { bg = tl; } else if (colours_equal(tr, bl) || colours_equal(tr, bl)) { bg = tr; } else if (colours_equal(br, bl)) { bg = br; } else { /* all different? give up */ XPUSHs(sv_2mortal(newSViv(cx))); XPUSHs(sv_2mortal(newSViv(cy))); XPUSHs(sv_2mortal(newSViv(cw))); XPUSHs(sv_2mortal(newSViv(ch))); return; } /* warn ("Have background colour: %i, %i, %i", bg.red, bg.green, bg.blue); */ /* check how many of the bottom lines are uniform */ abort = FALSE; for (y2 = height - 1; y2 >= 0 && !abort; y2--) { for (i = 0; i < width && !abort; i++) { imlib_image_query_pixel(i, y2, &c); abort = !colours_equal (c, bg); } } /* warn("x1 %i, y1 %i, x2 %i, y2 %i", x1, y1, x2, y2); */ if (y2 == -1) { /* plain colour */ XPUSHs(sv_2mortal(newSViv(cx))); XPUSHs(sv_2mortal(newSViv(cy))); XPUSHs(sv_2mortal(newSViv(cw))); XPUSHs(sv_2mortal(newSViv(ch))); return; } /* since now we don't need to check for the upper boundary of the outer loops as there is at least one pixel of different colour */ /* check how many of the top lines are uniform */ abort = FALSE; for (y1 = 0; !abort; y1++) { for (i = 0; i < width && !abort; i++) { imlib_image_query_pixel(i, y1, &c); abort = !colours_equal (c, bg); } } y2 += 1; /* to make y2 - y1 == height */ /* warn("x1 %i, y1 %i, x2 %i, y2 %i", x1, y1, x2, y2); */ /* the coordinates are now the first rows which DON'T match * the colour - crop instead to one row larger: */ if (y1 > 0) --y1; if (y2 < height-1) ++y2; /* check how many of the left lines are uniform */ abort = FALSE; for (x1 = 0; !abort; x1++) { for (i = y1; i < y2 && !abort; i++) { imlib_image_query_pixel(x1, i, &c); abort = !colours_equal (c, bg); } } /* warn("x1 %i, y1 %i, x2 %i, y2 %i", x1, y1, x2, y2); */ /* check how many of the right lines are uniform */ abort = FALSE; for (x2 = width - 1; !abort; x2--) { for (i = y1; i < y2 && !abort; i++) { imlib_image_query_pixel(x2, i, &c); abort = !colours_equal (c, bg); } } x2 += 1; /* to make x2 - x1 == width */ /* the coordinates are now the first columns which DON'T match * the color - crop instead to one column larger: */ if (x1 > 0) --x1; if (x2 < width-1) ++x2; /* warn("x1 %i, y1 %i, x2 %i, y2 %i", x1, y1, x2, y2); */ cx = x1; cy = y1; cw = x2 - x1; ch = y2 - y1; XPUSHs(sv_2mortal(newSViv(cx))); XPUSHs(sv_2mortal(newSViv(cy))); XPUSHs(sv_2mortal(newSViv(cw))); XPUSHs(sv_2mortal(newSViv(ch))); void Imlib2_find_colour(image) Image::Imlib2 image PROTOTYPE: $$ PREINIT: Imlib_Color c; int r, g, b, a; int width, height; int x = 0; int y = 0; bool abort; PPCODE: imlib_context_set_image(image); width = imlib_image_get_width(); height = imlib_image_get_height(); imlib_context_get_color(&r, &g, &b, &a); // warn("pr = %i, pg = %i, pb = %i", r, g, b); abort = FALSE; for (y = 0; y < height && !abort; y++) { for (x = 0; x < width && !abort; x++) { imlib_image_query_pixel(x, y, &c); abort = c.red == r && c.green == g && c.blue == b; } } if (abort) { XPUSHs(sv_2mortal(newSViv(x))); XPUSHs(sv_2mortal(newSViv(y))); } else { XPUSHs(newSV(0)); XPUSHs(newSV(0)); } void Imlib2_fill(image, x, y, newimage=NULL) Image::Imlib2 image Image::Imlib2 newimage int x int y PROTOTYPE: $$$$;$ PREINIT: Imlib_Color c; int r, g, b, a; int or, og, ob, oa; int width, height, px, py, west, east; AV* coords; SV* sv; int length; bool abort; PPCODE: imlib_context_set_image(image); width = imlib_image_get_width(); height = imlib_image_get_height(); imlib_image_query_pixel(x, y, &c); or = c.red; og = c.green; ob = c.blue; imlib_context_get_color(&r, &g, &b, &a); // warn("pr = %i, pg = %i, pb = %i", r, g, b); coords = newAV(); av_push(coords, newSViv(x)); av_push(coords, newSViv(y)); while (av_len(coords) != -1) { length = av_len(coords); // warn("length %i", length); sv = av_shift(coords); x = SvIVX(sv); sv_free(sv); sv = av_shift(coords); y = SvIVX(sv); sv_free(sv); imlib_image_query_pixel(x, y, &c); if ((c.red == or && c.green == og && c.blue == ob)) { if (newimage != NULL) { imlib_context_set_image(newimage); imlib_context_set_color(r, g, b, a); imlib_image_draw_pixel(x, y, 0); imlib_context_set_image(image); } imlib_image_draw_pixel(x, y, 0); west = x; east = x; abort = FALSE; while (!abort) { west -= 1; imlib_image_query_pixel(west, y, &c); abort = (west == 0 || !(c.red == or && c.green == og && c.blue == ob) ); } abort = FALSE; while (!abort) { east += 1; imlib_image_query_pixel(east, y, &c); abort = (east == width || !(c.red == or && c.green == og && c.blue == ob) ); } // warn(" %i-%i, %i", west, east, y); for (px = west; px <= east; px++) { if (newimage != NULL) { imlib_context_set_image(newimage); imlib_image_draw_pixel(px, y, 0); imlib_context_set_image(image); } imlib_image_draw_pixel(px, y, 0); py = y - 1; imlib_image_query_pixel(px, py, &c); if (py > 0 && (c.red == or && c.green == og && c.blue == ob) ) { // warn(" ^ %i, %i", px, py); av_push(coords, newSViv(px)); av_push(coords, newSViv(py)); } py = y + 1; imlib_image_query_pixel(px, py, &c); if (py < height && (c.red == or && c.green == og && c.blue == ob) ) { // warn(" v %i, %i", px, py); av_push(coords, newSViv(px)); av_push(coords, newSViv(py)); } } } } av_undef(coords); void Imlib2_draw_rectangle(image, x, y, w, h) Image::Imlib2 image int x int y int w int h PROTOTYPE: $$$$$ CODE: { imlib_context_set_image(image); imlib_image_draw_rectangle(x, y, w, h); } void Imlib2_fill_rectangle(image, x, y, w, h) Image::Imlib2 image int x int y int w int h PROTOTYPE: $$$$$ CODE: { imlib_context_set_image(image); imlib_image_fill_rectangle(x, y, w, h); } void Imlib2_draw_ellipse(image, x, y, w, h) Image::Imlib2 image int x int y int w int h PROTOTYPE: $$$$$ CODE: { imlib_context_set_image(image); imlib_image_draw_ellipse(x, y, w, h); } void Imlib2_fill_ellipse(image, x, y, w, h) Image::Imlib2 image int x int y int w int h PROTOTYPE: $$$$$ CODE: { imlib_context_set_image(image); imlib_image_fill_ellipse(x, y, w, h); } void Imlib2_add_font_path(image, directory) Image::Imlib2 image char * directory PROTOTYPE: $$ CODE: { imlib_context_set_image(image); imlib_add_path_to_font_path(directory); } void Imlib2_load_font(image, fontname) Image::Imlib2 image char * fontname PROTOTYPE: $$ CODE: { Imlib_Font font; imlib_context_set_image(image); font = imlib_load_font(fontname); imlib_context_set_font(font); } void Imlib2_get_text_size(image, text, direction=IMLIB_TEXT_TO_RIGHT, angle=0) Image::Imlib2 image char * text int direction double angle PROTOTYPE: $$ PREINIT: int text_w; int text_h; PPCODE: imlib_context_set_image(image); imlib_context_set_direction(direction); imlib_context_set_angle(angle); imlib_get_text_size(text, &text_w, &text_h); XPUSHs(sv_2mortal(newSViv(text_w))); XPUSHs(sv_2mortal(newSViv(text_h))); void Imlib2_draw_text(image, x, y, text, direction=IMLIB_TEXT_TO_RIGHT, angle=0) Image::Imlib2 image int x int y char * text int direction double angle PROTOTYPE: $$$$;$$ CODE: { imlib_context_set_image(image); imlib_context_set_direction(direction); imlib_context_set_angle(angle); imlib_text_draw(x, y, text); } Image::Imlib2 Imlib2_crop(image, x, y, w, h) Image::Imlib2 image int x int y int w int h PROTOTYPE: $$$$$ CODE: { Imlib_Image cropped; imlib_context_set_image(image); cropped = imlib_create_cropped_image(x, y, w, h); RETVAL = cropped; } OUTPUT: RETVAL void Imlib2_blend(image, source, alpha, x, y, w, h, d_x, d_y, d_w, d_h) Image::Imlib2 image Image::Imlib2 source int alpha int x int y int w int h int d_x int d_y int d_w int d_h PROTOTYPE: $$$$$$$$$$$ CODE: { imlib_context_set_image(image); imlib_blend_image_onto_image(source, alpha, x, y, w, h, d_x, d_y, d_w, d_h); } void Imlib2_blur(image, radius) Image::Imlib2 image int radius PROTOTYPE: $$ CODE: { imlib_context_set_image(image); imlib_image_blur(radius); } void Imlib2_sharpen(image, radius) Image::Imlib2 image int radius PROTOTYPE: $$ CODE: { imlib_context_set_image(image); imlib_image_sharpen(radius); } Image::Imlib2 Imlib2_clone(image) Image::Imlib2 image PROTOTYPE: $ CODE: { Imlib_Image cloned; imlib_context_set_image(image); cloned = imlib_clone_image(); RETVAL = cloned; } OUTPUT: RETVAL void Imlib2_draw_polygon(image, poly, closed) Image::Imlib2 image Image::Imlib2::Polygon poly unsigned char closed PROTOTYPE: $$$ CODE: { imlib_context_set_image(image); imlib_image_draw_polygon(poly,closed); } void Imlib2_fill_color_range_rectangle(image, cr, x, y, width, height, angle) Image::Imlib2 image Image::Imlib2::ColorRange cr int x int y int width int height double angle PROTOTYPE: $$$$$$ CODE: { Imlib_Color_Range oldcr; imlib_context_set_image(image); oldcr = imlib_context_get_color_range(); imlib_context_set_color_range(cr); imlib_image_fill_color_range_rectangle(x,y,width,height,angle); imlib_context_set_color_range(oldcr); } void Imlib2_image_orientate(image, steps) Image::Imlib2 image int steps PROTOTYPE: $$ CODE: { imlib_context_set_image(image); imlib_image_orientate(steps); } void Imlib2_image_set_format(image, format) Image::Imlib2 image char * format PROTOTYPE: $$ CODE: { imlib_context_set_image(image); imlib_image_set_format(format); } Image::Imlib2 Imlib2_create_scaled_image(image, dw, dh) Image::Imlib2 image int dw int dh PROTOTYPE: $$$ CODE: { Imlib_Image dstimage; int sw, sh; imlib_context_set_image(image); sw = imlib_image_get_width(); sh = imlib_image_get_height(); if ( dw == 0 ) { dw = (int) (((double) dh * sw) / sh); } if ( dh == 0 ) { dh = (int) (((double) dw * sh) / sw); } dstimage = imlib_create_cropped_scaled_image(0, 0, sw, sh, dw, dh); RETVAL = dstimage; } OUTPUT: RETVAL Image::Imlib2 Imlib2_set_quality(image, qual) Image::Imlib2 image int qual PROTOTYPE: $$ CODE: { imlib_context_set_image(image); imlib_image_attach_data_value("quality",NULL,qual,NULL); } Image::Imlib2 Imlib2_flip_horizontal(image) Image::Imlib2 image PROTOTYPE: $ CODE: { imlib_context_set_image(image); imlib_image_flip_horizontal(); } Image::Imlib2 Imlib2_flip_vertical(image) Image::Imlib2 image PROTOTYPE: $ CODE: { imlib_context_set_image(image); imlib_image_flip_vertical(); } Image::Imlib2 Imlib2_flip_diagonal(image) Image::Imlib2 image PROTOTYPE: $ CODE: { imlib_context_set_image(image); imlib_image_flip_diagonal(); } int Imlib2_has_alpha(image, ...) Image::Imlib2 image PREINIT: char value; PROTOTYPE: $;$ CODE: { imlib_context_set_image(image); if (items > 1) { value = SvTRUE(ST(1))?1:0; imlib_image_set_has_alpha(value); } RETVAL = imlib_image_has_alpha(); } OUTPUT: RETVAL void Imlib2_set_cache_size(packname="Image::Imlib2", size) char * packname int size PROTOTYPE: $$ CODE: { imlib_set_cache_size(size); } int Imlib2_get_cache_size(packname="Image::Imlib2") char * packname PROTOTYPE: $ CODE: { RETVAL = imlib_get_cache_size(); } OUTPUT: RETVAL void Imlib2_set_changes_on_disk(image) Image::Imlib2 image PROTOTYPE: $ CODE: { imlib_context_set_image(image); imlib_image_set_changes_on_disk(); } Image::Imlib2 Imlib2_create_transparent_image(source, alpha) Image::Imlib2 source int alpha PROTOTYPE: $$ PREINIT: Imlib_Image destination; Imlib_Color color_return; int x, y, w, h; CODE: { imlib_context_set_image(source); w = imlib_image_get_width(); h = imlib_image_get_height(); destination = imlib_create_image(w, h); imlib_context_set_image(destination); imlib_image_set_has_alpha(1); for (y = 0; y < h; y++) { for (x = 0; x < w; x++) { imlib_context_set_image(source); imlib_image_query_pixel(x, y, &color_return); imlib_context_set_color(color_return.red, color_return.green, color_return.blue, alpha); imlib_context_set_image(destination); imlib_image_draw_pixel(x, y, 0); } } RETVAL = destination; } OUTPUT: RETVAL Image::Imlib2 Imlib2_create_blended_image(source1, source2, pc) Image::Imlib2 source1 Image::Imlib2 source2 int pc PROTOTYPE: $$ PREINIT: Imlib_Image destination; Imlib_Color color1, color2; int x, y, w, h; int npc; CODE: { npc = 100 - pc; imlib_context_set_image(source1); w = imlib_image_get_width(); h = imlib_image_get_height(); destination = imlib_create_image(w, h); imlib_context_set_image(destination); for (y = 0; y < h; y++) { for (x = 0; x < w; x++) { imlib_context_set_image(source1); imlib_image_query_pixel(x, y, &color1); imlib_context_set_image(source2); imlib_image_query_pixel(x, y, &color2); imlib_context_set_image(destination); imlib_context_set_color((color1.red * pc + color2.red * npc)/100, (color1.green * pc + color2.green * npc)/100, (color1.blue * pc + color2.blue * npc)/100, 255); imlib_image_draw_line(x, y, x, y, 0); } } RETVAL = destination; } OUTPUT: RETVAL Image::Imlib2 Imlib2_create_rotated_image(source, angle) Image::Imlib2 source double angle CODE: imlib_context_set_image(source); RETVAL = imlib_create_rotated_image(angle); OUTPUT: RETVAL MODULE = Image::Imlib2 PACKAGE = Image::Imlib2::Polygon PREFIX= Imlib2_Polygon_ Image::Imlib2::Polygon Imlib2_Polygon_new(packname="Image::Imlib2::Polygon") char * packname PROTOTYPE: $ CODE: { ImlibPolygon poly; poly = imlib_polygon_new(); RETVAL = poly; } OUTPUT: RETVAL void Imlib2_Polygon_DESTROY(poly) Image::Imlib2::Polygon poly PROTOTYPE: $ CODE: { imlib_polygon_free(poly); } void Imlib2_Polygon_add_point(poly, x, y) Image::Imlib2::Polygon poly int x int y PROTOTYPE: $$$ CODE: { imlib_polygon_add_point(poly,x,y); } void Imlib2_Polygon_fill(poly) Image::Imlib2::Polygon poly PROTOTYPE: $ CODE: { imlib_image_fill_polygon(poly); } MODULE = Image::Imlib2 PACKAGE = Image::Imlib2::ColorRange PREFIX= Imlib2_ColorRange_ Image::Imlib2::ColorRange Imlib2_ColorRange_new(packname="Image::Imlib2::ColorRange") char * packname PROTOTYPE: $ CODE: { Imlib_Color_Range cr; cr = imlib_create_color_range(); RETVAL = cr; } OUTPUT: RETVAL void Imlib2_ColorRange_DESTROY(cr) Image::Imlib2::ColorRange cr PROTOTYPE: $ CODE: { Imlib_Color_Range oldcr; oldcr = imlib_context_get_color_range(); imlib_context_set_color_range(cr); imlib_free_color_range(); imlib_context_set_color_range(oldcr); } void Imlib2_ColorRange_add_color(cr, d, r, g, b, a) Image::Imlib2::ColorRange cr int d int r int g int b int a PROTOTYPE: $$ CODE: { Imlib_Color_Range oldcr; oldcr = imlib_context_get_color_range(); imlib_context_set_color_range(cr); imlib_context_set_color(r,b,g,a); imlib_add_color_to_color_range(d); imlib_context_set_color_range(oldcr); } Imlib2.pm000444001750001750 4121711303051420 16125 0ustar00acmeacme000000000000Image-Imlib2-2.03/lib/Imagepackage Image::Imlib2; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD); require Exporter; require DynaLoader; @ISA = qw(Exporter DynaLoader); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( TEXT_TO_RIGHT TEXT_TO_LEFT TEXT_TO_UP TEXT_TO_DOWN TEXT_TO_ANGLE ); $VERSION = '2.03'; bootstrap Image::Imlib2 $VERSION; Image::Imlib2->set_cache_size(0); sub new_transparent { my ( $pkg, $x, $y ) = @_; my $pixel = pack( 'CCCC', 0, 0, 0, 0 ); # ARGB return Image::Imlib2->new_using_data( $x, $y, $pixel x ( $x * $y ) ); } sub new_using_data { my ( $pkg, $x, $y, $data ) = @_; if ( defined $data && 4 * $x * $y == length $data ) { return $pkg->_new_using_data( $x, $y, $data ); } else { return undef; } } sub autocrop { my $image = shift; my ( $x, $y, $w, $h ) = $image->autocrop_dimensions; return $image->crop( $x, $y, $w, $h ); } 1; __END__ # Below is the stub of documentation for your module. You better edit it! =head1 NAME Image::Imlib2 - Interface to the Imlib2 image library =head1 SYNOPSIS use Image::Imlib2; # create a new image my $image = Image::Imlib2->new(200, 200); # or load an image $image = Image::Imlib2->load("foo.png"); # Enable the alpha channel support $image->has_alpha(1); # set a colour (rgba, so this is transparent orange) $image->set_color(255, 127, 0, 127); # draw a rectangle $image->draw_rectangle(50, 50, 50, 50); # draw a filled rectangle $image->fill_rectangle(150, 50, 50, 50); # draw a line $image->draw_line(0, 0, 200, 50); # set quality before saving $image->set_quality(50); # save out $image->save('out.png'); # create a polygon my $poly = Image::Imlib2::Polygon->new(); # add some points $poly->add_point(0, 0); $poly->add_point(100, 0); $poly->add_point(100, 100); $poly->add_point(0, 100); # fill the polygon $poly->fill(); # draw it closed on image $image->draw_polygon($poly, 1); # create a color range my $cr = Image::Imlib2::ColorRange->new(); # add a color my ($distance, $red, $green, $blue, $alpha) = (15, 200, 100, 50, 20); $cr->add_color($distance, $red, $green, $blue, $alpha); # draw it my($x, $y, $width, $height, $angle) = (20, 30, 200, 200, 1); $image->fill_color_range_rectangle($cr, $x, $y, $width, $height, $angle); =head1 DESCRIPTION B is a Perl port of Imlib2, a graphics library that does image file loading and saving as well as manipulation, arbitrary polygon support, etc. It does ALL of these operations FAST. It allows you to create colour images using a large number of graphics primitives, and output the images in a range of formats. Image::Imlib2::Polygon and Image::Imlib2::ColorRange are described following Image::Imlib2 but may be referenced before their description. Note that this is an early version of my attempt at a Perl interface to Imlib2. Currently, the API is just to test things out. Not everything is supported, but a great deal of functionality already exists. If you think the API can be tweaked to be a bit more intuitive, drop me a line! Note that a development version of Imlib2 must be installed before installing this module. =head1 Exported constants =head2 TEXT_TO_RIGHT =head2 TEXT_TO_LEFT =head2 TEXT_TO_UP =head2 TEXT_TO_DOWN =head2 TEXT_TO_ANGLE To be used as the direction parameter for text functions that accept it. =head1 METHODS (Image::Imlib2) =head2 new This will create a new, blank image. If the dimensions aren't specified, it will default to 256 x 256. my $image = Image::Imlib2->new(100, 100); The contents of this image at creation time are undefined - they could be garbage memory. You should clear the image if necessary. =head2 new_transparent This will create a new fully-transparent image. If the dimensions aren't specified, it will default to 256 x 256. my $image = Image::Imlib2->new_transparent(100, 100); =head2 new_using_data This will create a new image with the specified pixel data, which must be a packed string. If the dimensions are not specified, it will default to 256 x 256. my $pixel = pack('CCCC', 255, 127, 0, 255); # ARGB my $image = Image::Imlib2->new_using_data(100, 100, $pixel x (100*100)); =head2 load This will load an existing graphics file and create a new image object. It reads quite a few different image formats. my $image = Image::Imlib2->load("foo.png"); =head2 save This saves the current image out. Currently this is in PNG if the format has not been set using image_set_format(). $image->save("out.png"); =head2 image_set_format (format) This will set the image format for future save operations. format is a string and may be "jpeg", "tiff", "png", etc. The exact number of formats supported depends on how you built imlib2. $image->image_set_format("jpeg"); # Convert image to JPG =head2 set_quality This sets the quality of the saved picture - lower the quality to get smaller filesizes. $image->set_quality(50); =head2 set_color (r, g, b, a) or set_colour (r, g, b, a) This sets the colour that the drawing primitives will use. You specify the red, green, blue and alpha components, which should all range from 0 to 255. The alpha component specified how transparent the colour is: 0 is fully transparent (so drawing with it will be pointless), 127 is half-transparent, and 255 is fully opaque. Many examples: $image->set_colour(255, 255, 255, 255); # white $image->set_colour( 0, 0, 0, 255); # black $image->set_colour(127, 127, 127, 255); # 50% gray $image->set_colour(255, 0, 0, 255); # red $image->set_colour( 0, 255, 0, 255); # green $image->set_colour( 0, 0, 255, 255); # blue $image->set_colour(255, 127, 0, 127); # transparent orange Warning: this sets a global variable for the draw color. =head2 draw_point (x, y) This colours a point in the image in the currently-selected colour. Note that the coordinate system used has (0, 0) at the top left, with (50, 0) to the right of the top left, (0, 50) below the top left, and (50, 50) to the bottom right of the top left. $image->draw_point(50, 50); =head2 query_pixel (x, y) This returns the colour of a pixel in the image. It returns the red, green, blue and alpha components: my($r, $g, $b, $a) = $image->query_pixel(50,50); =head2 draw_line (x1, y1, x2, y2) This draws a line between two points in the currently-selected colour. The following draws between the (0, 0) and (100, 100) points: $image->draw_line(0, 0, 100, 100); =head2 draw_rectangle (x, y, w, h) This draws a the outline of a rectangle with the top left point at (x, y) and having width w and height h in the current colour. $image->draw_rectangle(0, 0, 50, 50); =head2 fill_rectangle (x, y, w, h) This draws a filled rectangle with the top left point at (x, y) and having width w and height h in the current colour. $image->fill_rectangle(0, 0, 50, 50); =head2 draw_ellipse (x, y, w, h) This draws an ellipse which has center (x, y) and horizontal amplitude of w and vertical amplitude of h in the current colour. Note that setting w and h to the same value will draw a circle. $image->draw_ellipse(100, 100, 50, 50); =head2 fill_ellipse (x, y, w, h) This draws a filled ellipse which has center (x, y) and horizontal amplitude of w and vertical amplitude of h in the current colour. Note that setting w and h to the same value will draw a filled circle. $image->fill_ellipse(100, 100, 50, 50); =head2 add_font_path (dir) This function adds the directory path to the end of the current list of directories to scan for truetype (TTF) fonts. $image->add_font_path("./ttfonts"); =head2 load_font (font) This function will load a truetype font from the first directory in the font path that contains that font. The font name format is "font_name/size". For example. If there is a font file called cinema.ttf somewhere in the font path you might use "cinema/20" to load a 20 pixel sized font of cinema. Note that this font will be used from now on, much like set_colour does for colours. $image->load_font("cinema/20"); Warning: this sets a global variable for the current font. =head2 get_text_size (text, direction, angle) This function returns the width and height in pixels the text string would use up if drawn with the current font. direction and angle are optional and deault to TEXT_TO_RIGHT and 0, respectively. my($w, $h) = $image->get_text_size("Imlib2 and Perl!"); my($w1, $w2) = $image->get_text_size("Crazy text", TEXT_TO_UP, 1); =head2 draw_text (x, y, text, direction, angle) This draws the text using the current font and colour onto the image at position (x, y). direction and angle are optional and deault to TEXT_TO_RIGHT and 0, respectively. $image->draw_text(50, 50, "Groovy, baby, yeah!"); $image->draw_text(50, 50, "Sweet, baby, yeah!", TEXT_TO_UP, 1.571); =head2 autocrop This creates a duplicate of the image which is automatically cropped to remove the background colour from the outside of the image: my $cropped_image = $image->autocrop; =head2 autocrop_dimensions This returns the x, y, width and height rectangle in an image which would hold the results of the autocrop method: my($x, $y, $w, $h) = $image->autocrop_dimensions; =head2 crop (x, y, w, h) This creates a duplicate of a x, y, width, height rectangle in the current image and returns another image. my $cropped_image = $image->crop(0, 0, 50, 50); =head2 blend (source_image, merge_alpha, sx, sy, sw, sh, dx, dy, dw, dh) This will blend the source rectangle x, y, width, height from the source_image onto the current image at the destination x, y location scaled to the width and height specified. If merge_alpha is set to 1 it will also modify the destination image alpha channel, otherwise the destination alpha channel is left untouched. $image->blend($cropped_image, 0, 0, 0, 50, 50, 200, 0, 50, 50); =head2 blur (radius) This will blur the image. A radius of 0 has no effect, 1 and above determine the blur matrix radius that determine how much to blur the image. $image->blur(1); =head2 sharpen (radius) This sharpens the image. The radius affects how much to sharpen by. $image->sharpen(1); =head2 clone () This creates an exact duplicate of the current image. $cloned = $image->clone; =head2 draw_polygon (polygon, closed) This will draw polygon (of type Imlib2::Image::Polygon) on the the image. The the polygon is drawn closed is closed is 1 and open if closed is 0. $image->draw_polygon($poly, 1); =head2 fill_color_range_rectangle(color_range, x, y, w, h, angle); This uses the color range color_range to fille a rectangle with points x, y, x+width, y+width. $image->fill_color_range_rectangle($cr, 10, 20, 100, 150, 0); =head2 image_orientate (steps) This will rotate the image by steps*90 degrees, so to rotate by 90 degrees set to 1, for 180 degrees set to 2, etc. $image->image_orientate(1); # Rotate by 90 degrees. =head2 create_rotated_image(radians) Create a new image, rotated from the original by a number of radians. For example, to rotate 45 degrees: my $rotated = $image->create_rotated_image(45 / 360 * 3.141519*2); =head2 create_scaled_image (x, y) Create a new image, scaled from the original to the dimensions given in x and y. If x or y are 0, then retain the aspect ratio given in the other. $image2=$image->create_scaled_image(100,100); # Scale to 100x100 pixels =head2 create_transparent_image (alpha) Create a new image, based upon the original but with a fixed alpha value. This will create a transparent image that you can then blend onto other images. Alpha ranges from 0 to 255: my $new = $image->create_transparent_image(64); =head2 create_blended_image (percent) Create a new image, which is percent% of source1 and (100-percent)% of source2. This is used for fading bedtween two images. Percent ranges from 0 to 100: my $new = $source1->create_blended_image($source2, 50); =head2 flip_horizontal () This will flip/mirror the image horizontally. $image->flip_horizontal(); =head2 flip_vertical () This will flip/mirror the image vertically. $image->flip_vertical(); =head2 flip_diagonal () This will flip/mirror the current image diagonally (good for quick and dirty 90 degree rotations if used before to after a horizontal or vertical flip). $image->flip_diagonal(); =head2 has_alpha (BOOLEAN) Queries and/or sets the alpha support flag for the image. Note that alpha is on by default when you create an image: if ($image->has_alpha) { # do something requiring alpha support } # Enable the alpha channel $image->has_alpha(1); =head2 set_cache_size (INT) By default, Imlib2 will not cache any images loaded from disk. If you set a cache size then Imlib2 will cache all loaded images (up to this size) and will use this cache to avoid loading images from disk. Sets the size of the image cache. Reducing this value will cause the cache to be emptied. You can turn off caching all together by setting this to zero. Even without a cache, as long as you have a reference to an image in memory that image will be returned immediately without checking the disk. Image::Imlib2->set_cache_size(1024 * 1024); my $image = Image::Imlib2->load("foo.jpg"); # image loaded from disk ... later, somewhere else, after $image has gone away ... my $image = Image::Imlib2->load("foo.jpg"); # same image, even if changed on disk ... later, somewhere else, after $image has gone away ... Image::Imlib2->set_cache_size(0); my $image = Image::Imlib2->load("foo.jpg"); # image loaded from disk my $image2 = Image::Imlib2->load("foo.jpg"); # same image as before, not reloaded =head2 get_cache_size () Returns the maximum size of the Image cache. =head2 set_changes_on_disk () Called on an Image::Imlib2 instance that you have loaded from disk, this method tells imlib that it should take extra care when caching the image for this filename. Next time the load method is called for this image's file name Imlib will check the modification time for the file on disk compared to the cached version and take appropriate action. my $image = Image::Imlib2->load("foo.jpg"); $image->set_changes_on_disk(); ...later... # reloads image from disk if mod time has changed (otherwise use cached) my $image = Image::Imlib2->load("foo.jpg"); Calling this method on a loaded image tells Imlib2 to look at the disk and compare mtimes with it's loaded copy - by default, this is not the case, so even if a file changes on disk, it won't be re-loaded. =head2 will_blend (BOOL) Changes the setting for whether drawing blends with existing pixels in the image or overwrites those pixels. Defaults to true. Returns the new value. If no argument is passed, just returns the current value. Warning: this sets a global variable for blending. =head2 find_colour This returns the x and y coordinates for the first pixel of the current colour it finds in the image. It returns undef if it doesn't find the colour: # find a red pixel $i->set_colour(255, 0, 0, 255); my($rx, $ry) = $i->find_red; =head2 fill This flood fills the image, starting at the x and y coordinates and filling every pixel under it with the current colour: $i->fill($x, $y); =head1 METHODS (Image::Imlib2::Polygon) =head2 new This will create a new polygon for use with Image::Imlib2::draw_polygon. my $poly = Image::Imlib2::Polygon->new(); =head2 add_point (x, y) Adds a point to the polygonal construct. $poly->add_point(10,10); =head2 fill Fills polygon in the current context. $poly->fill(); =head1 METHODS (Image::Imlib2::ColorRange) =head2 new Creates a new color range. my $cr = Image::Imlib2::ColorRange->new(); =head2 add_color (distance, red, green, blue, alpha) Similar to set_colour, but adds the color to the color range at the specified distance. $cr->add_color(10, 255, 127, 0, 66); Warning: this sets a global variable for the draw color. =head2 width Returns the current width of the image. my $width = $image->width; =head2 height Returns the current height of the image. my $height = $image->height; =head1 DEPRECATED METHOS =head2 get_width Returns the current width of the image. Use width() instead. my $width = $image->get_width; =head2 get_height Returns the current height of the image. Use height() instead. my $height = $image->get_height; =head1 AUTHOR Leon Brocard, acme@astray.com =head1 COPYRIGHT Copyright (c) 2000-9 Leon Brocard. All rights reserved. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut examples000755001750001750 011303051420 14315 5ustar00acmeacme000000000000Image-Imlib2-2.03benchmark.pl000444001750001750 161711303051420 16746 0ustar00acmeacme000000000000Image-Imlib2-2.03/examples#!/usr/local/bin/perl use lib qw(../lib ../blib/lib ../blib/arch); use Benchmark; use Image::Imlib2; my $image = Image::Imlib2->new(100, 100); $image->set_colour(255, 0, 0, 255); timethese(-5, { 'point' => \&point, 'line' => \&line, 'rect' => \&rectangle, 'rect_f' => \&rectangle_fill, 'ellipse' => \&ellipse, 'ellipse_f' => \&ellipse_f, }); #$image->save("benchmark.png"); sub point { $image->draw_point(rand(100), rand(100)); } sub line { $image->draw_line(rand(100), rand(100), rand(100), rand(100)); } sub rectangle { $image->draw_rectangle(rand(50), rand(50), rand(50), rand(50)); } sub rectangle_fill { $image->fill_rectangle(rand(50), rand(50), rand(50), rand(50)); } sub ellipse { $image->draw_ellipse(rand(50) + 25, rand(50) + 25, rand(24) + 1, rand(24) + 1); } sub ellipse_f { $image->fill_ellipse(rand(50) + 25, rand(50) + 25, rand(24) + 1, rand(24) + 1); } benchmark.txt000444001750001750 117711303051420 17153 0ustar00acmeacme000000000000Image-Imlib2-2.03/examplesBenchmark: running ellipse, ellipse_f, line, point, rect, rect_f, each for at least 5 CPU seconds... ellipse: 6 wallclock secs ( 5.24 usr + 0.00 sys = 5.24 CPU) @ 32643.89/s (n=171054) ellipse_f: 5 wallclock secs ( 5.18 usr + 0.00 sys = 5.18 CPU) @ 6162.93/s (n=31924) line: 6 wallclock secs ( 5.29 usr + 0.00 sys = 5.29 CPU) @ 34200.95/s (n=180923) point: 7 wallclock secs ( 5.24 usr + 0.00 sys = 5.24 CPU) @ 120843.51/s (n=633220) rect: 7 wallclock secs ( 5.26 usr + 0.00 sys = 5.26 CPU) @ 36132.89/s (n=190059) rect_f: 5 wallclock secs ( 5.36 usr + 0.00 sys = 5.36 CPU) @ 15042.72/s (n=80629) maeda.pl000444001750001750 222511303051420 16057 0ustar00acmeacme000000000000Image-Imlib2-2.03/examples#!/usr/local/bin/perl # # This is a program which attempts to produce a picture # I once saw by John Maeda. # # Note: there appears to be a bug in fill_ellipse in some versions of # imlib2. Change that to fill_rectange all if you get is a white # screen. # # Leon Brocard use strict; use lib qw(../lib ../blib/lib ../blib/arch); use Image::Imlib2; use POSIX qw(floor); my $image = Image::Imlib2->new(640, 480); $image->set_colour(255, 255, 255, 255); $image->fill_rectangle(0, 0, 640, 480); foreach my $x (0..640) { next if ($x + 16) % 32; $x += rand(16) - 8; my $h = $x / 2; $h = 320 - $h if $h > 160; $h *= 2; foreach my $c (1..$h/4) { my $rand = floor(rand(4)); if ($rand == 0) { $image->set_colour(255, 255, 0, 255); } elsif ($rand == 1) { $image->set_colour(255, 0, 255, 255); } elsif ($rand == 2) { $image->set_colour( 0, 255, 255, 255); } elsif ($rand == 3) { $image->set_colour( 0, 0, 0, 255); } my $y = 240 + rand($h) - ($h / 2) + rand(80) - 40; my $radius = int(rand(10)) + 1; $image->fill_ellipse($x, $y, $radius, $radius); } } $image->save("maeda.png"); t000755001750001750 011303051420 12742 5ustar00acmeacme000000000000Image-Imlib2-2.03autocrop.t000444001750001750 56111303051420 15102 0ustar00acmeacme000000000000Image-Imlib2-2.03/t#!/usr/bin/perl -w use strict; use Test::More tests => 8; use_ok('Image::Imlib2'); my $i = Image::Imlib2->load("t/blob.png"); isa_ok($i, 'Image::Imlib2'); my($x, $y, $w, $h) = $i->autocrop_dimensions; is($x, 128); is($y, 8); is($w, 123); is($h, 200); my $cropped = $i->autocrop; is($cropped->width, 123); is($cropped->height, 200); $cropped->save("t/cropped.png"); data.t000444001750001750 575511303051420 14211 0ustar00acmeacme000000000000Image-Imlib2-2.03/t#!/usr/bin/perl -w use strict; use Test::More; # This line comes from perlport.pod my $AM_BIG_ENDIAN = unpack( 'h*', pack( 's', 1 ) ) =~ /01/ ? 1 : 0; # $h must be divisible by 3 my $w = 4; my $h = 6; plan tests => 4 + 3 * $w * $h; # ntests * dimensions use_ok('Image::Imlib2'); ok( !Image::Imlib2->new_using_data( 16, 16 ), 'no data arg' ); ok( !Image::Imlib2->new_using_data( 16, 16, "0" x 16 ), 'wrong length data arg' ); ok( Image::Imlib2->new_using_data( 16, 16, "0" x ( 4 * 16 * 16 ) ), 'right length data arg' ); # Create two images with the same data. # One is created with an array of packed pixels # The other has a rectangle filled on it # The images are three horizontal bands of different color, to test # that the pixel order is right. # Note: if any of the colors has a non-255 alpha, then this test fails # unless the control image also uses new_using_data to clear itself # first (all pixels to 0,0,0,0). Reason: new_using_data overwrites the image while # fill_rectangle blends with (255,0,0,0), giving a different result. my $null = pack 'CCCC', 0, 0, 0, 0; # First test has just opaque pixels. Second has a translucent pixel for my $test ( { blend => 1, pixels => [ [ 255, 255, 127, 0 ], #ARGB [ 255, 127, 127, 127 ], [ 255, 0, 127, 255 ] ] }, { blend => 1, pixels => [ [ 255, 255, 127, 0 ], #ARGB [ 127, 127, 127, 127 ], [ 255, 0, 127, 255 ] ] }, { blend => 0, pixels => [ [ 255, 255, 127, 0 ], #ARGB [ 127, 127, 127, 127 ], [ 255, 0, 127, 255 ] ] }, ) { Image::Imlib2->will_blend( $test->{blend} ); my $pixels = $test->{pixels}; my $alpha = grep { $_->[0] != 255 } @$pixels; my @packed = map { pack 'CCCC', ($AM_BIG_ENDIAN ? @$_ : reverse @$_) } @$pixels; my $rect = ( $packed[0] x ( $w * $h / 3 ) ) . ( $packed[1] x ( $w * $h / 3 ) ) . ( $packed[2] x ( $w * $h / 3 ) ); my $data_image = Image::Imlib2->new_using_data( $w, $h, $rect ); # If we have a non-opaque pixel, need to create a transparent image my $image = $alpha && $test->{blend} ? Image::Imlib2->new_using_data( $w, $h, $null x ( $w * $h ) ) : Image::Imlib2->new( $w, $h ); $image->set_color( @{ $pixels->[0] }[ 1 .. 3 ], $pixels->[0]->[0] ) ; # RGBA $image->fill_rectangle( 0, 0, $w, $h / 3 ); $image->set_color( @{ $pixels->[1] }[ 1 .. 3 ], $pixels->[1]->[0] ) ; # RGBA $image->fill_rectangle( 0, $h / 3, $w, $h / 3 ); $image->set_color( @{ $pixels->[2] }[ 1 .. 3 ], $pixels->[2]->[0] ) ; # RGBA $image->fill_rectangle( 0, 2 * $h / 3, $w, $h / 3 ); for my $x ( 0 .. $w - 1 ) { for my $y ( 0 .. $h - 1 ) { my @p1 = $data_image->query_pixel( $x, $y ); my @p2 = $image->query_pixel( $x, $y ); is_deeply( \@p1, \@p2, "$x,$y" ); } } } cache.t000444001750001750 321311303051420 14326 0ustar00acmeacme000000000000Image-Imlib2-2.03/t#!/usr/bin/perl -w use strict; use Test::More tests => 7; use FindBin qw($Bin); use File::Spec; use File::Copy; use_ok('Image::Imlib2'); # create 2 differently-sized images, and save them as differennt files. my $file1 = File::Spec->catfile($Bin, "test1.jpg"); my $file2 = File::Spec->catfile($Bin, "test2.jpg"); my $file3 = File::Spec->catfile($Bin, "test3.jpg"); my $image1 = Image::Imlib2->new(580, 200); $image1->save($file1); my $image2 = Image::Imlib2->new(580, 300); $image2->save($file2); my $image3 = Image::Imlib2->new(580, 400); $image3->save($file3); ############################################################### # no cache, please, we're british. Image::Imlib2->set_cache_size(0); is( Image::Imlib2->get_cache_size, 0, "no cache now" ); # load the first file, we expect it to be a given size. my $im = Image::Imlib2->load($file1); is( $im->get_height, 200, "right height for original" ); # now overwrite the image with the other one. copy($file2, $file1) or die $!; # we _expect_ this to be image2, now, but the cache disagrees. $im = Image::Imlib2->load($file1); is( $im->get_height, 200, "image (wrongly) still original height" ); # try again, without cache undef $im; $im = Image::Imlib2->load($file1); is( $im->get_height, 300, "image now new (image2) height" ); # now overwrite the image with the _other_ other one. copy($file3, $file1) or die $!; # we _expect_ this to be image3, now, but the cache disagrees. $im = Image::Imlib2->load($file1); is( $im->get_height, 300, "image (wrongly) still image2 height" ); # force re-load again undef $im; $im = Image::Imlib2->load($file1); is( $im->get_height, 400, "image now image3 height" ); pod.t000444001750001750 21411303051420 14023 0ustar00acmeacme000000000000Image-Imlib2-2.03/t#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); blob.png000444001750001750 755111303051420 14533 0ustar00acmeacme000000000000Image-Imlib2-2.03/tPNG  IHDR hPLTE  """$$$%%%&&&'''((()))***+++,,,///000111222333444555666777888999:::;;;<<<===>>>???@@@AAABBBCCCDDDEEEFFFGGGHHHIIIJJJKKKLLLMMMNNNOOORRRTTTUUUVVVWWWXXXYYY[[[\\\]]]^^^aaabbbcccdddeeefffggghhhjjjmmmnnnooorrrtttvvvwwwxxxyyyzzz|||}}}~~~o]bKGDH pHYs  tIME 286 ^IDATx݋[S{lE\k]:ltsSå-as:nMS صp Z6I$'0IT~c$ !<}a$% $  H@b6HHRhhp(,Ii.!7;n_C "irW87v S͙ MB :?y3o98+ l&Â'+~vseD n\hن-w::b,$']cJB.`l/η͙3ǖ_pS˧kb}xsN![DEVCJZVxH2K>|娃4rr~p|?/3cBZӢ FDee{]T)ur~4_ȰS=TrޮX6O?+b GC7Bn-<'V|Μ]JQ]ҏe;=I:r8pվ\,JCv+T:K|Xf'͜Vo9'c(].jGIa^"%=cQ̶Uc3FA1hݳn_ouDQڢ;P.qGsdA(b0/b6 Z!iۢoiBuO.3$J8RRA10% cE3 nUK9Q6okٕEH`bկ\i"x ^lpu8hW%1)#xyeoƶcţnS彜lnO6:}tYB4kd;H:'h7yKHWB%&,"Aӎ vt&HgL 3=9%(QA$(َw Z"rP#v@H@bDsE $ >$M ֘ 2 ܉{$hV#ZK\tͨ`,C":;2U AYtFE/ LCufJ$3P"Arh2\H/!XV׏)R"nMqk F#0»H7].UzWl^'\g*A{{&kc݂XYd)!5b)Ӵ٦pW VdlFH%%g   H@$ 1G|#5;QK 2RKDo#M$FHDPԍ[@Z۶jR_Dd@q 9QB>HDw!Sa G>-rLRgrzibs~ˇ\g](k*o2HB.n'Q0|%ȶr7 p^)32o=v#ze*ɶ:F,]Ns]B"*jyC[B;k?SPX=ђ:uV+5f=U{}&@Bk,k2j l+9uX"#3o6g[Ϡ?,M H<֔c]a)6Cv,6?`l;q7R`#lAζю'`s~Q@jIC)RO95Lf%K%# I9p:H }W6.~,#I攓Ֆf^' M0:Ma7=kۋJKKJ.)J'\֮X-)M3b?{kL{GkkGٿ4RJ-rN"ZF> ~ߐ+ Ss`'1RLRM_rP'A$fDГ1g*%jcKDTߩo)w5_{L;8nwLž|\}s˳Q]O~ƞE}]W$DTlh>3|(4G%3}2lybZMBȻW"d(}oFR(%[K˳Wbo]7>N>*F>G^ҾCƜ~+G1/c܁$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@$  H@ءR IENDB`findfill.t000444001750001750 225111303051420 15053 0ustar00acmeacme000000000000Image-Imlib2-2.03/t#!/usr/bin/perl -w use strict; use Test::More tests => 12; use_ok('Image::Imlib2'); my $i = Image::Imlib2->load("t/findfill.png"); my($w, $h) = ($i->width, $i->height); isa_ok($i, 'Image::Imlib2'); # find red $i->set_colour(255, 0, 0, 255); my($rx, $ry) = $i->find_colour; is($rx, 186); is($ry, 51); $i->set_colour(127, 0, 0, 255); $i->fill($rx, $ry); $i->fill($rx + 10, $ry); # find green $i->set_colour(0, 255, 0, 255); ($rx, $ry) = $i->find_colour; is($rx, 163); is($ry, 145); $i->set_colour(0, 127, 0, 255); $i->fill($rx, $ry); $i->fill($rx + 10, $ry); # find blue $i->set_colour(0, 0, 255, 255); ($rx, $ry) = $i->find_colour; is($rx, 158); is($ry, 97); $i->set_colour(0, 0, 127, 255); $i->fill($rx, $ry); $i->fill($rx + 5, $ry); # find orange, which isn't there $i->set_colour(255, 127, 0, 255); ($rx, $ry) = $i->find_colour; is($rx, undef); is($ry, undef); my $new = Image::Imlib2->new($w, $h); $new->set_colour(255, 255, 255, 255); $new->fill_rectangle(0, 0, $w, $h); # find black $i->set_colour(0, 0, 0, 255); ($rx, $ry) = $i->find_colour; is($rx, 143); is($ry, 12); $i->set_colour(127, 127, 127, 255); $i->fill($rx, $ry, $new); #$new->save("new.png"); #$i->save("done.png"); pod_coverage.t000444001750001750 25411303051420 15702 0ustar00acmeacme000000000000Image-Imlib2-2.03/t#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); findfill.png000444001750001750 244711303051420 15403 0ustar00acmeacme000000000000Image-Imlib2-2.03/tPNG  IHDR D PLTE333fffbv bKGDH pHYs  tIME jIDATxAr@ UJ( 9/QlKƒ@xL ݙYX6Gf|xX4X"Iͭzc$qK#WI.c$$%z5Z隵If/-Bb*q(-q--Ҭ5ERkdY7X[$[WO{QYl?<>\U &3I'Z[#~HНB>Keq Çŝ ܅sm97 8x#9Uy yK,7x7)_ a3  B?<%  YB=0dk!Bd=nB7<k3SN5=kv/#X\n~"޹X(YL["N-TOL?ʑZ ?k13K ebbBu7B͙bbbB98e6O~-,lZ,]Xؼ) s 0zhtaw? \7B=8wYoNb.- "XwHW,ۤ&eB`Y%jŽYpo,NG j,dcJ1NjB{,$H,;EBYcqv,S5:=|N_XjX?I,gR`>\9akA3I,9Ja<'rKtBOXXl1812PDEUo-3U,NlnIXJ?1]< Ȓ#eL(")z;KGuɡ2xPͤN0IENDB`simple.t000444001750001750 474211303051420 14564 0ustar00acmeacme000000000000Image-Imlib2-2.03/t#!/usr/bin/perl -w use strict; use Test::More tests => 21; use_ok('Image::Imlib2'); my $image = Image::Imlib2->new( 580, 200 ); # Does the constructor work? ok( defined($image) ); # Is it the right width? is( $image->get_width, 580 ); # Is it the right height? is( $image->get_height, 200 ); # Is it the right width? is( $image->width, 580 ); # Is it the right height? is( $image->height, 200 ); # Is alpha on by default? is( $image->has_alpha, 1 ); # Does set_colour work? $image->set_colour( 255, 0, 0, 255 ); # Does set_color work? $image->set_color( 255, 0, 0, 255 ); # Does query_pixel work? my $p = [ $image->query_pixel( 10, 10 ) ]; is_deeply( $p, [ 0, 0, 0, 0 ] ); # Does draw_point work? $image->draw_point( 10, 10 ); # Does query_pixel work? $p = [ $image->query_pixel( 10, 10 ) ]; is_deeply( $p, [ 255, 0, 0, 255 ] ); # Does draw_line work? $image->draw_line( 50, 10, 100, 50 ); # Does draw_rectangle work? $image->draw_rectangle( 50, 50, 100, 100 ); # Does fill_rectangle work? $image->fill_rectangle( 50, 50, 100, 100 ); # Does draw_ellipse work? $image->draw_ellipse( 50, 50, 25, 25 ); # Does fill_ellipse work? $image->fill_ellipse( 50, 50, 25, 25 ); my $cloned = $image->clone; # Is it the right width? is( $cloned->get_width, 580 ); # Is it the right height? is( $cloned->get_height, 200 ); # Is alpha on by default? is( $cloned->has_alpha, 1 ); # create a polygon my $poly = Image::Imlib2::Polygon->new(); # add some points $poly->add_point( 10, 3 ); $poly->add_point( 0, 7 ); $poly->add_point( 10, 20 ); $poly->add_point( 10, 3 ); # fill the polygon $poly->fill(); # draw it closed on image $image->draw_polygon( $poly, 1 ); # orientate it $image->image_orientate(1); # blur it $image->blur(1); # sharpen it $image->sharpen(1); # create a scaled image of it my $dstimage = $image->create_scaled_image( 100, 80 ); # does has_alpha work? $image->has_alpha(0); is( $image->has_alpha, 0 ); # create a transparent image my $new = $image->create_transparent_image(64); # Is it the right width? is( $image->get_width, 200 ); # Is it the right height? is( $image->get_height, 580 ); # Is alpha on by default? is( $new->has_alpha, 1 ); # create a transparent image my $transparent = Image::Imlib2->new_transparent( 20, 40 ); is( $transparent->get_width, 20 ); is( $transparent->get_height, 40 ); # create a rotated image my $rotated = $image->create_rotated_image(45 / 360 * 3.141519*2); is( $rotated->get_width, 618 ); is( $rotated->get_height, 618 ); ok( 1, "got to the end" )