#!/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 # # 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 . 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 () { 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 () { 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{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{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; }