On Thu, Oct 10, 2019 at 08:55:02AM -0400, Mike Bianchi wrote:
> > If there is interest, I'll post the script and an example.
> 
> Yes please.
>                                                                       Mike
> 
Please find attached

        addtbl.pl       (the code)
        addtbl.exp      (an example)
        addtbl.exp.ps   (corresponding output)

Cheers,

        ulrich
:
# Copyright 2019 Ulrich Lauther
# This program 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.
# 
# This program 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 <https://www.gnu.org/licenses/>.

eval 'exec perl -w -S $0 ${1+"$@"}'
  if  0;
my $tab = "\t";
my $BLANK     = ' ';
my $in_table  = 0;
my $stack_ind = -1;
my $cols      = 0;
while ($line = <>) {
  chomp $line;
  if ($line eq ".TS") { # table starts
    print "$line\n";
    $in_table = 1;
    do { # skip table header
      chomp($line = <>);
      print "$line\n";
      if ($line =~ /tab/) {
        $tab = $line;
        $tab =~ s/.*tab\((.)\).*/$1/;
      }
    } while ($line !~ /\.$/); # last table header line ends with "."
    $line =~ s/\|/ /g; # eliminate "|", so we can count columns
    $cols = split $BLANK, $line;
    next;
  } # table start
  
  if ($in_table == 0) { # outside table, just copy
    print "$line\n";
    next;
  }

  if ($line eq ".TE") { # table ends
    print "$line\n";
    $in_table = 0;
    next;
  } # table end

  # .(
  if (substr($line,0,2) eq ".(") { # start summation
    # .( [add cols] col col ... collmn(s) to be added
    $stack_ind++;		# stack index
    #initialize signs and sums:
    for ($i = 0; $i < $cols; $i++) { # all cols
      $sign[$i][$stack_ind] = 0; # sign
      $s[$i][$stack_ind]    = 0; # sum
    }

    #store signs and cols:
    @fields = split $BLANK, $line;

    shift @fields; # skip ".("
    shift @fields if ($fields[0] eq "add");
    shift @fields if ($fields[0] eq "cols");
    
    # store signs of cols to be added:
    foreach $col (@fields) {
      if ($col < 0) {
        $col = -$col-1;
        $sign[$col][$stack_ind] = -1;
      }
      else {
        $col = $col-1;
        $sign[$col][$stack_ind] = 1;
      }
    }
    next; 
  } # end .(

  # .)
  if (substr($line,0,2) eq ".)") { # end summation
    # .) text S.d col col ...  output sum of sums with precision d

    if ($stack_ind > 0) {
      for ($i = 0; $i < $cols; $i++) {
        $s[$i][$stack_ind - 1] += $s[$i][$stack_ind];
      }
    }

    if (length($line) > 3) { # output sum of sums
      ($foo,$text,$p,$rest) = split $BLANK, $line, 4;
      ($foo,$p) = split /\./,$p; # split S.d
      if ($rest) { # col col ...
        $sum = 0;
        @cols = split $BLANK, $rest;
        foreach $col (@cols) {
          $sum += $s[$col-1][$stack_ind];
        }
        printf("%s %.${p}f\n",$text,$sum);
      }
    }

    $stack_ind--;
    next; 
  } # end .)

  if ($line =~ /$tab/) { # normal table line
    $sep = ($tab eq '|') ? '\|' : $tab;
    $n = @fields = split(/$sep/,$line);
    for ($i = 0; $i < $n; $i++) { # all fields
      $add = 1;
      $f = $fields[$i];
      if ($f =~ /^!?E\.\d /) { # evaluate expression
        $add = 0 if (substr($f,0,1) eq "!");
        ($form,$expr) = split $BLANK,$f; # E.d expr or !E.d expr
        ($foo,$p) = split /\./,$form;
        $expr =~ s/\$(\d+)/$fields[$1-1]/g;         # $col -> $fields[col-1]
        $expr =~ s/\$S(\d+)/$s[$1-1][$stack_ind]/g; # $Sx -> sum of col x
        $expr =~ s/\$S/$s[$i][$stack_ind]/g;        # $S  -> sum of current col
        $res  = eval($expr);
        $f    = sprintf("%.${p}f",$res);
        $fields[$i] = $f;
      }

      print $f;

      # possibly add per collumn:
      # printf("stack_ind: %d\n",$stack_ind);
      if ($add == 1 && $stack_ind >= 0 && $sign[$i][$stack_ind] != 0) {
        $f = 0 if ($f =~ /^ *$/); # empty field
        $s[$i][$stack_ind] += $f*$sign[$i][$stack_ind];
      }
      print $tab unless ($i == $n-1);
    }
    print "\n";
    next;
  }

  print "$line\n";

} # while input
.\" tbl add mom
.IR 0.9c     
.SPACE |2c  
.AUTOLEAD 2
.PT_SIZE 12     
.JUSTIFY      
.TS
tab(@);
L R N N.
.( 4
\*[BD]Einnahmen:\*[PREV]
.( 4
Miete Wohnung 1 - 12 @514.20@€@E.2 12*$2
Miete Garage  1 - 11 @60.00 @€@E.2 11*$2
_
Summe@@€@!E.2 $S
.)
.P
\*[BD]Ausgaben:\*[PREV]
.( 4
Wohngeld   1 -11 @216.70@€@E.2 -11*$2
Wohngeld       12@220.49@€@E.2 -$2
Grundsteuer      @      @€@  -228.56
Verwaltung       @      @€@  -392.70
Kontoführung     @      @€@  -197.25
Nachzahlungen    @      @€@  -206.37
Nachzahlungen    @      @€@   -61.03
Reisekosten Hotel@      @€@  -231.00
Reisekosten Hotel@      @€@  -317.00
Reisekosten Nahverkehr@ @€@   -14.00
Reisekosten Nahverkehr@ @€@    -5.20
Reisekosten KFZ 4 x 583 km@  @€@E.2 -4*583*0.30
AfA:                      @  @€@E.2 $afa=-3284.00
_
Summe@@€@!E.2 $S
.)
.P
=
\*[BD]Gewinn\*[PREV]@@€@!E.2 $S
\*[BD]Gewinn wthout AVA\*[PREV]@@€@!E.2 $S-$afa
.)
.TE

Attachment: addtbl.exp.ps
Description: PostScript document

Reply via email to