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

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Plain ASCII chess display
   4 ;;
   5
   6 (require 'chess-display)
   7
   8 ;;; Code:
   9
  10 (defgroup chess-plain nil
  11   "A minimal, customizable ASCII display."
  12   :group 'chess-display)
  13
  14 (defcustom chess-plain-draw-border nil
  15   "*Non-nil if a border should be drawn (using `chess-plain-border-chars')."
  16   :group 'chess-plain
  17   :type 'boolean)
  18
  19 (defcustom chess-plain-border-chars '(?+ ?- ?+ ?| ?| ?+ ?- ?+)
  20   "*A list of Characters used to draw borders."
  21   :group 'chess-plain
  22   :type '(list (character :tag "Upper left corner")
  23                (character :tag "Upper border")
  24                (character :tag "Upper right corner")
  25                (character :tag "Left border")
  26                (character :tag "Right border")
  27                (character :tag "Lower left corner")
  28                (character :tag "Lowwer border")
  29                (character :tag "Lower right corner")))
  30
  31 (defcustom chess-plain-black-square-char ?.
  32   "*Character used to indicate empty black squares."
  33   :group 'chess-plain
  34   :type 'character)
  35
  36 (defcustom chess-plain-white-square-char ?.
  37   "*Character used to indicate empty white squares."
  38   :group 'chess-plain
  39   :type 'character)
  40
  41 (defcustom chess-plain-piece-chars
  42   '((?K . ?K)
  43     (?Q . ?Q)
  44     (?R . ?R)
  45     (?B . ?B)
  46     (?N . ?N)
  47     (?P . ?P)
  48     (?k . ?k)
  49     (?q . ?q)
  50     (?r . ?r)
  51     (?b . ?b)
  52     (?n . ?n)
  53     (?p . ?p))
  54   "*Alist of pieces and their corresponding characters."
  55   :group 'chess-plain
  56   :type '(alist :key-type (character :tag "Internal representation")
  57                 :value-type (character :tag "Printed representation")))
  58
  59 (defcustom chess-plain-upcase-indicates 'color
  60   "*Defines what a upcase char should indicate.
  61 The default is 'color, meaning a upcase char is a white piece, a
  62 lowercase char a black piece.  Possible values: 'color (default),
  63 'square-color.  If set to 'square-color, a uppercase character
  64 indicates a piece on a black square. (Note that you also need to
  65 modify `chess-plain-piece-chars' to avoid real confusion.)"
  66   :group 'chess-plain
  67   :type '(choice (const color) (const square-color)))
  68
  69 (defcustom chess-plain-spacing 1
  70   "*Number of spaces between files."
  71   :group 'chess-plain
  72   :type 'integer)
  73
  74 (defface chess-plain-black-face
  75   '((((class color) (background light)) (:foreground "Black"))
  76     (((class color) (background dark)) (:foreground "Green"))
  77     (t (:bold t)))
  78   "*The face used for black pieces on the ASCII display."
  79   :group 'chess-plain)
  80
  81 (defface chess-plain-white-face
  82   '((((class color) (background light)) (:foreground "Blue"))
  83     (((class color) (background dark)) (:foreground "Yellow"))
  84     (t (:bold t)))
  85   "*The face used for white pieces on the ASCII display."
  86   :group 'chess-plain)
  87
  88 (defface chess-plain-highlight-face
  89   '((((class color) (background light)) (:background "#add8e6"))
  90     (((class color) (background dark)) (:background "#add8e6")))
  91   "Face to use for highlighting pieces that have been selected."
  92   :group 'chess-plain)
  93
  94 (defcustom chess-plain-popup-function 'chess-plain-popup
  95   "The function used to popup a chess-plain display."
  96   :type 'function
  97   :group 'chess-plain)
  98
  99 (defcustom chess-plain-separate-frame nil
 100   "*If non-nil, display the chessboard in its own frame."
 101   :type 'boolean
 102   :group 'chess-plain)
 103
 104 ;;; Code:
 105
 106 (defun chess-plain-handler (event &rest args)
 107   (cond
 108    ((eq event 'initialize) t)
 109
 110    ((eq event 'popup)
 111     (funcall chess-plain-popup-function))
 112
 113    ((eq event 'draw)
 114     (apply 'chess-plain-draw args))
 115
 116    ((eq event 'draw-square)
 117     (apply 'chess-plain-draw-square args))
 118
 119    ((eq event 'highlight)
 120     (apply 'chess-plain-highlight args))))
 121
 122 (defun chess-plain-popup ()
 123   (if chess-plain-separate-frame
 124       (chess-display-popup-in-frame 9 (* (1+ chess-plain-spacing) 8) nil t)
 125     (chess-display-popup-in-window)))
 126
 127 (defun chess-plain-piece-text (piece rank file)
 128   (let ((white-square (= (% (+ file rank) 2) 0)))
 129     (if (eq piece ? )
 130         (if white-square
 131             chess-plain-white-square-char
 132           chess-plain-black-square-char)
 133       (let* ((pchar (cdr (assq piece chess-plain-piece-chars)))
 134              (p (char-to-string
 135                  (if (eq chess-plain-upcase-indicates 'square-color)
 136                      (if white-square
 137                          (downcase pchar)
 138                        (upcase pchar))
 139                    pchar))))
 140         (add-text-properties 0 1 (list 'face (if (> piece ?a)
 141                                                  'chess-plain-black-face
 142                                                'chess-plain-white-face)) p)
 143         p))))
 144
 145 (defsubst chess-plain-draw-square (pos piece index)
 146   "Draw a piece image at POS on an already drawn display."
 147   (save-excursion
 148     (goto-char pos)
 149     (delete-char 1)
 150     (insert (chess-plain-piece-text piece (chess-index-rank index)
 151                                     (chess-index-file index)))
 152     (add-text-properties pos (point) (list 'chess-coord index))))
 153
 154 (defun chess-plain-draw (position perspective)
 155   "Draw the given POSITION from PERSPECTIVE's point of view.
 156 PERSPECTIVE is t for white or nil for black."
 157   (let ((inhibit-redisplay t)
 158         (pos (point)))
 159     (erase-buffer)
 160     (let* ((inverted (not perspective))
 161            (rank (if inverted 7 0))
 162            (file (if inverted 7 0)) beg)
 163       (if chess-plain-draw-border
 164           (insert ?  (nth 0 chess-plain-border-chars)
 165                   (make-string (+ 8 (* 7 chess-plain-spacing))
 166                                (nth 1 chess-plain-border-chars))
 167                   (nth 2 chess-plain-border-chars) ?\n))
 168       (while (if inverted (>= rank 0) (< rank 8))
 169         (if chess-plain-draw-border
 170             (insert (number-to-string (- 8 rank))
 171                     (nth 3 chess-plain-border-chars)))
 172         (while (if inverted (>= file 0) (< file 8))
 173           (let ((piece (chess-pos-piece position
 174                                         (chess-rf-to-index rank file)))
 175                 (begin (point)))
 176             (insert (chess-plain-piece-text piece rank file))
 177             (add-text-properties begin (point)
 178                                  (list 'chess-coord
 179                                        (chess-rf-to-index rank file)))
 180             (when (if inverted (>= file 1) (< file 7))
 181               (insert (make-string chess-plain-spacing ? ))))
 182           (setq file (if inverted (1- file) (1+ file))))
 183         (if chess-plain-draw-border
 184             (insert (nth 4 chess-plain-border-chars)))
 185         (insert ?\n)
 186         (setq file (if inverted 7 0)
 187               rank (if inverted (1- rank) (1+ rank))))
 188       (if chess-plain-draw-border
 189           (insert ?  (nth 5 chess-plain-border-chars)
 190                   (make-string (+ 8 (* 7 chess-plain-spacing))
 191                                (nth 6 chess-plain-border-chars))
 192                   (nth 7 chess-plain-border-chars) ?\n
 193                   ? ?
 194                   (let ((string (if (not inverted) "abcdefgh" "hgfedcba")))
 195                     (mapconcat 'string (string-to-list string)
 196                                (make-string chess-plain-spacing ? )))))
 197       (set-buffer-modified-p nil)
 198       (goto-char pos))))
 199
 200 (defun chess-plain-highlight (index &optional mode)
 201   (let ((pos (chess-display-index-pos nil index)))
 202     (put-text-property pos (1+ pos) 'face
 203                        (cond
 204                         ((eq mode :selected)
 205                          'chess-plain-highlight-face)
 206                         (t
 207                          (chess-display-get-face mode))))))
 208
 209 (provide 'chess-plain)
 210
 211 ;;; chess-plain.el ends here