[elpa] 135/255: stubbed out API interface for go-board

[Eric Schulte]

eschulte pushed a commit to branch go
in repository elpa.

commit 248dbc0b6ef2821cba0e498db2b911d4a13b4199
Author: Eric Schulte <address@hidden>
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