Part 8: pong, etc.

Continued from Emacs Lisp programming pt. 7.

Multi-player moving-character game

Based on on Travis’ code.

;; 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!"))))

Basic pong

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!"))))

Pretty clean multiplayer pong code

(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)))

Multiplayer pong, elaborate…

;; 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!"))))

Pong against the computer

;; 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))))

Tools for drawing colored stripes

;; 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)))

Continued in Emacs Lisp programming pt. 9.