Commits

Anonymous committed 51b3349

gamegrid v1.02

  • Participants
  • Parent commits 3f04a4e

Comments (0)

Files changed (5)

 
 # This XEmacs package contains independent single file lisp packages
 
-VERSION = 1.03
-AUTHOR_VERSION = 1.0
+VERSION = 1.04
+AUTHOR_VERSION = 1.02
 MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
 PACKAGE = xemacs-base
 PACKAGE = games
 ;; Copyright (C) 1997 Glynn Clements <glynn@sensei.co.uk>
 
 ;; Author: Glynn Clements <glynn@sensei.co.uk>
-;; Version: 1.0
+;; Version: 1.02
 ;; Created: 1997-08-13
 ;; Keywords: games
 
 
 ;;; Commentary:
 
+;; Modified: 1998-01-27, added gamegrid-event-x/y
+;; Modified: 1998-05-28, enclose body of gamegrid-add-score in save-excursion
+
 ;; URL: ftp://sensei.co.uk/misc/elisp-games.tar.gz
 ;; Tested with XEmacs 20.3/4/5 and Emacs 19.34
 
       (characterp arg)
     (integerp arg)))
 
+(defsubst gamegrid-event-x (event)
+  (if (fboundp 'event-x)
+      (event-x event)
+    (car (posn-col-row (event-end event)))))
+
+(defsubst gamegrid-event-y (event)
+  (if (fboundp 'event-y)
+      (event-y event)
+    (cdr (posn-col-row (event-end event)))))
+
 ;; ;;;;;;;;;;;;; display functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defun gamegrid-color (color shade)
     (eq (cdr-safe (assq 'display-type (frame-parameters))) 'color)))
 
 (defun gamegrid-display-type ()
+  (let ((window-system-p 
+	 (or (and (fboundp 'console-on-window-system-p)
+		  (console-on-window-system-p))
+	     window-system)))
   (cond ((and gamegrid-use-glyphs
-	      (eq window-system 'x)
+		window-system-p
 	      (featurep 'xpm))
 	 'glyph)
 	((and gamegrid-use-color
-	      (eq window-system 'x)
+		window-system-p
 	      (gamegrid-color-display-p))
 	 'color-x)
-	((eq window-system 'x)
+	  (window-system-p
 	 'mono-x)
 	((and gamegrid-use-color
 	      (gamegrid-color-display-p))
 	((fboundp 'set-face-property)
 	 'mono-tty)
 	(t
-	 'emacs-tty)))
+	   'emacs-tty))))
 
 (defun gamegrid-set-display-table ()
   (if (fboundp 'specifierp)
 				(< max-height height))
 			    (setq max-height height)))))))
 	   (if max-height
-	       (while (> (font-height font-spec) max-height)
-		 (setq name (x-find-smaller-font name))
+	       (while (and (> (font-height font-spec) max-height)
+			   (setq name (x-find-smaller-font name)))
 		 (add-spec-to-specifier font-spec name (current-buffer))))))))
 
 (defun gamegrid-initialize-display ()
 
 (defun gamegrid-add-score (file score)
   "Adds the current score to the high score file"
+  (save-excursion
   (find-file-other-window file)
   (setq buffer-read-only nil)
   (goto-char (point-max))
 			 user-mail-address)
 			(t ""))))
   (sort-numeric-fields 1 (point-min) (point-max))
-  (reverse-region (point-min)(point-max))
+    (reverse-region (point-min) (point-max))
   (goto-line (1+ gamegrid-score-file-length))
   (delete-region (point) (point-max))
   (setq buffer-read-only t)
-  (save-buffer))
+    (save-buffer)))
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; Copyright (C) 1997 Glynn Clements <glynn@sensei.co.uk>
 
 ;; Author: Glynn Clements <glynn@sensei.co.uk>
-;; Version: 1.0
+;; Version: 1.01
 ;; Created: 1997-09-10
 ;; Keywords: games
 
 
 ;;; Commentary:
 
+;; Modified: 1998-05-28
+;;	Added popup menu
+
 ;; URL: ftp://sensei.co.uk/misc/elisp-games.tar.gz
 ;; Tested with XEmacs 20.3/4/5 and Emacs 19.34
 
   (setq snake-paused (not snake-paused))
   (message (and snake-paused "Game paused (press p to resume)")))
 
+(defun snake-active-p ()
+  (eq (current-local-map) snake-mode-map))
+
 (put 'snake-mode 'mode-class 'special)
 
 (defun snake-mode ()
   (setq major-mode 'snake-mode)
   (setq mode-name "Snake")
 
+  (setq mode-popup-menu
+	'("Snake Commands"
+	  ["Start new game"	snake-start-game]
+	  ["End game"		snake-end-game
+	   (snake-active-p)]
+	  ["Pause"		snake-pause-game
+	   (and (snake-active-p) (not snake-paused))]
+	  ["Resume"		snake-pause-game
+	   (and (snake-active-p) snake-paused)]))
+
   (setq gamegrid-use-glyphs snake-use-glyphs)
   (setq gamegrid-use-color snake-use-color)
 
 ;; Copyright (C) 1997 Glynn Clements <glynn@sensei.co.uk>
 
 ;; Author: Glynn Clements <glynn@sensei.co.uk>
-;; Version: 1.0
+;; Version: 1.02
 ;; Created: 1997-09-11
 ;; Keywords: games
 
 
 ;;; Commentary:
 
+;; Modified: 1998-01-09, conditionalised use of locate-data-directory
+;; Modified: 1998-01-27, added mouse interface code
+;;   (provided by Sean MacLennan <bn932@freenet.carleton.ca>
+;; Modified: 1998-02-06, fixed bug, where sokoban-done wasn't reset to
+;;   zero in sokoban-restart-level
+;; Modified: 1998-02-27, patches from Hrvoje Niksic
+;;   added bounds check to sokoban-goto-level
+;;   added popup menu
+;;   display level and score in modeline
+
 ;; URL: ftp://sensei.co.uk/misc/elisp-games.tar.gz
 ;; Tested with XEmacs 20.3/4/5 and Emacs 19.34
 
 (defvar sokoban-temp-buffer-name " Sokoban-tmp")
 
 (defvar sokoban-level-file
-  (locate-data-file "sokoban.levels"))
+  (if (fboundp 'locate-data-file)
+      (locate-data-file "sokoban.levels")
+    (concat data-directory "sokoban.levels")))
 
 (defvar sokoban-width 20)
 (defvar sokoban-height 16)
 (defvar sokoban-moves 0)
 (defvar sokoban-pushes 0)
 (defvar sokoban-done 0)
+(defvar sokoban-mouse-x 0)
+(defvar sokoban-mouse-y 0)
 
 (make-variable-buffer-local 'sokoban-level)
 (make-variable-buffer-local 'sokoban-level-map)
 (make-variable-buffer-local 'sokoban-moves)
 (make-variable-buffer-local 'sokoban-pushes)
 (make-variable-buffer-local 'sokoban-done)
+(make-variable-buffer-local 'sokoban-mouse-x)
+(make-variable-buffer-local 'sokoban-mouse-y)
 
 ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define-key sokoban-mode-map [up]	'sokoban-move-up)
 (define-key sokoban-mode-map [down]	'sokoban-move-down)
 
+(define-key sokoban-mode-map [button2]	'sokoban-mouse-event-start)
+(define-key sokoban-mode-map [button2up] 'sokoban-mouse-event-end)
+
+(define-key sokoban-mode-map [down-mouse-2]	'sokoban-mouse-event-start)
+(define-key sokoban-mode-map [mouse-2] 'sokoban-mouse-event-end)
+
 (defvar sokoban-null-map
   (make-sparse-keymap 'sokoban-null-map))
 
 	    (loop for x from 0 to (1- len) do
 		  (gamegrid-set-cell (+ sokoban-score-x x)
 				     (+ sokoban-score-y y)
-				     (aref string x)))))))
+				     (aref string x))))))
+  (setq mode-line-format
+	(format "Sokoban:   Level: %3d   Moves: %05d   Pushes: %05d"
+		sokoban-level sokoban-moves sokoban-pushes))
+  (force-mode-line-update))
 
 (defun sokoban-move (dx dy)
   (let* ((x (+ sokoban-x dx))
 				  (sokoban-next-level)))))
 		    (sokoban-draw-score))))))))
 
+(defun sokoban-mouse-event-start (event)
+  (interactive "e")
+  (setq sokoban-mouse-x (gamegrid-event-x event))
+  (setq sokoban-mouse-y (gamegrid-event-y event)))
+
+(defun sokoban-mouse-event-end (event)
+  (interactive "e")
+  (let* ((x (gamegrid-event-x event))
+	 (y (gamegrid-event-y event))
+	 (dx (- x sokoban-x))
+	 (dy (- y sokoban-y)))
+    (cond
+     ;; Ensure that press and release are in the same square
+     ;; (which allows you to abort a move)
+     ((not (and (eq sokoban-mouse-x x) (eq sokoban-mouse-y y)))
+      nil)
+     ;; Check that the move isn't diagonal
+     ((not (or (eq dx 0) (eq dy 0)))
+      nil)
+     ((< dx 0)	;; Left
+      (while (< dx 0)
+	(sokoban-move -1 0)
+	(setq dx (1+ dx))))
+     ((> dx 0)	;; Right
+      (while (> dx 0)
+	(sokoban-move 1 0)
+	(setq dx (1- dx))))
+     ((> dy 0)	;; Up
+      (while (> dy 0)
+	(sokoban-move 0 1)
+	(setq dy (1- dy))))
+     ((< dy 0)	;; Down
+      (while (< dy 0)
+	(sokoban-move 0 -1)
+	(setq dy (1+ dy)))))))
+
 (defun sokoban-move-left ()
   "Move one square left"
   (interactive)
   "Restarts the current level"
   (interactive)
   (setq sokoban-moves 0
-	sokoban-pushes 0)
+	sokoban-pushes 0
+	sokoban-done 0)
   (sokoban-get-level-data)
   (sokoban-init-buffer)
   (sokoban-draw-score))
 (defun sokoban-goto-level (level)
   "Jumps to a specified level"
   (interactive "nLevel: ")
+  (while (or (<= level 0)
+	     (> level (length sokoban-level-data)))
+    (setq level
+	  (signal 'args-out-of-range
+		  (list "No such level number" level 1 88))))
   (setq sokoban-level level)
   (sokoban-restart-level))
 
   (setq major-mode 'sokoban-mode)
   (setq mode-name "Sokoban")
 
+  (setq mode-popup-menu
+	'("Sokoban Commands"
+	  ["Restart this level"		sokoban-restart-level]
+	  ["Start new game"		sokoban-start-game]
+	  ["Go to specific level"	sokoban-goto-level]))
+
   (setq gamegrid-use-glyphs sokoban-use-glyphs)
   (setq gamegrid-use-color sokoban-use-color)
   (setq gamegrid-font sokoban-font)
 ;; Copyright (C) 1997 Glynn Clements <glynn@sensei.co.uk>
 
 ;; Author: Glynn Clements <glynn@sensei.co.uk>
-;; Version: 2.0
+;; Version: 2.01
 ;; Created: 1997-08-13
 ;; Keywords: games
 
 ;; Modified: 1997-09-12
 ;;	fixed tetris-shift-down to deal with multiple rows correctly
 ;; Modified: 1998-01-05  (cgw) added pause, score, high score file
+;; Modified: 1998-05-28
+;;	Make new shapes appear at the centre of the top edge
+;;	Test whether the next shape can be placed before replacing it
+;;	Make tetris-shift-down clear the top row
+;;	Added popup menu
 
 ;; URL: ftp://sensei.co.uk/misc/elisp-games.tar.gz
 ;; Tested with XEmacs 20.3/4/5 and Emacs 19.34
   (setq tetris-shape tetris-next-shape)
   (setq tetris-rot 0)
   (setq tetris-next-shape (random 7))
-  (setq tetris-pos-x (random (- tetris-width (tetris-shape-width))))
+  (setq tetris-pos-x (/ (- tetris-width (tetris-shape-width)) 2))
   (setq tetris-pos-y 0)
+  (if (tetris-test-shape)
+      (tetris-end-game)
+    (tetris-draw-shape))
   (tetris-draw-next-shape)
   (tetris-update-score))
 
     full))
 
 (defun tetris-shift-row (y)
+  (if (= y 0)
+      (loop for x from 0 to (1- tetris-width) do
+	(gamegrid-set-cell (+ tetris-top-left-x x)
+			   (+ tetris-top-left-y y)
+			   tetris-blank))
   (loop for x from 0 to (1- tetris-width) do
 	(let ((c (gamegrid-get-cell (+ tetris-top-left-x x)
 				    (+ tetris-top-left-y y -1))))
 	  (gamegrid-set-cell (+ tetris-top-left-x x)
 			     (+ tetris-top-left-y y)
-			     c))))
+			   c)))))
 
 (defun tetris-shift-down ()
   (loop for y0 from 0 to (1- tetris-height) do
 	(if (tetris-full-row y0)
 	    (progn (setq tetris-n-rows (1+ tetris-n-rows))
-		   (loop for y from y0 downto 1 do
+		   (loop for y from y0 downto 0 do
 			 (tetris-shift-row y))))))
 
 (defun tetris-draw-border-p ()
 	tetris-n-rows	0
 	tetris-score	0
 	tetris-paused	nil)
-  (tetris-new-shape)
-  (tetris-draw-shape))
+  (tetris-new-shape))
 
 (defun tetris-shape-done ()
   (tetris-shift-down)
 	(+ tetris-score 
 	   (aref (aref tetris-shape-scores tetris-shape) tetris-rot)))
   (tetris-update-score)
-  (tetris-new-shape)
-  (if (tetris-test-shape)
-      (tetris-end-game)
-    (tetris-draw-shape)))
+  (tetris-new-shape))
 
 (defun tetris-update-game (tetris-buffer)
   "Called on each clock tick.
   (setq tetris-paused (not tetris-paused))
   (message (and tetris-paused "Game paused (press p to resume)")))
 
+(defun tetris-active-p ()
+  (eq (current-local-map) tetris-mode-map))
+
 (put 'tetris-mode 'mode-class 'special)
 
 (defun tetris-mode ()
   (setq major-mode 'tetris-mode)
   (setq mode-name "Tetris")
 
+  (setq mode-popup-menu
+	'("Tetris Commands"
+	  ["Start new game"	tetris-start-game]
+	  ["End game"		tetris-end-game
+	   (tetris-active-p)]
+	  ["Pause"		tetris-pause-game
+	   (and (tetris-active-p) (not tetris-paused))]
+	  ["Resume"		tetris-pause-game
+	   (and (tetris-active-p) tetris-paused)]))
+
   (setq gamegrid-use-glyphs tetris-use-glyphs)
   (setq gamegrid-use-color tetris-use-color)