comparison src/fftw-3.3.3/doc/FAQ/bfnnconv.pl @ 10:37bf6b4a2645

Add FFTW3

+#!/usr/bin/perl --
+# Copyright (C) 1993-1995 Ian Jackson.
+
+# This file 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 2, or (at your option)
+# any later version.
+
+# It 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 GNU Emacs; see the file COPYING.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+# (Note: I do not consider works produced using these BFNN processing
+# tools to be derivative works of the tools, so they are NOT covered
+# by the GPL.  However, I would appreciate it if you credited me if
+# appropriate in any documents you format using BFNN.)
+
+@outputs=('ascii','info','html');
+
+while ($ARGV[0] =~ m/^\-/) {
+    $_= shift(@ARGV);
+    if (m/^-only/) {
+        @outputs= (shift(@ARGV));
+    } else {
+        warn "unknown option `$_' ignored";
+    }
+}
+
+$prefix= $ARGV[0];
+$prefix= 'stdin' unless length($prefix);
+$prefix =~ s/\.bfnn$//;
+
+if (open(O,"$prefix.xrefdb")) {
+    @xrefdb= <O>;
+    close(O);
+} else {
+    warn "no $prefix.xrefdb ($!)";
+}
+
+$section= -1;
+for $thisxr (@xrefdb) {
+    $_= $thisxr;
+    chop;
+    if (m/^Q (\w+) ((\d+)\.(\d+)) (.*)$/) {
+        $qrefn{$1}= $2;
+        $qreft{$1}= $5;
+        $qn2ref{$3,$4}= $1;
+        $maxsection= $3;
+        $maxquestion[$3]= $4;
+    } elsif (m/^S (\d+) /) {
+        $maxsection= $1;
+        $sn2title{$1}=$';
+    }
+}
+
+open(U,">$prefix.xrefdb-new");
+
+for $x (@outputs) { require("m-$x.pl"); }
+
+&call('init');
+
+while (<>) {
+    chop;
+    next if m/^\\comment\b/;
+    if (!m/\S/) {
+        &call('endpara');
+        next;
+    }
+    if (s/^\\section +//) {
+        $line= $_;
+        $section++; $question=0;
+        print U "S $section $line\n";
+        $|=1; print "S$section",' 'x10,"\r"; $|=0;
+        &call('endpara');
+        &call('startmajorheading',"$section",
+              "Section $section",
+              $section<$maxsection ? "Section ".($section+1) : '',
+              $section>1 ? 'Section '.($section-1) : 'Top');
+        &text($line);
+        &call('endmajorheading');
+        if ($section) {
+            &call('endpara');
+            &call('startindex');
+            for $thisxr (@xrefdb) {
+                $_= $thisxr;
+                chop;
+                if (m/^Q (\w+) (\d+)\.(\d+) (.*)$/) {
+                    $ref= $1; $num1= $2; $num2= $3; $text= $4;
+                    next unless $num1 == $section;
+                    &call('startindexitem',$ref,"Q$num1.$num2","Question $num1.$num2");
+                    &text($text);
+                    &call('endindexitem');
+                }
+            }
+            &call('endindex');
+        }
+    } elsif (s/^\\question \d{2}[a-z]{3}((:\w+)?) +//) {
+        $line= $_;
+        $question++;
+        $qrefstring= $1;
+        $qrefstring= "q_${section}_$question" unless $qrefstring =~ s/^://;
+        print U "Q $qrefstring $section.$question $line\n";
+        $|=1; print "Q$section.$question",' 'x10,"\r"; $|=0;
+        &call('endpara');
+        &call('startminorheading',$qrefstring,
+              "Question $section.$question",
+              $question < $maxquestion[$section] ? "Question $section.".($question+1) :
+              $section < $maxsection ? "Question ".($section+1).".1" : '',
+              $question > 1 ? "Question $section.".($question-1) :
+              $section > 1 ? "Question ".($section-1).'.'.($maxquestion[$section-1]) :
+              'Top',
+              "Section $section");
+        &text("Question $section.$question.  $line");
+        &call('endminorheading');
+    } elsif (s/^\\only +//) {
+        @saveoutputs= @outputs;
+        @outputs=();
+        for $x (split(/\s+/,$_)) {
+            push(@outputs,$x) if grep($x eq $_, @saveoutputs);
+        }
+    } elsif (s/^\\endonly$//) {
+        @outputs= @saveoutputs;
+    } elsif (s/^\\copyto +//) {
+        $fh= $';
+        while(<>) {
+            last if m/^\\endcopy$/;
+            while (s/^([^\`]*)\`//) {
+                print $fh $1;
+                m/([^\\])\`/ || warn "`$_'";
+                $_= $';
+                $cmd= $`.$1;
+                $it= `$cmd`; chop $it;
+                print $fh $it;
+            }
+            print $fh $_;
+        }
+    } elsif (m/\\index$/) {
+        &call('startindex');
+        for $thisxr (@xrefdb) {
+            $_= $thisxr;
+            chop;
+            if (m/^Q (\w+) (\d+\.\d+) (.*)$/) {
+                $ref= $1; $num= $2; $text= $3;
+                &call('startindexitem',$ref,"Q$num","Question $num");
+                &text($text);
+                &call('endindexitem');
+            } elsif (m/^S (\d+) (.*)$/) {
+                $num= $1; $text= $2;
+                next unless $num;
+                &call('startindexmainitem',"s_$num",
+                      "Section $num.","Section $num");
+                &text($text);
+                &call('endindexitem');
+            } else {
+                warn $_;
+            }
+        }
+        &call('endindex');
+    } elsif (m/^\\call-(\w+) +(\w+)\s*(.*)$/) {
+        $fn= $1.'_'.$2;
+        eval { &$fn($3); };
+        warn $@ if length($@);
+    } elsif (m/^\\call +(\w+)\s*(.*)$/) {
+        eval { &call($1,$2); };
+        warn $@ if length($@);
+    } elsif (s/^\\set +(\w+)\s*//) {
+        $svalue= $'; $svari= $1;
+        eval("\$user_$svari=\$svalue"); $@ && warn "setting $svalue failed: $@\n";
+    } elsif (m/^\\verbatim$/) {
+        &call('startverbatim');
+        while (<>) {
+            chop;
+            last if m/^\\endverbatim$/;
+            &call('verbatim',$_);
+        }
+        &call('endverbatim');
+    } else {
+        s/\.$/\. /;
+        &text($_." ");
+    }
+}
+
+print ' 'x25,"\r";
+&call('finish');
+rename("$prefix.xrefdb-new","$prefix.xrefdb") || warn "rename xrefdb: $!";
+exit 0;
+
+
+sub text {
+    local($in,$rhs,$word,$refn,$reft,$fn,$style);
+    $in= "$holdover$_[0]";
+    $holdover= '';
+    while ($in =~ m/\\/) {
+#print STDERR ">$`##$'\n";
+        $rhs=$';
+        &call('text',$`);
+        $_= $rhs;
+        if (m/^\w+ $/) {
+            $holdover= "\\$&";
+            $in= '';
+        } elsif (s/^fn\s+([^\s\\]*\w)//) {
+            $in= $_;
+            $word= $1;
+            &call('courier');
+            &call('text',$word);
+            &call('endcourier');
+        } elsif (s/^tab\s+(\d+)\s+//) {
+            $in= $_; &call('tab',$1);
+        } elsif (s/^nl\s+//) {
+            $in= $_; &call('newline');
+        } elsif (s/^qref\s+(\w+)//) {
+            $refn= $qrefn{$1};
+            $reft= $qreft{$1};
+            if (!length($refn)) {
+                warn "unknown question `$1'";
+            }
+            $in= "$`\\pageref:$1:$refn:$reft\\endpageref.$_";
+        } elsif (s/^pageref:(\w+):([^:\n]+)://) {
+            $in= $_;
+            &call('pageref',$1,$2);
+        } elsif (s/^endpageref\.//) {
+            $in= $_; &call('endpageref');
+        } elsif (s/^(\w+)\{//) {
+            $in= $_; $fn= $1;
+            eval { &call("$fn"); };
+            if (length($@)) { warn $@; $fn= 'x'; }
+            push(@styles,$fn);
+        } elsif (s/^\}//) {
+            $in= $_;
+            $fn= pop(@styles);
+            if ($fn ne 'x') { &call("end$fn"); }
+        } elsif (s/^\\//) {
+            $in= $_;
+            &call('text',"\\");
+        } elsif (s,^(\w+)\s+([-A-Za-z0-9.\@:/]*\w),,) {
+#print STDERR "**$&**$_\n";
+            $in= $_;
+            $style=$1; $word= $2;
+            &call($style);
+            &call('text',$word);
+            &call("end$style");
+        } else {
+            warn "unknown control `\\$_'";
+            $in= $_;
+        }
+    }
+    &call('text',$in);
+}
+
+
+sub call {
+    local ($fnbase, @callargs) = @_;
+    local ($coutput);
+    for $coutput (@outputs) {
+        if ($fnbase eq 'text' && eval("\@${coutput}_cmds")) {
+#print STDERR "special handling text (@callargs) for $coutput\n";
+            $evstrg= "\$${coutput}_args[\$#${coutput}_args].=\"\@callargs\"";
+            eval($evstrg);
+            length($@) && warn "call adding for $coutput (($evstrg)): $@";
+        } else {
+            $fntc= $coutput.'_'.$fnbase; 
+            &$fntc(@callargs);
+        }
+    }
+}
+
+
+sub recurse {
+    local (@outputs) = $coutput;
+    local ($holdover);
+    &text($_[0]);
+}
+
+
+sub arg {
+#print STDERR "arg($_[0]) from $coutput\n";
+    $cmd= $_[0];
+    eval("push(\@${coutput}_cmds,\$cmd); push(\@${coutput}_args,'')");
+    length($@) && warn "arg setting up for $coutput: $@";
+}
+
+sub endarg {
+#print STDERR "endarg($_[0]) from $coutput\n";
+    $evstrg= "\$${coutput}_cmd= \$cmd= pop(\@${coutput}_cmds); ".
+             "\$${coutput}_arg= \$arg= pop(\@${coutput}_args); ";
+    eval($evstrg);
+    length($@) && warn "endarg extracting for $coutput (($evstrg)): $@";
+#print STDERR ">call $coutput $cmd $arg< (($evstrg))\n";
+    $evstrg= "&${coutput}_do_${cmd}(\$arg)";
+    eval($evstrg);
+    length($@) && warn "endarg running ${coutput}_do_${cmd} (($evstrg)): $@";
+}