File Coverage

blib/lib/PSGRAPH.pm
Criterion Covered Total %
statement 102 1340 7.6
branch 21 424 4.9
condition 0 72 0.0
subroutine 37 59 62.7
pod 0 51 0.0
total 160 1946 8.2


line stmt bran cond sub pod time code
1             package PSGRAPH;
2              
3 1     1   22866 use 5.8.8;
  1         3  
4 1     1   6 use strict;
  1         2  
  1         32  
5 1     1   6 use warnings;
  1         11  
  1         40  
6 1     1   6 use Carp;
  1         1  
  1         100  
7              
8             require Exporter;
9 1     1   896 use AutoLoader;
  1         1711  
  1         7  
10              
11             our @ISA = qw(Exporter);
12              
13             # Items to export into callers namespace by default. Note: do not export
14             # names by default without a very good reason. Use EXPORT_OK instead.
15             # Do not simply export all your public functions/methods/constants.
16              
17             # This allows declaration use PSGRAPH ':all';
18             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
19             # will save memory.
20             our %EXPORT_TAGS = ( 'all' => [ qw(
21            
22             ) ] );
23              
24             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
25              
26             our @EXPORT = qw(
27            
28             );
29              
30             our $VERSION = '0.04';
31              
32             # This is the default class for the CGI object to use when all else fails.
33             my $DefaultClass = 'PSGRAPH' unless defined $PSGRAPH::DefaultClass;
34              
35             sub new
36             {
37 1     1 0 8 my $class = shift;
38 1         2 my $self = {};
39 1         2 bless $self, $class;
40 1         2 return $self;
41             }
42             sub setData{
43 1     1 0 1275 my ( $self, $Data) = @_;
44 1 50       5 $self->{Data} = $Data if defined($Data);
45 1         2 return $self->{Data};
46             }
47             sub getData {
48 1     1 0 4 my( $self ) = @_;
49 1         3 return $self->{Data};
50             }
51             sub setGraphic{
52 2     2 0 1752 my ( $self, $Graphic) = @_;
53 2 50       7 $self->{Graphic} = $Graphic if defined($Graphic);
54 2         4 return $self->{Graphic};
55             }
56             sub getGraphic {
57 2     2 0 6 my( $self ) = @_;
58 2         3 return $self->{Graphic};
59             }
60             sub setLabelandColor{
61 1     1 0 7 my ( $self, $LabelandColor) = @_;
62 1 50       8 $self->{LabelandColor} = $LabelandColor if defined($LabelandColor);
63 1         2 return $self->{LabelandColor};
64             }
65             sub getLabelandColor {
66 1     1 0 5 my( $self ) = @_;
67 1         2 return $self->{LabelandColor};
68             }
69              
70             sub setPS {
71 1     1 0 400 my( $self, $graphic ) = @_;
72 1         1 my $subtype;
73 1 50       3 if(defined($self->getSubtype)){$subtype=$self->getSubtype; print "subtype is defined\n";}
  1         2  
  1         159  
74 1 50       24 if($graphic eq '2Dpie'){
    50          
    50          
75 0 0 0     0 if((defined($subtype) && $subtype==1) || !defined($subtype)){
    0 0        
    0          
    0          
    0          
    0          
76 0         0 $self->{PS} = 'gsave /radius 125 def /slicecount 1 def /pieslice {/label exch def /endangle exch def /startangle exch def /k exch def /y exch def /m exch def /c exch def /calloutline 29 def /labelpos 33 def 0 0 0 1 setcmykcolor .5 setlinewidth gsave 0 0 moveto /halfangle startangle endangle add 2 div def slicecount 2 mod 0 eq{/calloutline 15 def /labelpos 19 def}if halfangle startangle eq {halfangle rotate} {halfangle startangle gt {halfangle rotate}{/halfangle halfangle 180 add def halfangle rotate}ifelse}ifelse /checkangle halfangle def checkangle 360 gt {/checkangle checkangle cvi 360 mod def}if checkangle 90 gt { checkangle 110 lt{ /labelpos labelpos 4 add def }if checkangle 250 lt {checkangle 110 gt {/labelpos labelpos 8 add def}if}if}if checkangle 250 gt {/labelpos labelpos 14 add def}if radius calloutline add 0 lineto stroke grestore halfangle cos radius labelpos add mul typesize 3 checkangle 70 le {mul add}{div sub}ifelse halfangle sin radius labelpos add mul typesize 3 div sub moveto /Helvetica-Bold findfont typesize scalefont setfont ';
77             }elsif($subtype==2){
78 0         0 $self->{PS} = 'gsave /radius 125 def /slicecount 1 def /pieslice { /percent1 exch def /label1 exch def /endangle exch def /startangle exch def /k exch def /y exch def /m exch def /c exch def /calloutline 29 def /labelpos 33 def 0 0 0 1 setcmykcolor .5 setlinewidth /Helvetica-Bold findfont dup length dict begin {1 index /FID ne {def} {pop pop} ifelse}forall /Encoding ISOLatin1Encoding def currentdict end /Helvetica-Bold-ISOLatin1 exch definefont pop /Helvetica-Bold-ISOLatin1 findfont typesize scalefont setfont gsave 0 0 moveto /halfangle startangle endangle add 2 div def halfangle startangle eq {halfangle rotate} {halfangle startangle gt {halfangle rotate}{/halfangle halfangle 180 add def halfangle rotate}ifelse}ifelse radius calloutline add 0 lineto stroke grestore 0 0 0 1 setcmykcolor halfangle cos radius 45 add mul halfangle sin radius 45 add mul moveto gsave label1 dup stringwidth pop 2 div -1 mul 0 rmoveto show grestore gsave /percentline 1.2 def percent1 dup stringwidth pop 2 div -1 mul typesize percentline mul -1 mul rmoveto show grestore c m y k setcmykcolor 2 setlinejoin 0 0 moveto 0 0 radius startangle endangle arc closepath gsave fill grestore endangle startangle sub 360 ne { 0 0 0 0 setcmykcolor 1.5 setlinewidth stroke}if /slicecount slicecount 1 add def } def';
79             }elsif($subtype==3){
80 0         0 $self->{PS} = 'gsave /radius 125 def /typesize 8 def /slicecount 1 def /legendtype 16 def /legendbox 21 def /pieslice { /label exch def /endangle exch def /startangle exch def /k exch def /y exch def /m exch def /c exch def /calloutline 29 def /labelpos 33 def c m y k setcmykcolor 2 setlinejoin 0 0 moveto 0 0 radius startangle endangle arc closepath gsave fill grestore 0 0 0 0 setcmykcolor 1.5 setlinewidth stroke /slicecount slicecount 1 add def } def /legend { /vsize exch def /hsize exch def /leftright exch def /ystart exch def /xstart exch def /label exch def /k exch def /y exch def /m exch def /c exch def gsave xstart ystart moveto /legendtype1 legendtype vsize mul def /Helvetica findfont legendtype1 scalefont setfont leftright 1 eq { label stringwidth pop neg legendbox 2 mul sub 0 rmoveto } if /xstart currentpoint pop def 0 legendbox hsize mul rlineto legendbox vsize mul 0 rlineto /minuslegendbox{legendbox -1 mul} def 0 minuslegendbox hsize mul rlineto closepath c m y k setcmykcolor fill 0 0 0 1 setcmykcolor xstart legendbox 2 mul add ystart moveto gsave 1 hsize div 1 vsize div scale label show grestore grestore } def /legend_right { /vsize exch def /hsize exch def /ystart exch def /xstart exch def /label exch def /k exch def /y exch def /m exch def /c exch def gsave xstart ystart moveto /legendtype1 legendtype vsize mul def /Helvetica findfont legendtype1 scalefont setfont /xstart currentpoint pop def 0 legendbox hsize mul rlineto legendbox vsize mul 0 rlineto /minuslegendbox{legendbox -1 mul} def 0 minuslegendbox hsize mul rlineto closepath c m y k setcmykcolor fill 0 0 0 1 setcmykcolor xstart legendbox vsize mul 2 mul add ystart moveto gsave 1 hsize div 1 vsize div scale label show grestore grestore } def /legend_left { /vsize exch def /hsize exch def /ystart exch def /xstart exch def /label exch def /k exch def /y exch def /m exch def /c exch def gsave /xstart xstart 20 sub def xstart ystart moveto gsave 1 hsize div 1 vsize div scale /legendtype1 legendtype vsize mul def /Helvetica findfont legendtype1 scalefont setfont 0 0 0 1 setcmykcolor xstart hsize mul legendbox sub 10 sub label dup stringwidth pop -1 mul 0 rmoveto show 10 0 rmoveto legendbox vsize mul 0 rlineto 0 legendbox vsize mul rlineto /minuslegendbox{legendbox -1 mul} def minuslegendbox vsize mul 0 rlineto closepath c m y k setcmykcolor fill grestore grestore} def';
81             }elsif($subtype==31){
82 0         0 $self->{PS} = 'gsave /radius 125 def /typesize 14 def /slicecount 1 def /legendbox legendtype 3 add def /pieslice { /endangle exch def /startangle exch def /k exch def /y exch def /m exch def /c exch def /labelpos 39 def 0 0 0 1 setcmykcolor .5 setlinewidth c m y k setcmykcolor 2 setlinejoin 0 0 moveto 0 0 radius startangle endangle arc closepath gsave fill grestore 0 0 0 0 setcmykcolor 1.5 setlinewidth stroke /slicecount slicecount 1 add def } def /legend { /percent1 exch def /vsize exch def /hsize exch def /leftright exch def /ystart exch def /xstart exch def /label exch def /k exch def /y exch def /m exch def /c exch def gsave xstart ystart moveto /Helvetica-Bold findfont legendtype scalefont setfont leftright 1 eq { label stringwidth neg legendbox 2 mul sub 0 rmoveto } if /xstart currentpoint pop def 0 legendbox hsize mul rlineto legendbox vsize mul 0 rlineto /minuslegendbox{legendbox -1 mul} def 0 minuslegendbox hsize mul rlineto closepath c m y k setcmykcolor fill 0 0 0 1 setcmykcolor xstart legendbox vsize mul 2 mul add ystart moveto label show percent1 show grestore } def /legend_right { /percent1 exch def /vsize exch def /hsize exch def /ystart exch def /xstart exch def /label exch def /k exch def /y exch def /m exch def /c exch def gsave xstart ystart moveto /legendtype1 legendtype vsize mul def /Helvetica-Bold findfont legendtype1 scalefont setfont /xstart currentpoint pop def 0 legendbox hsize mul rlineto legendbox vsize mul 0 rlineto /minuslegendbox{legendbox -1 mul} def 0 minuslegendbox hsize mul rlineto closepath c m y k setcmykcolor fill 0 0 0 1 setcmykcolor xstart legendbox vsize mul 2 mul add ystart moveto gsave 1 hsize div 1 vsize div scale gsave label show percent1 show grestore grestore grestore } def grestore
83             ';
84             }elsif($subtype==4){
85 0         0 $self->{PS} = 'gsave /radius 125 def /slicecount 1 def /legendtype 16 def /legendbox 21 def /pieslice { /percent1 exch def /endangle exch def /startangle exch def /k exch def /y exch def /m exch def /c exch def /calloutline 29 def /labelpos 33 def 0 0 0 1 setcmykcolor .5 setlinewidth /Helvetica findfont dup length dict begin {1 index /FID ne {def} {pop pop} ifelse}forall /Encoding ISOLatin1Encoding def currentdict end /Helvetica-ISOLatin1 exch definefont pop /Helvetica-ISOLatin1 findfont typesize scalefont setfont gsave 0 0 moveto /halfangle startangle endangle add 2 div def halfangle startangle eq {halfangle rotate} {halfangle startangle gt {halfangle rotate}{/halfangle halfangle 180 add def halfangle rotate}ifelse}ifelse radius calloutline add 0 lineto stroke grestore 0 0 0 1 setcmykcolor halfangle cos radius 45 add mul halfangle sin radius 45 add mul moveto gsave percent1 dup stringwidth pop 2 div -1 mul 0 rmoveto show c m y k setcmykcolor 2 setlinejoin 0 0 moveto 0 0 radius startangle endangle arc closepath gsave fill grestore endangle startangle sub 360 ne { 0 0 0 0 setcmykcolor 1.5 setlinewidth stroke}if /slicecount slicecount 1 add def } def /legend { /vsize exch def /hsize exch def /leftright exch def /ystart exch def /xstart exch def /label exch def /k exch def /y exch def /m exch def /c exch def gsave xstart ystart moveto /legendtype1 legendtype vsize mul def /Helvetica findfont legendtype1 scalefont setfont leftright 1 eq { label stringwidth pop neg legendbox 2 mul sub 0 rmoveto } if /xstart currentpoint pop def 0 legendbox hsize mul rlineto legendbox vsize mul 0 rlineto /minuslegendbox{legendbox -1 mul} def 0 minuslegendbox hsize mul rlineto closepath c m y k setcmykcolor fill 0 0 0 1 setcmykcolor xstart legendbox 2 mul add ystart moveto gsave 1 hsize div 1 vsize div scale label show grestore grestore } def /legend_right { /vsize exch def /hsize exch def /ystart exch def /xstart exch def /label exch def /k exch def /y exch def /m exch def /c exch def gsave xstart ystart moveto /legendtype1 legendtype vsize mul def /Helvetica findfont legendtype1 scalefont setfont /xstart currentpoint pop def 0 legendbox hsize mul rlineto legendbox vsize mul 0 rlineto /minuslegendbox{legendbox -1 mul} def 0 minuslegendbox hsize mul rlineto closepath c m y k setcmykcolor fill 0 0 0 1 setcmykcolor xstart legendbox vsize mul 2 mul add ystart moveto gsave 1 hsize div 1 vsize div scale label show grestore grestore } def /legend_left { /vsize exch def /hsize exch def /ystart exch def /xstart exch def /label exch def /k exch def /y exch def /m exch def /c exch def gsave /xstart xstart 20 sub def xstart ystart moveto gsave 1 hsize div 1 vsize div scale /legendtype1 legendtype vsize mul def /Helvetica findfont legendtype1 scalefont setfont 0 0 0 1 setcmykcolor xstart hsize mul legendbox sub 10 sub label dup stringwidth pop -1 mul 0 rmoveto show 10 0 rmoveto legendbox vsize mul 0 rlineto 0 legendbox vsize mul rlineto /minuslegendbox{legendbox -1 mul} def minuslegendbox vsize mul 0 rlineto closepath c m y k setcmykcolor fill grestore grestore} def';
86             }elsif($subtype==5){
87 0         0 $self->{PS} = ' gsave /radius 125 def /slicecount 1 def /pieslice { /sectionanchor exch def /explodeoffset exch def /label exch def /endangle exch def /startangle exch def /k exch def /y exch def /m exch def /c exch def gsave sectionanchor cos explodeoffset mul sectionanchor sin explodeoffset mul translate 0 0 moveto /Helvetica-Bold findfont typesize scalefont setfont '
88             }else{
89 0         0 $self->{PS} = 'ERROR: Unsupported subtype.';
90             }
91             }elsif($graphic eq '2Dbar'){
92 0 0 0     0 if((defined($subtype) && $subtype==1) || !defined($subtype)){
      0        
93 0         0 $self->{PS} = '/typecolor {0 setgray} def /straighttype {/stst exch def gsave 1 hsize div 1 vsize div scale stst show grestore} def /rectoffset 2 def /Helvetica findfont 9 scalefont setfont /centertype { /hpos exch def /cpos exch def /ctstring exch def ctstring stringwidth pop 2 div cpos exch sub hpos moveto ctstring straighttype} def /fillrect { /rectheight exch def /rectwidth exch def /lly exch def /llx exch def llx lly moveto 0 rectheight rlineto rectwidth 0 rlineto 0 rectheight neg rlineto closepath fill }def /outlinerect {/rectheight exch def /rectwidth exch def /lly exch def /llx exch def llx lly moveto 0 rectheight rlineto rectwidth 0 rlineto 0 rectheight neg rlineto closepath stroke } def /bar { /barwidth exch def /barstart exch def /l2 exch def /l1 exch def /barvalue exch def /barlength exch def /pos exch def /k exch def /y exch def /m exch def /c exch def /st barstart def headertype l1 0 st barwidth 3 div add 12 add moveto straighttype l2 0 st barwidth 3 div add moveto straighttype valuecolor valuetype barvalue 80 barlength add barstart barwidth 3 div add moveto straighttype c m y k setcmykcolor 72 st barlength barwidth fillrect } def /bkgroundbox { /bheight exch def /bwidth exch def /by exch def /bx exch def bkground bx by bwidth bheight fillrect .5 setlinewidth typecolor bx by moveto 0 bheight rlineto bwidth 0 rlineto 0 bheight neg rlineto closepath stroke } def /chartscale { /vsize exch def /hsize exch def /barwidth exch def /bardepth exch def /val5 exch def /val4 exch def /val3 exch def /val2 exch def /val1 exch def /val0 exch def axistype typecolor .5 setlinewidth /fifthline {barwidth 5 div} def 0 fifthline barwidth { /x exch def 71 x add 0 moveto gsave 0 bardepth rlineto stroke grestore } for val0 71 -12 centertype val1 71 fifthline add -12 centertype val2 71 fifthline 2 mul add -12 centertype val3 71 fifthline 3 mul add -12 centertype val4 71 fifthline 4 mul add -12 centertype val5 71 fifthline 5 mul add -12 centertype } def';
94             }else{
95 0         0 $self->{PS} = 'ERROR: Unsupported subtype.';
96             }
97             }elsif($graphic eq '2Dcolumn'){
98 0 0 0     0 if((defined($subtype) && $subtype==1) || !defined($subtype)){
      0        
99 0         0 $self->{PS} = '/shadowblk 0.5 def /typecolor {0 setgray} def /straighttype {/stst exch def gsave 1 hsize div 1 vsize div scale stst show grestore} def/rectoffset 2 def /Helvetica findfont 9 scalefont setfont /centertype { /hpos exch def /cpos exch def /ctstring exch def ctstring stringwidth pop 2 div cpos exch sub hpos moveto ctstring straighttype} def /fillrect { /rectheight exch def /rectwidth exch def /lly exch def /llx exch def llx lly moveto 0 rectheight rlineto rectwidth 0 rlineto 0 rectheight neg rlineto closepath fill }def /column { /ccwidth exch def /cstart exch def /l2 exch def /l1 exch def /cvalue exch def /height exch def /pos exch def /k exch def /y exch def /m exch def /c exch def /st cstart def headertype l1 st ccwidth 2 div add 262 vsize mul 12 add centertype l2 st ccwidth 2 div add 262 vsize mul centertype typecolor valuetype cvalue st ccwidth 2 div add 226 vsize mul centertype /blkstep{ shadowblk k sub ccwidth 3 div div } def /shadowblk1 shadowblk def 1 1 ccwidth 3 div{ c m y shadowblk1 setcmykcolor st 0 1 height fillrect /st st 1 add def /shadowblk1 shadowblk1 blkstep sub def }for c m y shadowblk1 setcmykcolor st 0 ccwidth 3 div height fillrect /st st ccwidth 3 div add def 1 1 ccwidth 3 div{ c m y shadowblk1 setcmykcolor st 0 1 height fillrect /st st 1 add def /shadowblk1 shadowblk1 blkstep add def }for } def /bkgroundbox { /bheight exch def /bwidth exch def /by exch def /bx exch def bkground bx by bwidth bheight fillrect .5 setlinewidth typecolor bx by moveto 0 bheight rlineto bwidth 0 rlineto 0 bheight neg rlineto closepath stroke } def /chartscale { /vsize exch def /hsize exch def /cwidth exch def /val5 exch def /val4 exch def /val3 exch def /val2 exch def /val1 exch def /val0 exch def axistype typecolor .5 setlinewidth 0 43 vsize mul 214 vsize mul 1 sub { /y exch def 71 y moveto cwidth 0 rlineto } for stroke val0 dup gsave 1 hsize div 1 scale stringwidth grestore pop 69 exch sub 0 moveto straighttype val1 dup gsave 1 hsize div 1 scale stringwidth grestore pop 69 exch sub 41 vsize mul moveto straighttype val2 dup gsave 1 hsize div 1 scale stringwidth grestore pop 69 exch sub 84 vsize mul moveto straighttype val3 dup gsave 1 hsize div 1 scale stringwidth grestore pop 69 exch sub 127 vsize mul moveto straighttype val4 dup gsave 1 hsize div 1 scale stringwidth grestore pop 69 exch sub 170 vsize mul moveto straighttype val5 dup gsave 1 hsize div 1 scale stringwidth grestore pop 69 exch sub 213 vsize mul moveto straighttype } def';
100             }else{
101 0         0 $self->{PS} = 'ERROR: Unsupported subtype.';
102             }
103             }else{
104 1         2 $self->{PS} = 'ERROR: Unsupported graphic.';
105             }
106 1         4 return $self->{PS};
107             }
108             sub getPS{
109 0     0 0 0 my($self)=@_;
110 0         0 return $self->{PS};
111             }
112             sub setSubtype{
113 1     1 0 404 my ( $self, $Subtype) = @_;
114 1 50       5 $self->{Subtype} = $Subtype if defined($Subtype);
115 1         3 return $self->{Subtype};
116             }
117             sub getSubtype {
118 3     3 0 7 my( $self ) = @_;
119 3         9 return $self->{Subtype};
120             }
121             sub setHscale{
122 1     1 0 438 my ( $self, $hscale) = @_;
123 1 50       6 $self->{Hscale} = $hscale if defined($hscale);
124 1         1 return $self->{Hscale};
125             }
126             sub getHscale {
127 1     1 0 4 my( $self ) = @_;
128 1         2 return $self->{Hscale};
129             }
130             sub setVscale{
131 1     1 0 418 my ( $self, $vscale) = @_;
132 1 50       5 $self->{Vscale} = $vscale if defined($vscale);
133 1         1 return $self->{Vscale};
134             }
135             sub getVscale {
136 1     1 0 4 my( $self ) = @_;
137 1         2 return $self->{Vscale};
138             }
139             sub setInitialdegree{
140 0     0 0 0 my ( $self, $initialdegree) = @_;
141 0 0       0 $self->{Initialdegree} = $initialdegree if defined($initialdegree);
142 0         0 return $self->{Initialdegree};
143             }
144             sub getInitialdegree {
145 0     0 0 0 my( $self ) = @_;
146 0         0 return $self->{Initialdegree};
147             }
148             sub setGexport{
149 0     0 0 0 my ( $self, $gexport) = @_;
150 0 0       0 $self->{Gexport} = $gexport if defined($gexport);
151 0         0 return $self->{Gexport};
152             }
153             sub getGexport {
154 0     0 0 0 my( $self ) = @_;
155 0         0 return $self->{Gexport};
156             }
157             sub setLegend{
158 0     0 0 0 my ( $self, $legend) = @_;
159 0 0       0 $self->{Legend} = $legend if defined($legend);
160 0         0 return $self->{Legend};
161             }
162             sub getLegend {
163 0     0 0 0 my( $self ) = @_;
164 0         0 return $self->{Legend};
165             }
166             sub setColumnwidth {
167 1     1 0 792 my ( $self, $columnwidth) = @_;
168 1 50       6 $self->{Columnwidth} = $columnwidth if defined($columnwidth);
169 1         2 return $self->{Columnwidth};
170             }
171             sub getColumnwidth {
172 1     1 0 5 my( $self ) = @_;
173 1         2 return $self->{Columnwidth};
174             }
175             sub setFormat {
176 1     1 0 402 my ( $self, $format) = @_;
177 1 50       6 $self->{Format} = $format if defined($format);
178 1         3 return $self->{Format};
179             }
180             sub getFormat {
181 1     1 0 4 my( $self ) = @_;
182 1         2 return $self->{Format};
183             }
184             sub setHeadertype {
185 1     1 0 411 my ( $self, $headertype) = @_;
186 1 50       5 $self->{Headertype} = $headertype if defined($headertype);
187 1         2 return $self->{Headertype};
188             }
189             sub getHeadertype {
190 1     1 0 4 my( $self ) = @_;
191 1         3 return $self->{Headertype};
192             }
193             sub setAxistype {
194 1     1 0 437 my ( $self, $axistype) = @_;
195 1 50       6 $self->{Axistype} = $axistype if defined($axistype);
196 1         2 return $self->{Axistype};
197             }
198             sub getAxistype {
199 1     1 0 4 my( $self ) = @_;
200 1         2 return $self->{Axistype};
201             }
202             sub setValuetype {
203 1     1 0 404 my ( $self, $valuetype) = @_;
204 1 50       5 $self->{Valuetype} = $valuetype if defined($valuetype);
205 1         2 return $self->{Valuetype};
206             }
207             sub getValuetype {
208 1     1 0 4 my( $self ) = @_;
209 1         2 return $self->{Valuetype};
210             }
211             sub setValuecolor {
212 1     1 0 396 my ( $self, $valuetype) = @_;
213 1 50       5 $self->{Valuecolor} = $valuetype if defined($valuetype);
214 1         2 return $self->{Valuecolor};
215             }
216             sub getValuecolor {
217 1     1 0 4 my( $self ) = @_;
218 1         2 return $self->{Valuecolor};
219             }
220             sub setBackgroundcolor {
221 1     1 0 392 my ( $self, $backgroundcolor) = @_;
222 1 50       5 $self->{Backgroundcolor} = $backgroundcolor if defined($backgroundcolor);
223 1         2 return $self->{Backgroundcolor};
224             }
225             sub getBackgroundcolor {
226 1     1 0 3 my( $self ) = @_;
227 1         2 return $self->{Backgroundcolor};
228             }
229             sub setHeadercolor {
230 1     1 0 406 my ( $self, $headercolor) = @_;
231 1 50       7 $self->{Headercolor} = $headercolor if defined($headercolor);
232 1         2 return $self->{Headercolor};
233             }
234             sub getHeadercolor {
235 1     1 0 4 my( $self ) = @_;
236 1         3 return $self->{Headercolor};
237             }
238             sub setExplodeoffset{
239 0     0 0 0 my ( $self, $explodeoffset) = @_;
240 0 0       0 $self->{Explodeoffset} = $explodeoffset if defined($explodeoffset);
241 0         0 return $self->{Explodeoffset};
242             }
243             sub getExplodeoffset {
244 0     0 0 0 my( $self ) = @_;
245 0         0 return $self->{Explodeoffset};
246             }
247             sub showInfo{
248 0     0 0 0 my( $self ) = @_;
249 0         0 print "LabelandColor: " . $self->getLabelandColor . "\n";
250 0         0 print "Data: " . $self->getData . "\n";
251 0         0 print "Graphic: " . $self->getGraphic . "\n";
252 0         0 print "PS: " . $self->getPS . "\n";
253 0 0       0 if(defined($self->getSubtype)){print "Subtype: " . $self->getSubtype . "\n";}else{print "Subtype: Not Defined\n";}
  0         0  
  0         0  
254 0 0       0 if(defined($self->getHscale)){print "Hscale: " . $self->getHscale . "\n";}else{print "Hscale: Not Defined\n";}
  0         0  
  0         0  
255 0 0       0 if(defined($self->getVscale)){print "Vscale: " . $self->getVscale . "\n";}else{print "Vscale: Not Defined\n";};
  0         0  
  0         0  
256 0 0       0 if(defined($self->getGexport)){print "Gexport: " . $self->getGexport . "\n";}else{print "Gexport: Not Defined\n";}
  0         0  
  0         0  
257 0 0       0 if(defined($self->getLegend)){print "Legend: " . $self->getLegend . "\n";}else{print "Legend: Not Defined\n";}
  0         0  
  0         0  
258 0 0       0 if(defined($self->getColumnwidth)){print "Columnwidth: " . $self->getColumnwidth . "\n";}else{print "Columnwidth: Not Defined\n";}
  0         0  
  0         0  
259 0 0       0 if(defined($self->getFormat)){print "Format: " . $self->getFormat . "\n";}else{print "Format: Not Defined\n";}
  0         0  
  0         0  
260 0 0       0 if(defined($self->getHeadertype)){print "Headertype: " . $self->getHeadertype . "\n";}else{print "Headertype: Not Defined\n";}
  0         0  
  0         0  
261 0 0       0 if(defined($self->getAxistype)){print "Axistype: " . $self->getAxistype . "\n";}else{print "Axistype: Not Defined\n";}
  0         0  
  0         0  
262 0 0       0 if(defined($self->getValuetype)){print "Valuetype: " . $self->getValuetype . "\n";}else{print "Valuetype: Not Defined\n";}
  0         0  
  0         0  
263 0 0       0 if(defined($self->getBackgroundcolor)){print "Backgroundcolor: " . $self->getBackgroundcolor . "\n";}else{print "Backgroundcolor: Not Defined\n";}
  0         0  
  0         0  
264 0 0       0 if(defined($self->getHeadercolor)){print "Headercolor: " . $self->getHeadercolor . "\n";}else{print "Headercolor: Not Defined\n";}
  0         0  
  0         0  
265 0 0       0 if(defined($self->getExplodeoffset)){print "Explodeoffset: " . $self->getExplodeoffset . "\n";}else{print "Explodeoffset: Not Defined\n";}
  0         0  
  0         0  
266 0 0       0 if(defined($self->getInitialdegree)){print "Initialdegree: " . $self->getInitialdegree . "\n";}else{print "Initialdegree: Not Defined\n";}
  0         0  
  0         0  
267             }
268             sub writeGraphic {
269 1     1 0 5 my( $self ) = @_;
270 1 50       9 if($self->{Graphic} eq '2Dpie'){
    50          
    50          
271             #translate data into degrees in a circle for pie
272 0         0 my $transdata=&data2degrees($self->{Data});
273 0 0 0     0 if(defined($self->{Data}) && defined($self->{LabelandColor})){
274 0 0       0 if(!defined($self->{Hscale})){$self->{Hscale}=1;}
  0         0  
275 0 0       0 if(!defined($self->{Vscale})){$self->{Vscale}=1;}
  0         0  
276 0 0       0 if(!defined($self->{Gexport})){$self->{Gexport}='';}
  0         0  
277 0 0       0 if(!defined($self->{Valuetype})){$self->{Valuetype}=8;}
  0         0  
278 0 0       0 if(!defined($self->{Explodeoffset})){$self->{Expoldeoffset}=12;}
  0         0  
279 0 0       0 if(!defined($self->{Initialdegree})){$self->{Initialdegree}=120;}
  0         0  
280 0 0 0     0 if((defined($self->{Subtype}) && $self->{Subtype}==1) || !defined($self->{Subtype})){
    0 0        
    0 0        
    0 0        
      0        
      0        
281 0         0 return &pie1($self->{Initialdegree},$self->{PS}, $transdata, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport}, $self->{Valuetype});
282             }elsif((defined($self->{Subtype}) && $self->{Subtype}==2)){
283 0         0 return &pie2($self->{Initialdegree},$self->{PS}, $transdata, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport}, $self->{Valuetype});
284             }elsif(defined($self->{Subtype}) && ($self->{Subtype}==3 || $self->{Subtype}==31 || $self->{Subtype}==4)){
285 0 0       0 if(!defined($self->{Legend})){$self->setLegend('right');}
  0         0  
286 0         0 my $leg=$self->getLegend;
287 0 0 0     0 if($leg eq 'right' || $leg eq 'left' || $leg eq 'bottom'){
      0        
288 0 0       0 if($self->{Subtype}==3){
    0          
    0          
289 0         0 return &pie3($self->{Initialdegree},$self->{PS}, $transdata, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport}, $self->getLegend);
290             }elsif($self->{Subtype}==31){
291 0         0 return &pie31($self->{Initialdegree},$self->{PS}, $transdata, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport}, $self->getLegend, $self->{Valuetype});
292             }elsif($self->{Subtype}==4){
293 0         0 return &pie4($self->{Initialdegree},$self->{PS}, $transdata, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport}, $self->getLegend, $self->{Valuetype});
294             }
295             }else{
296 0         0 return "Legend must be right, left or bottom.";
297             }
298             }elsif((defined($self->{Subtype}) && $self->{Subtype}==5)){
299             #set centers for section translations for exploded pies
300             #step through slices and add degrees to combine them into sections
301 0         0 my $sectionends="";
302 0         0 my @sectionarray="";
303 0         0 my $sectionend;
304             my $sectioncenters;
305 0         0 my $currentsection=1;
306 0         0 my $currentslice=0;
307 0         0 my @lc;
308             my @da;
309 0         0 my $dalength;
310 0         0 my $transdata1='trans1';
311             #create an string, comma delimited, with the field numbers of the end sections
312 0 0       0 open(LC,$self->{LabelandColor}) || die "Cannot open LabelAndColor!\n";
313 0         0 while(){
314 0         0 @lc = split/\t/;
315 0         0 chomp;
316 0         0 $currentslice++;
317 0 0       0 if($lc[5] != $currentsection){
318 0         0 $sectionend=int($currentslice)-1;
319 0 0       0 if(length($sectionends)>0){$sectionends.=",";}
  0         0  
320 0         0 $sectionends.=$sectionend;
321 0         0 $currentsection=$lc[5];
322             }
323             }
324 0         0 $sectionends.="," . $currentslice;
325             #add the halfangles of the sections in a comma delimited string to the end of the row in transdata
326 0 0       0 open(TRANS, "<$transdata") || die "Cannot open transdata for reading!\n";
327 0 0       0 open(TRANSPLUS, ">$transdata1") || die "Cannot open transdata1 for writing!\n";
328 0         0 my $sectionmiddle="";
329 0         0 while(){
330 0         0 chomp;
331 0         0 my $dataline=$_;
332 0         0 @da = split/\t/;
333 0         0 $dalength=@da;
334 0         0 @sectionarray=split/,/,$sectionends;
335 0         0 my $salength=@sectionarray;
336 0         0 my $secdegrees=0;
337 0         0 my $lastsection=0;
338 0         0 my $thissection=0;
339 0         0 my $jj=$sectionarray[$thissection];
340 0         0 for(my $ii=0; $ii<$dalength ; $ii++){
341 0 0       0 if($ii==$jj){
342 0 0       0 if(length($sectionmiddle)>0){$sectionmiddle.=',';}
  0         0  
343 0         0 $sectionmiddle.=(.5)*($secdegrees+$lastsection);
344 0         0 $lastsection=$secdegrees;
345 0         0 $thissection++;
346 0         0 $jj=$sectionarray[$thissection];
347 0 0       0 if($thissection==($salength-1)){
348 0         0 $sectionmiddle.="," . (.5)*(360+$secdegrees);
349 0         0 last;
350             }
351             }
352 0         0 $secdegrees+=$da[$ii];
353             }
354 0         0 print TRANSPLUS $dataline . "\t$sectionmiddle\n";
355 0         0 $sectionmiddle="";
356             }
357 0         0 close TRANSPLUS;
358 0         0 return &pie5($self->{Initialdegree},$self->{PS}, $transdata1, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport}, $self->{Valuetype}, $self->{Explodeoffset}, $sectionends);
359             }
360             }else{
361 0         0 return "Both the data file (setData) and the color file (setLabelandColor) must be defined.";
362             }
363             }elsif($self->{Graphic} eq '2Dcolumn'){
364 0 0 0     0 if(defined($self->{Data}) && defined($self->{LabelandColor})){
365 0 0       0 if(!defined($self->{Hscale})){$self->{Hscale}=1;}
  0         0  
366 0 0       0 if(!defined($self->{Vscale})){$self->{Vscale}=1;}
  0         0  
367 0 0       0 if(!defined($self->{Gexport})){$self->{Gexport}='';}
  0         0  
368 0 0       0 if(!defined($self->{Columnwidth})){$self->{Columnwidth}=36;}
  0         0  
369 0 0       0 if(!defined($self->{Format})){$self->{Format}="money";}
  0         0  
370 0 0       0 if(!defined($self->{Headertype})){$self->{Headertype}=9;}
  0         0  
371 0 0       0 if(!defined($self->{Valuetype})){$self->{Valuetype}=9;}
  0         0  
372 0 0       0 if(!defined($self->{Axistype})){$self->{Axistype}=8;}
  0         0  
373 0 0       0 if(!defined($self->{Backgroundcolor})){$self->{Backgroundcolor}='.3 0 .15 .09';}
  0         0  
374 0 0       0 if(!defined($self->{Headercolor})){$self->{Headercolor}='0 0 0 1';}
  0         0  
375 0 0 0     0 if((defined($self->{Subtype}) && $self->{Subtype}==1) || !defined($self->{Subtype})){
      0        
376 0         0 return &column1($self->{PS}, $self->{Data}, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport},$self->{Columnwidth}, $self->{Format}, $self->{Headertype}, $self->{Axistype}, $self->{Valuetype}, $self->{Backgroundcolor}, $self->{Headercolor});
377             }
378             }else{
379 0         0 return "Both the data file (setData) and the color file (setLabelandColor) must be defined.";
380             }
381             }elsif($self->{Graphic} eq '2Dbar'){
382 0 0 0     0 if(defined($self->{Data}) && defined($self->{LabelandColor})){
383 0 0       0 if(!defined($self->{Hscale})){$self->{Hscale}=1;}
  0         0  
384 0 0       0 if(!defined($self->{Vscale})){$self->{Vscale}=1;}
  0         0  
385 0 0       0 if(!defined($self->{Gexport})){$self->{Gexport}='';}
  0         0  
386 0 0       0 if(!defined($self->{Columnwidth})){$self->{Columnwidth}=36;}
  0         0  
387 0 0       0 if(!defined($self->{Format})){$self->{Format}="money";}
  0         0  
388 0 0       0 if(!defined($self->{Headertype})){$self->{Headertype}=9;}
  0         0  
389 0 0       0 if(!defined($self->{Valuetype})){$self->{Valuetype}=9;}
  0         0  
390 0 0       0 if(!defined($self->{Valuecolor})){$self->{Valuecolor}=0;}
  0         0  
391 0 0       0 if(!defined($self->{Axistype})){$self->{Axistype}=8;}
  0         0  
392 0 0       0 if(!defined($self->{Backgroundcolor})){$self->{Backgroundcolor}='.3 0 .15 .09';}
  0         0  
393 0 0       0 if(!defined($self->{Headercolor})){$self->{Headercolor}='0 0 0 1';}
  0         0  
394 0 0 0     0 if((defined($self->{Subtype}) && $self->{Subtype}==1) || !defined($self->{Subtype})){
      0        
395 0         0 return &bar1($self->{PS}, $self->{Data}, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport},$self->{Columnwidth}, $self->{Format}, $self->{Headertype}, $self->{Axistype}, $self->{Valuetype}, $self->{Backgroundcolor}, $self->{Headercolor}, $self->{Valuecolor});
396             }
397             }else{
398 0         0 return "Both the data file (setData) and the color file (setLabelandColor) must be defined.";
399             }
400             }else{
401 1         3 return "Cannot write undefined graphic!";
402             }
403             }
404             sub data2degrees {
405 0     0 0   my ($data) = @_;
406 0           my $trans="trans";
407 0           my @totaldata;
408 0 0         open(DATA, "./" . $data) || die "Could not open ./$data file!\n";
409 0 0         open(TRANS, ">$trans") || die "Could not open trans file for writing!\n";
410 0 0         open(DATA1, "+>data1") || die "Could not open data1 file for writing!\n";
411             #sum the slices to create a totals field
412 0           my @sum;
413             my @drow1;
414 0           while(){
415 0           my @drow=split ("\t", $_);
416 0           my $total=0;
417 0           my $drow1='';
418 0           my $ddd=@drow-1;
419 0           chomp($ddd);
420             #find the largest slice
421 0           for(my $a=0; $a<@drow-1; $a++){
422 0           $sum[$a]+=$drow[$a];
423 0           $total+=$drow[$a];
424 0 0         if($drow1 eq ''){
425 0           $drow1.=$drow[$a];
426             }else{
427 0           $drow1.="\t" . $drow[$a];
428             }
429             }
430             #chomp($drow[@drow-1]);
431 0           $drow1.="\t" . $drow[$ddd];
432 0           chomp($drow1);
433 0           $drow1.="\t" . $total;
434 0           print DATA1 $drow1 . "\n";
435             }
436 0           my $largest;
437 0           my $lvalue=0;
438 0           for($b=0; $b<@sum; $b++){
439 0 0         if($sum[$b]>$lvalue){
440 0           $lvalue=$sum[$b];
441 0           $largest=$b;
442             }
443             }
444 0           seek DATA1, 0, 0;
445 0           while(){
446 0           my @crow=split ("\t", $_);
447 0           my @d;
448 0           my $otherdegrees=0;
449 0           for(my $c=0; $c<@crow-2; $c++){
450 0 0         if($c!=$largest){
451 0           $d[$c]=360*$crow[$c]/$crow[@crow-1];
452 0 0         if($d[$c]>0){
453 0 0         if($d[$c]<3.6){$d[$c]=3.6;}
  0            
454 0           $otherdegrees+=$d[$c];
455             }
456             }
457             }
458 0           $d[$largest]=360-$otherdegrees;
459 0           push @d, $crow[@crow-2];
460 0           print TRANS join("\t",@d) . "\n";
461 0           print join("\t",@d) . "\n";
462             }
463 0           close TRANS;
464 0           return $trans;
465             }
466             sub pie1{
467 0     0 0   my ($startingangle,$ps, $data, $labelandcolor, $hscale, $vscale, $gexport, $valuetype) = @_;
468 0 0         my $slicecounter; my $piefile; my $piececount; my $thisdate = scalar localtime; my $piedirectory="pies/"; my @slice; my $slicecnt; my $piefileextension="eps"; my $hsize=$hscale; my $vsize=$vscale; my $yend; my $labelmax=0; my $labelx; open(LABELANDCOLOR, "<$labelandcolor") or die("Couldn't open $labelandcolor\n"); while() {$_=~s/\t.*//; $_=~s/ *$//; chomp; $labelx=length($_)+10; if($labelx>$labelmax){$labelmax=$labelx; } $piececount++;} close(LABELANDCOLOR); my $xstart=int(306-($hsize*350/2)-($labelmax*$hsize)); my $xend=int(306+($hsize*350/2)+($labelmax*$hsize)); my $ystart=int(396-($vsize*350/2)-($labelmax*$vsize)); $yend=int(396+($vsize*350/2)+($labelmax*$vsize)); my @lclines; my $lclines; my $label; my $c; my $m; my $y; my $k; my $thisendangle; my $thisslice; my $thisstartangle; my $filewithdir; my $thispiefile; open(PIECHARTDATA, "<$data") || die "Couldn't open $data\n"; while() {chomp; @slice=split/\t/,$_; $slicecnt=@slice; $piefile=$slice[$slicecnt-1]; $thisslice=$slice[0]; $slicecounter=0; $thispiefile=$piefile.".".$piefileextension; $filewithdir=$piedirectory.$thispiefile; open(PIE, ">$filewithdir") or die("Couldn't create output file: ".$thispiefile); print PIE "%!PS-ADOBE 3.0 EPSF-3.0\n"; print PIE "%%Title: ".$thispiefile."\n"; print PIE "%%Creator: createpies.pl (c)Ken Owen 1999-2016\n"; print PIE "%%Creationdate: ".$thisdate."\n"; print PIE "%%BoundingBox: $xstart $ystart $xend $yend\n\n"; print PIE "/typesize " . $valuetype . " def\n"; print PIE $ps; print PIE "gsave 1 $hscale div 1 $vscale div scale label dup stringwidth pop checkangle 110 lt {2 div}if checkangle 250 gt {2 div}if -1 mul 2 rmoveto show grestore c m y k setcmykcolor 2 setlinejoin 0 0 moveto 0 0 radius startangle endangle arc closepath gsave fill grestore 0 0 0 0 setcmykcolor 1.5 setlinewidth stroke /slicecount slicecount 1 add def} def\n"; print PIE "\n%%set scale and translation\n"; print PIE "306 396 translate $hsize $vsize scale\n"; $thisstartangle=$startingangle; open(LABELANDCOLOR, "<$labelandcolor") or die("Couldn't open $labelandcolor"); my $counter=0; while () { chomp; $lclines[$counter]=$_; $counter++; } foreach $lclines(@lclines){ ($label, $c, $m, $y, $k)=split/\t/,$lclines; print PIE "%%draw pie chart\n"; $thisendangle=$thisstartangle+eval($thisslice); if(eval($thisslice)>0){ print PIE "$c $m $y $k $thisstartangle $thisendangle ($label) pieslice\n"; } $thisstartangle=$thisendangle; $slicecounter++; $thisslice=$slice[$slicecounter]; } my $exportstr="convert $filewithdir -density 1200x1200 $piedirectory$piefile.$gexport"; print PIE "\n"; print PIE "showpage\n"; print PIE "grestore\n"; print PIE "%%trailer\n"; print PIE "%%EOF"; close LABELANDCOLOR; close PIE; if(length($gexport)>0){`$exportstr`;} }
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
469             }
470             sub pie2{
471 0     0 0   my ($startingangle, $ps, $data, $labelandcolor, $hsize, $vsize, $gexport, $valuetype) = @_;
472 0 0         my $piefileextension="eps"; my $xstart=int(306-($hsize*385/2)); my $xend=int(306+($hsize*385/2 + 10)); my $ystart=int(396-($vsize*350/2) - 8); my $yend=int(396+($vsize*350/2)); my @slice; my $slice; my $piefile; my $piedirectory="pies/"; my $thisdate = scalar localtime; my $thisslice; my $slicecounter; my $filewithdir; my $thisstartangle; my $thisendangle; my $percent1; my $no_slices; my $piename; open(PIECHARTDATA, "<$data") or die("Couldn't open $data"); while () {chomp; @slice=split(/\t/,$_); $no_slices=@slice; $piefile=$slice[$no_slices-1]; $piename=$piefile; $piefile.="\.".$piefileextension; $thisslice=$slice[0]; $slicecounter=0; $filewithdir=$piedirectory.$piefile; open(PIE, ">$filewithdir") or die("Couldn't create output file: ".$piefile); print PIE "%!PS-ADOBE 3.0 EPSF-3.0\n"; print PIE "%%Title: ".$piefile."\n"; print PIE "%%Creator: createpies.pl (c)Ken Owen 1999-2016\n"; print PIE "%%Creationdate: ".$thisdate."\n"; print PIE "%%BoundingBox: $xstart $ystart $xend $yend\n\n"; print PIE "/typesize " . $valuetype . " def\n"; print PIE $ps; print PIE "%%set scale and translation\n"; print PIE "306 396 translate $hsize $vsize scale\n"; $thisstartangle=$startingangle; open(LABELANDCOLOR, "<$labelandcolor") or die("Couldn't open $labelandcolor"); my $counter=0; my @lclines; my $lclines; while () {chomp; $lclines[$counter]=$_; $counter++; } $counter=@lclines; my $labelx=0; my $labely=$counter*$vsize*9+50; $counter=0; my $wholepercent=0; my $percent1num=0; foreach $lclines(@lclines){my ($label, $c, $m, $y, $k)=split(/\t/,$lclines); print PIE "%%draw pie chart\n"; $thisendangle=$thisstartangle+eval($thisslice); if(eval($thisslice)>0){$percent1num=int(100*eval($thisslice)/360); if(((100*eval($thisslice)/36) % 10) >= 5){$percent1num++;} $percent1=substr($percent1num,0)."%"; if($percent1num == 0){$percent1num=1;} $wholepercent+=$percent1num; if($wholepercent == 101){$percent1num--; $percent1=substr($percent1num,0) . "%"; } print PIE "$c $m $y $k $thisstartangle $thisendangle ($label) ($percent1) pieslice\n"; } $thisstartangle=$thisendangle; $slicecounter++; $thisslice=$slice[$slicecounter]; } my $exportstr="convert $filewithdir -density 1200x1200 $piedirectory$piename.$gexport"; print PIE "\n"; print PIE "showpage\n"; print PIE "grestore\n"; print PIE "%%trailer\n"; print PIE "%%EOF"; close LABELANDCOLOR; close PIE; if(length($gexport)>0){`$exportstr`;} }
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
473             }
474             sub pie3{
475 0 0 0 0 0   my ($startingangle, $ps, $data, $labelandcolor, $hsize, $vsize, $gexport, $legend) = @_; my $piececount=0; my @slice; my $piename; my $slicecnt; my $filecounter; my @pclines; my $c; my $y; my $m; my $k; my $pclines; my $piefile; my $piedirectory; my $thisslice; my $thispiefile; my $leftright; my $lclines; my @lclines; my $slicecounter; my $thisdate; my $filewithdir; my $thisstartangle; my $thisendangle; my $label; my $piefileextension="eps"; my $legend_right; my $boundingxend; my $boundingxstart; my $xstart; my $xend; my $ystart; my $yend; my $labelmax=0; my $labelx; open(LABELANDCOLOR, "<$labelandcolor") or die("Couldn't open $labelandcolor\n"); while() { $_=~s/\t.*//; $_=~s/ *$//; chomp; $labelx=length($_); if($labelx>$labelmax){$labelmax=$labelx; } $piececount++;} close(LABELANDCOLOR); if($legend eq "right"){ $boundingxend=int(306+($hsize*321/2)+($labelmax*9)*$hsize); $boundingxstart=int(306-($hsize*321/2)); $xstart=int(306-($hsize*260/2)); $xend=int(306+($hsize*260/2)); $ystart=int(396-($vsize*308/2)); $yend=int(396+($vsize*308/2)); }elsif($legend eq "left"){ $boundingxstart=int(306-($hsize*321/2)-($labelmax*9)*$hsize); $boundingxend=int(306+($hsize*321/2)*$hsize); $xstart=int(306-($hsize*260/2)); $xend=int(306+($hsize*260/2)); $ystart=int(396-($vsize*308/2)); $yend=int(396+($vsize*308/2)); }elsif($legend eq "bottom"){ $boundingxstart=int(306-($hsize*315/2)); $boundingxend=int(306+($hsize*315/2)); $xstart=int(306-($hsize*315/2)); $xend=int(306+($hsize*315/2)); $ystart=int(396-150-($piececount)*($vsize*25)); $yend=int(396+($vsize*130)); }else{ $xstart=int(306-($hsize*315/2)); $xend=int(306+($hsize*315/2)); $ystart=int(396-($vsize*315/2)-30); $yend=int(396+($vsize*350/2)); } open(PIECHARTDATA, "<$data") or die("Couldn't open $data"); my $counter=0; while () { $pclines[$counter]=$_; $counter++; } foreach $pclines(@pclines){@slice=split(/\t/,$pclines); chomp($slice[2]); $slicecnt=@slice; $piefile=$slice[$slicecnt-1]; chomp($piefile); $piename=$piefile; $piefile.="\.".$piefileextension; $piedirectory="pies/"; $thisdate = scalar localtime; $thisslice=$slice[0]; $slicecounter=0; $filewithdir=$piedirectory.$piefile; open(PIE, ">$filewithdir") or die("Couldn't create output file: ".$thispiefile); print PIE "%!PS-ADOBE 3.0 EPSF-3.0\n"; print PIE "%%Title: ".$piefile."\n"; print PIE "%%Creator: createpies.pl (c)Ken Owen 1999-2016\n"; print PIE "%%Creationdate: ".$thisdate."\n"; if($legend eq "right" || $legend eq "left") { print PIE "%%BoundingBox: $boundingxstart $ystart $boundingxend $yend\n\n"; }elsif($legend eq "bottom") { print PIE "%%BoundingBox: $boundingxstart $ystart $boundingxend $yend\n\n"; }else{ print PIE "%%BoundingBox: $xstart $ystart $xend $yend\n\n"; } print PIE "<< /PageSize [1000 1000] >> setpagedevice \n gsave\n"; print PIE $ps; print PIE "%%set scale and translation\n"; print PIE "306 396 translate $hsize $vsize scale\n"; $thisstartangle=$startingangle; open(LABELANDCOLOR, "<$labelandcolor") or die("Couldn't open $labelandcolor\n"); $counter=0; while () { chomp; $lclines[$counter]=$_; $counter++; } $counter=@lclines; $labelx=0; my $labely=$counter*$vsize*9; $counter=0; foreach $lclines(@lclines){ ($label, $c, $m, $y, $k)=split(/\t/,$lclines); print PIE "%%draw pie chart\n"; $thisendangle=$thisstartangle+eval($thisslice); if(eval($thisslice)>0){ print PIE "$c $m $y $k $thisstartangle $thisendangle ($label) pieslice\n"; if($legend eq "bottom"){ $leftright=0; $labelx=-100; $labely=-150-($slicecounter*$vsize*25); print PIE "$c $m $y $k ($label) $labelx $labely $leftright $hsize $vsize legend\n"; $thisstartangle=$thisendangle; $thisslice=$slice[$slicecounter]; }elsif($legend eq "right"){ $labelx=(260/2) + 10; $labely=$labely-28; $counter++; print PIE "$c $m $y $k ($label) $labelx $labely $hsize $vsize legend_right\n"; }elsif($legend eq "left"){ $labelx=-((260/2) + 10); $labely=$labely-28; $counter++; print PIE "$c $m $y $k ($label) $labelx $labely $hsize $vsize legend_left\n"; } } $thisstartangle=$thisendangle; $slicecounter++; $thisslice=$slice[$slicecounter]; } my $exportstr="convert $filewithdir -density 1200x1200 $piedirectory$piename.$gexport"; print PIE "\n"; print PIE "showpage\n"; print PIE "grestore\n"; print PIE "%%trailer\n"; print PIE "%%EOF"; if(length($gexport)>0){ `$exportstr`; } } close LABELANDCOLOR; close PIE;
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
476             }
477             sub pie31{
478 0 0 0 0 0   my ($startingangle, $ps, $data, $labelandcolor, $hsize, $vsize, $gexport, $legend, $valuetype) = @_; my $piececount=0; my @slice; my $piename; my $slicecnt; my $filecounter; my @pclines; my $c; my $y; my $m; my $k; my $pclines; my $piefile; my $piedirectory; my $thisslice; my $thispiefile; my $leftright; my $lclines; my @lclines; my $slicecounter; my $thisdate; my $filewithdir; my $thisstartangle; my $thisendangle; my $label; my $piefileextension="eps"; my $legend_right; my $boundingxend; my $boundingxstart; my $xstart; my $xend; my $ystart; my $yend; my $labelmax=0; my $labelx; my $percent1num; my $percent1; my $wholepercent; open(LABELANDCOLOR, "<$labelandcolor") or die("Couldn't open $labelandcolor\n"); while() { $_=~s/\t.*//; $_=~s/ *$//; chomp; $labelx=length($_); if($labelx>$labelmax){ $labelmax=$labelx; } $piececount++; } close(LABELANDCOLOR); if($legend eq "right"){ $boundingxend=int(306+130+($labelmax*9)*$hsize); $boundingxstart=int(306-($hsize*200)); $xstart=int(306-($hsize*260/2)); $xend=int(306+($hsize*260/2)); $ystart=int(396-($vsize*308/2)-($vsize*30)); $yend=int(396+($vsize*308/2)+($vsize*30)); }elsif($legend eq "left"){ $boundingxstart=int(306-120-($labelmax*9)*$hsize); $boundingxend=int(306+(321/2)*$hsize); $xstart=int(306-($hsize*280/2)); $xend=int(306+($hsize*260/2)); $ystart=int(396-($vsize*308/2)-($vsize*30)); $yend=int(396+($vsize*308/2)+($vsize*30)); print "labelmax=$labelmax boundingxstart=$boundingxstart xstart=$xstart\n"; }elsif($legend eq "bottom"){ $boundingxstart=int(306-($hsize*315/2)-30); $boundingxend=int(306+($hsize*315/2)+30); $xstart=int(306-($hsize*315/2)); $xend=int(306+($hsize*315/2)); $ystart=int(396-100-($piececount)*($vsize*25)); $yend=int(396+($vsize*180)); }else{ $xstart=int(306-($hsize*315/2)); $xend=int(306+($hsize*315/2)); $ystart=int(396-($vsize*315/2)-30); $yend=int(396+($vsize*350/2)); } open(PIECHARTDATA, "<$data") or die("Couldn't open $data"); my $counter=0; while () { $pclines[$counter]=$_; $counter++; } foreach $pclines(@pclines){ @slice=split(/\t/,$pclines); chomp($slice[2]); $slicecnt=@slice; $piefile=$slice[$slicecnt-1]; chomp($piefile); $piename=$piefile; $piefile.="\.".$piefileextension; $piedirectory="pies/"; $thisdate = scalar localtime; $thisslice=$slice[0]; $slicecounter=0; $filewithdir=$piedirectory.$piefile; open(PIE, ">$filewithdir") or die("Couldn't create output file: ".$thispiefile); print PIE "%!PS-ADOBE 3.0 EPSF-3.0\n"; print PIE "%%Title: ".$piefile."\n"; print PIE "%%Creator: createpies.pl (c)Ken Owen 1999-2016\n"; print PIE "%%Creationdate: ".$thisdate."\n"; if($legend eq "right" || $legend eq "left") { print PIE "%%BoundingBox: $boundingxstart $ystart $boundingxend $yend\n\n"; }elsif($legend eq "bottom") { print PIE "%%BoundingBox: $boundingxstart $ystart $boundingxend $yend\n\n"; }else{ print PIE "%%BoundingBox: $xstart $ystart $xend $yend\n\n"; } print PIE "<< /PageSize [1000 1000] >> setpagedevice \n gsave\n"; print PIE "/typesize " . $valuetype . " def\n"; print PIE "/legendtype " . $valuetype . " def\n"; print PIE $ps; print PIE "%%set scale and translation\n"; print PIE "306 396 translate $hsize $vsize scale\n"; $thisstartangle=$startingangle; open(LABELANDCOLOR, "<$labelandcolor") or die("Couldn't open $labelandcolor\n"); $counter=0; while () { chomp; $lclines[$counter]=$_; $counter++; } $counter=@lclines; $labelx=0; my $labely=$counter*$vsize*9; $counter=0; foreach $lclines(@lclines){ ($label, $c, $m, $y, $k)=split(/\t/,$lclines); print PIE "%%draw pie chart\n"; $thisendangle=$thisstartangle+eval($thisslice); if(eval($thisslice)>0){ $percent1num=int(100*eval($thisslice)/360); if(((100*eval($thisslice)/36) % 10) >= 5){ $percent1num++; } $percent1=substr($percent1num,0)."%"; if($percent1num == 0){ $percent1num=1; } $wholepercent+=$percent1num; if($wholepercent == 101){ $percent1num--; $percent1=substr($percent1num,0) . "%"; } print "percent1=$percent1\n"; print PIE "$c $m $y $k $thisstartangle $thisendangle pieslice\n"; if($legend eq "bottom"){ $leftright=0; $labelx=-100; $labely=-200-($slicecounter*$vsize*$valuetype*3); print PIE "$c $m $y $k ($label) $labelx $labely $leftright $hsize $vsize ( " . $percent1 . ") legend\n"; $thisstartangle=$thisendangle; $thisslice=$slice[$slicecounter]; }elsif($legend eq "right"){ $labelx=(260/2) + 55; $labely=$labely-28; $counter++; print PIE "$c $m $y $k ($label) $labelx $labely $hsize $vsize ( " . $percent1 . ") legend_right\n"; }elsif($legend eq "left"){ $leftright=1; $labelx=-((260/2) + 140); $labely=$labely-28; $counter++; print PIE "$c $m $y $k ($label) $labelx $labely $leftright $hsize $vsize ( " . $percent1 . ") legend\n"; } } $thisstartangle=$thisendangle; $slicecounter++; $thisslice=$slice[$slicecounter]; } my $exportstr="convert $filewithdir -density 1200x1200 $piedirectory$piename.$gexport"; print PIE "\n"; print PIE "showpage\n"; print PIE "grestore\n"; print PIE "%%trailer\n"; print PIE "%%EOF"; if(length($gexport)>0){ `$exportstr`; } } close LABELANDCOLOR; close PIE;
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
479             }
480             sub pie4{
481 0 0 0 0 0   my ($startingangle, $ps, $data, $labelandcolor, $hsize, $vsize, $gexport, $legend, $valuetype) = @_; my $piececount=0; my @slice; my $piename; my $slicecnt; my $filecounter; my @pclines; my $c; my $y; my $m; my $k; my $pclines; my $piefile; my $piedirectory; my $thisslice; my $thispiefile; my $leftright; my $lclines; my @lclines; my $slicecounter; my $thisdate; my $filewithdir; my $thisstartangle; my $thisendangle; my $label; my $piefileextension="eps"; my $legend_right; my $boundingxend; my $boundingxstart; my $xstart; my $xend; my $ystart; my $yend; my $labelmax=0; my $labelx; my $percent1num; my $percent1; my $wholepercent; open(LABELANDCOLOR, "<$labelandcolor") or die("Couldn't open $labelandcolor\n"); while() { $_=~s/\t.*//; $_=~s/ *$//; chomp; $labelx=length($_); if($labelx>$labelmax){$labelmax=$labelx; } $piececount++; } close(LABELANDCOLOR); if($legend eq "right"){ $boundingxend=int(306+($hsize*321/2)+($labelmax*9+30)*$hsize); $boundingxstart=int(306-(30+$hsize*321/2)); $xstart=int(306-($hsize*260/2)); $xend=int(306+($hsize*260/2)); $ystart=int(396-($vsize*308/2)-($vsize*30)); $yend=int(396+($vsize*308/2)+($vsize*30)); }elsif($legend eq "left"){ $boundingxstart=int(306-($hsize*321/2)-($labelmax*9+30)*$hsize); $boundingxend=int(306+(30+$hsize*321/2)*$hsize); $xstart=int(306-($hsize*280/2)); $xend=int(306+($hsize*260/2)); $ystart=int(396-($vsize*308/2)-($vsize*30)); $yend=int(396+($vsize*308/2)+($vsize*30)); }elsif($legend eq "bottom"){ $boundingxstart=int(306-($hsize*315/2)-30); $boundingxend=int(306+($hsize*315/2)+30); $xstart=int(306-($hsize*315/2)); $xend=int(306+($hsize*315/2)); $ystart=int(396-200-($piececount)*($vsize*25)); $yend=int(396+($vsize*180)); }else{ $xstart=int(306-($hsize*315/2)); $xend=int(306+($hsize*315/2)); $ystart=int(396-($vsize*315/2)-30); $yend=int(396+($vsize*350/2)); } open(PIECHARTDATA, "<$data") or die("Couldn't open $data"); my $counter=0; while () { $pclines[$counter]=$_; $counter++; } foreach $pclines(@pclines){ @slice=split(/\t/,$pclines); chomp($slice[2]); $slicecnt=@slice; $piefile=$slice[$slicecnt-1]; chomp($piefile); $piename=$piefile; $piefile.="\.".$piefileextension; $piedirectory="pies/"; $thisdate = scalar localtime; $thisslice=$slice[0]; $slicecounter=0; $filewithdir=$piedirectory.$piefile; open(PIE, ">$filewithdir") or die("Couldn't create output file: ".$thispiefile); print PIE "%!PS-ADOBE 3.0 EPSF-3.0\n"; print PIE "%%Title: ".$piefile."\n"; print PIE "%%Creator: createpies.pl (c)Ken Owen 1999-2016\n"; print PIE "%%Creationdate: ".$thisdate."\n"; if($legend eq "right" || $legend eq "left") { print PIE "%%BoundingBox: $boundingxstart $ystart $boundingxend $yend\n\n"; }elsif($legend eq "bottom") { print PIE "%%BoundingBox: $boundingxstart $ystart $boundingxend $yend\n\n"; }else{ print PIE "%%BoundingBox: $xstart $ystart $xend $yend\n\n"; } print PIE "<< /PageSize [1000 1000] >> setpagedevice \n gsave\n"; print PIE "/typesize " . $valuetype . " def\n"; print PIE $ps; print PIE "%%set scale and translation\n"; print PIE "306 396 translate $hsize $vsize scale\n"; $thisstartangle=$startingangle; open(LABELANDCOLOR, "<$labelandcolor") or die("Couldn't open $labelandcolor\n"); $counter=0; while () { chomp; $lclines[$counter]=$_; $counter++; } $counter=@lclines; $labelx=0; my $labely=$counter*$vsize*9; $counter=0; foreach $lclines(@lclines){ ($label, $c, $m, $y, $k)=split(/\t/,$lclines); print PIE "%%draw pie chart\n"; $thisendangle=$thisstartangle+eval($thisslice); if(eval($thisslice)>0){ $percent1num=int(100*eval($thisslice)/360); if(((100*eval($thisslice)/36) % 10) >= 5){ $percent1num++; } $percent1=substr($percent1num,0)."%"; if($percent1num == 0){$percent1num=1;} $wholepercent+=$percent1num; if($wholepercent == 101){ $percent1num--; $percent1=substr($percent1num,0) . "%"; } print PIE "$c $m $y $k $thisstartangle $thisendangle ($percent1) pieslice\n"; if($legend eq "bottom"){ $leftright=0; $labelx=-100; $labely=-220-($slicecounter*$vsize*25); print PIE "$c $m $y $k ($label) $labelx $labely $leftright $hsize $vsize legend\n"; $thisstartangle=$thisendangle; $thisslice=$slice[$slicecounter]; }elsif($legend eq "right"){ $labelx=(260/2) + 55; $labely=$labely-28; $counter++; print PIE "$c $m $y $k ($label) $labelx $labely $hsize $vsize legend_right\n"; }elsif($legend eq "left"){ $labelx=-((260/2) + 70); $labely=$labely-28; $counter++; print PIE "$c $m $y $k ($label) $labelx $labely $hsize $vsize legend_left\n"; } } $thisstartangle=$thisendangle; $slicecounter++; $thisslice=$slice[$slicecounter]; } my $exportstr="convert $filewithdir -density 1200x1200 $piedirectory$piename.$gexport"; print PIE "\n"; print PIE "showpage\n"; print PIE "grestore\n"; print PIE "%%trailer\n"; print PIE "%%EOF"; if(length($gexport)>0){`$exportstr`;} } close LABELANDCOLOR; close PIE;
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
482             }
483             sub pie5{
484 0 0   0 0   my ($startingangle, $ps, $data, $labelandcolor, $hscale, $vscale, $gexport, $valuetype, $explodeoffset, $sections) = @_; my $slicecounter; my $piefile; my $piececount; my $thisdate = scalar localtime; my $piedirectory="pies/"; my @slice; my $slicecnt; my $piefileextension="eps"; my $hsize=$hscale; my $vsize=$vscale; my $yend; my $labelmax=0; my $labelx; open(LABELANDCOLOR, "<$labelandcolor") or die("Couldn't open $labelandcolor\n"); while() { $_=~s/\t.*//; $_=~s/ *$//; chomp; $labelx=length($_); if($labelx>$labelmax){ $labelmax=$labelx; } $piececount++; } close(LABELANDCOLOR); my $xstart=int(306-($hsize*350/2)-($labelmax*$hsize)-(2*$explodeoffset)); my $xend=int(306+($hsize*350/2)+($labelmax*$hsize)+(2*$explodeoffset)); my $ystart=int(396-($vsize*321/2)-($labelmax*$vsize)); $yend=int(396+($vsize*321/2)+($labelmax*$vsize)); my @lclines; my $lclines; my $label; my $c; my $m; my $y; my $k; my $sectionnum; my $oldsectionnum=0; my $sectionoffset=0; my $thisendangle; my $thisslice; my $thisstartangle; my $filewithdir; my $thispiefile; my $sectionanchor=0; my @anchors; my $anchorcnt=0; my @sectionarray; my $sectionarr; my $sectioncnt=0; my $initialangle=$startingangle; open(PIECHARTDATA, "<$data") || print "Cannot open data for reading\n"; while() { chomp; @slice=split/\t/,$_; @anchors=split/,/,$slice[6]; @sectionarray=split/,/,$sections; $sectionarr=@sectionarray; $sectioncnt=0; $slicecnt=@slice; $piefile=$slice[$slicecnt-2]; $thisslice=$slice[0]; $slicecounter=0; $thispiefile=$piefile . "." . $piefileextension; $filewithdir=$piedirectory.$thispiefile; open(PIE, ">$filewithdir") || print ("Couldn't create output file: ".$thispiefile); print PIE "%!PS-ADOBE 3.0 EPSF-3.0\n"; print PIE "%%Title: ".$thispiefile."\n"; print PIE "%%Creator: createpies.pl (c)Ken Owen 1999-2016\n"; print PIE "%%Creationdate: ".$thisdate."\n"; print PIE "%%BoundingBox: $xstart $ystart $xend $yend\n\n"; print PIE "/typesize " . $valuetype . " def\n"; print PIE $ps; print PIE "c m y k setcmykcolor 2 setlinejoin 0 0 moveto 0 0 radius startangle endangle arc closepath gsave fill grestore "; print PIE "0 0 0 0 setcmykcolor 1.5 setlinewidth stroke "; print PIE "/slicecount slicecount 1 add def} def\n"; print PIE "\n%%set scale and translation\n"; print PIE "306 396 translate $hsize $vsize scale\n"; $thisstartangle=$startingangle; open(LABELANDCOLOR, "<$labelandcolor") or die("Couldn't open $labelandcolor"); my $counter=0; while () { chomp; $lclines[$counter]=$_; $counter++; } foreach $lclines(@lclines){ ($label, $c, $m, $y, $k, $sectionnum)=split/\t/,$lclines; print PIE "%%draw pie chart\n"; $thisendangle=$thisstartangle+eval($thisslice); if($slicecounter<$sectionarray[$sectioncnt]){ $sectionanchor=$anchors[$sectioncnt]+$initialangle; }else{ $sectioncnt++; $sectionanchor=$anchors[$sectioncnt]+$initialangle; } if(eval($thisslice)>0){ print PIE "$c $m $y $k $thisstartangle $thisendangle ($label) $explodeoffset $sectionanchor pieslice\n"; print PIE "grestore\n"; } $thisstartangle=$thisendangle; $slicecounter++; $thisslice=$slice[$slicecounter]; } $sectionanchor=""; my $exportstr="convert $filewithdir -density 1200x1200 $piedirectory$piefile.$gexport"; print PIE "\n"; print PIE "showpage\n"; print PIE "grestore\n"; print PIE "%%trailer\n"; print PIE "%%EOF"; close LABELANDCOLOR; close PIE; if(length($gexport)>0){`$exportstr`;}}
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
485             }
486             sub column1{
487 0     0 0   my ($ps, $data, $labelandcolor, $hsize, $vsize, $gexport, $columnwidth, $format, $headertype, $axistype, $valuetype, $backgroundcolor, $headercolor) = @_;
488 0 0         my $l1; my $l2; my $number; my $colfileextension="eps"; my $roundto; my $topscale=0; my $coldirectory="columns/"; my $thisdate; my @cols; my $cols; my $number_columns=0; $columnwidth=$columnwidth; my $thiscolfile; my $colname; my $filewithdir; my $xstart; my $xend; my $ystart; my $yend; my $labeldepth=36; my $valuedepth=36; my $chartdepth=217; my $totaldepth; my $chartwidth; my $labelpos; my $i; my $maxval; my $yaxis=72; my $c; my $m; my $y; my $k; my $label; my $cstart; open(COLCHARTDATA, "<$data") or die("Couldn't open $data"); while () { chomp; @cols=split/\t/,$_; $number_columns=@cols - 1; $labelpos=@cols; $chartwidth=$yaxis + $columnwidth/2 + 1.5*$number_columns*$columnwidth; my $cwidth=$columnwidth*$hsize; $xstart=int(306 - $hsize*$chartwidth/2); $xend=int(306 + $hsize*$chartwidth/2); $totaldepth=($chartdepth+$valuedepth+$labeldepth) * $vsize + 1; $ystart=int(396 - $vsize*$totaldepth/2 - 2); $yend=int(396 + $vsize*$totaldepth/2 + 1); $thisdate = scalar localtime; $colname=$cols[$number_columns]; $thiscolfile=$colname . "." . $colfileextension; $filewithdir=$coldirectory.$thiscolfile; open(COL, ">$filewithdir") || die "Couldn't create output file: " . $thiscolfile . "\n"; print COL "%!PS-ADOBE 3.0 EPSF-3.0\n"; print COL "%%Title: ".$thiscolfile."\n"; print COL "%%Creator: createcolumns.pl (c)Ken Owen 2001 - 2014\n"; print COL "%%Creationdate: ".$thisdate."\n"; print COL "%%BoundingBox: $xstart $ystart $xend $yend\n"; print COL "<< /PageSize [1000 1000] >> setpagedevice \n gsave\n"; print COL "$xstart $ystart translate $hsize $vsize scale\n"; print COL "/cwidth $cwidth def\n" . $ps; print COL "%%background areas\n"; print COL "/bkground {$backgroundcolor setcmykcolor} def\n";print COL "0 $yaxis add 2 sub $chartdepth $valuedepth add $vsize mul $chartwidth $yaxis sub $labeldepth bkgroundbox\n"; print COL "0 $yaxis add 2 sub 0 $chartwidth $yaxis sub $chartdepth $vsize mul bkgroundbox\n"; print COL "/headertype {$headercolor setcmykcolor /Helvetica-Bold findfont $headertype vsize mul scalefont setfont} def\n/axistype {/Helvetica-Bold findfont $axistype vsize mul scalefont setfont} def\n/valuetype {/Helvetica-Bold findfont $valuetype vsize mul scalefont setfont} def\n"; open(LABELANDCOLOR, "<$labelandcolor") or die("Couldn't open $labelandcolor\n"); print COL "%%draw column chart\n"; $maxval=0; for ($i=0; $i<@cols-1;$i++){ if($cols[$i]>$maxval){$maxval=$cols[$i];} } if($maxval<10){ $roundto=1; }elsif($maxval<100){ $roundto=10; }elsif($maxval<1000){ $roundto=100; }elsif($maxval<10000){ $roundto=1000; }elsif($maxval<100000){ $roundto=10000; }else{ $roundto=25000; } if(($maxval%$roundto)==0){ $topscale=$maxval; }else{ $topscale=($roundto-($maxval%$roundto)+$maxval); } print COL "gsave (".&makedollars(0, $format, 1).") (".&makedollars($topscale/5, $format, 1).") (".&makedollars($topscale*2/5, $format, 1).") (".&makedollars($topscale*3/5, $format, 1).") (".&makedollars($topscale*4/5, $format, 1).") (".&makedollars($topscale, $format, 1).") $chartwidth $yaxis sub $hsize $vsize chartscale grestore\n"; $i=0; while(){ chomp; ($label, $c, $m, $y, $k)=split/\t/,$_; $l1=""; $l2=""; if(length($label)>15){ $l1=$label; $l2=$label; $l1=~s/ \S*$//; $l2=substr($label, length($l1)); }else{ $l2=$label; } $cstart=$yaxis + $columnwidth/2 + $i*1.5*$columnwidth; print COL "$c $m $y $k $i " . 215*$vsize*$cols[$i]/$topscale . " (" . &makedollars($cols[$i], $format, 0) . ") ($l1) ($l2) $cstart $columnwidth column\n"; $i++; } my $exportstr="convert $filewithdir -density 1200x1200 $coldirectory$colname.$gexport"; print COL "showpage\n"; print COL "grestore\n"; print COL "%%trailer\n"; print COL "%%EOF"; if(length($gexport)>0){`$exportstr`; }} close LABELANDCOLOR; close COL;
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
489             }
490             sub bar1{
491 0 0   0 0   my ($ps, $data, $labelandcolor, $hsize, $vsize, $gexport, $columnwidth, $format, $headertype, $axistype, $valuetype, $backgroundcolor, $headercolor, $valuecolor) = @_; my $l1; my $l2; my $number; my $colfileextension="eps"; my $roundto; my $topscale=0; my $coldirectory="bars/"; print "coldirectory=$coldirectory\n"; my $thisdate; my @cols; my $cols; my $number_columns=0; $columnwidth=$columnwidth; my $thiscolfile; my $colname; my $filewithdir; my $xstart; my $xend; my $ystart; my $ystartb; my $yend; my $labeldepth=36; my $valuedepth=36; my $chartdepth; my $totaldepth; my $chartwidth; my $labelpos; my $i; my $maxval; my $yaxis=72; my $c; my $m; my $y; my $k; my $label; my $cstart; my $extrawidth=0; my $barwidth; my $chartscale; open(BARCHARTDATA, "<$data") or die("Couldn't open $data"); while () { chomp; @cols=split/\t/,$_; $number_columns=@cols - 1; $labelpos=@cols; $chartdepth=$columnwidth/2 + 1.5*$number_columns*$columnwidth; $totaldepth=$chartdepth * $vsize + 1; $ystart=int(396 - $vsize*$totaldepth/2); $ystartb=int($ystart - 24); $yend=int(396 + $vsize*$totaldepth/2 + 1); $thisdate = scalar localtime; $colname=$cols[$number_columns]; $thiscolfile=$colname . "." . $colfileextension; $filewithdir=$coldirectory.$thiscolfile; $maxval=0; $extrawidth=0; for ($i=0; $i<@cols-1;$i++){ if($cols[$i]>$maxval){$maxval=$cols[$i];} } if($maxval<10){ $roundto=1; }elsif($maxval<100){ $roundto=10; }elsif($maxval<1000){ $roundto=100; }elsif($maxval<10000){ $roundto=1000; }elsif($maxval<100000){ $roundto=10000; }else{ $roundto=25000; } if(($maxval%$roundto)==0){ $topscale=$maxval; }else{ $topscale=($roundto-($maxval%$roundto)+$maxval); } $extrawidth=35; $chartscale=259/$topscale; $chartwidth=$yaxis + $chartscale * $topscale + $extrawidth; $barwidth=$chartwidth-$yaxis; $xstart=int(306 - $hsize*$chartwidth/2); $xend=int(306 + $hsize*$chartwidth/2 + $extrawidth); open(BAR, ">$filewithdir") || die "Couldn't create output file: " . $thiscolfile . "\n"; print BAR "%!PS-ADOBE 3.0 EPSF-3.0\n"; print BAR "%%Title: ".$thiscolfile."\n"; print BAR "%%Creator: createbars.pl (c)Ken Owen 2014\n"; print BAR "%%Creationdate: ".$thisdate."\n"; print BAR "%%BoundingBox: $xstart $ystartb $xend $yend\n"; print BAR "%%%Debug maxval=$maxval topscale=$topscale extrawidth=$extrawidth chartwidth=$chartwidth chartscale=$chartscale\n"; print BAR "<< /PageSize [1000 1000] >> setpagedevice \n gsave\n"; print BAR "$xstart $ystart translate $hsize $vsize scale\n"; print BAR "/bwidth $columnwidth def\n"; print BAR $ps; print BAR "%%background areas\n"; print BAR "/bkground {$backgroundcolor setcmykcolor} def\n"; print BAR "0 $yaxis add 2 sub 0 $chartwidth $extrawidth add $yaxis sub $chartdepth bkgroundbox\n"; print BAR "/headertype {$headercolor setcmykcolor /Helvetica-Bold findfont $headertype vsize mul scalefont setfont} def\n/axistype {/Helvetica-Bold findfont $axistype vsize mul scalefont setfont} def\n/valuetype {/Helvetica-Bold findfont $valuetype vsize mul scalefont setfont} def\n"; print BAR "/valuecolor {$valuecolor setgray} def\n"; open(LABELANDCOLOR, "<$labelandcolor") or die("Couldn't open $labelandcolor\n"); print BAR "%%draw bar chart\n"; print BAR "gsave (".&makedollars(0, $format, 1).") (".&makedollars($topscale/5, $format, 1).") (".&makedollars($topscale*2/5, $format, 1).") (".&makedollars($topscale*3/5, $format, 1).") (".&makedollars($topscale*4/5, $format, 1).") (".&makedollars($topscale, $format, 1).") $chartdepth $chartwidth $yaxis sub $hsize $vsize chartscale grestore\n"; $i=0; while(){ chomp; ($label, $c, $m, $y, $k)=split/\t/,$_; $l1=""; $l2=""; if(length($label)>15){ $l1=$label; $l2=$label; $l1=~s/ \S*$//; $l2=substr($label, length($l1)); }else{ $l2=$label; } $cstart=$columnwidth/2 + $i*1.5*$columnwidth; print BAR "$c $m $y $k $i " . $barwidth*$cols[$i]/$topscale . " (" . &makedollars($cols[$i], $format, 0) . ") ($l1) ($l2) $cstart $columnwidth bar\n"; print BAR "% barwidth=$barwidth cstart=$cstart\n"; $i++; } my $exportstr="convert $filewithdir -density 1200x1200 $coldirectory$colname.$gexport"; print BAR "showpage\n"; print BAR "grestore\n"; print BAR "%%trailer\n"; print BAR "%%EOF"; if(length($gexport)>0){`$exportstr`; } } close LABELANDCOLOR; close BAR;
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
492             }
493 0 0   0 0   sub makedollars{ my $number=shift; my $format=shift; my $scale=shift; my $decimal=0; my $decimal1=0; if($number < 1000000){ if($number<100000){ if($number<10000){ if($number<1000){}else{ $number=substr($number,0,1).",".substr($number,1); }}else{ $number=substr($number,0,2).",".substr($number,2); } }else{ $number=substr($number,0,3).",".substr($number,3); } }else{ $number=substr($number,0,1).",".substr($number,1,3).",".substr($number,4);} if($scale==1){$number=int($number); if($format eq "money"){$number="\$".$number;}}else{if($format eq "money"){$number=int($number);$number="\$".$number;}elsif(substr($format,0,1) eq "d"){$decimal1=substr($format,1,1);$decimal=10**$decimal1; $number=$number*$decimal; $number=int($number);$number=$number/$decimal;$decimal1="%." . $decimal1 . "f";$number=sprintf($decimal1, $number);}else{$number="Illegal Format!";}} return $number;
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0 0          
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
  0            
494             }
495             1;
496              
497              
498             sub AUTOLOAD {
499             # This AUTOLOAD is used to 'autoload' constants from the constant()
500             # XS function.
501              
502 0     0     my $constname;
503 0           our $AUTOLOAD;
504 0           ($constname = $AUTOLOAD) =~ s/.*:://;
505 0 0         croak "&PSGRAPH::constant not defined" if $constname eq 'constant';
506 0           my ($error, $val) = constant($constname);
507 0 0         if ($error) { croak $error; }
  0            
508             {
509 1     1   13591 no strict 'refs';
  1         1  
  1         104  
  0            
510             # Fixed between 5.005_53 and 5.005_61
511             #XXX if ($] >= 5.00561) {
512             #XXX *$AUTOLOAD = sub () { $val };
513             #XXX }
514             #XXX else {
515 0     0     *$AUTOLOAD = sub { $val };
  0            
516             #XXX }
517             }
518 0           goto &$AUTOLOAD;
519             }
520              
521             require XSLoader;
522             XSLoader::load('PSGRAPH', $VERSION);
523              
524             # Preloaded methods go here.
525              
526             # Autoload methods go after =cut, and are processed by the autosplit program.
527              
528             1;
529             __END__