CAD-Drawing

 view release on metacpan or  search on metacpan

Build.PL  view on Meta::CPAN

my $builder = $build_class->new(
	module_name         => 'CAD::Drawing',
	license             => 'perl',
	dist_version_from   => 'lib/CAD/Drawing.pm',
	requires => {
		'Test::More'             => 0,
		'Compress::Zlib'         => 1.41,
		'Stream::FileInputStream' => 0, # XXX kill that
		# XXX only needed for CAD::Drawing::Manipulate::Graphics
		'Image::Magick'          => 6,
		'Math::Geometry::Planar' => 1.14,
		'Math::MatrixReal'       => 1.9,
		# Eric wrote these
		'CAD::Calc'              => 0.25,
		'Math::Vec'              => '0.03',
	},
	add_to_cleanup      => [ qw(CAD-Drawing-* META.yml)],
);

$builder->create_build_script();

META.yml  view on Meta::CPAN

version: 0.26
author:
  - 'Eric L. Wilhelm <ewilhelm at cpan dot org>'
abstract: 'Methods to create, load, and save vector graphics'
license: perl
resources:
  license: http://dev.perl.org/licenses/
requires:
  CAD::Calc: 0.25
  Compress::Zlib: 1.41
  Image::Magick: 6
  Math::Geometry::Planar: 1.14
  Math::MatrixReal: 1.9
  Math::Vec: 0.03
  Stream::FileInputStream: 0
  Test::More: 0
provides:
  CAD::Drawing:
    file: lib/CAD/Drawing.pm
    version: 0.26
  CAD::Drawing::Calculate:

lib/CAD/Drawing/IO.pm  view on Meta::CPAN

=item L<CAD::Drawing::IO::OpenDWG|CAD::Drawing::IO::OpenDWG>

DWG/DXF handling using the OpenDWG toolkit.

=item L<CAD::Drawing::IO::PostScript|CAD::Drawing::IO::PostScript>

Postscript output.

=item L<CAD::Drawing::IO::Image|CAD::Drawing::IO::Image>

Image::Magick based output.

=item L<CAD::Drawing::IO::PgDB|CAD::Drawing::IO::PgDB>

PostgreSQL connected drawing database.

=item L<CAD::Drawing::IO::Tk|CAD::Drawing::IO::Tk>

Tk::WorldCanvas popup viewer -- not exactly an input/output backend, but
it uses much of the same facility because it is primarily just output to
a display.

lib/CAD/Drawing/Manipulate/Graphics.pm  view on Meta::CPAN

package CAD::Drawing::Manipulate::Graphics;
our $VERSION = '0.02';

use CAD::Drawing;
use CAD::Drawing::Defined;
use Image::Magick;
push(@CAD::Drawing::ISA, __PACKAGE__);

use warnings;
use strict;
use Carp;

=pod

=head1 Name

lib/CAD/Drawing/Manipulate/Graphics.pm  view on Meta::CPAN

=head1 Methods

All of these are CAD::Drawing methods (I force my own inheritance:)

=cut
########################################################################

=head2 image_init

Initialize the image at $addr based on the value at the fullpath key.
This establishes the contained Image::Magick object and loads the image
into memory in the image_handle key.

  $drw->image_init($addr);

=cut
sub image_init {
	my $self = shift;
	my ($addr) = @_;
	($addr->{type} eq "images") or croak("item is not an image\n");
	my $obj = $self->getobj($addr);
	my $name = $obj->{fullpath};
	(-e $name) or croak("$name does not exist\n");
	# print "loading $name ...\n";
	my $im = Image::Magick->new();
	my $err = $im->Read($name);
	$err && carp("read $name gave $err\n");
	$obj->{image_handle} = $im;
} # end subroutine image_init definition
########################################################################

=head2 image_crop

Crops an image and its definition (actually, changes its insert point)
according to the points given by @crop_points (which maybe had better be

lib/CAD/Drawing/Manipulate/Graphics.pm  view on Meta::CPAN

	$dbg && print "start crop: @crop_start\n";
	$dbg && print "stop  crop: @crop_stop\n";
	$im->Crop(
		width => $ext[0], height => $ext[1],
		x => $crop_start[0], y => $crop_start[1],
		);
	my @sz = $im->Get("width", "height");
	$dbg && print "check: @sz\n";

	# image processing does strange things, so we use the size reported
	# by Image::Magick to reset the insert point and size of the image
	my @new_base = (
		$crop_start[0],
		$crop_start[1] + $sz[1],
		);
	my @new_pt = $self->img_to_drw(\@new_base, $addr);
	$dbg && print "old insert: @{$obj->{pt}}\n";
	$dbg && print "new basepoint: @new_base at @new_pt\n";
	$obj->{pt} = [@new_pt];
	$obj->{size} = [@sz];
	if(0) {

lib/CAD/Drawing/Manipulate/Graphics.pm  view on Meta::CPAN

	$dbg && print "size now $w x $h (hopefully)\n";
	$dbg && print "checking: ", 
		join(" x ", $im_in->Get("width", "height")), "\n";
	# and set the vecs
	$obj->{vector} = [map({[@$_]} @$dvecs)];
	# and the size
	$obj->{size} = [$w, $h];
	# need to create a new image object which represents the destination
	# size and find the points where this one fits into that.
	my $d_size = $self->Get("size", $d_addr);
	my $im_out = Image::Magick->new();
	$im_out->Set(size => sprintf("%0.0fx%0.0f", @$d_size));
	$dbg && print "filling new image at @$d_size\n";
	$im_out->Read("xc:$bgcolor");
	$im_out->Transparent("color" => $bgcolor);
	# dot each corner for justification into other images
	my $color = $aci2hex[$self->Get("color", $s_addr)];
	$dbg && print "output dot color: $color\n";
	my $x = $d_size->[0] - 1;
	my $y = $d_size->[1] - 1;
	$im_out->Set("pixel[0,0]" => $color);