Function: artist-mouse-draw-poly
artist-mouse-draw-poly is an interactive and byte-compiled function
defined in artist.el.gz.
Signature
(artist-mouse-draw-poly EV)
Documentation
Generic function for shapes requiring several points as input.
The event, EV, is the mouse event.
Key Bindings
Source Code
;; Defined in /usr/src/emacs/lisp/textmodes/artist.el.gz
(defun artist-mouse-draw-poly (ev)
"Generic function for shapes requiring several points as input.
The event, EV, is the mouse event."
(interactive "@e")
(message "Mouse-1: set new point, mouse-2: set last point")
(let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
(shifted (artist-go-get-symbol-shift artist-curr-go t))
(shift-state (artist-event-is-shifted ev))
(op (if shift-state shifted unshifted))
(draw-how (artist-go-get-draw-how-from-symbol op))
(init-fn (artist-go-get-init-fn-from-symbol op))
(prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
(exit-fn (artist-go-get-exit-fn-from-symbol op))
(draw-fn (artist-go-get-draw-fn-from-symbol op))
(undraw-fn (artist-go-get-undraw-fn-from-symbol op))
(fill-pred (artist-go-get-fill-pred-from-symbol op))
(fill-fn (artist-go-get-fill-fn-from-symbol op))
(arrow-pred (artist-go-get-arrow-pred-from-symbol op))
(arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
(ev-start (event-start ev))
(initial-win (posn-window ev-start))
(ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
(x1-last (artist--adjust-x (car ev-start-pos)))
(y1-last (cdr ev-start-pos))
(x2 x1-last)
(y2 y1-last)
(is-down t)
(shape nil)
(point-list nil)
(done nil))
(select-window (posn-window ev-start))
(artist-funcall init-fn x1-last y1-last)
(if (not artist-rubber-banding)
(artist-no-rb-set-point1 x1-last y1-last))
(track-mouse
(while (not done)
;; decide what to do
(cond
;; *** Mouse button is released.
((and is-down
(or (member 'click (event-modifiers ev))
(member 'drag (event-modifiers ev))))
;; First, if not rubber-banding, draw the line.
;;
(if (not artist-rubber-banding)
(progn
(artist-no-rb-unset-points)
(setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))))
;; Set the second point to the shape's second point
;; (which might be different from the mouse's second point,
;; if, for example, we are drawing a straight line)
;;
(if (not (null shape))
(let ((endpoint2 (artist-2point-get-endpoint2 shape)))
(setq x1-last (artist-endpoint-get-x endpoint2))
(setq y1-last (artist-endpoint-get-y endpoint2))))
(setq point-list (cons (artist-make-endpoint x1-last y1-last)
point-list))
(setq shape nil)
(setq is-down nil))
;; *** Mouse button 2 or 3 down
((and (member 'down (event-modifiers ev))
(or (equal (event-basic-type ev) 'mouse-2)
(equal (event-basic-type ev) 'mouse-3)))
;; Ignore
nil)
;; *** Mouse button 2 or 3 released
((and (or (member 'click (event-modifiers ev))
(member 'drag (event-modifiers ev)))
(or (equal (event-basic-type ev) 'mouse-2)
(equal (event-basic-type ev) 'mouse-3)))
;; This means the end of our poly-line drawing-session.
;;
(setq done t))
;; *** Mouse button 1 went down
((and (not is-down)
(member 'down (event-modifiers ev))
(equal (event-basic-type ev) 'mouse-1))
;; Check whether the (possibly new, that depends on if shift
;; has been pressed or released) symbol has the same draw-how
;; information as the previous had. If it hasn't, we can't
;; proceed.
;;
(if (not (eq draw-how
(artist-go-get-draw-how-from-symbol
(if (not shift-state) shifted unshifted))))
(message "Cannot switch operation")
(progn
;; Decide operation
;;
(setq unshifted
(artist-go-get-symbol-shift artist-curr-go nil)
shifted
(artist-go-get-symbol-shift artist-curr-go t)
shift-state (artist-event-is-shifted ev)
op (if shift-state shifted unshifted)
draw-how (artist-go-get-draw-how-from-symbol op)
draw-fn (artist-go-get-draw-fn-from-symbol op)
undraw-fn (artist-go-get-undraw-fn-from-symbol op)
fill-pred (artist-go-get-fill-pred-from-symbol op)
fill-fn (artist-go-get-fill-fn-from-symbol op))
;; Draw shape from last place to this place
;; set x2 and y2
;;
(setq ev-start-pos (artist-coord-win-to-buf
(posn-col-row (event-start ev))))
(setq x2 (artist--adjust-x (car ev-start-pos)))
(setq y2 (cdr ev-start-pos))
;; Draw the new shape (if not rubber-banding, place both marks)
;;
(if artist-rubber-banding
(setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))
(progn
(artist-no-rb-set-point1 x1-last y1-last)
(artist-no-rb-set-point2 x2 y2)))
;; Show new operation in mode-line
(let ((artist-curr-go op))
(artist-mode-line-show-curr-operation t))))
(setq is-down t))
;; *** Mouse moved, button is down and we are still in orig window
((and (mouse-movement-p ev)
is-down
(eq initial-win (posn-window (event-start ev))))
;; Draw shape from last place to this place
;;
;; set x2 and y2
(setq ev-start-pos (artist-coord-win-to-buf
(posn-col-row (event-start ev))))
(setq x2 (artist--adjust-x (car ev-start-pos)))
(setq y2 (cdr ev-start-pos))
;; First undraw last shape
;; (unset last point if not rubberbanding)
;;
(artist-funcall undraw-fn shape)
;; Draw the new shape (if not rubberbanding, set 2nd mark)
;;
(if artist-rubber-banding
(setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))
(progn
(artist-no-rb-unset-point2)
(artist-no-rb-set-point2 x2 y2)))
;; Move cursor
(artist-move-to-xy x2 y2))
;; *** Mouse moved, button is down but we are NOT in orig window
((and (mouse-movement-p ev)
is-down
(not (eq initial-win (posn-window (event-start ev)))))
;; Ignore
nil)
;; *** Moving mouse while mouse button is not down
((and (mouse-movement-p ev) (not is-down))
;; don't do anything.
nil)
;; *** Mouse button 1 went down, first time
((and is-down
(member 'down (event-modifiers ev))
(equal (event-basic-type ev) 'mouse-1))
;; don't do anything
nil)
;; *** Another event
(t
;; End drawing
;;
(setq done t)))
;; Read next event (only if we should not stop)
(if (not done)
(setq ev (read--potential-mouse-event)))))
;; Reverse point-list (last points are cond'ed first)
(setq point-list (reverse point-list))
(artist-funcall prep-fill-fn point-list)
;; Maybe fill
(if (artist-funcall fill-pred)
(artist-funcall fill-fn point-list))
;; Maybe set arrow points
(if (and point-list (artist-funcall arrow-pred))
(artist-funcall arrow-set-fn point-list)
(artist-clear-arrow-points))
(artist-funcall exit-fn point-list)
(artist-move-to-xy x2 y2)))