eschulte pushed a commit to branch go
in repository elpa.
commit 248dbc0b6ef2821cba0e498db2b911d4a13b4199
Author: Eric Schulte <eric.schu...@gmx.com>
Date: Fri Jun 1 16:21:06 2012 -0600
stubbed out API interface for go-board
---
NOTES | 4 +-
go-board.el | 75 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
go-util.el | 7 +++++
3 files changed, 83 insertions(+), 3 deletions(-)
diff --git a/NOTES b/NOTES
index f0798ad..7e049dc 100644
--- a/NOTES
+++ b/NOTES
@@ -1,6 +1,6 @@
-# -*- org-mode -*-
+# -*- mode:org -*-
-* TODO make a board back-end so it can receive commands
+* DONE make a board back-end so it can receive commands
* TODO allow an IGS process to send commands to a board
* IGS Support
- use information in [[file:data/igs.c][igs.c]] and in the cgoban source.
diff --git a/go-board.el b/go-board.el
index eb9a111..90ef0aa 100644
--- a/go-board.el
+++ b/go-board.el
@@ -351,4 +351,77 @@
(define-derived-mode go-board-mode nil "GO"
"Major mode for viewing a GO board.")
-(provide 'go-board)
+
+;;; Class and interface
+(defclass board ()
+ ((buffer :initarg :buffer :accessor buffer :initform nil)))
+
+(defmacro with-board (board &rest body)
+ (declare (indent 1))
+ `(with-current-buffer (buffer ,board) ,@body))
+
+(defmethod go-size ((board board))
+ (with-board board *size*))
+
+(defmethod set-go-size ((board board) size)
+ (with-board board (setq *size* size)))
+
+(defmethod go-name ((board board))
+ (un-ear-muffs (buffer-name (buffer board))))
+
+(defmethod set-go-name ((board board) name)
+ (with-board board (rename-buffer name 'unique)))
+
+(defmethod go-move ((board board))
+ (signal 'unsupported-back-end-command (list board :move)))
+
+(defmethod set-go-move ((board board) move)
+ (with-board board
+ (apply-turn-to-board (list move))
+ (setf *turn* (other-color *turn*))))
+
+(defmethod go-labels ((board board))
+ (signal 'unsupported-back-end-command (list board :labels)))
+
+(defmethod set-go-labels ((board board) labels)
+ (signal 'unsupported-back-end-command (list board :set-labels labels)))
+
+(defmethod go-comment ((board board))
+ (signal 'unsupported-back-end-command (list board :comment)))
+
+(defmethod set-go-comment ((board board) comment)
+ (signal 'unsupported-back-end-command (list board :set-comment comment)))
+
+(defmethod go-alt ((board board))
+ (signal 'unsupported-back-end-command (list board :alt)))
+
+(defmethod set-go-alt ((board board) alt)
+ (signal 'unsupported-back-end-command (list board :set-alt alt)))
+
+(defmethod go-color ((board board))
+ (with-board board *turn*))
+
+(defmethod set-go-color ((board board) color)
+ (with-board board (setq *turn* color)))
+
+;; non setf'able generic functions
+(defmethod go-undo ((board board))
+ (with-board board (board-undo)))
+
+(defmethod go-pass ((board board))
+ (with-board board
+ (message "pass")
+ (setf *turn* (other-color *turn*))))
+
+(defmethod go-resign ((board board))
+ (with-board board (message "%s resign" *turn*)))
+
+(defmethod go-reset ((board board))
+ (with-board board
+ (setf *history* nil)
+ (update-display)))
+
+(defmethod go-quit ((board board))
+ (with-board board (board-quit)))
+
+(provide 'board)
diff --git a/go-util.el b/go-util.el
index d248d55..835cbf9 100644
--- a/go-util.el
+++ b/go-util.el
@@ -72,6 +72,13 @@
(defun ear-muffs (str) (concat "*" str "*"))
+(defun un-ear-muffs (str)
+ (let ((pen-ult (1- (length str))))
+ (if (and (= ?\* (aref str 0))
+ (= ?\* (aref str pen-ult)))
+ (substring str 1 pen-ult)
+ str)))
+
(defun char-to-num (char)
(flet ((err () (error "gtp: invalid char %s" char)))
(cond
