1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6 (require 'chess-display)
8 (defgroup chess-ics1 nil
9 "The ICS1 style ASCII display."
10 :group 'chess-display)
12 (defface chess-ics1-black-face
13 '((((class color) (background light)) (:foreground "Green"))
14 (((class color) (background dark)) (:foreground "Green"))
16 "*The face used for black pieces on the ASCII display."
19 (defface chess-ics1-white-face
20 '((((class color) (background light)) (:foreground "Yellow"))
21 (((class color) (background dark)) (:foreground "Yellow"))
23 "*The face used for white pieces on the ASCII display."
26 (defface chess-ics1-highlight-face
27 '((((class color) (background light)) (:background "#add8e6"))
28 (((class color) (background dark)) (:background "#add8e6")))
29 "Face to use for highlighting pieces that have been selected."
32 (defcustom chess-ics1-popup-function 'chess-ics1-popup
33 "The function used to popup a chess-ics1 display."
37 (defcustom chess-ics1-separate-frame nil
38 "If non-nil, display the chessboard in its own frame."
44 (defun chess-ics1-handler (event &rest args)
46 ((eq event 'initialize) t)
49 (funcall chess-ics1-popup-function))
52 (apply 'chess-ics1-draw args))
54 ((eq event 'draw-square)
55 (apply 'chess-ics1-draw-square args))
57 ((eq event 'highlight)
58 (apply 'chess-ics1-highlight args))))
60 (defun chess-ics1-popup ()
61 (if chess-ics1-separate-frame
62 (chess-display-popup-in-frame 21 43 nil t)
63 (chess-display-popup-in-window)))
65 (defsubst chess-ics1-piece-text (piece)
66 (let ((p (char-to-string piece)))
67 (add-text-properties 0 1 (list 'face (if (> piece ?a)
68 'chess-ics1-black-face
69 'chess-ics1-white-face)) p)
72 (defsubst chess-ics1-draw-square (pos piece index)
73 "Draw a piece image at point on an already drawn display."
75 (let ((inhibit-redisplay t))
78 (insert ? (chess-ics1-piece-text piece) ? )
79 (add-text-properties pos (point) (list 'chess-coord index)))))
81 (defun chess-ics1-draw (position perspective)
82 "Draw the given POSITION from PERSPECTIVE's point of view.
83 PERSPECTIVE is t for white or nil for black."
84 (let ((inhibit-redisplay t)
87 (let* ((inverted (not perspective))
88 (rank (if inverted 7 0))
89 (file (if inverted 7 0)) beg)
90 (insert "\n +---+---+---+---+---+---+---+---+\n")
91 (while (if inverted (>= rank 0) (< rank 8))
92 (if (/= rank (if inverted 7 0))
93 (insert " +---+---+---+---+---+---+---+---+\n"))
94 (while (if inverted (>= file 0) (< file 8))
95 (let ((piece (chess-pos-piece position
96 (chess-rf-to-index rank file)))
98 (if (= file (if inverted 7 0))
99 (insert (format " %d " (1+ (- 7 rank)))))
101 (setq begin (1- (point)))
102 (insert (chess-ics1-piece-text piece) ? )
103 (add-text-properties begin (point)
105 (chess-rf-to-index rank file))))
106 (setq file (if inverted (1- file) (1+ file))))
108 (setq file (if inverted 7 0)
109 rank (if inverted (1- rank) (1+ rank))))
110 (insert " +---+---+---+---+---+---+---+---+\n")
112 (insert " h g f e d c b a\n\n")
113 (insert " a b c d e f g h\n\n")))
114 (set-buffer-modified-p nil)
117 (defun chess-ics1-highlight (index &optional mode)
118 (let ((pos (chess-display-index-pos nil index)))
119 (put-text-property pos (save-excursion
121 (skip-chars-forward "^|")
125 'chess-ics1-highlight-face)
127 (chess-display-get-face mode))))))
129 (defun chess-debug-position (&optional position)
130 "This is a debugging function, and not meant from general use."
132 (let ((pos (or position (chess-engine-position nil))))
133 (with-current-buffer (get-buffer-create "*scratch*")
134 (chess-ics1-draw pos t)
135 (funcall chess-ics1-popup-function))))
137 (provide 'chess-ics1)
139 ;;; chess-ics1.el ends here