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