『漫游』酷论坛>『影音数码技术学习交流』>[分享] 将masktools 2使用 ..

[分享] 将masktools 2使用的逆波兰式转成S-表达式(emacs lisp)

linuxyouxia@2011-12-15 07:18

masktools 2用的逆波兰式不容易让人读懂,最近无聊折腾emacs,顺便用emacs lisp写了段代码将其转成S-表达式

使用效果:
http://img165.poco.cn/mypoco/myphoto/20111215/07/4476863220111215071552054.jpg
S-表达式
复制代码
  1. (? (== 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))))))

对应的中缀表达式是(用一个Perl脚本转换,Windows Cmd下使用会遇到参数转义问题,就不发上来了)
复制代码
  1. ((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))))))


代码:
复制代码
  1. (require 'pp)
  2. ;;http://braeburn.aquamacs.org/code/master/lisp/emacs-lisp/pp.el
  3. (defun avs-masktool-postfix-format (expstr)
  4.   (let ((initlist (delete "" (split-string expstr "\"")))
  5.     (outlist nil))
  6.     (defun expstrproc (procstr state)
  7.       (defun append-outlist (separator-str)
  8.     (setq outlist (append outlist (delete "" (split-string (car procstr) separator-str)))))
  9.       (cond ((null procstr) outlist)
  10.         ((= state 0)
  11.         (append-outlist nil)
  12.         (expstrproc (cdr procstr) 1))
  13.         ((= state 1)    
  14.         (append-outlist "+\\|\n\\|\s\\|\t\\|\r\\|\\\\")
  15.         (expstrproc (cdr procstr) 0))
  16.         (t nil)))
  17.     (expstrproc initlist 0)))
  18. (defun avs-masktool-postfix-to-prefix-elisp (explist)
  19.   (defun make-polish-symbol-table (list)
  20.     (let ((p-symbol-table (make-hash-table :test 'equal)))
  21.       (dolist (pair list)
  22.     (puthash (car pair) (cadr pair) p-symbol-table))
  23.       p-symbol-table))
  24.   (let ((rpnstack nil)
  25.     (polish-symbol-table (make-polish-symbol-table '(("+" 2) ("*" 2) ("/" 2) ("-" 2)
  26.                              ("^" 2) ("%" 2) ("?" 3) ("==" 2)
  27.                              ("=" 2) ("!=" 2) ("<=" 2) ("<" 2)
  28.                              (">=" 2) (">" 2) ("&" 2) ("|" 2)
  29.                              ("&!" 2) ("°" 2) ("@" 2) ("&u" 2)
  30.                              ("|u" 2) ("°u" 2) ("@u" 2) ("~u" 1)
  31.                              ("<<" 2) ("<<u" 2) (">>" 2) (">>u" 2)
  32.                              ("&s" 2) ("|s" 2) ("°s" 2) ("@s" 2)
  33.                              ("~s" 1) ("<<s" 2) (">>s" 2) ("cos" 1)
  34.                              ("sin" 1) ("tan" 1) ("log" 1) ("exp" 1)
  35.                              ("abs" 1) ("atan" 1) ("acos" 1) ("asin" 1)
  36.                              ("round" 1) ("clip" 3) ("min" 2) ("max" 2)
  37.                              ("ceil" 1) ("floor" 1) ("trunc" 1)))))
  38.     (defun poprpn ()
  39.       (let ((item (pop rpnstack)))
  40.     (cond ((gethash item polish-symbol-table nil) (push item rpnstack) "*undef*")
  41.           ((null item) "*undef*")
  42.           (t item))))
  43.     (defun funop (argc ele)
  44.       (let ((item nil))
  45.     (do ((i 1 (+ i 1)))
  46.         ((> i argc) (push (concat "(" ele " " item ")") rpnstack))
  47.       (setq item (concat (poprpn) (if item " " "") item)))))
  48.     (let ((rpnelelist (delete "" explist)))
  49.       (dolist (ele rpnelelist)
  50.     (let ((eleargc (gethash ele polish-symbol-table nil)))
  51.       (if eleargc
  52.           (funop eleargc ele)
  53.         (push ele rpnstack)))))
  54.     (let ((res ""))
  55.       (dolist (restele rpnstack)
  56.     (setq res (concat res restele "\n")))
  57.       res)))
  58. (defun avs-masktool-postfix-to-prefix (rstart rend)
  59.   (interactive "r")
  60.   (let ((data (buffer-substring-no-properties rstart rend))
  61.     (info nil)
  62.     (buf (get-buffer-create "*masktool helper*")))
  63.     (set-buffer buf)
  64.     (setq buffer-read-only nil)
  65.     (erase-buffer)
  66.     (setq info (avs-masktool-postfix-to-prefix-elisp (avs-masktool-postfix-format data)))
  67.     (insert info)
  68.     (pp-buffer)
  69.     (clipboard-kill-ring-save (point-min) (point-max))
  70.     (pop-to-buffer buf)
  71.     (message info)))
  72. (provide 'avs-masktool-helper)


如果不想要格式化代码,可以把pp-buffer那行去掉

在emacs配置里,绑定下avs-masktool-postfix-to-prefix快捷键,选中逆波兰式字符串区域(包括引号),然后按快捷键或者M-x avs-masktool-postfix-to-prefix RET,输出格式化后的S-表达式,并添加到kill-ring里面,方便粘贴
复制代码
  1. (add-to-list 'load-path "path2pp.el&avs-masktool-helper.el")
  2. (require 'pp)
  3. (require 'avs-masktool-helper)
  4. (global-set-key (kbd "C-C C-P") 'avs-masktool-postfix-to-prefix)


另1:masktools2提供了一个mt_polish函数用来将中缀表达式转成逆波兰式
另2:emacs曾有人写过一个视频编辑模式 GNEVE GNU Emacs Video Editing
另3:AvsPMod也完全可以写一个转换用的宏
(闪




[ 此帖被linuxyouxia在2011-12-15 07:40重新编辑 ]
引用

06_taro@2011-12-16 08:02

masktools2内置mt_infix/mt_polish可以直接转换
引用

linuxyouxia@2011-12-16 09:59

中缀表达式长了也容易看晕,继续看有缩进的S-表达式

mt_infix/mt_polish要通过avs调用,需要自己写个程序调用后直接返回字符串= =
(Windows下通过命令行把表达式当参数传过去需要转义;*nix下要调用Wine,麻烦)

转中缀表达式Perl脚本
复制代码
  1. #!/usr/bin/env perl
  2. use strict;
  3. use warnings;
  4. my @rpnstack;
  5. my %opsymbol =
  6.   (
  7.    '+' => \&mathop, '*' => \&mathop, '/' => \&mathop, '-' => \&mathop,
  8.    '^' => \&mathop, '%' => \&mathop, '?' => \&ifop, '==' => \&mathop,
  9.    '=' => \&mathop, '!=' => \&mathop, '<=' => \&mathop, '<' => \&mathop,
  10.    '>=' => \&mathop, '>' => \&mathop, '&' => \&mathop, '|' => \&mathop,
  11.    '&!' => \&mathop, '°' => \&mathop, '@' => \&mathop, '&u' => \&mathop,
  12.    '|u' => \&mathop, '°u' => \&mathop, '@u' => \&mathop, '~u' => &funop(1),
  13.    '<<' => \&mathop, '<<u' => \&mathop, '>>' => \&mathop, '>>u' => \&mathop,
  14.    '&s' => \&mathop, '|s' => \&mathop, '°s' => \&mathop, '@s' => \&mathop,
  15.    '~s' => &funop(1), '<<s' => \&mathop, '>>s' => \&mathop, 'cos' => &funop(1),
  16.    'sin' => &funop(1), 'tan' => &funop(1), 'log' => &funop(1), 'exp' => &funop(1),
  17.    'abs' => &funop(1), 'atan' => &funop(1), 'acos' => &funop(1), 'asin' => &funop(1),
  18.    'round' => &funop(1), 'clip' => &funop(3), 'min' => &funop(2), 'max' => &funop(2),
  19.    'ceil' => &funop(1), 'floor' => &funop(1), 'trunc' => &funop(1)
  20.   );
  21. sub poprpn {
  22.   my $res = pop @rpnstack;
  23.   if (!defined($res)) {
  24.     print "$_: The user has not input sufficient values!\n";
  25.     $res = '*undef*';
  26.   } elsif (defined($opsymbol{$res})) {
  27.     push(@rpnstack, $res);
  28.     print "$_: The user has not input sufficient values!\n";
  29.     $res = '*undef*';
  30.   }
  31.   return $res;
  32. }
  33. sub funop {
  34.   my $argc = shift;
  35.   return sub {
  36.     my $opstr = shift;
  37.     $_ = $opstr;
  38.     my $res = &poprpn;
  39.     for (my $i = 2; $i <= $argc; $i++) {
  40.       my $element = &poprpn;
  41.       $res = "$element ".$res;
  42.     }
  43.     return "$opstr($res)";
  44.   }
  45. }
  46. sub mathop {
  47.   my $opstr = shift;
  48.   $_ = $opstr;
  49.   my $item1 = &poprpn;
  50.   my $item2 = &poprpn;
  51.   return "($item2 $opstr $item1)";
  52. }
  53. sub ifop {
  54.   $_ = '?';
  55.   my $item1 = &poprpn;
  56.   my $item2 = &poprpn;
  57.   my $item3 = &poprpn;
  58.   return "($item3 ? $item2 : $item1)";
  59. }
  60. my @instr = split /(?<=")|(?=")/, $ARGV[0];
  61. my $rpnexp = '';
  62. my $state = 1;
  63. foreach my $to (@instr) {
  64.   if ($state == 0 ) {
  65.     if ($to eq '"') {
  66.       $state = 1;
  67.       next;
  68.     }
  69.   } elsif ($state == 1) {
  70.     if ($to eq '"') {
  71.       $state = 0;
  72.       next;
  73.     }
  74.     $to =~ s/\+|\\/ /g;
  75.   }
  76.   $rpnexp = $rpnexp."$to ";
  77. }
  78.   
  79. my @rpnstr = split /\s+/, $rpnexp;
  80. foreach my $token (@rpnstr) {
  81.   my $action = $opsymbol{$token};
  82.   if (defined($action)) {
  83.     my $res = &$action($token);
  84.     push(@rpnstack, $res);
  85.   } else {
  86.     push(@rpnstack, $token);
  87.   }
  88. }
  89. while (defined(my $exp = pop @rpnstack)) {
  90.   print "$exp\n";
  91. }


顺便想到了,可以给avisynth写个REPL程序
[ 此帖被linuxyouxia在2011-12-16 11:07重新编辑 ]
引用

| TOP