code.delx.au - gnu-emacs-elpa/blob - chess-puzzle.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; A special kind of display that merely autosaves the game
   4 ;;
   5
   6 (require 'chess-game)
   7 (require 'chess-random)
   8 (require 'chess-database)
   9
  10 (defgroup chess-puzzle nil
  11   "A mode for playing games from a database of puzzles."
  12   :group 'chess)
  13
  14 (defcustom chess-puzzle-auto-next nil
  15   "If non-nil, move to the next puzzle once the position is won."
  16   :type 'boolean
  17   :group 'chess-puzzle)
  18
  19 (defvar chess-puzzle-indices nil)
  20 (defvar chess-puzzle-position nil)
  21
  22 (make-variable-buffer-local 'chess-puzzle-indices)
  23 (make-variable-buffer-local 'chess-puzzle-position)
  24
  25 (chess-message-catalog 'english
  26   '((bad-game-read . "Error reading game at position %d")
  27     (end-of-puzzles . "There are no more puzzles in this collection")))
  28
  29 ;;;###autoload
  30 (defun chess-puzzle (file &optional index)
  31   "Pick a random puzzle from FILE, and solve it against the default engine.
  32 The spacebar in the display buffer is bound to `chess-puzzle-next',
  33 making it easy to go on to the next puzzle once you've solved one."
  34   (interactive "fRead chess puzzles from: ")
  35   (let* ((database (chess-database-open file))
  36          (objects (and database (chess-session)))
  37          (engine (car objects))
  38          (display (cadr objects)))
  39     (when database
  40       (if engine
  41           (chess-engine-set-option engine 'resign nil))
  42       (with-current-buffer display
  43         (chess-game-set-data (chess-display-game nil) 'database database)
  44         (if chess-puzzle-auto-next
  45             (chess-game-add-hook (chess-display-game nil)
  46                                  'chess-puzzle-handler display))
  47         (define-key (current-local-map) [? ] 'chess-puzzle-next)
  48         (define-key (current-local-map) [??] 'chess-puzzle-show-solution)
  49         (let ((count (chess-database-count database)))
  50           (setq chess-puzzle-indices (make-vector count nil))
  51           (dotimes (i count)
  52             (aset chess-puzzle-indices i i))
  53           (random t)
  54           (chess-shuffle-vector chess-puzzle-indices)
  55           (setq chess-puzzle-position 0))
  56         (chess-game-run-hooks (chess-display-game display) 'disable-autosave)
  57         (chess-puzzle-next)))))
  58
  59 (defun chess-puzzle-next ()
  60   "Play the next puzzle in the collection, selected randomly."
  61   (interactive)
  62   (let* ((game (chess-display-game nil))
  63          (database (chess-game-data game 'database))
  64          (index chess-puzzle-position)
  65          next-game)
  66     (if (= index (length chess-puzzle-indices))
  67         (chess-message 'end-of-puzzles)
  68       ;; setup and load the next puzzle position
  69       (setq chess-puzzle-position (1+ chess-puzzle-position))
  70       (if (null (setq next-game
  71                       (chess-database-read database
  72                                            (aref chess-puzzle-indices index))))
  73           (chess-error 'bad-game-read (aref chess-puzzle-indices index))
  74         (chess-display-set-game nil next-game 0)
  75         (chess-game-set-data game 'my-color (chess-game-side-to-move game 0))
  76         (dolist (key '(database database-index database-count))
  77           (chess-game-set-data game key (chess-game-data next-game key)))
  78         (let ((chess-display-handling-event nil))
  79           (chess-game-run-hooks game 'orient))))))
  80
  81 (defun chess-puzzle-show-solution ()
  82   (interactive)
  83   (let ((game (chess-display-game nil)))
  84     (when game
  85       (let ((bm (chess-pos-epd (chess-game-pos game 0) 'bm))
  86             (pv (chess-pos-epd (chess-game-pos game 0) 'pv)))
  87         (when (or bm pv)
  88           (message "Best move %s %s%s"
  89                    (if (zerop (chess-game-index game)) "is" "would have been")
  90                    (chess-ply-to-string (car bm))
  91                    (if pv
  92                        (concat ", predicted variation "
  93                                (chess-var-to-algebraic pv))
  94                      "")))))))
  95
  96
  97 (defun chess-puzzle-handler (game display event &rest args)
  98   (if (and (eq event 'move)
  99            (chess-game-over-p game))
 100       (with-current-buffer display
 101         (chess-puzzle-next))))
 102
 103 (provide 'chess-puzzle)
 104
 105 ;;; chess-puzzle.el ends here