Difference between revision 2 and current revision
Summary: Rollback to 2008-09-05 00:16 UTCNo diff available.
;;; chinese-chess-pvc.el --- a chinese chess computer player -*- coding: utf-8 -*- ;; Copyright 2007 Ye Wenbin ;; ;; Author: email@example.com ;; Version: $Id: chinese-chess-pvc.el,v 1.1 2007/02/15 08:10:35 ywb Exp ywb $ ;; Keywords: ;; X-URL: not distributed yet ;; This program 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 2, or (at your option) ;; any later version. ;; ;; This program 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 this program; if not, write to the Free Software ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: ;; This is NOT the computer player, it's just a front end of a ucci program. ;; You can get a ucci program from http://www.elephantbase.net/, then set ;; chinese-chess-pvc-program to the program. ;; Put this file into your load-path and the following into your ~/.emacs: ;; (require 'chinese-chess-pvc) ;;; Code: (provide 'chinese-chess-pvc) (eval-when-compile (require 'cl)) (require 'chinese-chess) (defvar chinese-chess-pvc-program "eleeye.exe") (defvar chinese-chess-pvc-engine nil) (defvar chinese-chess-pvc-buffer "*chinese-chess-pvc*") (defvar chinese-chess-old-filter nil) (defvar chinese-chess-computer-type 'black) (defvar chinese-chess-computer-time 3) (defvar chinese-chess-pvc-no-move nil) (defvar chinese-chess-pvc-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map chinese-chess-mode-map) (define-key map "B" 'chinese-chess-pvc-backward) (define-key map "T" 'chinese-chess-pvc-change-turn) (define-key map "Q" 'chinese-chess-pvc-quit) map)) (defun chinese-chess-pvc-change-turn () (interactive) (setq chinese-chess-computer-type (chinese-chess-other-type chinese-chess-computer-type)) (chinese-chess-pvc-move)) (defun chinese-chess-pvc-start-engine () (make-comint-in-buffer "chinese-chess" chinese-chess-pvc-buffer chinese-chess-pvc-program) (setq chinese-chess-pvc-engine (get-buffer-process chinese-chess-pvc-buffer) chinese-chess-old-filter (process-filter chinese-chess-pvc-engine)) (set-process-filter chinese-chess-pvc-engine 'chinese-chess-pvc-filter) (chinese-chess-pvc-send "ucci\n")) (defun chinese-chess-pvc-send (str) (comint-send-string chinese-chess-pvc-engine str)) (defun chinese-chess-pvc-filter (proc string) (and (functionp chinese-chess-old-filter) (funcall chinese-chess-old-filter proc string)) (dolist (line (split-string string "\n")) (cond ((string-match "^bestmove \\(\\sw+\\)" line) (let ((buf (chinese-chess-buffer))) (if (and buf (not chinese-chess-pvc-no-move)) (with-current-buffer buf (chinese-chess-move (match-string 1 line)))))) ((string-match "^nobestmove" line) ;; (chinese-chess-message "你太强了，我认输，请重新开始")))))) )))) (defun chinese-chess-pvc-buttons () (chinese-chess-put-buttons (cons "重新开始" 'chinese-chess-begin) (cons "停止思考" 'chinese-chess-pvc-stop) (cons "悔棋" 'chinese-chess-pvc-backward) (cons "交换" 'chinese-chess-pvc-change-turn))) (defun chinese-chess-pvc-mode () (interactive) (use-local-map chinese-chess-pvc-mode-map) (unless (and (processp chinese-chess-pvc-engine) (eq (process-status chinese-chess-pvc-engine) 'run)) (chinese-chess-pvc-start-engine)) (chinese-chess-pvc-buttons) (add-hook 'chinese-chess-begin-hook 'chinese-chess-pvc-mode) (add-hook 'chinese-chess-change-turn-hook 'chinese-chess-pvc-move) (chinese-chess-pvc-move)) (defun chinese-chess-pvc-quit () (interactive) (use-local-map chinese-chess-mode-map) (remove-hook 'chinese-chess-change-turn-hook 'chinese-chess-pvc-move) (remove-hook 'chinese-chess-begin-hook 'chinese-chess-pvc-mode) (chinese-chess-put-buttons (cons "重新开始" 'chinese-chess-begin) (cons "悔棋" 'chinese-chess-backward)) (with-current-buffer chinese-chess-pvc-buffer (chinese-chess-pvc-send "quit\n") (kill-buffer (current-buffer)))) (defun chinese-chess-pvc-move () (let ((buf (chinese-chess-buffer))) (when buf (with-current-buffer buf (when (eq chinese-chess-next-type chinese-chess-computer-type) (setq chinese-chess-pvc-no-move nil) (chinese-chess-pvc-send (format "position fen %s\ngo time %d\n" (chinese-chess-board-fen) chinese-chess-computer-time))))))) (defun chinese-chess-pvc-backward () (interactive) (let ((chinese-chess-change-turn-hook (remq 'chinese-chess-pvc-move chinese-chess-change-turn-hook))) (chinese-chess-pvc-stop) (setq chinese-chess-pvc-no-move t) (chinese-chess-backward))) (defun chinese-chess-pvc-stop () (interactive) (chinese-chess-pvc-send "stop\n")) (defun chinese-chess-pvc-banmoves (str) (interactive "sMove: ") (chinese-chess-pvc-send (concat "banmoves " str "\n"))) ;;; chinese-chess-pvc.el ends here