├── .exclude ├── .gitignore ├── .gitmodules ├── AUTHORS ├── COPYING ├── Cask ├── ChangeLog ├── Makefile.am ├── NEWS ├── README ├── TODO ├── _pkg.el ├── acprep ├── autogen.sh ├── chess-ai.el ├── chess-algebraic.el ├── chess-announce.el ├── chess-autosave.el ├── chess-chat.el ├── chess-clock.el ├── chess-common.el ├── chess-crafty.el ├── chess-database.el ├── chess-display.el ├── chess-eco.el ├── chess-eco.pos ├── chess-engine.el ├── chess-epd.el ├── chess-fen.el ├── chess-file.el ├── chess-fruit.el ├── chess-game.el ├── chess-german.el ├── chess-glaurung.el ├── chess-gnuchess.el ├── chess-ics.el ├── chess-ics1.el ├── chess-ics2.el ├── chess-images.el ├── chess-input.el ├── chess-irc.el ├── chess-kibitz.el ├── chess-link.el ├── chess-log.el ├── chess-maint.el ├── chess-message.el ├── chess-module.el ├── chess-network.el ├── chess-none.el ├── chess-perft.el ├── chess-pgn.el ├── chess-phalanx.el ├── chess-plain.el ├── chess-ply.el ├── chess-polyglot.bin ├── chess-polyglot.el ├── chess-pos.el ├── chess-puzzle.el ├── chess-random.el ├── chess-scid.el ├── chess-sjeng.el ├── chess-sound.el ├── chess-stockfish.el ├── chess-test.el ├── chess-transport.el ├── chess-tutorial.el ├── chess-ucb.el ├── chess-uci.el ├── chess-var.el ├── chess.el ├── configure.ac ├── contrib ├── assets │ ├── 1001bwtc.pgn │ └── 1001wcsc.pgn ├── books │ ├── 19081923.zip │ ├── TRANS.TBL │ ├── amateur.zip │ ├── aoca.zip │ ├── attack.pgn │ ├── attack.zip │ ├── botv100a.zip │ ├── capafund.zip │ ├── chernev.zip │ ├── chesspr.zip │ ├── fisch60.zip │ ├── htryc.zip │ ├── magictal.zip │ ├── mysys.zip │ ├── tactics │ │ ├── 1001bwtc.pgn │ │ ├── 1001wcsc.pgn │ │ ├── Pgn.zip │ │ ├── Pgn13.zip │ │ ├── Pgn14.zip │ │ ├── Pgn15.zip │ │ ├── Pgn16.zip │ │ ├── Pgn17.zip │ │ ├── TRANS.TBL │ │ ├── Tactics.pgn │ │ ├── WinAtChess.pgn │ │ ├── bestmove.zip │ │ ├── motive.zip │ │ ├── qmoves.zip │ │ ├── skittles148.pdf │ │ ├── skittles150.pdf │ │ ├── t.zip │ │ ├── testpgn.zip │ │ └── tp.zip │ └── thinkgm.zip └── games │ ├── chess.xml │ ├── fics.sg3 │ ├── fics.si3 │ ├── fics.sn3 │ ├── games.sg3 │ ├── games.si3 │ ├── games.sn3 │ ├── informal.sem │ ├── informal.sg3 │ ├── informal.si3 │ ├── informal.sn3 │ ├── jwiegley-MarcD.pgn │ ├── jwiegley-UBend.pgn │ ├── saca.sg3 │ ├── saca.si3 │ ├── saca.sn3 │ ├── sample.sg3 │ ├── sample.si3 │ ├── sample.sn3 │ ├── uscf.sg3 │ ├── uscf.si3 │ └── uscf.sn3 ├── doc ├── EPD.txt ├── PGN.txt └── chess.texi ├── features ├── castling.feature ├── highlight.feature ├── ics.feature ├── premove.feature ├── step-definitions │ └── emacs-chess-steps.el └── support │ └── env.el ├── run-tests.sh ├── runtest.sh ├── runtests ├── test └── historic.pgn ├── wac.epd └── wcsac.epd /.exclude: -------------------------------------------------------------------------------- 1 | CVS 2 | ICS-interaction 3 | .exclude 4 | .cvsignore 5 | pieces 6 | sounds 7 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.aux 2 | *.cp 3 | *.cps 4 | *.elc 5 | *.fn 6 | *.fns 7 | *.ky 8 | *.log 9 | *.lrn 10 | *.pg 11 | *.tar.* 12 | *.texi 13 | *.toc 14 | *.tp 15 | *.vr 16 | *~ 17 | /.DS_Store 18 | /Makefile 19 | /Makefile.in 20 | /TAGS 21 | /aclocal.m4 22 | /auto-autoloads.el 23 | /autom4te.cache 24 | /chess-auto.el 25 | /chess-eco.fen 26 | /chess-test 27 | /chess.info 28 | /chess.texi 29 | /config.log 30 | /config.status 31 | /configure 32 | /doc/*.info 33 | /doc/*.pdf 34 | /doc/.dirstamp 35 | /elc-stamp 36 | /elisp-comp 37 | /install-sh 38 | /missing 39 | /test/largedb.* 40 | /texinfo.tex 41 | game.* 42 | log.* 43 | /test.out 44 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "pieces"] 2 | path = pieces 3 | url = git://github.com/jwiegley/emacs-chess.git 4 | [submodule "sounds"] 5 | path = sounds 6 | url = git://github.com/jwiegley/emacs-chess.git 7 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | Emacs Chess was born after I defeated my father for the very first time. 2 | 3 | You see, for the first 30 years of my life, never once had I one a game. A 4 | couple times against my mother, but Dad always seemed to fork my queen without 5 | mercy. 6 | 7 | So, I began to wonder, "Can anyone get better at chess?" I looked up some 8 | simple strategies on the Web -- such as building a strong center -- and lo and 9 | behold! I won my first game for the very reasons I had read about. 10 | 11 | Needless to say, the excitement of victory at last prompted me to buy a book 12 | on chess (I think it was Chess Analysis), and thus a love was born. 13 | 14 | That same week, early in 2001, chess.el, or Emacs Chess, was created. 15 | 16 | I was visited my father on a month long vacation at the time, at his home in 17 | upstate New Jersey, and I remember spending days and nights just hacking away 18 | on chess.el, and loving every minute of it. What you see in this directory is 19 | pure passion, an obsession that took me by storm for over two years until I 20 | moved to other things. I hope you enjoy using it as much as I did making it. 21 | 22 | John Wiegley 23 | 24 | 25 | Further: Around 2005, another player came on the scene: Mario Lang. Mario is 26 | unable to see, but Emacs Chess's design made it possible for me to integrate 27 | the display code with his braille viewer. He still plays chess with it to 28 | this day, as it is the only client that allows him to do so. He has also 29 | contributed time, the German language translations, a fair bit of code 30 | (chess-eco is his doing, among others), and even money to help me bring Emacs 31 | Chess to where it is today. Thank you, Mario! 32 | -------------------------------------------------------------------------------- /Cask: -------------------------------------------------------------------------------- 1 | ;;-*- Mode: Emacs-Lisp -*- 2 | ;; Cask is a package manager for emacs lisp projects. It runs 3 | ;; tests and can generate the _pkg.el file. 4 | ;; 5 | ;; See http://cask.readthedocs.org/en/latest/guide/dsl.html for more 6 | ;; information about Cask. 7 | ;; 8 | ;; cask pkg-file 9 | ;; 10 | ;; cask exec ecukes 11 | ;; cask install 12 | ;; 13 | ;; are particularly useful commands (update/install is for flycheck-cask). 14 | ;; 15 | ;;; Code: 16 | 17 | (source gnu) 18 | (source melpa) 19 | 20 | (package-file "chess.el") 21 | 22 | (development 23 | ;; optional dependencies (used in the tests) 24 | (depends-on "f") 25 | (depends-on "ert-runner") 26 | (depends-on "ecukes") 27 | (depends-on "espuds")) 28 | 29 | ;;; Cash ends here 30 | -------------------------------------------------------------------------------- /Makefile.am: -------------------------------------------------------------------------------- 1 | BUILT_SOURCES = chess-auto.el 2 | CLEANFILES = TAGS chess-auto.el auto-autoloads.el 3 | EXTRA_DIST = autogen.sh chess-auto.el.in chess-eco.pos chess-polyglot.bin doc/chess.pdf 4 | DISTCLEANFILES = chess-eco.fen doc/chess.info doc/chess.pdf $(TESTS) 5 | info_TEXINFOS = doc/chess.texi 6 | dist_lisp_DATA = _pkg.el chess-eco.fen 7 | 8 | dist_lisp_LISP = \ 9 | chess-pos.el \ 10 | chess.el \ 11 | chess-ai.el \ 12 | chess-algebraic.el \ 13 | chess-announce.el \ 14 | chess-auto.el \ 15 | chess-autosave.el \ 16 | chess-chat.el \ 17 | chess-clock.el \ 18 | chess-common.el \ 19 | chess-crafty.el \ 20 | chess-database.el \ 21 | chess-display.el \ 22 | chess-engine.el \ 23 | chess-epd.el \ 24 | chess-fen.el \ 25 | chess-file.el \ 26 | chess-fruit.el \ 27 | chess-game.el \ 28 | chess-german.el \ 29 | chess-glaurung.el \ 30 | chess-gnuchess.el \ 31 | chess-ics.el \ 32 | chess-ics1.el \ 33 | chess-ics2.el \ 34 | chess-images.el \ 35 | chess-input.el \ 36 | chess-irc.el \ 37 | chess-kibitz.el \ 38 | chess-link.el \ 39 | chess-log.el \ 40 | chess-message.el \ 41 | chess-module.el \ 42 | chess-network.el \ 43 | chess-none.el \ 44 | chess-perft.el \ 45 | chess-pgn.el \ 46 | chess-phalanx.el \ 47 | chess-plain.el \ 48 | chess-ply.el \ 49 | chess-polyglot.el \ 50 | chess-puzzle.el \ 51 | chess-random.el \ 52 | chess-scid.el \ 53 | chess-sjeng.el \ 54 | chess-sound.el \ 55 | chess-stockfish.el \ 56 | chess-test.el \ 57 | chess-transport.el \ 58 | chess-tutorial.el \ 59 | chess-ucb.el \ 60 | chess-uci.el \ 61 | chess-var.el \ 62 | chess-eco.el 63 | 64 | chess-auto.el: $(ELFILES) 65 | echo ";;; DO NOT MODIFY THIS FILE" > $(top_builddir)/chess-auto.el 66 | echo "(if (featurep 'chess-auto) (error \"Already loaded\"))" \ 67 | >> $(top_builddir)/chess-auto.el 68 | $(EMACS) -batch -L $(srcdir) -l chess-maint.el \ 69 | -f chess-generate-autoloads \ 70 | $(top_builddir)/chess-auto.el $(srcdir) 71 | echo "(provide 'chess-auto)" >> $(top_builddir)/chess-auto.el 72 | ln -f $(top_builddir)/chess-auto.el $(top_builddir)/auto-autoloads.el 73 | 74 | chess-eco.fen: chess-eco.pos chess-eco.el 75 | $(EMACS) --no-init-file --no-site-file -batch \ 76 | -L $(srcdir) -l chess-eco -f chess-generate-fen-table \ 77 | chess-eco.pos chess-eco.fen 78 | 79 | TESTS = chess-test 80 | DATABASE = $(shell test -r test/largedb.sg3 && echo test/largedb || echo test/historic.pgn) 81 | START = $(shell test -r test/largedb.sg3 && perl -e 'print int(rand(4000000)), "\n";' || echo 0) 82 | COUNT = 100000 83 | 84 | # Note: There are 4,209,433 games in test/largedb, if you download the files 85 | # from: 86 | # 87 | # ftp://ftp.newartisans.com/pub/chess/largedb.7z 88 | # 89 | # If you have a dual-core CPU (or more), you'll get the best performance by 90 | # running a separate Emacs for each core. Here's how I run all the tests on 91 | # my dual-core MacBook Pro: (Note, removing chess-test is just a precaution, 92 | # since the Makefile will not regenerate it if you aborted a previous test 93 | # run). 94 | # 95 | # chess1 $ rm -f chess-test; nice -n 20 make START=0 COUNT=2104715 check 96 | # chess2 $ rm -f chess-test; nice -n 20 make START=2104715 COUNT=0 check 97 | # 98 | # I run both of these using `screen', with a vertical split so I can watch 99 | # them both running. I type C-a H in each screen window before starting, so 100 | # that all the output is logged to a file I can examine afterward. 101 | # 102 | # Note that these tests can take days to run. My MacBook Pro gets around 103 | # 2,000 plies per second. If you're a Lisp hacker and want to improve the 104 | # speed of that, the slowness is pretty much all in `chess-search-position', 105 | # in the file chess-pos.el. 106 | 107 | chess-test: 108 | echo "$(EMACS) -batch -L $(srcdir) -l chess-test.el -f chess-test '$(DATABASE)' $(START) $(COUNT); rm -f $(top_builddir)/chess-test" > $@ 109 | chmod u+x $@ 110 | 111 | .PHONY: test test24 112 | test: $(TESTS) $(ELCFILES) 113 | $(top_builddir)/chess-test 114 | cask exec ecukes --no-win 115 | cask exec ecukes --win 116 | 117 | test24: $(ELCFILES) 118 | EMACS="$$(evm bin emacs-24.5)" cask exec ecukes 119 | 120 | test/twic.pgn: 121 | (set -e; f=$$(pwd)/$@; tmp_dir=`mktemp -d`; \ 122 | cd $$tmp_dir; \ 123 | lftp -c "open http://www.theweekinchess.com/zips/; mget twic*g.zip"; \ 124 | for zip in *.zip; do unzip $$zip; done; \ 125 | cat *.pgn > $$f; rm *.pgn) 126 | 127 | check-twic: test/twic.pgn 128 | $(MAKE) DATABASE=$< START=0 COUNT=0 check 129 | 130 | perft: 131 | $(EMACS) -batch -L $(srcdir) -l chess-perft -f ert-run-tests-batch 132 | 133 | TAGS: $(dist_lisp_LISP) 134 | @etags $(dist_lisp_LISP) 135 | @echo TAGS rebuilt. 136 | 137 | # Makefile.am ends here 138 | -------------------------------------------------------------------------------- /NEWS: -------------------------------------------------------------------------------- 1 | -*- mode: text; outline-layout: (1 :) -*- 2 | 3 | This is the NEWS file for Emacs Chess, a chess client and analysis library 4 | written in Emacs Lisp. 5 | 6 | Please note that proper documentation is still on its way. 7 | 8 | * Release 2.0: 9 | 10 | Began keeping this file. See doc/chess.info for information about Emacs 11 | Chess. 12 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | Welcome to chess.el, a client and library for playing Chess from 2 | Emacs. 3 | 4 | chess.el is an Emacs Lisp library and several clients on top of the 5 | underlying library functionality for performing various activities 6 | related to the game of chess. 7 | 8 | You can play against an external chess program such as gnuchess, 9 | crafty, phalanx or sjeng. All of them are publically available, and 10 | chess.el will automatically detect which one you have installed, 11 | provided they have standard executable program names, and are in a 12 | located in a directory which is part of the PATH. See the 13 | customisable variable `chess-default-engine'. 14 | 15 | You can also play against another human or computer over the internet 16 | (through a direct Emacs-to-Emacs connection, or on one of the Internet 17 | Chess Servers like freechess.org or chessclub.com), or even against a 18 | very simple chess thinking module implemented in pure Emacs Lisp. 19 | 20 | chess.el also provides a mode for editing Portable Game Notation (PGN) 21 | files. 22 | 23 | To improve your chessaility, you might also like to have a look at 24 | chess-puzzle, which allows you to solve chess puzzle collections (in 25 | PGN or EPD format) against one of the engines you have installed. 26 | 27 | 28 | These days, chess.el is maintained as part of GNU ELPA, the Emacs Lisp 29 | Package Repository. Use `M-x list-packages RET' to show information about, 30 | and install, the current version. 31 | 32 | -------------------------------------------------------------------------------- /_pkg.el: -------------------------------------------------------------------------------- 1 | ;;;###autoload 2 | (if (fboundp 'package-provide) 3 | (package-provide 'chess 4 | :version 2.0 5 | :type 'regular)) 6 | -------------------------------------------------------------------------------- /acprep: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | sh autogen.sh && ./configure && make 3 | -------------------------------------------------------------------------------- /chess-algebraic.el: -------------------------------------------------------------------------------- 1 | ;;; chess-algebraic.el --- Convert a ply to/from standard chess algebraic notation 2 | 3 | ;; Copyright (C) 2002, 2004, 2008, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Commentary: 23 | 24 | ;; A thing to deal with in chess is algebraic move notation, such as 25 | ;; Nxf3+. (I leave description of this notation to better manuals 26 | ;; than this). This notation is a shorthand way of representing where 27 | ;; a piece is moving from and to, by specifying the piece is involved, 28 | ;; where it's going, and whether or not a capture or check is 29 | ;; involved. 30 | ;; 31 | ;; You can convert from algebraic notation to a ply (one pair in most 32 | ;; cases, but two for a castle) using the following function (NOTE: 33 | ;; POSITION determines which side is on move (by calling 34 | ;; `chess-pos-side-to-move')): 35 | ;; 36 | ;; (chess-algebraic-to-ply POSITION STRING) 37 | ;; 38 | ;; The function also checks if a move is legal, and will raise an 39 | ;; error if not. 40 | ;; 41 | ;; To convert from a ply to algebraic notation, use: 42 | ;; 43 | ;; (chess-ply-to-algebraic PLY) 44 | ;; 45 | ;; Castling is determined by the movement of both a king and a rook. 46 | ;; 47 | ;; Lastly, there is a regexp for quickly checking if a string is in 48 | ;; algebraic notation or not, or searching out algebraic strings in a 49 | ;; buffer: 50 | ;; 51 | ;; chess-algebraic-regexp 52 | 53 | ;;; Code: 54 | 55 | (eval-when-compile (require 'cl-lib)) 56 | 57 | (require 'chess-message) 58 | (require 'chess-ply) 59 | (require 'chess-pos) 60 | 61 | (defconst chess-algebraic-regexp 62 | (rx (group (or (or "O-O" "O-O-O") 63 | (and (optional (group (char ?N ?B ?R ?Q ?K))) 64 | (optional (char ?/)) 65 | (group (optional (char "a-h")) (optional (char "1-8"))) 66 | (optional (group (char ?- ?x))) 67 | (group (char "a-h") (char "1-8")) 68 | (optional 69 | (group (optional ?=) 70 | (group (char ?N ?B ?R ?Q ?n ?b ?r ?q))))))) 71 | (optional (group (char ?+ ?#)))) 72 | "A regular expression that matches all possible algebraic moves. 73 | This regexp handles both long and short form.") 74 | 75 | (defconst chess-algebraic-regexp-entire (concat chess-algebraic-regexp "$")) 76 | 77 | (defconst chess-algebraic-regexp-ws (concat chess-algebraic-regexp "\\s-")) 78 | 79 | (chess-message-catalog 'english 80 | '((clarify-piece . "Clarify piece to move by rank or file") 81 | (could-not-clarify . "Could not determine which piece to use") 82 | (could-not-diff . "Could not differentiate piece") 83 | (no-candidates . "There are no candidate moves for '%s'") 84 | (at-move-string . "At algebraic move '%s': %s"))) 85 | 86 | (defun chess-algebraic-to-ply (position move &optional trust) 87 | "Convert the algebraic notation MOVE for POSITION to a ply." 88 | (cl-assert (vectorp position)) 89 | (cl-assert (stringp move)) 90 | (let ((case-fold-search nil)) 91 | (when (string-match chess-algebraic-regexp-entire move) 92 | (let ((color (chess-pos-side-to-move position)) 93 | (mate (match-string 8 move)) 94 | (piece (aref move 0)) 95 | changes long-style) 96 | (if (eq piece ?O) 97 | (setq changes (chess-ply-castling-changes 98 | position (= (length (match-string 1 move)) 5))) 99 | (let ((promotion (match-string 7 move))) 100 | (setq 101 | changes 102 | (let ((source (match-string 3 move)) 103 | (target (chess-coord-to-index (match-string 5 move)))) 104 | (if (and source (= (length source) 2)) 105 | (prog1 106 | (list (chess-coord-to-index source) target) 107 | (setq long-style t)) 108 | (if (= (length source) 0) 109 | (setq source nil) 110 | (setq source (aref source 0))) 111 | (let (candidates which) 112 | (unless (< piece ?a) 113 | (setq source piece piece ?P)) 114 | ;; we must use our knowledge of how pieces can 115 | ;; move, to determine which piece is meant by the 116 | ;; piece indicator 117 | (if (setq candidates 118 | (chess-search-position position target 119 | (if color piece 120 | (downcase piece)) 121 | nil t)) 122 | (if (= (length candidates) 1) 123 | (list (car candidates) target) 124 | (if (null source) 125 | (chess-error 'clarify-piece) 126 | (nconc changes (list :which source)) 127 | (while candidates 128 | (if (if (>= source ?a) 129 | (eq (chess-index-file (car candidates)) 130 | (- source ?a)) 131 | (eq (chess-index-rank (car candidates)) 132 | (- 7 (- source ?1)))) 133 | (setq which (car candidates) 134 | candidates nil) 135 | (setq candidates (cdr candidates)))) 136 | (if (null which) 137 | (chess-error 'could-not-clarify) 138 | (list which target)))) 139 | (chess-error 'no-candidates move)))))) 140 | (when promotion 141 | (nconc changes (list :promote (upcase (aref promotion 0))))))) 142 | 143 | (when changes 144 | (if (and trust mate) 145 | (nconc changes (list (if (equal mate "#") 146 | :checkmate 147 | :check)))) 148 | (unless long-style 149 | (nconc changes (list :san move))) 150 | 151 | (condition-case err 152 | (apply 'chess-ply-create position trust changes) 153 | (error 154 | (chess-error 'at-move-string 155 | move (error-message-string err))))))))) 156 | 157 | (defun chess-ply--move-text (ply long) 158 | (or 159 | (and (chess-ply-keyword ply :castle) "O-O") 160 | (and (chess-ply-keyword ply :long-castle) "O-O-O") 161 | (let* ((pos (chess-ply-pos ply)) 162 | (from (chess-ply-source ply)) 163 | (to (chess-ply-target ply)) 164 | (from-piece (chess-pos-piece pos from)) 165 | (rank 0) (file 0) 166 | (from-rank (chess-index-rank from)) 167 | (from-file (chess-index-file from)) 168 | (differentiator (chess-ply-keyword ply :which))) 169 | (unless differentiator 170 | (let ((candidates (chess-search-position pos to from-piece nil t))) 171 | (when (> (length candidates) 1) 172 | (dolist (candidate candidates) 173 | (when (= (chess-index-rank candidate) from-rank) 174 | (setq rank (1+ rank))) 175 | (when (= (chess-index-file candidate) from-file) 176 | (setq file (1+ file)))) 177 | (cond 178 | ((= file 1) 179 | (setq differentiator (+ from-file ?a))) 180 | ((= rank 1) 181 | (setq differentiator (+ (- 7 from-rank) ?1))) 182 | (t (chess-error 'could-not-diff))) 183 | (chess-ply-set-keyword ply :which differentiator)))) 184 | (concat 185 | (unless (= (upcase from-piece) ?P) 186 | (char-to-string (upcase from-piece))) 187 | (cond 188 | (long (chess-index-to-coord from)) 189 | (differentiator (char-to-string differentiator)) 190 | ((and (not long) (= (upcase from-piece) ?P) 191 | (/= from-file (chess-index-file to))) 192 | (char-to-string (+ from-file ?a)))) 193 | (if (or (/= ? (chess-pos-piece pos to)) 194 | (chess-ply-keyword ply :en-passant)) 195 | "x" (if long "-")) 196 | (chess-index-to-coord to) 197 | (let ((promote (chess-ply-keyword ply :promote))) 198 | (if promote 199 | (concat "=" (char-to-string promote)))) 200 | (if (chess-ply-keyword ply :check) "+" 201 | (if (chess-ply-keyword ply :checkmate) "#")))))) 202 | 203 | (defun chess-ply-to-algebraic (ply &optional long) 204 | "Convert the given PLY to algebraic notation. 205 | If LONG is non-nil, render the move into long notation." 206 | (cl-assert (listp ply)) 207 | (or (and (not long) (chess-ply-keyword ply :san)) 208 | (and (null (chess-ply-source ply)) "") 209 | (let ((move (chess-ply--move-text ply long))) 210 | (unless long (chess-ply-set-keyword ply :san move)) 211 | move))) 212 | 213 | (provide 'chess-algebraic) 214 | 215 | ;;; chess-algebraic.el ends here 216 | -------------------------------------------------------------------------------- /chess-announce.el: -------------------------------------------------------------------------------- 1 | ;;; chess-announce.el --- Scheme to verbally announce chess moves 2 | 3 | ;; Copyright (C) 2002, 2004 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Code: 23 | 24 | (require 'chess-game) 25 | (require 'chess-message) 26 | 27 | (chess-message-catalog 'english 28 | '((queen . "queen") 29 | (king . "king") 30 | (bishop . "bishop") 31 | (knight . "knight") 32 | (rook . "rook") 33 | (pawn . "pawn") 34 | (short-castle . "short castle") 35 | (long-castle . "long castle") 36 | (check . "check") 37 | (checkmate . "checkmate") 38 | (stalemate . "stalemate") 39 | (en-passant . "on possont") 40 | (promote . "promote to %s") 41 | (piece-moves . "%s to %s") 42 | (piece-takes . "%s takes %s at %s"))) 43 | 44 | (defvar chess-announce-names 45 | '((?q . queen) 46 | (?k . king) 47 | (?b . bishop) 48 | (?n . knight) 49 | (?r . rook) 50 | (?p . pawn))) 51 | 52 | (autoload 'festival-start-process "festival") 53 | (autoload 'festival-kill-process "festival") 54 | 55 | (defvar chess-announce-functions 56 | (if (and (executable-find "festival") 57 | (not (featurep 'emacspeak))) 58 | (if (fboundp 'festival-say-string) 59 | '(festival-start-process festival-say-string festival-kill-process) 60 | '(ignore chess-announce-festival ignore)) 61 | '(ignore message ignore)) 62 | "These three functions are used to for announcing moves. 63 | The first is called one start of the announcer. The second is called 64 | with the string to announce each time. The third is called to 65 | shutdown the announcer process, if necessary.") 66 | 67 | (defsubst chess-piece-name (char) 68 | (chess-string (cdr (assq (downcase char) 69 | chess-announce-names)))) 70 | 71 | (defun chess-announce-handler (game event &rest args) 72 | (cond 73 | ((eq event 'initialize) 74 | (funcall (nth 0 chess-announce-functions)) 75 | t) 76 | 77 | ((eq event 'destroy) 78 | (funcall (nth 2 chess-announce-functions))) 79 | 80 | ((eq event 'move) 81 | (let* ((ply (chess-game-ply game (1- (chess-game-index game)))) 82 | (pos (chess-ply-pos ply))) 83 | (unless (eq (chess-game-data game 'my-color) 84 | (chess-pos-side-to-move pos)) 85 | (let* ((source (chess-ply-source ply)) 86 | (target (chess-ply-target ply)) 87 | (s-piece (and source (chess-pos-piece pos source))) 88 | (t-piece (and target (chess-pos-piece pos target))) 89 | (which (chess-ply-keyword ply :which)) 90 | text) 91 | (if which 92 | (setq which (char-to-string which))) 93 | (cond 94 | ((chess-ply-keyword ply :castle) 95 | (setq text (chess-string 'short-castle))) 96 | ((chess-ply-keyword ply :long-castle) 97 | (setq text (chess-string 'long-castle))) 98 | ((and s-piece t-piece (= t-piece ? ) target) 99 | (setq text 100 | (concat which 101 | (chess-string 'piece-moves 102 | (chess-piece-name s-piece) 103 | (chess-index-to-coord target))))) 104 | ((and s-piece t-piece target) 105 | (setq text 106 | (concat which 107 | (chess-string 'piece-takes 108 | (chess-piece-name s-piece) 109 | (chess-piece-name t-piece) 110 | (chess-index-to-coord target)))))) 111 | 112 | (let ((promotion (chess-ply-keyword ply :promote))) 113 | (if promotion 114 | (setq text 115 | (concat text ", " 116 | (chess-string 'promote 117 | (chess-piece-name promotion)))))) 118 | (if (chess-ply-keyword ply :en-passant) 119 | (setq text (concat text ", " (chess-string 'en-passant)))) 120 | (if (chess-ply-keyword ply :check) 121 | (setq text (concat text ", " (chess-string 'check)))) 122 | (if (chess-ply-keyword ply :checkmate) 123 | (setq text (concat text ", " (chess-string 'checkmate)))) 124 | (if (chess-ply-keyword ply :stalemate) 125 | (setq text (concat text ", " (chess-string 'stalemate)))) 126 | 127 | (funcall (nth 1 chess-announce-functions) text))))) 128 | ((eq event 'kibitz) 129 | (funcall (nth 1 chess-announce-functions) (car args))))) 130 | 131 | (defun chess-announce-festival (text) 132 | "Announce the given text using festival. 133 | This is less efficient than festival.el, which should be installed if 134 | possible. Debian installs it automatically when you apt-get install 135 | festival." 136 | (let ((proc (start-process "announce" nil "/usr/bin/festival" "--tts"))) 137 | (when (and proc (eq (process-status proc) 'run)) 138 | (process-send-string proc (concat text "\n")) 139 | (process-send-eof proc)))) 140 | 141 | (provide 'chess-announce) 142 | 143 | ;;; chess-announce.el ends here 144 | -------------------------------------------------------------------------------- /chess-autosave.el: -------------------------------------------------------------------------------- 1 | ;;; chess-autosave.el --- A special kind of display that merely autosaves the game 2 | ;; 3 | ;; Copyright (C) 2002, 2004, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games 8 | 9 | ;; This is free software; you can redistribute it and/or modify it under 10 | ;; the terms of the GNU General Public License as published by the Free 11 | ;; Software Foundation; either version 3, or (at your option) any later 12 | ;; version. 13 | ;; 14 | ;; This is distributed in the hope that it will be useful, but WITHOUT 15 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 16 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 17 | ;; for more details. 18 | ;; 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with GNU Emacs. If not, see . 21 | 22 | ;;; Code: 23 | 24 | (require 'chess-game) 25 | (require 'chess-database) 26 | (require 'chess-message) 27 | (require 'chess-module) 28 | 29 | (defgroup chess-autosave nil 30 | "A special display that autosaves after each move." 31 | :group 'chess-display) 32 | 33 | (defcustom chess-autosave-file "~/.chess-save" 34 | "Filename in which to autosave chess games." 35 | :type '(choice file (const :tag "Do not auto-save" nil)) 36 | :group 'chess-autosave) 37 | 38 | (defcustom chess-autosave-database nil 39 | "If non-nil, a chess database file in which completed games are appended. 40 | If a function, it will receive a game object and is expected to do the 41 | work of saving the game object to whichever database(s) it chooses. 42 | Whether it closes those databases or caches them for later use is up 43 | to the user." 44 | :type '(choice (const :tag "Do not save completed games" nil) 45 | file function) 46 | :group 'chess-autosave) 47 | 48 | (chess-message-catalog 'english 49 | '((chess-read-autosave . "There is a chess autosave file, read it? ") 50 | (chess-delete-autosave . "Delete the autosave file? ") 51 | (chess-disable-autosave . "Disable autosaving for this game? ") 52 | (autosave-available . "There is an autosave file; type ~ after connecting to read it"))) 53 | 54 | (defun chess-autosave-handler (game event &rest _args) 55 | (cond 56 | ((eq event 'initialize) 57 | (kill-buffer (current-buffer)) 58 | (set-buffer (find-file-noselect chess-autosave-file t)) 59 | (buffer-disable-undo) 60 | (setq buffer-auto-save-file-name nil) 61 | t) 62 | 63 | ((eq event 'check-autosave) 64 | (if (file-readable-p chess-autosave-file) 65 | (if (y-or-n-p (chess-string 'chess-read-autosave)) 66 | (progn 67 | (chess-autosave-read game chess-autosave-file) 68 | (erase-buffer)) 69 | (if (y-or-n-p (chess-string 'chess-delete-autosave)) 70 | (erase-buffer) 71 | (if (y-or-n-p (chess-string 'chess-disable-autosave)) 72 | (chess-autosave-handler game 'disable-autosave)))))) 73 | 74 | ((eq event 'announce-autosave) 75 | (if (file-readable-p chess-autosave-file) 76 | (chess-message 'autosave-available))) 77 | 78 | ((eq event 'disable-autosave) 79 | (chess-autosave-handler game 'destroy) 80 | (chess-module-destroy (current-buffer))) 81 | 82 | ((eq event 'post-move) 83 | (if (not (chess-game-over-p game)) 84 | (chess-autosave-write game chess-autosave-file) 85 | (erase-buffer) 86 | (if chess-autosave-database 87 | (if (functionp chess-autosave-database) 88 | (funcall chess-autosave-database game) 89 | (let ((database (chess-database-open chess-autosave-database))) 90 | (when database 91 | (chess-database-write database game) 92 | (chess-database-close database))))))) 93 | 94 | ((eq event 'destroy) 95 | (set-buffer-modified-p nil) 96 | (if (file-exists-p chess-autosave-file) 97 | (delete-file chess-autosave-file))))) 98 | 99 | (defun chess-prin1-ply (ply) 100 | (insert "([") 101 | (let ((pos (chess-ply-pos ply))) 102 | (dotimes (i 74) 103 | (prin1 (aref pos i) (current-buffer)) 104 | (insert ? ))) 105 | (insert "nil]") 106 | (let ((changes (chess-ply-changes ply))) 107 | (if changes 108 | (insert ? )) 109 | (while changes 110 | (if (eq (car changes) :next-pos) 111 | (setq changes (cddr changes)) 112 | (prin1 (car changes) (current-buffer)) 113 | (if (cdr changes) 114 | (insert ? )) 115 | (setq changes (cdr changes))))) 116 | (insert ")")) 117 | 118 | (defun chess-autosave-write (game file) 119 | "Write a chess GAME to FILE as raw Lisp." ;FIXME: `file' is not used! 120 | (let ((index (chess-game-index game))) 121 | (if (or (= 1 index) (and (bobp) (eobp))) 122 | (progn 123 | (erase-buffer) 124 | (prin1 (chess-game-tags game) 125 | (current-buffer)) 126 | (insert "\n(\n;;## ply 0\n")) 127 | (goto-char (point-max)) 128 | (re-search-backward "^;;## ply") 129 | (forward-line) 130 | (delete-region (point) (point-max))) 131 | (chess-prin1-ply (chess-game-ply game (1- index))) 132 | (insert (format "\n;;## ply %d\n" index)) 133 | (chess-prin1-ply (chess-game-ply game)) 134 | (insert ")\n") 135 | (basic-save-buffer) 136 | (message nil))) 137 | 138 | (defun chess-autosave-read (game file) 139 | "Read a chess game as raw Lisp from FILE." ;FIXME: `file' is not used! 140 | (goto-char (point-min)) 141 | (chess-game-set-tags game (read (current-buffer))) 142 | (let* ((plies (read (current-buffer))) 143 | (game-plies plies) 144 | prev-ply) 145 | (while plies 146 | (if prev-ply 147 | (chess-pos-set-preceding-ply (chess-ply-pos (car plies)) 148 | prev-ply)) 149 | (if (cdr plies) 150 | (chess-ply-set-keyword (car plies) :next-pos 151 | (chess-ply-pos (cadr plies)))) 152 | (setq prev-ply (car plies) 153 | plies (cdr plies))) 154 | 155 | (chess-game-set-plies game game-plies))) 156 | 157 | (provide 'chess-autosave) 158 | 159 | ;;; chess-autosave.el ends here 160 | -------------------------------------------------------------------------------- /chess-chat.el: -------------------------------------------------------------------------------- 1 | ;;; chess-chat.el --- Very much like kibitzing, but not saved. 2 | 3 | ;; Copyright (C) 2002, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games 8 | 9 | ;; This is free software; you can redistribute it and/or modify it under 10 | ;; the terms of the GNU General Public License as published by the Free 11 | ;; Software Foundation; either version 3, or (at your option) any later 12 | ;; version. 13 | ;; 14 | ;; This is distributed in the hope that it will be useful, but WITHOUT 15 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 16 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 17 | ;; for more details. 18 | ;; 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with GNU Emacs. If not, see . 21 | 22 | ;;; Commentary: 23 | 24 | ;; RET is used to send each chat line. 25 | 26 | ;;; Code: 27 | 28 | (require 'chess-module) 29 | 30 | (defvar chess-chat-input-last nil) 31 | 32 | (make-variable-buffer-local 'chess-chat-input-last) 33 | 34 | (define-derived-mode chess-chat-mode text-mode "Chat" 35 | "A mode for editing chess annotations." 36 | (set-buffer-modified-p nil) 37 | (setq chess-chat-input-last (copy-marker (point-max) t)) 38 | (let ((map (current-local-map))) 39 | (define-key map [return] 'chess-chat-send) 40 | (define-key map [(control ?m)] 'chess-chat-send))) 41 | 42 | (defun chess-chat-send () 43 | (interactive) 44 | (chess-game-run-hooks chess-module-game 'chat 45 | (buffer-substring-no-properties 46 | chess-chat-input-last (point-max))) 47 | (set-marker chess-chat-input-last (point-max)) 48 | (set-buffer-modified-p nil)) 49 | 50 | (defun chess-chat-handler (_game event &rest args) 51 | (cond 52 | ((eq event 'initialize) 53 | (kill-buffer (current-buffer)) 54 | (set-buffer (generate-new-buffer "*Chat*")) 55 | (chess-chat-mode) 56 | t) 57 | 58 | ((eq event 'switch-to-chat) 59 | (switch-to-buffer-other-window (current-buffer))) 60 | 61 | ((eq event 'chat) 62 | (chess-chat-handler 'switch-to-chat) 63 | (save-excursion 64 | (goto-char chess-chat-input-last) 65 | (insert (car args)))))) 66 | 67 | (provide 'chess-chat) 68 | 69 | ;;; chess-chat.el ends here 70 | -------------------------------------------------------------------------------- /chess-clock.el: -------------------------------------------------------------------------------- 1 | ;;; chess-clock.el --- Implements a chess clock 2 | 3 | ;; Copyright (C) 2002, 2004, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Code: 23 | 24 | (require 'chess-game) 25 | (require 'chess-module) 26 | 27 | (defvar chess-clock-last-time nil) 28 | (defvar chess-clock-timer nil) 29 | 30 | (make-variable-buffer-local 'chess-clock-last-time) 31 | (make-variable-buffer-local 'chess-clock-timer) 32 | 33 | (defsubst chess-clock-add-seconds (time seconds) 34 | "To TIME, add SECONDS. Return result as a time value." 35 | (let* ((secint (truncate seconds)) 36 | (hi (/ secint 65536)) 37 | (lo (% secint 65536)) 38 | (calc (+ (cadr time) lo))) 39 | (if (< calc 65536) 40 | (list (+ (car time) hi) calc) 41 | (list (+ (car time) (1+ hi)) (% calc 65536))))) 42 | 43 | (defsubst chess-clock-time-to-seconds (time) 44 | "Convert TIME to a floating point number." 45 | (+ (* (car time) 65536.0) 46 | (cadr time) 47 | (/ (or (car (cdr (cdr time))) 0) 1000000.0))) 48 | 49 | (defsubst chess-clock-time-diff (t1 t2) 50 | "Return the difference in seconds between T1 and T2." 51 | (- (chess-clock-time-to-seconds t1) 52 | (chess-clock-time-to-seconds t2))) 53 | 54 | (defun chess-clock-handler (game event &rest args) 55 | (cond 56 | ((eq event 'initialize) 57 | (unless (or (null (car args)) 58 | (chess-game-data game 'white-remaining)) 59 | (chess-game-set-data game 'white-remaining (float (car args))) 60 | (chess-game-set-data game 'black-remaining (float (car args)))) 61 | t) 62 | 63 | ((eq event 'post-undo) 64 | (let* ((last-ply (car (last (chess-game-plies game) 2))) 65 | (white (chess-ply-keyword last-ply :white)) 66 | (black (chess-ply-keyword last-ply :black))) 67 | (when (and white black) 68 | (chess-game-set-data game 'white-remaining white) 69 | (chess-game-set-data game 'black-remaining black)))) 70 | 71 | ((eq event 'move) 72 | (let ((white (chess-game-data game 'white-remaining)) 73 | (black (chess-game-data game 'black-remaining))) 74 | (when (and white black 75 | (chess-game-data game 'active) 76 | (> (chess-game-index game) 0)) 77 | (unless chess-clock-timer 78 | (setq chess-clock-timer 79 | (run-with-timer 0 1 'chess-clock-tick-tock 80 | (current-buffer)))) 81 | (let ((last-ply (car (last (chess-game-plies game) 2)))) 82 | (chess-ply-set-keyword last-ply :white white) 83 | (chess-ply-set-keyword last-ply :black black)))) 84 | 85 | (if (chess-game-over-p game) 86 | (chess-clock-handler game 'destroy))) 87 | 88 | ((eq event 'set-data) 89 | (if (and (eq (car args) 'active) 90 | (not (chess-game-data game 'active))) 91 | (chess-clock-handler game 'destroy))) 92 | 93 | ((eq event 'destroy) 94 | (if chess-clock-timer 95 | (cancel-timer chess-clock-timer) 96 | (setq chess-clock-timer nil))))) 97 | 98 | (defvar chess-clock-tick-tocking nil) 99 | 100 | (defun chess-clock-tick-tock (module) 101 | (unless chess-clock-tick-tocking 102 | (let ((chess-clock-tick-tocking t)) 103 | (with-current-buffer module 104 | (let ((last-time chess-clock-last-time) 105 | (chess-game-inhibit-events t) 106 | counter) 107 | (setq chess-clock-last-time (current-time)) 108 | (when (and last-time 109 | (> (chess-game-index chess-module-game) 0) 110 | (not (chess-game-status chess-module-game))) 111 | (if (chess-pos-side-to-move (chess-game-pos chess-module-game)) 112 | (setq counter 'white-remaining) 113 | (setq counter 'black-remaining)) 114 | (chess-game-set-data 115 | chess-module-game counter 116 | (- (chess-game-data chess-module-game counter) 117 | (chess-clock-time-diff chess-clock-last-time last-time)))))) 118 | (force-mode-line-update)))) 119 | 120 | (provide 'chess-clock) 121 | 122 | ;;; chess-clock.el ends here 123 | -------------------------------------------------------------------------------- /chess-common.el: -------------------------------------------------------------------------------- 1 | ;;; chess-common.el --- Handler functions common to xboard based engine protocols 2 | 3 | ;; Copyright (C) 2002, 2004, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Commentary: 23 | 24 | ;; Define handler functions that are common to the (relatively) 25 | ;; standard chess engine communication protocol: 26 | ;; 27 | ;; http://www.tim-mann.org/xboard/engine-intf.html 28 | ;; 29 | ;; See chess-uci.el for code shared by engines based on the 30 | ;; Universal Chess Interface instead. 31 | 32 | ;;; Code: 33 | 34 | (require 'chess) 35 | (require 'chess-engine) 36 | (require 'chess-message) 37 | 38 | (defvar chess-common-engine-name nil) 39 | (defvar chess-common-temp-files nil) 40 | (make-variable-buffer-local 'chess-common-engine-name) 41 | (make-variable-buffer-local 'chess-common-temp-files) 42 | 43 | (defmacro chess-with-temp-file (&rest body) 44 | `(let ((file (make-temp-file "chess"))) 45 | (with-temp-file file 46 | ,@body) 47 | (push file chess-common-temp-files) 48 | file)) 49 | 50 | (put 'chess-with-temp-file 'lisp-indent-function 1) 51 | 52 | (chess-message-catalog 'english 53 | '((starting-engine . "Starting chess program '%s'...") 54 | (starting-engine-done . "Starting chess program '%s'...done") 55 | (could-not-find-engine . "Cannot find %s executable; check `%s'") 56 | (draw-offer-declined . "Your draw offer was declined") 57 | (illegal-move . "Illegal move") 58 | (not-yet-implemented . "This feature is not yet implemented"))) 59 | 60 | (defun chess-common-handler (game event &rest args) 61 | "Initialize the network chess engine." 62 | (cond 63 | ((eq event 'initialize) 64 | (let* ((name (car args)) 65 | (path (intern (concat "chess-" name "-path"))) 66 | (args (intern (concat "chess-" name "-args"))) 67 | proc) 68 | (chess-message 'starting-engine name) 69 | (unless (and (boundp path) (symbol-value path)) 70 | (chess-error 'could-not-find-engine name path)) 71 | (setq proc (start-process (concat "chess-" name) 72 | (current-buffer) (symbol-value path) 73 | (if (and (boundp args) (symbol-value args)) 74 | (substitute-in-file-name (symbol-value args)) ""))) 75 | (chess-message 'starting-engine-done name) 76 | proc)) 77 | 78 | ((eq event 'ready) 79 | (chess-game-set-data game 'active t) 80 | (chess-game-run-hooks game 'check-autosave)) 81 | 82 | ((eq event 'destroy) 83 | (let ((proc (get-buffer-process (current-buffer)))) 84 | (if (and (processp proc) 85 | (memq (process-status proc) '(run open))) 86 | (chess-engine-send nil "quit\n"))) 87 | 88 | (dolist (file chess-common-temp-files) 89 | (if (file-exists-p file) 90 | (delete-file file))) 91 | (setq chess-common-temp-files nil)) 92 | 93 | ((eq event 'pass) 94 | (chess-engine-send nil "go\n")) 95 | 96 | ((eq event 'draw) 97 | (chess-message 'draw-offer-declined)) 98 | 99 | ((eq event 'resign) 100 | (chess-engine-send nil "resign\n") 101 | (chess-game-set-data game 'active nil)) 102 | 103 | ((eq event 'new) 104 | (chess-engine-send nil "new\n") 105 | (chess-engine-set-position nil)) 106 | 107 | ((eq event 'force) 108 | (chess-error 'not-yet-implemented)) 109 | 110 | ((eq event 'undo) 111 | (dotimes (i (car args)) 112 | (chess-engine-send nil "undo\n")) 113 | (if (= 1 (mod (car args) 2)) 114 | (chess-engine-send nil "go\n")) 115 | 116 | ;; prevent us from handling the `undo' event which this triggers 117 | (let ((chess-engine-handling-event t)) 118 | (chess-game-undo game (car args)))) 119 | 120 | ((eq event 'flag-fell) 121 | (chess-game-set-data game 'active nil) 122 | (let ((chess-game-inhibit-events t)) 123 | (chess-game-end game :flag-fell))) 124 | 125 | ((eq event 'move) 126 | (when (= 1 (chess-game-index game)) 127 | (chess-game-set-tag game "White" chess-full-name) 128 | (chess-game-set-tag game "Black" chess-engine-opponent-name)) 129 | 130 | (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) 131 | "\n")) 132 | (if (chess-game-over-p game) 133 | (chess-game-set-data game 'active nil))))) 134 | 135 | (provide 'chess-common) 136 | 137 | ;;; chess-common.el ends here 138 | -------------------------------------------------------------------------------- /chess-crafty.el: -------------------------------------------------------------------------------- 1 | ;;; chess-crafty.el --- Play against crafty! 2 | 3 | ;; Copyright (C) 2002, 2004, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games, processes 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Code: 23 | 24 | (require 'chess-common) 25 | (require 'chess-fen) 26 | (require 'chess-var) 27 | 28 | (defgroup chess-crafty nil 29 | "The publicly available chess engine 'crafty'." 30 | :group 'chess-engine) 31 | 32 | (defcustom chess-crafty-path (or (executable-find "crafty") 33 | (executable-find "wcrafty")) 34 | "*The path to the crafty executable." 35 | :type 'file 36 | :group 'chess-crafty) 37 | 38 | (defcustom chess-crafty-args "bookpath=$HOME/.crafty logpath=$HOME/.crafty tbpath=$HOME/.crafty" 39 | "Command line arguments to crafty executable" 40 | :type 'string 41 | :group 'chess-crafty) 42 | 43 | (defvar chess-crafty-evaluation nil) 44 | 45 | (make-variable-buffer-local 'chess-crafty-evaluation) 46 | 47 | (defvar chess-crafty-analyzing-p nil 48 | "Non-nil if Crafty is currently in analysis mode.") 49 | 50 | (make-variable-buffer-local 'chess-crafty-analyzing-p) 51 | 52 | (defvar chess-crafty-regexp-alist 53 | (list 54 | (cons (concat "move\\s-+\\(" chess-algebraic-regexp "\\)\\s-*$") 55 | (function 56 | (lambda () 57 | (funcall chess-engine-response-handler 'move 58 | (chess-engine-convert-algebraic (match-string 1) t))))) 59 | (cons "total evaluation\\.+\\s-+\\([-+0-9.]+\\)" 60 | (function 61 | (lambda () 62 | (setq chess-crafty-evaluation 63 | (string-to-number (match-string 1)))))) 64 | (cons "tellicsnoalias kibitz Hello from\\s-+\\(.+\\)$" 65 | (function 66 | (lambda () 67 | (setq chess-engine-opponent-name (match-string 1))))) 68 | (cons "Analyze Mode: type \"exit\" to terminate.$" 69 | (function 70 | (lambda () 71 | (setq chess-crafty-analyzing-p t)))) 72 | (cons (concat "\t ?\\([0-9]+\\)\\s-+" 73 | "\\(-?[0-9]+\\)\\s-+\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+" 74 | "\\(" ;; The list of moves 75 | "\\( *[1-9][0-9]*\\. " 76 | "\\(\\.\\.\\.\\|" chess-algebraic-regexp "\\)" 77 | "\\( " chess-algebraic-regexp "\\)?\\)+\\)$") 78 | (function 79 | (lambda () 80 | (when chess-crafty-analyzing-p 81 | ;; We can translate this information to EPD opcodes 82 | (let ((depth (read (match-string 1))) 83 | (centipawn (read (match-string 2))) 84 | (pos (chess-engine-position nil))) 85 | (chess-pos-set-epd pos 'acd depth) 86 | (chess-pos-set-epd pos 'ce centipawn) 87 | (chess-pos-set-epd 88 | pos 89 | 'pv ; predicted variation 90 | (save-restriction 91 | (narrow-to-region (match-beginning 5) (match-end 5)) 92 | (let ((var (chess-var-create pos))) 93 | (goto-char (point-min)) 94 | (while (not (eobp)) 95 | (cond 96 | ((looking-at "[1-9][0-9]*\\.[ .]*") 97 | (goto-char (match-end 0))) 98 | ((looking-at chess-algebraic-regexp) 99 | (goto-char (match-end 0)) 100 | (let ((ply (chess-algebraic-to-ply 101 | (chess-var-pos var) 102 | (match-string-no-properties 0)))) 103 | (unless ply 104 | (error "unable to read move '%s'" 105 | (match-string-no-properties 0))) 106 | (chess-var-move var ply)))) 107 | (skip-chars-forward " ")) 108 | var)))))))) 109 | (cons "analyze complete.$" 110 | (function 111 | (lambda () 112 | (setq chess-crafty-analyzing-p nil)))) 113 | (cons "{\\(Black\\|White\\) resigns}" 114 | (function 115 | (lambda () 116 | (funcall chess-engine-response-handler 'resign)))) 117 | (cons "\\(Illegal move\\|unrecognized/illegal command\\):\\s-*\\(.*\\)" 118 | (function 119 | (lambda () 120 | (error (match-string 1))))) 121 | (cons "command not legal now" 122 | (function 123 | (lambda () 124 | (error (match-string 0))))))) 125 | 126 | (defun chess-crafty-handler (game event &rest args) 127 | (unless chess-engine-handling-event 128 | (cond 129 | ((eq event 'initialize) 130 | (let ((proc (chess-common-handler game 'initialize "crafty"))) 131 | (when (and proc (processp proc) 132 | (eq (process-status proc) 'run)) 133 | (process-send-string proc "xboard\n") 134 | (setq chess-engine-process proc) 135 | t))) 136 | 137 | ((eq event 'setup-pos) 138 | (chess-engine-send nil (format "setboard %s\n" 139 | (chess-pos-to-fen (car args))))) 140 | 141 | ((eq event 'evaluate) 142 | (setq chess-crafty-evaluation nil) 143 | (chess-engine-send nil "display general\nscore\ndisplay nogeneral\n") 144 | (let ((limit 50)) 145 | (while (and (null chess-crafty-evaluation) 146 | (> (setq limit (1- limit)) 0)) 147 | (sit-for 0.1 t)) 148 | chess-crafty-evaluation)) 149 | 150 | ((eq event 'analyze) 151 | (if (car args) 152 | (chess-engine-send nil "analyze\npost\n") 153 | (chess-engine-send nil "exit\nnopost\n"))) 154 | 155 | ((eq event 'setup-game) 156 | (let ((file (chess-with-temp-file 157 | (insert (chess-game-to-string (car args)) ?\n)))) 158 | (chess-engine-send nil (format "read %s\n" file)))) 159 | 160 | ((eq event 'set-option) 161 | (cond 162 | ((eq (car args) 'resign) 163 | (if (cadr args) 164 | (chess-engine-send nil "resign 9\n") 165 | (chess-engine-send nil "resign -1\n"))) 166 | ((eq (car args) 'ponder) 167 | (if (cadr args) 168 | (chess-engine-send nil "hard\n") 169 | (chess-engine-send nil "easy\n"))) 170 | ((eq (car args) 'search-depth) 171 | (cl-assert (and (integerp (cadr args)) (>= (cadr args) 0))) 172 | (chess-engine-send nil (format "sd %d\n" (cadr args)))) 173 | ((eq (car args) 'search-time) 174 | (cl-assert (and (integerp (cadr args)) (> (cadr args) 0))) 175 | (chess-engine-send nil (format "st %d\n" (cadr args)))))) 176 | 177 | (t 178 | (if (and (eq event 'undo) 179 | (= 1 (mod (car args) 2))) 180 | (error "Cannot undo until after crafty moves")) 181 | 182 | (apply 'chess-common-handler game event args))))) 183 | 184 | (provide 'chess-crafty) 185 | 186 | ;;; chess-crafty.el ends here 187 | -------------------------------------------------------------------------------- /chess-database.el: -------------------------------------------------------------------------------- 1 | ;;; chess-database.el --- Basic code for manipulating game databases 2 | 3 | ;; Copyright (C) 2002, 2004, 2008 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: data, games 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Code: 23 | 24 | (require 'chess-message) 25 | 26 | (defgroup chess-database nil 27 | "Generic interface to chess database modules." 28 | :group 'chess) 29 | 30 | (defcustom chess-database-modules '(chess-scid chess-file) 31 | "List of database modules to try when `chess-database-open' is called." 32 | :type '(repeat (symbol :tag "Module")) 33 | :group 'chess-database) 34 | 35 | (defvar chess-database-handler nil) 36 | 37 | (make-variable-buffer-local 'chess-database-handler) 38 | 39 | (chess-message-catalog 'english 40 | '((no-such-database . "There is no such chess database module '%s'"))) 41 | 42 | (defun chess-database-do-open (module file) 43 | "Returns the opened database object, or nil." 44 | (let* ((name (symbol-name module)) 45 | (handler (intern-soft (concat name "-handler")))) 46 | (unless handler 47 | (chess-error 'no-such-database name)) 48 | (let ((buffer (funcall handler 'open file))) 49 | (when buffer 50 | (with-current-buffer buffer 51 | (setq chess-database-handler handler) 52 | (add-hook 'kill-buffer-hook 'chess-database-close nil t) 53 | (add-hook 'after-revert-hook 'chess-database-rescan nil t) 54 | (current-buffer)))))) 55 | 56 | (defun chess-database-open (file &optional module) 57 | "Returns the opened database object, or nil." 58 | (if module 59 | (chess-database-do-open module file) 60 | (let (result) 61 | (setq module chess-database-modules) 62 | (while module 63 | (if (and (require (car module) nil t) 64 | (setq result (chess-database-do-open (car module) file))) 65 | (setq module nil) 66 | (setq module (cdr module)))) 67 | result))) 68 | 69 | (defsubst chess-database-command (database event &rest args) 70 | (with-current-buffer database 71 | (apply chess-database-handler event args))) 72 | 73 | (defun chess-database-close (&optional database) 74 | (let ((buf (or database (current-buffer)))) 75 | (when (buffer-live-p buf) 76 | (with-current-buffer buf 77 | (remove-hook 'kill-buffer-hook 'chess-database-close t)) 78 | (chess-database-save buf) 79 | (chess-database-command buf 'close) 80 | (kill-buffer buf)))) 81 | 82 | (defun chess-database-save (database) 83 | (chess-database-command database 'save)) 84 | 85 | (defun chess-database-rescan (&optional database) 86 | (chess-database-command database 'rescan)) 87 | 88 | (defun chess-database-count (database) 89 | (chess-database-command database 'count)) 90 | 91 | (defun chess-database-read-only-p (database) 92 | "Return non-nil if DATABASE is read only." 93 | (chess-database-command database 'read-only-p)) 94 | 95 | (defun chess-database-filename (database) 96 | "Return the filename of an already opened DATABASE." 97 | (chess-database-command database 'filename)) 98 | 99 | (defun chess-database-read (database index) 100 | "Return from DATABASE the chess game object at INDEX." 101 | (chess-database-command database 'read index)) 102 | 103 | (defun chess-database-write (database game) 104 | (chess-database-command database 'write game)) 105 | 106 | (defun chess-database-replace (database game &optional index) 107 | (chess-database-command database 'replace game index)) 108 | 109 | (defun chess-database-query (database &rest terms) 110 | "Run a query on DATABASE. 111 | TERMS is partly dependent on the chess-database module in use. 112 | chess-scid: 113 | tree-search GAME: Perform a tree search on the last position of GAME." 114 | (apply 'chess-database-command database 'query terms)) 115 | 116 | (provide 'chess-database) 117 | 118 | ;;; chess-database.el ends here 119 | -------------------------------------------------------------------------------- /chess-eco.el: -------------------------------------------------------------------------------- 1 | ;;; chess-eco.el --- Chess opening classification 2 | 3 | ;; Copyright (C) 2004, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: Mario Lang 6 | ;; Keywords: games 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Code: 22 | 23 | (require 'chess-game) 24 | (require 'chess-ply) 25 | (require 'chess-pos) 26 | (require 'chess-fen) 27 | 28 | (defgroup chess-eco nil 29 | "Chess opening classification module." 30 | :group 'chess) 31 | 32 | (defcustom chess-eco-max-index 36 33 | "*Index at which to stop chess opening announcements." 34 | :group 'chess-eco 35 | :type 'integer) 36 | 37 | (defvar chess-eco-hash-table 38 | (when (file-exists-p 39 | (expand-file-name "chess-eco.fen" 40 | (file-name-directory load-file-name))) 41 | (with-temp-buffer 42 | (message "Emacs Chess: Loading ECO openings database...") 43 | (insert-file-contents "chess-eco.fen") 44 | (prog1 45 | (let ((fen-data (read (current-buffer))) 46 | (hash (make-hash-table :size 10541 :test 'equal))) 47 | (mapc (lambda (entry) 48 | (puthash (car entry) (cdr entry) hash)) 49 | fen-data) 50 | hash) 51 | (message "Emacs Chess: Loading ECO openings database...done")))) 52 | "List of well known chess opening positions.") 53 | 54 | (defun chess-generate-fen-table () 55 | "Generate chess-eco.fen from the ply lists in chess-eco.pos." 56 | (require 'chess-pos) 57 | (require 'chess-ply) 58 | (require 'chess-fen) 59 | (require 'chess-algebraic) 60 | (with-temp-buffer 61 | (insert-file-contents (car command-line-args-left)) 62 | (let ((fen-buffer (get-buffer-create "chess-eco.fen")) 63 | (pos-data (read (current-buffer)))) 64 | (with-current-buffer fen-buffer 65 | (print (mapcar 66 | (lambda (entry) 67 | (message "Preparing opening %s (%s)" 68 | (car entry) (cadr entry)) 69 | (let ((pos (chess-pos-create))) 70 | (mapc (lambda (move) 71 | (apply 'chess-pos-move 72 | pos (chess-ply-changes 73 | (chess-algebraic-to-ply pos move)))) 74 | (split-string (car (cddr entry)) " " t)) 75 | (list (chess-pos-to-fen pos) (cadr entry) (car entry)))) 76 | pos-data) 77 | (current-buffer)) 78 | (write-file (cadr command-line-args-left)))))) 79 | 80 | (defvar chess-eco-last-opening nil) 81 | (make-variable-buffer-local 'chess-eco-last-opening) 82 | 83 | (defun chess-eco-classify (game) 84 | (when chess-eco-hash-table 85 | (let ((plies (chess-game-plies game)) 86 | found) 87 | (while plies 88 | (let* ((fen (chess-pos-to-fen (chess-ply-pos (car plies)))) 89 | (entry (gethash fen chess-eco-hash-table))) 90 | (if entry 91 | (setq found entry)) 92 | (setq plies (cdr plies)))) 93 | found))) 94 | 95 | (chess-message-catalog 'english 96 | '((announce-opening . "%s (ECO code %s)"))) 97 | 98 | (defun chess-eco-handler (game event &rest _args) 99 | "Handle for the `chess-eco' module. 100 | If you add `chess-eco' to `chess-default-modules', this handler will 101 | try to figure out if the current position of a game does match a 102 | well known chess opening position." 103 | (cond 104 | ((eq event 'initialize)) 105 | 106 | ((eq event 'post-move) 107 | (when (= (chess-game-index game) 1) 108 | (setq chess-eco-last-opening nil)) 109 | (when (< (chess-game-index game) chess-eco-max-index) 110 | (let ((info (chess-eco-classify game))) 111 | (when (and info (not (eq info chess-eco-last-opening))) 112 | (setq chess-eco-last-opening info) 113 | (chess-message 'announce-opening (car info) (cadr info)))))))) 114 | 115 | (defun chess-eco-parse-scid-eco () 116 | (let ((result (list t))) 117 | (while (re-search-forward 118 | "\\([A-E][0-9][0-9]\\([a-z][0-9]?\\)?\\) \"\\([^\"]+\\)\"[\n ]+\\([^*]*\\|\n\\) +\\*" 119 | nil t) 120 | (nconc 121 | result 122 | (list 123 | (list (match-string 1) 124 | (match-string 3) 125 | (mapconcat (lambda (move) 126 | (if (string-match 127 | (concat 128 | "\\(" chess-algebraic-regexp "\\)") 129 | move) 130 | (match-string 1 move) 131 | move)) 132 | (split-string (match-string 4) "[\n ]+") " "))))) 133 | (cdr result))) 134 | 135 | (provide 'chess-eco) 136 | 137 | ;;; chess-ecos.el ends here 138 | -------------------------------------------------------------------------------- /chess-epd.el: -------------------------------------------------------------------------------- 1 | ;;; chess-epd.el --- Extended Position Description Format 2 | 3 | ;; Copyright (C) 2004 Free Software Foundation, Inc. 4 | 5 | ;; Author: Mario Lang 6 | 7 | ;; This program is free software; you can redistribute it and/or modify 8 | ;; it under the terms of the GNU General Public License as published by 9 | ;; the Free Software Foundation, either version 3 of the License, or 10 | ;; (at your option) any later version. 11 | 12 | ;; This program is distributed in the hope that it will be useful, 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;; GNU General Public License for more details. 16 | 17 | ;; You should have received a copy of the GNU General Public License 18 | ;; along with this program. If not, see . 19 | 20 | ;;; Commentary: 21 | 22 | ;; EPD is the "Extended Position Description" format. It is a standard for 23 | ;; describing chess positions along with an extended set of structured 24 | ;; attribute values using the ASCII character set. It is intended for data and 25 | ;; command interchange among chessplaying programs. It is also intended 26 | ;; for the representation of portable opening library repositories and for 27 | ;; problem test suites. 28 | 29 | ;; A single EPD record uses one text line of variable length composed of 30 | ;; four data fields followed by zero or more operations. A text file 31 | ;; composed exclusively of EPD data records should have a file name with 32 | ;; the suffix ".epd". 33 | 34 | ;;; Code: 35 | 36 | (require 'chess-algebraic) 37 | (require 'chess-fen) 38 | (require 'chess-game) 39 | (require 'chess-ply) 40 | (require 'chess-pos) 41 | (require 'chess-var) 42 | 43 | (defun chess-epd-annotation-to-string (annotation) 44 | (let ((opcode (car annotation)) 45 | (value (cdr annotation))) 46 | (cond 47 | ((or (eq opcode 'am) (eq opcode 'bm)) 48 | (cl-assert (consp value)) 49 | (format "%S %s;" 50 | opcode (mapconcat #'chess-ply-to-algebraic value " "))) 51 | ((eq opcode 'ce) 52 | (cl-assert (integerp value)) 53 | (format "%S %d;" opcode value)) 54 | ((or (eq opcode 'pv) (eq opcode 'sv)) 55 | (format "%S %s;" 56 | opcode (chess-var-to-algebraic value))) 57 | (t 58 | (format "%S%s;" opcode (if (eq value t) "" (format " %s" value))))))) 59 | 60 | (defun chess-pos-to-epd (position) 61 | "Convert a chess POSITION to a string representation in extended 62 | position description format." 63 | (cl-assert position) 64 | (concat (chess-pos-to-fen position) 65 | (when (consp (chess-pos-annotations position)) 66 | (concat " " 67 | (mapconcat #'chess-epd-annotation-to-string 68 | (chess-pos-annotations position) 69 | " "))))) 70 | 71 | (defun chess-epd-to-pos (&optional string) 72 | "Convert extended position description to a chess position. 73 | If STRING is not specified, look for an EPD string in the current buffer, 74 | and advance point after the correctly parsed position." 75 | (if (stringp string) 76 | (with-temp-buffer 77 | (insert string) 78 | (chess-epd-parse)) 79 | (chess-epd-parse))) 80 | 81 | (defun chess-epd-read-file (file) 82 | "Return a list of positions contained in FILE." 83 | (let ((positions (list t)) pos) 84 | (with-temp-buffer 85 | (insert-file-contents file) 86 | (goto-char (point-min)) 87 | (while (setq pos (chess-epd-parse)) 88 | (nconc positions (list pos)))) 89 | (cdr positions))) 90 | 91 | (defsubst chess-game-to-epd (game &optional to-string index) 92 | (if to-string 93 | (chess-pos-to-epd (chess-game-pos game index)) 94 | (insert (chess-pos-to-epd (chess-game-pos game index)) ?\n))) 95 | 96 | (defsubst chess-epd-to-game (&optional string) 97 | (chess-game-create (chess-epd-to-pos string))) 98 | 99 | (defun chess-epd-parse () 100 | (when (re-search-forward chess-fen-regexp nil t) 101 | (let ((pos (chess-fen-to-pos (match-string 0)))) 102 | (while (= 1 (skip-chars-forward " ")) 103 | (if (looking-at "[A-Za-z]") 104 | (let ((opcode (intern (buffer-substring 105 | (point) (+ (point) (skip-chars-forward 106 | "A-Za-z0-9_")))))) 107 | (if (= 1 (skip-chars-forward ";")) 108 | (chess-pos-set-epd pos opcode) 109 | (if (= (skip-chars-forward " ") 1) 110 | (let ((val (buffer-substring 111 | (point) (prog1 112 | (+ (point) 113 | (skip-chars-forward "^;")) 114 | (skip-chars-forward ";"))))) 115 | (chess-pos-set-epd 116 | pos opcode 117 | (cond 118 | ((or (eq opcode 'am) (eq opcode 'bm)) 119 | (mapcar (lambda (move) 120 | (chess-algebraic-to-ply pos move)) 121 | (split-string val " "))) 122 | ((eq opcode 'ce) 123 | (read val)) 124 | ((or (eq opcode 'pm) (eq opcode 'sm)) ;predicted/supplied move 125 | (chess-algebraic-to-ply pos val)) 126 | ((or (eq opcode 'pv) (eq opcode 'sv)) ; predicted/supplied variation 127 | (let ((var (chess-var-create pos))) 128 | (mapc (lambda (ply) 129 | (let ((changes (chess-algebraic-to-ply 130 | (chess-var-pos var) ply))) 131 | (if changes 132 | (chess-var-move var changes) 133 | (error "Unable to convert ply '%s'" ply)))) 134 | (split-string val " ")) 135 | var)) 136 | (t val)))) 137 | (error "Illegal char following identifier")))) 138 | (error "Illegal Identifier"))) 139 | (skip-chars-forward "\n") 140 | pos))) 141 | 142 | (provide 'chess-epd) 143 | ;;; chess-epd.el ends here 144 | -------------------------------------------------------------------------------- /chess-fen.el: -------------------------------------------------------------------------------- 1 | ;;; chess-fen.el --- Convert a chess position to/from FEN notation 2 | 3 | ;; Copyright (C) 2002, 2004, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Commentary: 23 | 24 | ;; FEN notation encodes a chess position using a simple string. The 25 | ;; format is: 26 | ;; 27 | ;; POSITION SIDE CASTLING EN-PASSANT 28 | ;; 29 | ;; The POSITION gives all eight ranks, by specifying a letter for each 30 | ;; piece on the position, and a number for any intervening spaces. 31 | ;; Trailing spaces need not be counted. Uppercase letters signify 32 | ;; white, and lowercase black. For example, if your position only had 33 | ;; a black king on d8, your POSITION string would be: 34 | ;; 35 | ;; 3k//////// 36 | ;; 37 | ;; For the three spaces (a, b and c file), the black king, and then 38 | ;; all the remaining ranks (which are all empty, so their spaces can 39 | ;; be ignored). 40 | ;; 41 | ;; The SIDE is w or b, to indicate whose move it is. 42 | ;; 43 | ;; CASTLING can contain K, Q, k or q, to signify whether the white or 44 | ;; black king can still castle on the king or queen side. EN-PASSANT 45 | ;; signifies the target sqaure of an en passant capture, such as "e3" or "a6". 46 | ;; 47 | ;; The starting chess position always looks like this: 48 | ;; 49 | ;; rnbqkbnr/pppppppp/////PPPPPPPP/RNBQKBNR/ w KQkq - 50 | ;; 51 | ;; And in "full" mode (where all spaces are accounted for): 52 | ;; 53 | ;; rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 54 | ;; 55 | ;; It may also have the current game sequence appended, but this 56 | ;; relate to the game, not the position. 57 | 58 | ;;; Code: 59 | 60 | (require 'chess-pos) 61 | (eval-when-compile (require 'cl-lib)) 62 | 63 | (defconst chess-fen-regexp 64 | "^\\([bnrqkpBNRQKP1-8]*/?\\)+ [bw] \\(-\\|[KQkq]+\\) \\(-\\|[1-8]\\)") 65 | 66 | (defun chess-fen-to-pos (fen) 67 | "Convert a FEN-like notation string to a chess position." 68 | (cl-assert (stringp fen)) 69 | (let ((i 0) (l (length fen)) 70 | (rank 0) (file 0) (c ?0) 71 | (position (chess-pos-create t)) 72 | error (space-count 0)) 73 | (setq c (aref fen i)) 74 | (while (and (null error) 75 | (/= c ? ) (< i l)) 76 | (cond 77 | ((= c ?/) 78 | (setq file 0 rank (1+ rank))) 79 | ((and (>= c ?1) (<= c ?9)) 80 | (setq file (+ file (- c ?0)))) 81 | ((memq (upcase c) '(?K ?Q ?B ?N ?R ?P)) 82 | (chess-pos-set-piece position (chess-rf-to-index rank file) c) 83 | (setq file (1+ file))) 84 | (t 85 | (setq error t))) 86 | (setq i (1+ i) c (aref fen i))) 87 | (if (= (aref fen i) ? ) 88 | (setq i (1+ i))) 89 | (if (memq (aref fen i) '(?b ?w)) 90 | (progn 91 | (chess-pos-set-side-to-move position (= (aref fen i) ?w)) 92 | (setq i (+ i 2))) 93 | (setq error t)) 94 | (setq c (aref fen i)) 95 | (while (and (null error) 96 | (< space-count 2) (< i l)) 97 | (cond 98 | ((= c ?-)) 99 | ((= c ? ) (setq space-count (1+ space-count))) 100 | ((= c ?K) (chess-pos-set-can-castle position ?K t)) 101 | ((= c ?Q) (chess-pos-set-can-castle position ?Q t)) 102 | ((= c ?k) (chess-pos-set-can-castle position ?k t)) 103 | ((= c ?q) (chess-pos-set-can-castle position ?q t)) 104 | ((and (>= c ?a) (<= c ?h)) 105 | (chess-pos-set-en-passant 106 | position 107 | (let ((target (chess-coord-to-index (substring fen i (+ i 2))))) 108 | (chess-incr-index target (if (= (chess-index-rank target) 2) 109 | 1 (if (= (chess-index-rank target) 5) 110 | -1 (setq error t) 0)) 0))) 111 | (setq i (1+ i))) 112 | (t 113 | (setq error t))) 114 | (setq i (1+ i) c (and (< i l) (aref fen i)))) 115 | (unless error 116 | position))) 117 | 118 | (defun chess-pos-to-fen (position &optional full) 119 | "Convert a chess POSITION to FEN-like notation. 120 | If FULL is non-nil, represent trailing spaces as well." 121 | (cl-assert (vectorp position)) 122 | (let ((blank 0) (str "") output) 123 | (dotimes (rank 8) 124 | (dotimes (file 8) 125 | (let ((p (chess-pos-piece position (chess-rf-to-index rank file)))) 126 | (if (= p ? ) 127 | (setq blank (1+ blank)) 128 | (if (> blank 0) 129 | (setq str (concat str (int-to-string blank)) blank 0)) 130 | (setq str (concat str (char-to-string p)))))) 131 | (if (and full (> blank 0)) 132 | (setq str (concat str (int-to-string blank)))) 133 | (if (< rank 7) (setq blank 0 str (concat str "/")))) 134 | (setq str (if (chess-pos-side-to-move position) 135 | (concat str " w ") 136 | (concat str " b "))) 137 | (mapc (lambda (castle) 138 | (if (chess-pos-can-castle position castle) 139 | (setq str (concat str (string castle)) output t))) 140 | '(?K ?Q ?k ?q)) 141 | (if output 142 | (setq str (concat str " ")) 143 | (setq str (concat str "- "))) 144 | (let ((index (chess-pos-en-passant position))) 145 | (if (and index 146 | (let ((pawn (if (chess-pos-side-to-move position) ?P ?p))) 147 | (or (and (chess-incr-index index 0 -1) 148 | (eq (chess-pos-piece position (chess-incr-index 149 | index 0 -1)) pawn)) 150 | (and (chess-incr-index index 0 1) 151 | (eq (chess-pos-piece position (chess-incr-index 152 | index 0 1)) pawn))))) 153 | (concat str (chess-index-to-coord 154 | (if (chess-pos-side-to-move position) 155 | (chess-incr-index index -1 0) 156 | (chess-incr-index index 1 0)))) 157 | (concat str "-"))))) 158 | 159 | (provide 'chess-fen) 160 | 161 | ;;; chess-fen.el ends here 162 | -------------------------------------------------------------------------------- /chess-file.el: -------------------------------------------------------------------------------- 1 | ;;; chess-file.el --- Handle chess databases stored in PGN or EPD files 2 | 3 | ;; Copyright (C) 2002, 2004, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: files, games 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Commentary: 23 | 24 | ;; A game database that stores PGN or EPD format positions in a single file. 25 | ;; 26 | ;; This is basically what you expect from a file ending in .pgn or .epd. 27 | 28 | ;;; Code: 29 | 30 | (require 'chess-fen) 31 | 32 | (defvar chess-file-locations nil 33 | "A list of starting positions of individual records of this collection.") 34 | (make-variable-buffer-local 'chess-file-locations) 35 | 36 | (defvar chess-file-type nil 37 | "The file format type of this database instance (a symbol). 38 | See `chess-file-types' for details.") 39 | (make-variable-buffer-local 'chess-file-type) 40 | 41 | (defvar chess-file-types 42 | `((pgn "^\\[Event " chess-pgn-to-game chess-game-to-pgn (?\n ?\n)) 43 | (epd ,(concat chess-fen-regexp "\\(\\s-+.+\\);\\s-*$") 44 | chess-epd-to-game chess-game-to-epd (?\n))) 45 | "Alist of different file types. 46 | Entries have the form (TYPE BEGIN-REGEXP TO-GAME FROM-GAME SEPARATOR) 47 | where TYPE is a symbol (usually either 'pgn or 'epd), 48 | BEGIN-REGEXP is the regexp to use for matching the beginning of new records, 49 | TO-GAME and FROM-GAME are functions to use for reading and writing a game 50 | object from/into the buffer and SEPARATOR is a list of characters to insert 51 | inbetween of individual records.") 52 | 53 | (defun chess-file-handler (event &rest args) 54 | "Event handler for file database objects." 55 | (cond 56 | ((eq event 'open) 57 | (with-current-buffer (find-file-noselect (car args)) 58 | (when (setq chess-file-type 59 | (cond 60 | ((or (string-match "\\.pgn\\'" (car args)) 61 | (save-excursion (re-search-forward "^\\[Event" nil t))) 62 | 'pgn) 63 | ((string-match "\\.epd\\'" (car args)) 64 | 'epd))) 65 | (chess-file-handler 'rescan) 66 | (current-buffer)))) 67 | 68 | ((eq event 'rescan) 69 | (save-excursion 70 | (goto-char (point-min)) 71 | (setq chess-file-locations nil) 72 | (while (re-search-forward (nth 1 (assq chess-file-type chess-file-types)) 73 | nil t) 74 | (goto-char (match-beginning 0)) 75 | (push (point) chess-file-locations) 76 | (forward-char 1)) 77 | (setq chess-file-locations (nreverse chess-file-locations)))) 78 | 79 | ((eq event 'read-only-p) 80 | buffer-read-only) 81 | 82 | ((eq event 'filename) 83 | buffer-file-name) 84 | 85 | ((eq event 'save) 86 | (save-buffer)) 87 | 88 | ((eq event 'count) 89 | (length chess-file-locations)) 90 | 91 | ((eq event 'read) 92 | (let ((index (car args)) game) 93 | (when (and (>= index 0) 94 | (< index (chess-file-handler 'count))) 95 | (goto-char (nth index chess-file-locations)) 96 | (when (setq game (funcall (nth 2 (assq chess-file-type 97 | chess-file-types)))) 98 | (chess-game-set-data game 'database (current-buffer)) 99 | (chess-game-set-data game 'database-index index) 100 | (chess-game-set-data game 'database-count 101 | (chess-file-handler 'count)) 102 | game)))) 103 | 104 | ((eq event 'write) 105 | (goto-char (point-max)) 106 | (while (memq (char-before) '(? ?\t ?\n ?\r)) 107 | (delete-char -1)) 108 | (apply 'insert (nth 4 (assq chess-file-type chess-file-types))) 109 | (push (point) chess-file-locations) 110 | (funcall (nth 3 (assq chess-file-type chess-file-types)) (car args)) 111 | (1- (chess-file-handler 'count))) 112 | 113 | ((eq event 'replace) 114 | (let ((index (or (cadr args) 115 | (chess-game-data (car args) 'database-index))) 116 | (count (chess-file-handler 'count))) 117 | (when (and (>= index 0) 118 | (< index count)) 119 | (goto-char (nth index chess-file-locations)) 120 | (delete-region (point) (if (= (1+ index) count) 121 | (point-max) 122 | (nth (1+ index) chess-file-locations))) 123 | (funcall (nth 3 (assq chess-file-type chess-file-types)) (car args)) 124 | (when (eq chess-file-type 'pgn) (insert ?\n))))))) 125 | 126 | (provide 'chess-file) 127 | 128 | ;;; chess-file.el ends here 129 | -------------------------------------------------------------------------------- /chess-fruit.el: -------------------------------------------------------------------------------- 1 | ;;; chess-fruit.el --- Play against fruit! 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: Mario Lang 6 | ;; Keywords: games, processes 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Code: 22 | 23 | (require 'chess-uci) 24 | 25 | (defgroup chess-fruit nil 26 | "The publicly available chess engine 'fruit'." 27 | :group 'chess-engine 28 | :link '(url-link "http://www.fruitchess.com/")) 29 | 30 | (defcustom chess-fruit-path (executable-find "fruit") 31 | "*The path to the fruit executable." 32 | :type 'file 33 | :group 'chess-fruit) 34 | 35 | (defvar chess-fruit-regexp-alist chess-uci-regexp-alist 36 | "Patterns used to match engine output.") 37 | 38 | (defun chess-fruit-handler (game event &rest args) 39 | (unless chess-engine-handling-event 40 | (cond 41 | ((eq event 'initialize) 42 | (let ((proc (chess-uci-handler game 'initialize "fruit"))) 43 | (when (and proc (processp proc) (eq (process-status proc) 'run)) 44 | (process-send-string proc "uci\n") 45 | (setq chess-engine-process proc) 46 | t))) 47 | 48 | (t 49 | (if (and (eq event 'undo) 50 | (= 1 (mod (car args) 2))) 51 | (error "Cannot undo until after fruit moves")) 52 | 53 | (apply 'chess-uci-handler game event args))))) 54 | 55 | (provide 'chess-fruit) 56 | 57 | ;;; chess-fruit.el ends here 58 | -------------------------------------------------------------------------------- /chess-german.el: -------------------------------------------------------------------------------- 1 | ;;; chess-german.el --- German translation of the chess.el message catalog 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: Mario Lang 6 | ;; Keywords: games, i18n 7 | 8 | ;; This is free software; you can redistribute it and/or modify it under 9 | ;; the terms of the GNU General Public License as published by the Free 10 | ;; Software Foundation; either version 3, or (at your option) any later 11 | ;; version. 12 | ;; 13 | ;; This is distributed in the hope that it will be useful, but WITHOUT 14 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 15 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 16 | ;; for more details. 17 | ;; 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with GNU Emacs. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;;; Code: 24 | 25 | (require 'chess-message) 26 | 27 | (chess-message-catalog 'german 28 | '((queen . "Dame") 29 | (king . "König") 30 | (bishop . "Läufer") 31 | (knight . "Springer") 32 | (rook . "Turm") 33 | (pawn . "Bauer") 34 | (short-castle . "Kurze Rochade") 35 | (long-castle . "Lange Rochade") 36 | (check . "Schach") 37 | (checkmate . "Schach matt") 38 | (stalemate . "Patt") 39 | (en-passant . "on possont") 40 | (piece-moves . "%s nach %s") 41 | (piece-takes . "%s schlägt %s auf %s") 42 | 43 | (add-to-completed . "Kann keine Züge zu abgeschlossenem Spiel hinzufügen") 44 | (bad-game-read . "Beim lesen des Spiels ist ein Fehler an Position %d aufgetreten") 45 | (cannot-mount . "Es ist nicht Möglich eine Figur auf die andere zu stellen") 46 | (cannot-yet-add . "Kann noch keine Züge zu Spiel hinzufügen") 47 | (challenge-whom . "Wehn willst du herausfordern? ") 48 | (chess-delete-autosave . "Soll die autosave Datei gelöscht werden? ") 49 | (chess-disable-autosave . "Disable autosaving for this game? ") 50 | (chess-read-autosave . "Es existiert eine Schach autosave Datei, soll sie geladen werden? ") 51 | (clarify-piece . "Clarify piece to move by rank or file") 52 | (congratulations . "Gratulation!") 53 | (could-not-clarify . "Could not determine which piece to use") 54 | (could-not-diff . "Could not differentiate piece") 55 | (could-not-find-engine . "Cannot find %s executable; check `%s'") 56 | (could-not-read-pgn . "Kann PGN Datei nicht lesen oder finden") 57 | (draw-offer . "Du bietest ein Unentschieden an") 58 | (draw-offer-declined . "Dein Angebot zum Unentschieden wurde abgelehnt") 59 | (editing-directly . "Now editing position directly, use S when complete...") 60 | (end-of-puzzles . "Es gibt keine weiteren Puzzles in dieser Sammlung") 61 | (engine-not-running . "Die Engine die Du verwendet hast läuft nicht mehr") 62 | (failed-start . "Failed to start chess engine process") 63 | (game-is-over . "Dieses Spiel ist abgeschlossen") 64 | (ics-connected . "Verbindungsaufbau mit Internet Chess Server '%s'...done") 65 | (ics-connecting . "Verbindungsaufbau mit Internet Chess Server '%s'...") 66 | (ics-server-prompt . "Verbindung zu Schach Server: ") 67 | (illegal-move . "Illegalaler Zug") 68 | (illegal-notation . "Illegale Zug notation: %s") 69 | (invalid-fen . "Ungültiger FEN string: %s") 70 | (invalid-pgn . "Ungültiger PGN text empfangen") 71 | (irc-challenge . "IRC nick of user to challenge: ") 72 | (irc-connecting . "Verbindungsaufbau mit IRC server '%s:%d'...") 73 | (irc-logging-in . "Connected, now logging in as '%s'...") 74 | (irc-waiting . "Now waiting for 'name USER' via /msg, or `M-x chess-irc-engage'") 75 | (knight-1-done . "Goal: take all the pawns, without letting the queen take your knight") 76 | (mode-black . "Schwarz") 77 | (mode-checkmate . "SCHACHMATT") 78 | (mode-drawn . "DRAWN") 79 | (mode-edit . "EDIT") 80 | (mode-flag-fell . "FLAG FELL") 81 | (mode-resigned . "RESIGNED") 82 | (mode-stalemate . "PATT") 83 | (mode-start . "START") 84 | (mode-white . "Weiß") 85 | (move-from-blank . "Du versuchst eine Figur vom leeren Feld %s zu bewegen") 86 | (move-not-legal . "Dies ist kein legaler Zug") 87 | (move-passed . "Your opponent has passed the move to you") 88 | (network-starting . "Starting network client/server...") 89 | (network-waiting . "Now waiting for your opponent to connect...") 90 | (no-candidates . "There are no candidate moves for '%s'") 91 | (no-engines-found . "Could not find any chess engines to play against; install gnuchess!") 92 | (no-images . "Cannot find any piece images; check `chess-images-directory'") 93 | (no-images-fallback . "Could not find any suitable or properly sized chess images") 94 | (no-such-database . "There is no such chess database module '%s'") 95 | (no-such-module . "There is no module named '%s'") 96 | (no-such-style . "There is no such chessboard display style '%s'") 97 | (not-your-move . "It is not your turn to move") 98 | (now-black . "Dein Gegner hat den ersten Zug gemacht, du bist nun Schwarz") 99 | (opp-abort . "Dein Gegner will das Spiel abbrechen, akzeptierst Du? ") 100 | (opp-abort-acc . "Your offer to abort was accepted") 101 | (opp-abort-dec . "Your offer to abort was declined") 102 | (opp-abort-ret . "Your opponent has retracted their offer to abort") 103 | (opp-draw . "Dein Gegner bietet ein Unentschieden an, willst Du annehmen? ") 104 | (opp-draw-acc . "Dein Remie Angebot wurde akzeptiert") 105 | (opp-draw-dec . "Your draw offer was declined") 106 | (opp-draw-ret . "Your opponent has retracted their draw offer") 107 | (opp-illegal . "Your opponent states your last command was illegal") 108 | (opp-quit . "Your opponent has quit playing") 109 | (opp-ready . "%s ist nun bereits zu spielen") 110 | (opp-ready-a . "Dein Anonymer Gegner ist nun bereit zu spielen") 111 | (opp-resigned . "Dein Gegner hat aufgegeben") 112 | (opp-undo . "Dein Gegner will %d Züge zurück nehmen, akzeptierst Du? ") 113 | (opp-undo-acc . "Request to undo %d moves was accepted") 114 | (opp-undo-dec . "Your request to undo %d moves was decline") 115 | (opp-undo-ret . "Your opponent has retracted their request to undo %d moves") 116 | (opponent-says . "Dein Gegner sagt: %s") 117 | (pgn-parse-error . "Error parsing PGN syntax") 118 | (pgn-read-error . "Error reading move: %s") 119 | (piece-images-loaded . "Loading chess piece images...done") 120 | (piece-images-loading . "Loading chess piece images...") 121 | (piece-immobile . "That piece cannot move now") 122 | (piece-unrecognized . "Unrecognized piece identifier") 123 | (queen-would-take . "Die Dame würde deinen Springer schlagen!") 124 | (redrawing-frame . "Redrawing chess display with different size...") 125 | (redrawing-frame-done . "Redrawing chess display with different size...done") 126 | (return-to-current . "Use '>' to return to the current position") 127 | (san-not-found . "Could not find a matching move") 128 | (selected-empty . "You cannot select an empty square") 129 | (starting-engine . "Starting chess program '%s'...") 130 | (starting-engine-done . "Starting chess program '%s'...done") 131 | (undo-limit-reached . "Cannot undo further") 132 | (want-to-play . "Willst Du eine Partie Schach gegen %s spielen? ") 133 | (want-to-play-a . "Willst Du eine Partie Schach gegen einen Anonymen Gegner spielen? ") 134 | (want-to-quit . "Do you really want to quit? ") 135 | (wrong-color . "Du kannst die Figuren deines Gegners nicht bewegen"))) 136 | 137 | (provide 'chess-german) 138 | 139 | ;;; chess-german.el ends here 140 | -------------------------------------------------------------------------------- /chess-glaurung.el: -------------------------------------------------------------------------------- 1 | ;;; chess-glaurung.el --- Play against glaurung! 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: Mario Lang 6 | ;; Keywords: games, processes 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Code: 22 | 23 | (require 'chess-uci) 24 | 25 | (defgroup chess-glaurung nil 26 | "The publicly available chess engine 'glaurung'." 27 | :group 'chess-engine 28 | :link '(url-link "http://www.glaurungchess.com/")) 29 | 30 | (defcustom chess-glaurung-path (executable-find "glaurung") 31 | "*The path to the glaurung executable." 32 | :type 'file 33 | :group 'chess-glaurung) 34 | 35 | (defvar chess-glaurung-regexp-alist chess-uci-regexp-alist 36 | "Patterns used to match engine output.") 37 | 38 | (defun chess-glaurung-handler (game event &rest args) 39 | (unless chess-engine-handling-event 40 | (cond 41 | ((eq event 'initialize) 42 | (let ((proc (chess-uci-handler game 'initialize "glaurung"))) 43 | (when (and proc (processp proc) (eq (process-status proc) 'run)) 44 | (process-send-string proc "uci\n") 45 | (setq chess-engine-process proc) 46 | t))) 47 | 48 | (t 49 | (if (and (eq event 'undo) 50 | (= 1 (mod (car args) 2))) 51 | (error "Cannot undo until after glaurung moves")) 52 | 53 | (apply 'chess-uci-handler game event args))))) 54 | 55 | (provide 'chess-glaurung) 56 | 57 | ;;; chess-glaurung.el ends here 58 | -------------------------------------------------------------------------------- /chess-gnuchess.el: -------------------------------------------------------------------------------- 1 | ;;; chess-gnuchess.el --- Play against gnuchess! 2 | 3 | ;; Copyright (C) 2002, 2004 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games, processes 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Code: 23 | 24 | (require 'chess-common) 25 | (require 'chess-fen) 26 | 27 | (defgroup chess-gnuchess nil 28 | "The publicly available chess engine 'gnuchess'." 29 | :group 'chess-engine) 30 | 31 | (defcustom chess-gnuchess-path (let ((exec-path (cons "/usr/games" exec-path))) 32 | (executable-find "gnuchess")) 33 | "*The path to the gnuchess executable." 34 | :type 'file 35 | :group 'chess-gnuchess) 36 | 37 | (defvar chess-gnuchess-bad-board nil) 38 | (make-variable-buffer-local 'chess-gnuchess-bad-board) 39 | 40 | (defvar chess-gnuchess-regexp-alist 41 | (list 42 | (cons (concat "My move is : \\(" chess-algebraic-regexp "\\)") 43 | (function 44 | (lambda () 45 | (funcall chess-engine-response-handler 'move 46 | (chess-engine-convert-algebraic (match-string 1) t))))) 47 | (cons "Illegal move:" 48 | (function 49 | (lambda () 50 | (chess-error 'illegal-move)))) 51 | (cons "Board is wrong!" 52 | (function 53 | (lambda () 54 | ;; gnuchess didn't like the given position, which 55 | ;; means it won't play against it unless we send a 56 | ;; "go" after the user's move 57 | (setq chess-gnuchess-bad-board t)))))) 58 | 59 | (defun chess-gnuchess-handler (game event &rest args) 60 | (unless chess-engine-handling-event 61 | (cond 62 | ((eq event 'initialize) 63 | (let ((proc (chess-common-handler game 'initialize "gnuchess"))) 64 | (when (and proc (processp proc) 65 | (eq (process-status proc) 'run)) 66 | (process-send-string proc "nopost\n") 67 | (setq chess-engine-process proc 68 | chess-engine-opponent-name "GnuChess") 69 | t))) 70 | 71 | ((eq event 'setup-pos) 72 | (let ((file (chess-with-temp-file 73 | (insert (chess-pos-to-fen (car args)) ?\n)))) 74 | (chess-engine-send nil (format "epdload %s\n" file)))) 75 | 76 | ((eq event 'setup-game) 77 | (if (zerop (chess-game-index (car args))) 78 | (chess-gnuchess-handler game 'setup-pos (chess-game-pos game 0)) 79 | (let ((file (chess-with-temp-file 80 | (insert (chess-game-to-string (car args)) ?\n)))) 81 | (chess-engine-send nil (format "pgnload %s\n" file))))) 82 | 83 | ((eq event 'pass) 84 | (chess-engine-send nil (concat (if (chess-pos-side-to-move 85 | (chess-engine-position nil)) 86 | "white" "black") 87 | "\n")) 88 | (chess-engine-send nil "go\n") 89 | (setq chess-gnuchess-bad-board nil)) 90 | 91 | ((eq event 'move) 92 | (chess-common-handler game 'move (car args)) 93 | (when chess-gnuchess-bad-board 94 | (chess-engine-send nil "go\n") 95 | (setq chess-gnuchess-bad-board nil))) 96 | 97 | (t 98 | (apply 'chess-common-handler game event args))))) 99 | 100 | (provide 'chess-gnuchess) 101 | 102 | ;;; chess-gnuchess.el ends here 103 | -------------------------------------------------------------------------------- /chess-ics1.el: -------------------------------------------------------------------------------- 1 | ;;; chess-ics1.el --- Classic ICS1 style chessboard display 2 | 3 | ;; Copyright (C) 2002, 2005, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Keywords: games 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Code: 22 | 23 | (require 'chess-display) 24 | 25 | (defgroup chess-ics1 nil 26 | "The ICS1 style ASCII display." 27 | :group 'chess-display) 28 | 29 | (defface chess-ics1-black-face 30 | '((((class color) (background light)) (:foreground "Green")) 31 | (((class color) (background dark)) (:foreground "Green")) 32 | (t (:bold t))) 33 | "*The face used for black pieces on the ASCII display." 34 | :group 'chess-ics1) 35 | 36 | (defface chess-ics1-white-face 37 | '((((class color) (background light)) (:foreground "Yellow")) 38 | (((class color) (background dark)) (:foreground "Yellow")) 39 | (t (:bold t))) 40 | "*The face used for white pieces on the ASCII display." 41 | :group 'chess-ics1) 42 | 43 | (defface chess-ics1-highlight-face 44 | '((((class color) (background light)) (:background "#add8e6")) 45 | (((class color) (background dark)) (:background "#add8e6"))) 46 | "Face to use for highlighting pieces that have been selected." 47 | :group 'chess-ics1) 48 | 49 | (defcustom chess-ics1-popup-function 'chess-ics1-popup 50 | "The function used to popup a chess-ics1 display." 51 | :type 'function 52 | :group 'chess-ics1) 53 | 54 | (defcustom chess-ics1-separate-frame nil 55 | "If non-nil, display the chessboard in its own frame." 56 | :type 'boolean 57 | :group 'chess-ics1) 58 | 59 | ;;; Code: 60 | 61 | (defun chess-ics1-handler (event &rest args) 62 | (cond 63 | ((eq event 'initialize) t) 64 | 65 | ((eq event 'popup) 66 | (funcall chess-ics1-popup-function)) 67 | 68 | ((eq event 'draw) 69 | (apply 'chess-ics1-draw args)) 70 | 71 | ((eq event 'draw-square) 72 | (apply 'chess-ics1-draw-square args)) 73 | 74 | ((eq event 'highlight) 75 | (apply 'chess-ics1-highlight args)))) 76 | 77 | (defun chess-ics1-popup () 78 | (if chess-ics1-separate-frame 79 | (chess-display-popup-in-frame 21 43 nil nil t) 80 | (chess-display-popup-in-window))) 81 | 82 | (defsubst chess-ics1-piece-text (piece) 83 | (let ((p (char-to-string piece))) 84 | (add-text-properties 0 1 (list 'face (if (> piece ?a) 85 | 'chess-ics1-black-face 86 | 'chess-ics1-white-face)) p) 87 | p)) 88 | 89 | (defsubst chess-ics1-draw-square (pos piece index) 90 | "Draw a piece image at point on an already drawn display." 91 | (save-excursion 92 | (let ((inhibit-redisplay t)) 93 | (goto-char pos) 94 | (delete-char 3) 95 | (insert ? (chess-ics1-piece-text piece) ? ) 96 | (add-text-properties pos (point) (list 'chess-coord index))))) 97 | 98 | (defun chess-ics1-draw (position perspective) 99 | "Draw the given POSITION from PERSPECTIVE's point of view. 100 | PERSPECTIVE is t for white or nil for black." 101 | (let ((inhibit-redisplay t) 102 | (pos (point))) 103 | (erase-buffer) 104 | (let* ((inverted (not perspective)) 105 | (rank (if inverted 7 0)) 106 | (file (if inverted 7 0))) 107 | (insert "\n +---+---+---+---+---+---+---+---+\n") 108 | (while (if inverted (>= rank 0) (< rank 8)) 109 | (if (/= rank (if inverted 7 0)) 110 | (insert " +---+---+---+---+---+---+---+---+\n")) 111 | (while (if inverted (>= file 0) (< file 8)) 112 | (let ((piece (chess-pos-piece position 113 | (chess-rf-to-index rank file))) 114 | begin) 115 | (if (= file (if inverted 7 0)) 116 | (insert (format " %d " (1+ (- 7 rank))))) 117 | (insert "| ") 118 | (setq begin (1- (point))) 119 | (insert (chess-ics1-piece-text piece) ? ) 120 | (add-text-properties begin (point) 121 | (list 'chess-coord 122 | (chess-rf-to-index rank file)))) 123 | (setq file (if inverted (1- file) (1+ file)))) 124 | (insert "|\n") 125 | (setq file (if inverted 7 0) 126 | rank (if inverted (1- rank) (1+ rank)))) 127 | (insert " +---+---+---+---+---+---+---+---+\n") 128 | (if inverted 129 | (insert " h g f e d c b a\n\n") 130 | (insert " a b c d e f g h\n\n"))) 131 | (set-buffer-modified-p nil) 132 | (goto-char pos))) 133 | 134 | (defun chess-ics1-highlight (index &optional mode) 135 | (let ((pos (chess-display-index-pos nil index)) 136 | (piece (chess-pos-piece (chess-display-position nil) index))) 137 | (put-text-property pos (save-excursion 138 | (goto-char pos) 139 | (skip-chars-forward "^|") 140 | (point)) 141 | 'face (cond 142 | ((eq mode :selected) 143 | 'chess-ics1-highlight-face) 144 | ((eq mode :unselected) 145 | (if (> piece ?a) 146 | 'chess-ics1-black-face 147 | 'chess-ics1-white-face)) 148 | (t 149 | (chess-display-get-face mode)))))) 150 | 151 | (defun chess-debug-position (&optional position) 152 | "This is a debugging function, and not meant from general use." 153 | (interactive) 154 | (let ((pos (or position (chess-engine-position nil)))) 155 | (with-current-buffer (get-buffer-create "*scratch*") 156 | (chess-ics1-draw pos t) 157 | (funcall chess-ics1-popup-function)))) 158 | 159 | (provide 'chess-ics1) 160 | 161 | ;;; chess-ics1.el ends here 162 | -------------------------------------------------------------------------------- /chess-ics2.el: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;; 3 | ;; ICS2 style display 4 | ;; Author: Dmitry "Troydm" Geurkov (dgeurkov@gmail.com) 5 | 6 | (require 'chess-display) 7 | (require 'chess-engine) 8 | 9 | (defgroup chess-ics2 nil 10 | "The ICS2 style based on ICS1 ASCII display." 11 | :group 'chess-display) 12 | 13 | (defface chess-ics2-black-face 14 | '((((class color) (background light)) 15 | (:foreground "Black" :background "color-209")) 16 | (((class color) (background dark)) 17 | (:foreground "Black" :background "color-209")) 18 | (t (:bold t))) 19 | "*The face used for black pieces on the ASCII display." 20 | :group 'chess-ics2) 21 | 22 | 23 | (defface chess-ics2-black-face-alt 24 | '((((class color) (background light)) 25 | (:foreground "Black" :background "color-130")) 26 | (((class color) (background dark)) 27 | (:foreground "Black" :background "color-130")) 28 | (t (:bold t))) 29 | "*The alternative face used for black pieces on the ASCII display." 30 | :group 'chess-ics2) 31 | 32 | (defface chess-ics2-white-face 33 | '((((class color) (background light)) 34 | (:foreground "White" :background "color-209")) 35 | (((class color) (background dark)) 36 | (:foreground "White" :background "color-209")) 37 | (t (:bold t))) 38 | "*The face used for white pieces on the ASCII display." 39 | :group 'chess-ics2) 40 | 41 | (defface chess-ics2-white-face-alt 42 | '((((class color) (background light)) 43 | (:foreground "White" :background "color-130")) 44 | (((class color) (background dark)) 45 | (:foreground "White" :background "color-130")) 46 | (t (:bold t))) 47 | "*The alternative face used for white pieces on the ASCII display." 48 | :group 'chess-ics2) 49 | 50 | (defface chess-ics2-highlight-face 51 | '((((class color) (background light)) 52 | (:foreground "Black" :background "#add8e6")) 53 | (((class color) (background dark)) 54 | (:foreground "Black" :background "#add8e6"))) 55 | "Face to use for highlighting pieces that have been selected." 56 | :group 'chess-ics2) 57 | 58 | (defcustom chess-ics2-piece-chars 59 | '((?\040 . ?\040) 60 | (?k . ?♛) 61 | (?q . ?♚) 62 | (?r . ?♜) 63 | (?b . ?♝) 64 | (?n . ?♞) 65 | (?p . ?♟) 66 | (?K . ?♛) 67 | (?Q . ?♚) 68 | (?R . ?♜) 69 | (?B . ?♝) 70 | (?N . ?♞) 71 | (?P . ?♟)) 72 | "*Alist of pieces and their corresponding characters." 73 | :group 'chess-ics2 74 | :type '(alist :key-type (character :tag "Internal representation") 75 | :value-type (character :tag "Printed representation"))) 76 | 77 | 78 | (defcustom chess-ics2-popup-function 'chess-ics2-popup 79 | "The function used to popup a chess-ics1 display." 80 | :type 'function 81 | :group 'chess-ics2) 82 | 83 | (defcustom chess-ics2-separate-frame nil 84 | "If non-nil, display the chessboard in its own frame." 85 | :type 'boolean 86 | :group 'chess-ics2) 87 | 88 | ;;; Code: 89 | 90 | (defun chess-ics2-handler (event &rest args) 91 | (cond 92 | ((eq event 'initialize) t) 93 | 94 | ((eq event 'popup) 95 | (funcall chess-ics2-popup-function)) 96 | 97 | ((eq event 'draw) 98 | (apply 'chess-ics2-draw args)) 99 | 100 | ((eq event 'draw-square) 101 | (apply 'chess-ics2-draw-square args)) 102 | 103 | ((eq event 'highlight) 104 | (apply 'chess-ics2-highlight args)))) 105 | 106 | (defun chess-ics2-popup () 107 | (if chess-ics2-separate-frame 108 | (chess-display-popup-in-frame 21 43 nil nil t) 109 | (chess-display-popup-in-window))) 110 | 111 | 112 | (defsubst chess-ics2-piece-text (piece rank file) 113 | (let ((p (char-to-string (cdr (assq piece chess-ics2-piece-chars)))) 114 | (a (% (+ rank file) 2))) 115 | (add-text-properties 0 1 (list 'face (if (> piece ?a) 116 | (if (= a 0) 'chess-ics2-black-face 117 | 'chess-ics2-black-face-alt) 118 | (if (= a 0) 'chess-ics2-white-face 119 | 'chess-ics2-white-face-alt))) p) 120 | p)) 121 | 122 | (defun chess-ics2-piece-text-draw (piece rank file) 123 | (insert (chess-ics2-piece-text piece rank file)) 124 | (insert (chess-ics2-piece-text ? rank file))) 125 | 126 | (defsubst chess-ics2-draw-square (pos piece index) 127 | "Draw a piece image at point on an already drawn display." 128 | (save-excursion 129 | (let ((inhibit-redisplay t)) 130 | (message (concat (int-to-string pos) " " (int-to-string index) " " 131 | (char-to-string piece))) 132 | (if (= (% (+ (/ index 8) pos) 2) 1) 133 | (goto-char pos) (goto-char (1- pos))) 134 | (delete-char 2) 135 | (insert (chess-ics2-piece-text piece (/ index 8) index)) 136 | (insert (chess-ics2-piece-text ? (/ index 8) index)) 137 | (add-text-properties pos (point) (list 'chess-coord index))))) 138 | 139 | (defun chess-ics2-draw (position perspective) 140 | "Draw the given POSITION from PERSPECTIVE's point of view. 141 | PERSPECTIVE is t for white or nil for black." 142 | (let ((inhibit-redisplay t) 143 | (pos (point))) 144 | (erase-buffer) 145 | (let* ((inverted (not perspective)) 146 | (rank (if inverted 7 0)) 147 | (file (if inverted 7 0)) beg) 148 | (insert "\n\n") 149 | (while (if inverted (>= rank 0) (< rank 8)) 150 | (while (if inverted (>= file 0) (< file 8)) 151 | (let ((piece (chess-pos-piece position 152 | (chess-rf-to-index rank file))) 153 | begin) 154 | (if (= file (if inverted 7 0)) 155 | (insert (format " %d " (1+ (- 7 rank))))) 156 | (setq begin (point)) 157 | (chess-ics2-piece-text-draw piece rank file) 158 | (add-text-properties begin (point) 159 | (list 'chess-coord 160 | (chess-rf-to-index rank file)))) 161 | (setq file (if inverted (1- file) (1+ file)))) 162 | (insert "\n") 163 | (setq file (if inverted 7 0) 164 | rank (if inverted (1- rank) (1+ rank)))) 165 | (if inverted 166 | (insert " h g f e d c b a\n\n") 167 | (insert " a b c d e f g h\n\n"))) 168 | (set-buffer-modified-p nil) 169 | (goto-char pos))) 170 | 171 | (defun chess-ics2-highlight (index &optional mode) 172 | (let ((pos (chess-display-index-pos nil index)) 173 | (piece (chess-pos-piece (chess-display-position nil) index))) 174 | (put-text-property pos (save-excursion 175 | (goto-char (+ pos 2)) 176 | (point)) 177 | 'face (cond 178 | ((eq mode :selected) 179 | 'chess-ics2-highlight-face) 180 | ((eq mode :unselected) 181 | (if (> piece ?a) 182 | (if (= a 0) 'chess-ics2-black-face 183 | 'chess-ics2-black-face-alt) 184 | (if (= a 0) 'chess-ics2-white-face 185 | 'chess-ics2-white-face-alt))) 186 | (t 187 | (chess-display-get-face mode)))))) 188 | 189 | (defun chess-ics2-debug-position (&optional position) 190 | "This is a debugging function, and not meant from general use." 191 | (interactive) 192 | (let ((pos (or position (chess-engine-position nil)))) 193 | (with-current-buffer (get-buffer-create "*scratch*") 194 | (chess-ics2-draw pos t) 195 | (funcall chess-ics2-popup-function)))) 196 | 197 | (provide 'chess-ics2) 198 | 199 | ;;; chess-ics2.el ends here 200 | -------------------------------------------------------------------------------- /chess-input.el: -------------------------------------------------------------------------------- 1 | ;;; chess-input.el --- Keyboard entry of algebraic notation, using shortcut notation 2 | 3 | ;; Copyright (C) 2002, 2005, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games 8 | 9 | ;; This is free software; you can redistribute it and/or modify it under 10 | ;; the terms of the GNU General Public License as published by the Free 11 | ;; Software Foundation; either version 3, or (at your option) any later 12 | ;; version. 13 | ;; 14 | ;; This is distributed in the hope that it will be useful, but WITHOUT 15 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 16 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 17 | ;; for more details. 18 | ;; 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with GNU Emacs. If not, see . 21 | 22 | ;;; Commentary: 23 | 24 | ;; This scheme was adapted from the way SCID (), 25 | ;; by Shane Hudson, behaves. It is based on standard algebraic notation. 26 | ;; You do not need to type all characters from the corresponding SAN of a move, 27 | ;; chess-input will automatically pick the move once it is unambiguous. 28 | ;; 29 | ;; Additionally, optional characters from SAN are treated as such. 30 | ;; You do not need to type x or =, although you can, if you prefer to. 31 | ;; For instance, "bxc8=N#" can be selected by typing `b c 8 n'. 32 | 33 | ;;; Code: 34 | 35 | (require 'chess-algebraic) 36 | (require 'chess-ply) 37 | (require 'chess-pos) 38 | 39 | (defvar chess-input-move-string "") 40 | (defvar chess-input-moves-pos nil) 41 | (defvar chess-input-moves nil) 42 | (defvar chess-input-position-function nil) 43 | (defvar chess-input-my-color-function nil) 44 | (defvar chess-input-move-function nil) 45 | 46 | (make-variable-buffer-local 'chess-input-move-string) 47 | (make-variable-buffer-local 'chess-input-moves-pos) 48 | (make-variable-buffer-local 'chess-input-moves) 49 | (make-variable-buffer-local 'chess-input-position-function) 50 | (make-variable-buffer-local 'chess-input-my-color-function) 51 | (make-variable-buffer-local 'chess-input-move-function) 52 | 53 | (defun chess-input-test-move (ply) 54 | "Return the given PLY if it matches the user's current input." 55 | (let* ((move (chess-ply-to-algebraic ply)) 56 | (i 0) (x 0) (l (length move)) 57 | (xl (length chess-input-move-string))) 58 | (unless (or (and (equal (downcase chess-input-move-string) "ok") 59 | (string-match "\\`O-O[+#]?\\'" move)) 60 | (and (equal (downcase chess-input-move-string) "oq") 61 | (string-match "\\`O-O-O[+#]?\\'" move))) 62 | (while (and (< i l) (< x xl)) 63 | (let ((move-char (aref move i)) 64 | (entry-char (aref chess-input-move-string x))) 65 | (cond 66 | ((or (and (= move-char ?x) (/= entry-char ?x)) 67 | (and (= move-char ?=) (/= entry-char ?=))) 68 | (setq i (1+ i))) 69 | ((/= entry-char (if (< entry-char ?a) move-char (downcase move-char))) 70 | (setq ply nil i l)) 71 | (t (setq i (1+ i) x (1+ x))))))) 72 | ply)) 73 | 74 | (defsubst chess-input-display-moves (&optional move-list) 75 | (if (> (length chess-input-move-string) 0) 76 | (message "[%s] %s" chess-input-move-string 77 | (mapconcat #'chess-ply-to-algebraic 78 | (or move-list 79 | (delq nil (mapcar 'chess-input-test-move 80 | (cdr chess-input-moves)))) 81 | " ")))) 82 | 83 | (defun chess-input-shortcut-delete () 84 | (interactive) 85 | (when (and chess-input-move-string 86 | (stringp chess-input-move-string) 87 | (> (length chess-input-move-string) 0)) 88 | (setq chess-input-move-string 89 | (substring chess-input-move-string 0 (1- (length chess-input-move-string)))) 90 | (chess-input-display-moves))) 91 | 92 | (defun chess-input-shortcut (&optional display-only) 93 | (interactive) 94 | (let* ((position (funcall chess-input-position-function)) 95 | (color (funcall chess-input-my-color-function)) 96 | char) 97 | (unless (memq last-command '(chess-input-shortcut 98 | chess-input-shortcut-delete)) 99 | (setq chess-input-move-string nil)) 100 | (unless display-only 101 | (setq chess-input-move-string 102 | (concat chess-input-move-string 103 | (char-to-string last-command-event)))) 104 | (unless (and chess-input-moves 105 | (eq position chess-input-moves-pos) 106 | (or (> (length chess-input-move-string) 1) 107 | (eq (car chess-input-moves) last-command-event))) 108 | (setq char (if (eq (downcase last-command-event) ?o) 109 | ?k 110 | last-command-event)) 111 | (if (or (memq (upcase char) '(?K ?Q ?N ?B ?R ?P)) 112 | (and (>= char ?a) (<= char ?h))) 113 | (setq chess-input-moves-pos position 114 | chess-input-moves 115 | (cons 116 | char 117 | (sort 118 | (if (eq char ?b) 119 | (append (chess-legal-plies 120 | position :piece (if color ?P ?p) :file 1) 121 | (chess-legal-plies 122 | position :piece (if color ?B ?b))) 123 | (if (and (>= char ?a) 124 | (<= char ?h)) 125 | (chess-legal-plies position 126 | :piece (if color ?P ?p) 127 | :file (- char ?a)) 128 | (chess-legal-plies position 129 | :piece (if color 130 | (upcase char) 131 | (downcase char))))) 132 | (function 133 | (lambda (left right) 134 | (string-lessp (chess-ply-to-algebraic left) 135 | (chess-ply-to-algebraic right)))))))))) 136 | (let ((moves (delq nil (mapcar 'chess-input-test-move 137 | (cdr chess-input-moves))))) 138 | (cond 139 | ((or (= (length moves) 1) 140 | ;; if there is an exact match except for case, it must be an 141 | ;; abiguity between a bishop and a b-pawn move. In this 142 | ;; case, always take the b-pawn move; to select the bishop 143 | ;; move, use B to begin the keyboard shortcut 144 | (and (= (length moves) 2) 145 | (string= (downcase (chess-ply-to-algebraic (car moves))) 146 | (downcase (chess-ply-to-algebraic (cadr moves)))) 147 | (setq moves (cdr moves)))) 148 | (funcall chess-input-move-function nil (car moves)) 149 | (setq chess-input-move-string nil 150 | chess-input-moves nil 151 | chess-input-moves-pos nil)) 152 | ((null moves) 153 | (chess-input-shortcut-delete)) 154 | (t 155 | (chess-input-display-moves moves))))) 156 | 157 | (provide 'chess-input) 158 | 159 | ;;; chess-input.el ends here 160 | -------------------------------------------------------------------------------- /chess-irc.el: -------------------------------------------------------------------------------- 1 | ;;; chess-irc.el --- This transport uses an IRC bot to send/receive moves. 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; This is free software; you can redistribute it and/or modify it under 6 | ;; the terms of the GNU General Public License as published by the Free 7 | ;; Software Foundation; either version 3, or (at your option) any later 8 | ;; version. 9 | ;; 10 | ;; This is distributed in the hope that it will be useful, but WITHOUT 11 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 12 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 13 | ;; for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with GNU Emacs. If not, see . 17 | 18 | ;;; Commentary: 19 | 20 | ;;; Code: 21 | 22 | (require 'chess-network) 23 | 24 | (defgroup chess-irc nil 25 | "Use an IRC bot for sending/receiving moves." 26 | :group 'chess-engine) 27 | 28 | (defcustom chess-irc-server "irc.openprojects.net" 29 | "The IRC host to connect your chess-irc engine to." 30 | :type 'string 31 | :group 'chess-irc) 32 | 33 | (defcustom chess-irc-port 6667 34 | "The port of the IRC host specified by `chess-irc-server'." 35 | :type 'string 36 | :group 'chess-irc) 37 | 38 | (defcustom chess-irc-nick (user-login-name) 39 | "The nick you wish to use for sending/receiving IRC chess moves." 40 | :type 'string 41 | :group 'chess-irc) 42 | 43 | ;;; Code: 44 | 45 | (chess-message-catalog 'english 46 | '((opponent-says . "Your opponent says: %s") 47 | (irc-connecting . "Connecting to IRC server '%s:%d'...") 48 | (irc-logging-in . "Connected, now logging in as '%s'...") 49 | (irc-waiting . "Now waiting for 'name USER' via /msg, or `M-x chess-irc-engage'") 50 | (irc-challenge . "IRC nick of user to challenge: "))) 51 | 52 | (defvar chess-irc-regexp-alist 53 | (append chess-network-regexp-alist 54 | (list (cons ".+" 55 | (function 56 | (lambda () 57 | (chess-message 'opponent-says 58 | (match-string 0)))))))) 59 | 60 | (defvar chess-irc-process) 61 | (defvar chess-irc-engine) 62 | (defvar chess-irc-opponent) 63 | (defvar chess-irc-working nil) 64 | (defvar chess-irc-last-pos nil) 65 | (defvar chess-irc-use-ctcp nil) 66 | 67 | (make-variable-buffer-local 'chess-irc-process) 68 | (make-variable-buffer-local 'chess-irc-engine) 69 | (make-variable-buffer-local 'chess-irc-opponent) 70 | (make-variable-buffer-local 'chess-irc-working) 71 | (make-variable-buffer-local 'chess-irc-last-pos) 72 | (make-variable-buffer-local 'chess-irc-use-ctcp) 73 | 74 | (defun chess-irc-handler (game event &rest args) 75 | "This is an example of a generic transport engine." 76 | (unless chess-engine-handling-event 77 | (cond 78 | ((eq event 'initialize) 79 | (chess-message 'irc-connecting chess-irc-server chess-irc-port) 80 | (let ((engine (current-buffer)) proc) 81 | (with-current-buffer (generate-new-buffer " *chess-irc*") 82 | (setq chess-irc-engine engine 83 | proc (open-network-stream "*chess-irc*" (current-buffer) 84 | chess-irc-server chess-irc-port)) 85 | (chess-message 'irc-logging-in chess-irc-nick) 86 | (when (and proc (processp proc) 87 | (eq (process-status proc) 'open)) 88 | (process-send-string proc (format "USER %s 0 * :%s\n" 89 | (user-login-name) 90 | chess-full-name)) 91 | (process-send-string proc (format "NICK %s\n" chess-irc-nick)) 92 | (set-process-filter proc 'chess-irc-filter) 93 | (set-process-buffer proc (current-buffer)) 94 | (set-marker (process-mark proc) (point)) 95 | (chess-message 'irc-waiting))) 96 | (setq chess-irc-process proc)) 97 | t) 98 | 99 | ((eq event 'match) 100 | (setq chess-irc-opponent (read-string (chess-string 'irc-challenge))) 101 | (chess-network-handler 'match chess-irc-opponent)) 102 | 103 | ((eq event 'destroy) 104 | (chess-engine-send nil "quit") 105 | (process-send-string chess-irc-process "QUIT :Goodbye\n") 106 | (kill-buffer (process-buffer chess-irc-process))) 107 | 108 | ((eq event 'send) 109 | (process-send-string chess-irc-process 110 | (if chess-irc-use-ctcp 111 | (format "PRIVMSG %s :\C-aCHESS %s\C-a\n" 112 | chess-irc-opponent (car args)) 113 | (format "PRIVMSG %s :%s\n" 114 | chess-irc-opponent (car args))))) 115 | (t 116 | (apply 'chess-network-handler game event args))))) 117 | 118 | ;; This filter translates IRC syntax into basic chess-network protocol 119 | (defun chess-irc-filter (proc string) 120 | (let ((buf (process-buffer proc))) 121 | (when (buffer-live-p buf) 122 | (with-current-buffer buf 123 | (let ((moving (= (point) (process-mark proc)))) 124 | (save-excursion 125 | ;; Insert the text, advancing the marker. 126 | (goto-char (process-mark proc)) 127 | (while (string-match "\r" string) 128 | (setq string (replace-match "" t t string))) 129 | (insert string) 130 | (set-marker (process-mark proc) (point))) 131 | (if moving (goto-char (process-mark proc)))) 132 | (unless chess-irc-working 133 | (setq chess-irc-working t) 134 | (unwind-protect 135 | (progn 136 | (if chess-irc-last-pos 137 | (goto-char chess-irc-last-pos) 138 | (goto-char (point-min))) 139 | (beginning-of-line) 140 | (while (not (eobp)) 141 | (cond 142 | ((looking-at 143 | ":\\([^ \t\n!]+\\)!\\S-+ PRIVMSG \\(\\S-+\\) :\\(\C-aCHESS \\)?\\(.+\\)\C-a?\n") 144 | (let ((sender (match-string 1)) 145 | (target (match-string 2)) 146 | (ctcp (match-string 3)) 147 | (msg (match-string 4))) 148 | (with-current-buffer chess-irc-engine 149 | (when (and (string= chess-irc-nick target) 150 | (or (null chess-irc-opponent) 151 | (string= chess-irc-opponent sender))) 152 | (unless chess-irc-opponent 153 | (setq chess-irc-opponent sender)) 154 | (if (and (not chess-irc-use-ctcp) 155 | ctcp (> (length ctcp) 0)) 156 | (setq chess-irc-use-ctcp t)) 157 | (chess-engine-submit nil (concat msg "\n"))))))) 158 | (forward-line))) 159 | (setq chess-irc-last-pos (point) 160 | chess-irc-working nil))))))) 161 | 162 | (provide 'chess-irc) 163 | 164 | ;;; chess-irc.el ends here 165 | -------------------------------------------------------------------------------- /chess-kibitz.el: -------------------------------------------------------------------------------- 1 | ;;; chess-kibitz.el --- Chess kibitzing, stored as annotations 2 | 3 | ;; Copyright (C) 2002, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games 8 | 9 | ;; This is free software; you can redistribute it and/or modify it under 10 | ;; the terms of the GNU General Public License as published by the Free 11 | ;; Software Foundation; either version 3, or (at your option) any later 12 | ;; version. 13 | ;; 14 | ;; This is distributed in the hope that it will be useful, but WITHOUT 15 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 16 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 17 | ;; for more details. 18 | ;; 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with GNU Emacs. If not, see . 21 | 22 | ;;; Commentary: 23 | 24 | ;; Implements chess kibitzing, stored as annotations to the game being 25 | ;; viewed or played. C-c C-c is used to save a kibitzing comment. 26 | 27 | ;;; Code: 28 | 29 | (require 'chess-game) 30 | 31 | (defvar chess-kibitz-input-last nil) 32 | (defvar chess-kibitz-index nil) 33 | 34 | (make-variable-buffer-local 'chess-kibitz-input-last) 35 | (make-variable-buffer-local 'chess-kibitz-index) 36 | 37 | (define-derived-mode chess-kibitz-mode text-mode "Kibitz" 38 | "A mode for editing chess annotations." 39 | (set-buffer-modified-p nil) 40 | (setq chess-kibitz-input-last (copy-marker (point-max) t)) 41 | (let ((map (current-local-map))) 42 | (define-key map [(control ?c) (control ?c)] 'chess-kibitz-save))) 43 | 44 | (defvar chess-module-game) 45 | 46 | (defun chess-kibitz-save () 47 | (interactive) 48 | (let ((ann (buffer-substring-no-properties chess-kibitz-input-last 49 | (point-max)))) 50 | (chess-game-run-hooks chess-module-game 'kibitz ann) 51 | (chess-pos-add-annotation (chess-game-pos chess-kibitz-index) ann)) 52 | (set-marker chess-kibitz-input-last (point-max)) 53 | (set-buffer-modified-p nil)) 54 | 55 | (defun chess-kibitz-show-annotations (index) 56 | (setq chess-kibitz-index index) 57 | (erase-buffer) 58 | (let ((position (chess-game-pos chess-module-game index)) 59 | popup) 60 | (dolist (ann (chess-pos-annotations position)) 61 | (when (stringp ann) 62 | (insert ann ?\n) 63 | (setq popup t))) 64 | (if popup 65 | (display-buffer (current-buffer))))) 66 | 67 | (defun chess-kibitz-handler (game event &rest args) 68 | (cond 69 | ((eq event 'initialize) 70 | (kill-buffer (current-buffer)) 71 | (set-buffer (generate-new-buffer "*Annotations*")) 72 | (chess-kibitz-mode) 73 | t) 74 | 75 | ((eq event 'switch-to-annotations) 76 | (switch-to-buffer-other-window (current-buffer))) 77 | 78 | ((eq event 'kibitz) 79 | (chess-kibitz-handler 'switch-to-annotations) 80 | (save-excursion 81 | (goto-char chess-kibitz-input-last) 82 | (insert (car args)))) 83 | 84 | ((eq event 'set-index) 85 | (chess-kibitz-show-annotations (car args))) 86 | 87 | ((memq event '(post-undo move)) 88 | (chess-kibitz-show-annotations (chess-game-index game))))) 89 | 90 | (provide 'chess-kibitz) 91 | 92 | ;;; chess-kibitz.el ends here 93 | -------------------------------------------------------------------------------- /chess-link.el: -------------------------------------------------------------------------------- 1 | ;;; chess-link.el --- Connect two engines 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; This is free software; you can redistribute it and/or modify it under 6 | ;; the terms of the GNU General Public License as published by the Free 7 | ;; Software Foundation; either version 3, or (at your option) any later 8 | ;; version. 9 | ;; 10 | ;; This is distributed in the hope that it will be useful, but WITHOUT 11 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 12 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 13 | ;; for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with GNU Emacs. If not, see . 17 | 18 | ;;; Commentary: 19 | 20 | ;; A module for connecting two engines. If one is a protocol 21 | ;; transport (like chess-network), and the other is a computing engine 22 | ;; (like chess-gnuchess), this will allow you to expose a bot over the 23 | ;; channel. 24 | 25 | ;;; Code: 26 | 27 | (require 'chess) 28 | (require 'chess-engine) 29 | 30 | (defun chess-link-response-handler (event &rest args) 31 | "This function handles responses from the bot's computing engine." 32 | (let ((first-engine 33 | (chess-game-data (chess-engine-game nil) 'first-engine)) 34 | (second-engine 35 | (chess-game-data (chess-engine-game nil) 'second-engine)) 36 | return-value) 37 | (cond 38 | ((eq event 'match) 39 | (chess-engine-command nil 'accept) 40 | t) 41 | 42 | (t 43 | (let ((chess-engine-inhibit-auto-pass t)) 44 | (setq return-value 45 | (apply 'chess-engine-default-handler event args))) 46 | 47 | ;; but now transfer the event to the other engine 48 | (apply 'chess-engine-command 49 | (if (eq (current-buffer) first-engine) 50 | second-engine 51 | first-engine) event args) 52 | 53 | return-value)))) 54 | 55 | (defun chess-link-connect (first-engine second-engine) 56 | "Connect two engines, so that they rely events back and forth." 57 | (chess-engine-set-response-handler first-engine 58 | 'chess-link-response-handler) 59 | (chess-engine-set-response-handler second-engine 60 | 'chess-link-response-handler)) 61 | 62 | ;;;###autoload 63 | (defun chess-link (first-engine-type second-engine-type) 64 | "Play out a game between two engines, and watch the progress. 65 | If you want to run an engine as a bot, make the transport the first 66 | engine, and the computer the second engine." 67 | (interactive "sFirst engine: \nsSecond engine: ") 68 | (setq first-engine-type (intern (concat "chess-" first-engine-type)) 69 | second-engine-type (intern (concat "chess-" second-engine-type))) 70 | (let* ((my-color t) ; we start out as white always 71 | (display (chess-create-display my-color)) 72 | (game (chess-display-game display))) 73 | (chess-game-set-data game 'my-color my-color) 74 | (chess-module-set-leader display) 75 | (chess-display-disable-popup display) 76 | (condition-case err 77 | (when (and (require first-engine-type) 78 | (require second-engine-type)) 79 | (let ((first-engine 80 | (chess-engine-create first-engine-type game)) 81 | (second-engine 82 | (chess-engine-create second-engine-type game))) 83 | 84 | (chess-game-set-data game 'first-engine first-engine) 85 | (chess-engine-command first-engine 'ready) 86 | 87 | (chess-game-set-data game 'second-engine second-engine) 88 | (chess-link-connect first-engine second-engine) 89 | (chess-engine-command second-engine 'ready) 90 | 91 | ;; tell the first engine to start moving 92 | (chess-engine-command first-engine 'pass)) 93 | 94 | (chess-display-update display) 95 | (chess-display-popup display)) 96 | (error 97 | (chess-module-destroy display) 98 | (error (error-message-string err)))))) 99 | 100 | (provide 'chess-link) 101 | 102 | ;;; chess-link.el ends here 103 | -------------------------------------------------------------------------------- /chess-log.el: -------------------------------------------------------------------------------- 1 | ;;; chess-log.el --- Log chess events, as an aid to debugging 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; This is free software; you can redistribute it and/or modify it under 6 | ;; the terms of the GNU General Public License as published by the Free 7 | ;; Software Foundation; either version 3, or (at your option) any later 8 | ;; version. 9 | ;; 10 | ;; This is distributed in the hope that it will be useful, but WITHOUT 11 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 12 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 13 | ;; for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with GNU Emacs. If not, see . 17 | 18 | ;;; Commentary: 19 | 20 | ;;; Code: 21 | 22 | (require 'chess-module) 23 | 24 | (defgroup chess-log nil 25 | "Code for logging chess events." 26 | :group 'chess) 27 | 28 | (defun chess-log (&rest args) 29 | (with-current-buffer (get-buffer-create "*Chess Log*") 30 | (insert (apply 'format args) ?\n))) 31 | 32 | (provide 'chess-log) 33 | 34 | ;;; chess-log.el ends here 35 | -------------------------------------------------------------------------------- /chess-maint.el: -------------------------------------------------------------------------------- 1 | ;;; chess-maint.el --- code to help build chess -*- no-byte-compile: t -*- 2 | 3 | ;; Copyright (C) 2008 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | 7 | ;; This file is part of GNU Emacs. 8 | 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; GNU Emacs is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with GNU Emacs. If not, see . 21 | 22 | ;;; Code: 23 | 24 | (provide 'chess-maint) 25 | 26 | (defun chess-generate-autoloads () 27 | (interactive) 28 | (require 'autoload) 29 | (setq generated-autoload-file 30 | (expand-file-name (car command-line-args-left))) 31 | (setq command-line-args-left (cdr command-line-args-left)) 32 | (batch-update-autoloads)) 33 | 34 | ;;; chess-maint.el ends here 35 | -------------------------------------------------------------------------------- /chess-message.el: -------------------------------------------------------------------------------- 1 | ;;; chess-message.el --- Code shared by all chess displays 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; This is free software; you can redistribute it and/or modify it under 6 | ;; the terms of the GNU General Public License as published by the Free 7 | ;; Software Foundation; either version 3, or (at your option) any later 8 | ;; version. 9 | ;; 10 | ;; This is distributed in the hope that it will be useful, but WITHOUT 11 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 12 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 13 | ;; for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with GNU Emacs. If not, see . 17 | 18 | ;;; Commentary: 19 | 20 | ;;; Code: 21 | 22 | (defgroup chess-message nil 23 | "Support for message catalogs in chess.el." 24 | :group 'chess) 25 | 26 | (defcustom chess-message-language 'english 27 | "The language to use when reporting messages." 28 | :type 'symbol 29 | :group 'chess-message) 30 | 31 | ;;; Code: 32 | 33 | (defvar chess-message-catalog nil) 34 | 35 | (defun chess-message-catalog (catalog definitions) 36 | (let ((entry (assq catalog chess-message-catalog))) 37 | (if entry 38 | (dolist (def definitions) 39 | (let ((str (assq (car def) (cdr entry)))) 40 | (if str 41 | (setcdr str (cdr def)) 42 | (setcdr entry (cons def (cdr entry)))))) 43 | (push (cons catalog definitions) chess-message-catalog)))) 44 | 45 | (defun chess-string (key &rest arguments) 46 | (let* ((entry (assq chess-message-language chess-message-catalog)) 47 | (msg (and entry (cdr (assq key (cdr entry)))))) 48 | (if msg 49 | (apply 'format msg arguments) 50 | (format "Message not found: %s" key)))) 51 | 52 | (defsubst chess-message (key &rest arguments) 53 | (message (apply 'chess-string key arguments))) 54 | 55 | (defsubst chess-error (key &rest arguments) 56 | (error (apply 'chess-string key arguments))) 57 | 58 | (put 'chess-message-catalog 'lisp-indent-function 1) 59 | 60 | (provide 'chess-message) 61 | 62 | ;;; chess-message.el ends here 63 | -------------------------------------------------------------------------------- /chess-module.el: -------------------------------------------------------------------------------- 1 | ;;; chess-module.el --- Basic module support code underlying all chess.el modules 2 | 3 | ;; Copyright (C) 2002, 2004, 2008, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Keywords: games 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Code: 22 | 23 | (eval-when-compile (require 'cl-lib)) 24 | 25 | (require 'chess-game) 26 | 27 | (defvar chess-module-game nil) 28 | (defvar chess-module-event-handler nil) 29 | (defvar chess-module-leader nil) 30 | 31 | (make-variable-buffer-local 'chess-module-game) 32 | (make-variable-buffer-local 'chess-module-event-handler) 33 | (make-variable-buffer-local 'chess-module-leader) 34 | 35 | (chess-message-catalog 'english 36 | '((no-such-module . "There is no module named '%s'"))) 37 | 38 | (defmacro chess-with-current-buffer (buffer &rest body) 39 | `(let ((buf ,buffer)) 40 | (if buf 41 | (with-current-buffer buf 42 | ,@body) 43 | ,@body))) 44 | 45 | (put 'chess-with-current-buffer 'lisp-indent-function 1) 46 | 47 | (defun chess-module-create (derived game &optional buffer-name 48 | &rest ctor-args) 49 | (let* ((name (symbol-name derived)) 50 | handler) 51 | (unless (and (require derived nil t) 52 | (setq handler (intern-soft (concat name "-handler")))) 53 | (chess-error 'no-such-module name)) 54 | (with-current-buffer (generate-new-buffer (or buffer-name 55 | (format " *%s*" name))) 56 | (if (not (apply handler game 'initialize ctor-args)) 57 | (ignore 58 | (kill-buffer (current-buffer))) 59 | (add-hook 'kill-buffer-hook 'chess-module-destroy nil t) 60 | (setq chess-module-event-handler handler) 61 | (chess-module-set-game* nil game) 62 | (current-buffer))))) 63 | 64 | (defun chess-module-game (module) 65 | (chess-with-current-buffer module 66 | chess-module-game)) 67 | 68 | (defun chess-module-game-index (module) 69 | (chess-with-current-buffer module 70 | (chess-game-index chess-module-game))) 71 | 72 | (defun chess-module-detach-game (module) 73 | (chess-with-current-buffer module 74 | (chess-game-remove-hook chess-module-game 75 | 'chess-module-event-handler 76 | (or module (current-buffer))) 77 | ;; if we are the leader, shutdown the game we were attached to 78 | ;; previously 79 | (if chess-module-leader 80 | (chess-game-run-hooks chess-module-game 'destroy)))) 81 | 82 | (defun chess-module-set-game (module game &optional no-setup) 83 | (chess-with-current-buffer module 84 | (let ((chess-game-inhibit-events no-setup)) 85 | (chess-game-copy-game chess-module-game game)))) 86 | 87 | (defun chess-module-set-game* (module game) 88 | (chess-with-current-buffer module 89 | (cl-assert game) 90 | (if chess-module-game 91 | (chess-module-detach-game nil)) 92 | (setq chess-module-game game) 93 | (chess-game-add-hook game 'chess-module-event-handler 94 | (or module (current-buffer))))) 95 | 96 | (defsubst chess-module-leader-p (module) 97 | (chess-with-current-buffer module 98 | chess-module-leader)) 99 | 100 | (defsubst chess-module-set-leader (module) 101 | (chess-with-current-buffer module 102 | (setq chess-module-leader t))) 103 | 104 | (defsubst chess-module-clear-leader (module) 105 | (chess-with-current-buffer module 106 | (setq chess-module-leader nil))) 107 | 108 | (defun chess-module-destroy (&optional module) 109 | (let ((buf (or module (current-buffer)))) 110 | (when (buffer-live-p buf) 111 | (with-current-buffer buf 112 | (remove-hook 'kill-buffer-hook 'chess-module-destroy t) 113 | (chess-module-detach-game nil)) 114 | (kill-buffer buf)))) 115 | 116 | (defun chess-module-event-handler (game object event &rest args) 117 | (with-current-buffer object 118 | (apply chess-module-event-handler game event args) 119 | (if (eq event 'destroy) 120 | (chess-module-destroy nil)))) 121 | 122 | (provide 'chess-module) 123 | 124 | ;;; chess-module.el ends here 125 | -------------------------------------------------------------------------------- /chess-network.el: -------------------------------------------------------------------------------- 1 | ;;; chess-network.el --- Play against an opponent over the network 2 | 3 | ;; Copyright (C) 2002, 2003, 2008 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Code: 23 | 24 | (require 'chess-common) 25 | (require 'chess-fen) 26 | 27 | (defvar chess-network-regexp-alist 28 | (list 29 | (cons (concat chess-algebraic-regexp "$") 30 | (function 31 | (lambda () 32 | (funcall chess-engine-response-handler 'move 33 | (chess-engine-convert-algebraic (match-string 0)))))) 34 | (cons "chess match\\(\\s-+\\(.+\\)\\)?$" 35 | (function 36 | (lambda () 37 | (funcall chess-engine-response-handler 'match 38 | (match-string 2))))) 39 | (cons "fen\\s-+\\(.+\\)" 40 | (function 41 | (lambda () 42 | (funcall chess-engine-response-handler 'setup-pos 43 | (chess-engine-convert-fen (match-string 1)))))) 44 | (cons "pgn\\s-+\\(.+\\)" 45 | (function 46 | (lambda () 47 | (funcall chess-engine-response-handler 'setup-game 48 | (chess-engine-convert-pgn 49 | (chess-network-parse-multiline (match-string 1))))))) 50 | (cons "pass$" 51 | (function 52 | (lambda () 53 | (funcall chess-engine-response-handler 'pass)))) 54 | (cons "quit$" 55 | (function 56 | (lambda () 57 | (funcall chess-engine-response-handler 'quit)))) 58 | (cons "resign$" 59 | (function 60 | (lambda () 61 | (funcall chess-engine-response-handler 'resign)))) 62 | (cons "draw$" 63 | (function 64 | (lambda () 65 | (funcall chess-engine-response-handler 'draw)))) 66 | (cons "abort$" 67 | (function 68 | (lambda () 69 | (funcall chess-engine-response-handler 'abort)))) 70 | (cons "takeback\\s-+\\([0-9]+\\)$" 71 | (function 72 | (lambda () 73 | (funcall chess-engine-response-handler 'undo 74 | (string-to-number (match-string 1)))))) 75 | (cons "accept\\(\\s-+\\(.+\\)\\)?$" 76 | (function 77 | (lambda () 78 | (funcall chess-engine-response-handler 'accept 79 | (match-string 2))))) 80 | (cons "decline$" 81 | (function 82 | (lambda () 83 | (funcall chess-engine-response-handler 'decline)))) 84 | (cons "retract$" 85 | (function 86 | (lambda () 87 | (funcall chess-engine-response-handler 'retract)))) 88 | (cons "illegal$" 89 | (function 90 | (lambda () 91 | (funcall chess-engine-response-handler 'illegal)))) 92 | (cons "flag$" 93 | (function 94 | (lambda () 95 | (funcall chess-engine-response-handler 'call-flag)))) 96 | (cons "forfeit$" 97 | (function 98 | (lambda () 99 | (funcall chess-engine-response-handler 'flag-fell)))) 100 | (cons "kibitz\\s-+\\(.+\\)$" 101 | (function 102 | (lambda () 103 | (funcall chess-engine-response-handler 'kibitz 104 | (chess-network-parse-multiline (match-string 1)))))) 105 | (cons "chat\\s-+\\(.+\\)$" 106 | (function 107 | (lambda () 108 | (funcall chess-engine-response-handler 'chat 109 | (chess-network-parse-multiline (match-string 1)))))))) 110 | 111 | (chess-message-catalog 'english 112 | '((network-starting . "Starting network client/server...") 113 | (network-waiting . "Now waiting for your opponent to connect...") 114 | (takeback-sent . "Sent request to undo %d ply(s) to your opponent"))) 115 | 116 | (defun chess-network-flatten-multiline (str) 117 | (while (string-match "\n" str) 118 | (setq str (replace-match "\C-k" t t str))) 119 | str) 120 | 121 | (defun chess-network-parse-multiline (str) 122 | (while (string-match "\C-k" str) 123 | (setq str (replace-match "\n" t t str))) 124 | str) 125 | 126 | (defvar chess-network-kind) 127 | (make-variable-buffer-local 'chess-network-kind) 128 | 129 | (defun chess-network-handler (game event &rest args) 130 | "Initialize the network chess engine." 131 | (unless chess-engine-handling-event 132 | (cond 133 | ((eq event 'initialize) 134 | (let* ((cursor-in-echo-area t) 135 | (which (read-char "Are you the c)lient or s)erver? ")) 136 | proc) 137 | (chess-message 'network-starting) 138 | (setq proc 139 | (if (eq which ?s) 140 | (if (fboundp 'open-network-stream-server) 141 | (open-network-stream-server "*chess-network*" 142 | (current-buffer) 143 | (string-to-number 144 | (read-string "Port: "))) 145 | (start-process "*chess-network*" 146 | (current-buffer) (executable-find "nc") 147 | "-l" "-p" (read-string "Port: "))) 148 | (open-network-stream "*chess-network*" (current-buffer) 149 | (read-string "Host: ") 150 | (read-string "Port: ")))) 151 | (setq chess-engine-process proc 152 | chess-network-kind (if (eq which ?s) 'server 'client)) 153 | t)) 154 | 155 | ((eq event 'ready) ; don't set active yet 156 | (chess-game-run-hooks game 'announce-autosave) 157 | (if (eq chess-network-kind 'server) 158 | (chess-message 'network-waiting) 159 | (chess-network-handler game 'match))) 160 | 161 | ((eq event 'setup-pos) 162 | (chess-engine-send nil (format "fen %s\n" 163 | (chess-pos-to-fen (car args))))) 164 | 165 | ((eq event 'setup-game) 166 | (chess-engine-send nil (format "pgn %s\n" 167 | (chess-network-flatten-multiline 168 | (chess-game-to-string (car args)))))) 169 | 170 | ((eq event 'pass) 171 | (chess-engine-send nil "pass\n")) 172 | 173 | ((eq event 'busy) 174 | (chess-engine-send nil "playing\n")) 175 | 176 | ((eq event 'match) 177 | (setq chess-engine-pending-offer 'match) 178 | (chess-engine-send nil (format "chess match %s\n" chess-full-name))) 179 | 180 | ((eq event 'draw) 181 | (if chess-engine-pending-offer 182 | (chess-engine-command nil 'retract)) 183 | (setq chess-engine-pending-offer 'draw) 184 | (chess-engine-send nil "draw\n")) 185 | 186 | ((eq event 'abort) 187 | (if chess-engine-pending-offer 188 | (chess-engine-command nil 'retract)) 189 | (setq chess-engine-pending-offer 'abort) 190 | (chess-engine-send nil "abort\n")) 191 | 192 | ((eq event 'undo) 193 | (if chess-engine-pending-offer 194 | (chess-engine-command nil 'retract)) 195 | (setq chess-engine-pending-offer 'undo 196 | chess-engine-pending-arg (car args)) 197 | 198 | (chess-engine-send nil (format "takeback %d\n" (car args))) 199 | (chess-message 'takeback-sent (car args))) 200 | 201 | ((eq event 'accept) 202 | (chess-engine-send nil (if (car args) 203 | (format "accept %s\n" (car args)) 204 | "accept\n"))) 205 | 206 | ((eq event 'decline) 207 | (chess-engine-send nil "decline\n")) 208 | 209 | ((eq event 'retract) 210 | (chess-engine-send nil "retract\n")) 211 | 212 | ((eq event 'illegal) 213 | (chess-engine-send nil "illegal\n")) 214 | 215 | ((eq event 'call-flag) 216 | (chess-engine-send nil "flag\n")) 217 | 218 | ((eq event 'kibitz) 219 | (chess-engine-send nil (format "kibitz %s\n" 220 | (chess-network-flatten-multiline 221 | (car args))))) 222 | 223 | ((eq event 'chat) 224 | (chess-engine-send nil (format "chat %s\n" 225 | (chess-network-flatten-multiline 226 | (car args))))) 227 | 228 | ((eq event 'set-index) 229 | (chess-engine-send nil (format "index %d\n" (car args)))) 230 | 231 | ((eq event 'flag-fell) 232 | (chess-engine-send nil "forfeit\n") 233 | (chess-common-handler game 'flag-fell)) 234 | 235 | (t 236 | (apply 'chess-common-handler game event args))))) 237 | 238 | (provide 'chess-network) 239 | 240 | ;;; chess-network.el ends here 241 | -------------------------------------------------------------------------------- /chess-none.el: -------------------------------------------------------------------------------- 1 | ;;; chess-none.el --- Null engine 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; This is free software; you can redistribute it and/or modify it under 6 | ;; the terms of the GNU General Public License as published by the Free 7 | ;; Software Foundation; either version 3, or (at your option) any later 8 | ;; version. 9 | ;; 10 | ;; This is distributed in the hope that it will be useful, but WITHOUT 11 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 12 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 13 | ;; for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with GNU Emacs. If not, see . 17 | 18 | ;;; Commentary: 19 | 20 | ;; A null engine, used when two humans play against each other on the 21 | ;; same display. 22 | 23 | ;;; Code: 24 | 25 | (require 'chess-engine) 26 | 27 | (defvar chess-none-regexp-alist nil) 28 | 29 | (defun chess-none-handler (game event &rest args) 30 | "An empty chess engine, used for fielding key events. 31 | This is only useful when two humans are playing each other, in which 32 | case this engine will do the job of accepting undos, handling 33 | resignations, etc." 34 | (unless chess-engine-handling-event 35 | (cond 36 | ((eq event 'initialize) t) 37 | 38 | ((memq event '(resign abort)) 39 | (chess-engine-set-position nil)) 40 | 41 | ((eq event 'undo) 42 | (chess-game-undo game (car args)))))) 43 | 44 | (provide 'chess-none) 45 | 46 | ;;; chess-none.el ends here 47 | -------------------------------------------------------------------------------- /chess-phalanx.el: -------------------------------------------------------------------------------- 1 | ;;; chess-phalanx.el --- Play chess against phalanx! 2 | 3 | ;; Copyright (C) 2002, 2004 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games, processes 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Code: 23 | 24 | (require 'chess-common) 25 | 26 | (defgroup chess-phalanx nil 27 | "The publicly available chess engine 'phalanx'." 28 | :group 'chess-engine 29 | :link '(url-link "http://phalanx.sourceforge.net/")) 30 | 31 | (defcustom chess-phalanx-path (executable-find "phalanx") 32 | "The path to the phalanx executable." 33 | :type 'file 34 | :group 'chess-phalanx) 35 | 36 | (defvar chess-phalanx-regexp-alist 37 | (list 38 | (cons (concat "my move is P?\\(" chess-algebraic-regexp "\\)\\s-*$") 39 | (function 40 | (lambda () 41 | (funcall chess-engine-response-handler 'move 42 | (chess-engine-convert-algebraic (match-string 1) t))))) 43 | (cons "Illegal move:\\s-*\\(.*\\)" 44 | (function 45 | (lambda () 46 | (error (match-string 1))))))) 47 | 48 | (defun chess-phalanx-handler (game event &rest args) 49 | (unless chess-engine-handling-event 50 | (cond 51 | ((eq event 'initialize) 52 | (let ((proc (chess-common-handler game 'initialize "phalanx"))) 53 | (when (and proc (processp proc) 54 | (eq (process-status proc) 'run)) 55 | (process-send-string proc "nopost\n") 56 | (setq chess-engine-process proc 57 | chess-engine-opponent-name "Phalanx") 58 | t))) 59 | 60 | ((eq event 'resign) 61 | (chess-game-set-data game 'active nil)) 62 | 63 | (t 64 | (apply 'chess-common-handler game event args))))) 65 | 66 | (provide 'chess-phalanx) 67 | 68 | ;;; chess-phalanx.el ends here 69 | -------------------------------------------------------------------------------- /chess-polyglot.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/chess-polyglot.bin -------------------------------------------------------------------------------- /chess-puzzle.el: -------------------------------------------------------------------------------- 1 | ;;; chess-puzzle.el --- Support for viewing and solving chess puzzles 2 | 3 | ;; Copyright (C) 2002, 2004, 2008, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Commentary: 23 | 24 | ;; WARNING: While this module does handle *some* chess puzzle data, 25 | ;; it is not complete yet. In particular, PGN based puzzles inclusing 26 | ;; variation annotations are not properly handled yet. 27 | 28 | ;;; Code: 29 | 30 | (require 'chess) 31 | (require 'chess-algebraic) 32 | (require 'chess-database) 33 | (require 'chess-display) 34 | (require 'chess-engine) 35 | (require 'chess-game) 36 | (require 'chess-random) 37 | 38 | (defgroup chess-puzzle nil 39 | "A mode for playing games from a database of puzzles." 40 | :group 'chess) 41 | 42 | (defcustom chess-puzzle-auto-next nil 43 | "If non-nil, move to the next puzzle once the position is won." 44 | :type 'boolean 45 | :group 'chess-puzzle) 46 | 47 | (defcustom chess-puzzle-default-file nil 48 | "Default file in which to search for chess puzzles. 49 | 50 | If non-nil, `chess-puzzle' will interpret the value as either a 51 | puzzle file to load or a directory in which to look for puzzle 52 | file to load. When nil, `chess-puzzle' will read files from 53 | current directory." 54 | :type 'file 55 | :group 'chess-puzzle) 56 | 57 | (defcustom chess-puzzle-autoload-file nil 58 | "Avoid prompting for puzzle file if `chess-puzzle-default-file' is a pgn file. 59 | 60 | If non-nil, don't use `chess-puzzle-default-file' as the default 61 | in the read file prompt for `chess-puzzle', and instead simply load 62 | it. Useful if you have all of your puzzles in a single file." 63 | :type 'boolean 64 | :group 'chess-puzzle) 65 | 66 | (defvar chess-puzzle-indices nil) 67 | (defvar chess-puzzle-position nil) 68 | 69 | (make-variable-buffer-local 'chess-puzzle-indices) 70 | (make-variable-buffer-local 'chess-puzzle-position) 71 | 72 | (chess-message-catalog 'english 73 | '((bad-game-read . "Error reading game at position %d") 74 | (end-of-puzzles . "There are no more puzzles in this collection"))) 75 | 76 | ;;;###autoload 77 | (defun chess-puzzle-set-default-file (file) 78 | "Set the default puzzle file to FILE for the current session. 79 | 80 | Useful mostly if you use `chess-puzzle-autoload-file'." 81 | (interactive 82 | (list (let* ((file-name (or chess-puzzle-default-file 83 | (file-name-directory (buffer-file-name)))) 84 | (file-p (not (file-directory-p file-name))) 85 | (def-file (read-file-name 86 | "Set puzzle file to: " 87 | (file-name-directory file-name) 88 | (when file-p file-name) t))) 89 | (if (file-directory-p def-file) 90 | (file-name-as-directory def-file) 91 | def-file)))) 92 | (setq chess-puzzle-default-file file) 93 | (when (yes-or-no-p "Load a chess puzzle?: ") 94 | (let ((chess-puzzle-autoload-file t)) 95 | (call-interactively 'chess-puzzle))) 96 | (message "chess-puzzle-default-file set to '%s'" file)) 97 | 98 | ;;;###autoload 99 | (defun chess-puzzle (file &optional index) ;FIXME: index not used! 100 | "Pick a random puzzle from FILE, and solve it against the default engine. 101 | The spacebar in the display buffer is bound to `chess-puzzle-next', 102 | making it easy to go on to the next puzzle once you've solved one." 103 | (interactive 104 | (list (let* ((file-name (or chess-puzzle-default-file 105 | (file-name-directory (buffer-file-name)))) 106 | (file-p (not (file-directory-p file-name))) 107 | (auto-load (and file-p chess-puzzle-autoload-file))) 108 | (if (not auto-load) 109 | (read-file-name 110 | (format "Read chess puzzles from%s: " 111 | (if file-p 112 | (concat 113 | " (" 114 | (file-name-nondirectory file-name) 115 | ")") 116 | "")) 117 | (file-name-directory file-name) 118 | (when file-p file-name) t) 119 | file-name)))) 120 | 121 | (let* ((database (chess-database-open file)) 122 | (objects (and database (chess-session))) 123 | (engine (car objects)) 124 | (display (cadr objects))) 125 | (when database 126 | (if engine 127 | (chess-engine-set-option engine 'resign nil)) 128 | (with-current-buffer display 129 | (chess-game-set-data (chess-display-game nil) 'database database) 130 | (if chess-puzzle-auto-next 131 | (chess-game-add-hook (chess-display-game nil) 132 | 'chess-puzzle-handler display)) 133 | (define-key (current-local-map) [? ] 'chess-puzzle-next) 134 | (define-key (current-local-map) [??] 'chess-puzzle-show-solution) 135 | (let ((count (chess-database-count database))) 136 | (setq chess-puzzle-indices (make-vector count nil)) 137 | (dotimes (i count) 138 | (aset chess-puzzle-indices i i)) 139 | (random t) 140 | (chess-shuffle-vector chess-puzzle-indices) 141 | (setq chess-puzzle-position 0)) 142 | (chess-game-run-hooks (chess-display-game display) 'disable-autosave) 143 | (chess-puzzle-next))))) 144 | 145 | (defvar chess-display-handling-event) 146 | 147 | (defun chess-puzzle-next () 148 | "Play the next puzzle in the collection, selected randomly." 149 | (interactive) 150 | (let* ((game (chess-display-game nil)) 151 | (database (chess-game-data game 'database)) 152 | (index chess-puzzle-position) 153 | next-game) 154 | (if (= index (length chess-puzzle-indices)) 155 | (chess-message 'end-of-puzzles) 156 | ;; setup and load the next puzzle position 157 | (setq chess-puzzle-position (1+ chess-puzzle-position)) 158 | (if (null (setq next-game 159 | (chess-database-read database 160 | (aref chess-puzzle-indices index)))) 161 | (chess-error 'bad-game-read (aref chess-puzzle-indices index)) 162 | (chess-display-set-game nil next-game 0) 163 | (chess-game-set-data game 'my-color (chess-game-side-to-move game 0)) 164 | (dolist (key '(database database-index database-count)) 165 | (chess-game-set-data game key (chess-game-data next-game key))) 166 | (let ((chess-display-handling-event nil)) 167 | (chess-game-run-hooks game 'orient)))))) 168 | 169 | (defun chess-puzzle-show-solution () 170 | (interactive) 171 | (let ((game (chess-display-game nil))) 172 | (when game 173 | (let ((bm (chess-pos-epd (chess-game-pos game 0) 'bm)) 174 | (pv (chess-pos-epd (chess-game-pos game 0) 'pv))) 175 | (when (or bm pv) 176 | (message "Best move %s %s%s" 177 | (if (zerop (chess-game-index game)) "is" "would have been") 178 | (chess-ply-to-algebraic (car bm)) 179 | (if pv 180 | (concat ", predicted variation " 181 | (chess-var-to-algebraic pv)) 182 | ""))))))) 183 | 184 | 185 | (defun chess-puzzle-handler (game display event &rest _args) 186 | (if (and (eq event 'move) 187 | (chess-game-over-p game)) 188 | (with-current-buffer display 189 | (chess-puzzle-next)))) 190 | 191 | (provide 'chess-puzzle) 192 | 193 | ;;; chess-puzzle.el ends here 194 | -------------------------------------------------------------------------------- /chess-random.el: -------------------------------------------------------------------------------- 1 | ;;; chess-random.el --- Generate Fischer Random style positions 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; This is free software; you can redistribute it and/or modify it under 6 | ;; the terms of the GNU General Public License as published by the Free 7 | ;; Software Foundation; either version 3, or (at your option) any later 8 | ;; version. 9 | ;; 10 | ;; This is distributed in the hope that it will be useful, but WITHOUT 11 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 12 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 13 | ;; for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with GNU Emacs. If not, see . 17 | 18 | ;;; Commentary: 19 | 20 | ;; Just call `chess-fischer-random-position' to generate such a 21 | ;; position. 22 | 23 | ;;; Code: 24 | 25 | (require 'chess-pos) 26 | 27 | (defvar pieces-vector [?r ?n ?b ?q ?k ?b ?n ?r]) 28 | 29 | (defun chess-shuffle-vector (vector) 30 | "Randomly permute the elements of VECTOR (all permutations equally likely)" 31 | (let ((i 0) 32 | j 33 | temp 34 | (len (length vector))) 35 | (while (< i len) 36 | (setq j (+ i (random (- len i)))) 37 | (setq temp (aref vector i)) 38 | (aset vector i (aref vector j)) 39 | (aset vector j temp) 40 | (setq i (1+ i)))) 41 | vector) 42 | 43 | ;;;###autoload 44 | (defun chess-fischer-random-position () 45 | "Generate a Fischer Random style position." 46 | (let (pieces position) 47 | (while (null position) 48 | (setq pieces (chess-shuffle-vector pieces-vector)) 49 | (let (first-bishop first-rook king) 50 | (catch 'retry 51 | (dotimes (i 8) 52 | (let ((piece (aref pieces i))) 53 | (cond 54 | ((= ?b piece) 55 | (if first-bishop 56 | (if (= (mod i 2) first-bishop) 57 | (throw 'retry t)) 58 | (setq first-bishop (mod i 2)))) 59 | ((= ?k piece) 60 | (if (null first-rook) 61 | (throw 'retry t)) 62 | (setq king i)) 63 | ((= ?r piece) 64 | (if first-rook 65 | (if (null king) 66 | (throw 'retry t)) 67 | (setq first-rook i)))))) 68 | (setq position (chess-pos-create))))) 69 | 70 | ;; set the home row pieces 71 | (dotimes (i 8) 72 | (chess-pos-set-piece position (chess-rf-to-index 0 i) 73 | (aref pieces i)) 74 | (chess-pos-set-piece position (chess-rf-to-index 7 i) 75 | (upcase (aref pieces i)))) 76 | 77 | position)) 78 | 79 | (provide 'chess-random) 80 | 81 | ;;; chess-random.el ends here 82 | -------------------------------------------------------------------------------- /chess-sjeng.el: -------------------------------------------------------------------------------- 1 | ;;; chess-sjeng.el --- Play against sjeng! 2 | 3 | ;; Copyright (C) 2004 Free Software Foundation, Inc. 4 | 5 | ;; Author: Mario Lang 6 | ;; Keywords: games, processes 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Code: 22 | 23 | (require 'chess-common) 24 | (require 'chess-fen) 25 | 26 | (defgroup chess-sjeng nil 27 | "The publicly available chess engine 'sjeng'." 28 | :group 'chess-engine 29 | :link '(url-link "http://sjeng.sourceforge.net")) 30 | 31 | (defcustom chess-sjeng-path (executable-find "sjeng") 32 | "*The path to the sjeng executable." 33 | :type 'file 34 | :group 'chess-sjeng) 35 | 36 | (defvar chess-sjeng-evaluation nil) 37 | 38 | (make-variable-buffer-local 'chess-sjeng-evaluation) 39 | 40 | (defvar chess-sjeng-regexp-alist 41 | (list 42 | (cons (concat "move\\s-+\\(" chess-algebraic-regexp "\\)\\s-*$") 43 | (function 44 | (lambda () 45 | (funcall chess-engine-response-handler 'move 46 | (chess-engine-convert-algebraic (match-string 1) t))))) 47 | (cons "tellics set 1\\s-+\\(.+\\)$" 48 | (function 49 | (lambda () 50 | (setq chess-engine-opponent-name (match-string 1))))) 51 | (cons "{\\(Black\\|White\\) resigns}" 52 | (function 53 | (lambda () 54 | (funcall chess-engine-response-handler 'resign)))) 55 | (cons "\\(Illegal move\\|unrecognized/illegal command\\):\\s-*\\(.*\\)" 56 | (function 57 | (lambda () 58 | (error (match-string 1))))) 59 | (cons "command not legal now" 60 | (function 61 | (lambda () 62 | (error (match-string 0))))))) 63 | 64 | (defun chess-sjeng-handler (game event &rest args) 65 | (unless chess-engine-handling-event 66 | (cond 67 | ((eq event 'initialize) 68 | (let ((proc (chess-common-handler game 'initialize "sjeng"))) 69 | (when (and proc (processp proc) 70 | (eq (process-status proc) 'run)) 71 | (process-send-string proc "xboard\nnew\n") 72 | (setq chess-engine-process proc) 73 | t))) 74 | 75 | ((eq event 'setup-pos) 76 | (chess-engine-send nil (format "setboard %s\n" 77 | (chess-pos-to-fen (car args))))) 78 | 79 | ((eq event 'move) 80 | (when (= 1 (chess-game-index game)) 81 | (chess-game-set-tag game "White" chess-full-name) 82 | (chess-game-set-tag game "Black" chess-engine-opponent-name)) 83 | 84 | (chess-engine-send 85 | nil 86 | (concat (chess-index-to-coord (chess-ply-source (car args))) 87 | (chess-index-to-coord (chess-ply-target (car args))) 88 | (if (chess-ply-keyword (car args) :promote) 89 | (string (downcase (chess-ply-keyword (car args) :promote))) 90 | "") 91 | "\n")) 92 | (if (chess-game-over-p game) 93 | (chess-game-set-data game 'active nil))) 94 | 95 | ((eq event 'setup-game) 96 | (let ((file (chess-with-temp-file 97 | (insert (chess-game-to-string (car args)) ?\n)))) 98 | (chess-engine-send nil (format "read %s\n" file)))) 99 | 100 | ((eq event 'set-option) 101 | (cond 102 | ((eq (car args) 'resign) 103 | (if (cadr args) 104 | (chess-engine-send nil "resign 9\n") 105 | (chess-engine-send nil "resign -1\n"))) 106 | ((eq (car args) 'ponder) 107 | (if (cadr args) 108 | (chess-engine-send nil "hard\n") 109 | (chess-engine-send nil "easy\n"))))) 110 | 111 | (t 112 | (if (and (eq event 'undo) 113 | (= 1 (mod (car args) 2))) 114 | (error "Cannot undo until after sjeng moves")) 115 | 116 | (apply 'chess-common-handler game event args))))) 117 | 118 | (provide 'chess-sjeng) 119 | 120 | ;;; chess-sjeng.el ends here 121 | -------------------------------------------------------------------------------- /chess-sound.el: -------------------------------------------------------------------------------- 1 | ;;; chess-sound.el --- Announce chess moves with pre-recorded sound files 2 | 3 | ;; Copyright (C) 2002, 2008, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Commentary: 23 | 24 | ;; This is very similar to chess-announce, except it uses specific 25 | ;; .WAV files instead of text-to-speech. 26 | 27 | ;;; Code: 28 | 29 | (require 'chess-game) 30 | 31 | (defgroup chess-sound nil 32 | "Code to play specific sounds when announcing chess moves." 33 | :group 'chess) 34 | 35 | (defcustom chess-sound-directory 36 | (expand-file-name "sounds" 37 | (file-name-directory 38 | (or load-file-name buffer-file-name))) 39 | "The directory where chess sounds can be found." 40 | :type 'directory 41 | :group 'chess-sound) 42 | 43 | (defcustom chess-sound-play-function (if (fboundp 'play-sound-file) 44 | 'play-sound-file 45 | 'chess-sound-play) 46 | "Non-nil if chess-sound should play sounds ." 47 | :type 'function 48 | :group 'chess-sound) 49 | 50 | (defcustom chess-sound-program (or (executable-find "esdplay") 51 | (executable-find "play")) 52 | "Program used to play sounds, if `play-sound-file' does not exist." 53 | :type 'file 54 | :group 'chess-sound) 55 | 56 | (defcustom chess-sound-args nil 57 | "Additional args to pass to `chess-sound-program', before the .WAV file." 58 | :type '(repeat string) 59 | :group 'chess-sound) 60 | 61 | (defcustom chess-sound-moves nil 62 | "If non-nil, plays move.wav for each move." 63 | :type 'boolean 64 | :group 'chess-sound) 65 | 66 | (defcustom chess-sound-voiced-moves nil 67 | "If non-nil, announces opponent's algebraic move." 68 | :type 'boolean 69 | :group 'chess-sound) 70 | 71 | (defsubst chess-sound (file) 72 | (ignore-errors 73 | (let ((wav (expand-file-name (concat file ".wav") chess-sound-directory))) 74 | (if (file-readable-p wav) 75 | (funcall chess-sound-play-function wav) 76 | (ding))))) 77 | 78 | (defsubst chess-sound-play (file) 79 | (apply 'call-process chess-sound-program 80 | nil nil nil (append chess-sound-args (list file)))) 81 | 82 | (defun chess-sound-handler (game event &rest _args) 83 | (cond 84 | ((eq event 'initialize) 85 | (and (file-directory-p chess-sound-directory) 86 | (file-readable-p (expand-file-name "move.wav" 87 | chess-sound-directory)) 88 | (or (eq chess-sound-play-function 'play-sound-file) 89 | (and chess-sound-program 90 | (file-executable-p chess-sound-program))))) 91 | 92 | ((eq event 'move) 93 | (let* ((ply (chess-game-ply game (1- (chess-game-index game)))) 94 | (pos (chess-ply-pos ply))) 95 | (if (and chess-sound-voiced-moves 96 | (not (eq (chess-game-data game 'my-color) 97 | (chess-pos-side-to-move pos)))) 98 | (let* ((source (chess-ply-source ply)) 99 | (target (chess-ply-target ply)) 100 | (s-piece (and source (chess-pos-piece pos source))) 101 | (t-piece (and target (chess-pos-piece pos target))) 102 | (which (chess-ply-keyword ply :which))) 103 | (cond 104 | ((chess-ply-keyword ply :castle) 105 | (chess-sound "O-O")) 106 | ((chess-ply-keyword ply :long-castle) 107 | (chess-sound "O-O-O")) 108 | ((and s-piece t-piece (= t-piece ? ) target) 109 | (if which 110 | (chess-sound (char-to-string which))) 111 | (chess-sound (format "%c_" (downcase s-piece))) 112 | (chess-sound (chess-index-to-coord target))) 113 | ((and s-piece t-piece target) 114 | (if which 115 | (chess-sound (char-to-string which))) 116 | (chess-sound (format "%c_" (downcase s-piece))) 117 | (chess-sound "x_") 118 | (chess-sound (format "%c_" (downcase t-piece))) 119 | (chess-sound (chess-index-to-coord target)))) 120 | 121 | (if (chess-ply-keyword ply :promote) 122 | (chess-sound 123 | (format "%c_" (downcase 124 | (chess-ply-keyword ply :promote))))) 125 | (if (chess-ply-keyword ply :en-passant) 126 | (chess-sound "enpassant")) 127 | (if (chess-ply-keyword ply :check) 128 | (chess-sound "+_")) 129 | (if (chess-ply-keyword ply :checkmate) 130 | (chess-sound "#_")) 131 | (if (chess-ply-keyword ply :stalemate) 132 | (chess-sound "smate"))) 133 | (if chess-sound-moves (chess-sound "move"))))))) 134 | 135 | (provide 'chess-sound) 136 | 137 | ;;; chess-sound.el ends here 138 | -------------------------------------------------------------------------------- /chess-stockfish.el: -------------------------------------------------------------------------------- 1 | ;;; chess-stockfish.el --- Play against stockfish! 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: Mario Lang 6 | ;; Keywords: games, processes 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Code: 22 | 23 | (require 'chess-uci) 24 | 25 | (defgroup chess-stockfish nil 26 | "The publicly available chess engine 'stockfish'." 27 | :group 'chess-engine 28 | :link '(url-link "http://www.stockfishchess.com")) 29 | 30 | (defcustom chess-stockfish-path (executable-find "stockfish") 31 | "*The path to the stockfish executable." 32 | :type 'file 33 | :group 'chess-stockfish) 34 | 35 | (defvar chess-stockfish-regexp-alist 36 | (append 37 | chess-uci-regexp-alist 38 | (list 39 | (cons (concat "^info\\s-+.*nps\\s-+\\([0-9]+\\).*pv\\s-+\\(" 40 | chess-uci-long-algebraic-regexp 41 | "\\(\\s-+" chess-uci-long-algebraic-regexp "\\)+\\)") 42 | (function 43 | (lambda () 44 | (setq-local chess-stockfish-nps (string-to-number (match-string 1))) 45 | (setq-local chess-stockfish-pv 46 | (split-string (match-string 2) " "))))))) 47 | "Patterns used to match stockfish output.") 48 | 49 | (defun chess-stockfish-handler (game event &rest args) 50 | (unless chess-engine-handling-event 51 | (cond 52 | ((eq event 'initialize) 53 | (let ((proc (chess-uci-handler game 'initialize "stockfish"))) 54 | (when (and proc (processp proc) (eq (process-status proc) 'run)) 55 | (process-send-string proc "uci\n") 56 | (setq chess-engine-process proc) 57 | t))) 58 | 59 | (t 60 | (if (and (eq event 'undo) 61 | (= 1 (mod (car args) 2))) 62 | (error "Cannot undo until after stockfish moves")) 63 | 64 | (apply 'chess-uci-handler game event args))))) 65 | 66 | (provide 'chess-stockfish) 67 | 68 | ;;; chess-stockfish.el ends here 69 | -------------------------------------------------------------------------------- /chess-test.el: -------------------------------------------------------------------------------- 1 | ;;; chess-test.el --- Put Emacs Chess through an enormous battery of tests 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; This is free software; you can redistribute it and/or modify it under 6 | ;; the terms of the GNU General Public License as published by the Free 7 | ;; Software Foundation; either version 3, or (at your option) any later 8 | ;; version. 9 | ;; 10 | ;; This is distributed in the hope that it will be useful, but WITHOUT 11 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 12 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 13 | ;; for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with GNU Emacs. If not, see . 17 | 18 | ;;; Commentary: 19 | 20 | ;; Soon. 21 | 22 | ;;; Code: 23 | 24 | (eval-when-compile (require 'cl-lib)) 25 | 26 | (require 'chess-database) 27 | (require 'chess-game) 28 | 29 | (defun chess-test (&optional file start count) 30 | (unless file 31 | (setq file (nth 0 command-line-args-left))) 32 | (unless start 33 | (setq start (ignore-errors 34 | (string-to-number (nth 1 command-line-args-left))))) 35 | (unless count 36 | (setq count (ignore-errors 37 | (string-to-number (nth 2 command-line-args-left))))) 38 | 39 | (message "Opening chess database '%s'" file) 40 | 41 | (let* ((large-file-warning-threshold nil) 42 | (database (chess-database-open file)) 43 | error-occurred) 44 | (if database 45 | (progn 46 | (message "Running validation suite...") 47 | (let* ((db-count (chess-database-count database)) 48 | (ply-count 0) 49 | (index (or start 0)) 50 | (last-index (if (and count (> count 0)) 51 | (min db-count (+ index count)) 52 | db-count)) 53 | (begin (current-time)) 54 | (read-count 0)) 55 | (message "Testing legality of games in range [%d, %d]:" 56 | index (1- last-index)) 57 | (while (< index last-index) 58 | ;; Reading in the game will cause it to be converted from PGN 59 | ;; (this is true currently) to a chess-game, during which time 60 | ;; every move will be tested for legality. 61 | ;; 62 | ;; jww (2008-08-31): We should add some extra checks here, if we 63 | ;; want to verify the final position and such. 64 | (condition-case err 65 | (let ((game (chess-database-read database index))) 66 | (when game 67 | (setq read-count (1+ read-count) 68 | ply-count 69 | (+ ply-count (length (chess-game-plies game)))) 70 | (if (and (> read-count 0) (= 0 (mod read-count 1000))) 71 | (message "Read %d games (next %d): %d total plies (%.2f ply/sec)" 72 | read-count (1+ index) ply-count 73 | (/ (float ply-count) 74 | (float-time 75 | (subtract-time (current-time) 76 | begin))))))) 77 | (error 78 | (setq error-occurred t) 79 | (message "Error reading game %d: %s" 80 | index (error-message-string err)))) 81 | (setq index (1+ index))) 82 | (message "Read %d games (last %d): %d plies (%.2f ply/sec, %.2f seconds)" 83 | read-count (1- index) ply-count 84 | (/ (float ply-count) 85 | (float-time (subtract-time (current-time) begin))) 86 | (float-time (subtract-time (current-time) begin))) 87 | (message "Running validation suite...done") 88 | (chess-database-close database))) 89 | (error "Failed to open chess database '%s'" file)) 90 | (if error-occurred 91 | (error "Some of the tests failed")))) 92 | 93 | ;;; chess-test.el ends here 94 | -------------------------------------------------------------------------------- /chess-transport.el: -------------------------------------------------------------------------------- 1 | ;;; chess-transport.el --- Example generic transport 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; This is free software; you can redistribute it and/or modify it under 6 | ;; the terms of the GNU General Public License as published by the Free 7 | ;; Software Foundation; either version 3, or (at your option) any later 8 | ;; version. 9 | ;; 10 | ;; This is distributed in the hope that it will be useful, but WITHOUT 11 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 12 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 13 | ;; for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with GNU Emacs. If not, see . 17 | 18 | ;;; Commentary: 19 | 20 | ;; An example of a generic transport engine, based on the protocol 21 | ;; used by chess-network.el. The only parts missing are send and 22 | ;; receive. This could be used for transmitting chess.el protocol 23 | ;; over CTCP, for example. 24 | 25 | ;;; Code: 26 | 27 | (require 'chess-network) 28 | 29 | (defvar chess-transport-regexp-alist chess-network-regexp-alist) 30 | 31 | (defun chess-transport-handler (game event &rest args) 32 | "This is an example of a generic transport engine." 33 | (unless chess-engine-handling-event 34 | (cond 35 | ((eq event 'initialize) 36 | ;; Initialize the transport here, if necessary. Make sure that 37 | ;; any housekeeping data you use is kept in buffer-local 38 | ;; variables. Otherwise, multiple games played using the same 39 | ;; kind of transport might collide. For example: 40 | ;; 41 | ;; (set (make-local-variable 'chess-transport-data) (car args)) 42 | ;; 43 | ;; NOTE: Be sure not to return a process, or else chess-engine 44 | ;; will do all the transport work! 45 | t) 46 | 47 | ((eq event 'send) 48 | ;; Transmit the string given in `(car args)' to the outbound 49 | ;; transport from here 50 | ) 51 | 52 | (t 53 | ;; Pass all other events down to chess-network 54 | (apply 'chess-network-handler game event args))))) 55 | 56 | ;; Call `(chess-engine-submit engine STRING)' for text that arrives 57 | ;; from the inbound transport 58 | 59 | (provide 'chess-transport) 60 | 61 | ;;; chess-transport.el ends here 62 | -------------------------------------------------------------------------------- /chess-tutorial.el: -------------------------------------------------------------------------------- 1 | ;;; chess-tutorial.el --- A simple chess training display 2 | 3 | ;; Copyright (C) 2002, 2004, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Commentary: 23 | 24 | ;; `M-x chess-tutorial' implements a simple knight movement exercise. 25 | ;; The objective is to take all pawns on the chessboard without moving to a 26 | ;; square which is attacked by a queen. 27 | 28 | ;;; Code: 29 | 30 | (require 'chess) 31 | (require 'chess-display) 32 | (require 'chess-game) 33 | (require 'chess-message) 34 | 35 | (chess-message-catalog 'english 36 | '((queen-would-take . "The queen would take your knight!") 37 | (congratulations . "Congratulations!") 38 | (knight-1-done . "Goal: take all the pawns, without letting the queen take your knight") 39 | (cannot-take-queen . "You cannot take the queen"))) 40 | 41 | (defun chess-tutorial-knight-1 (game _ignore event &rest _args) 42 | (if (eq event 'move) 43 | (let ((position (chess-game-pos game))) 44 | (if (null (chess-pos-search position ?p)) 45 | (chess-message 'congratulations) 46 | (cond 47 | ((chess-search-position position 48 | (car (chess-pos-search position ?N)) ?q) 49 | (let ((chess-display-handling-event nil)) 50 | (chess-game-undo game 1)) 51 | (chess-error 'queen-would-take)) 52 | ((not (chess-pos-search position ?q)) 53 | (let ((chess-display-handling-event nil)) 54 | (chess-game-undo game 1)) 55 | (chess-error 'cannot-take-queen))))))) 56 | 57 | ;;;###autoload 58 | (defun chess-tutorial () 59 | "A simple chess training display." 60 | (interactive) 61 | (with-current-buffer (chess-create-display t) 62 | (chess-module-set-leader nil) 63 | (chess-display-set-from-fen "8/3p1p/2p3p/4q/2p3p/3p1p/8/N w - -") 64 | (chess-game-add-hook (chess-display-game nil) 'chess-tutorial-knight-1) 65 | (setq chess-pos-always-white t) 66 | (chess-display-popup nil) 67 | (chess-message 'knight-1-done))) 68 | 69 | (provide 'chess-tutorial) 70 | 71 | ;;; chess-tutorial.el ends here 72 | -------------------------------------------------------------------------------- /chess-ucb.el: -------------------------------------------------------------------------------- 1 | ;;; chess-ucb.el --- Engine interface to the Novag Universal Chess Board 2 | 3 | ;; Copyright (C) 2002, 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: John Wiegley 6 | ;; Maintainer: Mario Lang 7 | ;; Keywords: games 8 | 9 | ;; This is free software; you can redistribute it and/or modify it under 10 | ;; the terms of the GNU General Public License as published by the Free 11 | ;; Software Foundation; either version 3, or (at your option) any later 12 | ;; version. 13 | ;; 14 | ;; This is distributed in the hope that it will be useful, but WITHOUT 15 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 16 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 17 | ;; for more details. 18 | ;; 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with GNU Emacs. If not, see . 21 | 22 | ;;; Commentary: 23 | 24 | ;; jww (2002-04-25): This code has not been tested yet, since I don't 25 | ;; have access to a UCB. If anybody wants to donate one, or the money 26 | ;; for one ($300), I would be happy to correct this module. :) 27 | 28 | ;;; Code: 29 | 30 | (require 'chess-common) 31 | 32 | (defgroup chess-ucb nil 33 | "Interface to the Novag Universal Chess Board." 34 | :group 'chess-engine) 35 | 36 | (defcustom chess-ucb-device "/dev/ttyS0" 37 | "The serial device used to talk to the Novag UCB." 38 | :type 'file 39 | :group 'chess-ucb) 40 | 41 | (defvar chess-ucb-handling-event nil) 42 | 43 | (defvar chess-ucb-regexp-alist 44 | (list 45 | (cons "^M\\(..\\)\\(..\\)\\(/\\([QRNB]\\)\\)?\r\n" 46 | (function 47 | (lambda () 48 | (let ((move (concat (match-string 1) 49 | "-" 50 | (match-string 2))) 51 | (promote (match-string 4))) 52 | (if promote 53 | (setq move (concat move "=" promote))) 54 | (setq move (chess-engine-convert-algebraic move)) 55 | ;; I don't use the usual engine logic for this, since 56 | ;; technically the UCB is just an input interface, not a 57 | ;; true engine. 58 | (let ((chess-ucb-handling-event t)) 59 | (chess-game-move (chess-engine-game nil) move)))))))) 60 | 61 | (defun chess-ucb-handler (game event &rest args) 62 | (unless chess-ucb-handling-event 63 | (cond 64 | ((eq event 'initialize) 65 | (when (file-exists-p chess-ucb-device) 66 | ;; jww (2002-04-25): cat is not bidirectional, so I need 67 | ;; something like "nc" that can talk with characters devices 68 | ;; at 9600 8N1. 69 | (setq chess-engine-process 70 | (start-process "*chess-ucb*" (current-buffer) 71 | (executable-find "cat") chess-ucb-device)) 72 | t)) 73 | 74 | ((memq event 'orient) 75 | (chess-engine-send nil "N\r\n") 76 | (chess-engine-set-position nil) 77 | 78 | ;; jww (2002-04-25): What happens if we're orienting to a 79 | ;; non-standard starting position? How do we inform the UCB of 80 | ;; the new position? If it doesn't test move legality, I 81 | ;; suppose we could just move all the pieces around one by 82 | ;; one... 83 | (unless (eq chess-starting-position (chess-engine-position nil)) 84 | nil)) 85 | 86 | ((eq event 'undo) 87 | (dotimes (i (car args)) 88 | (chess-engine-send nil "T\r\n")) 89 | ;; prevent us from handling the `undo' event which this triggers 90 | (let ((chess-engine-handling-event t)) 91 | (chess-game-undo game (car args)))) 92 | 93 | ((eq event 'move) 94 | (let ((move (chess-ply-to-algebraic (car args) t))) 95 | (cond 96 | ((chess-ply-keyword (car args) :en-passant) 97 | (setq move (concat move "ep"))) 98 | ((chess-ply-keyword (car args) :castle) 99 | (if (chess-pos-side-to-move (chess-ply-pos (car args))) 100 | (setq move "e1-g1") 101 | (setq move "e8-g8"))) 102 | ((chess-ply-keyword (car args) :long-castle) 103 | (if (chess-pos-side-to-move (chess-ply-pos (car args))) 104 | (setq move "e1-c1") 105 | (setq move "e8-c8")))) 106 | (chess-engine-send nil (format "M%s\r\n" move))))))) 107 | 108 | (provide 'chess-ucb) 109 | 110 | ;;; chess-ucb.el ends here 111 | -------------------------------------------------------------------------------- /chess-uci.el: -------------------------------------------------------------------------------- 1 | ;;; chess-uci.el --- Common functions for the Universal Chess Interface protocol 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; Author: Mario Lang 6 | ;; Keywords: games, processes 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; Common functions for engines based on the Universal Chess Interface. 24 | ;; See . 25 | 26 | ;;; Code: 27 | 28 | (eval-when-compile (require 'cl-lib)) 29 | (require 'chess-common) 30 | (require 'chess-polyglot) 31 | 32 | (defgroup chess-uci nil 33 | "Customisations for Chess engines based on the UCI protocol" 34 | :group 'chess) 35 | 36 | (defvar chess-uci-long-algebraic-regexp "\\([a-h][1-8]\\)\\([a-h][1-8]\\)\\([nbrq]\\)?" 37 | "A regular expression matching a UCI log algebraic move.") 38 | 39 | (defun chess-uci-long-algebraic-to-ply (position move) 40 | "Convert the long algebraic notation MOVE for POSITION to a ply." 41 | (cl-assert (vectorp position)) 42 | (cl-assert (stringp move)) 43 | (let ((case-fold-search nil)) 44 | (when (string-match chess-uci-long-algebraic-regexp move) 45 | (let ((color (chess-pos-side-to-move position)) 46 | (from (chess-coord-to-index (match-string 1 move))) 47 | (to (chess-coord-to-index (match-string 2 move))) 48 | (promotion (match-string 3 move))) 49 | (apply #'chess-ply-create position nil 50 | (if (and (= from (chess-pos-king-index position color)) 51 | (= (chess-index-rank from) (chess-index-rank to)) 52 | (> (abs (- (chess-index-file from) 53 | (chess-index-file to))) 1)) 54 | (chess-ply-castling-changes 55 | position 56 | (< (- (chess-index-file to) (chess-index-file from)) 0)) 57 | (nconc (list from to) 58 | (when promotion 59 | (list :promote (upcase (aref promotion 0))))))))))) 60 | 61 | (defsubst chess-uci-convert-long-algebraic (move) 62 | "Convert long algebraic MOVE to a ply in reference to the engine position. 63 | If conversion fails, this function fired an 'illegal event." 64 | (or (chess-uci-long-algebraic-to-ply (chess-engine-position nil) move) 65 | (chess-engine-command nil 'illegal))) 66 | 67 | (defvar chess-uci-regexp-alist 68 | (list 69 | (cons "^id\\s-+name\\s-+\\(.+\\)$" 70 | (function 71 | (lambda () 72 | (setq-local chess-engine-opponent-name (match-string 1)) 73 | 'once))) 74 | (cons (concat "^bestmove\\s-+\\(" chess-uci-long-algebraic-regexp "\\)") 75 | (function 76 | (lambda () 77 | (funcall chess-engine-response-handler 'move 78 | (chess-uci-convert-long-algebraic (match-string 1))))))) 79 | "Patterns matching responses of a standard UCI chess engine.") 80 | 81 | (defun chess-uci-position (game) 82 | "Convert the current GAME position to a UCI position command string." 83 | (concat "position fen " (chess-pos-to-fen (chess-game-pos game 0) t) 84 | " moves " (mapconcat (lambda (ply) 85 | (let ((source (chess-ply-source ply)) 86 | (target (chess-ply-target ply))) 87 | (if (and source target) 88 | (concat (chess-index-to-coord source) 89 | (chess-index-to-coord target) 90 | (if (chess-ply-keyword ply :promote) 91 | (string (downcase (chess-ply-keyword ply :promote))) 92 | "")) 93 | ""))) 94 | (chess-game-plies game) " ") 95 | "\n")) 96 | 97 | (defun chess-uci-handler (game event &rest args) 98 | "Default handler for UCI based engines." 99 | (unless chess-engine-handling-event 100 | (cond 101 | ((eq event 'initialize) 102 | (when (and chess-polyglot-book-file 103 | (file-exists-p chess-polyglot-book-file)) 104 | (unless chess-polyglot-book 105 | (setq chess-polyglot-book (chess-polyglot-book-open 106 | chess-polyglot-book-file)))) 107 | (apply #'chess-common-handler game event args)) 108 | 109 | ((eq event 'new) 110 | (chess-engine-send nil "ucinewgame\n") 111 | (chess-engine-set-position nil)) 112 | 113 | ((eq event 'resign) 114 | (chess-game-set-data game 'active nil)) 115 | 116 | ((eq event 'move) 117 | (when (= 1 (chess-game-index game)) 118 | (chess-game-set-tag game "White" chess-full-name) 119 | (chess-game-set-tag game "Black" chess-engine-opponent-name)) 120 | 121 | (if (chess-game-over-p game) 122 | (chess-game-set-data game 'active nil))) 123 | 124 | ((eq event 'post-move) 125 | (let ((book-ply (and chess-polyglot-book (bufferp chess-polyglot-book) 126 | (buffer-live-p chess-polyglot-book) 127 | (chess-polyglot-book-ply 128 | chess-polyglot-book 129 | (chess-game-pos game))))) 130 | (if book-ply 131 | (let ((chess-display-handling-event nil)) 132 | (funcall chess-engine-response-handler 'move book-ply)) 133 | (chess-engine-send nil (concat (chess-uci-position game) "go\n"))))) 134 | 135 | (t 136 | (apply 'chess-common-handler game event args))))) 137 | 138 | (provide 'chess-uci) 139 | 140 | ;;; chess-uci.el ends here 141 | -------------------------------------------------------------------------------- /chess-var.el: -------------------------------------------------------------------------------- 1 | ;;; chess-var.el --- Manipulate variations 2 | 3 | ;; Copyright (C) 2014 Free Software Foundation, Inc. 4 | 5 | ;; This is free software; you can redistribute it and/or modify it under 6 | ;; the terms of the GNU General Public License as published by the Free 7 | ;; Software Foundation; either version 3, or (at your option) any later 8 | ;; version. 9 | ;; 10 | ;; This is distributed in the hope that it will be useful, but WITHOUT 11 | ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 12 | ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License 13 | ;; for more details. 14 | ;; 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with GNU Emacs. If not, see . 17 | 18 | ;;; Commentary: 19 | 20 | ;; A chess variations is a simple list of plies. This module provides 21 | ;; an abstraction layer for applications. 22 | 23 | ;;; Code: 24 | 25 | (require 'chess-ply) 26 | (eval-when-compile (require 'cl-lib)) 27 | 28 | (defsubst chess-var-plies (var) 29 | "Return the plies of VAR." 30 | (cl-assert var) 31 | var) 32 | 33 | (defsubst chess-var-pos (var &optional index) 34 | "Return the position related to VAR's INDEX ply." 35 | (cl-assert var) 36 | (chess-ply-pos (chess-var-ply var index))) 37 | 38 | (defsubst chess-var-index (var) 39 | "Return the VAR's current position index." 40 | (cl-assert var) 41 | (1- (length (chess-var-plies var)))) 42 | 43 | (defsubst chess-var-seq (var) 44 | "Return the current VAR sequence." 45 | (cl-assert var) 46 | (1+ (/ (chess-var-index var) 2))) 47 | 48 | (defsubst chess-var-side-to-move (var &optional index) 49 | "Return the color whose move it is in VAR at INDEX (or at the last position 50 | of the variation if INDEX is nil)." 51 | (cl-assert var) 52 | (chess-pos-side-to-move (chess-var-pos var index))) 53 | 54 | (defun chess-var-ply (var &optional index) 55 | "Return VAR's INDEXth ply." 56 | (cl-assert var) 57 | (if index 58 | (nth index (chess-var-plies var)) 59 | (car (last (chess-var-plies var))))) 60 | 61 | (defun chess-var-add-ply (var ply) 62 | "Return the position related to VAR's INDEX position." 63 | (cl-assert var) 64 | (cl-assert (listp ply)) 65 | (let ((plies (chess-var-plies var))) 66 | (cl-assert plies) 67 | (nconc plies (list ply)))) 68 | 69 | (defsubst chess-var-create (&optional position) 70 | "Create a new chess variation object. 71 | Optionally use the given starting POSITION." 72 | (list (chess-ply-create* (or position chess-starting-position)))) 73 | 74 | (defun chess-var-move (var ply) 75 | "Make a move in the current VAR by applying the changes of PLY. 76 | This creates a new position and adds it to the main variation. 77 | The 'changes' of the last ply reflect whether the var is currently in 78 | progress (nil), if it is drawn, resigned, mate, etc." 79 | (cl-assert var) 80 | (cl-assert (listp ply)) 81 | (let ((current-ply (chess-var-ply var)) 82 | (changes (chess-ply-changes ply)) 83 | (position (chess-ply-pos ply))) 84 | (if (chess-ply-final-p current-ply) 85 | (chess-error 'add-to-completed)) 86 | (cl-assert (eq position (chess-ply-pos current-ply))) 87 | (chess-ply-set-changes current-ply changes) 88 | (chess-var-add-ply var (chess-ply-create* 89 | (chess-ply-next-pos current-ply))))) 90 | 91 | (defun chess-var-to-algebraic (var &optional long) 92 | "Reveal the plies of VAR by converting them to algebraic 93 | notation." 94 | (mapconcat (lambda (ply) 95 | (chess-ply-to-algebraic ply long)) 96 | (if (chess-ply-final-p (chess-var-ply var)) 97 | (chess-var-plies var) 98 | (reverse (cdr (reverse (chess-var-plies var))))) 99 | " ")) 100 | 101 | (provide 'chess-var) 102 | 103 | ;;; chess-var.el ends here 104 | -------------------------------------------------------------------------------- /configure.ac: -------------------------------------------------------------------------------- 1 | # -*- Autoconf -*- 2 | # Process this file with autoconf to produce a configure script. 3 | 4 | AC_PREREQ(2.61) 5 | 6 | AC_INIT([emacs-chess],[2.0],[johnw@newartisans.com]) 7 | AC_CONFIG_SRCDIR([chess.el]) 8 | AM_INIT_AUTOMAKE([dist-bzip2]) 9 | 10 | # Checks for programs. 11 | AC_PROG_MAKE_SET 12 | 13 | # Checks for emacs lisp path 14 | AM_PATH_LISPDIR 15 | 16 | # Pepare the Makefiles 17 | AC_CONFIG_FILES([Makefile]) 18 | AC_OUTPUT 19 | -------------------------------------------------------------------------------- /contrib/books/19081923.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/19081923.zip -------------------------------------------------------------------------------- /contrib/books/TRANS.TBL: -------------------------------------------------------------------------------- 1 | F 19081923.ZIP 19081923.zip 2 | F 19241937.ZIP 19241937.zip 3 | F AMATEUR.ZIP amateur.zip 4 | F AOCA.ZIP aoca.zip 5 | F ATTACK.PGN attack.pgn 6 | F ATTACK.ZIP attack.zip 7 | F BOTV100A.ZIP botv100a.zip 8 | F CAPAFUND.ZIP capafund.zip 9 | F CHERNEV.ZIP chernev.zip 10 | F CHESSPR.ZIP chesspr.zip 11 | F FISCH60.ZIP fisch60.zip 12 | F HTRYC.ZIP htryc.zip 13 | F LGTAL.ZIP lgtal.zip 14 | F MAGICTAL.ZIP magictal.zip 15 | F MYSYS.ZIP mysys.zip 16 | F THINKGM.ZIP thinkgm.zip 17 | -------------------------------------------------------------------------------- /contrib/books/amateur.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/amateur.zip -------------------------------------------------------------------------------- /contrib/books/aoca.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/aoca.zip -------------------------------------------------------------------------------- /contrib/books/attack.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/attack.zip -------------------------------------------------------------------------------- /contrib/books/botv100a.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/botv100a.zip -------------------------------------------------------------------------------- /contrib/books/capafund.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/capafund.zip -------------------------------------------------------------------------------- /contrib/books/chernev.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/chernev.zip -------------------------------------------------------------------------------- /contrib/books/chesspr.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/chesspr.zip -------------------------------------------------------------------------------- /contrib/books/fisch60.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/fisch60.zip -------------------------------------------------------------------------------- /contrib/books/htryc.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/htryc.zip -------------------------------------------------------------------------------- /contrib/books/magictal.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/magictal.zip -------------------------------------------------------------------------------- /contrib/books/mysys.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/mysys.zip -------------------------------------------------------------------------------- /contrib/books/tactics/Pgn.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/tactics/Pgn.zip -------------------------------------------------------------------------------- /contrib/books/tactics/Pgn13.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/tactics/Pgn13.zip -------------------------------------------------------------------------------- /contrib/books/tactics/Pgn14.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/tactics/Pgn14.zip -------------------------------------------------------------------------------- /contrib/books/tactics/Pgn15.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/tactics/Pgn15.zip -------------------------------------------------------------------------------- /contrib/books/tactics/Pgn16.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/tactics/Pgn16.zip -------------------------------------------------------------------------------- /contrib/books/tactics/Pgn17.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/tactics/Pgn17.zip -------------------------------------------------------------------------------- /contrib/books/tactics/TRANS.TBL: -------------------------------------------------------------------------------- 1 | F 1001BWTC.PGN 1001bwtc.pgn 2 | F 1001WCSC.PGN 1001wcsc.pgn 3 | F BESTMOVE.ZIP bestmove.zip 4 | F MOTIVE.ZIP motive.zip 5 | F PGN.ZIP Pgn.zip 6 | F PGN13.ZIP Pgn13.zip 7 | F PGN14.ZIP Pgn14.zip 8 | F PGN15.ZIP Pgn15.zip 9 | F PGN16.ZIP Pgn16.zip 10 | F PGN17.ZIP Pgn17.zip 11 | F QMOVES.ZIP qmoves.zip 12 | F SKITT000.PDF skittles150.pdf 13 | F SKITTLES.PDF skittles148.pdf 14 | F T.ZIP t.zip 15 | F TACTICS.PGN Tactics.pgn 16 | F TESTPGN.ZIP testpgn.zip 17 | F TP.ZIP tp.zip 18 | F WINATCHE.PGN WinAtChess.pgn 19 | -------------------------------------------------------------------------------- /contrib/books/tactics/bestmove.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/tactics/bestmove.zip -------------------------------------------------------------------------------- /contrib/books/tactics/motive.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/tactics/motive.zip -------------------------------------------------------------------------------- /contrib/books/tactics/qmoves.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/tactics/qmoves.zip -------------------------------------------------------------------------------- /contrib/books/tactics/skittles148.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/tactics/skittles148.pdf -------------------------------------------------------------------------------- /contrib/books/tactics/skittles150.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/tactics/skittles150.pdf -------------------------------------------------------------------------------- /contrib/books/tactics/t.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/tactics/t.zip -------------------------------------------------------------------------------- /contrib/books/tactics/testpgn.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/tactics/testpgn.zip -------------------------------------------------------------------------------- /contrib/books/tactics/tp.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/tactics/tp.zip -------------------------------------------------------------------------------- /contrib/books/thinkgm.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/books/thinkgm.zip -------------------------------------------------------------------------------- /contrib/games/chess.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | tournament|club|informal|correspondence 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | > 23 | 24 | 25 | 26 | 27 | FEN-string 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 42 | 43 | 0-1 44 | 45 | resigned 46 | mated 47 | stalemated 48 | repetition 49 | draw accepted 50 | flag fell 51 | aborted 52 | judgment 53 | other 54 | 55 | 56 | 57 | 58 | -------------------------------------------------------------------------------- /contrib/games/fics.sg3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/games/fics.sg3 -------------------------------------------------------------------------------- /contrib/games/fics.si3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/games/fics.si3 -------------------------------------------------------------------------------- /contrib/games/fics.sn3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/games/fics.sn3 -------------------------------------------------------------------------------- /contrib/games/games.sg3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/games/games.sg3 -------------------------------------------------------------------------------- /contrib/games/games.si3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/games/games.si3 -------------------------------------------------------------------------------- /contrib/games/games.sn3: -------------------------------------------------------------------------------- 1 | Scid.sn John Wiegley 2 | Mario LangComputer chess gamearis- -------------------------------------------------------------------------------- /contrib/games/informal.sem: -------------------------------------------------------------------------------- 1 | {{Roger Wiegley} rdw_dms@hotmail.com {Next move...} 22 {} {{Sent 18 2002.02.08}}} {{Eli Boling} eboling@borland.com {Next move...} 24 {} {{Sent 3 2002.02.08}}} {{Bryan Ayoub} puck12289@yahoo.com {Next move...} 20 {} {{Sent 16 2002.02.08} {Sent 16 2002.03.15}}} {{Alex Schroeder} alex@gnu.org {Next move...} 19 {} {{Sent 16 2002.02.08} {Received 17 2002.03.06} {Sent 17 2002.03.06}}} 2 | -------------------------------------------------------------------------------- /contrib/games/informal.sg3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/games/informal.sg3 -------------------------------------------------------------------------------- /contrib/games/informal.si3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/games/informal.si3 -------------------------------------------------------------------------------- /contrib/games/informal.sn3: -------------------------------------------------------------------------------- 1 | Scid.sn    Adam Gilbertlex Schroeder 2 | len Bryan Ayoub Dania Seiglie rkshadows 3 | Eli Boling J. P. LeBlanc eff Wiegley ohn Wiegley  Olie Ohlson Roger WiegleyBorders Chess NightCoffee shop gamerrespondence gameEastside Chess ClubUSCL rated standard game 4 | Boeing 777 5 | ChessPostCard.comE-mailSanta Cruz, Californiacotts Valley, California 6 | Tucson JCC, Arizona#USChessLive.org, Pittsburgh, PA USA-1234 7 | ? -------------------------------------------------------------------------------- /contrib/games/jwiegley-MarcD.pgn: -------------------------------------------------------------------------------- 1 | [Event "ICS rated blitz match"] 2 | [Site "69.36.243.188"] 3 | [Date "2005.05.27"] 4 | [Round "-"] 5 | [White "jwiegley"] 6 | [Black "MarcD"] 7 | [Result "1-0"] 8 | [WhiteElo "1130"] 9 | [BlackElo "1520"] 10 | [TimeControl "120+5"] 11 | 12 | 1. c4 c5 2. Nc3 Nc6 3. g3 Nf6 4. Bg2 e6 5. Nf3 d6 6. d3 Be7 7. Bg5 Bd7 8. 13 | Bxf6 Bxf6 9. O-O a6 10. Rb1 O-O 11. a3 Rb8 12. Nd2 b5 13. Nde4 Be7 14. b3 14 | b4 15. axb4 Nxb4 16. Qc1 h6 17. e3 Nxd3 18. Qd2 Nb4 19. Nxd6 Qc7 20. Nde4 15 | Rfd8 21. Qe2 Bc6 22. Rfc1 Rd7 23. Qg4 Rbd8 24. Na4 Bxa4 25. bxa4 Nd3 26. 16 | Rc2 Ne5 27. Qh5 Nd3 28. Rd2 Nb4 29. Rxd7 Rxd7 30. Rb2 Qa5 31. Nc3 Nd3 32. 17 | Rb8+ Bf8 33. Bc6 Rd8 34. Rb7 Qxc3 35. Qxf7+ Kh8 36. Qxe6 Qe1+ 37. Kg2 Qxf2+ 18 | 38. Kh3 Qf1+ 39. Kh4 Nf2 40. Bd5 g5+ 41. Kh5 Qh3+ 42. Kg6 Qxe6+ 43. Bxe6 19 | Bg7 44. Rxg7 Ne4 45. Rh7# 20 | {MarcD checkmated} 1-0 21 | 22 | -------------------------------------------------------------------------------- /contrib/games/jwiegley-UBend.pgn: -------------------------------------------------------------------------------- 1 | [Event "ICS rated blitz match"] 2 | [Site "64.71.131.140"] 3 | [Date "2004.11.04"] 4 | [Round "-"] 5 | [White "jwiegley"] 6 | [Black "UBend"] 7 | [Result "1-0"] 8 | [WhiteElo "1026"] 9 | [BlackElo "1342"] 10 | [TimeControl "120+12"] 11 | 12 | 1. c4 e5 2. Nc3 Nf6 3. d3 g6 4. a3 Bg7 5. g3 O-O 6. Bg2 c6 7. Nf3 d5 8. 13 | cxd5 Nxd5 9. Bg5 Qd7 10. O-O Nxc3 11. bxc3 Na6 12. Qc1 Nc7 13. Bh6 Re8 14. 14 | Bxg7 Kxg7 15. c4 f6 16. Nd2 Ne6 17. Re1 b6 18. Ne4 Nd4 19. Qc3 Bb7 20. c5 15 | b5 21. Nd6 Re7 22. e3 Ne6 23. d4 exd4 24. exd4 a5 25. Bh3 f5 26. d5+ Kg8 16 | 27. dxe6 Rxe6 28. Rxe6 Qxe6 29. Nxb7 Re8 30. Nd6 Re7 31. Qxa5 Qe5 32. Qb4 17 | Qxa1+ 33. Kg2 Qa2 34. Bxf5 Qd5+ 35. Be4 Qe5 36. Qb3+ Kg7 37. Bxc6 Qxc5 38. 18 | Qb2+ Kg8 39. Qxb5 Qxd6 40. Bd5+ Kg7 41. a4 Re5 42. Qb7+ Kh6 43. Bf3 Ra5 44. 19 | Bc6 Qc5 45. Qd7 Ra7 46. Qd2+ Kg7 47. Qd5 Qxd5+ 48. Bxd5 Rxa4 49. h4 Rd4 50. 20 | Ba8 Kf6 51. f4 Kf5 52. Bc6 Rd2+ 53. Kf3 h6 54. Be4+ Kf6 55. Kg4 Rb2 56. h5 21 | gxh5+ 57. Kxh5 Rh2+ 58. Kg4 h5+ 59. Kf3 Rh3 60. Kg2 22 | {UBend forfeits on time} 1-0 23 | 24 | -------------------------------------------------------------------------------- /contrib/games/saca.sg3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/games/saca.sg3 -------------------------------------------------------------------------------- /contrib/games/saca.si3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/games/saca.si3 -------------------------------------------------------------------------------- /contrib/games/saca.sn3: -------------------------------------------------------------------------------- 1 | Scid.sn  Alexandre Savinenthony ChiaroBenjie Brittenham ob Goldmanryan Jim Duffy ohn WiegleyMichael CornellSatheesh Aradhyula Eastside Chess Club 2 | Tucson JCC? -------------------------------------------------------------------------------- /contrib/games/sample.sg3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/games/sample.sg3 -------------------------------------------------------------------------------- /contrib/games/sample.si3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/games/sample.si3 -------------------------------------------------------------------------------- /contrib/games/sample.sn3: -------------------------------------------------------------------------------- 1 | Scid.sn?GnuChess John WiegleyComputer chess gamearis- -------------------------------------------------------------------------------- /contrib/games/uscf.sg3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/games/uscf.sg3 -------------------------------------------------------------------------------- /contrib/games/uscf.si3: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jwiegley/emacs-chess/865b2ab11469f3bd1bc4d7b3669cb4626c37be08/contrib/games/uscf.si3 -------------------------------------------------------------------------------- /contrib/games/uscf.sn3: -------------------------------------------------------------------------------- 1 | Scid.sn 2 |  Bryan Ayoub Ed Yetman 3 | Fred Duren Gary Anderson  uy Greenwald Jack Lucchesi mes Duffyoe Beck hn Wiegley  M. Belakovsky 4 | Orlando Rodriguez Roland Rodriguez Steve Farmer  MoskalaDesert Paradise Chess ClubEastside Chess ClubGone in 60 minutesNew Pueblo Open Winter FrolicTucson, Arizona12345? -------------------------------------------------------------------------------- /features/castling.feature: -------------------------------------------------------------------------------- 1 | Scenario: e1-b1 is misinterpreted as O-O-O when it should be illegal 2 | Given game with fen "rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/R3KBNR w KQkq -" 3 | Then the move "e1-b1" is illegal 4 | 5 | Scenario: e8-b8 is misinterpreted as O-O-O when it should be illegal 6 | Given game with fen "r3kbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR b KQkq -" 7 | Then the move "e8-b8" is illegal 8 | -------------------------------------------------------------------------------- /features/highlight.feature: -------------------------------------------------------------------------------- 1 | Scenario: legal highlights should not persist across piece selection 2 | Given I start server and client 3 | Then I am ready to play 4 | When white selects "d2" 5 | And white selects "d2" 6 | And white selects "e2" 7 | Given I switch to buffer "*Chessboard*" 8 | Then the square at "d3" is unhighlighted 9 | 10 | Scenario: preserve last-move highlight after changing my mind 11 | Given I start server and client 12 | Then I am ready to play 13 | When white moves "d4" 14 | And black moves "e5" 15 | And white selects "d4" 16 | And white selects "d4" 17 | Then the square at "e5" is highlighted last-move 18 | When black selects "e5" 19 | And black selects "e5" 20 | Then the square at "e5" is highlighted last-move 21 | 22 | Scenario: preserve last-move highlight after pre-move invalidated 23 | Given I start server and client 24 | Then I am ready to play 25 | When white moves "d4" 26 | And black moves "e5" 27 | And white moves "e4" 28 | And white moves "d5" 29 | Then the square at "d5" is highlighted pre-move 30 | When black moves "ex" 31 | Given I switch to buffer "*Chessboard*" 32 | Then the square at "d4" is highlighted last-move 33 | 34 | Scenario: Legal highlight locus must needs reduce after opponent moves 35 | Given I start server and client 36 | Then I am ready to play 37 | When white moves "d4" 38 | And black moves "d5" 39 | And black selects "e7" 40 | Then the square at "e5" is highlighted legal 41 | Then the square at "f6" is highlighted legal 42 | And white moves "e4" 43 | Given I switch to buffer "*Chessboard*<2>" 44 | Then the square at "e5" is highlighted legal 45 | Then the square at "f6" is unhighlighted 46 | 47 | Scenario: My opponent invalidates my pre-move. I should not need to click twice for next selection. 48 | Given I start server and client 49 | Then I am ready to play 50 | And white moves "d4" 51 | And black moves "e5" 52 | When black selects "e5" 53 | Then the square at "e5" is highlighted selected 54 | Then the square at "e4" is highlighted legal 55 | And white moves "dx" 56 | Given I switch to buffer "*Chessboard*<2>" 57 | Then the square at "e5" is highlighted last-move 58 | Then the square at "e4" is unhighlighted 59 | When black selects "c7" 60 | Then the square at "c7" is highlighted selected 61 | 62 | Scenario: paint-move had contained a redraw that was 2000 microseconds (still 1/200 of blink of an eye) 63 | Given I start server and client 64 | Then I am ready to play 65 | When white moves "d4" 66 | And black moves "c5" 67 | And paint-move last 2 plies less than 300 microseconds (individually) 68 | -------------------------------------------------------------------------------- /features/ics.feature: -------------------------------------------------------------------------------- 1 | Scenario: Echo area should indicate opponent ran out of time. 2 | Given ics session 3 | When new game 4 | And opponent forfeits on time 5 | Then I should see message "Your opponent has forfeited the game on time" 6 | 7 | Scenario: Let me know when opponent aborts 8 | Given ics session 9 | When new game 10 | And opponent aborts 11 | Then I should see message "Your offer to abort was accepted" 12 | 13 | Scenario: Let me know when opponent forfeits by disconnection 14 | Given ics session 15 | When new game 16 | And opponent forfeits by disconnection 17 | Then I should see message "Your opponent has resigned" 18 | -------------------------------------------------------------------------------- /features/premove.feature: -------------------------------------------------------------------------------- 1 | Scenario: en-passant logic assumed no pre-moves (white) 2 | Given I start server and client 3 | Then I am ready to play 4 | When white moves "d4" 5 | And white selects "d4" 6 | Then the square at "d3" is unhighlighted 7 | 8 | Scenario: en-passant logic assumed no pre-moves (black) 9 | Given I start server and client 10 | Then I am ready to play 11 | When white moves "d4" 12 | And black moves "e5" 13 | And black selects "e5" 14 | Then the square at "e6" is unhighlighted 15 | 16 | Scenario: pre-move can leave king in check, assuming checking piece is captured 17 | Given I start server and client 18 | Then I am ready to play 19 | And I set position of "*chess-network*<1>" to fen "3rk3/8/8/3R4/8/8/PPPPPPPP/1NBQKBNR w - -" 20 | And I send position from "*chess-network*<1>" 21 | When black selects "e8" 22 | And black selects "d8" 23 | Then the square at "d8" is highlighted pre-move 24 | 25 | 26 | Scenario: pre-move promotion should not ask yet 27 | Given I start server and client 28 | Then I am ready to play 29 | And I set position of "*chess-network*<1>" to fen "rnbqkbn1/pppppppP/8/8/8/8/PPPPPPP1/RNBQKBNR w - -" 30 | And I send position from "*chess-network*<1>" 31 | And white moves "d4" 32 | And white selects "h7" 33 | And white selects "h8" 34 | Then the square at "h8" is highlighted pre-move 35 | -------------------------------------------------------------------------------- /features/support/env.el: -------------------------------------------------------------------------------- 1 | (require 'f) 2 | 3 | (defvar emacs-chess-support-path 4 | (f-dirname load-file-name)) 5 | 6 | (defvar emacs-chess-features-path 7 | (f-parent emacs-chess-support-path)) 8 | 9 | (defvar emacs-chess-root-path 10 | (f-parent emacs-chess-features-path)) 11 | 12 | ;; Nikolaj Schumacher 13 | (defmacro measure-time (&rest body) 14 | "Measure the time it takes to evaluate BODY." 15 | `(let ((time (current-time))) 16 | ,@body 17 | (float-time (time-since time)))) 18 | 19 | (add-to-list 'load-path emacs-chess-root-path) 20 | 21 | (require 'chess-ics) 22 | (require 'chess) 23 | (require 'espuds) 24 | (require 'ert) 25 | (require 'cl) 26 | 27 | (Setup 28 | (defvar test-display nil) 29 | (defvar test-fifo nil) 30 | (defvar test-port nil) 31 | (setq test-port (catch 'loop 32 | (dolist (cand (list "5678" "5413" "5142" "5308" "5987")) 33 | (when (= 1 (call-process "nc" nil nil nil "-z" "localhost" cand)) 34 | (throw 'loop cand))))) 35 | (setq noninteractive t) 36 | (custom-set-variables '(chess-sound-moves nil) 37 | '(chess-display-highlight-last-move t) 38 | '(chess-display-highlight-legal t) 39 | '(chess-display-popup nil) 40 | '(chess-display-allow-pre-moves t) 41 | '(chess-images-separate-frame nil)) 42 | ) 43 | 44 | (Before 45 | ;; Before each scenario is run 46 | ) 47 | 48 | (After 49 | ;; After each scenario is run 50 | (when test-display 51 | (chess-module-destroy test-display) 52 | (setq test-display nil)) 53 | (dolist (p (process-list)) 54 | (delete-process p)) 55 | (setq test-fifo nil) 56 | (let ((buf (get-buffer "*Chessboard*")) 57 | (buf2 (get-buffer "*Chessboard*<2>"))) 58 | (if buf (kill-buffer buf)) 59 | (if buf2 (kill-buffer buf2))) 60 | ) 61 | 62 | (Teardown 63 | ;; After when everything has been run 64 | ) 65 | -------------------------------------------------------------------------------- /run-tests.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | CPUS=8 4 | SOURCE=$HOME/src/emacs-chess 5 | PRODUCTS=$HOME/Products/emacs-chess 6 | EMACS=/Applications/MacPorts/Emacs.app/Contents/MacOS/Emacs 7 | 8 | # No need to change these values 9 | TOTAL=4209433 10 | PART=$((TOTAL / CPUS)) 11 | 12 | for i in $(seq 1 $CPUS); do 13 | # Make sure the sources are all up to date 14 | rsync -av --delete --exclude=.git/ --delete-excluded \ 15 | $SOURCE/ $PRODUCTS/$i/ 16 | 17 | (cd $PRODUCTS/$i; rm -f chess-test; make EMACS=$EMACS; \ 18 | nice -n 20 make EMACS=$EMACS \ 19 | START=$(((i - 1) * PART)) COUNT=$PART check > test.out 2>&1) & 20 | done 21 | 22 | wait 23 | 24 | for i in $(seq 1 $CPUS); do 25 | cat $PRODUCTS/$i/test.out >> test.out 26 | done 27 | 28 | cat test.out 29 | -------------------------------------------------------------------------------- /runtest.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | cd $1 3 | nice -n 20 make START=$2 COUNT=$3 check 4 | -------------------------------------------------------------------------------- /runtests: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | NCPU=$1 4 | 5 | COUNT=4209433 6 | GROUP=$((COUNT / NCPU)) 7 | 8 | begin=0 9 | end=$NCPU 10 | 11 | HERE=$(pwd) 12 | 13 | while (( begin < end )); do 14 | dir=/tmp/emacs-chess-$(whoami)-$((begin)) 15 | rm -fr $dir 16 | mkdir $dir 17 | rsync -a --delete --exclude='*/' ./ $dir/ 18 | (cd $dir ; ln -s $HERE/doc $HERE/test .) 19 | (cd $dir ; rm -f chess-test) 20 | screen -dX screen $HERE/runtest.sh $dir $((begin * GROUP)) $((GROUP)) 21 | begin=$((begin + 1)) 22 | done 23 | --------------------------------------------------------------------------------