EMACS-DOCUMENT

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

Part 8: 乒乓游戏相关内容

多玩家角色移动游戏

基于 Travis 的代码

;; global variables 

(setq width 50)
(setq height 25)
(setq background-char ?\-)

;; helper routines (foundations)

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

(defun draw-char (x y char)
  (goto-char (+ x (* (1- y) (1+ width))))
  (delete-char 1)
  (insert-char char 1))

(defun clear-char (x y)
  (draw-char x y background-char))

;;main programs

(defun move-char ()
  (make-grid)
  (let ((x 1 ) (y 1))
    (dotimes (i 30)
      (draw-char x y ?\o)
      (sit-for 0.1)
      (clear-char x y)
      (setq x (+ x (random 3))
            y (+ y (random 3))))))

(defun running-man ()
  (setq cursor-type nil)
  (make-grid)
  (let ((ax 1) (ay 1)
        (dax 0) (day 0)
        (bx width) (by height)
        (dbx 0) (dby 0))
    (while (and (>= ax 1) (<= ax width)
                (>= bx 1) (<= bx width))
      ;; draw characters
      (draw-char ax ay ?o)
      (draw-char bx by ?*)
      ;; check input
      (let ((key (read-event nil nil 0.05)))
        (cond 
         ((eq key ?a)                   ;character a
          (setq dax -1))
         ((eq key ?s)
          (setq dax 1))
         ((eq key ?w)
          (setq day -1))
         ((eq key '?z)
          (setq day 1))
         ((eq key 'left)                ;character b
          (setq dbx -1))
         ((eq key 'right)
          (setq dbx 1))
         ((eq key 'up)
          (setq dby -1))
         ((eq key 'down)
          (setq dby 1))))
      ;; clear characters
      (clear-char ax ay)
      (clear-char bx by)
      ;; move characters
      (setq ax (+ ax dax)
            ay (+ ay day)
            bx (+ bx dbx)
            by (+ by dby))
      ;;bounce of top/bottom edges
      (if (or (< ay 1) (> ay height))
          (setq day (- day)))
      (if (or (< by 1) (> by height))
          (setq dby (- dby)))
      ;;stop at edges of screen
      (setq ay (min ay height)
            ay (max ay 1))
      (setq by (min by height)
            by (max by 1)))
    (if (and (>= ax 1) (<= ax width))
        (insert "Congratulations, o won!"))
    (if (and (>= bx 1) (<= bx width))
        (insert "Congratulations, * win!"))))

简单的乒乓游戏

One character wide paddle.

;; global variables

(setq width 50)
(setq height 25)
(setq background-char ?:)

;; helper routines (foundations)

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

(defun draw-char (x y char)
  (goto-char (+ x (* (1- y) (1+ width))))
  (delete-char 1)
  (insert-char char 1))

(defun clear-char (x y)
  (draw-char x y background-char))

;;main programs

(defun pong1 ()
  (setq cursor-type nil)
  (let ((pongx (/ width 2)) (pongy (/ height 2))
        (dpongx -1) (dpongy 0)
        (left-paddle-y (/ height 2))
        (right-paddle-y (/ height 2)))
    (while (and (>= pongx 1) (<= pongx width))
      ;; draw characters
      (make-grid)
      (draw-char pongx pongy ?o)
      (draw-char 1 left-paddle-y ?#)
      (draw-char width right-paddle-y ?#)
      ;; check input
      (let ((key (read-event nil nil 0.05)))
        (cond
         ((eq key ?a)
          (setq left-paddle-y (1- left-paddle-y))
          (if (<= left-paddle-y 1)
              (setq left-paddle-y 1)))
         ((eq key '?z)
          (setq left-paddle-y (1+ left-paddle-y))
          (if (>= left-paddle-y height)
              (setq left-paddle-y height)))
         ((eq key 'up)
          (setq right-paddle-y (1- right-paddle-y))
          (if (<= right-paddle-y 1)
              (setq right-paddle-y 1)))
         ((eq key 'down)
          (setq right-paddle-y (1+ right-paddle-y))
          (if (>= right-paddle-y height)
              (setq right-paddle-y height)))))
      ;; move characters
      (setq pongx (+ pongx dpongx)
            pongy (+ pongy dpongy))
      ;; bounce off paddles
      (if (and (= pongx 2) (= pongy left-paddle-y))
          (setq dpongx 1))
      (if (and (= pongx (1- width)) (= pongy right-paddle-y))
          (setq dpongx -1))
      ;;bounce of top/bottom edges
      (if (or (< pongy 1) (> pongy height))
          (setq dpongy (- dpongy)))
      ;;stop at edges of screen
      (setq pongy (min pongy height)
            pongy (max pongy 1)))
    (if (< pongx 1)
        (insert "Game over. Right player won!"))
    (if (> pongx width)
        (insert "Game over. Left player win!"))))
pong1

清晰的多人乒乓代码

(defun draw-paddle (x y)
  (draw-char x y ?\#)
  (draw-char x (1- y) ?\#)
  (draw-char x (1+ y) ?\#))

(defun keep-in-range (num min-num max-num)
  (min (max num min-num) max-num))

(defun move-paddle (paddle-y dir)
  (keep-in-range (+ paddle-y dir) 2 (1- height)))

(defun distance (a b)
  (abs (- a b)))

(defun bounce-paddle (paddle-x paddle-y bounce-dir)
  (if (and (= x (+ paddle-x bounce-dir))
           (/= dx bounce-dir)
           (or (<= (distance y paddle-y) 1)
               (and (= (distance y paddle-y) 2)
                    (= (distance (+ y dy) paddle-y) 1))))
      (setq dx bounce-dir
            dy (- y paddle-y))))

(defun pong3a ()
  (buffer-disable-undo)
  (setq cursor-type nil)
  (while t
    (let ((x (/ width 2)) (y (/ height 2))
          (dx -1) (dy 0)
          (left-paddle-x 2)
          (left-paddle-y (/ height 2))
          (right-paddle-x (1- width))
          (right-paddle-y (/ height 2)))
      (while (and (>= x 1) (<= x width))
        ;; draw scene
        (make-grid)
        (draw-char x y ?\*)
        (draw-paddle left-paddle-x left-paddle-y)
        (draw-paddle right-paddle-x right-paddle-y)
        ;; handle input
        (let ((key (read-event nil nil 0.1)))
          (cond
           ((eq key 'left)
            (setq right-paddle-y (move-paddle right-paddle-y -1)))
           ((eq key 'right)
            (setq right-paddle-y (move-paddle right-paddle-y 1)))
           ((eq key 'up)
            (setq left-paddle-y (move-paddle left-paddle-y -1)))
           ((eq key 'down)
            (setq left-paddle-y (move-paddle left-paddle-y 1)))))
        ;; update ball
        (setq x (+ x dx)
              y (+ y dy))
        (if (or (<= y 1) (>= y height))
            (setq dy (- dy)))
        (if (= y 0) (setq y 2))
        (if (= y (1+ height)) (setq y (1- height)))
        ;; bounce off paddles
        (bounce-paddle left-paddle-x left-paddle-y 1)
        (bounce-paddle right-paddle-x right-paddle-y -1)))
    (sit-for 1)))

精心制作的多人乒乓游戏...

;; global variables 

(setq width 55)
(setq height 25)
(setq background-char ?\:)

;; helper routines (foundations)

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

(defun draw-char (x y char)
  (goto-char (+ x (* (1- y) (1+ width))))
  (delete-char 1)
  (insert-char char 1))

(defun draw-paddle (x y)
  (draw-char x y ?#)
  (draw-char x (1- y) ?#)
  (draw-char x (1+ y) ?#))

(defun distance (a b)
  (abs (- a b)))

(defun clamp (num min-num max-num)
  (min (max num min-num) max-num))

(defun move-paddle (paddle-y dir)
  (clamp (+ paddle-y dir) 2 (1- height)))

;;main programs

(defun pong3 ()
  (setq cursor-type nil)
  (let ((pongx (/ width 2)) (pongy (/ height 2))
        (dpongx -1) (dpongy 0)
        (left-paddle-y (/ height 2))
        (d-left-paddle 0)
        (right-paddle-y (/ height 2))
        (d-right-paddle 0))
    (while (and (>= pongx 1) (<= pongx width))
      ;; draw characters
      (make-grid)
      (draw-char pongx pongy ?O)
      (draw-paddle 1 left-paddle-y)
      (draw-paddle width right-paddle-y)
      ;; check input
      (let ((key (read-event nil nil 0.05)))
        (cond 
         ((eq key ?q) (setq d-left-paddle -1))
         ((eq key ?a) (setq d-left-paddle 0))
         ((eq key ?z) (setq d-left-paddle 1))
         ((eq key ?p) (setq d-right-paddle -1))
         ((eq key ?\;) (setq d-right-paddle 0))
         ((eq key ?/) (setq d-right-paddle 1))))
      ;; update pong & paddles
      (setq pongx (+ pongx dpongx)
            pongy (+ pongy dpongy))
      (setq left-paddle-y
            (move-paddle left-paddle-y d-left-paddle))
      (setq right-paddle-y
            (move-paddle right-paddle-y d-right-paddle))
      ;; bounce off paddles
      (if (and (= pongx 2)
               (<= (distance pongy left-paddle-y) 1))
          (setq dpongx 1
                dpongy (- pongy left-paddle-y)))
      (if (and (= pongx (1- width))
               (<= (distance pongy right-paddle-y) 1))
          (setq dpongx -1
                dpongy (- pongy right-paddle-y)))
      ;;bounce of top/bottom edges
      (if (or (< pongy 1) (> pongy height))
          (setq dpongy (- dpongy)))
      ;;stop at edges of screen
      (setq pongy (min pongy height)
            pongy (max pongy 1)))
    (if (< pongx 1)
        (insert "Game over. Right player won!"))
    (if (> pongx width)
        (insert "Game over. Left player win!"))))

与电脑对抗的乒乓游戏

;; global variables 

(setq width 55)
(setq height 25)
(setq background-char ?\:)

;; helper routines (foundations)

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

(defun draw-char (x y char)
  (goto-char (+ x (* (1- y) (1+ width))))
  (delete-char 1)
  (insert-char char 1))

(defun draw-score ()
  (goto-char (point-max))
  (newline)
  (newline)
  (insert (format "Your score: %d   Emacs score: %d"
                  score-player-1 score-player-2)))

(defun draw-paddle (x y)
  (draw-char x y ?#)
  (draw-char x (1- y) ?#)
  (draw-char x (- y 2) ?#)
  (draw-char x (1+ y) ?#)
  (draw-char x (+ y 2) ?#))

(defun distance (a b)
  (abs (- a b)))

(defun clamp (num min-num max-num)
  (min (max num min-num) max-num))

(defun move-paddle (paddle-y dir)
  (clamp (+ paddle-y dir) 3 (- height 2)))

;; actual game

(defun pong-game ()
  (let ((pongx (/ width 2)) (pongy (/ height 2))
        (dpongx -1) (dpongy 0)
        (left-paddle-y (/ height 2))
        (d-left-paddle 0)
        (right-paddle-y (/ height 2))
        (d-right-paddle 0))
    (while (and (>= pongx 1) (<= pongx width))
      ;; draw characters
      (make-grid)
      (draw-char pongx pongy ?O)
      (draw-paddle 1 (round left-paddle-y))
      (draw-paddle width (round right-paddle-y))
      (draw-score)
      ;; check input
      (let ((key (read-event nil nil 0.05)))
        (cond 
         ((eq key ?q) (setq d-left-paddle -0.7))
         ((eq key ?a) (setq d-left-paddle 0))
         ((eq key ?z) (setq d-left-paddle 0.7))))
      ;; computer opponent
      (cond
       ((> right-paddle-y pongy)
        (setq d-right-paddle -0.9))
       ((< right-paddle-y pongy)
        (setq d-right-paddle 0.9))
       (t
        (setq d-right-paddle 0)))
      ;; update pong & paddles
      (setq pongx (+ pongx dpongx)
            pongy (+ pongy dpongy))
      (setq left-paddle-y
            (move-paddle left-paddle-y d-left-paddle))
      (setq right-paddle-y
            (move-paddle right-paddle-y d-right-paddle))
      ;; bounce off paddles
      (if (and (= pongx 2)
               (<= (distance pongy (round left-paddle-y)) 2))
          (setq dpongx 1
                dpongy (- pongy (round left-paddle-y))))
      (if (and (= pongx (1- width))
               (<= (distance pongy (round right-paddle-y)) 2))
          (setq dpongx -1
                dpongy (- pongy (round right-paddle-y))))
      ;;bounce of top/bottom edges
      (if (or (< pongy 1) (> pongy height))
          (setq dpongy (- dpongy)))
      ;;stop at edges of screen
      (setq pongy (min pongy height)
            pongy (max pongy 1)))
    (if (< pongx 1) 2 1)))

;;main program

(defun pong5 ()
  (pop-to-buffer "pong-game")
  (setq cursor-type nil)
  (buffer-disable-undo)
  (let ((score-player-1 0)
        (score-player-2 0))
    (while t
      (let ((winner (pong-game)))
        (if (= winner 1)
            (setq score-player-1 (1+ score-player-1)))
        (if (= winner 2)
            (setq score-player-2 (1+ score-player-2))))
      (sit-for 1))))
pong5

绘制彩色条纹字符的工具

;; global variables

(setq bkgd-width 40
      bkgd-height 25
      bkgd-char ?\.
      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 (x y width color)
  (gotoxy x y)
  (let ((actual-width (min width
                           (1+ (- bkgd-width x)))))
    (delete-char actual-width)
    (insert (propertize (make-string actual-width stripe-char)
                        'face `(:background ,color)))))

;; main program

(defun stripe-drawing ()
  (dotimes (i 100)
    (make-grid)
    (dotimes (j 10)
      (draw-a-stripe j j j "green"))
    (sit-for 0.1)
    (dotimes (j 20)
      (draw-a-stripe (+ j 5) (+ j 3) j "orange"))
    (sit-for 0.1)))