File Coverage

blib/lib/CAD/Drawing/Defined.pm

Criterion	Covered	Total	%
statement	12	65	18.4
branch	0	20	0.0
condition			n/a
subroutine	4	8	50.0
pod	4	4	100.0
total	20	97	20.6

package CAD::Drawing::Defined;
our $VERSION = '0.62';

use warnings;
use strict;
use Carp;
use vars qw(
		@ISA
		@EXPORT
		$debug
		$linkdebug
		$loaddebug
		$colordebug
		%color_names
		%call_syntax
		%ac_storage_method
		%defaults
		@defaultkeys
		@std_opts_syntax
		$pi
		@aci2hex
		@aci2rgb
		);

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
			$debug
			$linkdebug
			$loaddebug
			$colordebug
			%color_names
			%call_syntax
			%ac_storage_method
			%defaults
			@defaultkeys
			@std_opts_syntax
			$pi
			@aci2hex
			@aci2rgb
			check_select
			color_translate
			checkarcangs
			);
# @EXPORT_OK = qw(
# 			color_translate
# 			);
$debug = 0;
$linkdebug = 0;
$colordebug = 0;
$loaddebug = 0;

%defaults = (
	"layer" => "0",
	"color" => 256,
	"linetype" => "default",
	);

@defaultkeys = keys(%defaults);

########################################################################
=head1 NAME

CAD::Drawing::Defined - exported constants for CAD::Drawing::*

=head1 Description

Everything in this module is exported by default.  This module is not
intended to be used directly, but is required by each module in the
CAD::Drawing tree.

=head1 AUTHOR

Eric L. Wilhelm

http://scratchcomputing.com

=head1 COPYRIGHT

This module is copyright (C) 2004-2006 by Eric L. Wilhelm.  Portions
copyright (C) 2003 by Eric L. Wilhelm and A. Zahner Co.

=head1 LICENSE

This module is distributed under the same terms as Perl.  See the Perl
source package for details.

You may use this software under one of the following licenses:

  (1) GNU General Public License
    (found at http://www.gnu.org/copyleft/gpl.html)
  (2) Artistic License
    (found at http://www.perl.com/pub/language/misc/Artistic.html)

=head1 NO WARRANTY

This software is distributed with ABSOLUTELY NO WARRANTY.  The author,
his former employer, and any other contributors will in no way be held
liable for any loss or damages resulting from its use.

=head1 Modifications

The source code of this module is made freely available and
distributable under the GPL or Artistic License.  Modifications to and
use of this software must adhere to one of these licenses.  Changes to
the code should be noted as such and this notification (as well as the
above copyright information) must remain intact on all copies of the
code.

Additionally, while the author is actively developing this code,
notification of any intended changes or extensions would be most helpful
in avoiding repeated work for all parties involved.  Please contact the
author with any such development plans.

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

=head1 Useful Functions

These were functions that didn't seem appropriate as object-oriented but
were needed in multiple places.  They are exported by default (as is
nearly everything in this package.

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

=head2 check_select

Provides a uniform interface to selection processing.

NOTE:  this is not an object method and is exported by default!

Direct calling should be for internal use only, but you may have been
sent to this documentation by one of the modules which uses this
function to process %option arguments.

%opts hash may contain  (alias)

  Inclusive lists:
  "select layers"      (sl)
  "select colors"      (sc)
  "select types"       (st)
  "select linetypes"   (slt)

  Exclusive lists:
  "not layers"         (nl)
  "not colors"         (nc)
  "not types"          (nt)
  "not linetypes"      (nlt)

The values must be list references.

The space-separated terms in the keys above may now be underscore ("_")
separated as well (this saves having to double-quote the item when using
it as a hash key in the %options argument.)

If an option is omitted, all of that category are selected.

  ($s, $n) = check_select(\%selection_options);

$s will be a hash reference to inclusive items
$n will be a hash reference to excluded items

Keys in the returned hash references are according to the above-listed
alias conventions ($s->{l} contains a set of true values for selected
layers (where the layer name is a string acting as the hash key.))

Note that the \%selection_options hash reference is a required argument
(at this level.)  Any functions which make it optional must declare a
hash before passing to this.

=cut
sub check_select {
	my ($opt) = @_;
	my %opts = %$opt;
	my %s = (
		"l" => undef(),
		"c" => undef(),
		"t" =>  undef(),
		"lt" => undef(),
		);
	my %n = (
		"l" => undef(),
		"c" => undef(),
		"t" =>  undef(),
		"lt" => undef(),
		);
	my %res = ( "s" => \%s, "n" => \%n);
	my @choices = keys(%res);
	my %mapch = (
		"s" => "select",
		"n" => "not",
		);
	my %mapit = (
		"l" => "layers",
		"c" => "colors",
		"t" => "types",
		"lt" => "linetypes",
		);
	# $opts{sl} && print "wanted @{$opts{sl}}\n";
	foreach my $ch (@choices) {
		my $g = $res{$ch};
		foreach my $it (keys(%{$g})) {
			foreach my $alias ($ch . $it, $mapch{$ch}."_".$mapit{$it}) {
				$opts{$alias} &&
					($opts{"$mapch{$ch} $mapit{$it}"} = $opts{$ch.$it});
				# print "option $alias: $opts{$alias}\n";
			}
			if($opts{"$mapch{$ch} $mapit{$it}"}) {
				# print "$mapch{$ch} $mapit{$it}\n";
				my @list = @{$opts{"$mapch{$ch} $mapit{$it}"}};
				($it eq "c") && (@list = color_translate(@list));
				# print "($it) list: @list\n";
				$g->{$it} = {map({$_ => 1} @list)};
			}
			else {
				$g->{$it} = undef;
			}
		}
	}
	return(\%s, \%n);

} # end subroutine check_select definition
########################################################################

=head2 checkarcangs

Performs in-place modification of arc angles in \@angs.

NOTE:  this is not an object method and is exported by default!

Internal use only.

  checkarcangs(\@angs);

=cut
sub checkarcangs {
	my($ang) = @_;
	foreach my $d (0,1) {
		# print "got $$ang[$d] for an angle\n";
		if($$ang[$d] =~ s/d$//) {
			# allow spec of angle in degrees with $angle . "d";
			$$ang[$d] *= $pi / 180;
			}
		while($$ang[$d] > $pi) {
			$$ang[$d] -= $pi * 2;
			}
		while($$ang[$d] <= -$pi) {
			$$ang[$d] += $pi * 2;
			}
		}
	} # end subroutine checkarcangs definition
########################################################################

=head2 color_translate

Translates a list of colors into numbers.  Numbers will be passed
through (as will unrecognized names!)

  @colors = color_translate(@colors);

=cut
sub color_translate {
	my(@list) = @_;
	foreach my $item (@list) {
		$linkdebug && print "got color for $item: $color_names{$item}\n";
		( defined($color_names{$item}) ) && ($item = $color_names{$item} );
		($item == int($item) ) or carp("don't know what to do with color: $item\n");
		}
	$#list || return($list[0]);
	return(@list);

} # end subroutine color_translate definition
########################################################################

=head1 Various definitions

=head2 %color_names

Useful for humans.  Currently, these have to be statically defined here.
A better system might allow more spellings and user-defined names (maybe
loadable from a file.)

=cut

%color_names = (
	"byblock" => 0,
	"by block" => 0,
	"bylayer" => 256,
	"by layer" => 256,
	"red" => 1,
	"yellow" => 2,
	"green" => 3,
	"cyan" => 4,
	"blue" => 5,
	"magenta" => 6,
	"black" => 7,
	"darkgray" => 8,
	"darkgrey" => 8,
	"lightgray" => 9,
	"lightgrey" => 9,
	"charcoal" => 250,
	"white" => 255,
	);
########################################################################
# call syntax for add functions
# list only the non-standard options (as keys per the data-structure syntax)
# FIXME: need to define what is required separately from what is in the hash?
=head2 %call_syntax

used to allow other functions to decide how to handle various entities

=cut
%call_syntax = (
	"plines" 	=> 	[\&CAD::Drawing::addpolygon, "pts"],
	"lines" 	=>	[\&CAD::Drawing::addline, "pts"],
	"texts"	=>	[\&CAD::Drawing::addtext, "pt", "string"],
	"points"	=>	[\&CAD::Drawing::addpoint, "pt"],
	"circles"	=>	[\&CAD::Drawing::addcircle, "pt", "rad"],
	"arcs"	=>	[\&CAD::Drawing::addarc, "pt", "rad", "angs"],
	"images"	=>	[\&CAD::Drawing::addimage, "pt"],
	);
#"

%ac_storage_method = (
	plines => "ocs",
	lines => "wcs",
	texts => "ocs",
	circles => "ocs",
	arcs => "ocs",
	points => "wcs",
	);
#"
########################################################################
$pi = atan2(1,1) * 4;

########################################################################
=head1 Big Constant arrays

=head2 @aci2hex

256 value array which contains #RRGGBB photo-style hex codes for each
aci color.  This is mostly hand-mapped.

=cut

@aci2hex = (
                "#FFFFFF", "#ff0000", "#ffff00", "#00ff00", #   0 -   3
                "#00ffff", "#0000ff", "#ff00ff", "#ffffff", #   4 -   7
                "#b2b2b2", "#c0c0c0", "#ff0000", "#ff8080", #   8 -  11
                "#a60000", "#a65353", "#800000", "#804040", #  12 -  15
                "#4c0000", "#4c2626", "#260000", "#261313", #  16 -  19
                "#ff4000", "#ff9f80", "#a62900", "#a66853", #  20 -  23
                "#802000", "#805040", "#4c1300", "#4c3026", #  24 -  27
                "#260a00", "#261813", "#ff8000", "#ffbf80", #  28 -  31
                "#a65300", "#a67c53", "#804000", "#806040", #  32 -  35
                "#4c2600", "#4c3926", "#261300", "#261d13", #  36 -  39
                "#ffbf00", "#ffdf80", "#a67c00", "#a69153", #  40 -  43
                "#806000", "#807040", "#4c3900", "#4c4326", #  44 -  47
                "#261d00", "#262113", "#ffff00", "#ffff80", #  48 -  51
                "#a6a600", "#a6a653", "#808000", "#808040", #  52 -  55
                "#4c4c00", "#4c4c26", "#262600", "#262613", #  56 -  59
                "#bfff00", "#dfff80", "#7ca600", "#91a653", #  60 -  63
                "#608000", "#708040", "#394c00", "#434c26", #  64 -  67
                "#1d2600", "#212613", "#80ff00", "#bfff80", #  68 -  71
                "#53a600", "#7ca653", "#408000", "#608040", #  72 -  75
                "#264c00", "#394c26", "#132600", "#1d2613", #  76 -  79
                "#40ff00", "#9fff80", "#29a600", "#68a653", #  80 -  83
                "#208000", "#508040", "#134c00", "#304c26", #  84 -  87
                "#0a2600", "#182613", "#00ff00", "#80ff80", #  88 -  91
                "#00a600", "#53a653", "#008000", "#408040", #  92 -  95
                "#004c00", "#264c26", "#002600", "#132613", #  96 -  99
                "#00ff40", "#80ff9f", "#00a629", "#53a668", # 100 - 103
                "#008020", "#408050", "#004c13", "#264c30", # 104 - 107
                "#00260a", "#132618", "#00ff80", "#80ffbf", # 108 - 111
                "#00a653", "#53a67c", "#008040", "#408060", # 112 - 115
                "#004c26", "#264c39", "#002613", "#13261d", # 116 - 119
                "#00ffbf", "#80ffdf", "#00a67c", "#53a691", # 120 - 123
                "#008060", "#408070", "#004c39", "#264c43", # 124 - 127
                "#00261d", "#132621", "#00ffff", "#80ffff", # 128 - 131
                "#00a6a6", "#53a6a6", "#008080", "#408080", # 132 - 135
                "#004c4c", "#264c4c", "#002626", "#132626", # 136 - 139
                "#00bfff", "#80dfff", "#007ca6", "#5391a6", # 140 - 143
                "#006080", "#407080", "#00394c", "#26434c", # 144 - 147
                "#001d26", "#132126", "#0080ff", "#80bfff", # 148 - 151
                "#0053a6", "#537ca6", "#004080", "#406080", # 152 - 155
                "#00264c", "#26394c", "#001326", "#131d26", # 156 - 159
                "#0040ff", "#809fff", "#0029a6", "#5368a6", # 160 - 163
                "#002080", "#405080", "#00134c", "#26304c", # 164 - 167
                "#000a26", "#131826", "#0000ff", "#8080ff", # 168 - 171
                "#0000a6", "#5353a6", "#000080", "#404080", # 172 - 175
                "#00004c", "#26264c", "#000026", "#131326", # 176 - 179
                "#4000ff", "#9f80ff", "#2900a6", "#6853a6", # 180 - 183
                "#200080", "#504080", "#13004c", "#30264c", # 184 - 187
                "#0a0026", "#181326", "#8000ff", "#bf80ff", # 188 - 191
                "#5300a6", "#7c53a6", "#400080", "#604080", # 192 - 195
                "#26004c", "#39264c", "#130026", "#1d1326", # 196 - 199
                "#bf00ff", "#df80ff", "#7c00a6", "#9153a6", # 200 - 203
                "#600080", "#704080", "#39004c", "#43264c", # 204 - 207
                "#1d0026", "#211326", "#ff00ff", "#ff80ff", # 208 - 211
                "#a600a6", "#a653a6", "#800080", "#804080", # 212 - 215
                "#4c004c", "#4c264c", "#260026", "#261326", # 216 - 219
                "#ff00bf", "#ff80df", "#a6007c", "#a65391", # 220 - 223
                "#800060", "#804070", "#4c0039", "#4c2643", # 224 - 227
                "#26001d", "#261321", "#ff0080", "#ff80bf", # 228 - 231
                "#a60053", "#a6537c", "#800040", "#804060", # 232 - 235
                "#4c0026", "#4c2639", "#260013", "#26131d", # 236 - 239
                "#ff0040", "#ff809f", "#a60029", "#a65368", # 240 - 243
                "#800020", "#804050", "#4c0013", "#4c2630", # 244 - 247
                "#26000a", "#261318", "#545454", "#767676", # 248 - 251
                "#989898", "#bbbbbb", "#dddddd", "#000000", # 252 - 255
		"#000000" # FIXME:  By-Layer and By-Block colors have been set as white
                );
########################################################################

=head2 @aci2rgb

Generated from @aci2hex for use in postscript and other items.  The idea
here is that it is a fairly small set of values and may as well have
been generated and placed in this file, rather than constantly
loading-down the tight loop of saving values to postscript.

=cut
@aci2rgb = (
		[255, 255, 255], [255,   0,   0], [255, 255,   0], [  0, 255,   0],
		[  0, 255, 255], [  0,   0, 255], [255,   0, 255], [255, 255, 255],
		[178, 178, 178], [192, 192, 192], [255,   0,   0], [255, 128, 128],
		[166,   0,   0], [166,  83,  83], [128,   0,   0], [128,  64,  64],
		[ 76,   0,   0], [ 76,  38,  38], [ 38,   0,   0], [ 38,  19,  19],
		[255,  64,   0], [255, 159, 128], [166,  41,   0], [166, 104,  83],
		[128,  32,   0], [128,  80,  64], [ 76,  19,   0], [ 76,  48,  38],
		[ 38,  10,   0], [ 38,  24,  19], [255, 128,   0], [255, 191, 128],
		[166,  83,   0], [166, 124,  83], [128,  64,   0], [128,  96,  64],
		[ 76,  38,   0], [ 76,  57,  38], [ 38,  19,   0], [ 38,  29,  19],
		[255, 191,   0], [255, 223, 128], [166, 124,   0], [166, 145,  83],
		[128,  96,   0], [128, 112,  64], [ 76,  57,   0], [ 76,  67,  38],
		[ 38,  29,   0], [ 38,  33,  19], [255, 255,   0], [255, 255, 128],
		[166, 166,   0], [166, 166,  83], [128, 128,   0], [128, 128,  64],
		[ 76,  76,   0], [ 76,  76,  38], [ 38,  38,   0], [ 38,  38,  19],
		[191, 255,   0], [223, 255, 128], [124, 166,   0], [145, 166,  83],
		[ 96, 128,   0], [112, 128,  64], [ 57,  76,   0], [ 67,  76,  38],
		[ 29,  38,   0], [ 33,  38,  19], [128, 255,   0], [191, 255, 128],
		[ 83, 166,   0], [124, 166,  83], [ 64, 128,   0], [ 96, 128,  64],
		[ 38,  76,   0], [ 57,  76,  38], [ 19,  38,   0], [ 29,  38,  19],
		[ 64, 255,   0], [159, 255, 128], [ 41, 166,   0], [104, 166,  83],
		[ 32, 128,   0], [ 80, 128,  64], [ 19,  76,   0], [ 48,  76,  38],
		[ 10,  38,   0], [ 24,  38,  19], [  0, 255,   0], [128, 255, 128],
		[  0, 166,   0], [ 83, 166,  83], [  0, 128,   0], [ 64, 128,  64],
		[  0,  76,   0], [ 38,  76,  38], [  0,  38,   0], [ 19,  38,  19],
		[  0, 255,  64], [128, 255, 159], [  0, 166,  41], [ 83, 166, 104],
		[  0, 128,  32], [ 64, 128,  80], [  0,  76,  19], [ 38,  76,  48],
		[  0,  38,  10], [ 19,  38,  24], [  0, 255, 128], [128, 255, 191],
		[  0, 166,  83], [ 83, 166, 124], [  0, 128,  64], [ 64, 128,  96],
		[  0,  76,  38], [ 38,  76,  57], [  0,  38,  19], [ 19,  38,  29],
		[  0, 255, 191], [128, 255, 223], [  0, 166, 124], [ 83, 166, 145],
		[  0, 128,  96], [ 64, 128, 112], [  0,  76,  57], [ 38,  76,  67],
		[  0,  38,  29], [ 19,  38,  33], [  0, 255, 255], [128, 255, 255],
		[  0, 166, 166], [ 83, 166, 166], [  0, 128, 128], [ 64, 128, 128],
		[  0,  76,  76], [ 38,  76,  76], [  0,  38,  38], [ 19,  38,  38],
		[  0, 191, 255], [128, 223, 255], [  0, 124, 166], [ 83, 145, 166],
		[  0,  96, 128], [ 64, 112, 128], [  0,  57,  76], [ 38,  67,  76],
		[  0,  29,  38], [ 19,  33,  38], [  0, 128, 255], [128, 191, 255],
		[  0,  83, 166], [ 83, 124, 166], [  0,  64, 128], [ 64,  96, 128],
		[  0,  38,  76], [ 38,  57,  76], [  0,  19,  38], [ 19,  29,  38],
		[  0,  64, 255], [128, 159, 255], [  0,  41, 166], [ 83, 104, 166],
		[  0,  32, 128], [ 64,  80, 128], [  0,  19,  76], [ 38,  48,  76],
		[  0,  10,  38], [ 19,  24,  38], [  0,   0, 255], [128, 128, 255],
		[  0,   0, 166], [ 83,  83, 166], [  0,   0, 128], [ 64,  64, 128],
		[  0,   0,  76], [ 38,  38,  76], [  0,   0,  38], [ 19,  19,  38],
		[ 64,   0, 255], [159, 128, 255], [ 41,   0, 166], [104,  83, 166],
		[ 32,   0, 128], [ 80,  64, 128], [ 19,   0,  76], [ 48,  38,  76],
		[ 10,   0,  38], [ 24,  19,  38], [128,   0, 255], [191, 128, 255],
		[ 83,   0, 166], [124,  83, 166], [ 64,   0, 128], [ 96,  64, 128],
		[ 38,   0,  76], [ 57,  38,  76], [ 19,   0,  38], [ 29,  19,  38],
		[191,   0, 255], [223, 128, 255], [124,   0, 166], [145,  83, 166],
		[ 96,   0, 128], [112,  64, 128], [ 57,   0,  76], [ 67,  38,  76],
		[ 29,   0,  38], [ 33,  19,  38], [255,   0, 255], [255, 128, 255],
		[166,   0, 166], [166,  83, 166], [128,   0, 128], [128,  64, 128],
		[ 76,   0,  76], [ 76,  38,  76], [ 38,   0,  38], [ 38,  19,  38],
		[255,   0, 191], [255, 128, 223], [166,   0, 124], [166,  83, 145],
		[128,   0,  96], [128,  64, 112], [ 76,   0,  57], [ 76,  38,  67],
		[ 38,   0,  29], [ 38,  19,  33], [255,   0, 128], [255, 128, 191],
		[166,   0,  83], [166,  83, 124], [128,   0,  64], [128,  64,  96],
		[ 76,   0,  38], [ 76,  38,  57], [ 38,   0,  19], [ 38,  19,  29],
		[255,   0,  64], [255, 128, 159], [166,   0,  41], [166,  83, 104],
		[128,   0,  32], [128,  64,  80], [ 76,   0,  19], [ 76,  38,  48],
		[ 38,   0,  10], [ 38,  19,  24], [ 84,  84,  84], [118, 118, 118],
		[152, 152, 152], [187, 187, 187], [221, 221, 221], [  0,   0,   0],
		[255, 255, 255],
		);
########################################################################

=head2 regen_aci2rgb

Fairly self-explanatory.  Saved here only so I don't lose it.

=cut
# FIXME:  really should put this elsewhere (a BEGIN block!)
sub regen_aci2rgb {
	my $count = 0;
  my $per = 4;
	my $ts = 1;
	print "\@aci2rgb = (\n";
	for(my $i = 0; $i < @aci2hex; $i++) {
		my $hex = $aci2hex[$i];
		$hex =~ s/#(..)(..)(..)//;
		my ($red, $green, $blue) = ($1, $2, $3);
		($count % $per) || print "\t"x$ts;
		$count++;
		print "[" ,
				join(", ", map( { sprintf("%3d", hex($_)) }
														$red, $green, $blue)), "]";
		if($count % $per) {
			print ", ";
			}
		else {
			print ",\n";
			}
		}
	print "\n", "\t"x$ts, ");\n";
} # end subroutine regen_aci2rgb definition
########################################################################





########################################################################

1;