blob: 4d0d35c5f8ae7fdc57dd0acc3e8b0cb184db69ff (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; ICS1 style display
;;
(require 'chess-display)
(defgroup chess-ics1 nil
"The ICS1 style ASCII display."
:group 'chess-display)
(defface chess-ics1-black-face
'((((class color) (background light)) (:foreground "Green"))
(((class color) (background dark)) (:foreground "Green"))
(t (:bold t)))
"*The face used for black pieces on the ASCII display."
:group 'chess-ics1)
(defface chess-ics1-white-face
'((((class color) (background light)) (:foreground "Yellow"))
(((class color) (background dark)) (:foreground "Yellow"))
(t (:bold t)))
"*The face used for white pieces on the ASCII display."
:group 'chess-ics1)
(defface chess-ics1-highlight-face
'((((class color) (background light)) (:background "#add8e6"))
(((class color) (background dark)) (:background "#add8e6")))
"Face to use for highlighting pieces that have been selected."
:group 'chess-ics1)
(defcustom chess-ics1-popup-function 'chess-display-popup-in-window
"The function used to popup a chess-ics1 display."
:type 'function
:group 'chess-ics1)
;;; Code:
(defun chess-ics1-handler (event &rest args)
(cond
((eq event 'initialize) t)
((eq event 'popup)
(if chess-display-popup
(funcall chess-ics1-popup-function)))
((eq event 'draw)
(apply 'chess-ics1-draw args))
((eq event 'draw-square)
(apply 'chess-ics1-draw-square args))
((eq event 'highlight)
(apply 'chess-ics1-highlight args))))
(defsubst chess-ics1-piece-text (piece)
(let ((p (char-to-string piece)))
(add-text-properties 0 1 (list 'face (if (> piece ?a)
'chess-ics1-black-face
'chess-ics1-white-face)) p)
p))
(defsubst chess-ics1-draw-square (pos piece index)
"Draw a piece image at point on an already drawn display."
(save-excursion
(let ((inhibit-redisplay t))
(goto-char pos)
(delete-char 3)
(insert ? (chess-ics1-piece-text piece) ? ))))
(defun chess-ics1-draw (position perspective)
"Draw the given POSITION from PERSPECTIVE's point of view.
PERSPECTIVE is t for white or nil for black."
(let ((inhibit-redisplay t)
(pos (point)))
(erase-buffer)
(let* ((inverted (not perspective))
(rank (if inverted 7 0))
(file (if inverted 7 0)) beg)
(insert "\n +---+---+---+---+---+---+---+---+\n")
(while (if inverted (>= rank 0) (< rank 8))
(if (/= rank (if inverted 7 0))
(insert " +---+---+---+---+---+---+---+---+\n"))
(while (if inverted (>= file 0) (< file 8))
(let ((piece (chess-pos-piece position
(chess-rf-to-index rank file)))
begin)
(if (= file (if inverted 7 0))
(insert (format " %d " (1+ (- 7 rank)))))
(insert "| ")
(setq begin (1- (point)))
(insert (chess-ics1-piece-text piece) ? )
(add-text-properties begin (point)
(list 'chess-coord
(chess-rf-to-index rank file))))
(setq file (if inverted (1- file) (1+ file))))
(insert "|\n")
(setq file (if inverted 7 0)
rank (if inverted (1- rank) (1+ rank))))
(insert " +---+---+---+---+---+---+---+---+\n")
(if inverted
(insert " h g f e d c b a\n\n")
(insert " a b c d e f g h\n\n")))
(set-buffer-modified-p nil)
(goto-char pos)))
(defun chess-ics1-highlight (index &optional mode)
(let ((pos (chess-display-index-pos nil index)))
(put-text-property pos (save-excursion
(goto-char pos)
(skip-chars-forward "^|")
(point))
'face (cond
((eq mode :selected)
'chess-ics1-highlight-face)
(t
(chess-display-get-face mode))))))
(defun chess-debug-position (&optional position)
"This is a debugging function, and not meant from general use."
(interactive)
(let ((pos (or position (chess-engine-position nil))))
(with-current-buffer (get-buffer-create "*scratch*")
(chess-ics1-draw pos t)
(funcall chess-ics1-popup-function))))
(provide 'chess-ics1)
;;; chess-ics1.el ends here
|
