[分享] 将masktools 2使用的逆波兰式转成S-表达式（emacs lisp）|『影音数码技术学习交流』 - 『漫游』酷论坛

(? (== x y) x (+ x (* (* (* (* (^ (/ (abs (- x y)) 16) (/ 1 2)) 16) Str) (/ (^ (- x y) 2) (+ (^ (- x y) 2) (/ (* Str 100) 25)))) (/ (- x y) (abs (- x y))))))

((x == y) ? x : (x + ((((((abs((x - y)) / 16) ^ (1 / 2)) * 16) * Str) * (((x - y) ^ 2) / (((x - y) ^ 2) + ((Str * 100) / 25)))) * ((x - y) / abs((x - y))))))

(require 'pp)
;;http://braeburn.aquamacs.org/code/master/lisp/emacs-lisp/pp.el
(defun avs-masktool-postfix-format (expstr)
(let ((initlist (delete "" (split-string expstr "\"")))
(outlist nil))
(defun expstrproc (procstr state)
(defun append-outlist (separator-str)
(setq outlist (append outlist (delete "" (split-string (car procstr) separator-str)))))
(cond ((null procstr) outlist)
((= state 0)
(append-outlist nil)
(expstrproc (cdr procstr) 1))
((= state 1)
(append-outlist "+\\|\n\\|\s\\|\t\\|\r\\|\\\\")
(expstrproc (cdr procstr) 0))
(t nil)))
(expstrproc initlist 0)))
(defun avs-masktool-postfix-to-prefix-elisp (explist)
(defun make-polish-symbol-table (list)
(let ((p-symbol-table (make-hash-table :test 'equal)))
(dolist (pair list)
(puthash (car pair) (cadr pair) p-symbol-table))
p-symbol-table))
(let ((rpnstack nil)
(polish-symbol-table (make-polish-symbol-table '(("+" 2) ("*" 2) ("/" 2) ("-" 2)
("^" 2) ("%" 2) ("?" 3) ("==" 2)
("=" 2) ("!=" 2) ("<=" 2) ("<" 2)
(">=" 2) (">" 2) ("&" 2) ("|" 2)
("&!" 2) ("°" 2) ("@" 2) ("&u" 2)
("|u" 2) ("°u" 2) ("@u" 2) ("~u" 1)
("<<" 2) ("<<u" 2) (">>" 2) (">>u" 2)
("&s" 2) ("|s" 2) ("°s" 2) ("@s" 2)
("~s" 1) ("<<s" 2) (">>s" 2) ("cos" 1)
("sin" 1) ("tan" 1) ("log" 1) ("exp" 1)
("abs" 1) ("atan" 1) ("acos" 1) ("asin" 1)
("round" 1) ("clip" 3) ("min" 2) ("max" 2)
("ceil" 1) ("floor" 1) ("trunc" 1)))))
(defun poprpn ()
(let ((item (pop rpnstack)))
(cond ((gethash item polish-symbol-table nil) (push item rpnstack) "*undef*")
((null item) "*undef*")
(t item))))
(defun funop (argc ele)
(let ((item nil))
(do ((i 1 (+ i 1)))
((> i argc) (push (concat "(" ele " " item ")") rpnstack))
(setq item (concat (poprpn) (if item " " "") item)))))
(let ((rpnelelist (delete "" explist)))
(dolist (ele rpnelelist)
(let ((eleargc (gethash ele polish-symbol-table nil)))
(if eleargc
(funop eleargc ele)
(push ele rpnstack)))))
(let ((res ""))
(dolist (restele rpnstack)
(setq res (concat res restele "\n")))
res)))
(defun avs-masktool-postfix-to-prefix (rstart rend)
(interactive "r")
(let ((data (buffer-substring-no-properties rstart rend))
(info nil)
(buf (get-buffer-create "*masktool helper*")))
(set-buffer buf)
(setq buffer-read-only nil)
(erase-buffer)
(setq info (avs-masktool-postfix-to-prefix-elisp (avs-masktool-postfix-format data)))
(insert info)
(pp-buffer)
(clipboard-kill-ring-save (point-min) (point-max))
(pop-to-buffer buf)
(message info)))
(provide 'avs-masktool-helper)

(add-to-list 'load-path "path2pp.el&avs-masktool-helper.el")
(require 'pp)
(require 'avs-masktool-helper)
(global-set-key (kbd "C-C C-P") 'avs-masktool-postfix-to-prefix)

#!/usr/bin/env perl
use strict;
use warnings;
my @rpnstack;
my %opsymbol =
(
'+' => \&mathop, '*' => \&mathop, '/' => \&mathop, '-' => \&mathop,
'^' => \&mathop, '%' => \&mathop, '?' => \&ifop, '==' => \&mathop,
'=' => \&mathop, '!=' => \&mathop, '<=' => \&mathop, '<' => \&mathop,
'>=' => \&mathop, '>' => \&mathop, '&' => \&mathop, '|' => \&mathop,
'&!' => \&mathop, '°' => \&mathop, '@' => \&mathop, '&u' => \&mathop,
'|u' => \&mathop, '°u' => \&mathop, '@u' => \&mathop, '~u' => &funop(1),
'<<' => \&mathop, '<<u' => \&mathop, '>>' => \&mathop, '>>u' => \&mathop,
'&s' => \&mathop, '|s' => \&mathop, '°s' => \&mathop, '@s' => \&mathop,
'~s' => &funop(1), '<<s' => \&mathop, '>>s' => \&mathop, 'cos' => &funop(1),
'sin' => &funop(1), 'tan' => &funop(1), 'log' => &funop(1), 'exp' => &funop(1),
'abs' => &funop(1), 'atan' => &funop(1), 'acos' => &funop(1), 'asin' => &funop(1),
'round' => &funop(1), 'clip' => &funop(3), 'min' => &funop(2), 'max' => &funop(2),
'ceil' => &funop(1), 'floor' => &funop(1), 'trunc' => &funop(1)
);
sub poprpn {
my $res = pop @rpnstack;
if (!defined($res)) {
print "$_: The user has not input sufficient values!\n";
$res = '*undef*';
} elsif (defined($opsymbol{$res})) {
push(@rpnstack, $res);
print "$_: The user has not input sufficient values!\n";
$res = '*undef*';
}
return $res;
}
sub funop {
my $argc = shift;
return sub {
my $opstr = shift;
$_ = $opstr;
my $res = &poprpn;
for (my $i = 2; $i <= $argc; $i++) {
my $element = &poprpn;
$res = "$element ".$res;
}
return "$opstr($res)";
}
}
sub mathop {
my $opstr = shift;
$_ = $opstr;
my $item1 = &poprpn;
my $item2 = &poprpn;
return "($item2 $opstr $item1)";
}
sub ifop {
$_ = '?';
my $item1 = &poprpn;
my $item2 = &poprpn;
my $item3 = &poprpn;
return "($item3 ? $item2 : $item1)";
}
my @instr = split /(?<=")|(?=")/, $ARGV[0];
my $rpnexp = '';
my $state = 1;
foreach my $to (@instr) {
if ($state == 0 ) {
if ($to eq '"') {
$state = 1;
next;
}
} elsif ($state == 1) {
if ($to eq '"') {
$state = 0;
next;
}
$to =~ s/\+|\\/ /g;
}
$rpnexp = $rpnexp."$to ";
}
my @rpnstr = split /\s+/, $rpnexp;
foreach my $token (@rpnstr) {
my $action = $opsymbol{$token};
if (defined($action)) {
my $res = &$action($token);
push(@rpnstack, $res);
} else {
push(@rpnstack, $token);
}
}
while (defined(my $exp = pop @rpnstack)) {
print "$exp\n";
}