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-ics1-popup
  33   "The function used to popup a chess-ics1 display."
  34   :type 'function
  35   :group 'chess-ics1)
  36
  37 (defcustom chess-ics1-separate-frame nil
  38   "If non-nil, display the chessboard in its own frame."
  39   :type 'boolean
  40   :group 'chess-ics1)
  41
  42 ;;; Code:
  43
  44 (defun chess-ics1-handler (event &rest args)
  45   (cond
  46    ((eq event 'initialize) t)
  47
  48    ((eq event 'popup)
  49     (funcall chess-ics1-popup-function))
  50
  51    ((eq event 'draw)
  52     (apply 'chess-ics1-draw args))
  53
  54    ((eq event 'draw-square)
  55     (apply 'chess-ics1-draw-square args))
  56
  57    ((eq event 'highlight)
  58     (apply 'chess-ics1-highlight args))))
  59
  60 (defun chess-ics1-popup ()
  61   (if chess-ics1-separate-frame
  62       (chess-display-popup-in-frame 21 43 nil t)
  63     (chess-display-popup-in-window)))
  64
  65 (defsubst chess-ics1-piece-text (piece)
  66   (let ((p (char-to-string piece)))
  67     (add-text-properties 0 1 (list 'face (if (> piece ?a)
  68                                              'chess-ics1-black-face
  69                                            'chess-ics1-white-face)) p)
  70     p))
  71
  72 (defsubst chess-ics1-draw-square (pos piece index)
  73   "Draw a piece image at point on an already drawn display."
  74   (save-excursion
  75     (let ((inhibit-redisplay t))
  76       (goto-char pos)
  77       (delete-char 3)
  78       (insert ?  (chess-ics1-piece-text piece) ? )
  79       (add-text-properties pos (point) (list 'chess-coord index)))))
  80
  81 (defun chess-ics1-draw (position perspective)
  82   "Draw the given POSITION from PERSPECTIVE's point of view.
  83 PERSPECTIVE is t for white or nil for black."
  84   (let ((inhibit-redisplay t)
  85         (pos (point)))
  86     (erase-buffer)
  87     (let* ((inverted (not perspective))
  88            (rank (if inverted 7 0))
  89            (file (if inverted 7 0)) beg)
  90       (insert "\n      +---+---+---+---+---+---+---+---+\n")
  91       (while (if inverted (>= rank 0) (< rank 8))
  92         (if (/= rank (if inverted 7 0))
  93             (insert "      +---+---+---+---+---+---+---+---+\n"))
  94         (while (if inverted (>= file 0) (< file 8))
  95           (let ((piece (chess-pos-piece position
  96                                         (chess-rf-to-index rank file)))
  97                 begin)
  98             (if (= file (if inverted 7 0))
  99                 (insert (format "    %d " (1+ (- 7 rank)))))
 100             (insert "| ")
 101             (setq begin (1- (point)))
 102             (insert (chess-ics1-piece-text piece) ? )
 103             (add-text-properties begin (point)
 104                                  (list 'chess-coord
 105                                        (chess-rf-to-index rank file))))
 106           (setq file (if inverted (1- file) (1+ file))))
 107         (insert "|\n")
 108         (setq file (if inverted 7 0)
 109               rank (if inverted (1- rank) (1+ rank))))
 110       (insert "      +---+---+---+---+---+---+---+---+\n")
 111       (if inverted
 112           (insert "        h   g   f   e   d   c   b   a\n\n")
 113         (insert "        a   b   c   d   e   f   g   h\n\n")))
 114     (set-buffer-modified-p nil)
 115     (goto-char pos)))
 116
 117 (defun chess-ics1-highlight (index &optional mode)
 118   (let ((pos (chess-display-index-pos nil index)))
 119     (put-text-property pos (save-excursion
 120                              (goto-char pos)
 121                              (skip-chars-forward "^|")
 122                              (point))
 123                        'face (cond
 124                               ((eq mode :selected)
 125                                'chess-ics1-highlight-face)
 126                               (t
 127                                (chess-display-get-face mode))))))
 128
 129 (defun chess-debug-position (&optional position)
 130   "This is a debugging function, and not meant from general use."
 131   (interactive)
 132   (let ((pos (or position (chess-engine-position nil))))
 133     (with-current-buffer (get-buffer-create "*scratch*")
 134       (chess-ics1-draw pos t)
 135       (funcall chess-ics1-popup-function))))
 136
 137 (provide 'chess-ics1)
 138
 139 ;;; chess-ics1.el ends here