diff options
| -rw-r--r-- | chess-display.el | 125 | ||||
| -rw-r--r-- | chess-ics1.el | 48 | ||||
| -rw-r--r-- | chess-images.el | 75 | ||||
| -rw-r--r-- | chess-plain.el | 33 |
4 files changed, 194 insertions, 87 deletions
diff --git a/chess-display.el b/chess-display.el index c7cd835..9439649 100644 --- a/chess-display.el +++ b/chess-display.el @@ -53,8 +53,8 @@ (defvar chess-display-ply) (defvar chess-display-position) (defvar chess-display-perspective) -(defvar chess-display-draw-function nil) -(defvar chess-display-highlight-function nil) +(defvar chess-display-event-handler nil) +(defvar chess-display-no-popup nil) (defvar chess-display-edit-mode nil) (defvar chess-display-mode-line "") @@ -64,8 +64,8 @@ (make-variable-buffer-local 'chess-display-ply) (make-variable-buffer-local 'chess-display-position) (make-variable-buffer-local 'chess-display-perspective) -(make-variable-buffer-local 'chess-display-draw-function) -(make-variable-buffer-local 'chess-display-highlight-function) +(make-variable-buffer-local 'chess-display-event-handler) +(make-variable-buffer-local 'chess-display-no-popup) (make-variable-buffer-local 'chess-display-edit-mode) (make-variable-buffer-local 'chess-display-mode-line) @@ -79,18 +79,14 @@ (defun chess-display-create (style perspective) "Create a chess display, for displaying chess objects." (let* ((name (symbol-name style)) - (draw (intern-soft (concat name "-draw"))) - (highlight (intern-soft (concat name "-highlight"))) - (initialize (intern-soft (concat name "-initialize")))) - (unless draw - (error "There is no known chessboard display style '%s'" name)) + (handler (intern-soft (concat name "-handler")))) + (unless handler + (error "There is no such chessboard display style '%s'" name)) (with-current-buffer (generate-new-buffer "*Chessboard*") - (setq chess-display-draw-function draw - chess-display-highlight-function highlight - chess-display-perspective perspective) (chess-display-mode) - (if initialize - (funcall initialize)) + (funcall handler 'initialize) + (setq chess-display-event-handler handler + chess-display-perspective perspective) (current-buffer)))) (defsubst chess-display-destroy (display) @@ -125,7 +121,7 @@ that was passed in." chess-display-index nil chess-display-ply nil chess-display-position position) - (chess-display-update nil))) + (chess-display-update nil t))) (defun chess-display-position (display) "Return the position currently viewed." @@ -151,7 +147,7 @@ the modeline." chess-display-index nil chess-display-ply ply chess-display-position nil) - (chess-display-update display))) + (chess-display-update display t))) (defun chess-display-ply (display) (chess-with-current-buffer display @@ -175,7 +171,7 @@ variation that was passed in." chess-display-index (or index 0) chess-display-ply nil chess-display-position nil) - (chess-display-update nil))) + (chess-display-update nil t))) (defun chess-display-variation (display) (chess-with-current-buffer display @@ -197,7 +193,7 @@ modeline." chess-display-ply nil chess-display-position nil) (chess-game-add-hook game 'chess-display-event-handler display) - (chess-display-update nil))) + (chess-display-update nil t))) (defun chess-display-detach-game (display) "Set the display game. @@ -229,15 +225,15 @@ modeline." (chess-with-current-buffer display chess-display-index)) -(defun chess-display-update (display) - "This should be called if any object passed in has been changed. -That is, if you call `chess-display-set-position', and then later -change that position object, the display can be updated by calling -`chess-display-update'." +(defun chess-display-update (display &optional popup) + "Update the chessboard DISPLAY. POPUP too, if that arg is non-nil." (chess-with-current-buffer display - (if chess-display-draw-function - (funcall chess-display-draw-function)) - (chess-display-set-modeline))) + (funcall chess-display-event-handler 'draw + (chess-display-position nil) + (chess-display-perspective nil)) + (chess-display-set-modeline) + (if popup + (chess-display-popup nil)))) (defun chess-display-move (display ply) "Move a piece on DISPLAY, by applying the given PLY. @@ -267,12 +263,28 @@ The given highlighting MODE is used, or the default if the style you are displaying with doesn't support that mode. `selected' is a mode that is supported by most displays, and is the default mode." (chess-with-current-buffer display - (if chess-display-highlight-function - (let ((mode :selected)) - (dolist (arg args) - (if (symbolp arg) - (setq mode arg) - (funcall chess-display-highlight-function arg mode))))))) + (let ((mode :selected)) + (dolist (arg args) + (if (symbolp arg) + (setq mode arg) + (funcall chess-display-event-handler + 'highlight arg mode)))))) + +(defun chess-display-popup (display) + "Popup the given DISPLAY, so that it's visible to the user." + (chess-with-current-buffer display + (unless chess-display-no-popup + (funcall chess-display-event-handler 'popup)))) + +(defun chess-display-enable-popup (display) + "Popup the given DISPLAY, so that it's visible to the user." + (chess-with-current-buffer display + (setq chess-display-no-popup nil))) + +(defun chess-display-disable-popup (display) + "Popup the given DISPLAY, so that it's visible to the user." + (chess-with-current-buffer display + (setq chess-display-no-popup t))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -301,11 +313,15 @@ See `chess-display-type' for the different kinds of displays." ((memq event '(move game-over resign)) (chess-display-set-index nil (chess-game-index (chess-display-game nil))))) + (if (eq event 'resign) (message-box "%s resigns" (if (car args) "White" "Black"))) (unless (eq event 'shutdown) - (chess-display-update nil)))) + (chess-display-update nil)) + + (if (memq event '(pass move game-over resign)) + (chess-display-popup nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -359,9 +375,27 @@ See `chess-display-type' for the different kinds of displays." (t (define-key map [mouse-1] 'chess-display-mouse-select-piece) (define-key map [mouse-2] 'chess-display-mouse-select-piece))) + + (define-key map [menu-bar files] 'undefined) + (define-key map [menu-bar edit] 'undefined) + (define-key map [menu-bar options] 'undefined) + (define-key map [menu-bar buffer] 'undefined) + (define-key map [menu-bar tools] 'undefined) + (define-key map [menu-bar help-menu] 'undefined) + map) "The mode map used in a chessboard display buffer.") +(defvar chess-display-move-menu nil) +(unless chess-display-move-menu + (easy-menu-define + chess-display-move-menu chess-display-mode-map "" + '("History" + ["First" chess-display-move-first t] + ["Previous" chess-display-move-backward t] + ["Next" chess-display-move-forward t] + ["Last" chess-display-move-last t]))) + (defun chess-display-redraw () "Just redraw the current display." (interactive) @@ -697,6 +731,31 @@ to the end or beginning." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; +;; Default window and frame popup functions +;; + +(defun chess-display-popup-in-window () + "Popup the given DISPLAY, so that it's visible to the user." + (unless (get-buffer-window (current-buffer)) + (fit-window-to-buffer (display-buffer (current-buffer))))) + +(defun chess-display-popup-in-frame (display height width) + "Popup the given DISPLAY, so that it's visible to the user." + (let ((window (get-buffer-window (current-buffer) t))) + (if window + (let ((frame (window-frame window))) + (unless (eq frame (selected-frame)) + (select-frame-set-input-focus frame))) + (let ((params (list (cons 'name "*Chessboard*") + (cons 'height height) + (cons 'width width)))) + (if display + (push (cons 'display display) params)) + (select-frame (make-frame params)) + (set-window-dedicated-p (selected-window) t))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ;; Mousing around on the chess-display ;; diff --git a/chess-ics1.el b/chess-ics1.el index ef001f2..8a6e24d 100644 --- a/chess-ics1.el +++ b/chess-ics1.el @@ -6,26 +6,39 @@ (require 'chess-display) +(defgroup chess-ics1 nil + "The ICS1 style ASCII display." + :group 'chess-display) + +(defcustom chess-ics1-popup t + "If non-nil, popup the chessboard display whenever the opponent moves." + :type 'boolean + :group 'chess-ics1) + +(defcustom chess-ics1-popup-function 'chess-display-popup-in-window + "The function used to popup a chess-ics1 display." + :type 'function + :group 'chess-ics1) + ;;; Code: -(defun chess-debug-position (&optional position) - "This is a debugging function, and not meant from general use." - (interactive) - (let ((pos (or position (chess-engine-position nil)))) - (with-current-buffer (get-buffer-create "*scratch*") - (chess-ics1-draw pos)))) +(defun chess-ics1-handler (event &rest args) + (cond + ((eq event 'popup) + (if chess-ics1-popup + (funcall chess-ics1-popup-function))) + ((eq event 'draw) + (apply 'chess-ics1-draw args)) + ((eq event 'highlight) + (apply 'chess-ics1-highlight args)))) -(defun chess-ics1-draw (&optional disppos) +(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." - (if (null (get-buffer-window (current-buffer) t)) - (pop-to-buffer (current-buffer))) (let ((inhibit-redisplay t) (pos (point))) (erase-buffer) - (let* ((position (or disppos (chess-display-position nil))) - (inverted (and (null disppos) - (not (chess-display-perspective nil)))) + (let* ((inverted (not perspective)) (rank (if inverted 7 0)) (file (if inverted 7 0)) beg) @@ -59,8 +72,8 @@ PERSPECTIVE is t for white or nil for black." rank (if inverted (1- rank) (1+ rank)))) (insert " +---+---+---+---+---+---+---+---+\n") (if inverted - (insert " h g f e d c b a\n") - (insert " a b c d e f g h\n"))) + (insert " h g f e d c b a\n\n") + (insert " a b c d e f g h\n\n"))) (set-buffer-modified-p nil) (goto-char pos))) @@ -80,6 +93,13 @@ PERSPECTIVE is t for white or nil for black." (skip-chars-forward "^|") (put-text-property beg (point) 'face 'chess-display-highlight-face)))) +(defun chess-debug-position (&optional position) + "This is a debugging function, and not meant from general use." + (interactive) + (let ((pos (or position (chess-engine-position nil)))) + (with-current-buffer (get-buffer-create "*scratch*") + (chess-ics1-draw pos t)))) + (provide 'chess-ics1) ;;; chess-ics1.el ends here diff --git a/chess-images.el b/chess-images.el index d3ac937..ec07b79 100644 --- a/chess-images.el +++ b/chess-images.el @@ -44,8 +44,9 @@ (defcustom chess-images-directory (if (file-directory-p "/usr/share/games/xboard/pixmaps") "/usr/share/games/xboard/pixmaps" - (expand-file-name "pieces" (file-name-directory - (or load-file-name buffer-file-name)))) + (expand-file-name "pieces/xboard" + (file-name-directory + (or load-file-name buffer-file-name)))) "Directory containing the chess piece bitmap images. You are free to use your own chess pieces, of any size. By default, I assume you have xboard installed, or can go get the pixmaps that come @@ -132,8 +133,32 @@ that specialized squares may be used such as marble tiles, etc." :set 'chess-images-clear-image-cache :group 'chess-images) +(defcustom chess-images-popup t + "If non-nil, popup the chessboard display whenever the opponent moves." + :type 'boolean + :group 'chess-images) + +(defcustom chess-images-popup-function 'chess-images-popup + "The function used to popup a chess-images display. +The current-buffer is set to the display buffer when this function is +called." + :type 'function + :group 'chess-images) + ;;; Code: +(defun chess-images-handler (event &rest args) + (cond + ((eq event 'initialize) + (chess-images-initialize)) + ((eq event 'popup) + (if chess-images-popup + (funcall chess-images-popup-function))) + ((eq event 'draw) + (apply 'chess-images-draw args)) + ((eq event 'highlight) + (apply 'chess-images-highlight args)))) + (defconst chess-images-piece-names '((?r "rook" 0) (?n "knight" 1) @@ -161,36 +186,24 @@ that specialized squares may be used such as marble tiles, etc." (x-display-pixel-width display) (display-pixel-width)) 20))))) -(defun chess-images-popup-board () +(defun chess-images-popup () (unless chess-images-size (error "Cannot find any piece images; check `chess-images-directory'")) - - (let* ((size (float (+ (* (or chess-images-border-width 0) 8) - (* chess-images-size 8)))) - (max-char-height (ceiling (/ size (frame-char-height)))) - (max-char-width (ceiling (/ size (frame-char-width))))) - - (if chess-images-separate-frame - ;; make room for the possible title bar and other - ;; decorations - (let ((params (list (cons 'name "*Chessboard*") - (cons 'height (+ max-char-height 2)) - (cons 'width max-char-width)))) - (if (stringp chess-images-separate-frame) - (push (cons 'display chess-images-separate-frame) params)) - (select-frame (make-frame params)) - (set-window-dedicated-p (selected-window) t)) - (pop-to-buffer (current-buffer)) - (set-window-text-height (get-buffer-window (current-buffer)) - max-char-height)))) - -(defun chess-images-draw () + (if chess-images-separate-frame + (let* ((size (float (+ (* (or chess-images-border-width 0) 8) + (* chess-images-size 8)))) + (max-char-height (ceiling (/ size (frame-char-height)))) + (max-char-width (ceiling (/ size (frame-char-width)))) + (display (and (stringp chess-images-separate-frame) + chess-images-separate-frame))) + (chess-display-popup-in-frame display (+ max-char-height 2) + max-char-width)) + (chess-display-popup-in-window))) + +(defun chess-images-draw (position perspective) "Draw the current chess display position." - (if (null (get-buffer-window (current-buffer) t)) - (chess-images-popup-board)) (let* ((inhibit-redisplay t) - (board (chess-display-position nil)) - (inverted (not (chess-display-perspective nil))) + (inverted (not perspective)) (rank (if inverted 7 0)) (file (if inverted 7 0)) (pos (point)) new beg) @@ -201,7 +214,7 @@ that specialized squares may be used such as marble tiles, etc." (goto-char (point-min))) (while (if inverted (>= rank 0) (< rank 8)) (while (if inverted (>= file 0) (< file 8)) - (let* ((piece (chess-pos-piece board (chess-rf-to-index rank file))) + (let* ((piece (chess-pos-piece position (chess-rf-to-index rank file))) (image (if (= piece ? ) (aref chess-images-cache @@ -237,12 +250,10 @@ that specialized squares may be used such as marble tiles, etc." (goto-char pos))) (defun chess-images-highlight (index &optional mode) - "Highlight the piece on BOARD at INDEX, using the given MODE. + "Highlight the piece on the board at INDEX, using the given MODE. Common modes are: `selected' show that the piece has been selected for movement. `unselected' show that the piece has been unselected." - (if (null (get-buffer-window (current-buffer) t)) - (chess-images-popup-board)) (let* ((inverted (not (chess-display-perspective nil))) (pos (save-excursion (goto-char (point-min)) diff --git a/chess-plain.el b/chess-plain.el index 6b70e63..fdcf522 100644 --- a/chess-plain.el +++ b/chess-plain.el @@ -10,7 +10,7 @@ (defgroup chess-plain nil "A minimal, customizable ASCII display." - :group 'chess-ascii) + :group 'chess-display) (defcustom chess-plain-draw-border nil "*Non-nil if a border should be drawn (using `chess-plain-border-chars')." @@ -61,16 +61,35 @@ modify `chess-plain-piece-chars' to avoid real confusion.)" :type '(choice (const 'color) (const 'square-color))) ;; fails somehow -(defun chess-plain-draw () +(defcustom chess-plain-popup t + "If non-nil, popup the chessboard display whenever the opponent moves." + :type 'boolean + :group 'chess-plain) + +(defcustom chess-plain-popup-function 'chess-display-popup-in-window + "The function used to popup a chess-plain display." + :type 'function + :group 'chess-plain) + +;;; Code: + +(defun chess-plain-handler (event &rest args) + (cond + ((eq event 'popup) + (if chess-plain-popup + (funcall chess-plain-popup-function))) + ((eq event 'draw) + (apply 'chess-plain-draw args)) + ((eq event 'highlight) + (apply 'chess-plain-highlight args)))) + +(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." - (if (null (get-buffer-window (current-buffer) t)) - (pop-to-buffer (current-buffer))) (let ((inhibit-redisplay t) (pos (point))) (erase-buffer) - (let* ((position (chess-display-position nil)) - (inverted (not (chess-display-perspective nil))) + (let* ((inverted (not perspective)) (rank (if inverted 7 0)) (file (if inverted 7 0)) beg) @@ -117,8 +136,6 @@ PERSPECTIVE is t for white or nil for black." (goto-char pos)))) (defun chess-plain-highlight (index &optional mode) - (if (null (get-buffer-window (current-buffer) t)) - (pop-to-buffer (current-buffer))) (let ((inverted (not (chess-display-perspective nil)))) (save-excursion (beginning-of-line) |