diff options
| -rw-r--r-- | TODO | 6 | ||||
| -rw-r--r-- | chess-display.el | 46 | ||||
| -rw-r--r-- | chess-pos.el | 44 |
3 files changed, 60 insertions, 36 deletions
@@ -5,6 +5,12 @@ best for chess-images. I still need to figure out how best to handle cursor-type with that display. +- There is presently no way to start a new game! + +- Still need to test many areas: + + position editing + ---------------------------------------------------------------------- - Port image display code to XEmacs diff --git a/chess-display.el b/chess-display.el index e682861..f3c8662 100644 --- a/chess-display.el +++ b/chess-display.el @@ -366,29 +366,33 @@ The key bindings available in this mode are: (let ((color (chess-pos-side-to-move (chess-display-position nil))) (index (chess-display-index nil)) ply) - (if (and index (= index 0)) + (if (null index) (setq chess-display-mode-line - (format " %s START" (if color "White" "BLACK"))) - (cond - (chess-display-ply - (setq ply chess-display-ply)) - (chess-display-game - (setq ply (chess-game-ply chess-display-game (1- index)))) - (chess-display-variation - (setq ply (chess-var-ply chess-display-variation (1- index))))) - (if ply + (if color " White to move" " Black to move")) + (if (and index (= index 0)) (setq chess-display-mode-line - (concat - (if (chess-ply-final-p ply) - " FINISHED" - (concat " " (if color "White" "BLACK"))) - (if index - (concat " " (int-to-string - (if (> index 1) - (/ index 2) (1+ (/ index 2)))))) - (if ply - (concat ". " (if color "... ") - (or (chess-ply-to-algebraic ply) "???"))))))))) + (format " %s START" (if color "White" "Black"))) + (cond + (chess-display-ply + (setq ply chess-display-ply)) + (chess-display-game + (setq ply (chess-game-ply chess-display-game (1- index)))) + (chess-display-variation + (setq ply (chess-var-ply chess-display-variation (1- index))))) + (if ply + (setq chess-display-mode-line + (concat + (if (chess-ply-final-p ply) + " FINISHED" + (concat " " (if color "White" "Black"))) + (if index + (concat " " (int-to-string + (if (> index 1) + (/ index 2) (1+ (/ index 2)))))) + (if ply + (concat ". " (if color "... ") + (or (chess-ply-to-algebraic ply) + "???")))))))))) (defsubst chess-display-active-p () "Return non-nil if the displayed chessboard reflects an active game. diff --git a/chess-pos.el b/chess-pos.el index 46f61f2..6d1dae2 100644 --- a/chess-pos.el +++ b/chess-pos.el @@ -130,12 +130,13 @@ SIDE must be either ?q or ?k (case determines color)." (defsubst chess-pos-status (position) "Return whether the side to move is in a special state. -The symbols allowed are: `check', `checkmate', `stalemate'." +The symbols allowed are: `check', `checkmate', `stalemate'. +Also, EPD evaluation numbers/strings can be set here." (aref position 69)) -(defsubst chess-pos-set-status (position value) +(defsubst chess-pos-set-status (position &rest values) "Set whether the side to move is in a special state." - (aset position 69 value)) + (aset position 69 values)) (defsubst chess-pos-side-to-move (position) "Return the color whose move it is in POSITION." @@ -231,17 +232,21 @@ color will do." "Move a piece on the POSITION directly, using the indices FROM and TO. This function does not check any rules, it only makes sure you are not trying to move a blank square." - (while changes - (if (symbolp (car changes)) - (setq changes nil) - (let* ((from (car changes)) - (to (cadr changes)) - (piece (chess-pos-piece position from))) - (if (= piece ? ) - (error "Attempted piece move from blank square %s" from)) - (chess-pos-set-piece position from ? ) - (chess-pos-set-piece position to piece)) - (setq changes (cddr changes)))) + (assert changes) + (let ((ch changes)) + (while ch + (if (symbolp (car ch)) + (setq ch nil) + (let* ((from (car ch)) + (to (cadr ch)) + (piece (chess-pos-piece position from))) + (if (= piece ? ) + (error "Attempted piece move from blank square %s" from)) + (chess-pos-set-piece position from ? ) + (chess-pos-set-piece position to piece)) + (setq ch (cddr ch))))) + + ;; now fix up the position (let ((color (chess-pos-side-to-move position))) ;; once a piece is moved, en passant is no longer available @@ -249,7 +254,7 @@ trying to move a blank square." ;; if a king or rook moves, no more castling; also, if a pawn ;; jumps ahead two, mark it en-passantable - (let ((piece (downcase (car changes)))) + (let ((piece (downcase (chess-pos-piece position (car changes))))) (cond ((and (= piece ?k) (equal (car changes) @@ -280,6 +285,15 @@ trying to move a blank square." (if new-piece (chess-pos-set-piece position (cadr changes) new-piece))) + ;; did we leave the position in check, mate or stalemate? + (cond + ((memq :check changes) + (chess-pos-set-status position :check)) + ((memq :checkmate changes) + (chess-pos-set-status position :checkmate)) + ((memq :stalemate changes) + (chess-pos-set-status position :stalemate))) + ;; return the final position position)) |