Image-Base-Magick
view release on metacpan or search on metacpan
with Image-Base-Magick. If not, see <http://www.gnu.org/licenses/>.
Version 7, September 2021
- oops, need 1x1 rectangles to dispatch to single-point
Version 6, August 2021
- allow for GetPixel() returning transparency
Version 5, July 2017
- tests allow for Image::Magick->VERSION = undef circa its 6.97
Version 4, October 2012
- xy() use Draw(primitive=>'point') instead of set("pixel[]"), to
avoid error on negative or large X,Y
Version 3, August 2011
- fix diamond() coordinates
- try strokewidth on ellipse() and diamond()
Version 2, July 2011
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Image::Base" : "0",
"Image::Magick" : "0",
"perl" : "5.001"
}
},
"test" : {
"requires" : {
"Test" : "0"
}
}
},
"release_status" : "stable",
version: '1.4'
name: Image-Base-Magick
no_index:
directory:
- t
- inc
- devel
- xt
requires:
Image::Base: '0'
Image::Magick: '0'
perl: '5.001'
resources:
homepage: http://user42.tuxfamily.org/image-base-magick/index.html
license: http://www.gnu.org/licenses/gpl.html
version: '7'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
Makefile.PL view on Meta::CPAN
ABSTRACT => 'Image::Base on files using ImageMagick.',
VERSION_FROM => 'lib/Image/Base/Magick.pm',
AUTHOR => 'Kevin Ryde <user42_kevin@yahoo.com.au>',
LICENSE => 'gpl_3',
SIGN => 1,
PREREQ_PM => {
'Image::Base' => 0,
# maybe 0.39 of Nov 2001 for oop style tags,
# oopery is from somewhere post 0.20 at least
'Image::Magick' => 0,
},
TEST_REQUIRES => {
'Test' => 0,
},
# Magick might go right back to 5.002 or some such
MIN_PERL_VERSION => '5.001',
META_MERGE =>
{ resources =>
devel/magick.pl view on Meta::CPAN
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Image-Base-Magick. If not, see <http://www.gnu.org/licenses/>.
use 5.010;
use strict;
use warnings;
use Image::Magick;
use Smart::Comments;
use lib 't';
use MyTestImageBase;
# Is this wrapped by perlmagick ?
# {
# my @MagickVersion = Image::Magick->GetMagickVersion;
# ### @MagickVersion
# exit 0;
# }
{
# flat ellipse
require Image::Base::Magick;
my $image = Image::Base::Magick->new (-width => 50, -height => 20,
-file_format => 'xpm');
$image->rectangle (0,0, 49,29, 'black',1);
devel/magick.pl view on Meta::CPAN
$image->save ('/tmp/x-001.jpeg');
$image->set (-quality_percent => 100);
$image->save ('/tmp/x-100.jpeg');
system "ls -l /tmp/x*";
exit 0;
}
{
my $filename = 'temp%d.png';
my $m = Image::Magick->new or die;
# if (my $err = $m->Set (size => '20x10')) { die $err }
if (my $err = $m->ReadImage('xc:black')) { die $err }
if (my $err = $m->Set (filename => $filename)) { die $err }
require Fcntl;
sysopen FH, $filename, Fcntl::O_RDONLY() or die;
binmode FH or die;
my @oldims = @$m;
@$m = ();
### empty before load: $m
devel/magick.pl view on Meta::CPAN
### load leaves magick: $m
### array: [@$m]
### width: $m->Get('width')
### height: $m->Get('height')
### size: $m->Get('size')
exit 0;
}
{
my $m = Image::Magick->new (
# width => 20, height => 10,
size => '20x10',
# size => '20x',
);
### initial width: $m->Get('width')
### initial size: $m->Get('size')
### format: $m->Get('format')
### magick: $m->Get('magick')
### ReadImage xc-black
devel/magick.pl view on Meta::CPAN
$m->Set(filename => '/tmp/zz.png');
$m->Write;
exit 0;
}
{
use strict;
use warnings;
use Image::Magick;
unlink "/tmp/out.png";
my $m = Image::Magick->new (size => '1x1');
if (!$m) { die; }
### $m
my $err = $m->ReadImage('xc:black');
if ($err) { die $err; }
### $m
my $filename = "/tmp/x%d.blah";
$filename = "/tmp/xx.png";
$m->Write (filename => $filename,
# quality => 75,
);
$m = Image::Magick->new; # (size => '64x64');
if (!$m) { die; }
### $m
# $err = $m->SetAttribute (debug => 'all,trace');
# $err = $m->SetAttribute (debug => 'all');
# if ($err) { die $err; }
# $m->set(filename => "/tmp/x%d.png");
# $m->ReadImage('xc:black');
# $err = $m->Read ();
devel/magick.pl view on Meta::CPAN
# $image->ellipse (1,1, 18,8, 'white', 1);
# $image->ellipse (1,1, 2,2, 'white', 0);
$m->Write ('xpm:-');
exit 0;
}
{
my $m = Image::Magick->new;
### m: $m->Get('magick')
$m->Read('/usr/share/emacs/23.2/etc/images/icons/hicolor/16x16/apps/emacs.png');
### magick: $m->Get('magick')
### width: $m->Get('width')
### height: $m->Get('width')
### size: $m->Get('size')
# $m->Set(magick => '');
### m: $m->Get('magick')
$m->Read('/usr/share/webcheck/favicon.ico');
### m: $m->Get('magick')
$m->Write(filename => '/tmp/image%%03d.data');
exit 0;
}
{
my $m = Image::Magick->new;
# $m->Set(width=>10, height => 10);
$m->Set(size=>'20x10');
$m->ReadImage('xc:black');
say $m->Get('width');
say $m->Get('height');
say $m->Get('size');
# $m->Draw(fill=>'white',
# primitive=>'rectangle',
devel/magick.pl view on Meta::CPAN
# $m->Set('pixel[5,5]'=>'red');
say $m->GetPixel (x => 5, y => 5);
say $m->Get ('Pixel[5,5]');
$m->Write ('xpm:-');
exit 0;
$m->Set (size=>'20x10');
$m->Set (magick=>'xpm');
$m = Image::Magick->new;
$m->Set(size=>'20x10');
$m->ReadImage('xc:white');
# #$m->Read ('/usr/share/emacs/22.3/etc/images/icons/emacs_16.png');
# $m->Draw (primitive => 'rectangle',
# points => '0,0, 19,9',
# method => 'Replace',
# stroke => 'black',
# fill => 'black',
# );
devel/magick.pl view on Meta::CPAN
$m->Quantize(colours => 4);
exit 0;
}
{
use strict;
use warnings;
use Image::Magick;
my $m = Image::Magick->new (size => '20x10');
if (!$m) { die; }
### $m
my $err = $m->ReadImage('xc:black');
if ($err) { die $err; }
### $m
$err = $m->SetPixel (x=>3, y=>4, color=>'#AABBCC');
if ($err) { die $err; }
lib/Image/Base/Magick.pm view on Meta::CPAN
# file:///usr/share/doc/imagemagick-6-common/html/www/perl-magick.html
# file:///usr/share/doc/imagemagick-6-common/html/www/formats.html
package Image::Base::Magick;
use 5.004;
use strict;
use Carp;
use Fcntl;
use Image::Magick;
use vars '$VERSION', '@ISA';
use Image::Base;
@ISA = ('Image::Base');
$VERSION = 7;
# uncomment this to run the ### lines
# use Smart::Comments '###';
lib/Image/Base/Magick.pm view on Meta::CPAN
$params{'-imagemagick'} = $self->get('-imagemagick')->Clone;
}
# inherit everything else
%params = (%$self, %params);
### copy params: \%params
}
if (! defined $params{'-imagemagick'}) {
# Crib note: passing attributes to new() is the same as a subsequent
# set() except no error return from new()
my $m = $params{'-imagemagick'} = Image::Magick->new;
# must apply -width, -height as "size" before ReadImage()
if (exists $params{'-width'} || exists $params{'-height'}) {
my $width = delete $params{'-width'} || 0;
my $height = delete $params{'-height'} || 0;
### Set(size) -width,-height: "${width}x${height}"
if ($err = $m->Set (size => "${width}x${height}")) {
croak $err;
}
}
lib/Image/Base/Magick.pm view on Meta::CPAN
=head1 CLASS HIERARCHY
C<Image::Base::Magick> is a subclass of C<Image::Base>,
Image::Base
Image::Base::Magick
=head1 DESCRIPTION
C<Image::Base::Magick> extends C<Image::Base> to create or
update image files using C<Image::Magick>.
The native ImageMagick drawing has hugely more features, but this module is
a way to point C<Image::Base> style code at an ImageMagick canvas and use
the numerous file formats ImageMagick can read and write.
=head2 Colour Names
Colour names are anything recognised by ImageMagick,
http://imagemagick.org/www/color.html
lib/Image/Base/Magick.pm view on Meta::CPAN
C<-width> and C<-height>,
my $image = Image::Base::Magick->new (-width => 200,
-height => 100);
Or an existing file can be read,
my $image = Image::Base::Magick->new
(-file => '/some/filename.png');
Or an C<Image::Magick> object can be given,
$image = Image::Base::Magick->new (-imagemagick => $mobj);
=back
=head1 ATTRIBUTES
=over
=item C<-width> (integer)
lib/Image/Base/Magick.pm view on Meta::CPAN
=item C<-height> (integer)
Setting these changes the size of the image.
In the current code a C<Resize()> is done which means the existing image is
stretched, but don't depend on that. It might make more sense to crop when
shrinking and pad with black when extending.
=item C<-imagemagick>
The underlying C<Image::Magick> object.
=item C<-file> (string, default C<undef>)
The filename for C<load> or C<save>, or passed to C<new> to load a file.
The filename is used literally, it doesn't have ImageMagick's "%d" scheme
for sets of numbered files. The code here is only geared towards a single
image in a canvas, and using the filename literally is the same as other
C<Image::Base> modules.
lib/Image/Base/Magick.pm view on Meta::CPAN
C<$imagemagick-E<gt>Write()> when saving PNG.
=back
For reference, ImageMagick (as of version 6.7.7) doesn't read or write the
cursor "hotspot" of XPM format, so there's no C<-hotx> and C<-hoty> options.
=head1 SEE ALSO
L<Image::Base>,
L<Image::Magick>
L<Image::Base::GD>,
L<Image::Base::PNGwriter>,
L<Image::Base::Imager>,
L<Image::Base::Gtk2::Gdk::Pixbuf>,
L<Image::Base::Prima::Image>,
L<Image::Xbm>,
L<Image::Xpm>,
L<Image::Pbm>
L<Prima::Image::Magick>
=head1 HOME PAGE
http://user42.tuxfamily.org/image-base-magick/index.html
=head1 LICENSE
Image-Base-Magick is Copyright 2010, 2011, 2012, 2017, 2021 Kevin Ryde
Image-Base-Magick is free software; you can redistribute it and/or modify it
# use Smart::Comments;
# only test on 6.6 up since 6.5.5 seen doing dodgy stuff on a 3x3 ellipse,
# coming out with an excess to the right like
# _____www____________
# _____wwwww__________
# _____www____________
#
my $have_image_magick = eval { require Image::Magick; 1 };
if ($have_image_magick) {
# something in Image::Magick circa 6.97 broke its Image::Magick->VERSION,
# so watch out for undef
my $im_version = Image::Magick->VERSION;
MyTestHelpers::diag ("Image::Magick VERSION ".(defined $im_version ? $im_version : "[undef]"));
if (! defined $im_version) {
$im_version = eval { Image::Magick::Q16->VERSION };
if (defined $im_version) {
MyTestHelpers::diag ("Image::Magick::Q16 VERSION $im_version");
}
}
# Demand 6.6 or higher for bug fixes. But not Image::Magick->VERSION(6.6)
# since that provokes badness when non-numeric $VERSION='6.6.0'.
if (defined $im_version && $im_version =~ /([0-9]*(\.[0-9]*)?)/) {
my $im_two_version = $1;
if ($im_two_version < 6.6) {
MyTestHelpers::diag ("Image::Magick 6.6 not available -- im_version $im_version im_two_version $im_two_version");
$have_image_magick = 0;
}
}
}
if (! $have_image_magick) {
foreach (1 .. $test_count) {
skip ('no Image::Magick 6.6', 1, 1);
}
exit 0;
}
require Image::Base::Magick;
#------------------------------------------------------------------------------
# VERSION
xt/dummy/Image/Magick.pm view on Meta::CPAN
# later version.
#
# Image-Base-Magick is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Image-Base-Magick. If not, see <http://www.gnu.org/licenses/>.
package Image::Magick;
use vars '$VERSION';
$VERSION = 6;
1;
__END__
( run in 1.192 second using v1.01-cache-2.11-cpan-beeb90c9504 )