perl - Postscript show コマンドをマージするように Perl アルゴリズムを改善する

Question

Matlab R2007b からの Postscript 出力には問題があります。ポストスクリプト出力 (simprintdiag) で、テキスト文字列が多くの「moveto 」および「 show 」コマンドに分割されていることがわかりました。これにより、余分な空白を PDF に組版するときに問題が発生し、ラベルに挿入されることがあります (そのため、空白をダブルクリックできず、検索で見つかりません!)。

この問題を回避するために、これらの分割された「show」コマンドを結合する Perl スクリプトを作成しましたが、いくつかの問題があり、助けが必要です。

1. 「(0) s」などの表示コマンドが正しく繰り返されず、次のブロックに表示されます。
2. 入力ポストスクリプト ファイルは、変更が必要ない場合でも、常にスクリプトによって変更されます。
3. 最初に、連続する show コマンドを回避するためのハックがあります。
4. それほど速くはありません。一部のプロジェクトには 2000 を超える Postscript ファイルがあるため、速度の改善は歓迎されます。

以下のコードの DATA には、mt コマンドと s コマンドでテキスト文字列を分割する 4 つの例があります。最終的な出力がどうあるべきかを最後に含めました。このスクリプトは、私たちのテキストが左から右に書かれているという事実、またはポストスクリプトで書かれているという事実を利用しています。したがって、同じ Y コードを持つ連続した mt コマンドは、同じ文字列であると結論付けます。

感謝して受け取った助け。

ありがとう ：）

私のPerlスクリプト：

use strict;
use warnings;

my $debug=1;

#
## Slurp the input file into a variable
my $ps_in;
while(<DATA>) {
   $ps_in .= $_;     # Take a copy of input file
}


#
## HACK
## The main PS fix algorithm only works with show commands on a single
## line!  Fix the input contents now by joining all show commands that 
## occur over multiple lines.  Examples of this are:
##  272   63 mt 
## (main is an externally linked function of the ACC feature ru\
## nning every ) s
##  991   63 mt
## (100) s
my $buf;
my $no_show_split;
open(my $fh_ps, "<", \$ps_in );
while(<$fh_ps>) {
   if( /^(.*)\\$/ ) {   # Match on all lines ending with backslash \
      $buf .= $1;
   }
   else {
      if( $buf ) {
         $no_show_split .= $buf;
         undef($buf);
      }
      $no_show_split .= $_;
   }
}
close $fh_ps;

#
## Reopen our ps input, now the show splits have been removed
open($fh_ps,"<",\$no_show_split );

my $moveto_line = qr/^\s*\d+\s+(\d+)\s+(mt|moveto)/;  # Example '2831  738 mt'
my $show_line   = qr/^\((.+)\)\s+(s|show)/;           # Example '(chris) s'
my $ycrd;      # Y-axis cords
my $pstxt;     # Text to display
my $mtl;       # Moveto line
my $print_text;
my $fixes=0;
my $ps_condensed;

while(<$fh_ps>) {

    if( $print_text ) {
        $ps_condensed .= "$mtl\n";
        $ps_condensed .= "($pstxt) s\n";
        print "($pstxt) s\n====================\n" if $debug;
        undef($ycrd);
        undef($pstxt);
        $print_text=0;
        ++$fixes;
    }

    if( /$moveto_line/ ) {
        chomp;

        if( !$ycrd ) {
            $mtl=$_;       # Store this line for print later
            $ycrd=$1;      # Match on y-axis value
            redo;          # Redo this iteration so we can read the show line in
        }
        elsif( $1 == $ycrd ) {
            <$fh_ps> =~ /$show_line/;  # Read in the show line
            $pstxt .= $1;              # Built up string we want
            print " $mtl -->$1<--\n" if $debug;
        }
        else {
            $print_text=1; # Dropped out matching on y-cord so force a print
            redo;          # Need to redo this line again
        }
    }
    else {
        if( $pstxt ) {     # Print if we have something in buffer
            $print_text=1;
            redo;
        }
        $ps_condensed .= $_;
    }

} # End While Loop
close $fh_ps;

print $ps_condensed;


__DATA__
%%IncludeResource: font Helvetica
/Helvetica /WindowsLatin1Encoding 60 FMSR

11214 11653 mt 
(0) s
4.5 w
156 0 2204 19229 2 MP stroke
156 0 2204 19084 2 MP stroke

%%IncludeResource: font Helvetica
/Helvetica /WindowsLatin1Encoding 120 FMSR

8913 14971 mt 
(Function) s
9405 14971 mt 
(-) s
9441 14971 mt 
(Call) s
9009 15127 mt 
(Generator) s
6 w


%%IncludeResource: font Helvetica
/Helvetica /WindowsLatin1Encoding 120 FMSR

4962 4747 mt 
(trigger) s
5322 4747 mt 
(_) s
5394 4747 mt 
(scheduler) s
5934 4747 mt 
(_) s
6006 4747 mt 
(100) s
6222 4747 mt 
(ms) s
6378 4747 mt 
(_) s
6450 4747 mt 
(task) s
6654 4747 mt 
(_) s
6726 4747 mt 
(06) s
6 w
gr

24 10 10 24 0 4 -10 24 -24 10 5806 11736 14 MP stroke
%%IncludeResource: font Helvetica
/Helvetica /WindowsLatin1Encoding 120 FMSR

5454 11947 mt 
(Chris_\
did_this_example_) s
5874 11947 mt 
(to_test) s
5946 11947 mt 
(_out) s
6 w

最終的な「凝縮された」Postscript は次のようになります。

%%IncludeResource: font Helvetica
/Helvetica /WindowsLatin1Encoding 60 FMSR

11214 11653 mt 
(0) s
4.5 w
156 0 2204 19229 2 MP stroke
156 0 2204 19084 2 MP stroke

%%IncludeResource: font Helvetica
/Helvetica /WindowsLatin1Encoding 120 FMSR

8913 14971 mt 
(Function-Call) s
9009 15127 mt 
(Generator) s
6 w


%%IncludeResource: font Helvetica
/Helvetica /WindowsLatin1Encoding 120 FMSR

4962 4747 mt 
(trigger_scheduler_100ms_task_06) s
6 w
gr

24 10 10 24 0 4 -10 24 -24 10 5806 11736 14 MP stroke
%%IncludeResource: font Helvetica
/Helvetica /WindowsLatin1Encoding 120 FMSR

5454 11947 mt 
(Chris_did_this_example_to_test_out) s
6 w

Answer 1

以下があなたのために働くと思います。

ノート：

• イディオムを使用してすべてのデータを丸呑みしますdo { local $/; <DATA> }。
• 行末のバックスラッシュを単一の正規表現で修正する

---

use strict;
use warnings;

my $data = do { local $/; <DATA> };
$data =~ s,\\\n,,g;

my $out = "";
my $s = "";    
my $y;

for my $line (split("\n", $data)) {
  if (defined($y) && $line =~ m/^\((.*)\)\s+s\s*$/) {
    $s .= $1;
    next;
  } elsif ($line =~ m/^(\d+)\s+(\d+)\s+mt\s*$/) {
    if (defined($y) && $y == $2) {
      next;
    } else {
      $y = $2;
    }
  } else {
    $y = undef;
  }
  if (length($s)) {
    $out .= "($s) s\n";
    $s = "";
  }
  $out .= "$line\n";
}

print $out;

Answer 2

これに対する一般的なアプローチは見当たりません。しかし、特殊なケースのコレクションはうまくいくようです。ここでの弱点は、より多くの特殊なケースを追加することは、うまくスケーリングできないモデルであるということです. しかし、これが問題の完全なリストである場合、これは機能するはずです。

#!/usr/bin/perl -Tw

use strict;
use warnings;

my %regex_for = (
    a => qr{
        \( ( \w+ ) \)     \s s  \s+  # (Function) s
        \d+ \s+ \d+       \s mt \s+  # 9405 14971 mt
        \( ( [-_]|ms ) \) \s s  \s+  # (-) s
        \d+ \s+ \d+       \s mt \s+  # 9441 14971 mt
        \( ( \w+ ) \)     \s s  \s+  # (Call) s
    }xmsi,
    b => qr{
        \( ( \w+ ) \\ \s* ( \w+ ) \)  # (Chris_\
    }xms,    #  did_this_example_)
    c => qr{
        \( ( \w+ _ ) \) \s s  \s+  # (Chris_did_this_example_) s
        \d+ \s+ \d+     \s mt \s+  # 5874 11947 mt
        \( ( \w+ ) \)   \s s  \s+  # (to_test) s
    }xms,
    d => qr{
        \( ( \w+ ) \)   \s s  \s+  # (to_test) s
        \d+ \s+ \d+     \s mt \s+  # 5946 11947 mt
        \( ( _ \w+ ) \) \s s  \s+  # (_out) s
    }xms,
);

my $ps = do { local $/; <DATA> };

REGSUB:
{
    my $a = $ps =~ s{ $regex_for{a} }{($1$2$3) s\n}xmsg;
    my $b = $ps =~ s{ $regex_for{b} }{($1$2)}xmsg;
    my $c = $ps =~ s{ $regex_for{c} }{($1$2) s\n}xmsg;
    my $d = $ps =~ s{ $regex_for{d} }{($1$2) s\n}xmsg;

    redo REGSUB
        if $a || $b || $c || $d;
}

print $ps;

__DATA__
%%IncludeResource: font Helvetica
/Helvetica /WindowsLatin1Encoding 60 FMSR

11214 11653 mt
(0) s
4.5 w
156 0 2204 19229 2 MP stroke
156 0 2204 19084 2 MP stroke

%%IncludeResource: font Helvetica
/Helvetica /WindowsLatin1Encoding 120 FMSR

8913 14971 mt
(Function) s
9405 14971 mt
(-) s
9441 14971 mt
(Call) s
9009 15127 mt
(Generator) s
6 w


%%IncludeResource: font Helvetica
/Helvetica /WindowsLatin1Encoding 120 FMSR

4962 4747 mt
(trigger) s
5322 4747 mt
(_) s
5394 4747 mt
(scheduler) s
5934 4747 mt
(_) s
6006 4747 mt
(100) s
6222 4747 mt
(ms) s
6378 4747 mt
(_) s
6450 4747 mt
(task) s
6654 4747 mt
(_) s
6726 4747 mt
(06) s
6 w
gr

24 10 10 24 0 4 -10 24 -24 10 5806 11736 14 MP stroke
%%IncludeResource: font Helvetica
/Helvetica /WindowsLatin1Encoding 120 FMSR

5454 11947 mt
(Chris_\
did_this_example_) s
5874 11947 mt
(to_test) s
5946 11947 mt
(_out) s
6 w