diff options
| -rw-r--r-- | TODO | 11 | ||||
| -rw-r--r-- | chess-display.el | 137 | ||||
| -rw-r--r-- | chess-ics1.el | 58 | ||||
| -rw-r--r-- | chess-images.el | 47 | ||||
| -rw-r--r-- | chess-plain.el | 70 |
5 files changed, 191 insertions, 132 deletions
@@ -12,14 +12,6 @@ - Make use of the new chess-incr-index*, which does no checks -- Don't popup the display if it's already the currently selected - window - -- Make the drawing/highlighting code just touch single squares, rather - than redrawing the whole board each time (fast though this is, - touching single squares is all that's necessary, and it would be - even faster) - - Fix highlighting in chess-plain when chess-plain-spacing is set. chess-coord needs to be applied to a larger area, and also the way highlight locations are found needs to be recalculated. @@ -37,6 +29,9 @@ - Extend elp.el to do any kind of memory profiling +- Queue up input that comes in from an engine, then process the queue + -- instead of using chess-engine-last-pos + ---------------------------------------------------------------------- - Need to implement the "50 moves after irreversible" draw rule diff --git a/chess-display.el b/chess-display.el index 93dbe8d..e62b059 100644 --- a/chess-display.el +++ b/chess-display.el @@ -69,6 +69,8 @@ See `mode-line-format' for syntax details." (make-variable-buffer-local 'chess-display-no-popup) (make-variable-buffer-local 'chess-display-edit-mode) +(defvar chess-display-handling-event nil) + (chess-message-catalog 'english '((no-such-style . "There is no such chessboard display style '%s'"))) @@ -216,7 +218,23 @@ also view the same game." (erase-buffer) (chess-display-update nil))) -(defun chess-display-move (display ply) +(defun chess-display-paint-move (display ply) + (chess-with-current-buffer display + (let ((position (chess-ply-pos ply)) + (ch (chess-ply-changes ply))) + (while ch + (if (symbolp (car ch)) + (setq ch nil) + (let ((from (car ch)) + (to (cadr ch))) + (funcall chess-display-event-handler 'draw-square + (chess-display-index-pos nil from) ? from) + (funcall chess-display-event-handler 'draw-square + (chess-display-index-pos nil to) + (chess-pos-piece position from) to)) + (setq ch (cddr ch))))))) + +(defun chess-display-move (display ply &optional prev-pos pos) "Move a piece on DISPLAY, by applying the given PLY. The position of PLY must match the currently displayed position. If only START is given, it must be in algebraic move notation." @@ -224,9 +242,10 @@ If only START is given, it must be in algebraic move notation." ;; jww (2002-03-28): This should beget a variation within the ;; game, or alter the game, just as SCID allows (if (= chess-display-index (chess-game-index chess-module-game)) - (chess-game-move chess-module-game ply) + (let ((chess-display-handling-event t)) + (chess-game-move chess-module-game ply)) (error "What to do here?? NYI")) - (chess-display-update nil))) + (chess-display-paint-move nil ply))) (defun chess-display-highlight (display &rest args) "Highlight the square at INDEX on the current position. @@ -286,36 +305,43 @@ called." (defun chess-display-handler (game event &rest args) "This display module presents a standard chessboard. See `chess-display-type' for the different kinds of displays." - (if (eq event 'initialize) - (progn - (chess-display-mode) - (setq chess-display-index (chess-game-index game) - chess-display-side-to-move - (if (chess-pos-side-to-move (chess-game-pos game)) - (chess-string 'mode-white) - (chess-string 'mode-black)) - chess-display-move-text (chess-string 'mode-start) - chess-display-perspective (car args) - chess-display-event-handler - (intern-soft (concat (symbol-name chess-display-style) - "-handler"))) - (and chess-display-event-handler - (funcall chess-display-event-handler 'initialize))) - (cond - ((eq event 'pass) - (let ((my-color (chess-game-data game 'my-color))) - (chess-game-set-data game 'my-color (not my-color)) - (chess-display-set-perspective* nil (not my-color)))) - - ((eq event 'orient) - ;; Set the display's perspective to whichever color I'm playing - (chess-display-set-perspective* nil (chess-game-data game 'my-color)))) - - (let ((momentous (memq event chess-display-momentous-events))) - (if momentous - (chess-display-set-index* nil (chess-game-index game))) - (if (or momentous (memq event chess-display-interesting-events)) - (chess-display-update nil momentous))))) + (unless chess-display-handling-event + (if (eq event 'initialize) + (progn + (chess-display-mode) + (setq chess-display-index (chess-game-index game) + chess-display-side-to-move + (if (chess-pos-side-to-move (chess-game-pos game)) + (chess-string 'mode-white) + (chess-string 'mode-black)) + chess-display-move-text (chess-string 'mode-start) + chess-display-perspective (car args) + chess-display-event-handler + (intern-soft (concat (symbol-name chess-display-style) + "-handler"))) + (and chess-display-event-handler + (funcall chess-display-event-handler 'initialize))) + (cond + ((eq event 'pass) + (let ((my-color (chess-game-data game 'my-color))) + (chess-game-set-data game 'my-color (not my-color)) + (chess-display-set-perspective* nil (not my-color)))) + + ((eq event 'orient) + (let ((my-color (chess-game-data game 'my-color))) + ;; Set the display's perspective to whichever color I'm + ;; playing + (chess-display-set-perspective* nil my-color)))) + + (let ((momentous (memq event chess-display-momentous-events))) + (if momentous + (chess-display-set-index* nil (chess-game-index game))) + (if (or momentous (memq event chess-display-interesting-events)) + (if (eq event 'move) + (progn + (chess-display-paint-move nil (car args)) + (chess-display-popup nil)) + (chess-display-update nil momentous))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -482,10 +508,11 @@ Basically, it means we are playing, not editing or reviewing." "Set the piece under point to command character, or space for clear." (interactive) (unless (chess-display-active-p) - (chess-pos-set-piece (chess-display-position nil) - (get-text-property (point) 'chess-coord) - last-command-char) - (chess-display-update nil))) + (let ((index (get-text-property (point) 'chess-coord))) + (chess-pos-set-piece (chess-display-position nil) index + last-command-char) + (funcall chess-display-event-handler 'draw-square + (point) last-command-char index)))) (chess-message-catalog 'english '((illegal-notation . "Illegal move notation: %s") @@ -916,9 +943,12 @@ Clicking once on a piece selects it; then click on the target location." ;; it by redrawing the display and removing all ;; highlights (if (= (point) (car last-sel)) - (chess-display-update nil) + (funcall chess-display-event-handler 'draw-square + (car last-sel) + (chess-pos-piece position (cdr last-sel)) + (cdr last-sel)) (let ((s-piece (chess-pos-piece position - (cadr last-sel))) + (cdr last-sel))) (t-piece (chess-pos-piece position coord)) ply) (if (and (/= t-piece ? ) @@ -928,10 +958,10 @@ Clicking once on a piece selects it; then click on the target location." (> s-piece ?a)))) (throw 'message (chess-string 'cannot-mount))) (unless (setq ply (chess-ply-create position nil - (cadr last-sel) + (cdr last-sel) coord)) (throw 'message (chess-string 'move-not-legal))) - (chess-display-move nil ply))) + (chess-display-move nil ply (car last-sel) (point)))) (setq chess-display-last-selected nil)) (chess-display-assert-can-move position) (let ((piece (chess-pos-piece position coord))) @@ -945,13 +975,18 @@ Clicking once on a piece selects it; then click on the target location." ((and chess-display-highlight-legal (null (chess-legal-plies position :any :index coord))) (throw 'message (chess-string 'piece-immobile)))) - (setq chess-display-last-selected (list (point) coord)) + (setq chess-display-last-selected (cons (point) coord)) (chess-display-highlight nil coord) (if chess-display-highlight-legal (chess-display-highlight-legal nil coord)))))) (when message - (setq chess-display-last-selected nil) - (chess-display-update nil) + (when chess-display-last-selected + (funcall chess-display-event-handler 'draw-square + (car chess-display-last-selected) + (chess-pos-piece position + (cdr chess-display-last-selected)) + (cdr chess-display-last-selected)) + (setq chess-display-last-selected nil)) (error message))))) (defun chess-display-mouse-select-piece (event) @@ -969,6 +1004,20 @@ Clicking once on a piece selects it; then click on the target location." (goto-char (posn-point (event-end event))) (chess-display-select-piece)))) +(defun chess-display-index-pos (display index) + (chess-with-current-buffer display + (let ((pos (next-single-property-change (point-min) 'chess-coord)) + pos-index) + (while (and pos (or (null (setq pos-index + (get-text-property pos 'chess-coord))) + (/= index pos-index))) + (setq pos (next-single-property-change pos 'chess-coord))) + pos))) + +(defsubst chess-display-goto-index (index) + (chess-with-current-buffer display + (goto-char (chess-display-index-pos nil index)))) + (provide 'chess-display) ;;; chess-display.el ends here diff --git a/chess-ics1.el b/chess-ics1.el index e372f30..067a67a 100644 --- a/chess-ics1.el +++ b/chess-ics1.el @@ -39,14 +39,35 @@ (defun chess-ics1-handler (event &rest args) (cond ((eq event 'initialize) t) + ((eq event 'popup) (if chess-display-popup (funcall chess-ics1-popup-function))) + ((eq event 'draw) (apply 'chess-ics1-draw args)) + + ((eq event 'draw-square) + (apply 'chess-ics1-draw-square args)) + ((eq event 'highlight) (apply 'chess-ics1-highlight args)))) +(defsubst chess-ics1-piece-text (piece) + (let ((p (char-to-string piece))) + (add-text-properties 0 1 (list 'face (if (> piece ?a) + 'chess-ics1-black-face + 'chess-ics1-white-face)) p) + p)) + +(defsubst chess-ics1-draw-square (pos piece index) + "Draw a piece image at point on an already drawn display." + (save-excursion + (goto-char pos) + (forward-char) + (delete-char 1) + (insert (chess-ics1-piece-text piece)))) + (defun chess-ics1-draw (position perspective) "Draw the given POSITION from PERSPECTIVE's point of view. PERSPECTIVE is t for white or nil for black." @@ -69,13 +90,7 @@ PERSPECTIVE is t for white or nil for black." (insert (format " %d " (1+ (- 7 rank))))) (insert "| ") (setq begin (1- (point))) - (let ((p (char-to-string piece))) - (add-text-properties - 0 1 (list 'face (if (> piece ?a) - 'chess-ics1-black-face - 'chess-ics1-white-face)) p) - (insert p)) - (insert ? ) + (insert (chess-ics1-piece-text piece) ? ) (add-text-properties begin (point) (list 'chess-coord (chess-rf-to-index rank file)))) @@ -91,25 +106,16 @@ PERSPECTIVE is t for white or nil for black." (goto-char pos))) (defun chess-ics1-highlight (index &optional mode) - (if (null (get-buffer-window (current-buffer) t)) - (pop-to-buffer (current-buffer))) - (let ((inverted (not (chess-display-perspective nil))) - beg end) - (save-excursion - (goto-char (point-min)) - (let ((rank (chess-index-rank index)) - (file (chess-index-file index))) - (goto-line (+ 3 (* 2 (if inverted (- 7 rank) rank)))) - (forward-char (+ 8 (* 4 (if inverted (- 7 file) file))))) - (skip-chars-backward "^|") - (setq beg (point)) - (skip-chars-forward "^|") - (put-text-property beg (point) 'face - (cond - ((eq mode :selected) - 'chess-ics1-highlight-face) - (t - (chess-display-get-face mode))))))) + (let ((pos (chess-display-index-pos nil index))) + (put-text-property pos (save-excursion + (goto-char pos) + (skip-chars-forward "^|") + (point)) + 'face (cond + ((eq mode :selected) + 'chess-ics1-highlight-face) + (t + (chess-display-get-face mode)))))) (defun chess-debug-position (&optional position) "This is a debugging function, and not meant from general use." diff --git a/chess-images.el b/chess-images.el index c42ca32..f92b9c7 100644 --- a/chess-images.el +++ b/chess-images.el @@ -169,6 +169,9 @@ called." ((eq event 'draw) (apply 'chess-images-draw args)) + ((eq event 'draw-square) + (apply 'chess-images-draw-square args)) + ((eq event 'highlight) (apply 'chess-images-highlight args)))) @@ -208,6 +211,25 @@ called." max-char-width)) (chess-display-popup-in-window))) +(defun chess-images-piece-image (piece rank file) + "Return the image used for PIECE at RANK and FILE. +Rank and file are important because the colors of the squares on the +chess board are light or dark depending on location." + (let ((white-square (% (+ file rank) 2))) + (if (= piece ? ) + (aref chess-images-cache (+ white-square 2)) + (aref (aref (aref chess-images-cache + (if (> piece ?a) 0 1)) + white-square) + (nth 2 (assq (downcase piece) + chess-images-piece-names)))))) + +(defsubst chess-images-draw-square (pos piece index) + "Draw a piece image at point on an already drawn display." + (put-text-property pos (1+ pos) 'display + (chess-images-piece-image piece (chess-index-rank index) + (chess-index-file index)))) + (defun chess-images-draw (position perspective) "Draw the current chess display position." (let* ((inhibit-redisplay t) @@ -222,20 +244,9 @@ called." (goto-char (point-min))) (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))) - (image - (if (= piece ? ) - (aref chess-images-cache - (+ 2 (if (= 0 (mod rank 2)) - (- 1 (mod file 2)) - (mod file 2)))) - (aref (aref (aref chess-images-cache - (if (> piece ?a) 0 1)) - (if (= 0 (mod rank 2)) - (- 1 (mod file 2)) - (mod file 2))) - (nth 2 (assq (downcase piece) - chess-images-piece-names)))))) + (let* ((piece (chess-pos-piece position + (chess-rf-to-index rank file))) + (image (chess-images-piece-image piece rank file))) (if (not new) (progn (put-text-property (point) (1+ (point)) 'display image) @@ -263,13 +274,7 @@ Common modes are: `selected' show that the piece has been selected for movement. `unselected' show that the piece has been unselected." (let* ((inverted (not (chess-display-perspective nil))) - (pos (save-excursion - (goto-char (point-min)) - (let ((rank (chess-index-rank index)) - (file (chess-index-file index))) - (goto-line (1+ (if inverted (- 7 rank) rank))) - (forward-char (* 2 (if inverted (- 7 file) file)))) - (point))) + (pos (chess-display-index-pos nil index)) (highlight (copy-alist (get-text-property pos 'display)))) (setcar (last highlight) (list (cons "light_square" (if (eq mode :selected) diff --git a/chess-plain.el b/chess-plain.el index 2f386e9..bc0e46f 100644 --- a/chess-plain.el +++ b/chess-plain.el @@ -81,14 +81,43 @@ modify `chess-plain-piece-chars' to avoid real confusion.)" (defun chess-plain-handler (event &rest args) (cond ((eq event 'initialize) t) + ((eq event 'popup) (if chess-display-popup (funcall chess-plain-popup-function))) + ((eq event 'draw) (apply 'chess-plain-draw args)) + + ((eq event 'draw-square) + (apply 'chess-plain-draw-square args)) + ((eq event 'highlight) (apply 'chess-plain-highlight args)))) +(defun chess-plain-piece-text (piece rank file) + (let ((white-square (= (% (+ file rank) 2) 0))) + (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)))))) + +(defsubst chess-plain-draw-square (pos piece index) + "Draw a piece image at point on an already drawn display." + (save-excursion + (goto-char pos) + (delete-char 1) + (insert (chess-plain-piece-text piece (chess-index-rank index) + (chess-index-file index))))) + (defun chess-plain-draw (position perspective) "Draw the given POSITION from PERSPECTIVE's point of view. PERSPECTIVE is t for white or nil for black." @@ -111,20 +140,8 @@ PERSPECTIVE is t for white or nil for black." (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))))) + (insert (chess-plain-piece-text piece rank file)) (add-text-properties begin (point) (list 'chess-coord (chess-rf-to-index rank file))) @@ -146,26 +163,13 @@ PERSPECTIVE is t for white or nil for black." (goto-char pos)))) (defun chess-plain-highlight (index &optional mode) - (let ((inverted (not (chess-display-perspective nil)))) - (save-excursion - (beginning-of-line) - (let ((rank (chess-index-rank index)) - (file (chess-index-file index))) - (if inverted - (setq rank (- 7 rank) - file (- 7 file))) - (goto-line (if chess-plain-draw-border - (+ 2 rank) - (1+ rank))) - (forward-char (if chess-plain-draw-border - (1+ file) - file))) - (put-text-property (point) (1+ (point)) 'face - (cond - ((eq mode :selected) - 'chess-plain-highlight-face) - (t - (chess-display-get-face mode))))))) + (let ((pos (chess-display-index-pos nil index))) + (put-text-property pos (1+ pos) 'face + (cond + ((eq mode :selected) + 'chess-plain-highlight-face) + (t + (chess-display-get-face mode)))))) (provide 'chess-plain) |