deferred-demo.el

;; 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) ; 元のパラメーター