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