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