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__ |