(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.
(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)
(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))))))
(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
(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.
(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.
(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))
(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))
,@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))
(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))))
(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)
;;
;;;###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."
(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)))
(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
(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."
(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)