Skip to content
This repository
tree: 521683916c
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 193 lines (164 sloc) 6.07 kb
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 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; ICS2 style display
;; Author: Dmitry "Troydm" Geurkov (dgeurkov@gmail.com)

(require 'chess-display)
(require 'chess-engine)

(defgroup chess-ics2 nil
  "The ICS2 style based on ICS1 ASCII display."
  :group 'chess-display)

(defface chess-ics2-black-face
  '((((class color) (background light))
     (:foreground "Black" :background "color-209"))
    (((class color) (background dark))
     (:foreground "Black" :background "color-209"))
    (t (:bold t)))
  "*The face used for black pieces on the ASCII display."
  :group 'chess-ics2)


(defface chess-ics2-black-face-alt
  '((((class color) (background light))
     (:foreground "Black" :background "color-130"))
    (((class color) (background dark))
     (:foreground "Black" :background "color-130"))
    (t (:bold t)))
  "*The alternative face used for black pieces on the ASCII display."
  :group 'chess-ics2)

(defface chess-ics2-white-face
  '((((class color) (background light))
     (:foreground "White" :background "color-209"))
    (((class color) (background dark))
     (:foreground "White" :background "color-209"))
    (t (:bold t)))
  "*The face used for white pieces on the ASCII display."
  :group 'chess-ics2)

(defface chess-ics2-white-face-alt
  '((((class color) (background light))
     (:foreground "White" :background "color-130"))
    (((class color) (background dark))
     (:foreground "White" :background "color-130"))
    (t (:bold t)))
  "*The alternative face used for white pieces on the ASCII display."
  :group 'chess-ics2)

(defface chess-ics2-highlight-face
  '((((class color) (background light))
     (:foreground "Black" :background "#add8e6"))
    (((class color) (background dark))
     (:foreground "Black" :background "#add8e6")))
  "Face to use for highlighting pieces that have been selected."
  :group 'chess-ics2)

(defcustom chess-ics2-piece-chars
  '((?\040 . ?\040)
    (?k . ?)
    (?q . ?)
    (?r . ?)
    (?b . ?)
    (?n . ?)
    (?p . ?)
    (?K . ?)
    (?Q . ?)
    (?R . ?)
    (?B . ?)
    (?N . ?)
    (?P . ?))
  "*Alist of pieces and their corresponding characters."
  :group 'chess-ics2
  :type '(alist :key-type (character :tag "Internal representation")
:value-type (character :tag "Printed representation")))


(defcustom chess-ics2-popup-function 'chess-ics2-popup
  "The function used to popup a chess-ics1 display."
  :type 'function
  :group 'chess-ics2)

(defcustom chess-ics2-separate-frame nil
  "If non-nil, display the chessboard in its own frame."
  :type 'boolean
  :group 'chess-ics2)

;;; Code:

(defun chess-ics2-handler (event &rest args)
  (cond
   ((eq event 'initialize) t)

   ((eq event 'popup)
    (funcall chess-ics2-popup-function))

   ((eq event 'draw)
    (apply 'chess-ics2-draw args))

   ((eq event 'draw-square)
    (apply 'chess-ics2-draw-square args))

   ((eq event 'highlight)
    (apply 'chess-ics2-highlight args))))

(defun chess-ics2-popup ()
  (if chess-ics2-separate-frame
      (chess-display-popup-in-frame 21 43 nil nil t)
    (chess-display-popup-in-window)))


(defsubst chess-ics2-piece-text (piece rank file)
  (let ((p (char-to-string (cdr (assq piece chess-ics2-piece-chars))))
(a (% (+ rank file) 2)))
    (add-text-properties 0 1 (list 'face (if (> piece ?a)
(if (= a 0) 'chess-ics2-black-face
'chess-ics2-black-face-alt)
(if (= a 0) 'chess-ics2-white-face
'chess-ics2-white-face-alt))) p)
    p))

(defun chess-ics2-piece-text-draw (piece rank file)
  (insert (chess-ics2-piece-text piece rank file))
  (insert (chess-ics2-piece-text ? rank file)))

(defsubst chess-ics2-draw-square (pos piece index)
  "Draw a piece image at point on an already drawn display."
  (save-excursion
    (let ((inhibit-redisplay t))
      (message (concat (int-to-string pos) " " (int-to-string index) " "
                       (char-to-string piece)))
      (if (= (% (+ (/ index 8) pos) 2) 1)
      (goto-char pos) (goto-char (1- pos)))
      (delete-char 2)
      (insert (chess-ics2-piece-text piece (/ index 8) index))
      (insert (chess-ics2-piece-text ? (/ index 8) index))
      (add-text-properties pos (point) (list 'chess-coord index)))))

(defun chess-ics2-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))
(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)))))
(setq begin (point))
(chess-ics2-piece-text-draw piece rank file)
(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))))
      (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-ics2-highlight (index &optional mode)
  (let ((pos (chess-display-index-pos nil index)))
    (put-text-property pos (save-excursion
(goto-char (+ pos 2))
(point))
'face (cond
((eq mode :selected)
'chess-ics2-highlight-face)
(t
(chess-display-get-face mode))))))

(defun chess-ics2-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-ics2-draw pos t)
      (funcall chess-ics2-popup-function))))

(provide 'chess-ics2)

;;; chess-ics2.el ends here
Something went wrong with that request. Please try again.