1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;; Chessboard display style using graphical images
8 ;; In addition to what all displays offer, the images display adds a
11 ;; ^ increase the size of the display (if larger pieces exist)
12 ;; V decrease the size of the display (if smaller pieces exist)
13 ;; D use pieces from another directory
15 ;; When using pieces from another directory, they will be loaded and
16 ;; displayed immediately, allowing you to easily browse among
17 ;; different piece sets if you have them (such as the ZIICS set, see
18 ;; the xboard man page).
20 (require 'chess-display)
22 (defgroup chess-images nil
23 "Module for drawing a chess-display using graphical images."
24 :group 'chess-display)
26 (defvar chess-images-cache nil)
27 (defvar chess-images-size nil)
28 (defvar chess-images-sizes nil)
30 (make-variable-buffer-local 'chess-images-cache)
31 (make-variable-buffer-local 'chess-images-size)
32 (make-variable-buffer-local 'chess-images-sizes)
34 (defun chess-images-clear-image-cache (sym value)
36 (setq chess-images-cache nil))
38 (defcustom chess-images-separate-frame (display-multi-frame-p)
39 "If non-nil, display the chessboard in its own frame."
43 (defcustom chess-images-directory
44 (if (file-directory-p "/usr/share/games/xboard/pixmaps")
45 "/usr/share/games/xboard/pixmaps"
46 (expand-file-name "pieces/xboard"
48 (or load-file-name buffer-file-name))))
49 "Directory containing the chess piece bitmap images.
50 You are free to use your own chess pieces, of any size. By default, I
51 assume you have xboard installed, or can go get the pixmaps that come
52 with xboard. I am not an artist, and have not taken the time to draw
55 If you want to draw your own images, each piece must be named
56 COLOR-PIECE.EXT, where COLOR is either black or white, and PIECE is
57 one of rook, knight, bishop, queen, king or pawn.
59 At the moment only XPM has been tested, and I'm afraid it's probably
60 the only one that will work. ImageMagick can be used to convert other
61 graphics formats into XPM for you.
63 Each piece must define the background color to use the symbolic color
64 name \"background\", so that the chess program can use the same pieces
65 for all squares. If you want really custom pieces, you can use the
66 symbolic colors dark_square, light_square and dark_piece and
69 :set 'chess-images-clear-image-cache
72 (defcustom chess-images-default-size nil
73 "The default pixel width to use for chess pieces.
74 If this width is not available, then next smallest will be chosen.
75 If there is none smaller, then the best size available will be chosen.
76 If `chess-images-default-size' is nil (the default), then the best
77 width for the current display is calculated used."
78 :type '(choice integer (const :tag "Best fit" nil))
81 (defcustom chess-images-background-image "blank"
82 "The name of the file used for background squares.
83 This file is optional. If there is no file available by this name, a
84 solid color square will be created and used. This option exists so
85 that specialized squares may be used such as marble tiles, etc."
87 :set 'chess-images-clear-image-cache
90 (defcustom chess-images-border-color (cdr (assq 'background-color
92 "Color to use for the border around pieces."
94 :set 'chess-images-clear-image-cache
97 (defcustom chess-images-dark-color
98 (if (display-color-p) "#77a26d" "gray60")
99 "Color to use for \"dark\" background squares."
101 :set 'chess-images-clear-image-cache
102 :group 'chess-images)
104 (defcustom chess-images-light-color
105 (if (display-color-p) "#c8c365" "gray80")
106 "Color to use for \"light\" background squares."
108 :set 'chess-images-clear-image-cache
109 :group 'chess-images)
111 (defcustom chess-images-black-color
112 (if (display-color-p) "#202020" "gray0")
113 "Color to use for \"black\" pieces."
115 :set 'chess-images-clear-image-cache
116 :group 'chess-images)
118 (defcustom chess-images-white-color
119 (if (display-color-p) "#ffffcc" "gray100")
120 "Color to use for \"white\" pieces."
122 :set 'chess-images-clear-image-cache
123 :group 'chess-images)
125 (defcustom chess-images-highlight-color
126 (if (display-color-p) "#add8e6" "gray90")
127 "Color to use for highlighting pieces that have been selected."
129 :set 'chess-images-clear-image-cache
130 :group 'chess-images)
132 (defcustom chess-images-extension "xpm"
133 "The file extension used for chess display bitmaps."
135 :set 'chess-images-clear-image-cache
136 :group 'chess-images)
138 (defcustom chess-images-border-width 2
139 "This defines the width of the border that surrounds each piece."
140 :type '(choice integer (const :tag "No border" nil))
141 :set 'chess-images-clear-image-cache
142 :group 'chess-images)
144 (defcustom chess-images-popup-function 'chess-images-popup
145 "The function used to popup a chess-images display.
146 The current-buffer is set to the display buffer when this function is
149 :group 'chess-images)
153 (defconst chess-images-piece-names
160 "The names and index values of the different pieces.")
162 (chess-message-catalog 'english
163 '((no-images-fallback . "Could not find any suitable or properly sized chess images")))
165 (defun chess-images-handler (event &rest args)
167 ((eq event 'initialize)
168 (when (display-graphic-p)
169 (chess-images-initialize)
170 (or chess-images-size
172 (chess-message 'no-images-fallback)))))
175 (funcall chess-images-popup-function))
178 (apply 'chess-images-draw args))
180 ((eq event 'draw-square)
181 (apply 'chess-images-draw-square args))
183 ((eq event 'highlight)
184 (apply 'chess-images-highlight args))
186 ((eq event 'start-edit)
187 (setq cursor-type t))
189 ((eq event 'end-edit)
190 (setq cursor-type nil))))
192 (defun chess-images-determine-size ()
193 (let ((display (and (stringp chess-images-separate-frame)
194 chess-images-separate-frame)))
195 (setq cursor-type nil
196 chess-images-cache nil
197 chess-images-size (chess-images-best-size
199 (x-display-pixel-height display)
200 (display-pixel-height)) 20)
202 (x-display-pixel-width display)
203 (display-pixel-width)) 20)))))
205 (defun chess-images-initialize ()
206 (let ((map (current-local-map)))
207 (define-key map [?^] 'chess-images-increase-size)
208 (define-key map [?V] 'chess-images-decrease-size)
209 (define-key map [?P] 'chess-images-set-directory))
210 (chess-images-determine-size))
212 (chess-message-catalog 'english
213 '((no-images . "Cannot find any piece images; check `chess-images-directory'")))
215 (defun chess-images-popup ()
216 (unless chess-images-size
217 (chess-error 'no-images))
218 (if chess-images-separate-frame
219 (let* ((size (float (+ (* (or chess-images-border-width 0) 8)
220 (* chess-images-size 8))))
221 (max-char-height (ceiling (/ size (frame-char-height))))
222 (max-char-width (ceiling (/ size (frame-char-width))))
223 (display (and (stringp chess-images-separate-frame)
224 chess-images-separate-frame)))
225 ;; create the frame whenever necessary
226 (chess-display-popup-in-frame (+ max-char-height 2)
228 (chess-display-popup-in-window)))
230 (defun chess-images-piece-image (piece rank file)
231 "Return the image used for PIECE at RANK and FILE.
232 Rank and file are important because the colors of the squares on the
233 chess board are light or dark depending on location."
234 (let ((square-color (% (+ file rank) 2))) ; 0 is white
236 (aref chess-images-cache (- 3 square-color))
237 (aref (aref (aref chess-images-cache
238 (if (> piece ?a) 0 1))
239 (if (= square-color 0) 1 0))
240 (nth 2 (assq (downcase piece)
241 chess-images-piece-names))))))
243 (defsubst chess-images-draw-square (pos piece index)
244 "Draw a piece image at point on an already drawn display."
245 (put-text-property pos (1+ pos) 'display
246 (chess-images-piece-image piece (chess-index-rank index)
247 (chess-index-file index))))
249 (defun chess-images-draw (position perspective)
250 "Draw the current chess display position."
251 (let* ((inhibit-redisplay t)
252 (inverted (not perspective))
253 (rank (if inverted 7 0))
254 (file (if inverted 7 0))
255 (pos (point)) new beg)
256 (unless chess-images-cache
257 (chess-images-init-cache)
259 (unless (setq new (= (point-min) (point-max)))
260 (goto-char (point-min)))
261 (while (if inverted (>= rank 0) (< rank 8))
262 (while (if inverted (>= file 0) (< file 8))
263 (let* ((piece (chess-pos-piece position
264 (chess-rf-to-index rank file)))
265 (image (chess-images-piece-image piece rank file)))
268 (put-text-property (point) (1+ (point)) 'display image)
269 (unless (= (1+ (point)) (point-max))
273 (if (= file (if inverted 0 7))
274 (unless (= rank (if inverted 0 7))
276 (insert-image (aref chess-images-cache 5)))
278 beg (point) (list 'intangible (chess-rf-to-index rank file)
279 'rear-nonsticky '(intangible)
280 'chess-coord (chess-rf-to-index rank file)))))
281 (setq file (if inverted (1- file) (1+ file))))
282 (setq file (if inverted 7 0)
283 rank (if inverted (1- rank) (1+ rank))))
284 (set-buffer-modified-p nil)
287 (defun chess-images-highlight (index &optional mode)
288 "Highlight the piece on the board at INDEX, using the given MODE.
290 `selected' show that the piece has been selected for movement.
291 `unselected' show that the piece has been unselected."
292 (let* ((inverted (not (chess-display-perspective nil)))
293 (pos (chess-display-index-pos nil index))
294 (highlight (copy-alist (get-text-property pos 'display))))
295 (setcar (last highlight)
296 (list (cons "light_square" (if (eq mode :selected)
297 chess-images-highlight-color
299 (cons "dark_square" (if (eq mode :selected)
300 chess-images-highlight-color
302 (cons "background" (if (eq mode :selected)
303 chess-images-highlight-color
305 (put-text-property pos (1+ pos) 'display highlight)))
307 (chess-message-catalog 'english
308 '((redrawing-frame . "Redrawing chess display with different size...")
309 (redrawing-frame-done . "Redrawing chess display with different size...done")))
311 (defun chess-images-change-size (size)
312 (let* ((buffer (current-buffer))
313 (window (get-buffer-window buffer))
314 (frame (and window (window-frame window))))
315 (setq chess-images-size size
316 chess-images-cache nil )
318 (delete-frame frame t))
319 (chess-message 'redrawing-frame)
320 (chess-display-update buffer t)
321 (chess-message 'redrawing-frame-done)))
323 (defun chess-images-resize ()
324 "Resize the chessboard based on the frame or window's new size."
325 (chess-images-determine-size)
326 (if chess-images-size
327 (chess-images-change-size chess-images-size)
328 (chess-message 'no-images-fallback)))
330 (defun chess-images-alter-size (test)
331 (let ((sizes chess-images-sizes))
333 (setq sizes (reverse sizes)))
335 (if (funcall test (car sizes) chess-images-size)
337 (chess-images-change-size (car sizes))
339 (setq sizes (cdr sizes))))))
341 (defun chess-images-increase-size ()
342 "Increase the size of the pieces on the board."
344 (chess-images-alter-size '>))
346 (defun chess-images-decrease-size ()
347 "Increase the size of the pieces on the board."
349 (chess-images-alter-size '<))
351 (defun chess-images-sizes ()
352 "Return the set of available sizes for the current piece set.
353 They are returned in ascending order, or nil for no sizes available."
354 (let ((file (expand-file-name (format "black-rook.%s"
355 chess-images-extension)
356 chess-images-directory)))
357 (if (file-readable-p file)
359 (insert-file-contents-literally file)
360 (re-search-forward "\"\\([0-9]+\\)")
361 (setq chess-images-sizes (list (string-to-int (match-string 1)))))
363 (dolist (file (directory-files chess-images-directory nil
364 (format "rdd[0-9]+\\.%s"
365 chess-images-extension)))
366 (if (string-match "rdd\\([0-9]+\\)\\." file)
367 (push (string-to-int (match-string 1 file)) sizes)))
368 (setq chess-images-sizes (sort sizes '<))))))
370 (defun chess-images-best-size (&optional height width)
371 "Return the piece size that works best for a window of HEIGHT."
372 (let* ((size (or chess-images-default-size
373 (min (- (/ (or height (frame-pixel-height)) 8)
374 (or chess-images-border-width 0))
375 (- (/ (or width (frame-pixel-width)) 8)
376 (or chess-images-border-width 0)))))
377 (sizes (chess-images-sizes))
380 (if (> (car sizes) size)
382 (setq last (car sizes)
384 (or last (and chess-images-default-size
385 (let (chess-images-default-size)
386 (chess-images-best-size height width))))))
388 (defun chess-images-set-directory (directory)
389 "Increase the size of the pieces on the board."
390 (interactive "DUse chess pieces in: ")
391 (setq chess-images-directory directory
392 chess-images-sizes (chess-images-sizes)
393 chess-images-size (chess-images-best-size)
394 chess-images-cache nil)
395 (chess-images-alter-size '=))
397 (defun chess-images-create-xpm (height &optional width)
399 (insert "/* XPM */\n")
400 (insert "static char *chessdotel[] = {\n")
401 (insert "/* columns rows colors chars-per-pixel */\n")
402 (insert (format "\"%d %d 2 1\",\n" (or width height) height))
403 (insert "\" c red s void\",\n")
404 (insert "\". c red s background\",\n")
405 (insert "/* pixels */\n")
407 (insert ?\" (make-string (or width height) ?.) ?\" ?, ?\n))
408 (delete-backward-char 2)
412 (defun chess-images-hack-xpm (file add-height color)
413 "Hack an XPM to append ADD-HEIGHT rows of COLOR.
414 This is necessary for bizzare Emacs reasons."
416 (if (string-match "\\`/\\* XPM \\*/" file)
418 (insert-file-contents-literally file))
419 (goto-char (point-min))
420 (if (re-search-forward (concat "\"\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+"
421 "\\([0-9]+\\)\\s-+\\([0-9]+\\)\"") nil t)
422 (let* ((width (string-to-int (match-string 1)))
423 (height (string-to-int (match-string 2)))
424 (colors (string-to-int (match-string 3)))
425 (chars-per-color (string-to-int (match-string 4)))
426 (color-char (make-string chars-per-color ?~)))
427 (replace-match (int-to-string (+ height add-height)) t t nil 2)
431 (if (re-search-forward
432 (format "^\"\\(..\\)\\s-*c\\s-+%s" color) nil t)
434 (substring (match-string 1) 0 chars-per-color)))))
435 (replace-match (int-to-string (1+ colors)) t t nil 3)
437 (insert "\n\"" color-char "\tc " color "\","))
439 (forward-line (1+ colors))
440 (while (looking-at "/\\*")
442 (dotimes (i add-height)
449 (defsubst chess-images-create-image (file background &optional foreground)
450 "Create an Emacs image object, for insertion on the board."
451 (let ((syms (list (nth background
452 `(("dark_square" . ,chess-images-dark-color)
453 ("light_square" . ,chess-images-light-color)))
455 `(("background" . ,chess-images-dark-color)
456 ("background" . ,chess-images-light-color))))))
459 (list (nth foreground
460 `(("dark_piece" . ,chess-images-black-color)
461 ("light_piece" . ,chess-images-white-color))))))
462 (if chess-images-border-width
464 (chess-images-hack-xpm file chess-images-border-width
465 chess-images-border-color)
466 nil t :color-symbols syms)
467 (create-image file nil (string-match "\\`/\\* XPM \\*/" file)
468 :color-symbols syms))))
470 (chess-message-catalog 'english
471 '((piece-images-loading . "Loading chess piece images...")
472 (piece-images-loaded . "Loading chess piece images...done")))
474 (defun chess-images-init-cache ()
475 "Initialize the display image cache."
476 (chess-message 'piece-images-loading)
478 ;; Make a vector of two vectors of 6-item vectors: each piece of
479 ;; each color on each color square; and lastly two slots for the
481 (setq chess-images-cache
482 (vector (vector (make-vector 6 nil)
484 (vector (make-vector 6 nil)
488 (let* ((colors '("black" "white"))
489 (backgrounds (list chess-images-dark-color
490 chess-images-light-color))
491 (piece-colors (list chess-images-black-color
492 chess-images-white-color))
493 blank name image-data)
496 (dolist (piece chess-images-piece-names)
497 (let ((file (expand-file-name
498 (format "%s-%s.%s" (nth c colors) (nth 1 piece)
499 chess-images-extension)
500 chess-images-directory)))
501 (if (file-readable-p file)
502 (aset (aref (aref chess-images-cache c) b)
504 (chess-images-create-image file b c))
505 ;; try loading an xboard format file
506 (setq file (expand-file-name
507 (format "%c%c%c%d.%s" (car piece)
509 (if (= b 0) ?d ?l) chess-images-size
510 chess-images-extension)
511 chess-images-directory))
512 (aset (aref (aref chess-images-cache c) b)
514 (chess-images-create-image file b c)))))))
517 (setq blank (expand-file-name
518 (format "%s.%s" chess-images-background-image
519 chess-images-extension)
520 chess-images-directory)))
521 (aset chess-images-cache 2 (chess-images-create-image blank 0))
522 (aset chess-images-cache 3 (chess-images-create-image blank 1)))
523 ;; try loading an xboard format file
525 (setq name (format "dsq%d.%s" chess-images-size
526 chess-images-extension)
527 blank (expand-file-name name chess-images-directory)))
528 (aset chess-images-cache 2 (chess-images-create-image blank 0))
530 (setq blank (expand-file-name name chess-images-directory))
531 (aset chess-images-cache 3 (chess-images-create-image blank 1)))
532 ;; if all else fails, create one
536 ((string= chess-images-extension "xpm")
537 (chess-images-create-xpm chess-images-size))))
538 (aset chess-images-cache 2 (chess-images-create-image image-data 0))
539 (aset chess-images-cache 3 (chess-images-create-image image-data 1))))
541 (when chess-images-border-width
542 (aset chess-images-cache 4
544 (chess-images-create-xpm
545 chess-images-border-width
546 (+ (* 8 chess-images-size)
547 (* 9 chess-images-border-width)))
549 (list (cons "background" chess-images-border-color))))
550 (aset chess-images-cache 5
552 (chess-images-create-xpm chess-images-size
553 chess-images-border-width)
555 (list (cons "background" chess-images-border-color))))))
557 ;; let the garbage collector know we're through here
559 (chess-message 'piece-images-loaded))
561 (provide 'chess-images)
563 ;;; chess-images.el ends here