搜索 社区服务 统计排行 帮助
发帖 回复
« 返回列表上一主题下一主题
  • 4115阅读
  • 2回复

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

 楼层直达
linuxyouxia
级别: 圣骑士
注册时间:
2006-08-17
在线时间:
146小时
发帖:
215
只看楼主 更多操作 楼主  发表于: 2011-12-15
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
  4. (defun avs-masktool-postfix-format (expstr)
  5.   (let ((initlist (delete "" (split-string expstr "\"")))
  6.     (outlist nil))
  7.     (defun expstrproc (procstr state)
  8.       (defun append-outlist (separator-str)
  9.     (setq outlist (append outlist (delete "" (split-string (car procstr) separator-str)))))
  10.       (cond ((null procstr) outlist)
  11.         ((= state 0)
  12.         (append-outlist nil)
  13.         (expstrproc (cdr procstr) 1))
  14.         ((= state 1)    
  15.         (append-outlist "+\\|\n\\|\s\\|\t\\|\r\\|\\\\")
  16.         (expstrproc (cdr procstr) 0))
  17.         (t nil)))
  18.     (expstrproc initlist 0)))
  20. (defun avs-masktool-postfix-to-prefix-elisp (explist)
  21.   (defun make-polish-symbol-table (list)
  22.     (let ((p-symbol-table (make-hash-table :test 'equal)))
  23.       (dolist (pair list)
  24.     (puthash (car pair) (cadr pair) p-symbol-table))
  25.       p-symbol-table))
  26.   (let ((rpnstack nil)
  27.     (polish-symbol-table (make-polish-symbol-table '(("+" 2) ("*" 2) ("/" 2) ("-" 2)
  28.                              ("^" 2) ("%" 2) ("?" 3) ("==" 2)
  29.                              ("=" 2) ("!=" 2) ("<=" 2) ("<" 2)
  30.                              (">=" 2) (">" 2) ("&" 2) ("|" 2)
  31.                              ("&!" 2) ("°" 2) ("@" 2) ("&u" 2)
  32.                              ("|u" 2) ("°u" 2) ("@u" 2) ("~u" 1)
  33.                              ("<<" 2) ("<<u" 2) (">>" 2) (">>u" 2)
  34.                              ("&s" 2) ("|s" 2) ("°s" 2) ("@s" 2)
  35.                              ("~s" 1) ("<<s" 2) (">>s" 2) ("cos" 1)
  36.                              ("sin" 1) ("tan" 1) ("log" 1) ("exp" 1)
  37.                              ("abs" 1) ("atan" 1) ("acos" 1) ("asin" 1)
  38.                              ("round" 1) ("clip" 3) ("min" 2) ("max" 2)
  39.                              ("ceil" 1) ("floor" 1) ("trunc" 1)))))
  40.     (defun poprpn ()
  41.       (let ((item (pop rpnstack)))
  42.     (cond ((gethash item polish-symbol-table nil) (push item rpnstack) "*undef*")
  43.           ((null item) "*undef*")
  44.           (t item))))
  45.     (defun funop (argc ele)
  46.       (let ((item nil))
  47.     (do ((i 1 (+ i 1)))
  48.         ((> i argc) (push (concat "(" ele " " item ")") rpnstack))
  49.       (setq item (concat (poprpn) (if item " " "") item)))))
  50.     (let ((rpnelelist (delete "" explist)))
  51.       (dolist (ele rpnelelist)
  52.     (let ((eleargc (gethash ele polish-symbol-table nil)))
  53.       (if eleargc
  54.           (funop eleargc ele)
  55.         (push ele rpnstack)))))
  56.     (let ((res ""))
  57.       (dolist (restele rpnstack)
  58.     (setq res (concat res restele "\n")))
  59.       res)))
  61. (defun avs-masktool-postfix-to-prefix (rstart rend)
  62.   (interactive "r")
  63.   (let ((data (buffer-substring-no-properties rstart rend))
  64.     (info nil)
  65.     (buf (get-buffer-create "*masktool helper*")))
  66.     (set-buffer buf)
  67.     (setq buffer-read-only nil)
  68.     (erase-buffer)
  69.     (setq info (avs-masktool-postfix-to-prefix-elisp (avs-masktool-postfix-format data)))
  70.     (insert info)
  71.     (pp-buffer)
  72.     (clipboard-kill-ring-save (point-min) (point-max))
  73.     (pop-to-buffer buf)
  74.     (message info)))
  76. (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重新编辑 ]
分享到 淘江湖 新浪 QQ微博 QQ空间 开心 人人 豆瓣 网易微博 百度 鲜果 白社会 飞信
Fansubbing is a waste of time.
回复 引用
举报顶端
linuxyouxia
级别: 圣骑士
注册时间:
2006-08-17
在线时间:
146小时
发帖:
215
只看该作者 2楼 发表于: 2011-12-16
中缀表达式长了也容易看晕，继续看有缩进的S-表达式

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

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


顺便想到了，可以给avisynth写个REPL程序
[ 此帖被linuxyouxia在2011-12-16 11:07重新编辑 ]
Fansubbing is a waste of time.
回复 引用
举报顶端
06_taro
级别: 骑士
注册时间:
2008-10-06
在线时间:
115小时
发帖:
319
只看该作者 1楼 发表于: 2011-12-16
masktools2内置mt_infix/mt_polish可以直接转换
Follow me: @06_taro

MediaFire links to:
Taro's tools (avs plugins & other useful tools' builds)
Taro's x264 builds (Latest build: x264 core:129 r2245+704_tMod (&tMod+10bit/MixAQ/OreAQ), Win & MacOS, built on 10 Jan 2012, gcc: 4.7.2)

nmm牆內鏡像（部分工具）
回复 引用
举报顶端
发帖 回复
« 返回列表上一主题下一主题
快速回复
限150 字节
上一个 下一个