;;; chess-input.el --- Keyboard entry of algebraic notation, using shortcut notation

;; Copyright (C) 2002, 2005, 2014 Free Software Foundation, Inc.

;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: Mario Lang <mlang@delysid.org>
;; Keywords: games

;; This is free software; you can redistribute it and/or modify it under
;; the terms of the GNU General Public License as published by the Free
;; Software Foundation; either version 3, or (at your option) any later
;; version.
;;
;; This is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
;; for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This scheme was adapted from the way SCID (<http://scid.sourceforge.net/>),
;; by Shane Hudson, behaves.  It is based on standard algebraic notation.
;; You do not need to type all characters from the corresponding SAN of a move,
;; chess-input will automatically pick the move once it is unambiguous.
;;
;; Additionally, optional characters from SAN are treated as such.
;; You do not need to type x or =, although you can, if you prefer to.
;; For instance, "bxc8=N#" can be selected by typing `b c 8 n'.

;;; Code:

(require 'chess-algebraic)
(require 'chess-ply)
(require 'chess-pos)

(defvar chess-input-move-string "")
(defvar chess-input-moves-pos nil)
(defvar chess-input-moves nil)
(defvar chess-input-position-function nil)
(defvar chess-input-my-color-function nil)
(defvar chess-input-move-function nil)

(make-variable-buffer-local 'chess-input-move-string)
(make-variable-buffer-local 'chess-input-moves-pos)
(make-variable-buffer-local 'chess-input-moves)
(make-variable-buffer-local 'chess-input-position-function)
(make-variable-buffer-local 'chess-input-my-color-function)
(make-variable-buffer-local 'chess-input-move-function)

(defun chess-input-test-move (ply)
  "Return the given PLY if it matches the user's current input."
  (let* ((move (chess-ply-to-algebraic ply))
	 (i 0) (x 0) (l (length move))
	 (xl (length chess-input-move-string)))
    (unless (or (and (equal (downcase chess-input-move-string) "ok")
		     (string-match "\\`O-O[+#]?\\'" move))
		(and (equal (downcase chess-input-move-string) "oq")
		     (string-match "\\`O-O-O[+#]?\\'" move)))
      (while (and (< i l) (< x xl))
	(let ((move-char (aref move i))
	      (entry-char (aref chess-input-move-string x)))
	  (cond
	   ((or (and (= move-char ?x) (/= entry-char ?x))
		(and (= move-char ?=) (/= entry-char ?=)))
	    (setq i (1+ i)))
	   ((/= entry-char (if (< entry-char ?a) move-char (downcase move-char)))
	    (setq ply nil i l))
	   (t (setq i (1+ i) x (1+ x)))))))
    ply))

(defsubst chess-input-display-moves (&optional move-list)
  (if (> (length chess-input-move-string) 0)
      (message "[%s] %s" chess-input-move-string
	       (mapconcat #'chess-ply-to-algebraic
			  (or move-list
			      (delq nil (mapcar 'chess-input-test-move
						(cdr chess-input-moves))))
			  " "))))

(defun chess-input-shortcut-delete ()
  (interactive)
  (when (and chess-input-move-string
	     (stringp chess-input-move-string)
	     (> (length chess-input-move-string) 0))
    (setq chess-input-move-string
	  (substring chess-input-move-string 0 (1- (length chess-input-move-string))))
    (chess-input-display-moves)))

(defun chess-input-shortcut (&optional display-only)
  (interactive)
  (let* ((position (funcall chess-input-position-function))
	 (color (funcall chess-input-my-color-function))
	 char)
    (unless (memq last-command '(chess-input-shortcut
				 chess-input-shortcut-delete))
      (setq chess-input-move-string nil))
    (unless display-only
      (setq chess-input-move-string
	    (concat chess-input-move-string
		    (char-to-string last-command-event))))
    (unless (and chess-input-moves
		 (eq position chess-input-moves-pos)
		 (or (> (length chess-input-move-string) 1)
		     (eq (car chess-input-moves) last-command-event)))
      (setq char (if (eq (downcase last-command-event) ?o)
		     ?k
		   last-command-event))
      (if (or (memq (upcase char) '(?K ?Q ?N ?B ?R ?P))
	      (and (>= char ?a) (<= char ?h)))
	  (setq chess-input-moves-pos position
		chess-input-moves
		(cons
		 char
		 (sort
		  (if (eq char ?b)
		      (append (chess-legal-plies
			       position :piece (if color ?P ?p) :file 1)
			      (chess-legal-plies
			       position :piece (if color ?B ?b)))
		    (if (and (>= char ?a)
			     (<= char ?h))
			(chess-legal-plies position
					   :piece (if color ?P ?p)
					   :file (- char ?a))
		      (chess-legal-plies position
					 :piece (if color
						    (upcase char)
						  (downcase char)))))
		  (function
		   (lambda (left right)
		     (string-lessp (chess-ply-to-algebraic left)
				   (chess-ply-to-algebraic right))))))))))
  (let ((moves (delq nil (mapcar 'chess-input-test-move
				 (cdr chess-input-moves)))))
    (cond
     ((or (= (length moves) 1)
	  ;; if there is an exact match except for case, it must be an
	  ;; abiguity between a bishop and a b-pawn move.  In this
	  ;; case, always take the b-pawn move; to select the bishop
	  ;; move, use B to begin the keyboard shortcut
	  (and (= (length moves) 2)
	       (string= (downcase (chess-ply-to-algebraic (car moves)))
			(downcase (chess-ply-to-algebraic (cadr moves))))
	       (setq moves (cdr moves))))
      (funcall chess-input-move-function nil (car moves))
      (setq chess-input-move-string nil
	    chess-input-moves nil
	    chess-input-moves-pos nil))
     ((null moves)
      (chess-input-shortcut-delete))
     (t
      (chess-input-display-moves moves)))))

(provide 'chess-input)

;;; chess-input.el ends here
