Added chess-ics2.el, from Dmitry "Troydm" Geurkov

2 files changed, 193 insertions, 0 deletions

diff --git a/Makefile.am b/Makefile.am
index 24edea0..5f706a0 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -27,6 +27,7 @@ dist_lisp_LISP =	   \
 	chess-gnuchess.el  \
 	chess-ics.el	   \
 	chess-ics1.el	   \
+	chess-ics2.el	   \
 	chess-images.el	   \
 	chess-input.el	   \
 	chess-irc.el	   \
diff --git a/chess-ics2.el b/chess-ics2.el
new file mode 100644
index 0000000..a052bea
--- /dev/null
+++ b/chess-ics2.el
@@ -0,0 +1,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