[elpa] 101/255: now with colors

[Eric Schulte]

eschulte pushed a commit to branch go
in repository elpa.

commit 696d28802d9da4f56cad91025e0bc73c848624c1
Author: Eric Schulte <address@hidden>
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 <address@hidden>
+
+;; Author: Eric Schulte <address@hidden>
+;; 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)