Skip to content

Instantly share code, notes, and snippets.

@kiwanami
Created September 26, 2010 07:09
Show Gist options
  • Save kiwanami/597679 to your computer and use it in GitHub Desktop.
Save kiwanami/597679 to your computer and use it in GitHub Desktop.
;; for kansai_emacs #0x02
(require 'deferred)
;; ■ 基本的使い方
(deferred:$
(deferred:next
(lambda (x) (message "deferred start")))
(deferred:nextc it
(lambda (x)
(message "chain 1")
1))
(deferred:nextc it
(lambda (x)
(message "chain 2 : %s" x)))
(deferred:nextc it
(lambda (x)
(read-minibuffer "Input a number: ")))
(deferred:nextc it
(lambda (x)
(message "Got the number : %i" x)))
(deferred:error it
(lambda (err)
(message "Wrong input : %s" err))))
;; ■ Web Access
;; HTML取ってくる
(require 'url)
(deferred:$
(deferred:url-retrieve "http://www.gnu.org")
(deferred:nextc it
(lambda (buf)
(insert (with-current-buffer buf (buffer-string)))
(kill-buffer buf))))
;; 画像を取ってきてみる
(deferred:$
(deferred:url-retrieve "http://www.google.co.jp/intl/en_com/images/srpr/logo1w.png")
(deferred:nextc it
(lambda (buf)
(insert-image
(create-image
(let ((data (with-current-buffer buf (buffer-string))))
(substring data (+ (string-match "\n\n" data) 2)))
'png t))
(kill-buffer buf))))
;; ■ 並列実行
(deferred:$
(deferred:parallel
(lambda ()
(deferred:url-retrieve "http://www.google.co.jp/intl/en_com/images/srpr/logo1w.png"))
(lambda ()
(deferred:url-retrieve "http://www.google.co.jp/images/srpr/nav_logo14.png")))
(deferred:nextc it
(lambda (buffers)
(loop for i in buffers
do
(insert
(format
"size: %s\n"
(with-current-buffer i (length (buffer-string)))))
(kill-buffer i)))))
;; ■ wget で取ってきて convert でリサイズ
(deferred:$
;; try
(deferred:$
(deferred:process "wget" "-O" "a.jpg" "http://www.gnu.org/software/emacs/tour/images/splash.png")
(deferred:nextc it
(lambda (x) (deferred:process "convert" "a.jpg" "-reasize" "100x100" "jpg:b.jpg")))
(deferred:nextc it
(lambda (x)
(clear-image-cache)
(insert-image (create-image (expand-file-name "b.jpg") 'jpeg nil)))))
;; catch
(deferred:error it ;
(lambda (err)
(insert "Can not get a image! : " err)))
;; finally
(deferred:nextc it
(lambda (x)
(deferred:parallel
(lambda () (delete-file "a.jpg"))
(lambda () (delete-file "b.jpg")))))
(deferred:nextc it
(lambda (x) (message ">> %s" x))))
;; ■ 遅延評価、無限系、Generator
;; 準備
(defmacro jslambda (args &rest body)
(let ((argsyms (loop for i in args collect (gensym))))
`(lambda (,@argsyms)
(lexical-let (callee)
(setq callee (lambda( ,@args ) ,@body))
(funcall callee ,@argsyms)))))
(defun co-routine-replace-yield (tree)
(let (ret)
(loop for i in tree
do (cond
((eq i 'yield)
(push 'funcall ret)
(push i ret))
((listp i)
(push (co-routine-replace-yield i) ret))
(t
(push i ret))))
(nreverse ret)))
(defun co-routine-line (line)
(cond
((functionp line)
`(setq ,chain (deferred:nextc ,chain ,line)))
((eq 'while (car line))
(let ((condition (cadr line))
(body (cddr line)))
`(setq ,chain
(deferred:nextc ,chain
(jslambda (x)
(if ,condition
(deferred:nextc
(progn
,@(co-routine-replace-yield body)) callee)))))))
(t
`(setq ,chain
(deferred:nextc ,chain
(jslambda (x) ,(co-routine-replace-yield line)))))))
(defmacro co-routine (argcc &rest argbody)
(let ((chain (gensym))
(cc (gensym))
(waiter (gensym)))
`(lexical-let*
(,chain
(,cc ,argcc)
(,waiter (deferred:new))
(yield (lambda (x) (funcall ,cc x) ,waiter)))
(setq ,chain ,waiter)
,@(loop for i in argbody
collect
(co-routine-line i))
(lambda () (deferred:callback ,waiter)))))
;; フィボナッチをgeneratorで
(defun fib-generator (cc)
(lexical-let* ((a 0) (b 1) (n 0))
(co-routine cc
(yield a)
(yield b)
(while t
(setq n (+ a b))
(setq a b
b n)
(yield n)))))
(setq ret nil)
(setq fibgen (fib-generator (lambda (x) (push x ret))))
(progn (funcall fibgen) ret) ; ここを何度も実行すると、retに値が入っていく
;; ※非同期で値が入るので注意
;; 階乗計算
(defun fact-generator (cc)
(lexical-let* ((count 1) (fact 1))
(co-routine cc
(while t
(setq fact (* fact count))
(incf count)
(yield fact)))))
(setq ret nil)
(setq factgen (fact-generator (lambda (x) (push x ret))))
(progn (funcall factgen) ret)
;; ■ マルチスレッド
;; inertial-scroll.el を実行中に
(setq inertias-initial-velocity 120
inertias-friction 60
inertias-update-time 50
inertias-rest-coef 0.5) ; 動きが目立つパラメーター
;; ここで画面分割して、複数の画面でスクロールできるのを確認する
(setq inertias-initial-velocity 80
inertias-friction 120
inertias-update-time 50
inertias-rest-coef 0.1) ; 元のパラメーター
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment