Lots of painting improvements for displays, to improve efficiency.

5 files changed, 191 insertions, 132 deletions

diff --git a/TODO b/TODO
index 815a8a1..8b2b710 100644
--- a/TODO
+++ b/TODO
@@ -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)