/[emacs]/emacs/lisp/textmodes/artist.el
ViewVC logotype

Diff of /emacs/lisp/textmodes/artist.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10.2.2 by miles, Tue Oct 14 23:30:21 2003 UTC revision 1.10.2.3 by miles, Tue Jul 6 09:31:52 2004 UTC
# Line 1  Line 1 
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>
# Line 1698  info-variant-part." Line 1698  info-variant-part."
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'."
# Line 3368  The POINT-LIST is expected to cover the Line 3363  The POINT-LIST is expected to cover the
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    
# Line 3379  SHAPE-INFO is a two-element vector on th Line 3374  SHAPE-INFO is a two-element vector on th
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
# Line 3404  Ellipses with zero y-radius are not draw Line 3399  Ellipses with zero y-radius are not draw
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    
# Line 3419  SHAPE-INFO is a two-element vector on th Line 3414  SHAPE-INFO is a two-element vector on th
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)
# Line 3430  The Y-RADIUS must be 0, but the X-RADUIS Line 3425  The Y-RADIUS must be 0, but the X-RADUIS
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))
# Line 3440  The Y-RADIUS must be 0, but the X-RADUIS Line 3435  The Y-RADIUS must be 0, but the X-RADUIS
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    
# Line 3954  The 2-point shape SHAPE is drawn from X1 Line 3949  The 2-point shape SHAPE is drawn from X1
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))
# Line 4286  If optional argument THIS-IS-LAST-POINT Line 4281  If optional argument THIS-IS-LAST-POINT
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))
# Line 4793  If optional argument STATE is positive, Line 4788  If optional argument STATE is positive,
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)))

Legend:
Removed from v.1.10.2.2  
changed lines
  Added in v.1.10.2.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26