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

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

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

revision 1.11 by walters, Fri May 3 19:30:58 2002 UTC revision 1.11.2.1 by miles, Fri Apr 4 06:20:31 2003 UTC
# Line 42  Line 42 
42  (defvar gamegrid-font "-*-courier-medium-r-*-*-*-140-100-75-*-*-iso8859-*"  (defvar gamegrid-font "-*-courier-medium-r-*-*-*-140-100-75-*-*-iso8859-*"
43    "Name of the font used in X mode.")    "Name of the font used in X mode.")
44    
45    (defvar gamegrid-face nil
46      "Indicates the face to use as a default.")
47    (make-variable-buffer-local 'gamegrid-face)
48    
49  (defvar gamegrid-display-options nil)  (defvar gamegrid-display-options nil)
50    
51  (defvar gamegrid-buffer-width 0)  (defvar gamegrid-buffer-width 0)
# Line 120  static char *noname[] = { Line 124  static char *noname[] = {
124  "  "
125    "XPM format image used for each square")    "XPM format image used for each square")
126    
127    (defvar gamegrid-xbm "\
128    /* gamegrid XBM */
129    #define gamegrid_width 16
130    #define gamegrid_height 16
131    static unsigned char gamegrid_bits[] = {
132       0xff, 0xff, 0xff, 0x7f, 0xff, 0x3f, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a,
133       0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a,
134       0x57, 0x15, 0x07, 0x00, 0x03, 0x00, 0x01, 0x00 };"
135      "XBM format image used for each square.")
136    
137  ;; ;;;;;;;;;;;;;;;; miscellaneous functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;; ;;;;;;;;;;;;;;;; miscellaneous functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
138    
139  (defsubst gamegrid-characterp (arg)  (defsubst gamegrid-characterp (arg)
# Line 171  static char *noname[] = { Line 185  static char *noname[] = {
185      face))      face))
186    
187  (defun gamegrid-make-color-tty-face (color)  (defun gamegrid-make-color-tty-face (color)
188    (let* ((color-str (symbol-value color))    (let* ((color-str (if (symbolp color) (symbol-value color) color))
189           (name (intern (format "gamegrid-color-tty-face-%s" color-str)))           (name (intern (format "gamegrid-color-tty-face-%s" color-str)))
190           (face (make-face name)))           (face (make-face name)))
191      (gamegrid-setup-face face color-str)      (gamegrid-setup-face face color-str)
# Line 220  static char *noname[] = { Line 234  static char *noname[] = {
234         gamegrid-mono-tty-face))))         gamegrid-mono-tty-face))))
235    
236  (defun gamegrid-colorize-glyph (color)  (defun gamegrid-colorize-glyph (color)
237    (make-glyph    (find-image `((:type xpm :data ,gamegrid-xpm
238     (vector                         :ascent center
239      'xpm                         :color-symbols
240      :data gamegrid-xpm                         (("col1" . ,(gamegrid-color color 0.6))
241      :color-symbols (list (cons "col1" (gamegrid-color color 0.6))                          ("col2" . ,(gamegrid-color color 0.8))
242                           (cons "col2" (gamegrid-color color 0.8))                          ("col3" . ,(gamegrid-color color 1.0))))
243                           (cons "col3" (gamegrid-color color 1.0))))))                  (:type xbm :data ,gamegrid-xbm
244                           :ascent center
245                           :foreground ,(gamegrid-color color 1.0)
246                           :background ,(gamegrid-color color 0.5)))))
247    
248  (defun gamegrid-match-spec (spec)  (defun gamegrid-match-spec (spec)
249    (let ((locale (car spec))    (let ((locale (car spec))
# Line 250  static char *noname[] = { Line 267  static char *noname[] = {
267             (vector data))             (vector data))
268            ((eq data 'colorize)            ((eq data 'colorize)
269             (gamegrid-colorize-glyph color))             (gamegrid-colorize-glyph color))
270              ((listp data)
271               (find-image data)) ;untested!
272            ((vectorp data)            ((vectorp data)
273             (make-glyph data)))))             (gamegrid-make-image-from-vector data)))))
274    
275  (defun gamegrid-color-display-p ()  (defun gamegrid-make-image-from-vector (vect)
276    (if (fboundp 'device-class)    "Convert an XEmacs style \"glyph\" to an image-spec."
277        (eq (device-class (selected-device)) 'color)    (let ((l (list 'image :type)))
278      (eq (cdr-safe (assq 'display-type (frame-parameters))) 'color)))      (dotimes (n (length vect))
279          (setf l (nconc l (list (aref vect n)))))
280        (nconc l (list :ascent 'center))))
281    
282  (defun gamegrid-display-type ()  (defun gamegrid-display-type ()
   (let ((window-system-p  
          (or (and (fboundp 'console-on-window-system-p)  
                   (console-on-window-system-p))  
              (and (fboundp 'display-color-p)  
                   (display-color-p))  
              window-system)))  
283    (cond ((and gamegrid-use-glyphs    (cond ((and gamegrid-use-glyphs
284                  window-system-p                (display-images-p))
               (featurep 'xpm))  
285           'glyph)           'glyph)
286          ((and gamegrid-use-color          ((and gamegrid-use-color
287                  window-system-p                (display-graphic-p)
288                (gamegrid-color-display-p))                (display-color-p))
289           'color-x)           'color-x)
290            (window-system-p          ((display-graphic-p)
291           'mono-x)           'mono-x)
292          ((and gamegrid-use-color          ((and gamegrid-use-color
293                (gamegrid-color-display-p))                (display-color-p))
294           'color-tty)           'color-tty)
295          ((fboundp 'set-face-property)          ((display-multi-font-p) ;???
296           'mono-tty)           'mono-tty)
297          (t          (t
298             'emacs-tty))))             'emacs-tty)))
299    
300  (defun gamegrid-set-display-table ()  (defun gamegrid-set-display-table ()
301    (if (fboundp 'specifierp)    (if (fboundp 'specifierp)
# Line 292  static char *noname[] = { Line 306  static char *noname[] = {
306                               'remove-locale)                               'remove-locale)
307      (setq buffer-display-table gamegrid-display-table)))      (setq buffer-display-table gamegrid-display-table)))
308    
 (defun gamegrid-hide-cursor ()  
   (if (fboundp 'specifierp)  
       (set-specifier text-cursor-visible-p nil (current-buffer))))  
   
309  (defun gamegrid-setup-default-font ()  (defun gamegrid-setup-default-font ()
310    (cond ((eq gamegrid-display-mode 'glyph)    (setq gamegrid-face
311           (let* ((font-spec (face-property 'default 'font))          (copy-face 'default
312                  (name (font-name font-spec))                     (intern (concat "gamegrid-face-" (buffer-name)))))
313                  (max-height nil))    (when (eq gamegrid-display-mode 'glyph)
314             (loop for c from 0 to 255 do      (let ((max-height nil))
315               (let ((glyph (aref gamegrid-display-table c)))        (loop for c from 0 to 255 do
316                 (cond ((glyphp glyph)              (let ((glyph (aref gamegrid-display-table c)))
317                        (let ((height (glyph-height glyph)))                (when (and (listp glyph) (eq (car  glyph) 'image))
318                          (if (or (null max-height)                  (let ((height (cdr (image-size glyph))))
319                                  (< max-height height))                    (if (or (null max-height)
320                              (setq max-height height)))))))                            (< max-height height))
321             (if max-height                        (setq max-height height))))))
322                 (while (and (> (font-height font-spec) max-height)        (when (and max-height (< max-height 1))
323                             (setq name (x-find-smaller-font name)))          (set-face-attribute gamegrid-face nil :height max-height)))))
                  (add-spec-to-specifier font-spec name (current-buffer))))))))  
324    
325  (defun gamegrid-initialize-display ()  (defun gamegrid-initialize-display ()
326    (setq gamegrid-display-mode (gamegrid-display-type))    (setq gamegrid-display-mode (gamegrid-display-type))
# Line 325  static char *noname[] = { Line 334  static char *noname[] = {
334        (aset gamegrid-display-table c glyph)))        (aset gamegrid-display-table c glyph)))
335    (gamegrid-setup-default-font)    (gamegrid-setup-default-font)
336    (gamegrid-set-display-table)    (gamegrid-set-display-table)
337    (gamegrid-hide-cursor))    (setq cursor-type nil))
338    
339    
340  (defun gamegrid-set-face (c)  (defun gamegrid-set-face (c)
341    (unless (eq gamegrid-display-mode 'glyph)    (if (eq gamegrid-display-mode 'glyph)
342          (add-text-properties (1- (point)) (point)
343                               (list 'display (list (aref gamegrid-display-table c))))
344      (put-text-property (1- (point))      (put-text-property (1- (point))
345                         (point)                         (point)
346                         'face                         'face
# Line 364  static char *noname[] = { Line 375  static char *noname[] = {
375      (setq gamegrid-buffer-start (point))      (setq gamegrid-buffer-start (point))
376      (dotimes (i height)      (dotimes (i height)
377        (insert line))        (insert line))
378        ;; Adjust the height of the default face to the height of the
379        ;; images. Unlike XEmacs, Emacs doesn't allow to make the default
380        ;; face buffer-local; so we do this with an overlay.
381        (when (eq gamegrid-display-mode 'glyph)
382          (overlay-put (make-overlay (point-min) (point-max))
383                       'face gamegrid-face))
384      (goto-char (point-min))))      (goto-char (point-min))))
385    
386  (defun gamegrid-init (options)  (defun gamegrid-init (options)
# Line 410  static char *noname[] = { Line 427  static char *noname[] = {
427  ;; ;;;;;;;;;;;;;;; high score functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;; ;;;;;;;;;;;;;;; high score functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
428    
429  (defun gamegrid-add-score (file score)  (defun gamegrid-add-score (file score)
430    "Add the current score to the high score file."    "Add the current score to the high score file.
431    
432    On POSIX systems there may be a shared game directory for all users in
433    which the scorefiles are kept. On such systems Emacs doesn't create
434    the score file FILE in this directory, if it doesn't already exist. In
435    this case Emacs searches for FILE in the directory specified by
436    `gamegrid-user-score-file-directory' and creates it there, if
437    necessary.
438    
439    To add the score file for a game to the system wide shared game
440    directory, create the file with the shell command \"touch\" in this
441    directory and make sure that it is owned by the correct user and
442    group. You probably need special user privileges to do this.
443    
444    On non-POSIX systems Emacs searches for FILE in the directory
445    specified by the variable `temporary-file-directory'. If necessary,
446    FILE is created there."
447    (case system-type    (case system-type
448      ((ms-dos windows-nt)      ((ms-dos windows-nt)
449       (gamegrid-add-score-insecure file score))       (gamegrid-add-score-insecure file score))
# Line 418  static char *noname[] = { Line 451  static char *noname[] = {
451       (gamegrid-add-score-with-update-game-score file score))))       (gamegrid-add-score-with-update-game-score file score))))
452    
453  (defun gamegrid-add-score-with-update-game-score (file score)  (defun gamegrid-add-score-with-update-game-score (file score)
454    (let* ((result nil)    (let* ((result nil) ;; What is this good for? -- os
          (errbuf (generate-new-buffer " *update-game-score loss*"))  
455           (have-shared-game-dir           (have-shared-game-dir
456            (not (zerop (logand (file-modes            (not (zerop (logand (file-modes
457                                 (expand-file-name "update-game-score"                                 (expand-file-name "update-game-score"
458                                                   exec-directory))                                                   exec-directory))
459                                #o4000))))                                #o4000)))))
460           (target (if have-shared-game-dir      (if (and have-shared-game-dir
461                       (expand-file-name file shared-game-score-directory)               (file-exists-p (expand-file-name file shared-game-score-directory)))
462                     (let ((f (expand-file-name          ;; Use the setuid update-gamescore program to update a
463                               gamegrid-user-score-file-directory)))          ;; system-wide score file.
464                       (when (file-writable-p f)          (gamegrid-add-score-with-update-game-score-1
465                         (unless (eq (car-safe (file-attributes f))           (expand-file-name file shared-game-score-directory) score)
466                                     t)        ;; Else: Add the score to a score file in the user's home
467                           (make-directory f))        ;; directory. If `have-shared-game-dir' is non-nil, the
468                         (setq f (expand-file-name file f))        ;; "update-gamescore" program is setuid, so don't use it.
469                         (unless (file-exists-p f)        (if have-shared-game-dir
470                           (write-region "" nil f nil 'silent nil 'excl)))            (gamegrid-add-score-insecure file score
471                       f))))                                         gamegrid-user-score-file-directory)
472      (let ((default-directory "/"))          (let ((f (expand-file-name
473        (apply                    gamegrid-user-score-file-directory)))
474         'call-process            (when (file-writable-p f)
475         (append              (unless (eq (car-safe (file-attributes f))
476          (list                          t)
477           (expand-file-name "update-game-score" exec-directory)                (make-directory f))
478           nil errbuf nil              (setq f (expand-file-name file f))
479           "-m" (int-to-string gamegrid-score-file-length)              (unless (file-exists-p f)
480           "-d" (if have-shared-game-dir                (write-region "" nil f nil 'silent nil 'excl)))
481                    (expand-file-name shared-game-score-directory)            (gamegrid-add-score-with-update-game-score-1 f score))))))
482                  (file-name-directory target))  
483           file  (defun gamegrid-add-score-with-update-game-score-1 (target score)
484           (int-to-string score)    (let ((default-directory "/")
485           (concat          (errbuf (generate-new-buffer " *update-game-score loss*")))
486            (user-full-name)      (apply
487            " <"       'call-process
488            (cond ((fboundp 'user-mail-address)       (append
489                   (user-mail-address))        (list
490                  ((boundp 'user-mail-address)         (expand-file-name "update-game-score" exec-directory)
491                   user-mail-address)         nil errbuf nil
492                  (t ""))         "-m" (int-to-string gamegrid-score-file-length)
493            ">  "         "-d" (if have-shared-game-dir
494            (current-time-string))))))                  (expand-file-name shared-game-score-directory)
495                  (file-name-directory target))
496           file
497           (int-to-string score)
498           (concat
499            (user-full-name)
500            " <"
501            (cond ((fboundp 'user-mail-address)
502                   (user-mail-address))
503                  ((boundp 'user-mail-address)
504                   user-mail-address)
505                  (t ""))
506            ">  "
507            (current-time-string)))))
508      (if (buffer-modified-p errbuf)      (if (buffer-modified-p errbuf)
509          (progn          (progn
510            (display-buffer errbuf)            (display-buffer errbuf)
# Line 474  static char *noname[] = { Line 519  static char *noname[] = {
519                (display-buffer buf))                (display-buffer buf))
520            (find-file-read-only-other-window target))))))            (find-file-read-only-other-window target))))))
521    
522  (defun gamegrid-add-score-insecure (file score)  (defun gamegrid-add-score-insecure (file score &optional directory)
523    (save-excursion    (save-excursion
524      (setq file (expand-file-name file temporary-file-directory))      (setq file (expand-file-name file (or directory
525                                              temporary-file-directory)))
526      (find-file-other-window file)      (find-file-other-window file)
527      (setq buffer-read-only nil)      (setq buffer-read-only nil)
528      (goto-char (point-max))      (goto-char (point-max))

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.11.2.1

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