CAD::Drawing::Defined - exported constants for CAD::Drawing::*
Index
Code Index:
NAME
CAD::Drawing::Defined - exported constants for CAD::Drawing::*
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.
AUTHOR
Eric L. Wilhelm <ewilhelm at cpan dot org>
http://scratchcomputing.com
COPYRIGHT
This module is copyright (C) 2004-2006 by Eric L. Wilhelm. Portions
copyright (C) 2003 by Eric L. Wilhelm and A. Zahner Co.
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)
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.
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.
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.
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.
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);
color_translate
Translates a list of colors into numbers. Numbers will be passed
through (as will unrecognized names!)
@colors = color_translate(@colors);
Various definitions
%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.)
%call_syntax
used to allow other functions to decide how to handle various entities
Big Constant arrays
@aci2hex
256 value array which contains #RRGGBB photo-style hex codes for each
aci color. This is mostly hand-mapped.
@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.
regen_aci2rgb
Fairly self-explanatory. Saved here only so I don't lose it.
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);
########################################################################
########################################################################
########################################################################
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
########################################################################
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
########################################################################
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
########################################################################
%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?
%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;
########################################################################
@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
);
########################################################################
@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],
);
########################################################################
# 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;