EMACS-DOCUMENT

=============>随便,谢谢

Part 9: Common Lisp, incf, decf, 结构体

Common Lisp

(require 'cl)                           ;译者注,已经不推荐使用cl库了,用cl-lib替代

把它放在代码的开头,就可以使用常见的Lisp命令了(incf, decf, setf, defstruct,等等)。

incfdecf

(setq x 5)
(incf x 3) ;; ==> 8 (等于 (setq x (+ x 3)) ;译者注,严格来说等同于 (setf x (+ x 3))
(incf x) ;; ==> 9 (等于 (setq x (1+ x))
(decf x 7) ;; ==> 2 (等于 (setq x (- x 7))
(decf x) ;; ==> 1 (等于 (setq x (1- x))

setf

(setf x 5) ;; 与 (setq x 5) 一样

setf 很有用的一点是,你不仅可以设置变量,还可以设置其他东西,例如结构体中的内容。

结构体

俗话说,编程就是定义数据结构,然后用算法来改变它们. defstruct 让你可以定义数据结构。

(defstruct obj x y ch)

(setq o (make-obj 5 5 ?^))
(draw-char (obj-x o) (obj-y o) (obj-ch o))
(incf (obj-x o))
(setf (obj-ch o) ?!)

注意使用 setf 而不是 setq 来更改对象中的内容。

映射

(mapcar* '1+ '(4 5 6)) ;; ==> (5 6 7)

对列表中的每一项调用函数 1+ 返回结果 (4 5 6).

可以用来创建一个结构体的列表:

;; data

(defstruct obj x y ch)

(defun make-char-obj (ch)
  (make-obj :x (/ width 2) :y (/ height 2) :ch ch))

;; algorithm

(defun move-char3a ()
  (pop-to-buffer "test")
  (buffer-disable-undo)
  (make-grid)
  (let ((chars (mapcar* 'make-char-obj '(?> ?< ?^))))
    (dotimes (i 2000)
      (dolist (c chars)
        (draw-char (obj-x c) (obj-y c) (obj-ch c))
        (incf (obj-x c) (delta))
        (incf (obj-y c) (delta))
        ;; stop at edges
        (setf (obj-x c) (clamp (obj-x c) 1 width)
              (obj-y c) (clamp (obj-y c) 1 height)))
      (sit-for 0.03))))

其中需要一些辅助程序,比如

(defun clamp (num low high)
  (min (max num low) high))

使用结构体表示条纹字符

(require 'cl)

;; global variables

(setf bkgd-width 60)
(setf bkgd-height 40)
(setf bkgd-char ?s)
(setf stripe-char ?s)

;; helper routines

(defun make-grid ()
  (erase-buffer)
  (dotimes (i bkgd-height)
    (insert-char bkgd-char bkgd-width)
    (newline)))

(defun gotoxy (x y)
  (goto-char (+ x (* (1- y) (1+ bkgd-width)))))

(defun draw-a-stripe (s)
  (gotoxy (stripe-x s) (stripe-y s))
  (let ((actual-width (min (1+ (- bkgd-width (stripe-x s)))
                           (stripe-width s))))
    (delete-char actual-width)
    (insert (propertize (make-string actual-width stripe-char)
                        'face `(:background ,(stripe-color s))))))

(defun random+ (n) (1+ (random n)))

                                        ; data
(defstruct stripe x y width color dx dy)

(defun build-a-stripe (color)
  (make-stripe :x (random+ bkgd-width) :y (random+ bkgd-height)
               :width (random+ bkgd-width)
               :color color :dx (- (random 3) 1) :dy (1+ (random 2))))

(setf color-choices (defined-colors))
(defun random-color ()
  (nth (random (length color-choices)) color-choices))

(defun random-gray ()
  (format "gray%d" (random 101)))

(defun build-random-stripes (num)
  (loop repeat num
        collect (build-a-stripe (random-color))))

;; two different ways to build stripes, use one or the other!
(setf the-stripes (build-random-stripes 100))
(setf the-stripes (loop repeat 100 collect (build-a-stripe (random-gray))))

(defun animate-a-stripe (s)
  (draw-a-stripe s)
  (incf (stripe-x s) (stripe-dx s))
  (if (cond
       ((> (stripe-x s) bkgd-width) (setf (stripe-x s) 1))
       ((< (stripe-x s) 1) (setf (stripe-x s) bkgd-width)))
      (setf (stripe-y s) (random+ bkgd-height)))
  (incf (stripe-y s) (stripe-dy s))
  (if (> (stripe-y s) bkgd-height) (setf (stripe-y s) 1))
  (if (< (stripe-y s) 1) (setf (stripe-y s) bkgd-height)))

(defun animate4 ()
  (pop-to-buffer "stripes-animation")
  (buffer-disable-undo)
  (setf cursor-type nil)
  (while (not (input-pending-p))
    (make-grid)
    (dolist (s the-stripes)
      (animate-a-stripe s))
    (sit-for 0.01)))