From mboxrd@z Thu Jan  1 00:00:00 1970
Path: news.gmane.org!not-for-mail
From: Thien-Thi Nguyen <ttn@gnu.org>
Newsgroups: gmane.emacs.devel
Subject: Re: OpenClipart.org for ELPA?
Date: Tue, 20 May 2014 20:52:31 +0200
Message-ID: <87lhtwqo40.fsf@zigzag.favinet>
References: <87ppj81odp.fsf@fx.delysid.org>
NNTP-Posting-Host: plane.gmane.org
Mime-Version: 1.0
Content-Type: multipart/signed; boundary="==-=-=";
	micalg=pgp-sha1; protocol="application/pgp-signature"
X-Trace: ger.gmane.org 1400611712 25285 80.91.229.3 (20 May 2014 18:48:32 GMT)
X-Complaints-To: usenet@ger.gmane.org
NNTP-Posting-Date: Tue, 20 May 2014 18:48:32 +0000 (UTC)
To: emacs-devel@gnu.org
Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue May 20 20:48:23 2014
Return-path: <emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org>
Envelope-to: ged-emacs-devel@m.gmane.org
Original-Received: from lists.gnu.org ([208.118.235.17])
	by plane.gmane.org with esmtp (Exim 4.69)
	(envelope-from <emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org>)
	id 1Wmp5E-0008Py-DP
	for ged-emacs-devel@m.gmane.org; Tue, 20 May 2014 20:48:16 +0200
Original-Received: from localhost ([::1]:54970 helo=lists.gnu.org)
	by lists.gnu.org with esmtp (Exim 4.71)
	(envelope-from <emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org>)
	id 1Wmp5D-0005ko-Ta
	for ged-emacs-devel@m.gmane.org; Tue, 20 May 2014 14:48:15 -0400
Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:51350)
	by lists.gnu.org with esmtp (Exim 4.71) (envelope-from <ttn@gnu.org>)
	id 1Wmp51-0005jg-Me
	for emacs-devel@gnu.org; Tue, 20 May 2014 14:48:08 -0400
Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
	(envelope-from <ttn@gnu.org>) id 1Wmp4w-0000BW-Ma
	for emacs-devel@gnu.org; Tue, 20 May 2014 14:48:03 -0400
Original-Received: from smtp207.alice.it ([82.57.200.103]:38969)
	by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from <ttn@gnu.org>)
	id 1Wmp4w-0000BK-4h
	for emacs-devel@gnu.org; Tue, 20 May 2014 14:47:58 -0400
Original-Received: from zigzag.favinet (95.245.73.135) by smtp207.alice.it (8.6.060.28)
	id 525156852C6CFDE4 for emacs-devel@gnu.org;
	Tue, 20 May 2014 20:47:56 +0200
Original-Received: from ttn by zigzag.favinet with local (Exim 4.80)
	(envelope-from <ttn@gnu.org>) id 1Wmp9Z-0004tL-I7
	for emacs-devel@gnu.org; Tue, 20 May 2014 20:52:45 +0200
In-Reply-To: <87ppj81odp.fsf@fx.delysid.org> (Mario Lang's message of "Tue, 20
	May 2014 17:05:54 +0200")
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux)
Mail-Followup-To: emacs-devel@gnu.org
X-detected-operating-system: by eggs.gnu.org: Genre and OS details not
	recognized.
X-Received-From: 82.57.200.103
X-BeenThere: emacs-devel@gnu.org
X-Mailman-Version: 2.1.14
Precedence: list
List-Id: "Emacs development discussions." <emacs-devel.gnu.org>
List-Unsubscribe: <https://lists.gnu.org/mailman/options/emacs-devel>,
	<mailto:emacs-devel-request@gnu.org?subject=unsubscribe>
List-Archive: <http://lists.gnu.org/archive/html/emacs-devel>
List-Post: <mailto:emacs-devel@gnu.org>
List-Help: <mailto:emacs-devel-request@gnu.org?subject=help>
List-Subscribe: <https://lists.gnu.org/mailman/listinfo/emacs-devel>,
	<mailto:emacs-devel-request@gnu.org?subject=subscribe>
Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org
Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org
Xref: news.gmane.org gmane.emacs.devel:171963
Archived-At: <http://permalink.gmane.org/gmane.emacs.devel/171963>

--==-=-=
Content-Type: multipart/mixed; boundary="=-=-="

--=-=-=
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable

() Mario Lang <mlang@delysid.org>
() Tue, 20 May 2014 17:05:54 +0200

   We currently need XPM format, as %c-%p.xpm, where %c is either
   black or white, and %p is one of pawn, knight, bishop, rook,
   queen and king.

I just added package =E2=80=98xpm=E2=80=99 to ELPA.  Maybe you could use it=
 to
"compose" (algorithmically create) these pieces?  Here's a snapshot
of wip gnugo-d0.el, which does just that, for (ELPA package)
=E2=80=98gnugo=E2=80=99:

--=-=-=
Content-Type: application/emacs-lisp
Content-Disposition: attachment; filename=gnugo-d0.el
Content-Transfer-Encoding: quoted-printable

;;; gnugo-d0.el --- gnugo.el display protocol 0   -*- lexical-binding: t -*-

;; Copyright (C) 2014  Free Software Foundation, Inc.

;; Author: Thien-Thi Nguyen <ttn@gnu.org>
;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>

;; This program 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 of the License, or
;; (at your option) any later version.

;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; this makes use of xpm.el (et al)

;;; Code:

(require 'xpm)
(require 'xpm-m2z)

;; lacunae (sigh)
(defun xpm-as-rectangle ()
  (xpm--w/gg (w h cpp origin y-mult) (xpm--gate)
    (extract-rectangle
     origin
     (+ origin (* y-mult (1- h)) (* w cpp)))))

(defun xpm-from-rectangle (rect)
  (xpm--w/gg (w h cpp origin y-mult) (xpm--gate)
    (assert (=3D h (length rect)))
    (assert (=3D (* w cpp) (length (car rect))))
    (goto-char origin)
    (delete-rectangle origin (+ origin (* y-mult (1- h)) (* w cpp)))
    (insert-rectangle rect)))

(defun xpm-replace-from (buffer)
  (xpm-from-rectangle
   (with-current-buffer buffer
     (xpm-as-rectangle))))

(require 'cl-lib)
(eval-when-compile (require 'cl))

(defvar gnugo-d0-styles
  '((d-bump                             ; thanks
     :background "#FFFFC7C75252"
     :grid-lines "#000000000000"
     :circ-edges "#C6C6C3C3C6C6"
     :white-fill "#FFFFFFFFFFFF"
     :black-fill "#000000000000")
    (ttn                                ; this guy must live in a cave
     :background "#000000000000"
     :grid-lines "#AAAA88885555"
     :circ-edges "#888888888888"
     :white-fill "#CCCCCCCCCCCC"
     :black-fill "#444444444444"))
  "*Alist of styles suitable for `gnugo-d0-create-xpms'.
The key is a symbol naming the style.  The value is a plist.  Here is
a list of recognized keywords and their meanings:

  :background -- string that names a color in XPM format, such as
  :grid-lines    \"#000000000000\" to mean \"black\"; you may be able
  :circ-edges    to use an actual color name but that hasn't been tested
  :white-fill
  :black-fill

At this time, all keywords are required and color values cannot be nil.
This restriction may be lifted in the future.")

(defvar gnugo-d0-style nil
  "Which style in `gnugo-d0-styles' to use.
If nil, `gnugo-d0-create-xpms' defaults to the first one.")

(defvar gnugo-d0-sizing-function 'gnugo-d0-fit-window-height
  "Function to compute XPM image size from board size.
This is called with one arg, integer BOARD-SIZE,
and should return a number (float or integer).
A value less than 8 is taken as 8.")

(defvar gnugo-d0-cache (make-hash-table :test 'equal))

(defun gnugo-d0-clear-cache ()
  "Clear the cache."
  (interactive)
  (clrhash gnugo-d0-cache))

(defun gnugo-d0-fit-window-height (board-size)
  "Return the dimension (in pixels) of a square for BOARD-SIZE.
This uses the TOP and BOTTOM components as returned by
`window-inside-absolute-pixel-edges' and subtracts twice
the `frame-char-height' (to leave space for the grid)."
  (destructuring-bind (L top R bot)
      (window-inside-absolute-pixel-edges)
    (ignore L R)
    (/ (float (- bot top (* 2 (frame-char-height))))
       board-size)))

(defconst gnugo-d0-palette '((32 . :background)
                             (?. . :grid-lines)
                             (?X . :circ-edges)
                             (?- . :black-fill)
                             (?+ . :white-fill)))

(defun gnugo-d0-create-xpms-1 (square style)
  (let* ((kws (mapcar 'cdr gnugo-d0-palette))
         (roles (mapcar 'symbol-name kws))
         (palette (loop
                   for px in (mapcar 'car gnugo-d0-palette)
                   for role in roles
                   collect (cons px (format "s %s" role))))
         (resolved (loop
                    with parms =3D (copy-sequence style)
                    for role in roles
                    for kw in kws
                    collect (cons role (plist-get parms kw))))
         (sq-m1 (1- square))
         (half (/ sq-m1 2.0))
         (half-m1 (truncate (- half 0.5)))
         (half-p1 (truncate (+ half 0.5)))
         (background (make-vector 10 nil))
         (foreground (make-vector 4 nil))
         rv)
    (cl-flet
        ((workbuf (n)
                  (xpm-generate-buffer (format "%d_%d" n square)
                                       square square 1 palette))
         (nine-from-four (N E W S)
                         (list (list   E   S)
                               (list   E W S)
                               (list     W S)
                               (list N E   S)
                               (list N E W S)
                               (list N   W S)
                               (list N E    )
                               (list N E W  )
                               (list N   W  )))
         (mput-points (px ls)
                      (dolist (coord ls)
                        (apply 'xpm-put-points px coord))))
      ;; background
      (loop for place from 1 to 9
            for parts
            in (cl-flet*
                   ((vline (x y1 y2)  (list (list x (cons y1 y2))))
                    (v-expand (y1 y2) (append (vline half-m1 y1 y2)
                                              (vline half-p1 y1 y2)))
                    (hline (y x1 x2)  (list (list (cons x1 x2) y)))
                    (h-expand (x1 x2) (append (hline half-m1 x1 x2)
                                              (hline half-p1 x1 x2))))
                 (nine-from-four (v-expand 0       half-p1)
                                 (h-expand half-m1   sq-m1)
                                 (h-expand 0       half-p1)
                                 (v-expand half-m1   sq-m1)))
            do (aset background place
                     (with-current-buffer (workbuf place)
                       (dolist (part parts)
                         (mput-points ?. part))
                       (current-buffer))))
      ;; foreground
      (cl-flet
          ((circ (radius)
                 (xpm-m2z-circle half half radius)))
        (loop with stone-form =3D (circ (truncate half))
              with minim-form =3D (circ (/ square 9))
              for n below 4
              for type in '(bmoku bpmoku wmoku wpmoku)
              do (aset foreground n
                       (with-current-buffer (workbuf n)
                         (cl-flet*
                             ((rast (fill form) (xpm-raster form ?X fill))
                              (stone (fill)     (rast fill stone-form))
                              (minim (fill)     (rast fill minim-form)))
                           (if (cl-evenp n)
                               (stone (cl-case type
                                        (bmoku ?-)
                                        (wmoku ?+)))
                             (xpm-replace-from (aref foreground (1- n)))
                             (minim (cl-case type
                                      (bpmoku ?+)
                                      (wpmoku ?-))))
                           (current-buffer))))))
      ;; do it
      (cl-flet
          ((ok (place type finish)
               (goto-char 25)
               (delete-char (- (skip-chars-forward "^1-9")))
               (delete-char 1)
               (insert (format "%s%d" type place))
               (push (cons (cons type place)
                           (funcall finish
                                    :ascent 'center
                                    :color-symbols resolved))
                     rv)))
        (with-current-buffer (workbuf 5)
          (xpm-replace-from (aref background 5))
          (xpm-raster
           ;; yes, using an ellipse is bizarre; no, we don't mind;
           ;; maybe, =E2=80=98artist-ellipse-generate-quadrant=E2=80=99 is =
stable.
           (xpm-m2z-ellipse half half 4 4.5)
           ?. t)
          (ok 5 'hoshi 'xpm-finish))
        (loop
         for place from 1 to 9
         for decor in (let ((friends (cons half-m1 half-p1)))
                        (nine-from-four (list friends       0)
                                        (list sq-m1   friends)
                                        (list 0       friends)
                                        (list friends   sq-m1)))
         do (with-current-buffer (aref background place)
              (ok place 'empty 'xpm-finish))
         do (cl-flet
                ((decorate (px)
                           (mput-points px decor)))
              (loop for n below 4
                    for type in '(bmoku bpmoku wmoku wpmoku)
                    do (with-current-buffer (aref foreground n)
                         (decorate ?.)
                         (ok place type 'xpm-as-xpm)
                         (decorate 32)))))
        (mapc 'kill-buffer foreground)
        (nreverse rv)))))

(defun gnugo-d0-create-xpms (board-size)
  "Return a list of XPM images suitable for BOARD-SIZE.
The size and style of the images are determined by
`gnugo-d0-sizing-function' (rounded down to an even number)
and `gnugo-d0-style', respectively.

The returned list is cached; see also `gnugo-d0-clear-cache'."
  (let* ((square (let ((n (funcall gnugo-d0-sizing-function
                                   board-size)))
                   (unless (numberp n)
                     (error "Invalid BOARD-SIZE: %s" board-size))
                   (max 8 (logand (lognot 1) (truncate n)))))
         (style (or (unless gnugo-d0-style (cdar gnugo-d0-styles))
                    (cdr (assq gnugo-d0-style gnugo-d0-styles))
                    (error "No style selected")))
         (key (cons square style)))
    (or (gethash key gnugo-d0-cache)
        (puthash key (gnugo-d0-create-xpms-1 square style)
                 gnugo-d0-cache))))

;;;------------------------------------------------------------------------=
---
;;; that's it

(provide 'gnugo-d0)

;;; gnugo-d0.el ends here

--=-=-=
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable

The component forms are much simpler (lines and circles only) than
for chess, so artistry is not the draw (yuk yuk), here.  Instead,
the Cool Hack IMHO is that the primary dimension (pixel length of a
square side) is computed based on window height, and moreover that
computation is user customizable (see =E2=80=98gnugo-d0-sizing-function=E2=
=80=99).

The end result is that the user can turn on the menu-bar (for
example) or resize the frame, and it's enough to type =E2=80=98i=E2=80=99 (=
to
toggle image-display mode) twice to have updated XPMs appear.
It's not real-time ("SIGWINCH" handler) resizing, but close enough
for me (and my slow computer :-D).

Also, it *almost* goes w/o mentioning: Generating XPM images on
the fly means less disk footprint, easier package management, no
search-path groveling, etc.  That's regardless of resize support.

=2D-=20
Thien-Thi Nguyen
   GPG key: 4C807502
   (if you're human and you know it)
      read my lisp: (responsep (questions 'technical)
                               (not (via 'mailing-list)))
                     =3D> nil

--=-=-=--

--==-=-=
Content-Type: application/pgp-signature

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.12 (GNU/Linux)

iEYEARECAAYFAlN7pHUACgkQZwMiJEyAdQKAWQCg2HQzjbL/aAuqebDbFDn0OxNV
ZIoAoI8gvvAngZ53evxmPEp6Mdr0Z7hp
=6OPb
-----END PGP SIGNATURE-----
--==-=-=--