1 |
;;; artist.el --- draw ascii graphics with your mouse |
;;; artist.el --- draw ascii graphics with your mouse |
2 |
|
|
3 |
;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. |
;; Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Tomas Abrahamsson <tab@lysator.liu.se> |
;; Author: Tomas Abrahamsson <tab@lysator.liu.se> |
6 |
;; Maintainer: Tomas Abrahamsson <tab@lysator.liu.se> |
;; Maintainer: Tomas Abrahamsson <tab@lysator.liu.se> |
1698 |
(t (cons (car l) (artist-butlast (cdr l)))))) |
(t (cons (car l) (artist-butlast (cdr l)))))) |
1699 |
|
|
1700 |
|
|
1701 |
(defun artist-last (seq &optional n) |
(defun artist-last (l &optional n) |
1702 |
"Return the last link in the list SEQ. |
"Return the last link in the list L. |
1703 |
With optional argument N, returns Nth-to-last link (default 1)." |
With optional argument N, returns Nth-to-last link (default 1)." |
1704 |
(if (not n) |
(nth (- (length l) (or n 1)) l)) |
|
(setq n 1)) |
|
|
(let ((len (length seq))) |
|
|
(elt seq (- len n)))) |
|
1705 |
|
|
1706 |
(defun artist-remove-nulls (l) |
(defun artist-remove-nulls (l) |
1707 |
"Remove nils in list L." |
"Remove nils in list L." |
1708 |
(cond ((null l) nil) |
(remq nil l)) |
|
((null (car l)) (artist-remove-nulls (cdr l))) |
|
|
(t (cons (car l) (artist-remove-nulls (cdr l)))))) |
|
1709 |
|
|
1710 |
(defun artist-uniq (l) |
(defun artist-uniq (l) |
1711 |
"Remove consecutive duplicates in list L. Comparison is done with `equal'." |
"Remove consecutive duplicates in list L. Comparison is done with `equal'." |
3363 |
(append right-half left-half))) |
(append right-half left-half))) |
3364 |
|
|
3365 |
|
|
3366 |
(defun artist-draw-ellipse-general (x y x-radius y-radius) |
(defun artist-draw-ellipse-general (x1 y1 x-radius y-radius) |
3367 |
"Draw an ellipse with center at X, Y and X-RADIUS and Y-RADIUS. |
"Draw an ellipse with center at X1, Y1 and X-RADIUS and Y-RADIUS. |
3368 |
|
|
3369 |
Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO). |
Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO). |
3370 |
|
|
3374 |
POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR]. |
POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR]. |
3375 |
FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]. |
FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]. |
3376 |
|
|
3377 |
Ellipses with zero y-radius are not drawn correctly." |
Ellipses with zero Y-RADIUS are not drawn correctly." |
3378 |
(let* ((point-list (artist-ellipse-generate-quadrant x-radius y-radius)) |
(let* ((point-list (artist-ellipse-generate-quadrant x-radius y-radius)) |
3379 |
(fill-info (artist-ellipse-compute-fill-info point-list)) |
(fill-info (artist-ellipse-compute-fill-info point-list)) |
3380 |
(shape-info (make-vector 2 0))) |
(shape-info (make-vector 2 0))) |
3381 |
|
|
3382 |
(setq point-list (artist-calculate-new-chars point-list)) |
(setq point-list (artist-calculate-new-chars point-list)) |
3383 |
(setq point-list (artist-ellipse-mirror-quadrant point-list)) |
(setq point-list (artist-ellipse-mirror-quadrant point-list)) |
3384 |
(setq point-list (artist-ellipse-point-list-add-center x y point-list)) |
(setq point-list (artist-ellipse-point-list-add-center x1 y1 point-list)) |
3385 |
(setq fill-info (artist-ellipse-fill-info-add-center x y fill-info)) |
(setq fill-info (artist-ellipse-fill-info-add-center x1 y1 fill-info)) |
3386 |
|
|
3387 |
;; Draw the ellipse |
;; Draw the ellipse |
3388 |
(setq point-list |
(setq point-list |
3399 |
|
|
3400 |
(aset shape-info 0 point-list) |
(aset shape-info 0 point-list) |
3401 |
(aset shape-info 1 fill-info) |
(aset shape-info 1 fill-info) |
3402 |
(artist-make-2point-object (artist-make-endpoint x y) |
(artist-make-2point-object (artist-make-endpoint x1 y1) |
3403 |
(artist-make-endpoint x-radius y-radius) |
(artist-make-endpoint x-radius y-radius) |
3404 |
shape-info))) |
shape-info))) |
3405 |
|
|
3406 |
(defun artist-draw-ellipse-with-0-height (x y x-radius y-radius) |
(defun artist-draw-ellipse-with-0-height (x1 y1 x-radius y-radius) |
3407 |
"Draw an ellipse with center at X, Y and X-RADIUS and Y-RADIUS. |
"Draw an ellipse with center at X1, Y1 and X-RADIUS and Y-RADIUS. |
3408 |
|
|
3409 |
Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO). |
Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO). |
3410 |
|
|
3414 |
POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR]. |
POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR]. |
3415 |
FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]. |
FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]. |
3416 |
|
|
3417 |
The Y-RADIUS must be 0, but the X-RADUIS must not be 0." |
The Y-RADIUS must be 0, but the X-RADIUS must not be 0." |
3418 |
(let ((point-list nil) |
(let ((point-list nil) |
3419 |
(width (max (- (abs (* 2 x-radius)) 1))) |
(width (max (- (abs (* 2 x-radius)) 1))) |
3420 |
(left-edge (1+ (- x (abs x-radius)))) |
(left-edge (1+ (- x1 (abs x-radius)))) |
3421 |
(line-char (if artist-line-char-set artist-line-char ?-)) |
(line-char (if artist-line-char-set artist-line-char ?-)) |
3422 |
(i 0) |
(i 0) |
3423 |
(point-list nil) |
(point-list nil) |
3425 |
(shape-info (make-vector 2 0))) |
(shape-info (make-vector 2 0))) |
3426 |
(while (< i width) |
(while (< i width) |
3427 |
(let* ((line-x (+ left-edge i)) |
(let* ((line-x (+ left-edge i)) |
3428 |
(line-y y) |
(line-y y1) |
3429 |
(new-coord (artist-new-coord line-x line-y))) |
(new-coord (artist-new-coord line-x line-y))) |
3430 |
(artist-coord-add-saved-char new-coord |
(artist-coord-add-saved-char new-coord |
3431 |
(artist-get-char-at-xy line-x line-y)) |
(artist-get-char-at-xy line-x line-y)) |
3435 |
(setq i (1+ i)))) |
(setq i (1+ i)))) |
3436 |
(aset shape-info 0 point-list) |
(aset shape-info 0 point-list) |
3437 |
(aset shape-info 1 fill-info) |
(aset shape-info 1 fill-info) |
3438 |
(artist-make-2point-object (artist-make-endpoint x y) |
(artist-make-2point-object (artist-make-endpoint x1 y1) |
3439 |
(artist-make-endpoint x-radius y-radius) |
(artist-make-endpoint x-radius y-radius) |
3440 |
shape-info))) |
shape-info))) |
3441 |
|
|
3949 |
|
|
3950 |
(defun artist-draw-region-trim-line-endings (min-y max-y) |
(defun artist-draw-region-trim-line-endings (min-y max-y) |
3951 |
"Trim lines in current draw-region from MIN-Y to MAX-Y. |
"Trim lines in current draw-region from MIN-Y to MAX-Y. |
3952 |
Trimming here means removing white space at end of a line" |
Trimming here means removing white space at end of a line." |
3953 |
;; Safetyc check: switch min-y and max-y if if max-y is smaller |
;; Safetyc check: switch min-y and max-y if if max-y is smaller |
3954 |
(if (< max-y min-y) |
(if (< max-y min-y) |
3955 |
(let ((tmp min-y)) |
(let ((tmp min-y)) |
4281 |
|
|
4282 |
(defun artist-key-set-point-common (arg) |
(defun artist-key-set-point-common (arg) |
4283 |
"Common routine for setting point in current shape. |
"Common routine for setting point in current shape. |
4284 |
With ARG set to t, set the last point." |
With non-nil ARG, set the last point." |
4285 |
(let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go)) |
(let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go)) |
4286 |
(col (artist-current-column)) |
(col (artist-current-column)) |
4287 |
(row (artist-current-line)) |
(row (artist-current-line)) |
4788 |
|
|
4789 |
|
|
4790 |
(defun artist-mouse-choose-operation (ev op) |
(defun artist-mouse-choose-operation (ev op) |
4791 |
"Choose operation for evenvt EV and operation OP." |
"Choose operation for event EV and operation OP." |
4792 |
(interactive |
(interactive |
4793 |
(progn |
(progn |
4794 |
(select-window (posn-window (event-start last-input-event))) |
(select-window (posn-window (event-start last-input-event))) |