File Coverage

blib/lib/PSGRAPH.pm
Criterion Covered Total %
statement 109 1540 7.0
branch 23 466 4.9
condition 0 78 0.0
subroutine 38 61 62.3
pod 0 53 0.0
total 170 2198 7.7


line stmt bran cond sub pod time code
1             package PSGRAPH;
2              
3 1     1   60837 use 5.8.8;
  1         2  
4 1     1   4 use strict;
  1         2  
  1         24  
5 1     1   5 use warnings;
  1         1  
  1         22  
6 1     1   3 use Carp;
  1         6  
  1         56  
7              
8             require Exporter;
9 1     1   435 use AutoLoader;
  1         1054  
  1         3  
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.05';
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 62 my $class = shift;
38 1         2 my $self = {};
39 1         3 bless $self, $class;
40 1         2 return $self;
41             }
42             sub setData{
43 1     1 0 1194 my ( $self, $Data) = @_;
44 1 50       4 $self->{Data} = $Data if defined($Data);
45 1         3 return $self->{Data};
46             }
47             sub getData {
48 1     1 0 11 my( $self ) = @_;
49 1         3 return $self->{Data};
50             }
51             sub setGraphic{
52 2     2 0 1629 my ( $self, $Graphic) = @_;
53 2 50       12 $self->{Graphic} = $Graphic if defined($Graphic);
54 2         5 return $self->{Graphic};
55             }
56             sub getGraphic {
57 2     2 0 5 my( $self ) = @_;
58 2         5 return $self->{Graphic};
59             }
60             sub setLabelandColor{
61 1     1 0 7 my ( $self, $LabelandColor) = @_;
62 1 50       7 $self->{LabelandColor} = $LabelandColor if defined($LabelandColor);
63 1         2 return $self->{LabelandColor};
64             }
65             sub getLabelandColor {
66 1     1 0 4 my( $self ) = @_;
67 1         2 return $self->{LabelandColor};
68             }
69              
70             sub setPS {
71 1     1 0 366 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         3  
  1         9  
74 1 50       7 if($graphic eq '2Dpie'){
    50          
    50          
75 0 0 0     0 if((defined($subtype) && $subtype==1) || !defined($subtype)){
    0 0        
    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             }elsif($subtype==4){
84 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';
85             }elsif($subtype==41){
86 0         0 $self->{PS} = 'gsave /radius 125 def /typesize 18 def /slicecount 1 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-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 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';
87             }elsif($subtype==5){
88 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 '
89             # }elsif((defined($subtype) && $subtype==6) || !defined($subtype)){
90             }elsif($subtype==6){
91 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 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 '
92             }else{
93 0         0 $self->{PS} = 'ERROR: Unsupported subtype.';
94             }
95             }elsif($graphic eq '2Dbar'){
96 0 0 0     0 if((defined($subtype) && $subtype==1) || !defined($subtype)){
      0        
97 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';
98             }else{
99 0         0 $self->{PS} = 'ERROR: Unsupported subtype.';
100             }
101             }elsif($graphic eq '2Dcolumn'){
102 0 0 0     0 if((defined($subtype) && $subtype==1) || !defined($subtype)){
      0        
103 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';
104             }else{
105 0         0 $self->{PS} = 'ERROR: Unsupported subtype.';
106             }
107             }else{
108 1         3 $self->{PS} = 'ERROR: Unsupported graphic.';
109             }
110 1         3 return $self->{PS};
111             }
112             sub getPS{
113 0     0 0 0 my($self)=@_;
114 0         0 return $self->{PS};
115             }
116             sub setSubtype{
117 1     1 0 355 my ( $self, $Subtype) = @_;
118 1 50       4 $self->{Subtype} = $Subtype if defined($Subtype);
119 1         2 return $self->{Subtype};
120             }
121             sub getSubtype {
122 3     3 0 7 my( $self ) = @_;
123 3         6 return $self->{Subtype};
124             }
125             sub setHscale{
126 1     1 0 364 my ( $self, $hscale) = @_;
127 1 50       4 $self->{Hscale} = $hscale if defined($hscale);
128 1         2 return $self->{Hscale};
129             }
130             sub getHscale {
131 1     1 0 4 my( $self ) = @_;
132 1         2 return $self->{Hscale};
133             }
134             sub setVscale{
135 1     1 0 356 my ( $self, $vscale) = @_;
136 1 50       5 $self->{Vscale} = $vscale if defined($vscale);
137 1         1 return $self->{Vscale};
138             }
139             sub getVscale {
140 1     1 0 4 my( $self ) = @_;
141 1         2 return $self->{Vscale};
142             }
143             sub setInitialdegree{
144 0     0 0 0 my ( $self, $initialdegree) = @_;
145 0 0       0 $self->{Initialdegree} = $initialdegree if defined($initialdegree);
146 0         0 return $self->{Initialdegree};
147             }
148             sub getInitialdegree {
149 0     0 0 0 my( $self ) = @_;
150 0         0 return $self->{Initialdegree};
151             }
152             sub setGexport{
153 0     0 0 0 my ( $self, $gexport) = @_;
154 0 0       0 $self->{Gexport} = $gexport if defined($gexport);
155 0         0 return $self->{Gexport};
156             }
157             sub getGexport {
158 0     0 0 0 my( $self ) = @_;
159 0         0 return $self->{Gexport};
160             }
161             sub setLegend{
162 0     0 0 0 my ( $self, $legend) = @_;
163 0 0       0 $self->{Legend} = $legend if defined($legend);
164 0         0 return $self->{Legend};
165             }
166             sub getLegend {
167 0     0 0 0 my( $self ) = @_;
168 0         0 return $self->{Legend};
169             }
170             sub setColumnwidth {
171 1     1 0 727 my ( $self, $columnwidth) = @_;
172 1 50       6 $self->{Columnwidth} = $columnwidth if defined($columnwidth);
173 1         2 return $self->{Columnwidth};
174             }
175             sub getColumnwidth {
176 1     1 0 3 my( $self ) = @_;
177 1         2 return $self->{Columnwidth};
178             }
179             sub setFormat {
180 1     1 0 352 my ( $self, $format) = @_;
181 1 50       4 $self->{Format} = $format if defined($format);
182 1         2 return $self->{Format};
183             }
184             sub getFormat {
185 1     1 0 3 my( $self ) = @_;
186 1         2 return $self->{Format};
187             }
188             sub setHeadertype {
189 1     1 0 392 my ( $self, $headertype) = @_;
190 1 50       3 $self->{Headertype} = $headertype if defined($headertype);
191 1         2 return $self->{Headertype};
192             }
193             sub getHeadertype {
194 1     1 0 5 my( $self ) = @_;
195 1         1 return $self->{Headertype};
196             }
197             sub setAxistype {
198 1     1 0 364 my ( $self, $axistype) = @_;
199 1 50       4 $self->{Axistype} = $axistype if defined($axistype);
200 1         2 return $self->{Axistype};
201             }
202             sub getAxistype {
203 1     1 0 4 my( $self ) = @_;
204 1         2 return $self->{Axistype};
205             }
206             sub setValuetype {
207 1     1 0 358 my ( $self, $valuetype) = @_;
208 1 50       4 $self->{Valuetype} = $valuetype if defined($valuetype);
209 1         2 return $self->{Valuetype};
210             }
211             sub getValuetype {
212 1     1 0 4 my( $self ) = @_;
213 1         2 return $self->{Valuetype};
214             }
215             sub setValuecolor {
216 1     1 0 426 my ( $self, $valuetype) = @_;
217 1 50       5 $self->{Valuecolor} = $valuetype if defined($valuetype);
218 1         3 return $self->{Valuecolor};
219             }
220             sub getValuecolor {
221 1     1 0 4 my( $self ) = @_;
222 1         3 return $self->{Valuecolor};
223             }
224             sub setBackgroundcolor {
225 1     1 0 387 my ( $self, $backgroundcolor) = @_;
226 1 50       4 $self->{Backgroundcolor} = $backgroundcolor if defined($backgroundcolor);
227 1         2 return $self->{Backgroundcolor};
228             }
229             sub getBackgroundcolor {
230 1     1 0 4 my( $self ) = @_;
231 1         2 return $self->{Backgroundcolor};
232             }
233             sub setHeadercolor {
234 1     1 0 354 my ( $self, $headercolor) = @_;
235 1 50       3 $self->{Headercolor} = $headercolor if defined($headercolor);
236 1         3 return $self->{Headercolor};
237             }
238             sub getHeadercolor {
239 1     1 0 3 my( $self ) = @_;
240 1         2 return $self->{Headercolor};
241             }
242             sub setExplodeoffset{
243 0     0 0 0 my ( $self, $explodeoffset) = @_;
244 0 0       0 $self->{Explodeoffset} = $explodeoffset if defined($explodeoffset);
245 0         0 return $self->{Explodeoffset};
246             }
247             sub getExplodeoffset {
248 0     0 0 0 my( $self ) = @_;
249 0         0 return $self->{Explodeoffset};
250             }
251             sub showInfo{
252 0     0 0 0 my( $self ) = @_;
253 0         0 print "LabelandColor: " . $self->getLabelandColor . "\n";
254 0         0 print "Data: " . $self->getData . "\n";
255 0         0 print "Graphic: " . $self->getGraphic . "\n";
256 0         0 print "PS: " . $self->getPS . "\n";
257 0 0       0 if(defined($self->getSubtype)){print "Subtype: " . $self->getSubtype . "\n";}else{print "Subtype: Not Defined\n";}
  0         0  
  0         0  
258 0 0       0 if(defined($self->getHscale)){print "Hscale: " . $self->getHscale . "\n";}else{print "Hscale: Not Defined\n";}
  0         0  
  0         0  
259 0 0       0 if(defined($self->getVscale)){print "Vscale: " . $self->getVscale . "\n";}else{print "Vscale: Not Defined\n";};
  0         0  
  0         0  
260 0 0       0 if(defined($self->getGexport)){print "Gexport: " . $self->getGexport . "\n";}else{print "Gexport: Not Defined\n";}
  0         0  
  0         0  
261 0 0       0 if(defined($self->getLegend)){print "Legend: " . $self->getLegend . "\n";}else{print "Legend: Not Defined\n";}
  0         0  
  0         0  
262 0 0       0 if(defined($self->getColumnwidth)){print "Columnwidth: " . $self->getColumnwidth . "\n";}else{print "Columnwidth: Not Defined\n";}
  0         0  
  0         0  
263 0 0       0 if(defined($self->getFormat)){print "Format: " . $self->getFormat . "\n";}else{print "Format: Not Defined\n";}
  0         0  
  0         0  
264 0 0       0 if(defined($self->getHeadertype)){print "Headertype: " . $self->getHeadertype . "\n";}else{print "Headertype: Not Defined\n";}
  0         0  
  0         0  
265 0 0       0 if(defined($self->getAxistype)){print "Axistype: " . $self->getAxistype . "\n";}else{print "Axistype: Not Defined\n";}
  0         0  
  0         0  
266 0 0       0 if(defined($self->getValuetype)){print "Valuetype: " . $self->getValuetype . "\n";}else{print "Valuetype: Not Defined\n";}
  0         0  
  0         0  
267 0 0       0 if(defined($self->getBackgroundcolor)){print "Backgroundcolor: " . $self->getBackgroundcolor . "\n";}else{print "Backgroundcolor: Not Defined\n";}
  0         0  
  0         0  
268 0 0       0 if(defined($self->getHeadercolor)){print "Headercolor: " . $self->getHeadercolor . "\n";}else{print "Headercolor: Not Defined\n";}
  0         0  
  0         0  
269 0 0       0 if(defined($self->getExplodeoffset)){print "Explodeoffset: " . $self->getExplodeoffset . "\n";}else{print "Explodeoffset: Not Defined\n";}
  0         0  
  0         0  
270 0 0       0 if(defined($self->getInitialdegree)){print "Initialdegree: " . $self->getInitialdegree . "\n";}else{print "Initialdegree: Not Defined\n";}
  0         0  
  0         0  
271             }
272             sub writeGraphic {
273 1     1 0 4 my( $self ) = @_;
274 1 50       7 if($self->{Graphic} eq '2Dpie'){
    50          
    50          
275             #translate data into degrees in a circle for pie
276 0         0 my $transdata=&data2degrees($self->{Data});
277 0 0 0     0 if(defined($self->{Data}) && defined($self->{LabelandColor})){
278 0 0       0 if(!defined($self->{Hscale})){$self->{Hscale}=1;}
  0         0  
279 0 0       0 if(!defined($self->{Vscale})){$self->{Vscale}=1;}
  0         0  
280 0 0       0 if(!defined($self->{Gexport})){$self->{Gexport}='';}
  0         0  
281 0 0       0 if(!defined($self->{Valuetype})){$self->{Valuetype}=8;}
  0         0  
282 0 0       0 if(!defined($self->{Explodeoffset})){$self->{Expoldeoffset}=12;}
  0         0  
283 0 0       0 if(!defined($self->{Initialdegree})){$self->{Initialdegree}=120;}
  0         0  
284 0 0 0     0 if((defined($self->{Subtype}) && $self->{Subtype}==1) || !defined($self->{Subtype})){
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
      0        
      0        
285 0         0 return &pie1($self->{Initialdegree},$self->{PS}, $transdata, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport}, $self->{Valuetype});
286             }elsif((defined($self->{Subtype}) && $self->{Subtype}==2)){
287 0         0 return &pie2($self->{Initialdegree},$self->{PS}, $transdata, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport}, $self->{Valuetype});
288             }elsif(defined($self->{Subtype}) && ($self->{Subtype}==3 || $self->{Subtype}==31 || $self->{Subtype}==4)){
289 0 0       0 if(!defined($self->{Legend})){$self->setLegend('right');}
  0         0  
290 0         0 my $leg=$self->getLegend;
291 0 0 0     0 if($leg eq 'right' || $leg eq 'left' || $leg eq 'bottom'){
      0        
292 0 0       0 if($self->{Subtype}==3){
    0          
    0          
293 0         0 return &pie3($self->{Initialdegree},$self->{PS}, $transdata, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport}, $self->getLegend, $self->{Valuetype});
294             }elsif($self->{Subtype}==31){
295 0         0 return &pie31($self->{Initialdegree},$self->{PS}, $transdata, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport}, $self->getLegend, $self->{Valuetype});
296             }elsif($self->{Subtype}==4){
297 0         0 return &pie4($self->{Initialdegree},$self->{PS}, $transdata, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport}, $self->getLegend, $self->{Valuetype});
298             }
299             }else{
300 0         0 return "Legend must be right, left or bottom.";
301             }
302             }elsif($self->{Subtype}==41){
303 0         0 return &pie41($self->{Initialdegree},$self->{PS}, $transdata, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport}, $self->{Valuetype});
304             }elsif((defined($self->{Subtype}) && $self->{Subtype}==5)){
305             #set centers for section translations for exploded pies
306             #step through slices and add degrees to combine them into sections
307 0         0 my $sectionends="";
308 0         0 my @sectionarray="";
309 0         0 my $sectionend;
310             my $sectioncenters;
311 0         0 my $currentsection=1;
312 0         0 my $currentslice=0;
313 0         0 my @lc;
314             my @da;
315 0         0 my $dalength;
316 0         0 my $transdata1='trans1';
317             #create an string, comma delimited, with the field numbers of the end sections
318 0 0       0 open(LC,$self->{LabelandColor}) || die "Cannot open LabelAndColor!\n";
319 0         0 while(){
320 0         0 @lc = split/\t/;
321 0         0 chomp;
322 0         0 $currentslice++;
323 0 0       0 if($lc[5] != $currentsection){
324 0         0 $sectionend=int($currentslice)-1;
325 0 0       0 if(length($sectionends)>0){$sectionends.=",";}
  0         0  
326 0         0 $sectionends.=$sectionend;
327 0         0 $currentsection=$lc[5];
328             }
329             }
330 0         0 $sectionends.="," . $currentslice;
331             #add the halfangles of the sections in a comma delimited string to the end of the row in transdata
332 0 0       0 open(TRANS, "<$transdata") || die "Cannot open transdata for reading!\n";
333 0 0       0 open(TRANSPLUS, ">$transdata1") || die "Cannot open transdata1 for writing!\n";
334 0         0 my $sectionmiddle="";
335 0         0 while(){
336 0         0 chomp;
337 0         0 my $dataline=$_;
338 0         0 @da = split/\t/;
339 0         0 $dalength=@da;
340 0         0 @sectionarray=split/,/,$sectionends;
341 0         0 my $salength=@sectionarray;
342 0         0 my $secdegrees=0;
343 0         0 my $lastsection=0;
344 0         0 my $thissection=0;
345 0         0 my $jj=$sectionarray[$thissection];
346 0         0 for(my $ii=0; $ii<$dalength ; $ii++){
347 0 0       0 if($ii==$jj){
348 0 0       0 if(length($sectionmiddle)>0){$sectionmiddle.=',';}
  0         0  
349 0         0 $sectionmiddle.=(.5)*($secdegrees+$lastsection);
350 0         0 $lastsection=$secdegrees;
351 0         0 $thissection++;
352 0         0 $jj=$sectionarray[$thissection];
353 0 0       0 if($thissection==($salength-1)){
354 0         0 $sectionmiddle.="," . (.5)*(360+$secdegrees);
355 0         0 last;
356             }
357             }
358 0         0 $secdegrees+=$da[$ii];
359             }
360 0         0 print TRANSPLUS $dataline . "\t$sectionmiddle\n";
361 0         0 $sectionmiddle="";
362             }
363 0         0 close TRANSPLUS;
364 0         0 return &pie5($self->{Initialdegree},$self->{PS}, $transdata1, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport}, $self->{Valuetype}, $self->{Explodeoffset}, $sectionends);
365             }elsif((defined($self->{Subtype}) && $self->{Subtype}==6) || !defined($self->{Subtype})){
366 0         0 return &pie6($self->{Initialdegree},$self->{PS}, $transdata, $self->{LabelandColor}, $self->{Hscale}, $self->{Vscale}, $self->{Gexport}, $self->{Valuetype});
367             }
368             }else{
369 0         0 return "Both the data file (setData) and the color file (setLabelandColor) must be defined.";
370             }
371             }elsif($self->{Graphic} eq '2Dcolumn'){
372 0 0 0     0 if(defined($self->{Data}) && defined($self->{LabelandColor})){
373 0 0       0 if(!defined($self->{Hscale})){$self->{Hscale}=1;}
  0         0  
374 0 0       0 if(!defined($self->{Vscale})){$self->{Vscale}=1;}
  0         0  
375 0 0       0 if(!defined($self->{Gexport})){$self->{Gexport}='';}
  0         0  
376 0 0       0 if(!defined($self->{Columnwidth})){$self->{Columnwidth}=36;}
  0         0  
377 0 0       0 if(!defined($self->{Format})){$self->{Format}="money";}
  0         0  
378 0 0       0 if(!defined($self->{Headertype})){$self->{Headertype}=9;}
  0         0  
379 0 0       0 if(!defined($self->{Valuetype})){$self->{Valuetype}=9;}
  0         0  
380 0 0       0 if(!defined($self->{Axistype})){$self->{Axistype}=8;}
  0         0  
381 0 0       0 if(!defined($self->{Backgroundcolor})){$self->{Backgroundcolor}='.3 0 .15 .09';}
  0         0  
382 0 0       0 if(!defined($self->{Headercolor})){$self->{Headercolor}='0 0 0 1';}
  0         0  
383 0 0 0     0 if((defined($self->{Subtype}) && $self->{Subtype}==1) || !defined($self->{Subtype})){
      0        
384 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});
385             }
386             }else{
387 0         0 return "Both the data file (setData) and the color file (setLabelandColor) must be defined.";
388             }
389             }elsif($self->{Graphic} eq '2Dbar'){
390 0 0 0     0 if(defined($self->{Data}) && defined($self->{LabelandColor})){
391 0 0       0 if(!defined($self->{Hscale})){$self->{Hscale}=1;}
  0         0  
392 0 0       0 if(!defined($self->{Vscale})){$self->{Vscale}=1;}
  0         0  
393 0 0       0 if(!defined($self->{Gexport})){$self->{Gexport}='';}
  0         0  
394 0 0       0 if(!defined($self->{Columnwidth})){$self->{Columnwidth}=36;}
  0         0  
395 0 0       0 if(!defined($self->{Format})){$self->{Format}="money";}
  0         0  
396 0 0       0 if(!defined($self->{Headertype})){$self->{Headertype}=9;}
  0         0  
397 0 0       0 if(!defined($self->{Valuetype})){$self->{Valuetype}=9;}
  0         0  
398 0 0       0 if(!defined($self->{Valuecolor})){$self->{Valuecolor}=0;}
  0         0  
399 0 0       0 if(!defined($self->{Axistype})){$self->{Axistype}=8;}
  0         0  
400 0 0       0 if(!defined($self->{Backgroundcolor})){$self->{Backgroundcolor}='.3 0 .15 .09';}
  0         0  
401 0 0       0 if(!defined($self->{Headercolor})){$self->{Headercolor}='0 0 0 1';}
  0         0  
402 0 0 0     0 if((defined($self->{Subtype}) && $self->{Subtype}==1) || !defined($self->{Subtype})){
      0        
403 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});
404             }
405             }else{
406 0         0 return "Both the data file (setData) and the color file (setLabelandColor) must be defined.";
407             }
408             }else{
409 1         2 return "Cannot write undefined graphic!";
410             }
411             }
412             sub data2degrees {
413 0     0 0 0 my ($data) = @_;
414 0         0 my $trans="trans";
415 0         0 my @totaldata;
416 0 0       0 open(DATA, "./" . $data) || die "Could not open ./$data file!\n";
417 0 0       0 open(TRANS, ">$trans") || die "Could not open trans file for writing!\n";
418 0 0       0 open(DATA1, "+>data1") || die "Could not open data1 file for writing!\n";
419             #sum the slices to create a totals field
420 0         0 my @sum;
421             my @drow1;
422 0         0 while(){
423 0         0 my @drow=split ("\t", $_);
424 0         0 my $total=0;
425 0         0 my $drow1='';
426 0         0 my $ddd=@drow-1;
427 0         0 chomp($ddd);
428             #find the largest slice
429 0         0 for(my $a=0; $a<@drow-1; $a++){
430 0         0 $sum[$a]+=$drow[$a];
431 0         0 $total+=$drow[$a];
432 0 0       0 if($drow1 eq ''){
433 0         0 $drow1.=$drow[$a];
434             }else{
435 0         0 $drow1.="\t" . $drow[$a];
436             }
437             }
438             #chomp($drow[@drow-1]);
439 0         0 $drow1.="\t" . $drow[$ddd];
440 0         0 chomp($drow1);
441 0         0 $drow1.="\t" . $total;
442 0         0 print DATA1 $drow1 . "\n";
443             }
444 0         0 my $largest;
445 0         0 my $lvalue=0;
446 0         0 for($b=0; $b<@sum; $b++){
447 0 0       0 if($sum[$b]>$lvalue){
448 0         0 $lvalue=$sum[$b];
449 0         0 $largest=$b;
450             }
451             }
452 0         0 seek DATA1, 0, 0;
453 0         0 while(){
454 0         0 my @crow=split ("\t", $_);
455 0         0 my @d;
456 0         0 my $otherdegrees=0;
457 0         0 for(my $c=0; $c<@crow-2; $c++){
458 0 0       0 if($c!=$largest){
459 0         0 $d[$c]=360*$crow[$c]/$crow[@crow-1];
460 0 0       0 if($d[$c]>0){
461 0 0       0 if($d[$c]<3.6){$d[$c]=3.6;}
  0         0  
462 0         0 $otherdegrees+=$d[$c];
463             }
464             }
465             }
466 0         0 $d[$largest]=360-$otherdegrees;
467 0         0 push @d, $crow[@crow-2];
468 0         0 print TRANS join("\t",@d) . "\n";
469 0         0 print join("\t",@d) . "\n";
470             }
471 0         0 close TRANS;
472 0         0 return $trans;
473             }
474             sub pie1{
475 0     0 0 0 my ($startingangle,$ps, $data, $labelandcolor, $hscale, $vscale, $gexport, $valuetype) = @_;
476 0 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  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
477             }}
478             sub pie2{
479 0     0 0 0 my ($startingangle, $ps, $data, $labelandcolor, $hsize, $vsize, $gexport, $valuetype) = @_;
480 0 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         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
481             }
482             sub pie3{
483 0 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; 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*$valuetype; $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*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         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
484             }
485             sub pie31{
486 0 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  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
487             }
488             sub pie41{
489 0 0   0 0 0 my ($startingangle, $ps, $data, $labelandcolor, $hsize, $vsize, $gexport, $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 $boundingxend; my $boundingxstart; my $labelmax=0; my $labelx; my $percent1num; my $percent1; my $wholepercent; 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)); my $yend=int(396+($vsize*350/2)+($labelmax*$vsize)); 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); 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"; 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"; } $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  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
490             }
491             sub pie4{
492 0 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  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
493             }
494             sub pie5{
495 0 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         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
496             }
497             sub pie6{
498 0     0 0 0 my ($startingangle,$ps, $data, $labelandcolor, $hscale, $vscale, $gexport, $valuetype) = @_;
499 0 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 "\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  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
500             }
501             sub column1{
502 0     0 0 0 my ($ps, $data, $labelandcolor, $hsize, $vsize, $gexport, $columnwidth, $format, $headertype, $axistype, $valuetype, $backgroundcolor, $headercolor) = @_;
503 0 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  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
504             }
505             sub bar1{
506 0 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         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
507             }
508 0 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  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
509             }
510             1;
511              
512              
513             sub AUTOLOAD {
514             # This AUTOLOAD is used to 'autoload' constants from the constant()
515             # XS function.
516              
517 1     1   420 my $constname;
518 1         1 our $AUTOLOAD;
519 1         6 ($constname = $AUTOLOAD) =~ s/.*:://;
520 1 50       3 croak "&PSGRAPH::constant not defined" if $constname eq 'constant';
521 1         6 my ($error, $val) = constant($constname);
522 1 50       3 if ($error) { croak $error; }
  1         158  
523             {
524 1     1   10164 no strict 'refs';
  1         2  
  1         100  
  0            
525             # Fixed between 5.005_53 and 5.005_61
526             #XXX if ($] >= 5.00561) {
527             #XXX *$AUTOLOAD = sub () { $val };
528             #XXX }
529             #XXX else {
530 0     0     *$AUTOLOAD = sub { $val };
  0            
531             #XXX }
532             }
533 0           goto &$AUTOLOAD;
534             }
535              
536             require XSLoader;
537             XSLoader::load('PSGRAPH', $VERSION);
538              
539             # Preloaded methods go here.
540              
541             # Autoload methods go after =cut, and are processed by the autosplit program.
542              
543             1;
544             __END__