eschulte pushed a commit to branch go
in repository elpa.
commit 0341e6d1df5afc5a46d3ece85fabb068a4eac12f
Author: Eric Schulte <eric.schu...@gmx.com>
Date: Tue May 22 21:26:34 2012 -0400
splitting the sgf back end from the board interface
---
sgf-board.el | 97 ++++++----------------------------------------------------
sgf.el | 75 ++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 85 insertions(+), 87 deletions(-)
diff --git a/sgf-board.el b/sgf-board.el
index 72f2f99..bebb3a6 100644
--- a/sgf-board.el
+++ b/sgf-board.el
@@ -29,22 +29,16 @@
(require 'sgf-util)
(require 'sgf2el)
-
-;;; Visualization
(defvar *board* nil "Holds the board local to a GO buffer.")
-(defvar *sgf* nil "Holds the sgf data structure local to a GO buffer.")
-
-(defvar *index* nil "Index into the sgf local to a GO buffer.")
-
-(defun make-board (size) (make-vector (* size size) nil))
-
-(defun board-size (board) (round (sqrt (length board))))
+(defvar *backends* nil "Holds the back-ends connected to a board.")
(defvar black-piece "X")
(defvar white-piece "O")
+
+;;; Visualization
(defun board-header (board)
(let ((size (board-size board)))
(concat " "
@@ -55,9 +49,6 @@
(string char)))
(range size) " "))))
-(defun pos-to-index (pos size)
- (+ (car pos) (* (cdr pos) size)))
-
(defun board-pos-to-string (board pos)
(let ((size (board-size board)))
(flet ((emph (n)
@@ -105,17 +96,6 @@
(dolist (piece pieces board)
(setf (aref board (cdr piece)) (car piece)))))
-(defun sgf-board-options ()
- (let ((count 0))
- (mapcar (lambda (alt)
- (prog1 (if (alistp alt)
- count
- (if (alistp (car alt))
- (list count 0)
- :other))
- (incf count)))
- (sgf-nthcdr *sgf* *index*))))
-
(defun get-create-pieces ()
(let ((pieces (aget (sgf-ref *sgf* *index*) :pieces)))
(if pieces
@@ -142,7 +122,7 @@
(insert comment)))
(goto-char (point-min)))
-(defun display-sgf (game)
+(defun display (game)
(let ((buffer (generate-new-buffer "*sgf*")))
(with-current-buffer buffer
(sgf-mode)
@@ -164,71 +144,14 @@
(update-display)))
(pop-to-buffer buffer)))
-(defun display-sgf-file (path)
- (interactive "f")
- (display-sgf (sgf2el-file-to-el path)))
-
-(defun up (&optional num)
- (interactive "p")
- (prog1 (dotimes (n num n)
- (unless (alistp (sgf-ref *sgf* *index*))
- (update-display)
- (error "sgf: no more upwards moves."))
- (decf (car (last *index* 2)))
- (update-display))))
-
-(defun down (&optional num)
- (interactive "p")
- (prog1 (dotimes (n num n)
- (incf (car (last *index* 2)))
- (setf (car (last *index*)) 0)
- (unless (alistp (sgf-ref *sgf* *index*))
- (update-display)
- (error "sgf: no more downwards moves."))
- (update-display))))
-
-(defun left (&optional num)
- (interactive "p")
- (prog1 (dotimes (n num n)
- (unless (alistp (sgf-ref *sgf* *index*))
- (update-display)
- (error "sgf: no more backwards moves."))
- (decf (car (last *index*)))
- (update-display))))
-
-(defun right (&optional num)
- (interactive "p")
- (prog1 (dotimes (n num n)
- (incf (car (last *index*)))
- (unless (alistp (sgf-ref *sgf* *index*))
- (decf (car (last *index*)))
- (update-display)
- (error "sgf: no more forward moves."))
- (update-display))))
-
;;; Board manipulation functions
-(defun sgf-nthcdr (sgf index)
- (let ((part sgf))
- (while (cdr index)
- (setq part (nth (car index) part))
- (setq index (cdr index)))
- (setq part (nthcdr (car index) part))
- part))
-
-(defun sgf-ref (sgf index)
- (let ((part sgf))
- (while (car index)
- (setq part (nth (car index) part))
- (setq index (cdr index)))
- part))
-
-(defun set-sgf-ref (sgf index new)
- (eval `(setf ,(reduce (lambda (acc el) (list 'nth el acc))
- index :initial-value 'sgf)
- ',new)))
-
-(defsetf sgf-ref set-sgf-ref)
+(defun make-board (size) (make-vector (* size size) nil))
+
+(defun board-size (board) (round (sqrt (length board))))
+
+(defun pos-to-index (pos size)
+ (+ (car pos) (* (cdr pos) size)))
(defun move-type (move)
(cond
diff --git a/sgf.el b/sgf.el
new file mode 100644
index 0000000..99e017a
--- /dev/null
+++ b/sgf.el
@@ -0,0 +1,75 @@
+;;; sgf.el --- SGF back end
+
+;; Copyright (C) 2012 Eric Schulte <eric.schu...@gmx.com>
+
+;; Author: Eric Schulte <eric.schu...@gmx.com>
+;; Created: 2012-05-15
+;; Version: 0.1
+;; Keywords: game go sgf
+
+;; This file is not (yet) part of GNU Emacs.
+;; However, it is distributed under the same license.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;; Commentary:
+
+;; This file implements an `sgf-trans' interface into an SGF file.
+
+;; Code:
+(require 'sgf-util)
+(require 'sgf-trans)
+
+(defun sgf-nthcdr (sgf index)
+ (let ((part sgf))
+ (while (cdr index)
+ (setq part (nth (car index) part))
+ (setq index (cdr index)))
+ (setq part (nthcdr (car index) part))
+ part))
+
+(defun sgf-ref (sgf index)
+ (let ((part sgf))
+ (while (car index)
+ (setq part (nth (car index) part))
+ (setq index (cdr index)))
+ part))
+
+(defun set-sgf-ref (sgf index new)
+ (eval `(setf ,(reduce (lambda (acc el) (list 'nth el acc))
+ index :initial-value 'sgf)
+ ',new)))
+
+(defsetf sgf-ref set-sgf-ref)
+
+
+;;; Class and interface
+(defclass sgf nil
+ ((sgf :initarg :sgf :accessor sgf :initform nil)
+ (index :initarg :index :accessor index :initform nil))
+ "Class for the SGF back end.")
+
+(defmethod sgf->move ((sgf sgf) move))
+(defmethod sgf->board ((sgf sgf) size))
+(defmethod sgf->resign ((sgf sgf) resign))
+(defmethod sgf->undo ((sgf sgf) undo))
+(defmethod sgf->comment ((sgf sgf) comment))
+(defmethod sgf<-alt ((sgf sgf)))
+(defmethod sgf<-move ((sgf sgf)))
+(defmethod sgf<-board ((sgf sgf)))
+(defmethod sgf<-comment ((sgf sgf)))
+
+(provide 'sgf)
