eschulte pushed a commit to branch go
in repository elpa.
commit 696d28802d9da4f56cad91025e0bc73c848624c1
Author: Eric Schulte <eric.schu...@gmx.com>
Date: Sat May 26 18:19:47 2012 -0600
now with colors
---
go-board-faces.el | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++++
go-board.el | 33 +++++++++++++++++++---
2 files changed, 105 insertions(+), 5 deletions(-)
diff --git a/go-board-faces.el b/go-board-faces.el
new file mode 100644
index 0000000..dc2ba7d
--- /dev/null
+++ b/go-board-faces.el
@@ -0,0 +1,77 @@
+;;; go-board-faces.el -- Color for GO boards
+
+;; 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.
+
+;;; Code:
+(defface go-board-background
+ '((t (:background "#b36108" :foreground "#6f3c04")))
+ "woodsy background")
+
+(defface go-board-hoshi
+ '((t (:background "#b36108" :foreground "#6d3300")))
+ "woodsy background with darker hoshi mark")
+
+(defface go-board-black
+ '((t (:background "#b36108" :foreground "black")))
+ "black piece on woodsy background")
+
+(defface go-board-white
+ '((t (:background "#b36108" :foreground "white")))
+ "white piece on woodsy background")
+
+(defface go-board-black-territory-background
+ '((t (:background "#6a4014" :foreground "#6f3c04")))
+ "woodsy background")
+
+(defface go-board-black-territory-hoshi
+ '((t (:background "#6a4014" :foreground "#6d3300")))
+ "woodsy background with darker hoshi mark")
+
+(defface go-board-black-territory-black
+ '((t (:background "#6a4014" :foreground "black")))
+ "black piece on black territory")
+
+(defface go-board-black-territory-white
+ '((t (:background "#6a4014" :foreground "#6b6b6b")))
+ "white piece on black territory")
+
+(defface go-board-white-territory-background
+ '((t (:background "#cd9c67" :foreground "#6f3c04")))
+ "white territory")
+
+(defface go-board-white-territory-hoshi
+ '((t (:background "#cd9c67" :foreground "#6d3300")))
+ "white territory with darker hoshi mark")
+
+(defface go-board-white-territory-black
+ '((t (:background "#cd9c67" :foreground "#6b6b6b")))
+ "black piece on white territory")
+
+(defface go-board-white-territory-white
+ '((t (:background "#cd9c67" :foreground "white")))
+ "white piece on white territory")
+
+(provide 'go-board-faces)
diff --git a/go-board.el b/go-board.el
index c477a43..396d250 100644
--- a/go-board.el
+++ b/go-board.el
@@ -28,6 +28,7 @@
;;; Code:
(require 'go-util)
(require 'go-trans)
+(require 'go-board-faces)
(defvar *history* nil "Holds the board history for a GO buffer.")
(defvar *size* nil "Holds the board size.")
@@ -152,25 +153,33 @@
(= n (/ (- size 1) 2))))
((= size 9)
(or (= 2 n)
- (= 4 n))))))
+ (= 4 n)))))
+ (put (str prop val) (put-text-property 0 (length str) prop val
str)))
(let* ((val (aref board (pos-to-index pos size)))
(str (cond
((equal val :W) white-piece)
((equal val :B) black-piece)
((and (stringp val) (= 1 (length val)) val))
(t (if (and (emph (car pos)) (emph (cdr pos))) "+" ".")))))
- (put-text-property 0 (length str) :pos (cons (cdr pos) (car pos)) str)
+ (cond
+ ((string= str white-piece) (put str :type :white))
+ ((string= str black-piece) (put str :type :black))
+ ((string= str "+") (put str :type :hoshi))
+ (t (put str :type :background)))
+ (put str :pos (cons (cdr pos) (car pos)))
str))))
(defun board-row-to-string (board row)
(let* ((size (board-size board))
(label (format "%3d" (1+ row)))
- (row-body ""))
+ (row-body "")
+ (filler " "))
+ (put-text-property 0 1 :type :background filler)
(dotimes (n size)
(setq row-body
(concat row-body
(board-pos-to-string board (cons row n))
- " ")))
+ filler)))
(concat label " " (substring row-body 0 (1- (length row-body))) label)))
(defun board-body-to-string (board)
@@ -180,9 +189,22 @@
(defun board-to-string (board)
(let ((header (board-header board))
- (body (board-body-to-string board)))
+ (body (board-body-to-string board)))
(mapconcat #'identity (list header body header) "\n")))
+(defun go-board-paint (&optional start end)
+ (interactive "r")
+ (flet ((ov (point face)
+ (overlay-put (make-overlay point (1+ point)) 'face face)))
+ (let ((start (or start (point-min)))
+ (end (or end (point-max))))
+ (dolist (point (range start end))
+ (case (get-text-property point :type)
+ (:background (ov point 'go-board-background))
+ (:hoshi (ov point 'go-board-hoshi))
+ (:white (ov point 'go-board-white))
+ (:black (ov point 'go-board-black)))))))
+
(defun update-display (buffer)
(with-current-buffer buffer
(delete-region (point-min) (point-max))
@@ -196,6 +218,7 @@
(insert (make-string (+ 6 (* 2 *size*)) ?=)
"\n\n"
comment)))
+ (go-board-paint)
(goto-char (point-min))))
(defun go-board-display (back-end &rest trackers)
