diff options
| -rw-r--r-- | chess-algebraic.el | 95 | ||||
| -rw-r--r-- | chess-display.el | 74 | ||||
| -rw-r--r-- | chess-engine.el | 62 | ||||
| -rw-r--r-- | chess-game.el | 3 | ||||
| -rw-r--r-- | chess-gnuchess.el | 2 | ||||
| -rw-r--r-- | chess-ply.el | 4 | ||||
| -rw-r--r-- | chess.el | 31 |
7 files changed, 140 insertions, 131 deletions
diff --git a/chess-algebraic.el b/chess-algebraic.el index c960d4a..de2d953 100644 --- a/chess-algebraic.el +++ b/chess-algebraic.el @@ -53,53 +53,54 @@ This regexp handles both long and short form.") (defun chess-algebraic-to-ply (position move &optional search-func) "Convert the algebraic notation MOVE for POSITION to a ply." - (when (string-match chess-algebraic-regexp move) - (let* ((color (chess-pos-side-to-move position)) - (mate (match-string 10 move)) - (piece (aref move 0)) - (changes - (if (eq piece ?O) - (let ((rank (if color 7 0)) - (long (= (length (match-string 1 move)) 5))) - (list (chess-rf-to-index rank 4) - (chess-rf-to-index rank (if long 2 6)) - (chess-rf-to-index rank (if long 0 7)) - (chess-rf-to-index rank (if long 3 5)))) - (let ((source (match-string 4 move)) - (target (chess-coord-to-index (match-string 7 move)))) - (if (and source (= (length source) 2)) - (list (chess-coord-to-index source) target) - (let (candidates which) - (unless (< piece ?a) - (setq piece ?P)) - ;; we must use our knowledge of how pieces can - ;; move, to determine which piece is meant by the - ;; piece indicator - (when (setq candidates - (funcall (or search-func - 'chess-standard-search-position) - position target (if color piece - (downcase piece)))) - (if (= (length candidates) 1) - (list (car candidates) target) - (if (null source) - (error "Clarify piece to move by rank or file") - (while candidates - (if (if (>= source ?a) - (eq (cdar candidates) (- source ?a)) - (eq (caar candidates) (- 7 (- source ?1)))) - (setq which (car candidates) candidates nil) - (setq candidates (cdr candidates)))) - (if (null which) - (error "Could not determine which piece to use") - (list which target))))))))))) - (if mate - (nconc changes - (list (if (equal mate "#") - ':checkmate - ':check)))) - (assert changes) - (apply 'chess-ply-create position changes)))) + (unless (string-match chess-algebraic-regexp move) + (error "Cannot parse non-algebraic move notation: %s" move)) + (let* ((color (chess-pos-side-to-move position)) + (mate (match-string 10 move)) + (piece (aref move 0)) + (changes + (if (eq piece ?O) + (let ((rank (if color 7 0)) + (long (= (length (match-string 1 move)) 5))) + (list (chess-rf-to-index rank 4) + (chess-rf-to-index rank (if long 2 6)) + (chess-rf-to-index rank (if long 0 7)) + (chess-rf-to-index rank (if long 3 5)))) + (let ((source (match-string 4 move)) + (target (chess-coord-to-index (match-string 7 move)))) + (if (and source (= (length source) 2)) + (list (chess-coord-to-index source) target) + (let (candidates which) + (unless (< piece ?a) + (setq piece ?P)) + ;; we must use our knowledge of how pieces can + ;; move, to determine which piece is meant by the + ;; piece indicator + (when (setq candidates + (funcall (or search-func + 'chess-standard-search-position) + position target (if color piece + (downcase piece)))) + (if (= (length candidates) 1) + (list (car candidates) target) + (if (null source) + (error "Clarify piece to move by rank or file") + (while candidates + (if (if (>= source ?a) + (eq (cdar candidates) (- source ?a)) + (eq (caar candidates) (- 7 (- source ?1)))) + (setq which (car candidates) candidates nil) + (setq candidates (cdr candidates)))) + (if (null which) + (error "Could not determine which piece to use") + (list which target))))))))))) + (if mate + (nconc changes + (list (if (equal mate "#") + ':checkmate + ':check)))) + (assert changes) + (apply 'chess-ply-create position changes))) (defun chess-ply-to-algebraic (ply &optional long search-func) "Convert the given PLY to algebraic notation. diff --git a/chess-display.el b/chess-display.el index 4e18130..526d8ca 100644 --- a/chess-display.el +++ b/chess-display.el @@ -259,39 +259,30 @@ change that position object, the display can be updated by calling (funcall chess-display-draw-function)) (chess-display-set-modeline))) -(defun chess-display-move (display start &optional target) - "Move a piece on DISPLAY from START to TARGET. +(defun chess-display-move (display ply) + "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." (chess-with-current-buffer display - ;; jww (2002-03-28): how is this going to handle castling? There - ;; needs to be a way to "flesh" out a move using the standard - ;; search function. - (let ((ply (if (null target) - (chess-algebraic-to-ply - (chess-display-position nil) start - (chess-display-search-function nil)) - (chess-ply-create (chess-display-position nil) - start target)))) - (cond - ((chess-display-active-p) - ;; make the move and then announce it - (chess-game-move chess-display-game ply) - (chess-session-event chess-display-session 'move ply)) - (chess-display-game - ;; jww (2002-03-28): This should beget a variation within the - ;; game, or alter the game, just as SCID allows - (unless (= (chess-display-index nil) - (chess-game-index chess-display-game)) - (error "Cannot move partway in game (index %d != game index %d)" - (chess-display-index nil) - (chess-game-index chess-display-game))) - (chess-game-move chess-display-game ply)) - (chess-display-variation - (nconc chess-display-variation (list ply))) - (chess-display-ply - (setq chess-display-ply ply)) - (t ; an ordinary position - (setq chess-display-position (chess-ply-next-pos ply))))) + (cond + ((chess-display-active-p) + (chess-session-event chess-display-session 'move ply)) + (chess-display-game + ;; jww (2002-03-28): This should beget a variation within the + ;; game, or alter the game, just as SCID allows + (if (= (chess-display-index nil) + (chess-game-index chess-display-game)) + (setq chess-display-index + (1+ (chess-game-index chess-display-game)))) + (chess-game-move chess-display-game ply)) + (chess-display-variation + ;; jww (2002-04-02): what if we're in the middle? + (nconc chess-display-variation (list ply)) + (setq chess-display-index (1- (length chess-display-variation)))) + (chess-display-ply + (setq chess-display-ply ply)) + (t ; an ordinary position + (setq chess-display-position (chess-ply-next-pos ply)))) (chess-display-update nil))) (defun chess-display-highlight (display index &optional mode) @@ -337,6 +328,11 @@ See `chess-display-type' for the different kinds of displays." (chess-display-set-perspective display (not (chess-display-perspective display)))) + ((eq event 'move) + (chess-display-set-index + display (chess-game-index (chess-display-game display))) + (chess-display-update display)) + (t (chess-display-update display)))))) @@ -412,7 +408,7 @@ The key bindings available in this mode are: (let ((ply (chess-display-ply nil)) (color (chess-pos-side-to-move (chess-display-position nil))) (index (chess-display-index nil))) - (if (and index (= index 1)) + (if (and index (= index 0)) (setq chess-display-mode-line (format " %s START" (if color "White" "BLACK"))) (setq chess-display-mode-line @@ -425,7 +421,7 @@ The key bindings available in this mode are: (if ply (concat ". " (if color "... ") (chess-ply-to-algebraic - ply (chess-display-search-function nil))))))))) + ply nil (chess-display-search-function nil))))))))) (defsubst chess-display-active-p () "Return non-nil if the displayed chessboard reflects an active game. @@ -490,7 +486,9 @@ position within the game)." (if (chess-pos-side-to-move (chess-display-position nil)) "White" "Black") (1+ (/ (or (chess-display-index nil) 0) 2)))))) - (chess-display-move nil move)) + (chess-display-move nil (chess-algebraic-to-ply + (chess-display-position nil) move + (chess-display-search-function nil)))) (defun chess-display-set-current (dir) "Change the currently displayed board. @@ -649,7 +647,9 @@ to the end or beginning." (setq moves (delq nil moves)) (cond ((= (length moves) 1) - (chess-display-move nil (car moves)) + (chess-display-move nil (chess-algebraic-to-ply + (chess-display-position nil) (car moves) + (chess-display-search-function nil))) (setq chess-move-string nil chess-legal-moves nil chess-legal-moves-pos nil)) @@ -691,7 +691,9 @@ Clicking once on a piece selects it; then click on the target location." (let ((last-sel chess-display-last-selected)) ;; if they select the same square again, just deselect it (if (/= (point) (car last-sel)) - (chess-display-move nil (cadr last-sel) coord) + (chess-display-move + nil (chess-ply-create (chess-display-position nil) + (cadr last-sel) coord)) ;; put the board back to rights (chess-display-update nil)) (setq chess-display-last-selected nil)) diff --git a/chess-engine.el b/chess-engine.el index 678f5c3..40090ab 100644 --- a/chess-engine.el +++ b/chess-engine.el @@ -49,24 +49,28 @@ ,@body) ,@body))) +(defun chess-engine-do-move (ply) + (cond + ((and chess-engine-session + chess-engine-game) + (chess-session-event chess-engine-session event ply)) + (chess-engine-game + (chess-game-move chess-engine-game ply)) + (t + (apply 'chess-pos-move ply)))) + (defun chess-engine-default-handler (event &rest args) (cond ((eq event 'move) - (cond - ((chess-engine-session nil) - (apply 'chess-session-event (chess-engine-session nil) event args)) - ((chess-engine-game nil) - (chess-game-move (chess-engine-game nil) (car args))) - (t - (apply 'chess-pos-move (chess-ply-pos (car args)) - (chess-ply-changes (car args)))))))) + (chess-engine-do-move (car args))))) (defun chess-engine-create (module &optional user-handler session search-func) (let ((regexp-alist (intern-soft (concat (symbol-name module) "-regexp-alist"))) (handler (intern-soft (concat (symbol-name module) "-handler")))) (with-current-buffer (generate-new-buffer " *chess-engine*") - (setq chess-engine-regexp-alist (symbol-value regexp-alist) + (setq chess-engine-session session + chess-engine-regexp-alist (symbol-value regexp-alist) chess-engine-event-handler handler chess-engine-response-handler (or 'chess-engine-default-handler user-handler)) @@ -75,11 +79,15 @@ (error "Failed to start chess engine process")) (set-process-buffer proc (current-buffer)) (set-process-filter proc 'chess-engine-filter)) - (chess-engine-set-game nil (chess-game-create nil search-func)) + (if session + (let ((game (chess-session-data session 'current-game))) + (if game + (chess-engine-set-game nil game))) + (chess-engine-set-game nil (chess-game-create nil search-func))) (current-buffer)))) (defun chess-engine-destroy (engine) - (let ((buf (or display (current-buffer)))) + (let ((buf (or engine (current-buffer)))) (if (buffer-live-p buf) (kill-buffer buf)))) @@ -139,11 +147,7 @@ (defun chess-engine-move (engine ply) (chess-with-current-buffer engine - (cond - (chess-engine-game - (chess-game-move chess-engine-game ply)) - (chess-engine-position - (apply 'chess-pos-move ply))) + (chess-engine-do-move ply) (chess-engine-command engine 'move ply))) (defun chess-engine-pass (engine ply) @@ -160,20 +164,22 @@ ;; ;;;###autoload -(defun chess-engine (session buffer event &rest args) +(defun chess-engine (session engine event &rest args) "Handle any commands being sent to this instance of this module." (if (eq event 'initialize) - (chess-engine-create (car args) 'chess-engine-session-callback session) - (ignore - (cond - ((eq event 'shutdown) - (chess-engine-destroy engine)) - - ((eq event 'setup) - (chess-engine-set-game engine (car args))) - - ((eq event 'pass) - (chess-engine-pass engine)))))) + (chess-engine-create (car args) + 'chess-engine-session-callback session) + (with-current-buffer engine + (unless (apply chess-engine-event-handler event args) + (cond + ((eq event 'shutdown) + (chess-engine-destroy engine)) + + ((eq event 'setup) + (chess-engine-set-game engine (car args))) + + ((eq event 'pass) + (chess-engine-pass engine))))))) (defun chess-engine-filter (proc string) "Process filter for receiving text from a chess process." diff --git a/chess-game.el b/chess-game.el index b321bd1..7e28405 100644 --- a/chess-game.el +++ b/chess-game.el @@ -111,8 +111,7 @@ later using the various tag-related methods)." (unless (chess-game-tag game (car tag)) (chess-game-set-tag game (car tag) (cdr tag)))) (chess-game-add-ply game (chess-ply-create - (or (and position - (chess-pos-copy position)) + (or position (chess-pos-create)))) (if position (chess-game-set-tag game "FEN" (chess-pos-to-fen position))) diff --git a/chess-gnuchess.el b/chess-gnuchess.el index 4598020..09fe89e 100644 --- a/chess-gnuchess.el +++ b/chess-gnuchess.el @@ -13,7 +13,7 @@ (function (lambda () (funcall chess-engine-response-handler 'move - (chess-algebraic-to-ply position + (chess-algebraic-to-ply (chess-engine-position nil) (match-string 1)))))) (cons "Illegal move:" (function diff --git a/chess-ply.el b/chess-ply.el index 6b810d4..f5261b9 100644 --- a/chess-ply.el +++ b/chess-ply.el @@ -68,7 +68,9 @@ (chess-ply-changes ply))) (defsubst chess-ply-create (position &rest changes) - (cons position changes)) + ;; jww (2002-04-02): if changes is a castling maneuver, then + ;; annotate and extend the ply correctly + (cons (chess-pos-copy position) changes)) (defun chess-legal-plies (position &optional search-func) "Return a list of all legal plies in POSITION." @@ -126,25 +126,24 @@ a0 243 (defun chess-handler (session window-config event &rest args) "React to changes on the chess board in a global Emacs way." - (cond - ((eq event 'initialize) - (current-window-configuration)) - - ((eq event 'shutdown) - (ignore (set-window-configuration window-config))) + (if (eq event 'initialize) + (current-window-configuration) + (ignore + (cond + ((eq event 'shutdown) + (set-window-configuration window-config)) - ((eq event 'setup) - (ignore (chess-session-set-data session 'current-game (car args)))) + ((eq event 'setup) + (chess-session-set-data session 'current-game (car args))) - ((eq event 'pass) - (ignore - (let ((color (not (chess-session-data session 'my-color)))) - (message "You are now playing %s" (if color "White" "Black")) - (chess-session-set-data session 'my-color (not color))))) + ((eq event 'pass) + (let ((color (not (chess-session-data session 'my-color)))) + (message "You are now playing %s" (if color "White" "Black")) + (chess-session-set-data session 'my-color (not color)))) - ((eq event 'move) - (chess-game-move (chess-session-data session 'current-game) - (car args))))) + ((eq event 'move) + (chess-game-move (chess-session-data session 'current-game) + (car args))))))) (aset chess-puzzle-locations 3 puzzle-engine))))))) (provide 'chess) |