comparison lisp/textmodes/artist.el @ 55793:812519af46fd

(artist-last, artist-remove-nulls): Simplify. (artist-draw-ellipse-general, artist-draw-ellipse-with-0-height): Make arguments match their use in docstring. (artist-draw-region-trim-line-endings, (artist-mouse-choose-operation): Fix typo in docstring. (artist-key-set-point-common): Doc fix.

55792:0d890eccf70f

;;; artist.el --- draw ascii graphics with your mouse

;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.

;; Author:       Tomas Abrahamsson <[e-mail]>
;; Maintainer:   Tomas Abrahamsson <[e-mail]>
;; Keywords:     mouse
;; Version:	 1.2.4

  (cond ((null l) nil)
	((null (cdr l)) nil)
	(t (cons (car l) (artist-butlast (cdr l))))))


(defun artist-last (seq &optional n)
  "Return the last link in the list SEQ.
With optional argument N, returns Nth-to-last link (default 1)."
  (if (not n)
      (setq n 1))
  (let ((len (length seq)))
    (elt seq (- len n))))

(defun artist-remove-nulls (l)
  "Remove nils in list L."
  (cond ((null l) nil)
	((null (car l)) (artist-remove-nulls (cdr l)))
	(t (cons (car l) (artist-remove-nulls (cdr l))))))

(defun artist-uniq (l)
  "Remove consecutive duplicates in list L.  Comparison is done with `equal'."
  (cond ((null l) nil)
	((null (cdr l)) l)		; only one element in list

	   ;; and middle bottom char twice.
	   (funcall artist-butlast-fn (cdr (reverse right-half)))))
    (append right-half left-half)))


(defun artist-draw-ellipse-general (x y x-radius y-radius)
  "Draw an ellipse with center at X, Y and X-RADIUS and Y-RADIUS.

Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).

END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].

POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE].

Ellipses with zero y-radius are not drawn correctly."
  (let* ((point-list   (artist-ellipse-generate-quadrant x-radius y-radius))
	 (fill-info    (artist-ellipse-compute-fill-info point-list))
	 (shape-info   (make-vector 2 0)))

    (setq point-list (artist-calculate-new-chars point-list))
    (setq point-list (artist-ellipse-mirror-quadrant point-list))
    (setq point-list (artist-ellipse-point-list-add-center x y point-list))
    (setq fill-info (artist-ellipse-fill-info-add-center x y fill-info))

    ;; Draw the ellipse
    (setq point-list
	  (mapcar
	   (lambda (coord)

	   (artist-modify-new-chars
	     (artist-save-chars-under-point-list point-list))))

    (aset shape-info 0 point-list)
    (aset shape-info 1 fill-info)
    (artist-make-2point-object (artist-make-endpoint x y)
			       (artist-make-endpoint x-radius y-radius)
			       shape-info)))

(defun artist-draw-ellipse-with-0-height (x y x-radius y-radius)
  "Draw an ellipse with center at X, Y and X-RADIUS and Y-RADIUS.

Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).

END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].

POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE].

The Y-RADIUS must be 0, but the X-RADUIS must not be 0."
  (let ((point-list nil)
	(width      (max (- (abs (* 2 x-radius)) 1)))
	(left-edge  (1+ (- x (abs x-radius))))
	(line-char  (if artist-line-char-set artist-line-char ?-))
	(i          0)
	(point-list nil)
	(fill-info  nil)
	(shape-info (make-vector 2 0)))
    (while (< i width)
      (let* ((line-x (+ left-edge i))
	     (line-y y)
	     (new-coord (artist-new-coord line-x line-y)))
	(artist-coord-add-saved-char new-coord
				     (artist-get-char-at-xy line-x line-y))
	(artist-move-to-xy line-x line-y)
	(artist-replace-char line-char)
	(setq point-list (append point-list (list new-coord)))
	(setq i (1+ i))))
    (aset shape-info 0 point-list)
    (aset shape-info 1 fill-info)
    (artist-make-2point-object (artist-make-endpoint x y)
			       (artist-make-endpoint x-radius y-radius)
			       shape-info)))

(defun artist-draw-ellipse (x1 y1 x2 y2)
  "Draw an ellipse with center at X1, Y1 and point X2,Y2.

  (setq artist-draw-region-max-y 0)
  (setq artist-draw-region-min-y 1000000))

(defun artist-draw-region-trim-line-endings (min-y max-y)
  "Trim lines in current draw-region from MIN-Y to MAX-Y.
Trimming here means removing white space at end of a line"
  ;; Safetyc check: switch min-y and max-y if if max-y is smaller
  (if (< max-y min-y)
      (let ((tmp min-y))
	(setq min-y max-y)
	(setq max-y tmp)))

	(setq artist-key-is-drawing nil)))))


(defun artist-key-set-point-common (arg)
  "Common routine for setting point in current shape.
With ARG set to t, set the last point."
  (let ((draw-how    (artist-go-get-draw-how-from-symbol artist-curr-go))
	(col         (artist-current-column))
	(row         (artist-current-line))
	(was-drawing artist-key-is-drawing))

      (artist-mode-line-show-curr-operation artist-key-is-drawing))))


(defun artist-mouse-choose-operation (ev op)
  "Choose operation for evenvt EV and operation OP."
  (interactive
   (progn
     (select-window (posn-window (event-start last-input-event)))
     (list last-input-event
           (x-popup-menu last-nonmenu-event artist-popup-menu-table))))

55793:812519af46fd

;;; artist.el --- draw ascii graphics with your mouse

;; Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc.

;; Author:       Tomas Abrahamsson <[e-mail]>
;; Maintainer:   Tomas Abrahamsson <[e-mail]>
;; Keywords:     mouse
;; Version:	 1.2.4

  (cond ((null l) nil)
	((null (cdr l)) nil)
	(t (cons (car l) (artist-butlast (cdr l))))))


(defun artist-last (l &optional n)
  "Return the last link in the list L.
With optional argument N, returns Nth-to-last link (default 1)."
  (nth (- (length l) (or n 1)) l))

(defun artist-remove-nulls (l)
  "Remove nils in list L."
  (remq nil l))

(defun artist-uniq (l)
  "Remove consecutive duplicates in list L.  Comparison is done with `equal'."
  (cond ((null l) nil)
	((null (cdr l)) l)		; only one element in list

	   ;; and middle bottom char twice.
	   (funcall artist-butlast-fn (cdr (reverse right-half)))))
    (append right-half left-half)))


(defun artist-draw-ellipse-general (x1 y1 x-radius y-radius)
  "Draw an ellipse with center at X1, Y1 and X-RADIUS and Y-RADIUS.

Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).

END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].

POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE].

Ellipses with zero Y-RADIUS are not drawn correctly."
  (let* ((point-list   (artist-ellipse-generate-quadrant x-radius y-radius))
	 (fill-info    (artist-ellipse-compute-fill-info point-list))
	 (shape-info   (make-vector 2 0)))

    (setq point-list (artist-calculate-new-chars point-list))
    (setq point-list (artist-ellipse-mirror-quadrant point-list))
    (setq point-list (artist-ellipse-point-list-add-center x1 y1 point-list))
    (setq fill-info (artist-ellipse-fill-info-add-center x1 y1 fill-info))

    ;; Draw the ellipse
    (setq point-list
	  (mapcar
	   (lambda (coord)

	   (artist-modify-new-chars
	     (artist-save-chars-under-point-list point-list))))

    (aset shape-info 0 point-list)
    (aset shape-info 1 fill-info)
    (artist-make-2point-object (artist-make-endpoint x1 y1)
			       (artist-make-endpoint x-radius y-radius)
			       shape-info)))

(defun artist-draw-ellipse-with-0-height (x1 y1 x-radius y-radius)
  "Draw an ellipse with center at X1, Y1 and X-RADIUS and Y-RADIUS.

Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).

END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].

POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE].

The Y-RADIUS must be 0, but the X-RADIUS must not be 0."
  (let ((point-list nil)
	(width      (max (- (abs (* 2 x-radius)) 1)))
	(left-edge  (1+ (- x1 (abs x-radius))))
	(line-char  (if artist-line-char-set artist-line-char ?-))
	(i          0)
	(point-list nil)
	(fill-info  nil)
	(shape-info (make-vector 2 0)))
    (while (< i width)
      (let* ((line-x (+ left-edge i))
	     (line-y y1)
	     (new-coord (artist-new-coord line-x line-y)))
	(artist-coord-add-saved-char new-coord
				     (artist-get-char-at-xy line-x line-y))
	(artist-move-to-xy line-x line-y)
	(artist-replace-char line-char)
	(setq point-list (append point-list (list new-coord)))
	(setq i (1+ i))))
    (aset shape-info 0 point-list)
    (aset shape-info 1 fill-info)
    (artist-make-2point-object (artist-make-endpoint x1 y1)
			       (artist-make-endpoint x-radius y-radius)
			       shape-info)))

(defun artist-draw-ellipse (x1 y1 x2 y2)
  "Draw an ellipse with center at X1, Y1 and point X2,Y2.

  (setq artist-draw-region-max-y 0)
  (setq artist-draw-region-min-y 1000000))

(defun artist-draw-region-trim-line-endings (min-y max-y)
  "Trim lines in current draw-region from MIN-Y to MAX-Y.
Trimming here means removing white space at end of a line."
  ;; Safetyc check: switch min-y and max-y if if max-y is smaller
  (if (< max-y min-y)
      (let ((tmp min-y))
	(setq min-y max-y)
	(setq max-y tmp)))

	(setq artist-key-is-drawing nil)))))


(defun artist-key-set-point-common (arg)
  "Common routine for setting point in current shape.
With non-nil ARG, set the last point."
  (let ((draw-how    (artist-go-get-draw-how-from-symbol artist-curr-go))
	(col         (artist-current-column))
	(row         (artist-current-line))
	(was-drawing artist-key-is-drawing))

      (artist-mode-line-show-curr-operation artist-key-is-drawing))))


(defun artist-mouse-choose-operation (ev op)
  "Choose operation for event EV and operation OP."
  (interactive
   (progn
     (select-window (posn-window (event-start last-input-event)))
     (list last-input-event
           (x-popup-menu last-nonmenu-event artist-popup-menu-table))))