/[emacs]/emacs/lisp/play/pong.el
ViewVC logotype

Diff of /emacs/lisp/play/pong.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10 by eliz, Wed Feb 6 12:06:04 2002 UTC revision 1.10.4.1 by miles, Fri Apr 4 06:20:31 2003 UTC
# Line 34  Line 34 
34    
35  ;;; Customization  ;;; Customization
36    
37  (defgroup pong nil  (defgroup pong nil
38    "Emacs-Lisp implementation of the classical game pong."    "Emacs-Lisp implementation of the classical game pong."
39    :tag "Pong"    :tag "Pong"
40    :group 'games)    :group 'games)
41    
42  (defcustom pong-buffer-name "*Pong*"  (defcustom pong-buffer-name "*Pong*"
43    "*Name of the buffer used to play."    "*Name of the buffer used to play."
44    :group 'pong    :group 'pong
45    :type '(string))    :type '(string))
# Line 75  Line 75 
75    :type 'color)    :type 'color)
76    
77  (defcustom pong-border-color "white"  (defcustom pong-border-color "white"
78    "*Color used for pong balls."    "*Color used for pong borders."
79    :group 'pong    :group 'pong
80    :type 'color)    :type 'color)
81    
# Line 155  Line 155 
155    '(((glyph colorize)    '(((glyph colorize)
156       (t ?\+))       (t ?\+))
157      ((color-x color-x)      ((color-x color-x)
158       (mono-x grid-x))       (mono-x grid-x)
159      ;; The colors used to be [0.5 0.5 0.5], but that produces a black       (color-tty color-tty))
160      ;; color on 8-color tty's, which would make the border invisible.      (((glyph color-x) [0.5 0.5 0.5])
     ;; 0.51 produces white on such tty's, and at the same time has  
     ;; almost no effect on X and similar displays.  
     (((glyph color-x) [0.51 0.51 0.51])  
161       (color-tty pong-border-color))))       (color-tty pong-border-color))))
162    
163  (defconst pong-blank    0)  (defconst pong-blank    0)
# Line 316  implementations you move with left/right Line 313  implementations you move with left/right
313          (gamegrid-set-cell x (1- y) pong-blank))          (gamegrid-set-cell x (1- y) pong-blank))
314      (if (< (+ y pong-bat-width) (1- pong-height))      (if (< (+ y pong-bat-width) (1- pong-height))
315          (gamegrid-set-cell x (+ y pong-bat-width) pong-blank)))))          (gamegrid-set-cell x (+ y pong-bat-width) pong-blank)))))
316      
317    
318    
319  (defun pong-init ()  (defun pong-init ()
320    "Initialize a game."    "Initialize a game."
321      
322    (define-key pong-mode-map pong-pause-key 'pong-pause)    (define-key pong-mode-map pong-pause-key 'pong-pause)
323    
324    (add-hook 'kill-buffer-hook 'pong-quit nil t)    (add-hook 'kill-buffer-hook 'pong-quit nil t)
# Line 348  updates ball and bats positions.  It is Line 345  updates ball and bats positions.  It is
345  detection and checks if a player scores."  detection and checks if a player scores."
346    (if (not (eq (current-buffer) pong-buffer))    (if (not (eq (current-buffer) pong-buffer))
347        (pong-pause)        (pong-pause)
348            
349      (let ((old-x pong-x)      (let ((old-x pong-x)
350            (old-y pong-y))            (old-y pong-y))
351          
352        (setq pong-x (+ pong-x pong-xx))        (setq pong-x (+ pong-x pong-xx))
353        (setq pong-y (+ pong-y pong-yy))        (setq pong-y (+ pong-y pong-yy))
354          
355        (if (and (> old-y 0)        (if (and (> old-y 0)
356                 (< old-y (- pong-height 1)))                 (< old-y (- pong-height 1)))
357            (gamegrid-set-cell old-x old-y pong-blank))            (gamegrid-set-cell old-x old-y pong-blank))
358          
359        (if (and (> pong-y 0)        (if (and (> pong-y 0)
360                 (< pong-y (- pong-height 1)))                 (< pong-y (- pong-height 1)))
361            (gamegrid-set-cell pong-x pong-y pong-ball))            (gamegrid-set-cell pong-x pong-y pong-ball))
362          
363        (cond        (cond
364         ((or (= pong-x 3) (= pong-x 2))         ((or (= pong-x 3) (= pong-x 2))
365          (if (and (>= pong-y pong-bat-player1)          (if (and (>= pong-y pong-bat-player1)
366                   (< pong-y (+ pong-bat-player1 pong-bat-width)))                   (< pong-y (+ pong-bat-player1 pong-bat-width)))
367              (and              (and
368               (setq pong-yy (+ pong-yy               (setq pong-yy (+ pong-yy
369                                (cond                                (cond
370                                 ((= pong-y pong-bat-player1) -1)                                 ((= pong-y pong-bat-player1) -1)
371                                 ((= pong-y (1+ pong-bat-player1)) 0)                                 ((= pong-y (1+ pong-bat-player1)) 0)
372                                 (t 1))))                                 (t 1))))
373               (setq pong-xx (- pong-xx)))))               (setq pong-xx (- pong-xx)))))
374    
375         ((or (= pong-x (- pong-width 4)) (= pong-x (- pong-width 3)))         ((or (= pong-x (- pong-width 4)) (= pong-x (- pong-width 3)))
376          (if (and (>= pong-y pong-bat-player2)          (if (and (>= pong-y pong-bat-player2)
377                   (< pong-y (+ pong-bat-player2 pong-bat-width)))                   (< pong-y (+ pong-bat-player2 pong-bat-width)))
378              (and              (and
379               (setq pong-yy (+ pong-yy               (setq pong-yy (+ pong-yy
380                                (cond                                (cond
381                                 ((= pong-y pong-bat-player2) -1)                                 ((= pong-y pong-bat-player2) -1)
382                                 ((= pong-y (1+ pong-bat-player2)) 0)                                 ((= pong-y (1+ pong-bat-player2)) 0)
383                                 (t 1))))                                 (t 1))))
384               (setq pong-xx (- pong-xx)))))               (setq pong-xx (- pong-xx)))))
385      
386         ((<= pong-y 1)         ((<= pong-y 1)
387          (setq pong-yy (- pong-yy)))          (setq pong-yy (- pong-yy)))
388    

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.10.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26