More work to get engines working.

1 files changed, 134 insertions, 0 deletions

diff --git a/chess-plain.el b/chess-plain.el
new file mode 100644
index 0000000..c067664
--- /dev/null
+++ b/chess-plain.el
@@ -0,0 +1,134 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Plain ASCII chess display
+;;
+;; $Revision$
+
+(require 'chess-display)
+
+;;; Code:
+
+(defgroup chess-plain nil
+  "A minimal, customizable ASCII display."
+  :group 'chess-ascii)
+
+(defcustom chess-plain-draw-border nil
+  "*Non-nil if a border should be drawn (using `chess-plain-border-chars')."
+  :group 'chess-plain
+  :type 'boolean)
+
+(defcustom chess-plain-border-chars '(?+ ?- ?+ ?| ?| ?+ ?- ?+)
+  "*Characters used to draw borders."
+  :group 'chess-plain
+  :type '(list character character character character
+	       character character character character))
+
+(defcustom chess-plain-black-square-char ?.
+  "*Character used to indicate black squares."
+  :group 'chess-plain
+  :type 'character)
+
+(defcustom chess-plain-white-square-char ?.
+  "*Character used to indicate white squares."
+  :group 'chess-plain
+  :type 'character)
+
+(defcustom chess-plain-piece-chars
+  '((?K . ?K)
+    (?Q . ?Q)
+    (?R . ?R)
+    (?B . ?B)
+    (?N . ?N)
+    (?P . ?P)
+    (?k . ?k)
+    (?q . ?q)
+    (?r . ?r)
+    (?b . ?b)
+    (?n . ?n)
+    (?p . ?p))
+  "*Alist of pieces and their corresponding characters."
+  :group 'chess-plain
+  :type '(alist :key-type character :value-type character))
+
+(defcustom chess-plain-upcase-indicates 'color
+  "*Defines what a upcase char should indicate.
+The default is 'color, meaning a upcase char is a white piece, a
+lowercase char a black piece.  Possible values: 'color (default),
+'square-color.  If set to 'square-color, a uppercase character
+indicates a piece on a black square. (Note that you also need to
+modify `chess-plain-piece-chars' to avoid real confusion.)"
+  :group 'chess-plain
+  :type '(choice (const 'color) (const 'square-color)))
+	 ;; fails somehow
+
+(defun chess-plain-draw ()
+  "Draw the given POSITION from PERSPECTIVE's point of view.
+PERSPECTIVE is t for white or nil for black."
+  (if (null (get-buffer-window (current-buffer) t))
+      (pop-to-buffer (current-buffer)))
+  (let ((inhibit-redisplay t)
+	(pos (point)))
+    (erase-buffer)
+    (let* ((position (chess-display-position nil))
+	   (inverted (null (chess-display-perspective nil)))
+	   (rank (if inverted 7 0))
+	   (file (if inverted 7 0))
+	   beg)
+      (if chess-plain-draw-border
+	  (insert ?  (nth 0 chess-plain-border-chars)
+		  (make-string 8 (nth 1 chess-plain-border-chars))
+		  (nth 2 chess-plain-border-chars) ?\n))
+      (while (if inverted (>= rank 0) (< rank 8))
+	(if chess-plain-border-chars
+	    (insert (number-to-string (- 8 rank))
+		    (nth 3 chess-plain-border-chars)))
+	(while (if inverted (>= file 0) (< file 8))
+	  (let ((piece (chess-pos-piece position
+					(chess-rf-to-index rank file)))
+		(white-square (evenp (+ file rank)))
+		(begin (point)))
+	    (insert (if (eq piece ? )
+			(if white-square
+			    chess-plain-white-square-char
+			  chess-plain-black-square-char)
+		      (let ((what chess-plain-upcase-indicates)
+			    (pchar (cdr (assq piece chess-plain-piece-chars))))
+			(cond
+			 ((eq what 'square-color)
+			  (if white-square
+			      (downcase pchar)
+			    (upcase pchar)))
+			 (t pchar)))))
+	    (add-text-properties begin (point)
+				 (list 'chess-coord
+				       (chess-rf-to-index rank file))))
+	  (setq file (if inverted (1- file) (1+ file))))
+	(if chess-plain-draw-border
+	    (insert (nth 4 chess-plain-border-chars) ?\n))
+	(setq file (if inverted 7 0)
+	      rank (if inverted (1- rank) (1+ rank))))
+      (if chess-plain-draw-border
+	  (insert ?  (nth 5 chess-plain-border-chars)
+		  (make-string 8 (nth 6 chess-plain-border-chars))
+		  (nth 7 chess-plain-border-chars) ?\n
+		  ? ?  (if (not inverted) "abcdefgh" "hgfedcba")))
+      (set-buffer-modified-p nil)
+      (goto-char pos))))
+
+(defun chess-plain-highlight (index &optional mode)
+  (if (null (get-buffer-window (current-buffer) t))
+      (pop-to-buffer (current-buffer)))
+  (save-excursion
+    (beginning-of-line)
+    (goto-line (if chess-plain-draw-border
+		   (+ 2 (chess-index-rank index))
+		 (1+ (chess-index-rank index))))
+    (forward-char (if chess-plain-draw-border
+		      (1+ (chess-index-file index))
+		    (chess-index-file index)))
+    (put-text-property (point) (1+ (point)) 'face
+		       'chess-display-highlight-face)))
+
+(provide 'chess-plain)
+
+;;; chess-plain.el ends here