/[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.12 by rms, Tue Sep 10 16:47:16 2002 UTC revision 1.13 by rms, Mon Sep 23 16:03:03 2002 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 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 ()
283    (let ((window-system-p    (cond ((and gamegrid-use-glyphs
284           (or (and (fboundp 'console-on-window-system-p)                (display-images-p))
285                    (console-on-window-system-p))           'glyph)
286               window-system)))          ((and gamegrid-use-color
287      (cond ((and gamegrid-use-glyphs                (display-graphic-p)
288                  window-system-p                (display-color-p))
289                  (featurep 'xpm))           'color-x)
290             'glyph)          ((display-graphic-p)
291            ((and gamegrid-use-color           'mono-x)
292                  window-system-p          ((and gamegrid-use-color
293                  (gamegrid-color-display-p))                (display-color-p))
294             'color-x)           'color-tty)
295            (window-system-p          ((display-multi-font-p) ;???
296             'mono-x)           'mono-tty)
297            ((and gamegrid-use-color          (t
298                  (gamegrid-color-display-p))             'emacs-tty)))
            'color-tty)  
           ((fboundp 'set-face-property)  
            'mono-tty)  
           (t  
            'emacs-tty))))  
299    
300  (defun gamegrid-set-display-table ()  (defun gamegrid-set-display-table ()
301    (if (fboundp 'specifierp)    (if (fboundp 'specifierp)
# Line 290  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 ()  
   (make-local-variable 'cursor-type)  
   (setq cursor-type nil))  
   
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 323  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 362  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)

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

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