code.delx.au - gnu-emacs-elpa/blob - packages/xpm/xpm-m2z.el

   1 ;;; xpm-m2z.el --- (% span 2) => 0             -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2014  Free Software Foundation, Inc.
   4
   5 ;; Author: Thien-Thi Nguyen <ttn@gnu.org>
   6 ;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org>
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; Although artist.el is wonderful, it doesn't (yet) do subpixel-centered
  24 ;; circles (or ellipses).  Those shapes are always rendered with an odd
  25 ;; "span", i.e., (% (- HI LO -1) 2) => 1, since the origin is *on* an
  26 ;; integral coordinate (i.e., intersection of row and column).
  27 ;;
  28 ;; This file provides funcs `xpm-m2z-ellipse' and `xpm-m2z-circle' to
  29 ;; locally rectify the current situation ("m2z" means "modulo 2 => 0"),
  30 ;; with the hope that eventually a generalization can be worked back
  31 ;; into artist.el, perhaps as a subpixel-center minor mode of some sort.
  32
  33 ;;; Code:
  34
  35 (require 'artist)
  36 (require 'cl-lib)
  37
  38 ;;;###autoload
  39 (defun xpm-m2z-ellipse (cx cy rx ry)
  40   "Return an ellipse with center (CX,CY) and radii RX and RY.
  41 Both CX and CY must be non-integer, preferably
  42 precisely half-way between integers, e.g., 13/2 => 6.5.
  43 The ellipse is represented as a list of unique XPM coords,
  44 with the \"span\", i.e., (- HI LO -1), of the extreme X and Y
  45 components equal to twice the rounded (to integer) value of
  46 RX and RY, respectively.  For example:
  47
  48  (xpm-m2z-ellipse 1.5 3.5 5.8 4.2)
  49  => list of length 20
  50
  51     min  max  span
  52  X   -3    6    10
  53  Y    0    7     8
  54
  55 The span is always an even number.  As a special case, if the
  56 absolute value of RX or RY is less than 1, the value is nil."
  57   (cl-assert (and (not (integerp cx))
  58                   (not (integerp cy)))
  59              nil "Integer component in center coordinate: (%S,%S)"
  60              cx cy)
  61   (unless (or (> 1 (abs rx))
  62               (> 1 (abs ry)))
  63     (cl-flet*
  64         ((offset (coord idx)
  65                  (- (aref coord idx) 0.5))
  66          (normal (coord)
  67                  ;; flip axes: artist (ROW,COL) to xpm (X,Y)
  68                  (cons
  69                   (offset coord 1)      ; 1: COL -> car: X
  70                   (offset coord 0)))    ; 0: ROW -> cdr: Y
  71          (placed (origin scale n)
  72                  (truncate (+ origin (* scale n))))
  73          (orient (coords quadrant)
  74                  (cl-loop
  75                   with (sx . sy) = quadrant
  76                   for (x . y) in coords
  77                   collect (cons (placed cx sx x)
  78                                 (placed cy sy y)))))
  79       (delete-dups
  80        (cl-loop
  81         with coords = (mapcar
  82                        #'normal
  83                        (artist-ellipse-generate-quadrant
  84                         ;; Specify row first; artist.el is like that.
  85                         ;; (That's why ‘normal’ does what it does...)
  86                         ry rx))
  87         for quadrant                    ; these are in order: I-IV
  88         in '(( 1 .  1)                  ; todo: "manually" remove single
  89              (-1 .  1)                  ;       (border point) overlaps;
  90              (-1 . -1)                  ;       avoid ‘delete-dups’
  91              ( 1 . -1))
  92         append (orient coords quadrant))))))
  93
  94 ;;;###autoload
  95 (defun xpm-m2z-circle (cx cy radius)
  96   "Like `xpm-m2z-ellipse' with a shared radius RADIUS."
  97   (xpm-m2z-ellipse cx cy radius radius))
  98
  99 (provide 'xpm-m2z)
 100
 101 ;;; xpm-m2z.el ends here