2685 lines
67 KiB
Perl
Executable File
2685 lines
67 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
#
|
|
# busgraph.pl : Produce Business Graphs in troff format
|
|
# Deri James : 5th February 2015
|
|
#
|
|
|
|
# Copyright (C) 2015 Free Software Foundation, Inc.
|
|
# Written by Deri James <deri@chuzzlewit.demon.co.uk>
|
|
#
|
|
# This file is part of groff.
|
|
#
|
|
# groff is free software; you can redistribute it and/or modify it under
|
|
# the terms of the GNU General Public License as published by the Free
|
|
# Software Foundation, either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# groff is distributed in the hope that it will be useful, but WITHOUT ANY
|
|
# WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
# for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
use strict;
|
|
|
|
|
|
my @CMDS=(
|
|
['FRAME','c','pi/graph',"6c\t5c"],
|
|
['ORIGIN','c','pi/graph',''],
|
|
['DARKER','','pi/graph',.8],
|
|
['BORDER','p','pi/graph',0],
|
|
['BRDCOLOUR','#','pi/graph','black'],
|
|
['JUST','','pi/graph','left'],
|
|
['FT','p','pi/graph','HR'],
|
|
['PS','p','pi/graph','10'],
|
|
['VS','p','pi/graph','+10%'],
|
|
['TEXTCOLOUR','#','pi/graph','black'],
|
|
['BGCOLOUR','#','pi/graph',''],
|
|
['WALLCOLOUR','#','graph',''],
|
|
['LINECOLOUR','#','pi/graph','black'],
|
|
['THICKNESS','p','pi/graph','.2'],
|
|
['TYPE','','pi','pi'],
|
|
['3D','c','pi','0'],
|
|
['COLOURED','bool','pi/graph','no'],
|
|
['XRAD','c','pi','2c'],
|
|
['YRAD','c','pi','2c'],
|
|
['HOLE','','pi','0'],
|
|
['OTHERS','','pi',2.05],
|
|
['VDECIMALS','','pi',0],
|
|
['PDECIMALS','','pi',1],
|
|
['PDECIMALS','','graph',''],
|
|
['LABEL','','pi','$text ($percent%)'],
|
|
['KEYBOX','bool','pi/graph','no'],
|
|
['BOXFRAME','c','pi/graph',''], # xoffs, yoffs, width, depth
|
|
['BOXHEADS','','pi',"Name\tValue\t%"],
|
|
['BOXHEADS','','graph',''],
|
|
['BOXLABELS','','pi/graph',"\$text\t\$value\t\$percent"],
|
|
['BOXTABS','','pi/graph',"0cL 2.8cR 4cR"],
|
|
['FLOW','bool','pi/graph','no'],
|
|
['CAPTION','','pi/graph',''],
|
|
['SCOLOURS','#','pi/graph',"#bfad94\t#2a586f\t#dbd6ce\t#568da3\t#a17759\t#c1d4de\t#74c9aa\t#dee1b6\t#e1b866\t#bf5434\t#373c42\tgrey80"],
|
|
# SCOLOURS:#bfad94 #2a586f #dbd6ce #568da3 #a17759 #c1d4de #74c9aa #dee1b6 #e1b866 #bf5434 #373c42 grey80
|
|
# ['SCOLOURS','#','pi/graph',"cyan\tmagenta\tyellow\tpaleturquoise1\tgrey6\tgreen\tpeachpuff\tcornflowerblue\tpink2\tdarkgoldenrod\tdarkolivegreen1\tdarkturquoise"],
|
|
['NEGCOLOUR','#','graph',''],
|
|
['POSCOLOUR','#','graph',''],
|
|
['HGRID','bool','graph','no'],
|
|
['VGRID','bool','graph','no'],
|
|
['SERIES','undef','pi/graph',''],
|
|
['SYMSIZE','p','graph',2],
|
|
['FLOOR','undef','graph',''],
|
|
['HORIZONTAL','bool','graph','no'],
|
|
['SYNC','bool','graph','no'],
|
|
['SORT','bool','pi','n'],
|
|
['SHADOW','bool','pi','no'],
|
|
['SFILE','','pi/graph',''],
|
|
['STEPS','undef','graph',''],
|
|
['PDFBOOKMARK','','pi/graph',0],
|
|
);
|
|
|
|
my %colours=(
|
|
'black' => 'rgb #000000',
|
|
'grey' => 'rgb #bebebe',
|
|
'dimgrey' => 'rgb #696969',
|
|
'lightgray' => 'rgb #d3d3d3',
|
|
'lightslategrey' => 'rgb #778899',
|
|
'slategray' => 'rgb #708090',
|
|
'slategray1' => 'rgb #c6e2ff',
|
|
'slategray2' => 'rgb #b9d3ee',
|
|
'slategray3' => 'rgb #9fb6cd',
|
|
'slategray4' => 'rgb #6c7b8b',
|
|
'slategrey' => 'rgb #708090',
|
|
'grey0' => 'rgb #000000',
|
|
'grey1' => 'rgb #030303',
|
|
'grey2' => 'rgb #050505',
|
|
'grey3' => 'rgb #080808',
|
|
'grey4' => 'rgb #0a0a0a',
|
|
'grey5' => 'rgb #0d0d0d',
|
|
'grey6' => 'rgb #0f0f0f',
|
|
'grey7' => 'rgb #121212',
|
|
'grey8' => 'rgb #141414',
|
|
'grey9' => 'rgb #171717',
|
|
'grey10' => 'rgb #1a1a1a',
|
|
'grey11' => 'rgb #1c1c1c',
|
|
'grey12' => 'rgb #1f1f1f',
|
|
'grey13' => 'rgb #212121',
|
|
'grey14' => 'rgb #242424',
|
|
'grey15' => 'rgb #262626',
|
|
'grey16' => 'rgb #292929',
|
|
'grey17' => 'rgb #2b2b2b',
|
|
'grey18' => 'rgb #2e2e2e',
|
|
'grey19' => 'rgb #303030',
|
|
'grey20' => 'rgb #333333',
|
|
'grey21' => 'rgb #363636',
|
|
'grey22' => 'rgb #383838',
|
|
'grey23' => 'rgb #3b3b3b',
|
|
'grey24' => 'rgb #3d3d3d',
|
|
'grey25' => 'rgb #404040',
|
|
'grey26' => 'rgb #424242',
|
|
'grey27' => 'rgb #454545',
|
|
'grey28' => 'rgb #474747',
|
|
'grey29' => 'rgb #4a4a4a',
|
|
'grey30' => 'rgb #4d4d4d',
|
|
'grey31' => 'rgb #4f4f4f',
|
|
'grey32' => 'rgb #525252',
|
|
'grey33' => 'rgb #545454',
|
|
'grey34' => 'rgb #575757',
|
|
'grey35' => 'rgb #595959',
|
|
'grey36' => 'rgb #5c5c5c',
|
|
'grey37' => 'rgb #5e5e5e',
|
|
'grey38' => 'rgb #616161',
|
|
'grey39' => 'rgb #636363',
|
|
'grey40' => 'rgb #666666',
|
|
'grey41' => 'rgb #696969',
|
|
'grey42' => 'rgb #6b6b6b',
|
|
'grey43' => 'rgb #6e6e6e',
|
|
'grey44' => 'rgb #707070',
|
|
'grey45' => 'rgb #737373',
|
|
'grey46' => 'rgb #757575',
|
|
'grey47' => 'rgb #787878',
|
|
'grey48' => 'rgb #7a7a7a',
|
|
'grey49' => 'rgb #7d7d7d',
|
|
'grey50' => 'rgb #7f7f7f',
|
|
'grey51' => 'rgb #828282',
|
|
'grey52' => 'rgb #858585',
|
|
'grey53' => 'rgb #878787',
|
|
'grey54' => 'rgb #8a8a8a',
|
|
'grey55' => 'rgb #8c8c8c',
|
|
'grey56' => 'rgb #8f8f8f',
|
|
'grey57' => 'rgb #919191',
|
|
'grey58' => 'rgb #949494',
|
|
'grey59' => 'rgb #969696',
|
|
'grey60' => 'rgb #999999',
|
|
'grey61' => 'rgb #9c9c9c',
|
|
'grey62' => 'rgb #9e9e9e',
|
|
'grey63' => 'rgb #a1a1a1',
|
|
'grey64' => 'rgb #a3a3a3',
|
|
'grey65' => 'rgb #a6a6a6',
|
|
'grey66' => 'rgb #a8a8a8',
|
|
'grey67' => 'rgb #ababab',
|
|
'grey68' => 'rgb #adadad',
|
|
'grey69' => 'rgb #b0b0b0',
|
|
'grey70' => 'rgb #b3b3b3',
|
|
'grey71' => 'rgb #b5b5b5',
|
|
'grey72' => 'rgb #b8b8b8',
|
|
'grey73' => 'rgb #bababa',
|
|
'grey74' => 'rgb #bdbdbd',
|
|
'grey75' => 'rgb #bfbfbf',
|
|
'grey76' => 'rgb #c2c2c2',
|
|
'grey77' => 'rgb #c4c4c4',
|
|
'grey78' => 'rgb #c7c7c7',
|
|
'grey79' => 'rgb #c9c9c9',
|
|
'grey80' => 'rgb #cccccc',
|
|
'grey81' => 'rgb #cfcfcf',
|
|
'grey82' => 'rgb #d1d1d1',
|
|
'grey83' => 'rgb #d4d4d4',
|
|
'grey84' => 'rgb #d6d6d6',
|
|
'grey85' => 'rgb #d9d9d9',
|
|
'grey86' => 'rgb #dbdbdb',
|
|
'grey87' => 'rgb #dedede',
|
|
'grey88' => 'rgb #e0e0e0',
|
|
'grey89' => 'rgb #e3e3e3',
|
|
'grey90' => 'rgb #e5e5e5',
|
|
'grey91' => 'rgb #e8e8e8',
|
|
'grey92' => 'rgb #ebebeb',
|
|
'grey93' => 'rgb #ededed',
|
|
'grey94' => 'rgb #f0f0f0',
|
|
'grey95' => 'rgb #f2f2f2',
|
|
'grey96' => 'rgb #f5f5f5',
|
|
'grey97' => 'rgb #f7f7f7',
|
|
'grey98' => 'rgb #fafafa',
|
|
'grey99' => 'rgb #fcfcfc',
|
|
'grey100' => 'rgb #ffffff',
|
|
'aliceblue' => 'rgb #f0f8ff',
|
|
'blueviolet' => 'rgb #8a2be2',
|
|
'cadetblue' => 'rgb #5f9ea0',
|
|
'cadetblue1' => 'rgb #98f5ff',
|
|
'cadetblue2' => 'rgb #8ee5ee',
|
|
'cadetblue3' => 'rgb #7ac5cd',
|
|
'cadetblue4' => 'rgb #53868b',
|
|
'cornflowerblue' => 'rgb #6495ed',
|
|
'darkslateblue' => 'rgb #483d8b',
|
|
'darkturquoise' => 'rgb #00ced1',
|
|
'deepskyblue' => 'rgb #00bfff',
|
|
'deepskyblue1' => 'rgb #00bfff',
|
|
'deepskyblue2' => 'rgb #00b2ee',
|
|
'deepskyblue3' => 'rgb #009acd',
|
|
'deepskyblue4' => 'rgb #00688b',
|
|
'dodgerblue' => 'rgb #1e90ff',
|
|
'dodgerblue1' => 'rgb #1e90ff',
|
|
'dodgerblue2' => 'rgb #1c86ee',
|
|
'dodgerblue3' => 'rgb #1874cd',
|
|
'dodgerblue4' => 'rgb #104e8b',
|
|
'lightblue' => 'rgb #add8e6',
|
|
'lightblue1' => 'rgb #bfefff',
|
|
'lightblue2' => 'rgb #b2dfee',
|
|
'lightblue3' => 'rgb #9ac0cd',
|
|
'lightblue4' => 'rgb #68838b',
|
|
'lightcyan' => 'rgb #e0ffff',
|
|
'lightcyan1' => 'rgb #e0ffff',
|
|
'lightcyan2' => 'rgb #d1eeee',
|
|
'lightcyan3' => 'rgb #b4cdcd',
|
|
'lightcyan4' => 'rgb #7a8b8b',
|
|
'lightskyblue' => 'rgb #87cefa',
|
|
'lightskyblue1' => 'rgb #b0e2ff',
|
|
'lightskyblue2' => 'rgb #a4d3ee',
|
|
'lightskyblue3' => 'rgb #8db6cd',
|
|
'lightskyblue4' => 'rgb #607b8b',
|
|
'lightslateblue' => 'rgb #8470ff',
|
|
'lightsteelblue' => 'rgb #b0c4de',
|
|
'lightsteelblue1' => 'rgb #cae1ff',
|
|
'lightsteelblue2' => 'rgb #bcd2ee',
|
|
'lightsteelblue3' => 'rgb #a2b5cd',
|
|
'lightsteelblue4' => 'rgb #6e7b8b',
|
|
'mediumaquamarine' => 'rgb #66cdaa',
|
|
'mediumblue' => 'rgb #0000cd',
|
|
'mediumslateblue' => 'rgb #7b68ee',
|
|
'mediumturquoise' => 'rgb #48d1cc',
|
|
'midnightblue' => 'rgb #191970',
|
|
'navyblue' => 'rgb #000080',
|
|
'paleturquoise' => 'rgb #afeeee',
|
|
'paleturquoise1' => 'rgb #bbffff',
|
|
'paleturquoise2' => 'rgb #aeeeee',
|
|
'paleturquoise3' => 'rgb #96cdcd',
|
|
'paleturquoise4' => 'rgb #668b8b',
|
|
'powderblue' => 'rgb #b0e0e6',
|
|
'royalblue' => 'rgb #4169e1',
|
|
'royalblue1' => 'rgb #4876ff',
|
|
'royalblue2' => 'rgb #436eee',
|
|
'royalblue3' => 'rgb #3a5fcd',
|
|
'royalblue4' => 'rgb #27408b',
|
|
'skyblue' => 'rgb #87ceeb',
|
|
'skyblue1' => 'rgb #87ceff',
|
|
'skyblue2' => 'rgb #7ec0ee',
|
|
'skyblue3' => 'rgb #6ca6cd',
|
|
'skyblue4' => 'rgb #4a708b',
|
|
'slateblue' => 'rgb #6a5acd',
|
|
'slateblue1' => 'rgb #836fff',
|
|
'slateblue2' => 'rgb #7a67ee',
|
|
'slateblue3' => 'rgb #6959cd',
|
|
'slateblue4' => 'rgb #473c8b',
|
|
'steelblue' => 'rgb #4682b4',
|
|
'steelblue1' => 'rgb #63b8ff',
|
|
'steelblue2' => 'rgb #5cacee',
|
|
'steelblue3' => 'rgb #4f94cd',
|
|
'steelblue4' => 'rgb #36648b',
|
|
'aquamarine' => 'rgb #7fffd4',
|
|
'aquamarine1' => 'rgb #7fffd4',
|
|
'aquamarine2' => 'rgb #76eec6',
|
|
'aquamarine3' => 'rgb #66cdaa',
|
|
'aquamarine4' => 'rgb #458b74',
|
|
'azure' => 'rgb #f0ffff',
|
|
'azure1' => 'rgb #f0ffff',
|
|
'azure2' => 'rgb #e0eeee',
|
|
'azure3' => 'rgb #c1cdcd',
|
|
'azure4' => 'rgb #838b8b',
|
|
'blue' => 'rgb #0000ff',
|
|
'blue1' => 'rgb #0000ff',
|
|
'blue2' => 'rgb #0000ee',
|
|
'blue3' => 'rgb #0000cd',
|
|
'blue4' => 'rgb #00008b',
|
|
'cyan' => 'rgb #00ffff',
|
|
'cyan1' => 'rgb #00ffff',
|
|
'cyan2' => 'rgb #00eeee',
|
|
'cyan3' => 'rgb #00cdcd',
|
|
'cyan4' => 'rgb #008b8b',
|
|
'navy' => 'rgb #000080',
|
|
'turquoise' => 'rgb #40e0d0',
|
|
'turquoise1' => 'rgb #00f5ff',
|
|
'turquoise2' => 'rgb #00e5ee',
|
|
'turquoise3' => 'rgb #00c5cd',
|
|
'turquoise4' => 'rgb #00868b',
|
|
'darkslategray' => 'rgb #2f4f4f',
|
|
'darkslategray1' => 'rgb #97ffff',
|
|
'darkslategray2' => 'rgb #8deeee',
|
|
'darkslategray3' => 'rgb #79cdcd',
|
|
'darkslategray4' => 'rgb #528b8b',
|
|
'rosybrown' => 'rgb #bc8f8f',
|
|
'rosybrown1' => 'rgb #ffc1c1',
|
|
'rosybrown2' => 'rgb #eeb4b4',
|
|
'rosybrown3' => 'rgb #cd9b9b',
|
|
'rosybrown4' => 'rgb #8b6969',
|
|
'saddlebrown' => 'rgb #8b4513',
|
|
'sandybrown' => 'rgb #f4a460',
|
|
'beige' => 'rgb #f5f5dc',
|
|
'brown' => 'rgb #a52a2a',
|
|
'brown1' => 'rgb #ff4040',
|
|
'brown2' => 'rgb #ee3b3b',
|
|
'brown3' => 'rgb #cd3333',
|
|
'brown4' => 'rgb #8b2323',
|
|
'burlywood' => 'rgb #deb887',
|
|
'burlywood1' => 'rgb #ffd39b',
|
|
'burlywood2' => 'rgb #eec591',
|
|
'burlywood3' => 'rgb #cdaa7d',
|
|
'burlywood4' => 'rgb #8b7355',
|
|
'chocolate' => 'rgb #d2691e',
|
|
'chocolate1' => 'rgb #ff7f24',
|
|
'chocolate2' => 'rgb #ee7621',
|
|
'chocolate3' => 'rgb #cd661d',
|
|
'chocolate4' => 'rgb #8b4513',
|
|
'peru' => 'rgb #cd853f',
|
|
'tan' => 'rgb #d2b48c',
|
|
'tan1' => 'rgb #ffa54f',
|
|
'tan2' => 'rgb #ee9a49',
|
|
'tan3' => 'rgb #cd853f',
|
|
'tan4' => 'rgb #8b5a2b',
|
|
'darkgreen' => 'rgb #006400',
|
|
'darkkhaki' => 'rgb #bdb76b',
|
|
'darkolivegreen' => 'rgb #556b2f',
|
|
'darkolivegreen1' => 'rgb #caff70',
|
|
'darkolivegreen2' => 'rgb #bcee68',
|
|
'darkolivegreen3' => 'rgb #a2cd5a',
|
|
'darkolivegreen4' => 'rgb #6e8b3d',
|
|
'darkseagreen' => 'rgb #8fbc8f',
|
|
'darkseagreen1' => 'rgb #c1ffc1',
|
|
'darkseagreen2' => 'rgb #b4eeb4',
|
|
'darkseagreen3' => 'rgb #9bcd9b',
|
|
'darkseagreen4' => 'rgb #698b69',
|
|
'forestgreen' => 'rgb #228b22',
|
|
'greenyellow' => 'rgb #adff2f',
|
|
'lawngreen' => 'rgb #7cfc00',
|
|
'lightseagreen' => 'rgb #20b2aa',
|
|
'limegreen' => 'rgb #32cd32',
|
|
'mediumseagreen' => 'rgb #3cb371',
|
|
'mediumspringgreen' => 'rgb #00fa9a',
|
|
'mintcream' => 'rgb #f5fffa',
|
|
'olivedrab' => 'rgb #6b8e23',
|
|
'olivedrab1' => 'rgb #c0ff3e',
|
|
'olivedrab2' => 'rgb #b3ee3a',
|
|
'olivedrab3' => 'rgb #9acd32',
|
|
'olivedrab4' => 'rgb #698b22',
|
|
'palegreen' => 'rgb #98fb98',
|
|
'palegreen1' => 'rgb #9aff9a',
|
|
'palegreen2' => 'rgb #90ee90',
|
|
'palegreen3' => 'rgb #7ccd7c',
|
|
'palegreen4' => 'rgb #548b54',
|
|
'seagreen' => 'rgb #2e8b57',
|
|
'seagreen1' => 'rgb #54ff9f',
|
|
'seagreen2' => 'rgb #4eee94',
|
|
'seagreen3' => 'rgb #43cd80',
|
|
'seagreen4' => 'rgb #2e8b57',
|
|
'springgreen' => 'rgb #00ff7f',
|
|
'springgreen1' => 'rgb #00ff7f',
|
|
'springgreen2' => 'rgb #00ee76',
|
|
'springgreen3' => 'rgb #00cd66',
|
|
'springgreen4' => 'rgb #008b45',
|
|
'yellowgreen' => 'rgb #9acd32',
|
|
'chartreuse' => 'rgb #7fff00',
|
|
'chartreuse1' => 'rgb #7fff00',
|
|
'chartreuse2' => 'rgb #76ee00',
|
|
'chartreuse3' => 'rgb #66cd00',
|
|
'chartreuse4' => 'rgb #458b00',
|
|
'green' => 'rgb #00ff00',
|
|
'green1' => 'rgb #00ff00',
|
|
'green2' => 'rgb #00ee00',
|
|
'green3' => 'rgb #00cd00',
|
|
'green4' => 'rgb #008b00',
|
|
'khaki' => 'rgb #f0e68c',
|
|
'khaki1' => 'rgb #fff68f',
|
|
'khaki2' => 'rgb #eee685',
|
|
'khaki3' => 'rgb #cdc673',
|
|
'khaki4' => 'rgb #8b864e',
|
|
'darkorange' => 'rgb #ff8c00',
|
|
'darkorange1' => 'rgb #ff7f00',
|
|
'darkorange2' => 'rgb #ee7600',
|
|
'darkorange3' => 'rgb #cd6600',
|
|
'darkorange4' => 'rgb #8b4500',
|
|
'darksalmon' => 'rgb #e9967a',
|
|
'lightcoral' => 'rgb #f08080',
|
|
'lightsalmon' => 'rgb #ffa07a',
|
|
'lightsalmon1' => 'rgb #ffa07a',
|
|
'lightsalmon2' => 'rgb #ee9572',
|
|
'lightsalmon3' => 'rgb #cd8162',
|
|
'lightsalmon4' => 'rgb #8b5742',
|
|
'peachpuff' => 'rgb #ffdab9',
|
|
'peachpuff1' => 'rgb #ffdab9',
|
|
'peachpuff2' => 'rgb #eecbad',
|
|
'peachpuff3' => 'rgb #cdaf95',
|
|
'peachpuff4' => 'rgb #8b7765',
|
|
'bisque' => 'rgb #ffe4c4',
|
|
'bisque1' => 'rgb #ffe4c4',
|
|
'bisque2' => 'rgb #eed5b7',
|
|
'bisque3' => 'rgb #cdb79e',
|
|
'bisque4' => 'rgb #8b7d6b',
|
|
'coral' => 'rgb #ff7f50',
|
|
'coral1' => 'rgb #ff7256',
|
|
'coral2' => 'rgb #ee6a50',
|
|
'coral3' => 'rgb #cd5b45',
|
|
'coral4' => 'rgb #8b3e2f',
|
|
'honeydew' => 'rgb #f0fff0',
|
|
'honeydew1' => 'rgb #f0fff0',
|
|
'honeydew2' => 'rgb #e0eee0',
|
|
'honeydew3' => 'rgb #c1cdc1',
|
|
'honeydew4' => 'rgb #838b83',
|
|
'orange' => 'rgb #ffa500',
|
|
'orange1' => 'rgb #ffa500',
|
|
'orange2' => 'rgb #ee9a00',
|
|
'orange3' => 'rgb #cd8500',
|
|
'orange4' => 'rgb #8b5a00',
|
|
'salmon' => 'rgb #fa8072',
|
|
'salmon1' => 'rgb #ff8c69',
|
|
'salmon2' => 'rgb #ee8262',
|
|
'salmon3' => 'rgb #cd7054',
|
|
'salmon4' => 'rgb #8b4c39',
|
|
'sienna' => 'rgb #a0522d',
|
|
'sienna1' => 'rgb #ff8247',
|
|
'sienna2' => 'rgb #ee7942',
|
|
'sienna3' => 'rgb #cd6839',
|
|
'sienna4' => 'rgb #8b4726',
|
|
'deeppink' => 'rgb #ff1493',
|
|
'deeppink1' => 'rgb #ff1493',
|
|
'deeppink2' => 'rgb #ee1289',
|
|
'deeppink3' => 'rgb #cd1076',
|
|
'deeppink4' => 'rgb #8b0a50',
|
|
'hotpink' => 'rgb #ff69b4',
|
|
'hotpink1' => 'rgb #ff6eb4',
|
|
'hotpink2' => 'rgb #ee6aa7',
|
|
'hotpink3' => 'rgb #cd6090',
|
|
'hotpink4' => 'rgb #8b3a62',
|
|
'indianred' => 'rgb #cd5c5c',
|
|
'indianred1' => 'rgb #ff6a6a',
|
|
'indianred2' => 'rgb #ee6363',
|
|
'indianred3' => 'rgb #cd5555',
|
|
'indianred4' => 'rgb #8b3a3a',
|
|
'lightpink' => 'rgb #ffb6c1',
|
|
'lightpink1' => 'rgb #ffaeb9',
|
|
'lightpink2' => 'rgb #eea2ad',
|
|
'lightpink3' => 'rgb #cd8c95',
|
|
'lightpink4' => 'rgb #8b5f65',
|
|
'mediumvioletred' => 'rgb #c71585',
|
|
'mistyrose' => 'rgb #ffe4e1',
|
|
'mistyrose1' => 'rgb #ffe4e1',
|
|
'mistyrose2' => 'rgb #eed5d2',
|
|
'mistyrose3' => 'rgb #cdb7b5',
|
|
'mistyrose4' => 'rgb #8b7d7b',
|
|
'orangered' => 'rgb #ff4500',
|
|
'orangered1' => 'rgb #ff4500',
|
|
'orangered2' => 'rgb #ee4000',
|
|
'orangered3' => 'rgb #cd3700',
|
|
'orangered4' => 'rgb #8b2500',
|
|
'palevioletred' => 'rgb #db7093',
|
|
'palevioletred1' => 'rgb #ff82ab',
|
|
'palevioletred2' => 'rgb #ee799f',
|
|
'palevioletred3' => 'rgb #cd6889',
|
|
'palevioletred4' => 'rgb #8b475d',
|
|
'violetred' => 'rgb #d02090',
|
|
'violetred1' => 'rgb #ff3e96',
|
|
'violetred2' => 'rgb #ee3a8c',
|
|
'violetred3' => 'rgb #cd3278',
|
|
'violetred4' => 'rgb #8b2252',
|
|
'firebrick' => 'rgb #b22222',
|
|
'firebrick1' => 'rgb #ff3030',
|
|
'firebrick2' => 'rgb #ee2c2c',
|
|
'firebrick3' => 'rgb #cd2626',
|
|
'firebrick4' => 'rgb #8b1a1a',
|
|
'pink' => 'rgb #ffc0cb',
|
|
'pink1' => 'rgb #ffb5c5',
|
|
'pink2' => 'rgb #eea9b8',
|
|
'pink3' => 'rgb #cd919e',
|
|
'pink4' => 'rgb #8b636c',
|
|
'red' => 'rgb #ff0000',
|
|
'red1' => 'rgb #ff0000',
|
|
'red2' => 'rgb #ee0000',
|
|
'red3' => 'rgb #cd0000',
|
|
'red4' => 'rgb #8b0000',
|
|
'tomato' => 'rgb #ff6347',
|
|
'tomato1' => 'rgb #ff6347',
|
|
'tomato2' => 'rgb #ee5c42',
|
|
'tomato3' => 'rgb #cd4f39',
|
|
'tomato4' => 'rgb #8b3626',
|
|
'darkorchid' => 'rgb #9932cc',
|
|
'darkorchid1' => 'rgb #bf3eff',
|
|
'darkorchid2' => 'rgb #b23aee',
|
|
'darkorchid3' => 'rgb #9a32cd',
|
|
'darkorchid4' => 'rgb #68228b',
|
|
'darkviolet' => 'rgb #9400d3',
|
|
'lavenderblush' => 'rgb #fff0f5',
|
|
'lavenderblush1' => 'rgb #fff0f5',
|
|
'lavenderblush2' => 'rgb #eee0e5',
|
|
'lavenderblush3' => 'rgb #cdc1c5',
|
|
'lavenderblush4' => 'rgb #8b8386',
|
|
'mediumorchid' => 'rgb #ba55d3',
|
|
'mediumorchid1' => 'rgb #e066ff',
|
|
'mediumorchid2' => 'rgb #d15fee',
|
|
'mediumorchid3' => 'rgb #b452cd',
|
|
'mediumorchid4' => 'rgb #7a378b',
|
|
'mediumpurple' => 'rgb #9370db',
|
|
'mediumpurple1' => 'rgb #ab82ff',
|
|
'mediumpurple2' => 'rgb #9f79ee',
|
|
'mediumpurple3' => 'rgb #8968cd',
|
|
'mediumpurple4' => 'rgb #5d478b',
|
|
'lavender' => 'rgb #e6e6fa',
|
|
'magenta' => 'rgb #ff00ff',
|
|
'magenta1' => 'rgb #ff00ff',
|
|
'magenta2' => 'rgb #ee00ee',
|
|
'magenta3' => 'rgb #cd00cd',
|
|
'magenta4' => 'rgb #8b008b',
|
|
'maroon' => 'rgb #b03060',
|
|
'maroon1' => 'rgb #ff34b3',
|
|
'maroon2' => 'rgb #ee30a7',
|
|
'maroon3' => 'rgb #cd2990',
|
|
'maroon4' => 'rgb #8b1c62',
|
|
'orchid' => 'rgb #da70d6',
|
|
'orchid1' => 'rgb #ff83fa',
|
|
'orchid2' => 'rgb #ee7ae9',
|
|
'orchid3' => 'rgb #cd69c9',
|
|
'orchid4' => 'rgb #8b4789',
|
|
'plum' => 'rgb #dda0dd',
|
|
'plum1' => 'rgb #ffbbff',
|
|
'plum2' => 'rgb #eeaeee',
|
|
'plum3' => 'rgb #cd96cd',
|
|
'plum4' => 'rgb #8b668b',
|
|
'purple' => 'rgb #a020f0',
|
|
'purple1' => 'rgb #9b30ff',
|
|
'purple2' => 'rgb #912cee',
|
|
'purple3' => 'rgb #7d26cd',
|
|
'purple4' => 'rgb #551a8b',
|
|
'thistle' => 'rgb #d8bfd8',
|
|
'thistle1' => 'rgb #ffe1ff',
|
|
'thistle2' => 'rgb #eed2ee',
|
|
'thistle3' => 'rgb #cdb5cd',
|
|
'thistle4' => 'rgb #8b7b8b',
|
|
'violet' => 'rgb #ee82ee',
|
|
'antiquewhite' => 'rgb #faebd7',
|
|
'antiquewhite1' => 'rgb #ffefdb',
|
|
'antiquewhite2' => 'rgb #eedfcc',
|
|
'antiquewhite3' => 'rgb #cdc0b0',
|
|
'antiquewhite4' => 'rgb #8b8378',
|
|
'floralwhite' => 'rgb #fffaf0',
|
|
'ghostwhite' => 'rgb #f8f8ff',
|
|
'navajowhite' => 'rgb #ffdead',
|
|
'navajowhite1' => 'rgb #ffdead',
|
|
'navajowhite2' => 'rgb #eecfa1',
|
|
'navajowhite3' => 'rgb #cdb38b',
|
|
'navajowhite4' => 'rgb #8b795e',
|
|
'oldlace' => 'rgb #fdf5e6',
|
|
'whitesmoke' => 'rgb #f5f5f5',
|
|
'gainsboro' => 'rgb #dcdcdc',
|
|
'ivory' => 'rgb #fffff0',
|
|
'ivory1' => 'rgb #fffff0',
|
|
'ivory2' => 'rgb #eeeee0',
|
|
'ivory3' => 'rgb #cdcdc1',
|
|
'ivory4' => 'rgb #8b8b83',
|
|
'linen' => 'rgb #faf0e6',
|
|
'seashell' => 'rgb #fff5ee',
|
|
'seashell1' => 'rgb #fff5ee',
|
|
'seashell2' => 'rgb #eee5de',
|
|
'seashell3' => 'rgb #cdc5bf',
|
|
'seashell4' => 'rgb #8b8682',
|
|
'snow' => 'rgb #fffafa',
|
|
'snow1' => 'rgb #fffafa',
|
|
'snow2' => 'rgb #eee9e9',
|
|
'snow3' => 'rgb #cdc9c9',
|
|
'snow4' => 'rgb #8b8989',
|
|
'wheat' => 'rgb #f5deb3',
|
|
'wheat1' => 'rgb #ffe7ba',
|
|
'wheat2' => 'rgb #eed8ae',
|
|
'wheat3' => 'rgb #cdba96',
|
|
'wheat4' => 'rgb #8b7e66',
|
|
'white' => 'rgb #ffffff',
|
|
'blanchedalmond' => 'rgb #ffebcd',
|
|
'darkgoldenrod' => 'rgb #b8860b',
|
|
'darkgoldenrod1' => 'rgb #ffb90f',
|
|
'darkgoldenrod2' => 'rgb #eead0e',
|
|
'darkgoldenrod3' => 'rgb #cd950c',
|
|
'darkgoldenrod4' => 'rgb #8b6508',
|
|
'lemonchiffon' => 'rgb #fffacd',
|
|
'lemonchiffon1' => 'rgb #fffacd',
|
|
'lemonchiffon2' => 'rgb #eee9bf',
|
|
'lemonchiffon3' => 'rgb #cdc9a5',
|
|
'lemonchiffon4' => 'rgb #8b8970',
|
|
'lightgoldenrod' => 'rgb #eedd82',
|
|
'lightgoldenrod1' => 'rgb #ffec8b',
|
|
'lightgoldenrod2' => 'rgb #eedc82',
|
|
'lightgoldenrod3' => 'rgb #cdbe70',
|
|
'lightgoldenrod4' => 'rgb #8b814c',
|
|
'lightgoldenrodyellow' => 'rgb #fafad2',
|
|
'lightyellow' => 'rgb #ffffe0',
|
|
'lightyellow1' => 'rgb #ffffe0',
|
|
'lightyellow2' => 'rgb #eeeed1',
|
|
'lightyellow3' => 'rgb #cdcdb4',
|
|
'lightyellow4' => 'rgb #8b8b7a',
|
|
'palegoldenrod' => 'rgb #eee8aa',
|
|
'papayawhip' => 'rgb #ffefd5',
|
|
'cornsilk' => 'rgb #fff8dc',
|
|
'cornsilk1' => 'rgb #fff8dc',
|
|
'cornsilk2' => 'rgb #eee8cd',
|
|
'cornsilk3' => 'rgb #cdc8b1',
|
|
'cornsilk4' => 'rgb #8b8878',
|
|
'gold' => 'rgb #ffd700',
|
|
'gold1' => 'rgb #ffd700',
|
|
'gold2' => 'rgb #eec900',
|
|
'gold3' => 'rgb #cdad00',
|
|
'gold4' => 'rgb #8b7500',
|
|
'goldenrod' => 'rgb #daa520',
|
|
'goldenrod1' => 'rgb #ffc125',
|
|
'goldenrod2' => 'rgb #eeb422',
|
|
'goldenrod3' => 'rgb #cd9b1d',
|
|
'goldenrod4' => 'rgb #8b6914',
|
|
'moccasin' => 'rgb #ffe4b5',
|
|
'yellow' => 'rgb #ffff00',
|
|
'yellow1' => 'rgb #ffff00',
|
|
'yellow2' => 'rgb #eeee00',
|
|
'yellow3' => 'rgb #cdcd00',
|
|
'yellow4' => 'rgb #8b8b00',
|
|
);
|
|
|
|
my ($ln,%grph,@data,$colno,%sz,$buf,%defcol);
|
|
my $InBG=0;
|
|
|
|
my $piestart;
|
|
my $pi=3.1459*2;
|
|
my ($fh,$fn);
|
|
|
|
my @qname=('Jan-Mar','Apr-Jun','Jul-Sep','Oct-Dec');
|
|
my @hname=('Jan-Jun','Jul-Dec');
|
|
my @mname=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
|
|
my ($stats,$ymarg,$xmarg,%stats);
|
|
$stats=\%stats;
|
|
|
|
while (<>)
|
|
{
|
|
chomp;
|
|
s/\r$//;
|
|
|
|
if (m'^\.\s*BGS\s*(\w*)')
|
|
{
|
|
my $type=($1)?$1:'pi';
|
|
if ($type ne 'FRAME')
|
|
{
|
|
$InBG=1;
|
|
%grph=();
|
|
@data=();
|
|
%stats=();
|
|
$grph{TYPE}->[0]=lc($type);
|
|
$buf="";
|
|
next;
|
|
}
|
|
}
|
|
|
|
if ($InBG and $_ eq '.BGE')
|
|
{
|
|
$InBG=0;
|
|
$buf.=".fl\n";
|
|
BuildGraph();
|
|
next;
|
|
}
|
|
|
|
if (!$InBG)
|
|
{
|
|
print "$_\n";
|
|
next;
|
|
}
|
|
|
|
s/^\s+//;
|
|
next if substr($_,0,1) eq '#';
|
|
$ln++;
|
|
|
|
if (m/^(.+?):(.*)/)
|
|
{
|
|
my $cmd=uc($1);
|
|
my (@args)=split("\t",$2);
|
|
|
|
my $cptr;
|
|
my $dup=0;
|
|
|
|
foreach my $c (@CMDS)
|
|
{
|
|
if ($cmd eq substr($c->[0],0,length($cmd)) and index("/$c->[2]/","/$grph{TYPE}->[0]/") >= 0)
|
|
{
|
|
$cptr=$c,$c->[4]=$ln if $dup == 0;
|
|
$dup++;
|
|
}
|
|
}
|
|
|
|
Log(1,"Command '$cmd' not understood") if $dup == 0;
|
|
Log(0,"Command '$cmd' is ambiguous - '$cptr->[0]' used") if $cmd ne 'SERIES' and $dup > 1;
|
|
|
|
$cmd=$cptr->[0];
|
|
|
|
if ($cmd eq 'SERIES')
|
|
{
|
|
LoadSeries(\@args);
|
|
}
|
|
elsif ($cmd eq 'SFILE')
|
|
{
|
|
if (open(F,"<$args[0]"))
|
|
{
|
|
while (<F>)
|
|
{
|
|
chomp;
|
|
s/\r$//;
|
|
s/^\s+//;
|
|
s/^S.*?://;
|
|
|
|
my (@r)=split("\t");
|
|
LoadSeries(\@r);
|
|
}
|
|
|
|
close(F);
|
|
}
|
|
else
|
|
{
|
|
Log(1,"Failed to open Series File '$args[0]'");
|
|
}
|
|
}
|
|
else
|
|
{
|
|
Log(0,$ln,"Redefined command '$cmd'") if exists($grph{$cmd});
|
|
$grph{$cmd}=\@args;
|
|
}
|
|
}
|
|
}
|
|
|
|
exit 0;
|
|
|
|
sub LoadSeries
|
|
{
|
|
my $args=shift;
|
|
|
|
if ($grph{TYPE}->[0] eq 'pi')
|
|
{
|
|
my ($nm,$val)=(@{$args});
|
|
|
|
my $valn=$val;
|
|
$valn=~s'\\.(\(..|\[.*\])''g;
|
|
$valn=~s/[^-0-9.]//g;
|
|
$valn=0 if $valn eq '';
|
|
$grph{NEGPIE}=1 if $valn < 0;
|
|
push(@data,[$valn,$nm,undef,$val]);
|
|
}
|
|
else
|
|
{
|
|
my ($sno,$txt,@data);
|
|
($sno,$txt,@data)=(@{$args});
|
|
$sno=1,$grph{BACKGROUND}=1 if uc($sno) eq 'B';
|
|
$sno-- if $sno=~m/^\d+$/ and $sno > 0;
|
|
foreach my $d (@data) {$d=~s/\((.+)\)/-$1/}
|
|
LoadData($sno,$txt,\@data);
|
|
}
|
|
}
|
|
|
|
sub BuildGraph
|
|
{
|
|
# All Commands now read, assign defaults for any missing
|
|
|
|
my $type='pi';
|
|
$type=lc($grph{TYPE}->[0]) if exists($grph{TYPE});
|
|
|
|
foreach my $c (@CMDS)
|
|
{
|
|
# Log(0,"Cmd=$c->[0]");
|
|
if (index($c->[2],$type) >= 0)
|
|
{
|
|
my $cmd=$c->[0];
|
|
|
|
if (!exists($grph{$cmd}) and $c->[1] ne 'undef')
|
|
{
|
|
my (@args)=split("\t",$c->[3]);
|
|
$args[0]='' if $#args==-1;
|
|
$grph{$cmd}=\@args;
|
|
}
|
|
|
|
# Add default scaling factors
|
|
|
|
my $scale=$c->[1];
|
|
|
|
if ($scale ne '' and exists($grph{$cmd}))
|
|
{
|
|
my $ct=-1;
|
|
|
|
foreach my $v (@{$grph{$cmd}})
|
|
{
|
|
if ($scale eq '#' and $v ne '')
|
|
{
|
|
# colours
|
|
|
|
$v=lc($v);
|
|
|
|
if (substr($v,0,1) eq '#')
|
|
{
|
|
$v=defcol("rgb $v");
|
|
}
|
|
elsif ($v=~m/(rgb|cmyk|cmy|gray|grey)\s+(.*)/)
|
|
{
|
|
$v=defcol("$1 $2");
|
|
}
|
|
elsif (exists($colours{$v}))
|
|
{
|
|
$v=defcol($colours{$v});
|
|
}
|
|
else
|
|
{
|
|
Log(0,"Colour names ($v) not found");
|
|
}
|
|
|
|
if ($cmd eq 'SCOLOURS')
|
|
{
|
|
$grph{CONTRAST}->[++$ct]=contrast($v);
|
|
}
|
|
}
|
|
elsif ($scale eq 'bool')
|
|
{
|
|
$v=lc($v);
|
|
|
|
if (substr($v,0,1) eq 'y')
|
|
{
|
|
$v=1;
|
|
}
|
|
elsif (substr($v,0,1) eq 'n')
|
|
{
|
|
$v=0;
|
|
}
|
|
}
|
|
else
|
|
{
|
|
if ($v=~m/^\s*([-0-9.+]+)\s*$/)
|
|
{
|
|
$v="$1$scale" if $scale ne 'undef';
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Now convert all values to points
|
|
|
|
if (exists($grph{$cmd}))
|
|
{
|
|
foreach my $v (@{$grph{$cmd}})
|
|
{
|
|
if ($scale ne '#' and $scale ne '' and $scale ne 'undef')
|
|
{
|
|
if ($v=~m/([\d.]+)([cimp])/i)
|
|
{
|
|
my $num=$1;
|
|
my $mul=$2;
|
|
|
|
$v=ToPoints($num,$mul,$c->[4]);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# If no ORIGIN or relative - centre it
|
|
|
|
if ($grph{TYPE}->[0] eq 'pi')
|
|
{
|
|
foreach my $i (0..1)
|
|
{
|
|
$grph{ORIGIN}->[$i]=0 if !$grph{ORIGIN}->[$i];
|
|
|
|
if ($grph{ORIGIN}->[$i]=~m/^[+-]/ or $grph{ORIGIN}->[$i] == 0)
|
|
{
|
|
$grph{ORIGIN}->[$i]+=int($grph{FRAME}->[$i]/2);
|
|
}
|
|
}
|
|
}
|
|
|
|
# VS may be a percentage of PS
|
|
|
|
if ($grph{VS}->[0]=~m/(\+|\-)?(\d+)%/)
|
|
{
|
|
my $p=$grph{PS}->[0];
|
|
my $d=$p*$2/100;
|
|
$d*=-1 if $1 and $1 eq '-';
|
|
$grph{VS}->[0]=$p+$d;
|
|
}
|
|
|
|
# Drop Shadow?
|
|
|
|
$grph{SHADE}=[];
|
|
|
|
if ($grph{SHADOW}->[0])
|
|
{
|
|
my $bg=$grph{BGCOLOUR}->[0] || 'rgb_#ffffff';
|
|
|
|
my ($coltype,$arg)=split('_',$bg,2);
|
|
my (@c)=GetComponents($arg);
|
|
my @add;
|
|
my $start;
|
|
|
|
if ($coltype eq 'cmyk')
|
|
{
|
|
$start=0xffff;
|
|
}
|
|
elsif ($coltype eq 'cmy')
|
|
{
|
|
$start=0xffff;
|
|
}
|
|
elsif ($coltype eq 'grey')
|
|
{
|
|
$start=0;
|
|
}
|
|
elsif ($coltype eq 'rgb')
|
|
{
|
|
$start=0;
|
|
}
|
|
|
|
foreach my $c (@c)
|
|
{
|
|
push(@add,($c-$start)/10);
|
|
}
|
|
|
|
foreach my $j (1..10)
|
|
{
|
|
foreach my $i (0..$#c)
|
|
{
|
|
$c[$i]-=$add[$i];
|
|
$c[$i]=0xffff if $c[$i] > 0xffff;
|
|
$c[$i]=0 if $c[$i] < 0;
|
|
}
|
|
|
|
push(@{$grph{SHADE}},defcol("$coltype #".join('',map(sprintf("%02x",$_>>8),@c))));
|
|
}
|
|
}
|
|
|
|
# Graph floor
|
|
|
|
if (exists($grph{FLOOR}) and $grph{FLOOR}->[0]=~/^C/)
|
|
{
|
|
substr($grph{FLOOR}->[0],0,1)='';
|
|
$grph{FLOORFLAG}->[0]='C';
|
|
}
|
|
else
|
|
{
|
|
$grph{FLOORFLAG}->[0]='';
|
|
}
|
|
|
|
# Frigging with horizontal bar graphs
|
|
|
|
if ($grph{HORIZONTAL}->[0])
|
|
{
|
|
# First make all series bar type
|
|
|
|
foreach my $s (@{$stats->{BAR}}) {$s=1;}
|
|
|
|
# Now alter data to $label~col1^col2...
|
|
|
|
foreach my $s (0..$#{$stats->{DATA}})
|
|
{
|
|
my $d=$stats->{DATA}->[$s];
|
|
my $v=shift(@{$d});
|
|
my $t=join('^',@{$d});
|
|
$stats->{NAME}->[$s].="~$t";
|
|
$stats->{DATA}->[$s]=[$v];
|
|
}
|
|
}
|
|
# Now find out width of any text
|
|
|
|
# my $tmpnm="busgraph-$$";
|
|
# my $tmpdir='/tmp';
|
|
#
|
|
# if (exists($ENV{GROFF_TMPDIR}))
|
|
# {
|
|
# $tmpdir=$ENV{GROFF_TMPDIR};
|
|
# }
|
|
# else
|
|
# {
|
|
# $tmpdir=$ENV{TMPDIR} if exists($ENV{TMPDIR});
|
|
# }
|
|
#
|
|
# my $seq='0000';
|
|
#
|
|
# do
|
|
# {
|
|
# $fn="$tmpdir/$tmpnm";
|
|
# $fn.="-$seq" if $seq ne '0000';
|
|
# $seq++;
|
|
# } until (! -e "$fn.dat");
|
|
#
|
|
# open($fh,">$fn.dat") or die "Failed to open '$fn.dat'";
|
|
#
|
|
# print $fh ".ps $grph{PS}->[0]\n";
|
|
# print $fh ".vs $grph{VS}->[0]\n";
|
|
# print $fh ".ft $grph{FT}->[0]\n";
|
|
#
|
|
# FindLen('I::','I');
|
|
# FindLen('II::','II');
|
|
# my $ser=0;
|
|
#
|
|
# foreach my $s (@data)
|
|
# {
|
|
# my $txt=$s->[1];
|
|
# my (@wds)=split(' ',$txt);
|
|
# $ser++;
|
|
# FindLen("S:$ser:TOT",$s->[1]);
|
|
#
|
|
# my $wd=0;
|
|
#
|
|
# foreach my $w (@wds)
|
|
# {
|
|
# $wd++;
|
|
#
|
|
# FindLen("S:${ser}:${wd}",$w);
|
|
# }
|
|
# }
|
|
#
|
|
# close($fh);
|
|
#
|
|
# LoadLengths("$fn.dat");
|
|
|
|
$buf.=".nr GRP:ll \\n[.ll]\n.ev GRP\n.ad l\n.ft $grph{FT}->[0]\n.fam ".substr($grph{FT}->[0],0,-1)."\n.ps $grph{PS}->[0]\n.vs 0\n\\M[$grph{TEXTCOLOUR}->[0]]\\c\n";
|
|
|
|
if ($grph{PDFBOOKMARK}->[0] and $grph{CAPTION}->[0])
|
|
{
|
|
$buf.=".pdfbookmark $grph{PDFBOOKMARK}->[0] ".($type eq 'pi'?'Pie':'Chart').": $grph{CAPTION}->[0]\n";
|
|
}
|
|
|
|
if ($grph{JUST}->[0] eq 'left')
|
|
{
|
|
$buf.=".nr GRP:lefx 0\n";
|
|
}
|
|
elsif ($grph{JUST}->[0] eq 'centre')
|
|
{
|
|
$buf.=".nr GRP:lefx \\n[GRP:ll]u/2-($grph{FRAME}->[0]p/2)\n";
|
|
}
|
|
else
|
|
{
|
|
$buf.=".nr GRP:lefx \\n[GRP:ll]u-$grph{FRAME}->[0]p\n";
|
|
}
|
|
|
|
if ($grph{TYPE}->[0] eq 'pi')
|
|
{
|
|
Do_Pie();
|
|
}
|
|
else
|
|
{
|
|
Do_Graph();
|
|
}
|
|
|
|
if ($grph{FLOW}->[0] and $grph{JUST}->[0] ne 'centre')
|
|
{
|
|
$buf.=".de GRP:skip\n.if \\\\n[.d]<\\\\n[GRP:mk]u+$grph{FRAME}->[1]p .sp |\\\\n[GRP:mk]u+$grph{FRAME}->[1]p\n..\n";
|
|
|
|
if ($grph{JUST}->[0] eq 'left')
|
|
{
|
|
$buf.=".sp |\\n[GRP:mk]u\n.nr GRP:JPos \\n[GRP:mk]u+$grph{FRAME}->[1]p-.9v\n.de GRP:Just\n'in -($grph{FRAME}->[0]p+8p)\n'sp \\\\n[.trunc]u\n.wh \\n[GRP:JPos]u\n..\n.wh \\n[GRP:JPos]u GRP:Just\n.in $grph{FRAME}->[0]p+8p\n";
|
|
}
|
|
elsif ($grph{JUST}->[0] eq 'right')
|
|
{
|
|
$buf.=".sp |\\n[GRP:mk]u\n.nr GRP:JPos \\n[GRP:mk]u+$grph{FRAME}->[1]p-.9v\n.de GRP:Just\n.ll +($grph{FRAME}->[0]p+8p)\n'sp \\\\n[.trunc]u\n.wh \\n[GRP:JPos]u\n..\n.wh \\n[GRP:JPos]u GRP:Just\n.ll -($grph{FRAME}->[0]p+8p)\n";
|
|
}
|
|
}
|
|
else
|
|
{
|
|
$buf.=".sp |\\n[GRP:mk]u+$grph{FRAME}->[1]p\n";
|
|
}
|
|
|
|
|
|
|
|
print ".BGS FRAME $grph{FRAME}->[0]p $grph{FRAME}->[1]p\n";
|
|
print $buf;
|
|
print ".BGE\n";
|
|
}
|
|
|
|
sub Log
|
|
{
|
|
my $crit=shift;
|
|
my $msg=shift;
|
|
|
|
print STDERR "busgrap: $msg\n";
|
|
exit 1 if $crit;
|
|
}
|
|
|
|
sub defcol
|
|
{
|
|
my $col=shift;
|
|
return('') if $col eq '';
|
|
my $colnm=$col;
|
|
$colnm=~tr[ ][_];
|
|
# return($colnm) if exists($defcol{$colnm});
|
|
|
|
my ($coltype,$arg)=split(' ',$col,2);
|
|
my (@c)=GetComponents($arg);
|
|
|
|
$buf.=".defcolor $colnm $coltype #".join('',map(sprintf("%02x",$_>>8),@c))."\n";
|
|
|
|
if ($coltype eq 'cmyk')
|
|
{
|
|
$c[3]+=0x10000*$grph{DARKER}->[0];
|
|
}
|
|
elsif ($coltype eq 'cmy')
|
|
{
|
|
foreach my $c (@c) {$c/=$grph{DARKER}->[0];}
|
|
}
|
|
elsif ($coltype eq 'gray')
|
|
{
|
|
$c[0]-=0x10000*$grph{DARKER}->[0];
|
|
}
|
|
elsif ($coltype eq 'rgb')
|
|
{
|
|
foreach my $c (@c) {$c*=$grph{DARKER}->[0];}
|
|
}
|
|
|
|
foreach my $c (@c)
|
|
{
|
|
$c=0xffff if ($c > 0xffff);
|
|
$c=0 if ($c<0);
|
|
}
|
|
|
|
$buf.=".defcolor ${colnm}DK $coltype #".join('',map(sprintf("%02x",$_>>8),@c))."\n";
|
|
|
|
$defcol{$colnm}=1;
|
|
return($colnm);
|
|
}
|
|
|
|
sub contrast
|
|
{
|
|
my $col=shift;
|
|
|
|
my ($coltype,$arg)=split('_',$col,2);
|
|
my (@c)=GetComponents($arg);
|
|
|
|
# (299*R + 587*G + 114*B) / 1000
|
|
|
|
if ($coltype eq "rgb")
|
|
{
|
|
return(((($c[0]>>8)*299 + ($c[1]>>8)*587 + ($c[2]>>8)*114)/1000)>128?'black':'white');
|
|
}
|
|
elsif ($coltype eq "grey")
|
|
{
|
|
return(($c[0]>128)?'black':'white');
|
|
}
|
|
|
|
return(undef);
|
|
}
|
|
|
|
sub GetComponents
|
|
{
|
|
my $arg=shift;
|
|
|
|
if ($arg=~m/([0-9.]+)f?\s+([0-9.]+)f?\s+([0-9.]+)f?/)
|
|
{
|
|
return($1*65535,$2*65535,$3*65535)
|
|
}
|
|
elsif ($arg=~m/(\d+)\s+(\d+)\s+(\d+)/)
|
|
{
|
|
return($1,$2,$3)
|
|
}
|
|
elsif (substr($arg,0,2) eq '##')
|
|
{
|
|
return(map(hex($_),$arg=~m/[0-9a-fA-F]{4}/g));
|
|
}
|
|
elsif (substr($arg,0,1) eq '#')
|
|
{
|
|
return((map(hex($_) << 8,$arg=~m/[0-9a-fA-F]{2}/g)));
|
|
}
|
|
|
|
Log(0,"Failed to convert colour component '$arg'");
|
|
return(());
|
|
}
|
|
|
|
sub FindLen
|
|
{
|
|
my $key=shift;
|
|
my $val=shift;
|
|
|
|
print $fh ".nr tm \\w'$val'\n.tm $key:\\n[tm]:\\n[rst]:\\n[rsb]\n";
|
|
}
|
|
|
|
sub LoadLengths
|
|
{
|
|
my $fn=shift;
|
|
|
|
open(F,"groff $fn -Z 2>&1 |") or die "Can't run groff!\n";
|
|
|
|
while (<F>)
|
|
{
|
|
chomp;
|
|
|
|
my (@r)=split(':');
|
|
|
|
$sz{$r[0]}->{$r[1]}->{$r[2]}=[@r[3..5]];
|
|
}
|
|
|
|
close(F) or die "Spawning groff failed!\n";
|
|
}
|
|
|
|
sub ToPoints
|
|
{
|
|
my $num=shift;
|
|
my $unit=shift;
|
|
my $ln=shift;
|
|
|
|
if ($unit eq 'i')
|
|
{
|
|
return($num*72);
|
|
}
|
|
elsif ($unit eq 'c')
|
|
{
|
|
return int($num*72/2.54);
|
|
}
|
|
elsif ($unit eq 'm') # millimetres
|
|
{
|
|
return int($num*72/25.4);
|
|
}
|
|
elsif ($unit eq 'p')
|
|
{
|
|
return($num);
|
|
}
|
|
elsif ($unit eq 'P')
|
|
{
|
|
return($num*6);
|
|
}
|
|
else
|
|
{
|
|
Log(1,$ln,"Unknown scaling factor '$unit'");
|
|
}
|
|
}
|
|
|
|
sub Do_Pie
|
|
{
|
|
my $tot=0;
|
|
my $totval='';
|
|
my $srt;
|
|
$piestart=$pi/8;
|
|
my $pieradx=$grph{XRAD}->[0]*1000;
|
|
my $pierady=$grph{YRAD}->[0]*1000;
|
|
my $pct=$grph{PDECIMALS}->[0];
|
|
my $residual=$grph{OTHERS}->[0];
|
|
my $key=$grph{KEYBOX}->[0];
|
|
my $hole=$grph{HOLE}->[0];
|
|
my $shadv=int((($pieradx+$pierady)/2)*.12);
|
|
my $shadh=int($shadv/2);
|
|
my $usey=$grph{FRAME}->[1];
|
|
my $usex=$grph{FRAME}->[0];
|
|
Log(1,0,"No Series data found") if $#data == -1;
|
|
|
|
my (@wdgs)=(@data);
|
|
|
|
if ($grph{SORT}->[0])
|
|
{
|
|
foreach my $wdg (sort {$b->[0] <=> $a->[0]} @wdgs)
|
|
{
|
|
$tot+=$wdg->[0];
|
|
push(@{$srt},$wdg);
|
|
}
|
|
}
|
|
else
|
|
{
|
|
foreach my $wdg (@wdgs)
|
|
{
|
|
$tot+=$wdg->[0];
|
|
push(@{$srt},$wdg);
|
|
}
|
|
}
|
|
|
|
my $totpctval=0;
|
|
|
|
my $bot=scalar(@wdgs)-1;
|
|
my $label=$grph{LABEL}->[0];
|
|
$label='' if $key;
|
|
return if $tot == 0;
|
|
return if $bot+1 < 1;
|
|
|
|
foreach my $wdg (@{$srt})
|
|
{
|
|
my $pctval=sprintf("%0.*f",abs(${pct}),$wdg->[0]*100/$tot);
|
|
$wdg->[2]=$pctval;
|
|
$totpctval+=$pctval;
|
|
}
|
|
|
|
$srt->[0]->[2]+=(100-$totpctval); # "correction" to make percentages = 100
|
|
|
|
my $srt2;
|
|
my $bot2=$bot;
|
|
|
|
# for (my $j=0; $j <= $bot2; $j++)
|
|
# {
|
|
# push(@{$srt2},$srt->[$j]);
|
|
#
|
|
# if ($j < $bot2)
|
|
# {
|
|
# push(@{$srt2},$srt->[$bot2--]);
|
|
# }
|
|
# }
|
|
#
|
|
# $srt=$srt2;
|
|
|
|
my $residtxt='';
|
|
|
|
for (my $j=$bot; $j > 0; $j--)
|
|
{
|
|
next if !defined($srt->[$j]) or $key;
|
|
|
|
if ($srt->[$j]->[2] < $residual)
|
|
{
|
|
my $i=$j;
|
|
my $t=$srt->[$j]->[2];
|
|
my $tc=1;
|
|
|
|
while ($i > 0 and (($t+$srt->[$i-1]->[2]) < ($residual*2)) or (($t+$srt->[$i-1]->[2])>=($residual*2) and ($srt->[$i-1]->[2] < $residual)))
|
|
{
|
|
$i--;
|
|
$t+=$srt->[$i]->[2];
|
|
$tc++;
|
|
}
|
|
|
|
if ($i < $j)
|
|
{
|
|
$residtxt.=', ' if $residtxt ne '';
|
|
$residtxt.=FillTplt($grph{LABEL}->[0],$srt->[$i]->[1],$srt->[$i]->[3],$srt->[$i]->[2],$pct);
|
|
$srt->[$i]->[1]="Others";
|
|
my $rt='';
|
|
|
|
foreach my $k ($i+1..$j)
|
|
{
|
|
$srt->[$i]->[2]+=$srt->[$k]->[2];
|
|
$srt->[$i]->[0]+=$srt->[$k]->[0];
|
|
$residtxt.=', ' if $residtxt ne '';
|
|
$rt=FillTplt($grph{LABEL}->[0],$srt->[$k]->[1],$srt->[$k]->[3],$srt->[$k]->[2],$pct);
|
|
$rt=~s/ /\\ /g;
|
|
$residtxt.=$rt;
|
|
$srt->[$k]=undef;
|
|
}
|
|
|
|
$srt->[$i]->[3]=$srt->[$i]->[0];
|
|
}
|
|
}
|
|
}
|
|
|
|
if (!$grph{NEGPIE})
|
|
{
|
|
$buf.=".ne ${usey}p\n.nf\n.vs 0\n.mk GRP:mk\n";
|
|
$buf.=".in \\n[GRP:lefx]u\n\\Z'\\D't $grph{THICKNESS}->[0]p'\\m[$grph{TEXTCOLOUR}->[0]]\\M[$grph{LINECOLOUR}->[0]]'\\c\n";
|
|
|
|
if ($grph{BGCOLOUR}->[0] ne '')
|
|
{
|
|
$buf.="\\Z@\\M[$grph{BGCOLOUR}->[0]]\\D'P ${usex}p 0 0 ${usey}p -${usex}p 0 0 -${usey}p'\\M[]@\\c\n";
|
|
}
|
|
|
|
if ($grph{BORDER}->[0])
|
|
{
|
|
$buf.="\\Z@\\D't $grph{BORDER}->[0]p'@\\Z@\\m[$grph{BRDCOLOUR}->[0]]\\D'p ${usex}p 0 0 ${usey}p -${usex}p 0 0 -${usey}p'\\D't $grph{THICKNESS}->[0]p'\\m[]@\\c\n";
|
|
}
|
|
|
|
$buf.=".fl\n.vs $grph{VS}->[0]p\n";
|
|
|
|
if ($grph{CAPTION}->[0] ne '')
|
|
{
|
|
$buf.=".fi\n.ad c\n.ll ${usex}p+\\n[GRP:lefx]u\n\\s'+2p'$grph{CAPTION}->[0]\\s'-2p'\n.sp -1\n.ad\n.nf\n";
|
|
}
|
|
|
|
$buf.="\\v'$grph{ORIGIN}->[1]p'\\h'$grph{ORIGIN}->[0]p'\\c\n";
|
|
my $lastfill=scalar(@{$grph{SHADE}})-1;
|
|
my $pie3d=$grph{'3D'}->[0];
|
|
|
|
if ($lastfill >= 1)
|
|
{
|
|
$buf.="\\v'${pie3d}p'";
|
|
$buf.="\\Z@\\v'${shadv}u'\\h'${shadh}u-${pieradx}u'";
|
|
foreach my $j (0..$lastfill-1) # must have at least 2 colours
|
|
{
|
|
$buf.="\\Z^\\M[".$grph{SHADE}->[$j]."]\\D'E ".(${pieradx}*2)."u ".(${pierady}*2)."u'^\\v'-".($shadv/$lastfill)."u'\\h'-".($shadh/$lastfill)."u'\\M[]";
|
|
}
|
|
|
|
$buf.="\\Z^\\h'-".($shadh/$lastfill)."u'\\M[".$grph{SHADE}->[$lastfill]."]\\D'E ".(${pieradx}*2)."u ".(${pierady}*2)."u'^\\M[]";
|
|
$buf.="@\\c\n";
|
|
$buf.="\\v'-${pie3d}p'\\c\n";
|
|
}
|
|
|
|
my $nooutline=($bot==0)?1:0;
|
|
$nooutline=1 if $grph{COLOURED}->[0];
|
|
|
|
if ($pie3d)
|
|
{
|
|
for (my $j=0; $j <= $bot; $j++)
|
|
{
|
|
next if !defined($srt->[$j]);
|
|
my ($val,$txt,$pctval)=(@{$srt->[$j]});
|
|
|
|
DoWedge3d(($val/$tot)*360,$grph{SCOLOURS}->[$j]."DK",$txt,$pieradx,$pierady,$nooutline,$grph{'3D'}->[0]) if $pct < 0 or $pctval > 0;
|
|
}
|
|
}
|
|
|
|
for (my $j=0; $j <= $bot; $j++)
|
|
{
|
|
next if !defined($srt->[$j]);
|
|
my ($val,$txt,$pctval,$valtxt)=(@{$srt->[$j]});
|
|
|
|
$pctval=($pct>=0)?sprintf("%0.*f",abs(${pct}),$pctval):'';
|
|
|
|
my $tmplt=FillTplt($grph{LABEL}->[0],$txt,$valtxt,$pctval,$pct);
|
|
|
|
$txt=$tmplt if $pct >= 0;
|
|
$txt='' if $label eq '';
|
|
|
|
DoWedge(($val/$tot)*360,$grph{SCOLOURS}->[$j],$txt,$pieradx,$pierady,$nooutline,$grph{'3D'}->[0]) if $pct < 0 or $pctval > 0;
|
|
}
|
|
|
|
if ($hole)
|
|
{
|
|
$piestart=$pi/8;
|
|
DoWedge(360,$grph{BGCOLOUR}->[0],'',$pieradx*$hole,$pierady*$hole,1,0);
|
|
}
|
|
|
|
if ($residtxt ne '')
|
|
{
|
|
my $ry=int($grph{ORIGIN}->[1]+$grph{YRAD}->[0]+$grph{'3D'}->[0]+2);
|
|
# setupfield($fldp,0,1,0);
|
|
$buf.=".ll ".($grph{FRAME}->[0])."p\n";
|
|
$buf.=".fi\n.ad c\n.sp ${ry}p+1.5v\nOthers includes: $residtxt\n.nf\n.ad l\n";
|
|
}
|
|
|
|
}
|
|
|
|
if ($key and !$grph{NEGPIE})
|
|
{
|
|
my $boxlabels=join("\t",@{$grph{BOXLABELS}});
|
|
my $boxheads=join("\t",@{$grph{BOXHEADS}});
|
|
my $boxtabs=join(' ',@{$grph{BOXTABS}});
|
|
$buf.=".vs 0\n.sp |\\n[GRP:mk]u+$grph{BOXFRAME}->[1]p\n.in +$grph{BOXFRAME}->[0]p\n.ta $boxtabs\n.vs\n.in +(1m+4p)\n\\fB$boxheads\\fP\n.sp -.2\n.in -(1m+4p)\n";
|
|
|
|
for (my $j=0; $j <= $bot; $j++)
|
|
{
|
|
next if !defined($srt->[$j]);
|
|
my ($val,$txt,$pctval,$valtxt)=(@{$srt->[$j]});
|
|
my $textcol=$grph{TEXTCOLOUR}->[0];
|
|
my $linecol=$grph{LINECOLOUR}->[0];
|
|
$linecol=$grph{SCOLOURS}->[$j] if $grph{COLOURED}->[0];
|
|
$valtxt=FillTplt($boxlabels,$txt,$valtxt,$pctval,$pct);
|
|
|
|
$buf.="\\M[$grph{SCOLOURS}->[$j]]\\m[$linecol]";
|
|
$buf.="\\Z!\\D'P 0 1 1 0 0 -1'!" if $val > 0;
|
|
$buf.="\\D'p 0 1 1 0 0 -1'\\M[]\n.in +1m\n.in +4p\n.sp -.2v\n";
|
|
$buf.="\\m[$textcol]$valtxt\\m[]\n.sp -.5\n.in -(1m+4p)\n";
|
|
}
|
|
|
|
# if ($totval and $bot > 0)
|
|
# {
|
|
# my $pctval=($pct>=0)?sprintf("%0.*f%%",abs(${pct}),100):'';
|
|
# $buf.=".in +1m\n'in +$fldk->{INDENT}->{LEFT}p\n'sp +.8v\nTotal\\c\n.in -1m\n.in -$fldk->{INDENT}->{LEFT}p\n'sp -1\n\t$totval\t$pctval\n";
|
|
# }
|
|
}
|
|
|
|
$buf.=".fl\n.ev\n";
|
|
# print $buf;
|
|
}
|
|
|
|
sub FillTplt
|
|
{
|
|
my $tmplt=shift;
|
|
my $txt=shift;
|
|
my $valtxt=shift;
|
|
my $pctval=shift;
|
|
my $pct=shift;
|
|
|
|
$tmplt=~s/\$text/$txt/ge;
|
|
$tmplt=~s/\$value/$valtxt/ge;
|
|
$tmplt=~s/\$percent/sprintf("%0.*f",abs($pct),$pctval)/ge;
|
|
|
|
return($tmplt);
|
|
}
|
|
|
|
sub PtoR
|
|
{
|
|
my $theta=shift;
|
|
my $radx=shift;
|
|
my $rady=shift;
|
|
|
|
my $y=-int(sin($theta)*$rady);
|
|
my $x=int(cos($theta)*$radx);
|
|
|
|
return ($x,$y);
|
|
}
|
|
|
|
sub rad
|
|
{
|
|
my $deg=shift;
|
|
|
|
return((($deg)/360)*$pi);
|
|
}
|
|
|
|
sub deg
|
|
{
|
|
my $rad=shift;
|
|
|
|
return(($rad*360)/$pi);
|
|
}
|
|
|
|
sub DoWedge
|
|
{
|
|
my ($ox,$oy)=(0,0);
|
|
my $end=rad($_[0])+$piestart;
|
|
my $col=$_[1];
|
|
my $txt=$_[2];
|
|
my $pieradx=$_[3];
|
|
my $pierady=$_[4];
|
|
my $nooutline=$_[5];
|
|
my $depth3d=$_[6]*1000;
|
|
my $step=.05;
|
|
my $points='';
|
|
my $j;
|
|
|
|
for ($j=$piestart; $j<=$end; $j+=$step)
|
|
{
|
|
# $j=$end if $end-$j < $step;
|
|
my ($x,$y)=PtoR($j,$pieradx,$pierady);
|
|
$x-=$ox;
|
|
$y-=$oy;
|
|
$points.="${x}u ${y}u ";
|
|
$ox+=$x;
|
|
$oy+=$y;
|
|
}
|
|
|
|
if ($j < $end+$step)
|
|
{
|
|
$j=$end;
|
|
my ($x,$y)=PtoR($j,$pieradx,$pierady);
|
|
$x-=$ox;
|
|
$y-=$oy;
|
|
$points.="${x}u ${y}u ";
|
|
$ox+=$x;
|
|
$oy+=$y;
|
|
}
|
|
|
|
$points.="-${ox}u -${oy}u'";
|
|
$buf.="\\M[$col]\\D'P 0 0 $points\\M[]\\c\n";
|
|
$buf.="\\m[$grph{LINECOLOUR}->[0]]\\D'p 0 0 $points\\m[]\\c\n" if !$nooutline;
|
|
$j=$piestart+(($end-$piestart)/2);
|
|
while ($j-$pi >= 0) {$j-=$pi;}
|
|
$piestart=$end;
|
|
return if $txt eq '';
|
|
my ($x,$y)=PtoR($j,$pieradx*1.05,$pierady*1.15);
|
|
$depth3d=0 if !($j>=$pi/2 and $j < $pi);
|
|
$buf.=".nr wi \\w'$txt'\n";
|
|
$buf.="\\Z@\\h'${x}u'\\v'${y}u+${depth3d}u'";
|
|
$buf.="\\v'\\n[rsb]u'" if $y < -1000;
|
|
$buf.="\\v'\\n[rst]u'" if $y > 1000;
|
|
rjust($txt) if $x < -1000;
|
|
ljust($txt) if $x > 1000;
|
|
cjust($txt) if abs($x) <= 1000;
|
|
$buf.="@\\c\n";
|
|
my($x1,$y1)=PtoR($j,$pieradx,$pierady);
|
|
$x-=$x1;
|
|
$y-=$y1;
|
|
$y1+=$depth3d;
|
|
$buf.="\\Z@\\h'${x1}u'\\v'${y1}u'\\D'l ${x}u ${y}u'@\\c\n";
|
|
}
|
|
|
|
sub DoWedge3d
|
|
{
|
|
my ($ox,$oy)=(0,0);
|
|
my $end=rad($_[0])+$piestart;
|
|
my $col=$_[1];
|
|
my $txt=$_[2];
|
|
my $pieradx=$_[3];
|
|
my $pierady=$_[4];
|
|
my $nooutline=$_[5];
|
|
my $depth3d=$_[6]*1000;
|
|
my $step=.05;
|
|
my $points='';
|
|
my $j;
|
|
my $doing3d=0;
|
|
my $predark='';
|
|
my $offs;
|
|
my $sx;
|
|
|
|
for ($j=$piestart; $j<=$end; $j+=$step)
|
|
{
|
|
# $j=$end if $end-$j < $step;
|
|
my ($x,$y)=PtoR($j,$pieradx,$pierady);
|
|
if ($doing3d==0 and $j>=$pi/2 and $j < $pi)
|
|
{
|
|
$doing3d=1;
|
|
$offs=$y+$depth3d;
|
|
$ox=$x;
|
|
$oy=$y;
|
|
$sx=$x;
|
|
$predark="0u ${offs}u";
|
|
}
|
|
elsif ($doing3d==1 and $j>=$pi)
|
|
{
|
|
$doing3d=2;
|
|
last;
|
|
}
|
|
elsif ($doing3d==1)
|
|
{
|
|
$x-=$ox;
|
|
$y-=$oy;
|
|
$points.="${x}u ${y}u ";
|
|
$ox+=$x;
|
|
$oy+=$y;
|
|
}
|
|
}
|
|
|
|
if ($doing3d==1 and $j < $end+$step)
|
|
{
|
|
$j=$end;
|
|
my ($x,$y)=PtoR($j,$pieradx,$pierady);
|
|
$x-=$ox;
|
|
$y-=$oy;
|
|
$points.="${x}u ${y}u ";
|
|
$ox+=$x;
|
|
$oy+=$y;
|
|
}
|
|
|
|
if ($doing3d)
|
|
{
|
|
$offs=$depth3d+$oy;
|
|
my $ex=$sx-$ox;
|
|
$points.="0 -${offs}u ${ex}u 0'\\h'-${sx}u";
|
|
$buf.="\\M[$col]\\h'${sx}u'\\D'P $predark $points'\\M[]\\c\n";
|
|
$buf.="\\h'${sx}u'\\m[$grph{LINECOLOUR}->[0]]\\D'p $predark $points'\\m[]\\c\n" if !$nooutline;
|
|
}
|
|
|
|
$j=$piestart+(($end-$piestart)/2);
|
|
$piestart=$end;
|
|
}
|
|
|
|
sub rjust
|
|
{
|
|
my $txt=shift;
|
|
|
|
$buf.="\\h'-\\n[wi]u'$txt";
|
|
}
|
|
|
|
sub ljust
|
|
{
|
|
my $txt=shift;
|
|
|
|
$buf.="$txt";
|
|
}
|
|
|
|
sub cjust
|
|
{
|
|
my $txt=shift;
|
|
|
|
$buf.="\\h'-\\n[wi]u/2u'$txt";
|
|
}
|
|
|
|
sub Do_Graph
|
|
{
|
|
CalcData();
|
|
PlotData();
|
|
}
|
|
|
|
sub LoadData
|
|
{
|
|
my $s=shift;
|
|
my $nm=shift;
|
|
my $d=shift;
|
|
|
|
if (uc($s) eq 'X')
|
|
{
|
|
push(@{$stats->{LABELS}},@{$d});
|
|
}
|
|
elsif (uc($s) eq 'A')
|
|
{
|
|
push(@{$stats->{ANCHOR}},undef,@{$d});
|
|
}
|
|
else
|
|
{
|
|
if (uc(substr($nm,0,4)) eq "BAR:")
|
|
{
|
|
$nm=substr($nm,4);
|
|
$stats->{BAR}->[$s]=1;
|
|
}
|
|
else
|
|
{
|
|
$stats->{BAR}->[$s]=0;
|
|
}
|
|
push(@{$stats->{DATA}->[$s]},@{$d});
|
|
$stats->{NAME}->[$s]=$nm;
|
|
}
|
|
}
|
|
|
|
sub CalcData
|
|
{
|
|
my $pointsz=$grph{PS}->[0];
|
|
my ($min,$max,$factor,$range,$diff,$steps,$step,$bars);
|
|
my $floorflag=$grph{FLOORFLAG}->[0];
|
|
my $horizontal=$grph{HORIZONTAL}->[0];
|
|
|
|
$factor=0;
|
|
|
|
foreach my $set (@{$stats->{DATA}})
|
|
{
|
|
next if !defined($set);
|
|
$#{$set}=$#{$stats->{LABELS}};
|
|
my @tset=@{$set};
|
|
|
|
while (@tset)
|
|
{
|
|
my $y=shift(@tset);
|
|
last if !defined($y);
|
|
next if $y eq '.';
|
|
|
|
if ($y =~ m/\.(\d+)$/)
|
|
{
|
|
$factor=length($1) if length($1) > $factor;
|
|
}
|
|
}
|
|
}
|
|
|
|
$stats->{YFACTOR}=$factor;
|
|
my $floor=(exists($grph{FLOOR}))?$grph{FLOOR}->[0]*10**$factor:undef;
|
|
$min=$max=$floor if defined($floor);
|
|
|
|
foreach my $set (@{$stats->{DATA}})
|
|
{
|
|
next if !defined($set);
|
|
my @tset=@{$set};
|
|
|
|
while (@tset)
|
|
{
|
|
my $y=shift(@tset);
|
|
last if !defined($y);
|
|
next if $y eq '.';
|
|
|
|
$y*=10**$factor;
|
|
$min=$max=$y if !defined($min);
|
|
|
|
$min=$y if $y < $min;
|
|
$max=$y if $y > $max;
|
|
}
|
|
}
|
|
|
|
if (exists($stats->{ANCHOR}))
|
|
{
|
|
foreach my $y (@{$stats->{ANCHOR}})
|
|
{
|
|
next if !defined($y);
|
|
next if $y eq '.';
|
|
my $y2=$y*10**$factor;
|
|
$min=$y2 if !defined($min) or $y2 < $min;
|
|
$max=$y2 if !defined($max) or $y2 > $max;
|
|
}
|
|
}
|
|
|
|
if ($floorflag eq 'C' and $floor >= $min and $floor <= $max)
|
|
{
|
|
my $diffmax=$max-$floor;
|
|
my $diffmin=$floor-$min;
|
|
|
|
$max=$floor+$diffmin if $diffmax < $diffmin;
|
|
$min=$floor-$diffmax if $diffmax > $diffmin;
|
|
}
|
|
|
|
$bars=0;
|
|
|
|
foreach my $bar (@{$stats->{BAR}})
|
|
{
|
|
next if !defined($bar);
|
|
$bar=1 if $horizontal; # Only bars can be horizontal
|
|
$bars++ if $bar;
|
|
}
|
|
|
|
$bars++ if $bars;
|
|
|
|
foreach my $xlab (@{$stats->{LABELS}})
|
|
{
|
|
next if !defined($xlab);
|
|
|
|
if ($xlab=~m/^([A-Z]{3,3})\-(\d+)/i)
|
|
{
|
|
$xlab=ucfirst(lc($1)).'~'.(($2<30)?$2+2000:($2>100)?$2:$2+1900);
|
|
}
|
|
elsif ($xlab=~m/^(\d+)Q(\d+)/)
|
|
{
|
|
$xlab=$qname[$1-1].'~'.(($2<30)?$2+2000:($2>100)?$2:$2+1900);
|
|
}
|
|
elsif ($xlab=~m/^(\d+)H(\d+)/)
|
|
{
|
|
$xlab=$hname[$1-1].'~'.(($2<30)?$2+2000:($2>100)?$2:$2+1900);
|
|
}
|
|
elsif ($xlab=~m/^(\d+)\/(\d+)/)
|
|
{
|
|
$xlab=$mname[$1-1].'~'.(($2<30)?$2+2000:($2>100)?$2:$2+1900);
|
|
}
|
|
}
|
|
|
|
my @lbnd=(-1,-1,-1,-1);
|
|
my @lbvl=('','','','');
|
|
my $lbrows=-1;
|
|
|
|
# X labels can be split over multiple rows (1-4)
|
|
|
|
foreach my $j (0..scalar(@{$stats->{LABELS}})-1)
|
|
{
|
|
my @vals=split('~',$stats->{LABELS}->[$j]);
|
|
|
|
foreach my $i (0..3)
|
|
{
|
|
if (!defined($vals[$i]))
|
|
{
|
|
$stats->{LABND}->[$j]->[$i]=-1;
|
|
next;
|
|
}
|
|
|
|
$lbrows=$i if $i > $lbrows;
|
|
|
|
if ($vals[$i] ne $lbvl[$i])
|
|
{
|
|
# Differs
|
|
$lbvl[$i]=$vals[$i];
|
|
$lbnd[$i]=$j;
|
|
$stats->{LABND}->[$j]->[$i]=$j;
|
|
}
|
|
else
|
|
{
|
|
$stats->{LABND}->[$lbnd[$i]]->[$i]=$j if $lbnd[$i] > -1;
|
|
}
|
|
}
|
|
|
|
$stats->{LABELS}->[$j]=\@vals;
|
|
}
|
|
|
|
$min=$max=0 if !defined($min);
|
|
$range=$max-$min;
|
|
$range=10*10**$factor,$min--,$max++ if $range/10**$factor < .01;
|
|
$min/=10**$factor;
|
|
$max/=10**$factor;
|
|
$stats->{YRANGE}=$range;
|
|
$stats->{XLABS}=$lbrows+1;
|
|
|
|
$steps=10;
|
|
$steps=$grph{STEPS}->[0] if exists($grph{STEPS});
|
|
my $ticksz=$range/($steps-1);
|
|
my $x=ceil(log10($ticksz)-1);
|
|
my $pow10x=10**$x;
|
|
$ticksz=ceil($ticksz/$pow10x)*$pow10x/10**$factor;
|
|
my $lo2=$ticksz*round($min/$ticksz);
|
|
my $hi2=$ticksz*round($max/$ticksz);
|
|
$lo2-=$ticksz if $min < $lo2;
|
|
$hi2+=$ticksz if $max >= $hi2;
|
|
$steps=sprintf("%0f",($hi2-$lo2)/$ticksz);
|
|
$stats->{YMIN}=$lo2;
|
|
$stats->{YMAX}=$hi2;
|
|
$stats->{YSTEP}=$ticksz;
|
|
$stats->{YSTEPS}=$steps;
|
|
# print STDERR "Min=$min, Max=$max, Lo=$lo2, Hi=$hi2, Sz=",$ticksz,", Ticks=$steps\n";
|
|
# for (my $j=$lo2; $j<=$hi2; $j+=$ticksz) {print STDERR "$j\n";}
|
|
# print STDERR "\n";
|
|
|
|
# # $range=10*10**$factor,$min--,$max++ if $range==0;
|
|
# $stats->{YRANGE}=$range;
|
|
# $stats->{XLABS}=$lbrows+1;
|
|
#
|
|
# $steps=10;
|
|
# my $maxstep=11;
|
|
# $maxstep=$grph{STEPS} if exists($grph{STEPS});
|
|
# $step=-1;
|
|
#
|
|
# while ($steps > 9)
|
|
# {
|
|
# $step++;
|
|
# $steps=int($range/(10**$step)+1);
|
|
# }
|
|
#
|
|
# $step=10**$step;
|
|
# $step/=10, $steps*=10 if $steps < 2;
|
|
# $step/=5, $steps*=5 if $steps < 5 and $steps < $maxstep;
|
|
# $step/=2, $steps*=2 if $steps < 7 and $steps < $maxstep;
|
|
# $step*=2, $steps=int($steps/2) if $steps > $maxstep;
|
|
#
|
|
# $stats->{YMIN}=int($min/$step)*$step/10**$factor;
|
|
# $stats->{YMAX}=(int($max/$step)+1)*$step/10**$factor;
|
|
# $stats->{YSTEP}=$step/10**$factor;
|
|
# $stats->{YMIN}-=$stats->{YSTEP}, $steps++ if $min < $stats->{YMIN};
|
|
# $stats->{YMAX}+=$stats->{YSTEP}, $steps++ if $max > $stats->{YMAX};
|
|
# $stats->{YSTEPS}=$steps;
|
|
$factor=0;
|
|
if ($grph{PDECIMALS}->[0] ne '')
|
|
{
|
|
$factor=$grph{PDECIMALS}->[0];
|
|
}
|
|
else
|
|
{
|
|
$factor=length($1) if ($stats->{YSTEP}=~m/\.(\d+)$/);
|
|
}
|
|
$stats->{YMAX}=sprintf("%.*f",$factor,$stats->{YMAX});
|
|
$stats->{XSTEPS}=scalar(@{$stats->{LABELS}});
|
|
$stats->{XSTEPS}=1 if $horizontal;
|
|
$stats->{BARS}=$bars;
|
|
|
|
my $ylab=length($stats->{YMAX})+1;
|
|
# $ylab+=2 if $grph{PDECIMALS} >= 0;
|
|
$xmarg=$ylab/2*1.2*$pointsz+($pointsz*.4);
|
|
$ymarg=0;
|
|
|
|
foreach my $j (0..$lbrows)
|
|
{
|
|
$ymarg+=$pointsz+$j+($pointsz*.1);
|
|
}
|
|
|
|
}
|
|
|
|
sub sgn
|
|
{
|
|
return 1 if $_[0]>=0;
|
|
return -1;
|
|
}
|
|
|
|
sub log10
|
|
{
|
|
my $n = shift;
|
|
return 0 if !$n;
|
|
return log($n)/log(10);
|
|
}
|
|
|
|
sub ceil
|
|
{
|
|
my $n=shift;
|
|
my $i=int($n);
|
|
return ($n==$i)?$n:$i+1;
|
|
}
|
|
|
|
sub round
|
|
{
|
|
my $n=shift;
|
|
return(sprintf("%.0f",$n));
|
|
}
|
|
|
|
sub PlotData
|
|
{
|
|
my $width=$grph{FRAME}->[0];
|
|
my $height=$grph{FRAME}->[1];
|
|
my $pointsz=$grph{PS}->[0];
|
|
my $gthickness=$grph{THICKNESS}->[0];
|
|
my $thickness=$grph{BORDER}->[0];
|
|
my $symsize=$grph{SYMSIZE}->[0];
|
|
my $background=$grph{BACKGROUND};
|
|
my $key=$grph{KEYBOX}->[0];
|
|
my $bars=$stats->{BARS};
|
|
my $floor=(exists($grph{FLOOR}))?$grph{FLOOR}->[0]:$stats->{YMIN};
|
|
my $horizontal=$grph{HORIZONTAL}->[0];
|
|
my $topmarg=$pointsz+2;
|
|
$topmarg+=$pointsz if $key;# and !$horizontal;
|
|
my ($xgrph,$ygrph,@sync);
|
|
my ($xof,$yof,$tm,$lm)=(0,0,0,0);
|
|
|
|
if ($grph{ORIGIN}->[0] ne '')
|
|
{
|
|
$xof=$lm=$grph{ORIGIN}->[0];
|
|
$yof=$tm=$grph{ORIGIN}->[1];
|
|
|
|
if ($#{$grph{ORIGIN}} == 3)
|
|
{
|
|
$xof=$width-$grph{ORIGIN}->[2];
|
|
$yof=$height-$grph{ORIGIN}->[3];
|
|
}
|
|
}
|
|
|
|
if ($horizontal)
|
|
{
|
|
my $t=$width;
|
|
$width=$height;
|
|
$height=$t;
|
|
# $t=$xmarg;
|
|
# $xmarg=$ymarg;
|
|
# $ymarg=$t;
|
|
$ymarg=0;
|
|
$xmarg=$pointsz;
|
|
$ygrph=($height-$xmarg*2-$xof);
|
|
$xgrph=($width-$pointsz*2.8-$yof);
|
|
$xmarg+=$lm;
|
|
$ymarg+=$tm;
|
|
}
|
|
else
|
|
{
|
|
$ygrph=($height-$ymarg-$topmarg-$yof);
|
|
$xgrph=($width-$xmarg-$xof);
|
|
}
|
|
|
|
return if $stats->{YSTEPS} == 0 or $stats->{XSTEPS} == 0 or ($bars==0 and $horizontal);
|
|
my $ydiv=sprintf("%.2f",$ygrph/$stats->{YSTEPS});
|
|
my $xdiv=sprintf("%.2f",$xgrph/$stats->{XSTEPS});
|
|
my $barwidth=($bars)?($xdiv*.8)/$bars:0;
|
|
my $lbrows=$stats->{XLABS}-1;
|
|
my $span=sprintf("%.2f",$stats->{YSTEP}*$stats->{YSTEPS});
|
|
# print STDERR "ydiv=$ydiv, xdiv=$xdiv, span=$span, YSTEP=$stats->{YSTEP}, YSTEPS=$stats->{YSTEPS}\n";
|
|
if ($span == 0)
|
|
{
|
|
Log(1,"WARN: span is zero");
|
|
return;
|
|
};
|
|
|
|
# Move to origin
|
|
|
|
my $thick=$symsize;
|
|
my $thick2=$thick*2;
|
|
my $y60=1*$thick;
|
|
my $x60=.866*$thick;
|
|
my $x60_2=$x60*2;
|
|
my $y60_2=$y60*2;
|
|
|
|
no warnings;
|
|
|
|
$buf.=<< "EOF";
|
|
.ds series2 \\M[$grph{SCOLOURS}->[1]]\\h'-${thick}p'\\D'C ${thick2}p'\\h'-${thick}p'\\M[]
|
|
.ds series3 \\Z'\\M[$grph{SCOLOURS}->[2]]\\h'${thick}p'\\D'P -${thick}p ${thick}p -${thick}p -${thick}p ${thick}p -${thick}p'\\M[]'
|
|
.ds series4 \\Z'\\M[$grph{SCOLOURS}->[3]]\\h'${thick}p'\\v'-${thick}p'\\D'P 0p ${thick2}p -${thick2}p 0p 0p -${thick2}p'\\M[]'
|
|
.ds series1 \\Z'\\M[$grph{SCOLOURS}->[0]]\\v'-${thick}p'\\D'P ${thick}p ${thick2}p -${thick2}p 0p'\\M[]'
|
|
.ds series6 \\M[$grph{SCOLOURS}->[5]]\\h'-${thick}p'\\D'C ${thick2}p'\\h'-${thick}p'\\M[]
|
|
.ds series5 \\Z'\\M[$grph{SCOLOURS}->[4]]\\h'${x60}p'\\v'-${y60}p'\\D'P -${x60_2}p 0p ${x60}p ${y60_2}p'\\M[]'
|
|
EOF
|
|
|
|
use warnings;
|
|
|
|
|
|
$buf.=".ne ${height}p\n.nf\n.mk GRP:mk\n";
|
|
$buf.=".in \\n[GRP:lefx]u\n\\Z'\\D't $grph{THICKNESS}->[0]p'\\m[$grph{TEXTCOLOUR}->[0]]\\M[$grph{LINECOLOUR}->[0]]'\\c\n";
|
|
|
|
Swap(\$width,\$height) if $horizontal;
|
|
|
|
if ($grph{BGCOLOUR}->[0] ne '')
|
|
{
|
|
$buf.="\\Z@\\M[$grph{BGCOLOUR}->[0]]\\D'P ${width}p 0 0 ${height}p -${width}p 0 0 -${height}p'\\M[]@\\c\n";
|
|
}
|
|
|
|
if ($grph{BORDER}->[0])
|
|
{
|
|
$buf.="\\Z@\\D't $grph{BORDER}->[0]p'@\\Z@\\m[$grph{BRDCOLOUR}->[0]]\\D'p ${width}p 0 0 ${height}p -${width}p 0 0 -${height}p'\\D't $grph{THICKNESS}->[0]p'\\m[]@\\c\n";
|
|
}
|
|
|
|
Swap(\$width,\$height) if $horizontal;
|
|
|
|
$buf.=".fl\n";
|
|
|
|
|
|
|
|
$buf.=".sp +".($grph{BORDER}->[0])."p\n";
|
|
$buf.=".in +".($grph{BORDER}->[0])."p\n";
|
|
$buf.=".ll +".($grph{FRAME}->[0]-$grph{BORDER}->[0]*2)."p\n";
|
|
# $buf.=".nf\n";
|
|
|
|
|
|
if ($horizontal)
|
|
{
|
|
# Move to origin (lower left corner)
|
|
|
|
$buf.=".mk grph\n\\Z'\\D't ${thickness}p''\\v'${xgrph}p+${topmarg}p'\\h'${xmarg}p'\\c\n";
|
|
|
|
# Background
|
|
|
|
$buf.="\\Z'\\M[$grph{WALLCOLOUR}->[0]]\\D'P 0p -${xgrph}p ${ygrph}p 0 0 ${xgrph}p'\\M[]'\\c\n" if $grph{WALLCOLOUR}->[0];
|
|
|
|
# Base Line
|
|
|
|
$buf.="\\Z'\\D'l ${ygrph}p 0''\\c\n";
|
|
|
|
# Floor Line
|
|
|
|
$buf.="\\Z'";
|
|
|
|
if ($stats->{YMIN} < $floor and $stats->{YMAX} >= $floor)
|
|
{
|
|
# zero is between min/max so draw axis on zero
|
|
$buf.="\\h'".abs($stats->{YMIN}-$floor)/$span*$ygrph."p'"
|
|
}
|
|
|
|
$buf.="\\D'l 0 -${xgrph}p''\\c\n";
|
|
|
|
# Ticks on X-axis
|
|
|
|
$buf.="\\Z'";
|
|
|
|
for my $j (0..$stats->{YSTEPS})
|
|
{
|
|
$buf.="\\h'${ydiv}p'" if $j;
|
|
$buf.="\\v'".($pointsz*.1+$thickness/2)."p'\\D'l 0 -".($pointsz*.1)."p'\\v'-".($thickness/2)."p'";
|
|
$buf.="\\Z!\\D'l 0 -".(${xgrph}-$thickness)."p'!" if $grph{VGRID};
|
|
}
|
|
|
|
$buf.="'\\c\n";
|
|
|
|
my $barno=0;
|
|
my $bardiv=d2($xgrph/($bars));
|
|
$barwidth=d2($pointsz*2);
|
|
$barwidth=$bardiv*.8 if $barwidth > $bardiv*.8;
|
|
|
|
foreach (my $i=scalar(@{$stats->{DATA}})-1; $i>=0; $i--) # For each series
|
|
{
|
|
my $set=$stats->{DATA}->[$i];
|
|
next if !defined($set);
|
|
next if !$stats->{BAR}->[$i];
|
|
my @tset=@{$set};
|
|
my ($oy,$ay,$cx,$ox);
|
|
my ($lbl,$txt)=split('~',$stats->{NAME}->[$i]);
|
|
|
|
$cx=$bardiv/2;
|
|
|
|
$buf.=".nr wi \\w'$lbl'\n";
|
|
my $baseline=($stats->{YMIN}<$floor)?((($stats->{YMIN}-$floor)/$span)*$ygrph):0;
|
|
# $oy=((($tset[$ox]-$stats->{YMIN})/$span)+$stats->{YMIN} )*$ygrph;
|
|
$oy=(($tset[0]-$stats->{YMIN})/$span)*$ygrph;
|
|
# $oy=((($tset[$ox]-$stats->{YMIN})/$span)-$stats->{YMIN})*$ygrph;
|
|
my $s=($i % 6) + 1;
|
|
|
|
my $cx2=sprintf("%.2f",($barno*$bardiv)+($bardiv/2)-($barwidth/2));
|
|
my $dep;
|
|
my $colo;
|
|
$sync[$i]=$topmarg+$xgrph-$cx-$cx2-$barwidth/2-$pointsz*.4;
|
|
$barno++;
|
|
|
|
my $j=0; # Horizontal bars have multiple series with one value in each
|
|
next if !defined($tset[$j]);
|
|
next if $tset[$j] eq '.';
|
|
my $y=(($tset[$j]-$stats->{YMIN})/$span)*$ygrph;
|
|
$dep=d2($oy+$baseline);
|
|
$dep=sgn($dep)*.5 if abs($dep) < 1;
|
|
if ($grph{NEGCOLOUR}->[0])
|
|
{
|
|
$colo=($dep < 0)?$grph{NEGCOLOUR}->[$i]:$grph{SCOLOURS}->[$i];
|
|
}
|
|
else
|
|
{
|
|
$colo=$grph{SCOLOURS}->[$i];
|
|
}
|
|
# my $y=((($tset[$j]-$stats->{YMIN})/$span)+$stats->{YMIN} )*$ygrph;
|
|
# my $y=((($tset[$j]-$stats->{YMIN})/$span)-$stats->{YMIN})*$ygrph;
|
|
|
|
my ($contrast,$contrastnd);
|
|
$contrast=$grph{CONTRAST}->[$i];
|
|
if (defined($contrast))
|
|
{
|
|
$contrast="\\m[$contrast]";
|
|
$contrastnd="\\m[]";
|
|
}
|
|
else
|
|
{
|
|
$contrast=$contrastnd='';
|
|
}
|
|
|
|
if ($dep < 0)
|
|
{
|
|
if ($pointsz < $barwidth)
|
|
{
|
|
$buf.=".ie \\n[wi]u+2p<".abs(${dep})."p .ds lb $contrast\\h'1p'$lbl$contrastnd\n";
|
|
$buf.=".el .ds lb \\h'-\\n[wi]u-2p'$lbl\n";
|
|
}
|
|
else
|
|
{
|
|
$buf.=".ds lb \\h'-\\n[wi]u-1p'$lbl\n";
|
|
}
|
|
}
|
|
else
|
|
{
|
|
if ($pointsz < $barwidth)
|
|
{
|
|
$buf.=".ie \\n[wi]u+2p>".abs(${dep})."p .ds lb \\h'1p'$lbl\n";
|
|
$buf.=".el .ds lb $contrast\\h'-\\n[wi]u-2p'$lbl$contrastnd\n";
|
|
}
|
|
else
|
|
{
|
|
$buf.=".ds lb \\h'1p'$lbl\n";
|
|
}
|
|
}
|
|
$buf.="\\Z'";
|
|
$buf.="\\h'${oy}p'\\v'-${cx}p'";
|
|
$buf.="\\m[$colo]" if $grph{COLOURED}->[0];
|
|
|
|
$buf.="\\Z~\\D't 0p'\\M[$colo]\\v'-${cx2}p'\\D'P 0 -${barwidth}p -${dep}p 0 0 ${barwidth}p ${dep}p 0'\\M[]\\D't ${thickness}p'~";
|
|
$buf.="\\Z~\\v'-".($cx2+$barwidth/2-($pointsz*.4))."p'\\h'".(sgn($dep ))."p'";
|
|
|
|
$buf.="\\*[lb]";
|
|
$buf.="~";
|
|
# $buf.="\\Z~\\D't 0p'\\M[$colo]\\v'-${cx2}p'\\D'P ${barwidth}p 0p 0p ${dep}p -${barwidth}p 0p 0p -${dep}p'\\M[]\\D't ${thickness}p'~";
|
|
# $buf.="\\v'-${cx}p'\\h'".sprintf("%.3f",$y-$oy)."p'";
|
|
# $buf.="\\D'l ${cx}p ".sprintf("%.3f",$oy-$y)."p'";
|
|
|
|
$buf.="\\m[]" if $grph{COLOURED}->[0];
|
|
$oy=$y;
|
|
|
|
$dep=$oy+$baseline;
|
|
# if (exists($grph{POSCOLOUR}))
|
|
# {
|
|
# $colo=($dep < 0)?$grph{NEGCOLOUR}->{NAME}:$grph{POSCOLOUR}->{NAME}
|
|
# }
|
|
# else
|
|
# {
|
|
# $colo=$grph{COLOURS}->[$i]->{NAME};
|
|
# }
|
|
# $buf.="\\Z~\\D't 0p'\\M[$colo]\\v'-${cx2}p'\\D'P 0 -${barwidth}p -${dep}p 0 0 ${barwidth}p ${dep}p 0'\\M[]\\D't ${thickness}p'~";
|
|
|
|
$buf.="'\\c\n";
|
|
}
|
|
|
|
# Now bottom labels
|
|
|
|
my $y=$stats->{YMIN};
|
|
my $factor=0;
|
|
my $pattern="%.*f";
|
|
if ($grph{PDECIMALS}->[0] ne '')
|
|
{
|
|
# $pattern.='%%';
|
|
$factor=$grph{PDECIMALS}->[0];
|
|
}
|
|
else
|
|
{
|
|
$factor=length($1) if ($stats->{YSTEP}=~m/\.(\d+)$/);
|
|
$factor=1 if ($stats->{YMAX}-$stats->{YMIN}) < $stats->{YSTEPS};
|
|
}
|
|
|
|
$buf.="\\v'".($pointsz*1.2)."p'\\c\n";
|
|
|
|
foreach my $j (0..$stats->{YSTEPS})
|
|
{
|
|
my $dy=sprintf($pattern,$factor,$y);
|
|
$buf.=".nr wi \\w'$dy'\n";
|
|
$buf.="\\h'-\\n[wi]u/2u'$dy\\h'${ydiv}p-(\\n[wi]u/2u)'\\c\n";
|
|
$y+=$stats->{YSTEP};
|
|
}
|
|
|
|
|
|
if ($grph{KEYBOX}->[0])
|
|
{
|
|
my $marg=$symsize*4;
|
|
my $ps=$grph{PS}->[0];
|
|
|
|
my $boxlabels=join("\t",@{$grph{BOXLABELS}});
|
|
my $boxheads=join("\t",@{$grph{BOXHEADS}});
|
|
my $boxtabs=join(' ',@{$grph{BOXTABS}});
|
|
$buf.=".sp |\\n[GRP:mk]u+$grph{BOXFRAME}->[1]p\n.in +$grph{BOXFRAME}->[0]p\n.ta $boxtabs\n.vs\n.in +(4p)\n\\fB$boxheads\\fP\n.sp .2\n.in -(4p)\n";
|
|
my $y2=0;
|
|
# $buf.=".sp ${pointsz}p\n" if $grph{SYNC};
|
|
|
|
foreach my $i (0..scalar(@{$stats->{NAME}})-1)
|
|
{
|
|
next if !defined($stats->{NAME}->[$i]);
|
|
my ($lbl,$txt)=split('~',$stats->{NAME}->[$i]);
|
|
|
|
$txt=~tr[^][\t];
|
|
|
|
if ($grph{SYNC}->[0])
|
|
{
|
|
$buf.=".sp |\\n[GRP:mk]u+$sync[$i]p-2p\n";
|
|
}
|
|
# else
|
|
# {
|
|
$buf.="\\v'-".($pointsz*.4)."p'\\h'-${thick}p'\\Z!\\M[$grph{SCOLOURS}->[$i]]\\v'-${thick}p'\\D'P ${thick2}p 0 0 ${thick2}p -${thick2}p 0'!\\h'${thick2}p'\\v'".($pointsz*.4)."p'\\~\\c\n" if !$grph{POSCOLOUR}->[0];
|
|
$buf.="$txt\n";
|
|
$buf.="\\M[]\\c\n" if !$grph{POSCOLOUR}->[0];
|
|
# }
|
|
# print STDERR "$sync[$i] "
|
|
# $buf.="\\v'-".($pointsz*.4)."p'\\D'l ".(${symsize}*4)."p 0p'\\Z'\\h'-".(${symsize}*2)."p'\\*[series$s]'\\v'".($pointsz*.4)."p'\\~\\c\n";
|
|
# $buf.=".in +${marg}p\n.sp -1\n$txt\\h'".(${symsize}*2)."p'\n.sp $fldk->{SKIPAFTER}p\n.in -${marg}p\n";
|
|
}
|
|
}
|
|
|
|
# print STDERR "\n";
|
|
}
|
|
else
|
|
{
|
|
# Move to origin (lower left corner)
|
|
|
|
$buf.=".mk grph\n\\Z'\\D't ${thickness}p''\\v'${ygrph}p+${topmarg}p+${tm}p'\\h'${xmarg}p+${lm}p'\\c\n";
|
|
|
|
# Background
|
|
|
|
$buf.="\\Z'\\M[$grph{WALLCOLOUR}->[0]]\\D'P 0p -${ygrph}p ${xgrph}p 0 0 ${ygrph}p'\\M[]'\\c\n" if $grph{WALLCOLOUR}->[0];
|
|
|
|
# Left line
|
|
|
|
$buf.="\\Z'\\L'-${ygrph}p''\\c\n";
|
|
|
|
# Bottom line
|
|
|
|
$buf.="\\Z'";
|
|
|
|
if ($stats->{YMIN} < $floor and $stats->{YMAX} >= $floor)
|
|
{
|
|
# zero is between min/max so draw axis on zero
|
|
$buf.="\\v'-".abs($stats->{YMIN}-$floor)/$span*$ygrph."p'"
|
|
}
|
|
|
|
$buf.="\\l'${xgrph}p''\\c\n";
|
|
|
|
# Label Y axis
|
|
|
|
# ticks
|
|
|
|
$buf.="\\Z'";
|
|
|
|
for my $j (0..$stats->{YSTEPS})
|
|
{
|
|
$buf.="\\v'-${ydiv}p'" if $j;
|
|
$buf.="\\h'-".($pointsz*.1+$thickness/2)."p'\\l'".($pointsz*.1)."p'\\h'".($thickness/2)."p'";
|
|
$buf.="\\Z!\\D'l ".(${xgrph}-$thickness)."p 0'!" if $grph{HGRID}->[0];
|
|
}
|
|
|
|
$buf.="'\\c\n";
|
|
|
|
# Label X axis
|
|
|
|
# ticks
|
|
|
|
foreach my $j (0..$lbrows)
|
|
{
|
|
my $sofar=0;
|
|
my $fi=0;
|
|
my $targ=0;
|
|
my $nd;
|
|
my $i;
|
|
|
|
for ($i=0; $i<scalar(@{$stats->{LABELS}}); $i=$nd+1)
|
|
{
|
|
$nd=$stats->{LABND}->[$i]->[$j];
|
|
$nd=$i if $nd < 0;
|
|
$sofar+=($nd-$i)*$xdiv;
|
|
|
|
my $mi=($i!=$nd)?$nd:int(($i-$fi)/2)+$fi;
|
|
my $lblsz=length($stats->{LABELS}->[$mi]->[$j] || '')*$pointsz*.6;
|
|
|
|
if ($lblsz==0 or ($lblsz) > $xdiv+$sofar)
|
|
{
|
|
$fi=$nd+1 if $lblsz==0;
|
|
$sofar+=$xdiv;
|
|
$stats->{LABELS}->[$nd]->[$j]='.' if $nd > $i;
|
|
next;
|
|
}
|
|
else
|
|
{
|
|
# print STDERR "$stats->{LABELS}->[$mi]->[$j]: sofar $sofar: lblsz $lblsz: xdiv $xdiv\n";
|
|
$sofar=0;
|
|
foreach my $t ($fi..$nd)
|
|
{
|
|
$stats->{LABELS}->[$t]->[$j]='' if $stats->{LABELS}->[$t]->[$j] ne '.' and $t != $mi;
|
|
}
|
|
$fi=$nd+1;
|
|
}
|
|
|
|
}
|
|
|
|
foreach my $i ($fi..$#{$stats->{LABELS}})
|
|
{
|
|
$stats->{LABELS}->[$i]->[$j]='';
|
|
}
|
|
|
|
}
|
|
|
|
$buf.="\\Z'";
|
|
|
|
for my $j (0..$stats->{XSTEPS}-1)
|
|
{
|
|
$buf.="\\h'${xdiv}p'" if $j;
|
|
$buf.="\\h'".(${xdiv}/2)."p'" if $j==0;
|
|
next if $stats->{LABELS}->[$j]->[0] eq '';
|
|
$buf.="\\D'l 0 ".($pointsz*.3)."p'\\v'-".($pointsz*.3)."p'";
|
|
$buf.="\\Z!\\D'l 0 -".(${ygrph}-$thickness)."p'!" if $grph{VGRID}->[0];
|
|
}
|
|
|
|
$buf.="'\\c\n";
|
|
|
|
# $buf.=series
|
|
|
|
# First any bars?
|
|
my $barno=0;
|
|
|
|
foreach my $i (0..scalar(@{$stats->{DATA}})-1)
|
|
{
|
|
my $set=$stats->{DATA}->[$i];
|
|
next if !defined($set);
|
|
next if !$stats->{BAR}->[$i];
|
|
my @tset=@{$set};
|
|
my ($oy,$ay,$cx,$ox);
|
|
|
|
$cx=$xdiv/2+$barwidth/2;
|
|
|
|
for ($ox=0; $ox<=$#tset; $ox++)
|
|
{
|
|
last if $tset[$ox] ne '.';
|
|
$cx+=$xdiv;
|
|
}
|
|
|
|
if (!defined($tset[$ox]) or $tset[$ox] eq '.')
|
|
{
|
|
$stats->{NAME}->[$i]=undef;
|
|
next;
|
|
}
|
|
|
|
$buf.="\\Z'";
|
|
my $baseline=($stats->{YMIN}<$floor)?((($stats->{YMIN}-$floor)/$span)*$ygrph):0;
|
|
# $oy=((($tset[$ox]-$stats->{YMIN})/$span)+$stats->{YMIN} )*$ygrph;
|
|
$oy=(($tset[$ox]-$stats->{YMIN})/$span)*$ygrph;
|
|
# $oy=((($tset[$ox]-$stats->{YMIN})/$span)-$stats->{YMIN})*$ygrph;
|
|
my $s=($i % 6) + 1;
|
|
|
|
$buf.="\\v'-${oy}p'\\h'${cx}p'";
|
|
$cx=0;
|
|
my $cx2=sprintf("%.3f",($barno*$barwidth)-($bars*$barwidth/2));
|
|
my $dep;
|
|
my $colo;
|
|
|
|
foreach my $j ($ox+1..$stats->{XSTEPS})
|
|
{
|
|
$cx+=$xdiv;
|
|
next if !defined($tset[$j]);
|
|
next if $tset[$j] eq '.';
|
|
my $y=(($tset[$j]-$stats->{YMIN})/$span)*$ygrph;
|
|
$dep=$oy+$baseline;
|
|
$dep=sgn($dep)*.5 if abs($dep) < 1;
|
|
if ($grph{POSCOLOUR}->[0])
|
|
{
|
|
$colo=($dep < 0)?$grph{NEGCOLOUR}->[0]:$grph{POSCOLOUR}->[0];
|
|
}
|
|
else
|
|
{
|
|
$colo=$grph{SCOLOURS}->[$i];
|
|
}
|
|
# my $y=((($tset[$j]-$stats->{YMIN})/$span)+$stats->{YMIN} )*$ygrph;
|
|
# my $y=((($tset[$j]-$stats->{YMIN})/$span)-$stats->{YMIN})*$ygrph;
|
|
$buf.="\\m[$colo]" if $grph{COLOURED}->[0];
|
|
|
|
$buf.="\\Z~\\D't 0p'\\M[$colo]\\h'${cx2}p'\\D'P ${barwidth}p 0p 0p ${dep}p -${barwidth}p 0p 0p -${dep}p'\\M[]\\D't ${thickness}p'~";
|
|
$buf.="\\h'${cx}p'\\v'".sprintf("%.3f",$oy-$y)."p'";
|
|
# $buf.="\\D'l ${cx}p ".sprintf("%.3f",$oy-$y)."p'";
|
|
|
|
$buf.="\\m[]" if $grph{COLOURED}->[0];
|
|
$oy=$y;
|
|
$cx=0;
|
|
}
|
|
|
|
$dep=$oy+$baseline;
|
|
if ($grph{POSCOLOUR}->[0])
|
|
{
|
|
$colo=($dep < 0)?$grph{NEGCOLOUR}->[0]:$grph{POSCOLOUR}->[0];
|
|
}
|
|
else
|
|
{
|
|
$colo=$grph{SCOLOURS}->[$i];
|
|
}
|
|
$buf.="\\Z~\\D't 0p'\\M[$colo]\\h'${cx2}p'\\D'P ${barwidth}p 0p 0p ${dep}p -${barwidth}p 0p 0p -${dep}p'\\M[]\\D't ${thickness}p'~";
|
|
|
|
$buf.="'\\c\n";
|
|
$barno++;
|
|
}
|
|
|
|
# Now the graph lines
|
|
|
|
foreach my $i (0..scalar(@{$stats->{DATA}})-1)
|
|
{
|
|
my $set=$stats->{DATA}->[$i];
|
|
next if !defined($set);
|
|
next if $stats->{BAR}->[$i];
|
|
my @tset=@{$set};
|
|
my ($oy,$ay,$cx,$ox);
|
|
|
|
$cx=$xdiv/2;
|
|
|
|
for ($ox=0; $ox<=$#tset; $ox++)
|
|
{
|
|
last if $tset[$ox] ne '.';
|
|
$cx+=$xdiv;
|
|
}
|
|
|
|
if (!defined($tset[$ox]) or $tset[$ox] eq '.')
|
|
{
|
|
$stats->{NAME}->[$i]=undef;
|
|
next;
|
|
}
|
|
|
|
$buf.="\\Z'";
|
|
$buf.="\\m[$grph{SCOLOURS}->[$i]DK]" if $grph{COLOURED}->[0];
|
|
$buf.="\\Z!\\D't ${gthickness}p'!";
|
|
$oy=(($tset[$ox]-$stats->{YMIN})/$span)*$ygrph;
|
|
my $s=($i % 6) + 1;
|
|
|
|
if (exists($stats->{ANCHOR}) and $stats->{ANCHOR}->[$i] ne '.')
|
|
{
|
|
$ay=(($stats->{ANCHOR}->[$i]-$stats->{YMIN})/$span)*$ygrph;
|
|
$buf.="\\v'-${ay}p'";
|
|
if ($background and $i == 0)
|
|
{
|
|
$buf.="\\Z'\\D't 0p'\\M[$grph{SCOLOURS}->[$i]DK]\\D'P ${cx}p ".sprintf("%.3f",$ay-$oy)."p 0p ${oy}p -${cx}p 0p 0p -${ay}p'\\M[]\\D't ${gthickness}p''";
|
|
}
|
|
$buf.="\\D'l ${cx}p ".sprintf("%.3f",$ay-$oy)."p'";
|
|
$cx=0;
|
|
}
|
|
else
|
|
{
|
|
$buf.="\\v'-${oy}p'\\h'${cx}p'";
|
|
$cx=0;
|
|
}
|
|
|
|
foreach my $j ($ox+1..$stats->{XSTEPS}-1)
|
|
{
|
|
$cx+=$xdiv;
|
|
next if !defined($tset[$j]);
|
|
next if $tset[$j] eq '.';
|
|
my $y=(($tset[$j]-$stats->{YMIN})/$span)*$ygrph;
|
|
if ($background and $i == 0)
|
|
{
|
|
$buf.="\\Z'\\D't 0p'\\M[$grph{SCOLOURS}->[$i]DK]\\D'P ${cx}p ".sprintf("%.3f",$oy-$y)."p 0p ${y}p -${cx}p 0p 0p -${oy}p'\\M[]\\D't ${gthickness}p''";
|
|
}
|
|
|
|
$buf.="\\D'l ${cx}p ".sprintf("%.3f",$oy-$y)."p'";
|
|
|
|
$oy=$y;
|
|
$cx=0;
|
|
}
|
|
|
|
$buf.="\\m[]" if $grph{COLOURED}->[0];
|
|
$buf.="'\\c\n";
|
|
|
|
# Draw points
|
|
|
|
if ($symsize)
|
|
{
|
|
$cx=$xdiv/2;
|
|
|
|
for ($ox=0; $ox<=$#tset; $ox++)
|
|
{
|
|
last if $tset[$ox] ne '.';
|
|
$cx+=$xdiv;
|
|
}
|
|
|
|
if (!defined($tset[$ox]) or $tset[$ox] eq '.')
|
|
{
|
|
$stats->{NAME}->[$i]=undef;
|
|
next;
|
|
}
|
|
|
|
$buf.="\\Z'";
|
|
$buf.="\\m[$grph{SCOLOURS}->[$i]]" if $grph{COLOURED}->[0];
|
|
$oy=(($tset[$ox]-$stats->{YMIN})/$span)*$ygrph;
|
|
|
|
if (exists($stats->{ANCHOR}) and $stats->{ANCHOR}->[$i] ne '.')
|
|
{
|
|
$ay=(($stats->{ANCHOR}->[$i]-$stats->{YMIN})/$span)*$ygrph;
|
|
$buf.="\\v'-${ay}p'";
|
|
$buf.="\\h'${cx}p'\\v'".sprintf("%.3f",$ay-$oy)."p'";
|
|
$cx=0;
|
|
}
|
|
else
|
|
{
|
|
$buf.="\\v'-${oy}p'\\h'${cx}p'";
|
|
$cx=0;
|
|
}
|
|
|
|
my $sym='';
|
|
$sym="\\*[series$s]" if !$background or $i != 0;
|
|
$buf.=$sym;
|
|
|
|
foreach my $j ($ox+1..$stats->{XSTEPS}-1)
|
|
{
|
|
$cx+=$xdiv;
|
|
next if !defined($tset[$j]);
|
|
next if $tset[$j] eq '.';
|
|
my $y=(($tset[$j]-$stats->{YMIN})/$span)*$ygrph;
|
|
$buf.="\\h'${cx}p'\\v'".sprintf("%.3f",$oy-$y)."p'$sym";
|
|
$oy=$y;
|
|
$cx=0;
|
|
}
|
|
|
|
$buf.="\\m[]" if $grph{COLOURED};
|
|
$buf.="'\\c\n";
|
|
}
|
|
}
|
|
|
|
# $buf.=X Labels
|
|
|
|
$buf.=".nf\n.sp |\\n[grph]u+${ygrph}p+${topmarg}p+${tm}p\n.vs $grph{VS}->[0]p\n";
|
|
|
|
foreach my $j (0..$lbrows)
|
|
{
|
|
$buf.="\\m[$grph{TEXTCOLOUR}->[0]]\\c\n";
|
|
$buf.=".ta ";
|
|
my $tab=$xmarg;
|
|
my $tabln='';
|
|
my $divs=1;
|
|
my $nd=0;
|
|
|
|
for (my $i=0; $i<scalar(@{$stats->{LABELS}}); $tab+=$divs*$xdiv, $i=$nd+1)
|
|
{
|
|
# next if $xskip != 1 and ($i+1) % $xskip != 1;
|
|
$nd=$stats->{LABND}->[$i]->[$j];
|
|
$nd=$i if $nd < 0;
|
|
$divs=$nd-$i+1;
|
|
$i=$nd;
|
|
my $vals=$stats->{LABELS}->[$i];
|
|
next if !defined($vals->[$j]) or $vals->[$j] eq '' or $vals->[$j] eq '.';
|
|
$buf.="".($tab+($divs*$xdiv)/2)."pC ";
|
|
$tabln.="\t$vals->[$j]";
|
|
}
|
|
|
|
|
|
$buf.="\n\\s'+${j}'$tabln\\s'-${j}'\n";
|
|
}
|
|
|
|
$buf.=".vs\n.fi\n.ta ".($xmarg+$lm-$pointsz*.2-$thickness/2)."pR\n";
|
|
my $y=$stats->{YMIN};
|
|
my $factor=0;
|
|
my $pattern="%.*f";
|
|
if ($grph{PDECIMALS}->[0] ne '')
|
|
{
|
|
# $pattern.='%%';
|
|
$factor=$grph{PDECIMALS}->[0];
|
|
}
|
|
else
|
|
{
|
|
$factor=length($1) if ($stats->{YSTEP}=~m/\.(\d+)$/);
|
|
}
|
|
|
|
foreach my $j (0..$stats->{YSTEPS})
|
|
{
|
|
$buf.=".sp |\\n[grph]u+".(${ygrph}-$ydiv*$j+$pointsz/4+$topmarg+${tm})."p\n\t".sprintf($pattern,$factor,$y)."\n";
|
|
$y+=$stats->{YSTEP};
|
|
}
|
|
|
|
$buf.="\\m[]\\D't ${thickness}p'\n";
|
|
|
|
if (!$grph{KEYBOX}->[0])
|
|
{
|
|
$buf.=".sp |\\n[grph]u+${pointsz}p+${tm}p\n.in +${xmarg}p+${lm}p+6p\n";
|
|
foreach my $i (0..scalar(@{$stats->{NAME}})-1)
|
|
{
|
|
next if !defined($stats->{NAME}->[$i]);
|
|
my $s=($i % 6)+1;
|
|
if ($stats->{BAR}->[$i])
|
|
{
|
|
$buf.="\\v'-".($pointsz*.4)."p'\\h'-${thick}p'\\Z!\\M[$grph{SCOLOURS}->[$i]]\\v'-${thick}p'\\D'P ${thick2}p 0 0 ${thick2}p -${thick2}p 0'!\\h'${thick2}p'\\v'".($pointsz*.4)."p'\\~$stats->{NAME}->[$i]\\0\\M[]\n";
|
|
}
|
|
else
|
|
{
|
|
my $symsize=2;
|
|
$buf.="\\Z'\\D't 2p'\\m[$grph{SCOLOURS}->[$i]DK]'";
|
|
$buf.="\\v'-".($pointsz*.4)."p'\\D'l ".(${symsize}*4)."p 0p'\\Z'\\h'-".(${symsize}*2)."p'\\m[]\\*[series$s]'\\v'".($pointsz*.4)."p'\\~$stats->{NAME}->[$i]\\h'".(${symsize}*2)."p'\n";
|
|
}
|
|
}
|
|
}
|
|
else
|
|
{
|
|
my $marg=$symsize*4;
|
|
|
|
my $boxlabels=join("\t",@{$grph{BOXLABELS}});
|
|
my $boxheads=join("\t",@{$grph{BOXHEADS}});
|
|
my $boxtabs=join(' ',@{$grph{BOXTABS}});
|
|
|
|
$buf.=".fl\n.vs 0\n.sp |\\n[GRP:mk]u+$grph{BOXFRAME}->[1]p\n.in +$grph{BOXFRAME}->[0]p\n.ta $boxtabs\n.vs $grph{VS}->[0]p\n.in +(1m+4p)\n\\fB$boxheads\\fP\n.sp -.2\n.in -(1m+4p)\n";
|
|
|
|
# $buf.=".in +".($fldk->{THICKNESS}->{LEFT}*.5)."p\n.sp -1v\n.sp $fldk->{INDENT}->{TOP}p\n.ll +$fldk->{POSITION}->{WIDTH}p\n";
|
|
foreach my $i (0..scalar(@{$stats->{NAME}})-1)
|
|
{
|
|
next if !defined($stats->{NAME}->[$i]);
|
|
my $s=($i % 6)+1;
|
|
$buf.="\\v'-".($pointsz*.4)."p'\\D'l ".(${symsize}*4)."p 0p'\\Z'\\h'-".(${symsize}*2)."p'\\*[series$s]'\\v'".($pointsz*.4)."p'\\~\\c\n";
|
|
$buf.=".in +${marg}p\n.sp -1\n$stats->{NAME}->[$i]\\h'".(${symsize}*2)."p'\n.in -${marg}p\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
$buf.=".fl\n.ev\n";
|
|
### $srcur=undef;
|
|
# outbuf($buf);
|
|
}
|
|
|
|
sub d2
|
|
{
|
|
return sprintf("%.2f",$_[0]);
|
|
}
|
|
|
|
sub Swap
|
|
{
|
|
my $v1=shift;
|
|
my $v2=shift;
|
|
|
|
my $t=$$v1;
|
|
$$v1=$$v2;
|
|
$$v2=$t;
|
|
}
|