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

   1 ;;; xpm-ops.el --- drawing operations        -*- 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 ;;; Code:
  21
  22 (require 'queue)
  23 (require 'cl-lib)
  24 (require 'xpm)
  25
  26 (defun xpm-flood-fill (px x y)
  27   (xpm--w/gg (cpp origin y-mult) (xpm--gate)
  28     (let ((q (queue-create))
  29           bye)
  30       (cl-labels
  31           ((pos (x y) (+ origin (* cpp x) (* y-mult y)))
  32            (cur () (let ((p (point)))
  33                      (buffer-substring-no-properties
  34                       p (+ p cpp))))
  35            (oldp () (string= bye (cur)))
  36            (extent (coord)
  37                    (let* ((x (car coord))
  38                           (y (cdr coord))
  39                           (p (goto-char (pos x y)))
  40                           (beg x)
  41                           (end x))
  42                      (when (oldp)
  43                        (cl-loop while (oldp)
  44                                 do (backward-char cpp)
  45                                 do (cl-decf beg)
  46                                 finally do (cl-incf beg))
  47                        (goto-char p)
  48                        (cl-loop while (oldp)
  49                                 do (forward-char cpp)
  50                                 do (cl-incf end)
  51                                 finally do (cl-decf end))
  52                        (cons beg end)))))
  53         (setq bye (let ((p (pos x y)))
  54                     (buffer-substring-no-properties
  55                      p (+ p cpp))))
  56         (queue-enqueue q (cons x y))
  57         (cl-loop until (queue-empty q)
  58               do (let* ((coord (queue-dequeue q))
  59                         (ext (extent coord)))
  60                    (when ext
  61                      (xpm-put-points px ext y)
  62                      ;; todo: expansion and queuing of y-1 and y+1
  63                      )))))))
  64
  65 ;;; xpm-ops.el ends here