code.delx.au - gnu-emacs-elpa/blob - chess-ics1.el

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