123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430 |
- # $Id$
- eval 'exec perl -Ss $0 "$@"'
- if 0;
- # A simple bargraph preprocessor for GNU pic / troff package.
- # Hacked into existence by Larry McVoy (lm@sun.com now lm@sgi.com).
- # Copyright (c) 1994 Larry McVoy. GPLed software.
- #
- # TODO
- # Make this work with sideways graphs.
- #
- # Input format is:
- #
- # 3 foo bar
- # 9 bigger foo
- # "Silly example
- #
- # and output is
- #
- # bigger
- # foo
- # +----------+
- # | |
- # foo | |
- # bar | |
- # +----------+ | |
- # | | | |
- # +----------+ +----------+
- # -------------------------------
- # 3 9
- #
- # Silly example
- #
- # Input options:
- # specifier value default
- # %ps <point size> 10
- # %ft <font> HB
- # %labelgap <space in inches between fill labels> 1.5
- # %xsize <size of graph width in inches> 7
- # %ysize <size of graph height in inches> 6
- # %Title n|s <Bargraph title> none
- # %titleplus <increase in points of titlesize> 0
- # %label%d <label name> none
- # %boxpercent <100% means columns touch> 75
- # %worse up|down n|w|e|s|nw|ne|sw|se - idiot arrow
- # %better up|down n|w|e|s|nw|ne|sw|se - idiot arrow
- # %fakemax <pretend one data point was this big>
- #
- # The data can be optionally followed by a %fill%d that gets turned into
- # the fill value (darkness) for that bar of the bar graph. The default
- # fill value is whatever pic defaults to.
- # The %label control is used to provide a legend for the different fill
- # values.
- #
- # Command line options:
- #
- # -big make the x/y defaults be 7.5 inches, crank up title size, and
- # don't put a spacer at the top.
- # -nobox do not put an outline box around the bargraph.
- #
- # -sideways
- # do the bars towards the right.
- #
- # Much thanks to James Clark for providing such a nice replacement for
- # the Unix troff package.
- @lines = <>; # sluuuuuuuuuuuurp
- $titleplus = 2;
- $bottomplus = 0;
- $fill = "fillval";
- $SP = ".sp 1i";
- $PO = "0i";
- # All of these can be set in the graph with %xxx value
- $ps = 10;
- $ft = "CB";
- $xsize = 4;
- $ysize = 6;
- $boxpercent = 75;
- $labelgap = 1.5;
- if ($nobox) {
- $invis = "invis";
- } else {
- $invis = "";
- }
- if ($big) {
- $slide = 0;
- $xsize = 7.5;
- $ysize = 7.5;
- $SP = "";
- $titleplus = 4;
- $bottomplus = 2;
- # XXX - you may need to screw with this.
- $xsize -= 3.75 if ($sideways);
- }
- if ($slide) {
- $big = 0;
- $xsize = 6.5;
- $ysize = 4.20;
- $SP = ".sp .75i";
- $PO = ".23i";
- $titleplus = 2;
- $bottomplus = 0;
- # XXX - you may need to screw with this.
- $xsize -= 2.2 if ($sideways);
- }
- $vs = $ps + 1;
- # Calculate max to autosize the graph.
- foreach $_ (@lines) {
- next if /^\s*#/;
- next if /^\s*$/;
- if (/^\s*"/) {
- ($title = $_) =~ s/\s*"//;
- chop($title);
- push(@title, "\"\\s+$titleplus$title\\s0\"");
- next;
- }
- if (/^\s*%/) {
- &control(0);
- push(@control, $_);
- next;
- }
- @_ = split;
- if (!defined $maxdata) {
- $maxdata = $_[0];
- } else {
- $maxdata = $_[0] if ($maxdata < $_[0]);
- }
- push(@data, $_);
- }
- foreach $_ (@control) {
- &control(1);
- }
- $n = $#data + 1;
- $tps = $ps + $titleplus;
- $tvs = int($tps * 1.2);
- print <<EOF;
- $SP
- .po $PO
- .ft $ft
- .ps $ps
- .vs $tvs
- .ce 100
- EOF
- foreach $_ (@title_n) {
- print;
- }
- # Spit out the pic stuff.
- # The idea here is to spit the variables and let pic do most of the math.
- # This allows tweeking of the output by hand.
- print <<EOF;
- .ce 0
- .vs
- .PS
- .ps $ps
- .vs $vs
- [
- # Variables, tweek these.
- fillval = .12 # default fill value boxes
- xsize = $xsize # width of the graph
- ysize = $ysize # height of the graph
- n = $n
- boxpercent = $boxpercent / 100
- gap = xsize / n * (1 - boxpercent)
- maxdata = $maxdata
- yscale = ysize / maxdata
- xscale = xsize / maxdata
- # Draw the graph borders
- O: box invis ht ysize wid xsize
- EOF
- # line thick 2 from O.sw - (0, .1) to O.se - (0, .1)
- #foreach $_ (@control) {
- # &control(1);
- #}
- # boxwid = xsize / n * boxpercent
- if ($sideways) {
- print "boxht = ysize / n * boxpercent\n";
- # Each data point.
- for ($i = 0; $i <= $#data; $i++) {
- $_ = $data[$i];
- @_ = &getfill;
- print "box fill $fill wid $_[0] * xscale " .
- "with .nw at O.nw - (0, gap /2 + $i * (ysize/n))\n";
- $value = shift(@_);
- # XXXXXXX
- if ($_[$#_] =~ /secs/) {
- #print "\"@_\" ljust at last box.e + .1,0\n";
- $units = pop(@_);
- $each = pop(@_);
- print "\"\\s+1$value\\s0, @_,\\ \\s+1$each $units\\s0\" ljust at last box.e + .1,0\n";
- } else {
- print "\"\\s+2$value\\s0 @_\" ljust at last box.e + .1,0\n";
- }
- }
- } else {
- print "boxwid = xsize / n * boxpercent\n";
- # Each data point.
- for ($i = 0; $i <= $#data; $i++) {
- $_ = $data[$i];
- @_ = &getfill;
- print "box fill $fill ht $_[0] * yscale " .
- "with .sw at O.sw + (gap /2 + $i * (xsize/n), 0)\n";
- $value = shift(@_);
- @_ = &fmt(@_);
- #warn "V=$value\nT=@_\n";
- # Make the bar titles
- for ($j = $#_; $j >= 0; $j--) {
- print "\t\"$_[$j]\" at last box.n + (0, .05 + .12 * $j)\n";
- }
- print "\t\"\\s+$bottomplus$value\\s0\" at last box.s - (0, .30)\n";
- }
- }
- # Labels, if any
- if ($#labels > -1) {
- print "\n# Labels.\n";
- print "[\n boxwid = .35; boxht = .18; y = .10; x = -.03; ";
- print "labelgap = $labelgap\n";
- $first = 1;
- foreach $_ (@labels) {
- print " [ B: box fill $_[0]; ";
- shift(@_);
- print "\"@_\" ljust at B.e + (y, x) ]";
- if ($first == 1) {
- $first = 0;
- print "\n";
- } else {
- print " \\\n\twith .w at last [].e + (labelgap, 0)\n";
- }
- }
- print "] with .nw at O.sw - (0, .6)\n";
- }
- $invis = "invis" if $sideways;
- print <<EOF;
- ]
- box $invis wid last [].wid + .5 ht last [].ht + .5 with .nw at last [].nw + (-.25, .25)
- move to last [].nw + 0,.25
- line thick 2 right 7
- move to last [].sw - 0,.25
- line thick 2 right 7
- .PE
- .ft
- .ps
- .vs
- .po
- EOF
- print <<EOF;
- .po .5i
- .ft $ft
- .ps $ps
- .vs $tvs
- .sp .5
- .ce 100
- EOF
- foreach $_ (@title_s) {
- print;
- }
- print <<EOF;
- .po
- .ft
- .ps
- .vs
- .ce 0
- EOF
- exit 0;
- sub fmt
- {
- local(@args);
- local(@ret);
- # XXX - this assumes that # is not used anywhere else in the
- # label line.
- $_ = "@_";
- s/\\ /#/g;
- @args = split;
- foreach $_ (@args) {
- s/#/ /g;
- }
- $len = 0;
- foreach $_ (@args) {
- $len = length($_) if (length($_) > $len);
- }
- $len += 2;
- $word = shift(@args);
- while ($#args > -1) {
- if (length($word) + length($args[0]) < $len) {
- $word .= " $args[0]";
- shift(@args);
- } else {
- push(@ret, $word);
- $word = shift(@args);
- }
- }
- push(@ret, $word);
- reverse(@ret);
- }
- # Eat some control information
- #
- sub control
- {
- local($pass) = $_[0];
- if ($pass == 0) {
- s/.*%//;
- chop;
- }
- @_ = split;
- if ($_[0] =~ /[Ww]orse$/ || $_[0] =~ /[Bb]etter$/) {
- return if ($pass == 0);
- if ($#_ != 2) {
- die "bad control: $_\n";
- return;
- }
- ($label, $dir, $where) = @_;
- print "\n# Idiot arrow\n";
- print "[\tarrow thick 10 wid .5 ht .4 $dir 1.15\n";
- print "\t\"\\s+9$label\\s0\" ";
- if ($dir eq "up") {
- print "at last arrow.s - (0, .25)\n";
- } elsif ($dir eq "down") {
- print "at last arrow.n + (0, .25)\n";
- } else {
- die "bad control: $_\n";
- }
- print "] with .$where at O.$where ";
- if ($where eq "n") {
- print "- (0, .5)\n";
- } elsif ($where eq "ne") {
- print "- (.5, .5)\n";
- } elsif ($where eq "e") {
- print "- (.5, 0)\n";
- } elsif ($where eq "se") {
- print "- (.5, -.5)\n";
- } elsif ($where eq "s") {
- print "+ (0, .5)\n";
- } elsif ($where eq "sw") {
- print "+ (.5, .5)\n";
- } elsif ($where eq "w") {
- print "+ (.5, 0)\n";
- } elsif ($where eq "nw") {
- print "+ (.5, -.5)\n";
- } else {
- die "bad control: $_\n";
- }
- print "\n";
- } elsif ($_[0] =~ /Title/) {
- # XXX - I haven't fixed this for -sideways
- return if ($pass == 0);
- if ($_[1] eq "n") {
- shift(@_); shift(@_);
- push(@title_n, "\\s+$titleplus@_\\s0\n");
- } elsif ($_[1] eq "s") {
- shift(@_); shift(@_);
- push(@title_s, "\\s+$titleplus@_\\s0\n");
- } else {
- die "bad control: $_\n";
- }
- } elsif ($_[0] =~ /ps/) {
- $ps = $_[1];
- } elsif ($_[0] =~ /ft/) {
- $ft = $_[1];
- } elsif ($_[0] =~ /xsize/) {
- $xsize = $_[1];
- } elsif ($_[0] =~ /ysize/) {
- $ysize = $_[1];
- } elsif ($_[0] =~ /titleplus/) {
- $titleplus = $_[1];
- } elsif ($_[0] =~ /boxpercent/) {
- $boxpercent = $_[1];
- } elsif ($_[0] =~ /labelgap/) {
- $labelgap = $_[1];
- } elsif ($_[0] =~ /label/) { # has to be after labelgap
- return if ($pass == 0);
- $_[0] =~ s/label//;
- if (length($_[0]) > 0) {
- $fill = $_[0];
- } else {
- $fill = "fillval";
- }
- push(@labels, "@_");
- } elsif ($_[0] =~ /fakemax/) {
- if (!defined $maxdata) {
- $maxdata = $_[1];
- } else {
- $maxdata = $_[1] if ($maxdata < $_[1]);
- }
- } else {
- die "bad control: $_\n";
- }
- }
- # Look for a %fill[val], eat it, and set $fill
- sub getfill
- {
- local (@line);
- if (/%fill/) {
- @_ = split;
- foreach $_ (@_) {
- if (/%fill/) {
- s/%fill//;
- if (length($_) > 0) {
- $fill = $_;
- } else {
- $fill = "fillval";
- }
- } else {
- push(@line, $_);
- }
- }
- } else {
- $fill = "fillval";
- @line = split;
- }
- @line;
- }
|