1package Chart::Gnuplot::Util;
2use strict;
3use vars qw(@ISA @EXPORT_OK);
4use Exporter;
5
6@ISA = qw(Exporter);
7@EXPORT_OK = qw(_lineType _pointType _borderCode _fillStyle _copy);
8
9# Convert named line type to indexed line type of gnuplot
10#
11# XXX
12# Assuming postscript terminal is used
13# This may subjected to change when postscript/gnuplot changes its convention
14sub _lineType
15{
16	my ($type) = @_;
17	return($type) if ($type =~ /^\d+$/);
18
19	# Indexed line type of postscript terminal of gnuplot
20	my %type = (
21		solid          => 1,
22		longdash       => 2,
23		dash           => 3,
24		dot            => 4,
25		'dot-longdash' => 5,
26		'dot-dash'     => 6,
27		'2dash'        => 7,
28		'2dot-dash'    => 8,
29		'4dash'        => 9,
30	);
31	return($type{$type});
32}
33
34
35# Convert named line type to indexed line type of gnuplot
36#
37# XXX
38# Assuming postscript terminal is used
39# This may subjected to change when postscript/gnuplot changes its convention
40sub _pointType
41{
42	my ($type) = @_;
43	return($type) if ($type =~ /^\d+$/);
44
45	# Indexed line type of postscript terminal of gnuplot
46	my %type = (
47		dot               => 0,
48		plus              => 1,
49		cross             => 2,
50		star              => 3,
51		'dot-square'      => 4,
52		'dot-circle'      => 6,
53		'dot-triangle'    => 8,
54		'dot-diamond'     => 12,
55		'dot-pentagon'    => 14,
56		'fill-square'     => 5,
57		'fill-circle'     => 7,
58		'fill-triangle'   => 9,
59		'fill-diamond'    => 13,
60		'fill-pentagon'   => 15,
61		square            => 64,
62		circle            => 65,
63		triangle          => 66,
64		diamond           => 68,
65		pentagon          => 69,
66		'opaque-square'   => 70,
67		'opaque-circle'   => 71,
68		'opaque-triangle' => 72,
69		'opaque-diamond'  => 74,
70		'opaque-pentagon' => 75,
71	);
72	return($type{$type});
73}
74
75
76# Encode the border name
77# - Used by setting graph border display
78sub _borderCode
79{
80    my ($side) = @_;
81    return($side) if ($side =~ /^\d+$/);
82
83    my $code = 0;
84    $code += 1 if ($side =~ /(^|,)\s*(1|bottom|bottom left front)\s*(,|$)/);
85    $code += 2 if ($side =~ /(^|,)\s*(2|left|bottom left back)\s*(,|$)/);
86    $code += 4 if ($side =~ /(^|,)\s*(4|top|bottom right front)\s*(,|$)/);
87    $code += 8 if ($side =~ /(^|,)\s*(8|right|bottom right back)\s*(,|$)/);
88    $code += 16 if ($side =~ /(^|,)\s*(16|left vertical)\s*(,|$)/);
89    $code += 32 if ($side =~ /(^|,)\s*(32|back vertical)\s*(,|$)/);
90    $code += 64 if ($side =~ /(^|,)\s*(64|right vertical)\s*(,|$)/);
91    $code += 128 if ($side =~ /(^|,)\s*(128|front vertical)\s*(,|$)/);
92    $code += 256 if ($side =~ /(^|,)\s*(256|top left back)\s*(,|$)/);
93    $code += 512 if ($side =~ /(^|,)\s*(512|top right back)\s*(,|$)/);
94    $code += 1024 if ($side =~ /(^|,)\s*(1024|top left front)\s*(,|$)/);
95    $code += 2048 if ($side =~ /(^|,)\s*(2048|top right front)\s*(,|$)/);
96    return($code);
97}
98
99
100# Generate box filling style string
101# - called by _thaw() and _setObjOpt()
102sub _fillStyle
103{
104    my ($fill) = @_;
105
106    if (ref($fill) eq 'HASH')
107    {
108		my $style = "";
109		if (defined $$fill{pattern})
110		{
111			$style .= " transparent" if (defined $$fill{alpha} &&
112				$$fill{alpha} == 0);
113			$style .= " pattern $$fill{pattern}";
114		}
115		else
116		{
117			if (defined $$fill{alpha})
118			{
119				$style .= " transparent solid $$fill{alpha}";
120			}
121			elsif (defined $$fill{density})
122			{
123        		$style .= " solid $$fill{density}";
124			}
125			else
126			{
127				$style .= " solid 1";
128			}
129		}
130
131        $style .= " noborder" if (defined $$fill{border} &&
132            $$fill{border} =~ /^(off|no)$/);
133        return($style);
134    }
135
136    return(" $fill");
137}
138
139
140# Copy object using dclone() of Storable
141sub _copy
142{
143    my ($obj, $num) = @_;
144    use Storable;
145
146    my @clones = ();
147    $num = 1 if (!defined $num);
148
149    for (my $i = 0; $i < $num; $i++)
150    {
151        push(@clones, Storable::dclone($obj));
152    }
153    return(@clones);
154}
155
156
1571;
158
159__END__
160