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

   1 ;;; flower.el --- can `xpm-raster' DTRT?     -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2014  Free Software Foundation, Inc.
   4
   5 ;; This program is free software; you can redistribute it and/or modify
   6 ;; it under the terms of the GNU General Public License as published by
   7 ;; the Free Software Foundation, either version 3 of the License, or
   8 ;; (at your option) any later version.
   9
  10 ;; This program is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;; GNU General Public License for more details.
  14
  15 ;; You should have received a copy of the GNU General Public License
  16 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 ;;; Commentary:
  19
  20 ;; This file helps visualize `xpm-raster' failure modes.  Maybe one
  21 ;; day it will be rendered useless by improvements to `xpm-raster'.
  22 ;;
  23 ;; NB: There is no `provide' form.
  24 ;; NB: Loading munges the global keymap -- YHBW!
  25
  26 ;;; Code:
  27
  28 (require 'xpm)
  29 (require 'xpm-m2z)
  30 (require 'cl-lib)
  31
  32 (defun flower (&optional again)
  33   "Stress `xpm-raster' in various ways."
  34   (interactive "P")
  35   (let ((buf (get-buffer "flower")))
  36     (when buf (kill-buffer buf)))
  37   (switch-to-buffer
  38    (xpm-generate-buffer "flower" 99 99 2
  39                         '(("  " . "green")
  40                           (".." . "yellow")
  41                           ("OO" . "red")
  42                           ("--" . "black"))))
  43   (setq truncate-lines t)
  44   (let* ((τ (* 4 2 (atan 1)))
  45          (half (/ 99 2.0))
  46          (mag-fns (vector (lambda (θ) (ignore θ) 1)
  47                           (lambda (θ) (sin θ))
  48                           (lambda (θ) (cos θ))
  49                           (lambda (θ) (sin (* 0.5 τ θ)))
  50                           (lambda (θ) (cos (* 0.5 τ θ)))
  51                           (lambda (θ) (sin (* 0.25 τ θ)))
  52                           (lambda (θ) (cos (* 0.25 τ θ)))
  53                           (lambda (θ) (sin (* τ θ)))
  54                           (lambda (θ) (cos (* τ θ)))))
  55          (n-mag-fns (length mag-fns)))
  56     (cl-flet
  57         ((random-mag-fn () (aref mag-fns (random n-mag-fns)))
  58          (form (fn &rest args) (apply fn half half (random 42) args)))
  59       (let* ((x-mag-fn (random-mag-fn))
  60              (y-mag-fn (random-mag-fn))
  61              (form (if again
  62                        (get 'flower 'form)
  63                      (delete-dups
  64                       (if (zerop (random 5))
  65                           (let ((one (form 'xpm-m2z-circle))
  66                                 (two (form 'xpm-m2z-ellipse (random 42))))
  67                             (append one two))
  68                         (cl-loop
  69                          for θ below τ by 0.003
  70                          collect
  71                          (cl-flet
  72                              ((at (f mfn)
  73                                   (truncate (+ half (* 42 (funcall mfn θ)
  74                                                        (funcall f θ))))))
  75                            (cons (at 'cos x-mag-fn)
  76                                  (at 'sin y-mag-fn)))))))))
  77         (put 'flower 'form form)
  78         (xpm-raster form "OO" ".."))))
  79   (image-mode)
  80   ;; strangely, image-mode screws up the markers, so we need to do
  81   ;; this again if we want to do subsequent xpm-* access:
  82   ;;+ (xpm-grok t)
  83   t)
  84
  85 ;;;---------------------------------------------------------------------------
  86 ;;; load-time actions
  87
  88 (global-set-key [f9] 'flower)
  89 (global-set-key
  90  [(meta f9)]
  91  (lambda () (interactive)
  92    (message "xpm-raster-inhibit-continuity-optimization now %s"
  93             (setq xpm-raster-inhibit-continuity-optimization
  94                   (not xpm-raster-inhibit-continuity-optimization)))))
  95
  96 ;;; flower.el ends here