| blob | 6342110f20beea4548e6ec87e95c5bf8f7ececff |
1 ;;; artist.el --- draw ascii graphics with your mouse
3 ;; Copyright (C) 2000-2016 Free Software Foundation, Inc.
5 ;; Author: Tomas Abrahamsson <tab@lysator.liu.se>
6 ;; Maintainer: Tomas Abrahamsson <tab@lysator.liu.se>
7 ;; Keywords: mouse
8 ;; Version: 1.2.6
9 ;; Release-date: 6-Aug-2004
10 ;; Location: http://www.lysator.liu.se/~tab/artist/
12 ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
13 ;; file on 19/3/2008, and the maintainer agreed that when a bug is filed in
14 ;; the Emacs bug reporting system against this file, a copy of the bug
15 ;; report be sent to the maintainer's email address.
17 ;; This file is part of GNU Emacs.
19 ;; GNU Emacs is free software: you can redistribute it and/or modify
20 ;; it under the terms of the GNU General Public License as published by
21 ;; the Free Software Foundation, either version 3 of the License, or
22 ;; (at your option) any later version.
24 ;; GNU Emacs is distributed in the hope that it will be useful,
25 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
26 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
27 ;; GNU General Public License for more details.
29 ;; You should have received a copy of the GNU General Public License
30 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
32 ;;; Commentary:
34 ;; What is artist?
35 ;; ---------------
36 ;;
37 ;; Artist is an Emacs lisp package that allows you to draw lines,
38 ;; rectangles and ellipses by using your mouse and/or keyboard. The
39 ;; shapes are made up with the ascii characters |, -, / and \.
40 ;;
41 ;; Features are:
42 ;;
43 ;; * Intersecting: When a `|' intersects with a `-', a `+' is
44 ;; drawn, like this: | \ /
45 ;; --+-- X
46 ;; | / \
47 ;;
48 ;; * Rubber-banding: When drawing lines you can interactively see the
49 ;; result while holding the mouse button down and moving the mouse. If
50 ;; your machine is not fast enough (a 386 is a bit to slow, but a
51 ;; pentium is well enough), you can turn this feature off. You will
52 ;; then see 1's and 2's which mark the 1st and 2nd endpoint of the line
53 ;; you are drawing.
54 ;;
55 ;; * Drawing operations: The following drawing operations are implemented:
56 ;;
57 ;; lines straight-lines
58 ;; rectangles squares
59 ;; poly-lines straight poly-lines
60 ;; ellipses circles
61 ;; text (see-thru) text (overwrite)
62 ;; spray-can setting size for spraying
63 ;; vaporize line vaporize lines
64 ;; erase characters erase rectangles
65 ;;
66 ;; Straight lines are lines that go horizontally, vertically or
67 ;; diagonally. Plain lines go in any direction. The operations in
68 ;; the right column are accessed by holding down the shift key while
69 ;; drawing.
70 ;;
71 ;; It is possible to vaporize (erase) entire lines and connected lines
72 ;; (rectangles for example) as long as the lines being vaporized are
73 ;; straight and connected at their endpoints. Vaporizing is inspired
74 ;; by the drawrect package by Jari Aalto <jari.aalto@poboxes.com>.
75 ;;
76 ;; * Flood-filling: You can fill any area with a certain character by
77 ;; flood-filling.
78 ;;
79 ;; * Cut copy and paste: You can cut, copy and paste rectangular
80 ;; regions. Artist also interfaces with the rect package (this can be
81 ;; turned off if it causes you any trouble) so anything you cut in
82 ;; artist can be yanked with C-x r y and vice versa.
83 ;;
84 ;; * Drawing with keys: Everything you can do with the mouse, you can
85 ;; also do without the mouse.
86 ;;
87 ;; * Arrows: After having drawn a (straight) line or a (straight)
88 ;; poly-line, you can set arrows on the line-ends by typing < or >.
89 ;;
90 ;; * Aspect-ratio: You can set the variable artist-aspect-ratio to
91 ;; reflect the height-width ratio for the font you are using. Squares
92 ;; and circles are then drawn square/round. Note, that once your
93 ;; ascii-file is shown with font with a different height-width ratio,
94 ;; the squares won't be square and the circles won't be round.
95 ;;
96 ;; * Picture mode compatibility: Artist is picture mode compatible (this
97 ;; can be turned off).
98 ;;
99 ;; See the documentation for the function artist-mode for a detailed
100 ;; description on how to use artist.
101 ;;
102 ;;
103 ;; What about adding my own drawing modes?
104 ;; ---------------------------------------
105 ;;
106 ;; See the short guide at the end of this file.
107 ;; If you add a new drawing mode, send it to me, and I would gladly
108 ;; include in the next release!
110 ;;; Installation:
112 ;; To use artist, put this in your .emacs:
113 ;;
114 ;; (autoload 'artist-mode "artist" "Enter artist-mode" t)
117 ;;; Requirements:
119 ;; Artist requires Emacs 19.28 or higher.
120 ;;
121 ;; Artist requires the `rect' package (which comes with Emacs) to be
122 ;; loadable, unless the variable `artist-interface-with-rect' is set
123 ;; to nil.
124 ;;
125 ;; Artist also requires the Picture mode (which also comes with Emacs)
126 ;; to be loadable, unless the variable `artist-picture-compatibility'
127 ;; is set to nil.
129 ;;; Known bugs:
131 ;; The shifted operations are not available when drawing with the mouse
132 ;; in Emacs 19.29 and 19.30.
133 ;;
134 ;; It is not possible to change between shifted and unshifted operation
135 ;; while drawing with the mouse. (See the comment in the function
136 ;; artist-shift-has-changed for further details.)
139 ;;; ChangeLog:
141 ;; 1.2.6 6-Aug-2004
142 ;; New: Coerced with the artist.el that's in Emacs-21.3.
143 ;; (minor editorial changes)
144 ;;
145 ;; 1.2.5 4-Aug-2004
146 ;; New: Added tool selection via the mouse-wheel
147 ;; Function provided by Andreas Leue <al@sphenon.de>
148 ;;
149 ;; 1.2.4 25-Oct-2001
150 ;; Bugfix: Some operations (the edit menu) got hidden
151 ;; Bugfix: The first arrow for poly-lines was always pointing
152 ;; to the right
153 ;; Changed: Updated with changes made for Emacs 21.1
154 ;;
155 ;; 1.2.3 20-Nov-2000
156 ;; Bugfix: Autoload cookie corrected
157 ;;
158 ;; 1.2.2 19-Nov-2000
159 ;; Changed: More documentation fixes.
160 ;; Bugfix: The arrow characters (`artist-arrows'), which
161 ;; got wrong in 1.1, are now corrected.
162 ;;
163 ;; 1.2.1 15-Nov-2000
164 ;; New: Documentation fixes.
165 ;; Bugfix: Sets next-line-add-newlines to t while in artist-mode.
166 ;; Drawing with keys was confusing without this fix, if
167 ;; next-line-add-newlines was set to nil.
168 ;; Thanks to Tatsuo Furukawa <tatsuo@kobe.hp.com> for this.
169 ;;
170 ;; 1.2 22-Oct-2000
171 ;; New: Updated to work with Emacs 21
172 ;;
173 ;; 1.1 15-Aug-2000
174 ;; Bugfix: Cursor follows mouse pointer more closely.
175 ;; New: Works with Emacs 20.x
176 ;; New: Variables are customizable
177 ;;
178 ;; 1.1-beta1 21-Apr-1998
179 ;; New: Spray-can (Utterly useless, I believe, but it was fun
180 ;; to implement :-) after an idea by Karl-Johan Karlsson
181 ;; <kj@lysator.liu.se>.
182 ;; New: Freehand drawing (with pen).
183 ;; New: Vaporizing lines.
184 ;; New: Text-rendering using figlet.
185 ;; New: Picture mode compatibility.
186 ;; Changed: All Artist keys now uses the prefix C-c C-a not to conflict
187 ;; with Picture mode.
188 ;; Bugfix: No longer leaves traces of lines when rubberbanding
189 ;; if the buffer auto-scrolls.
190 ;; Bugfix: Infinite loop sometimes when rubberbanding was turned
191 ;; off.
192 ;;
193 ;; 1.0 01-Mar-1998
194 ;; First official release.
196 ;;; Code:
198 ;; Variables
205 ;; User options
206 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
209 "Customization of the Artist mode."
213 "Customization of the text rendering."
217 "Interactively do rubber-banding when non-nil."
222 "Character to set at first point when not rubber-banding."
227 "Character to set at second point when not rubber-banding."
232 "Whether to interface with the rect package or not.
234 Interfacing to the rect package means that the Copy and Paste operations
235 will use the rectangle buffer when accessing the copied area. This means
236 that you can insert a rectangle which is copied using the artist package
237 and vice versa.
239 If this causes any problem for you (for example, if the implementation of
240 the rectangle package changes), you can set this variable to nil, and the
241 artist package will use its own copy buffer."
246 ;; This is a defvar, not a defcustom, since the custom
247 ;; package shows vectors of characters as a vector of integers,
248 ;; which is confusing
249 "A vector of characters to use as arrows.
251 The vector is 8 elements long and contains a character for each
252 direction, or nil if there is no suitable character to use for arrow
253 in that direction.
255 The directions are as follows:
257 5 6 7
259 4 - * - 0
264 "Defines the character height-to-width aspect ratio.
265 This is used when drawing squares and circles."
270 "Whether or not to remove white-space at end of lines.
272 If non-nil, line-endings are trimmed (that is, extraneous white-space
273 at the end of the line is removed) when the shape is drawn."
279 "Right edge definition, used when flood-filling.
281 When flood-filling, if the area is not closed off to the right, then
282 flood-filling will fill no more to the right than specified by this
283 variable. This limit is called the fill-border."
289 "Whether or not to incrementally update display when flood-filling.
291 If non-nil, incrementally update display when flood-filling.
292 If set to non-nil, this currently implies discarding any input events
293 during the flood-fill."
299 "Character to use at the rightmost position when drawing narrow ellipses.
302 -----
303 ( )
304 -----"
310 "Character to use at the leftmost position when drawing narrow ellipses.
313 -----
314 ( )
315 -----"
320 "Whether or not picture mode compatibility is on."
328 "How to vaporize lines that are cut off.
330 Accept this many characters cutting off a line and still treat
331 it as one line.
332 Example:
333 If `artist-vaporize-fuzziness' is 2, then those will be recognized as
335 /
336 A----*------/-----------B
341 but this one won't, since it is cut off by more than 2 characters:
346 crossing the line] will be vaporized)."
356 "Function for doing text rendering."
363 "Program to run for `figlet'."
369 "Default font for `figlet'."
375 ;; list files ending with *.flf in any directory printed by the
376 ;; ``figlet -I2'' command. I think this will not produce more than
377 ;; one directory, but it never hurts to be on the safe side...
378 "for dir in `figlet -I2`; do cd $dir; ls *.flf; done"
379 "Command to run to get list of available fonts."
385 "Number of seconds between repeated spraying."
391 "Size of the area for spraying."
397 ;; This is a defvar, not a defcustom, since the custom
398 ;; package shows lists of characters as a lists of integers,
399 ;; which is confusing
406 "Initial character to use when spraying.
407 This character is used if spraying upon a character that is not in
408 `artist-spray-chars'. The character defined by this variable should
412 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
413 ;; End of user options
416 ;; Internal variables
417 ;;
453 ; This variable is not buffer local
466 "When non-nil, draw shapes without border.
471 "Assoc list for looking up next and/or previous draw operation.
472 The structure is as follows: (OP . (PREV-OP . NEXT-OP))
473 where the elements are as follows:
474 * OP is an atom: the KEY-SYMBOL in the `artist-mt' structure
475 * PREV-OP and NEXT-OP are strings: the KEYWORD in the `artist-mt' structure
480 ;; Make rect available at compile-time
493 ;; Variables that are made local in artist-mode-init
504 \f
511 '(menu-item "Draw Shape Borders" artist-toggle-borderless-shapes
512 :help "Toggle whether shapes are drawn with borders"
513 :button (:toggle . (not artist-borderless-shapes))))
514 (define-key map [trimming]
515 '(menu-item "Trim Line Endings" artist-toggle-trim-line-endings
516 :help "Toggle trimming of line-endings"
517 :button (:toggle . artist-trim-line-endings)))
518 (define-key map [rubber-band]
519 '(menu-item "Rubber-banding" artist-toggle-rubber-banding
520 :help "Toggle rubber-banding"
521 :button (:toggle . artist-rubber-banding)))
522 (define-key map [set-erase]
523 '(menu-item "Character to Erase..." artist-select-erase-char
524 :help "Choose a specific character to erase"))
525 (define-key map [set-line]
526 '(menu-item "Character for Line..." artist-select-line-char
527 :help "Choose the character to insert when drawing lines"))
528 (define-key map [set-fill]
529 '(menu-item "Character for Fill..." artist-select-fill-char
530 :help "Choose the character to insert when filling in shapes"))
531 (define-key map [artist-separator] '(menu-item "--"))
532 (dolist (op '(("Vaporize" artist-select-op-vaporize-lines vaporize-lines)
533 ("Erase" artist-select-op-erase-rectangle erase-rect)
534 ("Spray-can" artist-select-op-spray-set-size spray-get-size)
535 ("Text" artist-select-op-text-overwrite text-ovwrt)
536 ("Ellipse" artist-select-op-circle circle)
537 ("Poly-line" artist-select-op-straight-poly-line spolyline)
538 ("Square" artist-select-op-square square)
539 ("Rectangle" artist-select-op-rectangle rectangle)
540 ("Line" artist-select-op-straight-line s-line)
541 ("Pen" artist-select-op-pen-line pen-line)))
542 (define-key map (vector (nth 2 op))
543 `(menu-item ,(nth 0 op)
544 ,(nth 1 op)
545 :help ,(format "Draw using the %s style" (nth 0 op))
546 :button (:radio . (eq artist-curr-go ',(nth 2 op))))))
547 map))
549 (defvar artist-mode-map
550 (let ((map (make-sparse-keymap)))
551 (setq artist-mode-map (make-sparse-keymap))
552 (define-key map [down-mouse-1] 'artist-down-mouse-1)
553 (define-key map [S-down-mouse-1] 'artist-down-mouse-1)
554 (define-key map [down-mouse-2] 'artist-mouse-choose-operation)
555 (define-key map [S-down-mouse-2] 'artist-mouse-choose-operation)
556 (define-key map [down-mouse-3] 'artist-down-mouse-3)
557 (define-key map [S-down-mouse-3] 'artist-down-mouse-3)
558 (define-key map [C-mouse-4] 'artist-select-prev-op-in-list)
559 (define-key map [C-mouse-5] 'artist-select-next-op-in-list)
561 (define-key map [up] 'artist-previous-line)
562 (define-key map "\C-p" 'artist-previous-line)
563 (define-key map [down] 'artist-next-line)
564 (define-key map "\C-n" 'artist-next-line)
565 (define-key map [left] 'artist-backward-char)
566 (define-key map "\C-b" 'artist-backward-char)
567 (define-key map [right] 'artist-forward-char)
568 (define-key map "\C-f" 'artist-forward-char)
569 (define-key map "<" 'artist-toggle-first-arrow)
570 (define-key map ">" 'artist-toggle-second-arrow)
571 (define-key map "\C-c\C-a\C-e" 'artist-select-erase-char)
572 (define-key map "\C-c\C-a\C-f" 'artist-select-fill-char)
573 (define-key map "\C-c\C-a\C-l" 'artist-select-line-char)
574 (define-key map "\C-c\C-a\C-o" 'artist-select-operation)
575 (define-key map "\C-c\C-a\C-r" 'artist-toggle-rubber-banding)
576 (define-key map "\C-c\C-a\C-t" 'artist-toggle-trim-line-endings)
577 (define-key map "\C-c\C-a\C-s" 'artist-toggle-borderless-shapes)
578 (define-key map "\C-c\C-c" 'artist-mode-off)
579 (define-key map "\C-c\C-al" 'artist-select-op-line)
580 (define-key map "\C-c\C-aL" 'artist-select-op-straight-line)
581 (define-key map "\C-c\C-ar" 'artist-select-op-rectangle)
582 (define-key map "\C-c\C-aR" 'artist-select-op-square)
583 (define-key map "\C-c\C-as" 'artist-select-op-square)
584 (define-key map "\C-c\C-ap" 'artist-select-op-poly-line)
585 (define-key map "\C-c\C-aP" 'artist-select-op-straight-poly-line)
586 (define-key map "\C-c\C-ae" 'artist-select-op-ellipse)
587 (define-key map "\C-c\C-ac" 'artist-select-op-circle)
588 (define-key map "\C-c\C-at" 'artist-select-op-text-see-thru)
589 (define-key map "\C-c\C-aT" 'artist-select-op-text-overwrite)
590 (define-key map "\C-c\C-aS" 'artist-select-op-spray-can)
591 (define-key map "\C-c\C-az" 'artist-select-op-spray-set-size)
592 (define-key map "\C-c\C-a\C-d" 'artist-select-op-erase-char)
593 (define-key map "\C-c\C-aE" 'artist-select-op-erase-rectangle)
594 (define-key map "\C-c\C-av" 'artist-select-op-vaporize-line)
595 (define-key map "\C-c\C-aV" 'artist-select-op-vaporize-lines)
596 (define-key map "\C-c\C-a\C-k" 'artist-select-op-cut-rectangle)
597 (define-key map "\C-c\C-a\M-w" 'artist-select-op-copy-rectangle)
598 (define-key map "\C-c\C-a\C-y" 'artist-select-op-paste)
599 (define-key map "\C-c\C-af" 'artist-select-op-flood-fill)
600 (define-key map "\C-c\C-a\C-b" 'artist-submit-bug-report)
601 (define-key map [menu-bar artist] (cons "Artist" artist-menu-map))
602 map)
603 "Keymap for `artist-minor-mode'.")
605 (defvar artist-replacement-table (make-vector 256 0)
606 "Replacement table for `artist-replace-char'.")
609 ;;;
610 ;;; The table of graphic operations
611 ;;;
612 (defvar artist-mt
613 ;; Implementation note: Maybe this should be done using a structure
614 ;; in the cl package?
615 ;;
616 '(
617 (menu
618 ("Drawing"
619 ((function-call
620 ( "Undo" do-undo undo))
622 (separator )
623 (graphics-operation
624 ("Pen" (("Pen" pen-char "pen-c"
625 artist-no-arrows nil
626 nil nil nil
627 artist-do-continously
628 artist-pen
629 (nil))
630 ("Pen Line" pen-line "pen-l"
631 artist-arrows artist-pen-set-arrow-points
632 artist-pen-reset-last-xy nil nil
633 artist-do-continously
634 artist-pen-line
635 (nil)))))
637 (graphics-operation
638 ("Line" (("line" line "line"
639 artist-arrows artist-set-arrow-points-for-2points
640 nil nil nil
641 2
642 artist-draw-line
643 (artist-undraw-line
644 artist-nil nil))
645 ("straight line" s-line "sline"
646 artist-arrows artist-set-arrow-points-for-2points
647 nil nil nil
648 2
649 artist-draw-sline
650 (artist-undraw-sline
651 artist-nil nil)))))
653 (graphics-operation
654 ("Rectangle" (("rectangle" rect "rect"
655 artist-no-arrows nil
656 nil nil nil
657 2
658 artist-draw-rect
659 (artist-undraw-rect
660 artist-t-if-fill-char-set artist-fill-rect))
661 ("square" square "square"
662 artist-no-arrows nil
663 nil nil nil
664 2
665 artist-draw-square
666 (artist-undraw-square
667 artist-t-if-fill-char-set artist-fill-square)))))
669 (graphics-operation
670 ("Poly-line" (("poly-line" polyline "poly"
671 artist-arrows artist-set-arrow-points-for-poly
672 nil nil nil
673 artist-do-poly
674 artist-draw-line
675 (artist-undraw-line
676 artist-nil nil))
677 ("straight poly-line" spolyline "s-poly"
678 artist-arrows artist-set-arrow-points-for-poly
679 nil nil nil
680 artist-do-poly
681 artist-draw-sline
682 (artist-undraw-sline
683 artist-nil nil)))))
685 (graphics-operation
686 ("Ellipse" (("ellipse" ellipse "ellipse"
687 artist-no-arrows nil
688 nil nil nil
689 2
690 artist-draw-ellipse
691 (artist-undraw-ellipse
692 artist-t-if-fill-char-set artist-fill-ellipse))
693 ("circle" circle "circle"
694 artist-no-arrows nil
695 nil nil nil
696 2
697 artist-draw-circle
698 (artist-undraw-circle
699 artist-t-if-fill-char-set artist-fill-circle)))))
701 (graphics-operation
702 ("Text" (("text see-thru" text-thru "text-thru"
703 artist-no-arrows nil
704 nil nil nil
705 1
706 artist-text-see-thru
707 nil)
708 ("text overwrite" text-ovwrt "text-ovwrt"
709 artist-no-arrows nil
710 nil nil nil
711 1
712 artist-text-overwrite
713 nil))))
715 (graphics-operation
716 ("Spray-can" (("spray-can" spray-can "spray-can"
717 artist-no-arrows nil
718 nil nil nil
719 artist-do-continously
720 artist-spray
721 (artist-spray-get-interval))
722 ("spray set size" spray-get-size "spray-size"
723 artist-no-arrows nil
724 nil artist-spray-clear-circle artist-spray-set-radius
725 2
726 artist-draw-circle
727 (artist-undraw-circle
728 artist-nil nil)))))
730 (graphics-operation
731 ("Erase" (("erase char" erase-char "erase-c"
732 artist-no-arrows nil
733 nil nil nil
734 artist-do-continously
735 artist-erase-char
736 (nil))
737 ("erase rectangle" erase-rect "erase-r"
738 artist-no-arrows nil
739 nil nil nil
740 2
741 artist-draw-rect
742 (artist-undraw-rect
743 artist-t artist-erase-rect)))))
745 (graphics-operation
746 ("Vaporize" (("vaporize line" vaporize-line "vaporize-1"
747 artist-no-arrows nil
748 nil nil nil
749 1
750 artist-vaporize-line
751 nil)
752 ("vaporize lines" vaporize-lines "vaporize-n"
753 artist-no-arrows nil
754 nil nil nil
755 1
756 artist-vaporize-lines
757 nil)))))))
759 (menu
760 ("Edit"
761 ((graphics-operation
762 ("Cut" (("cut rectangle" cut-r "cut-r"
763 artist-no-arrows nil
764 nil nil nil
765 2
766 artist-draw-rect
767 (artist-undraw-rect
768 artist-t artist-cut-rect))
769 ("cut square" cut-s "cut-s"
770 artist-no-arrows nil
771 nil nil nil
772 2
773 artist-draw-square
774 (artist-undraw-square
775 artist-t artist-cut-square)))))
777 (graphics-operation
778 ("Copy" (("copy rectangle" copy-r "copy-r"
779 artist-no-arrows nil
780 nil nil nil
781 2
782 artist-draw-rect
783 (artist-undraw-rect
784 artist-t artist-copy-rect))
785 ("copy square" copy-s "copy-s"
786 artist-no-arrows nil
787 nil nil nil
788 2
789 artist-draw-square
790 (artist-undraw-square
791 artist-t artist-copy-square)))))
793 (graphics-operation
794 ("Paste" (("paste" paste "paste"
795 artist-no-arrows nil
796 nil nil nil
797 1
798 artist-paste
799 nil)
800 ("paste" paste "paste"
801 artist-no-arrows nil
802 nil nil nil
803 1
804 artist-paste
805 nil))))
807 (graphics-operation
808 ("Flood-fill" (("flood-fill" flood-fill "flood"
809 artist-no-arrows nil
810 nil nil nil
811 1
812 artist-flood-fill
813 nil)
814 ("flood-fill" flood-fill "flood"
815 artist-no-arrows nil
816 nil nil nil
817 1
818 artist-flood-fill
819 nil)))))))
821 (menu
822 ("Settings"
823 ((function-call
824 ("Set Fill" set-fill artist-select-fill-char))
826 (function-call
827 ("Set Line" set-line artist-select-line-char))
829 (function-call
830 ("Set Erase" set-erase artist-select-erase-char))
832 (function-call
833 ("Rubber-banding" rubber-band artist-toggle-rubber-banding))
835 (function-call
836 ("Trimming" trimming artist-toggle-trim-line-endings))
838 (function-call
839 ("Borders" borders artist-toggle-borderless-shapes))
841 (function-call
842 ("Spray-chars" spray-chars artist-select-spray-chars)))))
844 ) ;; end of list
846 "Master Table for `artist-mode'.
847 This table is primarily a table over the different graphics operations
848 available in Artist mode, but it also holds layout information for the
849 popup menu.
851 The master table is a list of table elements. The elements of this table
852 have the layout
854 (TAG INFO-PART)
856 There are three kinds of TAG:
858 `menu' -- a sub-menu
859 `separator' -- produce a separator in the popup menu
860 `function-call' -- call a function
861 `graphics-operation' -- a graphics operation
863 The layout of the INFO-PART for `menu' is
865 (TITLE ((TAG-1 INFO-PART-1) (TAG-2 INFO-PART-2) ...))
867 TITLE is the title of the submenu; this is followed by a list of
868 menu items, each on the general form (TAG INFO-PART).
871 The layout of the INFO-PART for `separator' is empty and not used.
874 This is the layout of the INFO-PART for `function-call':
876 (KEYWORD SYMBOL FN)
878 KEYWORD is a string naming the operation, and appears in the popup menu.
879 SYMBOL is the symbol for the operations.
880 FN is the function performing the operation. This function
881 is called with no arguments. Its return value is ignored.
884 The layout of the INFO-PART for `graphics-operation' is
886 (TITLE (UNSHIFTED SHIFTED))
888 TITLE is the title that appears in the popup menu. UNSHIFTED
889 and SHIFTED specify for unshifted and shifted operation. Both
890 have the form
892 (KEYWORD KEY-SYMBOL MODE-LINE ARROW-PRED ARROW-SET-FN
893 INIT-FN PREP-FILL-FN EXIT-FN DRAW-HOW DRAW-FN EXTRA-DRAW-INFO)
895 KEYWORD is a string specifying the name of the shape to draw.
896 This is used when selecting drawing operation.
897 KEY-SYMBOL is the key which is used when looking up members
898 through the functions `artist-go-get-MEMBER-from-symbol'
899 and `artist-fc-get-MEMBER-from-symbol'.
900 MODE-LINE is a string that appears in the mode-line when drawing
901 the shape.
902 ARROW-PRED is a function that is called to find out if the shape
903 can have arrows. The function is called with no arguments and
904 must return nil or t.
905 ARROW-SET-FN is a function that is called to set arrow end-points.
906 Arguments and return values for this function are described below.
907 INIT-FN is, if non-nil, a function that is called when the first
908 point of the shape is set. Arguments and return values for
909 this function are described below.
910 PREP-FILL-FN is, if non-nil, a function that is called after
911 the last point is set, but before the filling is done.
912 Arguments and return values for this function are described below.
913 EXIT-FN is, if non-nil, a function that is called after filling
914 is done. Arguments and return values for this function are
915 described below.
916 DRAW-HOW defines the kind of shape. The kinds of shapes are:
917 `artist-do-continously' -- Do drawing operation continuously,
918 as long as the mouse button is held down.
919 `artist-do-poly' -- Do drawing operation many times.
920 1 -- Do drawing operation only once.
921 2 -- The drawing operation requires two points.
922 DRAW-FN is the function to call for drawing. Arguments and
923 return values for this function are described below.
924 EXTRA-DRAW-INFO the layout of this depends on the value of DRAW-HOW:
925 If DRAW-HOW is `artist-do-continously':
927 (INTERVAL-FN)
929 INTERVAL-FN is, if non-nil, a function to call for getting
930 an interval between repeated calls to the DRAW-FN.
931 This function is called with no arguments and must
932 return a number, the interval in seconds.
933 If nil, calls to DRAW-FN are done only when the mouse
934 or cursor is moved.
936 If DRAW-HOW is either `artist-do-poly' or 2:
938 (UNDRAW-FN FILL-PRED FILL-FN)
940 UNDRAW-FN is a function to call for undrawing the shape.
941 Arguments and return values for this function are
942 described below.
943 FILL-PRED is a function that is called to find out if the shape
944 can have arrows. The function must take no arguments and
945 return nil or t.
946 FILL-FN is a function to call for filling the shape.
947 Arguments and return values for this function are
948 described below.
950 If DRAW-HOW is 1:
952 ()
954 Note! All symbols and keywords (both in the `function-call' INFO-PART
955 as well as in the `graphics-operation' INFO-PART) must be unique.
957 The following table describe function arguments and return value
958 for different functions and DRAW-HOWs.
960 If DRAW-HOW is either `artist-do-continously' or 1:
962 INIT-FN X Y ==> ignored
963 PREP-FILL-FN X Y ==> ignored
964 EXIT-FN X Y ==> ignored
965 ARROW-SET-FN X Y ==> ignored
966 DRAW-FN X Y ==> ignored
968 If DRAW-HOW is 2:
970 INIT-FN X1 Y1 ==> ignored
971 PREP-FILL-FN X1 Y1 X2 Y2 ==> ignored
972 EXIT-FN X1 Y1 X2 Y2 ==> ignored
973 ARROW-SET-FN X1 Y1 X2 Y2 ==> ignored
974 DRAW-FN X1 Y1 X2 Y2 ==> (ENDPOINT-1 ENDPOINT-2 SHAPE)
975 UNDRAW-FN (ENDPOINT-1 ENDPOINT-2 SHAPE) ==> ignored
976 FILL-FN (ENDPOINT-1 ENDPOINT-2 SHAPE) X1 Y1 X2 Y2 ==> ignored
978 ENDPOINT-1 and ENDPOINT-2 are endpoints which are created with
979 `artist-make-endpoint'
980 SHAPE is an opaque structure, created by the DRAW-FN and intended
981 to be used only by the UNDRAW-FN.
983 If DRAW-HOW is `artist-do-poly':
985 INIT-FN X1 Y1
986 PREP-FILL-FN POINT-LIST
987 ARROW-SET-FN POINT-LIST
988 EXIT-FN POINT-LIST
989 DRAW-FN X-LAST Y-LAST X-NEW Y-NEW ==> (ENDPOINT-1 ENDPOINT-2 SHAPE)
990 UNDRAW-FN (ENDPOINT-1 ENDPOINT-2 SHAPE)
991 FILL-FN POINT-LIST
993 ENDPOINT-1 and ENDPOINT-2 are endpoints which are created with
994 `artist-make-endpoint'.
995 SHAPE is an opaque structure, created by the DRAW-FN and intended
996 to be used only by the UNDRAW-FN.
997 POINT-LIST is a list of vectors [X Y].")
1000 ;;
1001 ;; Accessors for the master table
1002 ;;
1004 (defun artist-mt-get-tag (element)
1005 "Retrieve the tag component from the master table ELEMENT."
1006 (elt element 0))
1008 (defun artist-mt-get-info-part (element)
1009 "Retrieve the info part component from the master table ELEMENT."
1010 (elt element 1))
1012 ;; For the 'graphics-operation info-parts
1013 ;;
1014 (defsubst artist-go-get-desc (info-part)
1015 "Retrieve the description component from a graphics operation INFO-PART."
1016 (elt info-part 0))
1018 (defsubst artist-go-get-unshifted (info-part)
1019 "Retrieve the unshifted info from a graphics operation INFO-PART."
1020 (elt (elt info-part 1) 0))
1022 (defsubst artist-go-get-shifted (info-part)
1023 "Retrieve the shifted info from a graphics operation INFO-PART."
1024 (elt (elt info-part 1) 1))
1026 (defsubst artist-go-get-keyword (info-variant-part)
1027 "Retrieve the keyword component from an INFO-VARIANT-PART.
1028 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1029 (elt info-variant-part 0))
1031 (defsubst artist-go-get-symbol (info-variant-part)
1032 "Retrieve the symbol component from an INFO-VARIANT-PART.
1033 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1034 (elt info-variant-part 1))
1036 (defsubst artist-go-get-mode-line (info-variant-part)
1037 "Retrieve the mode line component from an INFO-VARIANT-PART.
1038 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1039 (elt info-variant-part 2))
1041 (defsubst artist-go-get-arrow-pred (info-variant-part)
1042 "Retrieve the arrow predicate component from an INFO-VARIANT-PART.
1043 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1044 (elt info-variant-part 3))
1046 (defsubst artist-go-get-arrow-set-fn (info-variant-part)
1047 "Retrieve the arrow set component from an INFO-VARIANT-PART.
1048 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1049 (elt info-variant-part 4))
1051 (defsubst artist-go-get-init-fn (info-variant-part)
1052 "Retrieve the init function component from an INFO-VARIANT-PART.
1053 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1054 (elt info-variant-part 5))
1056 (defsubst artist-go-get-prep-fill-fn (info-variant-part)
1057 "Retrieve the fill preparation function component from an INFO-VARIANT-PART.
1058 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1059 (elt info-variant-part 6))
1061 (defsubst artist-go-get-exit-fn (info-variant-part)
1062 "Retrieve the exit component from an INFO-VARIANT-PART.
1063 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1064 (elt info-variant-part 7))
1066 (defsubst artist-go-get-draw-how (info-variant-part)
1067 "Retrieve the draw how component from an INFO-VARIANT-PART.
1068 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1069 (elt info-variant-part 8))
1071 (defsubst artist-go-get-draw-fn (info-variant-part)
1072 "Retrieve the draw function component from an INFO-VARIANT-PART.
1073 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1074 (elt info-variant-part 9))
1076 (defsubst artist-go-get-undraw-fn (info-variant-part)
1077 "Retrieve the undraw function component from an INFO-VARIANT-PART.
1078 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part.
1079 This interval function component is available only if the `draw-how'
1080 component is other than `artist-do-continously' or 1."
1081 (elt (elt info-variant-part 10) 0))
1083 (defsubst artist-go-get-interval-fn (info-variant-part)
1084 "Retrieve the interval function component from an INFO-VARIANT-PART.
1085 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part.
1086 This interval function component is available only if the `draw-how'
1087 component is `artist-do-continously'."
1088 (elt (elt info-variant-part 10) 0))
1090 (defsubst artist-go-get-fill-pred (info-variant-part)
1091 "Retrieve the fill predicate component from an INFO-VARIANT-PART.
1092 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part.
1093 This interval function component is available only if the `draw-how'
1094 component is other than `artist-do-continously' or 1."
1095 (elt (elt info-variant-part 10) 1))
1097 (defsubst artist-go-get-fill-fn (info-variant-part)
1098 "Retrieve the fill function component from an INFO-VARIANT-PART.
1099 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part.
1100 This interval function component is available only if the `draw-how'
1101 component is other than `artist-do-continously' or 1."
1102 (elt (elt info-variant-part 10) 2))
1104 ;; For the 'function-call info-parts
1105 ;;
1106 (defsubst artist-fc-get-keyword (info-part)
1107 "Retrieve the keyword component from a graphics operation INFO-PART."
1108 (elt info-part 0))
1110 (defsubst artist-fc-get-symbol (info-part)
1111 "Retrieve the symbol component from a graphics operation INFO-PART."
1112 (elt info-part 1))
1114 (defsubst artist-fc-get-fn (info-part)
1115 "Retrieve the function component from a graphics operation INFO-PART."
1116 (elt info-part 2))
1118 ;; For the 'menu info-parts
1119 ;;
1120 (defsubst artist-mn-get-title (info-part)
1121 "Retrieve the title component from a graphics operation INFO-PART."
1122 (elt info-part 0))
1124 (defsubst artist-mn-get-items (info-part)
1125 "Retrieve the items component from a graphics operation INFO-PART."
1126 (elt info-part 1))
1128 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1129 ;; mouse wheel cyclic operation selection
1131 (defun artist-get-last-non-nil-op (op-list &optional last-non-nil)
1132 "Find the last non-nil draw operation in OP-LIST.
1133 Optional LAST-NON-NIL will be returned if OP-LIST is nil."
1134 (if op-list
1135 (artist-get-last-non-nil-op (cdr op-list)
1136 (or (car (car op-list)) last-non-nil))
1137 last-non-nil))
1139 (defun artist-get-first-non-nil-op (op-list)
1140 "Find the first non-nil draw operation in OP-LIST."
1141 (or (car (car op-list)) (artist-get-first-non-nil-op (cdr op-list))))
1143 (defun artist-is-in-op-list-p (op op-list)
1144 "Check whether OP is in OP-LIST."
1145 (and op-list
1146 (or (and (car (car op-list)) (string= op (car (car op-list))))
1147 (artist-is-in-op-list-p op (cdr op-list)))))
1149 (defun artist-make-prev-next-op-alist (op-list
1150 &optional
1151 last-non-nil-arg first-non-nil-arg
1152 prev-entry prev-op-arg)
1153 "Build an assoc-list of OP-LIST.
1154 The arguments LAST-NON-NIL-ARG, FIRST-NON-NIL-ARG, PREV-ENTRY and
1155 PREV-OP-ARG are used when invoked recursively during the build-up."
1156 (let* ((last-non-nil (or last-non-nil-arg
1157 (artist-get-last-non-nil-op
1158 artist-key-compl-table)))
1159 (first-non-nil (or first-non-nil-arg
1160 (artist-get-first-non-nil-op
1161 artist-key-compl-table)))
1162 (prev-op (or prev-op-arg last-non-nil))
1163 (op (car (car op-list)))
1164 (opsym (artist-mt-get-symbol-from-keyword op))
1165 (entry (cons opsym (cons prev-op nil))))
1166 (if (or (and op-list (not op))
1167 (artist-is-in-op-list-p op (cdr op-list)))
1168 (artist-make-prev-next-op-alist (cdr op-list)
1169 last-non-nil first-non-nil
1170 prev-entry prev-op)
1171 (if prev-entry (setcdr (cdr prev-entry) op))
1172 (if op-list
1173 (cons entry (artist-make-prev-next-op-alist
1174 (cdr op-list)
1175 last-non-nil first-non-nil
1176 entry op))
1177 (progn (setcdr (cdr prev-entry) first-non-nil) nil)))))
1179 (defun artist-select-next-op-in-list ()
1180 "Cyclically select next drawing mode operation."
1181 (interactive)
1182 (let ((next-op (cdr (cdr (assoc artist-curr-go artist-prev-next-op-alist)))))
1183 (artist-select-operation next-op)
1184 (message "%s" next-op)))
1186 (defun artist-select-prev-op-in-list ()
1187 "Cyclically select previous drawing mode operation."
1188 (interactive)
1189 (let ((prev-op (car (cdr (assoc artist-curr-go artist-prev-next-op-alist)))))
1190 (artist-select-operation prev-op)
1191 (message "%s" prev-op)))
1193 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1195 ;;; ---------------------------------
1196 ;;; The artist-mode
1197 ;;; ---------------------------------
1199 ;;;###autoload
1200 (define-minor-mode artist-mode
1201 "Toggle Artist mode.
1202 With argument ARG, turn Artist mode on if ARG is positive.
1203 Artist lets you draw lines, squares, rectangles and poly-lines,
1204 ellipses and circles with your mouse and/or keyboard.
1206 How to quit Artist mode
1211 How to submit a bug report
1216 Drawing with the mouse:
1218 mouse-2
1219 shift mouse-2 Pops up a menu where you can select what to draw with
1220 mouse-1, and where you can do some settings (described
1221 below).
1223 mouse-1
1224 shift mouse-1 Draws lines, rectangles or poly-lines, erases, cuts, copies
1225 or pastes:
1227 Operation Not shifted Shifted
1228 --------------------------------------------------------------
1229 Pen fill-char at point line from last point
1230 to new point
1231 --------------------------------------------------------------
1232 Line Line in any direction Straight line
1233 --------------------------------------------------------------
1234 Rectangle Rectangle Square
1235 --------------------------------------------------------------
1236 Poly-line Poly-line in any dir Straight poly-lines
1237 --------------------------------------------------------------
1238 Ellipses Ellipses Circles
1239 --------------------------------------------------------------
1240 Text Text (see thru) Text (overwrite)
1241 --------------------------------------------------------------
1242 Spray-can Spray-can Set size for spray
1243 --------------------------------------------------------------
1244 Erase Erase character Erase rectangle
1245 --------------------------------------------------------------
1246 Vaporize Erase single line Erase connected
1247 lines
1248 --------------------------------------------------------------
1249 Cut Cut rectangle Cut square
1250 --------------------------------------------------------------
1251 Copy Copy rectangle Copy square
1252 --------------------------------------------------------------
1253 Paste Paste Paste
1254 --------------------------------------------------------------
1255 Flood-fill Flood-fill Flood-fill
1256 --------------------------------------------------------------
1258 * Straight lines can only go horizontally, vertically
1259 or diagonally.
1261 * Poly-lines are drawn while holding mouse-1 down. When you
1262 release the button, the point is set. If you want a segment
1263 to be straight, hold down shift before pressing the
1264 mouse-1 button. Click mouse-2 or mouse-3 to stop drawing
1265 poly-lines.
1267 * See thru for text means that text already in the buffer
1268 will be visible through blanks in the text rendered, while
1269 overwrite means the opposite.
1271 * Vaporizing connected lines only vaporizes lines whose
1272 _endpoints_ are connected. See also the variable
1273 `artist-vaporize-fuzziness'.
1275 * Cut copies, then clears the rectangle/square.
1277 * When drawing lines or poly-lines, you can set arrows.
1280 * The mode line shows the currently selected drawing operation.
1281 In addition, if it has an asterisk (*) at the end, you
1282 are currently drawing something.
1284 * Be patient when flood-filling -- large areas take quite
1285 some time to fill.
1288 mouse-3 Erases character under pointer
1289 shift mouse-3 Erases rectangle
1292 Settings
1294 Set fill Sets the character used when filling rectangles/squares
1296 Set line Sets the character used when drawing lines
1298 Erase char Sets the character used when erasing
1300 Rubber-banding Toggles rubber-banding
1302 Trimming Toggles trimming of line-endings (that is: when the shape
1303 is drawn, extraneous white-space at end of lines is removed)
1305 Borders Toggles the drawing of line borders around filled shapes
1308 Drawing with keys
1311 For lines/rectangles/squares: sets the first/second endpoint
1313 When erase characters: toggles erasing
1314 When cutting/copying: Sets first/last endpoint of rect/square
1315 When pasting: Pastes
1319 Move around with \\[artist-next-line], \\[artist-previous-line], \\[artist-forward-char] and \\[artist-backward-char].
1329 Arrows
1332 of the line/poly-line
1335 of the line/poly-line
1338 Selecting operation
1340 There are some keys for quickly selecting drawing operations:
1364 Variables
1366 This is a brief overview of the different variables. For more info,
1369 artist-rubber-banding Interactively do rubber-banding or not
1370 artist-first-char What to set at first/second point...
1371 artist-second-char ...when not rubber-banding
1372 artist-interface-with-rect If cut/copy/paste should interface with rect
1373 artist-arrows The arrows to use when drawing arrows
1374 artist-aspect-ratio Character height-to-width for squares
1375 artist-trim-line-endings Trimming of line endings
1376 artist-flood-fill-right-border Right border when flood-filling
1377 artist-flood-fill-show-incrementally Update display while filling
1378 artist-pointer-shape Pointer shape to use while drawing
1379 artist-ellipse-left-char Character to use for narrow ellipses
1380 artist-ellipse-right-char Character to use for narrow ellipses
1381 artist-borderless-shapes If shapes should have borders
1382 artist-picture-compatibility Whether or not to be picture mode compatible
1383 artist-vaporize-fuzziness Tolerance when recognizing lines
1384 artist-spray-interval Seconds between repeated sprayings
1385 artist-spray-radius Size of the spray-area
1389 Hooks
1391 Turning the mode on or off runs `artist-mode-hook'.
1394 Keymap summary
1397 :init-value nil :group 'artist :lighter artist-mode-name
1398 :keymap artist-mode-map
1399 (cond ((null artist-mode)
1400 ;; Turn mode off
1401 (artist-mode-exit))
1402 (t
1403 ;; Turn mode on
1404 (artist-mode-init))))
1406 ;; Init and exit
1407 (defun artist-mode-init ()
1408 "Init Artist mode. This will call the hook `artist-mode-hook'."
1409 ;; Set up a conversion table for mapping tabs and new-lines to spaces.
1410 ;; the last case, 0, is for the last position in buffer/region, where
1411 ;; the `following-char' function returns 0.
1412 (let ((i 0))
1413 (while (< i 256)
1414 (aset artist-replacement-table i i)
1415 (setq i (1+ i))))
1418 (aset artist-replacement-table 0 ?\s)
1419 ;; More setup
1420 (make-local-variable 'artist-key-is-drawing)
1421 (make-local-variable 'artist-key-endpoint1)
1422 (make-local-variable 'artist-key-poly-point-list)
1423 (make-local-variable 'artist-key-shape)
1424 (make-local-variable 'artist-key-draw-how)
1425 (make-local-variable 'artist-popup-menu-table)
1426 (make-local-variable 'artist-key-compl-table)
1427 (make-local-variable 'artist-prev-next-op-alist)
1428 (make-local-variable 'artist-rb-save-data)
1429 (make-local-variable 'artist-arrow-point-1)
1430 (make-local-variable 'artist-arrow-point-2)
1431 (setq artist-key-is-drawing nil)
1432 (setq artist-key-endpoint1 nil)
1433 (setq artist-key-poly-point-list nil)
1434 (setq artist-key-shape nil)
1435 (setq artist-popup-menu-table (artist-compute-popup-menu-table artist-mt))
1436 (setq artist-key-compl-table (artist-compute-key-compl-table artist-mt))
1437 (setq artist-prev-next-op-alist
1438 (artist-make-prev-next-op-alist artist-key-compl-table))
1439 (setq artist-rb-save-data (make-vector 7 0))
1440 (setq artist-arrow-point-1 nil)
1441 (setq artist-arrow-point-2 nil)
1442 (make-local-variable 'next-line-add-newlines)
1443 (setq next-line-add-newlines t)
1444 (setq artist-key-draw-how
1445 (artist-go-get-draw-how-from-symbol artist-curr-go))
1446 (if (and artist-picture-compatibility (not (eq major-mode 'picture-mode)))
1447 (progn
1448 (picture-mode)
1449 (message "")))
1450 (artist-mode-line-show-curr-operation artist-key-is-drawing))
1452 (declare-function picture-mode-exit "picture" (&optional nostrip))
1454 (defun artist-mode-exit ()
1455 "Exit Artist mode. This will call the hook `artist-mode-hook'."
1456 (if (and artist-picture-compatibility (eq major-mode 'picture-mode))
1457 (picture-mode-exit))
1458 (kill-local-variable 'next-line-add-newlines))
1460 (defun artist-mode-off ()
1461 "Turn Artist mode off."
1462 (interactive)
1463 (artist-mode -1)
1464 (force-mode-line-update))
1466 ;;
1467 ;; General routines
1468 ;;
1470 (defun artist-update-display ()
1471 "Repaint the display."
1472 (sit-for 0))
1474 (defun artist-mode-line-show-curr-operation (is-drawing)
1475 "Show current operation in mode-line. If IS-DRAWING, show that."
1476 (let ((mtext (concat artist-mode-name "/"
1477 (artist-go-get-mode-line-from-symbol artist-curr-go)
1478 (if is-drawing "/*" ""))))
1479 (setcdr (assq 'artist-mode minor-mode-alist) (list mtext)))
1480 (force-mode-line-update))
1483 (defun artist-t-if-fill-char-set ()
1484 "Return the value of the variable `artist-fill-char-set'."
1485 artist-fill-char-set)
1487 (defun artist-t ()
1488 "Always return t."
1489 t)
1491 (defun artist-nil ()
1492 "Always return nil."
1493 nil)
1495 (defun artist-arrows ()
1496 "Say yes to arrows!"
1497 t)
1499 (defun artist-no-arrows ()
1500 "Say no to arrows!"
1501 nil)
1503 ;;
1504 ;; Auxiliary init-routines
1505 ;;
1507 ;
1508 ; Computing the table for the x-popup-menu from the master table
1509 ;
1511 (defun artist-compute-popup-menu-table (menu-table)
1512 "Create a menu from MENU-TABLE data.
1513 The returned value is suitable for the `x-popup-menu' function."
1514 (cons "Artist menu"
1515 (artist-compute-popup-menu-table-sub menu-table)))
1517 (defun artist-compute-popup-menu-table-sub (menu-table)
1518 "Compute operation table suitable for `x-popup-menu' from MENU-TABLE."
1519 (mapcar
1520 (lambda (element)
1521 (let ((element-tag (artist-mt-get-tag element)))
1522 (cond ((eq element-tag 'graphics-operation)
1523 (let* ((info-part (artist-mt-get-info-part element))
1524 (descr (artist-go-get-desc info-part))
1525 (unshifted (artist-go-get-unshifted info-part))
1526 (symbol (artist-go-get-symbol unshifted)))
1527 (list descr symbol)))
1529 ((eq element-tag 'function-call)
1530 (let* ((info-part (artist-mt-get-info-part element))
1531 (keyword (artist-fc-get-keyword info-part))
1532 (symbol (artist-fc-get-symbol info-part)))
1533 (list keyword symbol)))
1535 ((eq element-tag 'separator)
1536 '("" ""))
1538 ((eq element-tag 'menu)
1539 (let* ((info-part (artist-mt-get-info-part element))
1540 (title (artist-mn-get-title info-part))
1541 (items (artist-mn-get-items info-part)))
1542 (cons title (artist-compute-popup-menu-table-sub items))))
1544 (t
1546 element-tag)))))
1547 menu-table))
1549 ;
1550 ; Computing the completion table from the master table
1551 ;
1553 (defun artist-compute-key-compl-table (menu-table)
1554 "Compute completion table from MENU-TABLE, suitable for `completing-read'."
1555 (apply
1556 'nconc
1557 (remq nil
1558 (mapcar
1559 (lambda (element)
1560 (let ((element-tag (artist-mt-get-tag element)))
1561 (cond ((eq element-tag 'graphics-operation)
1562 (let* ((info-part (artist-mt-get-info-part element))
1563 (unshifted (artist-go-get-unshifted info-part))
1564 (shifted (artist-go-get-shifted info-part))
1565 (unshifted-kwd (artist-go-get-keyword unshifted))
1566 (shifted-kwd (artist-go-get-keyword shifted)))
1567 (list (list unshifted-kwd) (list shifted-kwd))))
1568 ((eq element-tag 'menu)
1569 (let* ((info-part (artist-mt-get-info-part element))
1570 (items (artist-mn-get-items info-part)))
1571 (artist-compute-key-compl-table items)))
1572 (t
1573 nil))))
1574 menu-table))))
1577 ;
1578 ; Retrieving a symbol (graphics operation or function-call) from a keyword
1579 ;
1581 (defun artist-mt-get-symbol-from-keyword (kwd)
1582 "Search master table for keyword KWD and return its symbol."
1583 (artist-mt-get-symbol-from-keyword-sub artist-mt kwd))
1585 (defun artist-mt-get-symbol-from-keyword-sub (table kwd)
1586 "Search TABLE for keyword KWD and return its symbol."
1587 (catch 'found
1588 (mapc
1589 (lambda (element)
1590 (let ((element-tag (artist-mt-get-tag element)))
1591 (cond ((eq element-tag 'graphics-operation)
1592 (let* ((info-part (artist-mt-get-info-part element))
1593 (unshifted (artist-go-get-unshifted info-part))
1594 (shifted (artist-go-get-shifted info-part))
1595 (unshifted-kwd (artist-go-get-keyword unshifted))
1596 (shifted-kwd (artist-go-get-keyword shifted))
1597 (unshifted-sym (artist-go-get-symbol unshifted))
1598 (shifted-sym (artist-go-get-symbol shifted)))
1599 (if (string-equal kwd unshifted-kwd)
1600 (throw 'found unshifted-sym))
1601 (if (string-equal kwd shifted-kwd)
1602 (throw 'found shifted-sym))))
1604 ((eq element-tag 'function-call)
1605 (let* ((info-part (artist-mt-get-info-part element))
1606 (keyword (artist-fc-get-keyword info-part))
1607 (symbol (artist-fc-get-symbol info-part)))
1608 (if (string-equal kwd keyword)
1609 (throw 'found symbol))))
1610 ((eq element-tag 'menu)
1611 (let* ((info-part (artist-mt-get-info-part element))
1612 (items (artist-mn-get-items info-part))
1613 (answer (artist-mt-get-symbol-from-keyword-sub
1614 items kwd)))
1615 (if answer (throw 'found answer))))
1616 (t
1617 nil))))
1618 table)
1619 nil))
1622 ;
1623 ; Retrieving info from a graphics operation symbol
1624 ;
1626 (defun artist-go-retrieve-from-symbol (symbol retrieve-fn)
1627 "Search the master table for a graphics operation SYMBOL.
1628 Calls RETRIEVE-FN to retrieve information from that symbol's
1629 info-variant-part."
1630 (artist-go-retrieve-from-symbol-sub artist-mt symbol retrieve-fn))
1632 (defun artist-go-retrieve-from-symbol-sub (table symbol retrieve-fn)
1633 "Search the TABLE for a graphics operation SYMBOL.
1634 Calls RETRIEVE-FN to retrieve information from that symbol's
1635 info-variant-part."
1636 (catch 'found
1637 (mapc
1638 (lambda (element)
1639 (let ((element-tag (artist-mt-get-tag element)))
1640 (cond ((eq element-tag 'graphics-operation)
1641 (let* ((info-part (artist-mt-get-info-part element))
1642 (unshifted (artist-go-get-unshifted info-part))
1643 (shifted (artist-go-get-shifted info-part))
1644 (unshifted-sym (artist-go-get-symbol unshifted))
1645 (shifted-sym (artist-go-get-symbol shifted))
1646 (variant-part (cond
1647 ((eq unshifted-sym symbol) unshifted)
1648 ((eq shifted-sym symbol) shifted)
1649 (t nil))))
1650 (if variant-part ; if found do:
1651 (throw 'found (funcall retrieve-fn variant-part)))))
1653 ((eq element-tag 'menu)
1654 (let* ((info-part (artist-mt-get-info-part element))
1655 (items (artist-mn-get-items info-part))
1656 (answer (artist-go-retrieve-from-symbol-sub
1657 items symbol retrieve-fn)))
1658 (if answer (throw 'found answer)))))))
1660 table)
1661 nil))
1663 (defun artist-go-get-keyword-from-symbol (symbol)
1664 "Search the master table, get keyword from a graphics operation SYMBOL."
1665 (artist-go-retrieve-from-symbol symbol 'artist-go-get-keyword))
1667 (defun artist-go-get-mode-line-from-symbol (symbol)
1668 "Search the master table, get mode-line from a graphics operation SYMBOL."
1669 (artist-go-retrieve-from-symbol symbol 'artist-go-get-mode-line))
1671 (defun artist-go-get-arrow-pred-from-symbol (symbol)
1672 "Search the master table, get arrow-pred from a graphics operation SYMBOL."
1673 (artist-go-retrieve-from-symbol symbol 'artist-go-get-arrow-pred))
1675 (defun artist-go-get-arrow-set-fn-from-symbol (symbol)
1676 "Search the master table, get arrow-set-fn from a graphics operation SYMBOL."
1677 (artist-go-retrieve-from-symbol symbol 'artist-go-get-arrow-set-fn))
1679 (defun artist-go-get-init-fn-from-symbol (symbol)
1680 "Search the master table, get init-fn from a graphics operation SYMBOL."
1681 (artist-go-retrieve-from-symbol symbol 'artist-go-get-init-fn))
1683 (defun artist-go-get-prep-fill-fn-from-symbol (symbol)
1684 "Search the master table, get prep-fill-fn from a graphics operation SYMBOL."
1685 (artist-go-retrieve-from-symbol symbol 'artist-go-get-prep-fill-fn))
1687 (defun artist-go-get-exit-fn-from-symbol (symbol)
1688 "Search the master table, get exit-fn from a graphics operation SYMBOL."
1689 (artist-go-retrieve-from-symbol symbol 'artist-go-get-exit-fn))
1691 (defun artist-go-get-draw-fn-from-symbol (symbol)
1692 "Search the master table, get draw-fn from a graphics operation SYMBOL."
1693 (artist-go-retrieve-from-symbol symbol 'artist-go-get-draw-fn))
1695 (defun artist-go-get-draw-how-from-symbol (symbol)
1696 "Search the master table, get draw-how from a graphics operation SYMBOL."
1697 (artist-go-retrieve-from-symbol symbol 'artist-go-get-draw-how))
1699 (defun artist-go-get-undraw-fn-from-symbol (symbol)
1700 "Search the master table, get undraw-fn from a graphics operation SYMBOL."
1701 (artist-go-retrieve-from-symbol symbol 'artist-go-get-undraw-fn))
1703 (defun artist-go-get-interval-fn-from-symbol (symbol)
1704 "Search the master table, get interval-fn from a graphics operation SYMBOL."
1705 (artist-go-retrieve-from-symbol symbol 'artist-go-get-interval-fn))
1707 (defun artist-go-get-fill-pred-from-symbol (symbol)
1708 "Search the master table, get fill-pred from a graphics operation SYMBOL."
1709 (artist-go-retrieve-from-symbol symbol 'artist-go-get-fill-pred))
1711 (defun artist-go-get-fill-fn-from-symbol (symbol)
1712 "Search the master table, get fill-fn from a graphics operation SYMBOL."
1713 (artist-go-retrieve-from-symbol symbol 'artist-go-get-fill-fn))
1715 (defun artist-go-get-symbol-shift (symbol is-shifted)
1716 "Search for (shifted or unshifted) graphics operation SYMBOL.
1717 If IS-SHIFTED is non-nil, return the shifted symbol,
1718 otherwise the unshifted symbol."
1719 (artist-go-get-symbol-shift-sub artist-mt symbol is-shifted))
1721 (defun artist-go-get-symbol-shift-sub (table symbol is-shifted)
1722 "Search TABLE for (shifted or unshifted) graphics SYMBOL.
1723 If IS-SHIFTED is non-nil, return the shifted symbol,
1724 otherwise the unshifted symbol."
1725 (catch 'found
1726 (mapc
1727 (lambda (element)
1728 (let ((element-tag (artist-mt-get-tag element)))
1729 (cond ((eq element-tag 'graphics-operation)
1730 (let* ((info-part (artist-mt-get-info-part element))
1731 (unshift-variant (artist-go-get-unshifted info-part))
1732 (shift-variant (artist-go-get-shifted info-part))
1733 (unshift-sym (artist-go-get-symbol unshift-variant))
1734 (shift-sym (artist-go-get-symbol shift-variant)))
1735 (if (or (eq symbol unshift-sym) (eq symbol shift-sym))
1736 (throw 'found (if is-shifted shift-sym unshift-sym)))))
1738 ((eq element-tag 'menu)
1739 (let* ((info-part (artist-mt-get-info-part element))
1740 (items (artist-mn-get-items info-part))
1741 (answer (artist-go-get-symbol-shift-sub
1742 items symbol is-shifted)))
1743 (if answer (throw 'found answer)))))))
1745 table)
1746 nil))
1748 ;
1749 ; Retrieving info from a function-call symbol
1750 ;
1752 (defun artist-fc-retrieve-from-symbol (symbol retrieve-fn)
1753 "Search the master table for a function call SYMBOL.
1754 Calls RETRIEVE-FN to retrieve information from that symbol's
1755 info-variant-part."
1756 (artist-fc-retrieve-from-symbol-sub artist-mt symbol retrieve-fn))
1758 (defun artist-fc-retrieve-from-symbol-sub (table symbol retrieve-fn)
1759 "Search TABLE for a function-call SYMBOL.
1760 Calls RETRIEVE-FN to retrieve information from that symbol's
1761 info-variant-part."
1762 (catch 'found
1763 (mapc
1764 (lambda (element)
1765 (let ((element-tag (artist-mt-get-tag element)))
1766 (cond ((eq element-tag 'function-call)
1767 (let* ((info-part (artist-mt-get-info-part element))
1768 (fc-symbol (artist-fc-get-symbol info-part)))
1769 (if (eq fc-symbol symbol)
1770 (throw 'found (funcall retrieve-fn info-part)))))
1772 ((eq element-tag 'menu)
1773 (let* ((info-part (artist-mt-get-info-part element))
1774 (items (artist-mn-get-items info-part))
1775 (answer (artist-fc-retrieve-from-symbol-sub
1776 items symbol retrieve-fn)))
1777 (if answer (throw 'found answer)))))))
1779 table)
1780 nil))
1782 (defun artist-fc-get-fn-from-symbol (symbol)
1783 "Search the master table to get function from a function call SYMBOL."
1784 (artist-fc-retrieve-from-symbol symbol 'artist-fc-get-fn))
1787 ;;
1788 ;; Utilities
1789 ;;
1791 ;; Macro that won't funcall the function if it is nil.
1792 ;;
1793 (defmacro artist-funcall (fn &rest args)
1794 "Call function FN with ARGS, if FN is not nil."
1795 `(if ,fn (funcall ,fn ,@args)))
1797 (defun artist-uniq (l)
1798 "Remove consecutive duplicates in list L. Comparison is done with `equal'."
1799 (cond ((null l) nil)
1800 ((null (cdr l)) l) ; only one element in list
1801 ((equal (car l) (car (cdr l))) (artist-uniq (cdr l))) ; first 2 equal
1802 (t (cons (car l) (artist-uniq (cdr l)))))) ; first 2 are different
1804 (defun artist-string-split (str r)
1805 "Split string STR at occurrences of regexp R, returning a list of strings."
1806 (let ((res nil)
1807 (start 0)
1808 (match-pos 0))
1809 (while (setq match-pos (string-match r str start))
1810 (setq res (cons (copy-sequence (substring str start match-pos)) res))
1811 (setq start (match-end 0)))
1812 (if (null res)
1813 (list str)
1814 (if (< (match-end 0) (- (length str) 1))
1815 (setq res (cons (substring str (match-end 0) (length str)) res)))
1816 (reverse res))))
1818 (defun artist-string-to-file (str file-name)
1819 "Write string STR to file FILE-NAME."
1820 (write-region str 'end-is-ignored file-name nil 'no-message))
1822 (defun artist-file-to-string (file-name)
1823 "Read from file FILE-NAME into a string."
1824 (save-excursion
1825 (let ((tmp-buffer (get-buffer-create (concat "*artist-" file-name "*"))))
1826 (set-buffer tmp-buffer)
1827 (goto-char (point-min))
1828 (insert-file-contents file-name nil nil nil t)
1829 (let ((str (copy-sequence (buffer-substring (point-min)
1830 (point-max)))))
1831 (kill-buffer tmp-buffer)
1832 str))))
1834 (defun artist-clear-buffer (buf)
1835 "Clear contents of buffer BUF."
1836 (with-current-buffer buf
1837 (goto-char (point-min))
1838 (delete-char (- (point-max) (point-min)) nil)))
1841 (defun artist-system (program stdin &optional program-args)
1842 "Run PROGRAM synchronously with the contents of string STDIN to stdin.
1843 Optional args PROGRAM-ARGS are arguments to PROGRAM.
1844 Return a list (RETURN-CODE STDOUT STDERR)."
1845 (save-excursion
1846 (let* ((tmp-stdin-file-name (if stdin
1847 (make-temp-file "artist-stdin.")
1848 nil))
1849 (tmp-stdout-buffer (get-buffer-create
1850 (concat "*artist-" program "*")))
1851 (tmp-stderr-file-name (make-temp-file "artist-stdout."))
1852 (binary-process-input nil) ; for msdos
1853 (binary-process-output nil))
1855 ;; Prepare stdin
1856 (if stdin (artist-string-to-file stdin tmp-stdin-file-name))
1858 ;; Clear the buffer
1859 (artist-clear-buffer tmp-stdout-buffer)
1861 ;; Start the program
1862 (unwind-protect
1863 (let ((res (if program-args
1864 (apply 'call-process
1865 program
1866 tmp-stdin-file-name
1867 (list tmp-stdout-buffer
1868 tmp-stderr-file-name)
1869 nil
1870 (if (stringp program-args)
1871 (list program-args)
1872 program-args))
1873 (apply 'call-process
1874 program
1875 tmp-stdin-file-name
1876 (list tmp-stdout-buffer
1877 tmp-stderr-file-name)
1878 nil))))
1880 ;; the return value
1881 (list res
1882 (with-current-buffer tmp-stdout-buffer
1883 (buffer-substring (point-min) (point-max)))
1884 (artist-file-to-string tmp-stderr-file-name)))
1886 ;; Unwind: remove temporary files and buffers
1887 (if (and stdin (file-exists-p tmp-stdin-file-name))
1888 (delete-file tmp-stdin-file-name))
1889 (if (file-exists-p tmp-stderr-file-name)
1890 (delete-file tmp-stderr-file-name))
1891 (if (memq tmp-stdout-buffer (buffer-list))
1892 (kill-buffer tmp-stdout-buffer))))))
1894 ;; Routines that deal with the buffer
1895 ;;
1896 ;; artist-current-line get line number (top of buffer is 0)
1897 ;;
1898 ;; artist-move-to-xy move to (x,y) (0,0) is beg-of-buffer
1899 ;;
1900 ;; artist-get-char-at-xy get char in at (x,y)
1901 ;;
1902 ;; artist-replace-char overwrite (replace) char at point
1903 ;; artist-replace-chars overwrite (replace) chars at point
1904 ;;
1906 (defsubst artist-current-column ()
1907 "Return point's current column."
1908 (current-column))
1910 (defsubst artist-current-line ()
1911 "Return point's current line, buffer-relative. Top of buffer is 0."
1912 (+ (count-lines 1 (point))
1913 (if (= (current-column) 0) 1 0)
1914 -1))
1916 (defsubst artist-move-to-xy (x y)
1917 "Move to column X, at row Y from the top of buffer. Top line is 0."
1918 ;;
1919 ;; Q: Why do we do forward-line twice?
1920 ;; A: The documentation for forward-line says
1921 ;;
1922 ;; "... Returns the count of lines left to move. ... With
1923 ;; positive N, a non-empty line at the end counts as one
1924 ;; line successfully moved (for the return value)."
1925 ;;
1926 ;; This means that if we are trying to move forward past the end
1927 ;; of the buffer, and that last line happened to be longer than
1928 ;; the current column, then we end up at the end of that last
1929 ;; line, and forward-line returns one less than we actually
1930 ;; wanted to move.
1931 ;;
1932 ;; Example: In the figure below, the `X' is the very last
1933 ;; character in the buffer ("a non-empty line at the
1934 ;; end"). Suppose point is at P. Then (forward-line 1)
1935 ;; returns 0 and puts point after the `X'.
1936 ;;
1937 ;; --------top of buffer--------
1938 ;;
1939 ;; P X
1940 ;; -------bottom of buffer------
1941 ;;
1942 ;; But, if we are at the end of buffer when trying to move
1943 ;; forward, then forward-line will return the (for us) correct
1944 ;; value, which is good, because we will come to the end of the
1945 ;; buffer by the first forward-line. The second forward-line
1946 ;; will then get us where we really wanted to go.
1947 ;;
1948 ;; If we are not moving past the end of the buffer, then the
1949 ;; second forward-line will return 0.
1950 ;;
1951 ;; Q: What happens if we are moving upwards?
1952 ;; A: That will work good. insert-char won't insert a negative
1953 ;; number of chars, and forward-line will fail silently if we are
1954 ;; moving past the beginning of the buffer.
1955 ;;
1956 (forward-line (- y (artist-current-line)))
1958 (move-to-column (max x 0) t)
1959 (let ((curr-y (artist-current-line)))
1960 (setq artist-draw-region-min-y (min curr-y artist-draw-region-min-y))
1961 (setq artist-draw-region-max-y (max curr-y artist-draw-region-max-y))))
1963 (defsubst artist-get-char-at-xy (x y)
1964 "Return the character found at column X, row Y.
1965 Also updates the variables `artist-draw-min-y' and `artist-draw-max-y'."
1966 (artist-move-to-xy x y)
1967 (let ((curr-y (artist-current-line)))
1968 (setq artist-draw-region-min-y (min curr-y artist-draw-region-min-y))
1969 (setq artist-draw-region-max-y (max curr-y artist-draw-region-max-y)))
1970 (following-char))
1973 (defsubst artist-get-replacement-char (c)
1974 "Retrieve a replacement for character C from `artist-replacement-table'.
1975 The replacement is used to convert tabs and new-lines to spaces."
1976 ;; Characters may be outside the range of the `artist-replacement-table',
1977 ;; for example if they are Unicode code points >= 256.
1978 ;; Check so we don't attempt to access the array out of its bounds,
1979 ;; assuming no such character needs to be replaced.
1980 (if (< c (length artist-replacement-table))
1981 (aref artist-replacement-table c)
1982 c))
1984 (defun artist-get-char-at-xy-conv (x y)
1985 "Retrieve the character at X, Y, converting tabs and new-lines to spaces."
1986 (save-excursion
1987 (artist-get-replacement-char (artist-get-char-at-xy x y))))
1990 (defun artist-replace-char (new-char)
1991 "Replace the character at point with NEW-CHAR."
1992 (let ((overwrite-mode 'overwrite-mode-textual)
1993 (fill-column 32765) ; Large :-)
1994 (blink-matching-paren nil))
1995 (setq last-command-event (artist-get-replacement-char new-char))
1996 (self-insert-command 1)))
1998 (defun artist-replace-chars (new-char count)
1999 "Replace characters at point with NEW-CHAR. COUNT chars are replaced."
2000 ;; Check that the variable exists first. The doc says it was added in 19.23.
2001 (if (and (and (boundp 'emacs-major-version) (= emacs-major-version 20))
2002 (and (boundp 'emacs-minor-version) (<= emacs-minor-version 3)))
2003 ;; This is a bug workaround for Emacs 20, versions up to 20.3:
2004 ;; The self-insert-command doesn't care about the overwrite-mode,
2005 ;; so the insertion is done in the same way as in picture mode.
2006 ;; This seems to be a little bit slower.
2007 (let* ((replaced-c (artist-get-replacement-char new-char))
2008 (replaced-s (make-string count replaced-c)))
2009 (artist-move-to-xy (+ (artist-current-column) count)
2010 (artist-current-line))
2011 (delete-char (- count))
2012 (insert replaced-s))
2013 ;; In emacs-19, the self-insert-command works better
2014 (let ((overwrite-mode 'overwrite-mode-textual)
2015 (fill-column 32765) ; Large :-)
2016 (blink-matching-paren nil))
2017 (setq last-command-event (artist-get-replacement-char new-char))
2018 (self-insert-command count))))
2020 (defsubst artist-replace-string (string &optional see-thru)
2021 "Replace contents at point with STRING.
2022 With optional argument SEE-THRU set to non-nil, text in the buffer
2024 (let ((char-list (append string nil)) ; convert the string to a list
2025 (overwrite-mode 'overwrite-mode-textual)
2026 (fill-column 32765) ; Large :-)
2027 (blink-matching-paren nil))
2028 (while char-list
2029 (let ((c (car char-list)))
2030 (if (and see-thru (= (artist-get-replacement-char c) ?\s))
2031 (artist-move-to-xy (1+ (artist-current-column))
2032 (artist-current-line))
2033 (artist-replace-char c)))
2034 (setq char-list (cdr char-list)))))
2036 ;;
2037 ;; Routines for setting and unsetting points
2038 ;; Used when not rubber-banding
2039 ;;
2040 (defun artist-no-rb-unset-point1 ()
2041 "Unsets point 1 when not rubber-banding."
2042 (let ((x-now (artist-current-column))
2043 (y-now (artist-current-line))
2044 (x (aref artist-rb-save-data 0))
2045 (y (aref artist-rb-save-data 1)))
2046 (artist-move-to-xy x y)
2047 (artist-replace-char (aref artist-rb-save-data 2))
2048 (artist-move-to-xy x-now y-now)))
2050 (defun artist-no-rb-set-point1 (x y)
2051 "Set point 1 at X, Y when not rubber-banding."
2052 (let ((x-now (artist-current-column))
2053 (y-now (artist-current-line)))
2054 (aset artist-rb-save-data 0 x)
2055 (aset artist-rb-save-data 1 y)
2056 (aset artist-rb-save-data 2 (artist-get-char-at-xy x y))
2057 (artist-move-to-xy x y)
2058 (artist-replace-char artist-first-char)
2059 (artist-move-to-xy x-now y-now)
2060 (aset artist-rb-save-data 6 0)))
2062 (defun artist-no-rb-unset-point2 ()
2063 "This function unsets point 2 when not rubber-banding."
2064 (if (= (aref artist-rb-save-data 6) 1)
2065 (let ((x-now (artist-current-column))
2066 (y-now (artist-current-line))
2067 (x (aref artist-rb-save-data 3))
2068 (y (aref artist-rb-save-data 4)))
2069 (artist-move-to-xy x y)
2070 (artist-replace-char (aref artist-rb-save-data 5))
2071 (artist-move-to-xy x-now y-now))))
2073 (defun artist-no-rb-set-point2 (x y)
2074 "Set point 2 at X, Y when not rubber-banding."
2075 (let ((x-now (artist-current-column))
2076 (y-now (artist-current-line)))
2077 (aset artist-rb-save-data 3 x)
2078 (aset artist-rb-save-data 4 y)
2079 (aset artist-rb-save-data 5 (artist-get-char-at-xy x y))
2080 (artist-move-to-xy x y)
2081 (artist-replace-char artist-second-char)
2082 (artist-move-to-xy x-now y-now)
2083 (aset artist-rb-save-data 6 1)))
2085 (defun artist-no-rb-unset-points ()
2086 "This function unsets point 1 and 2 when not rubber-banding."
2087 (artist-no-rb-unset-point1)
2088 (artist-no-rb-unset-point2))
2091 ;; artist-intersection-char
2092 ;;
2093 ;; Note: If changing this, see the notes for artist-unintersection-char
2094 ;; and artist-vaporize-lines
2095 ;;
2096 (defun artist-intersection-char (new-c old-c)
2097 "Calculates intersection character when drawing a NEW-C on top of an OLD-C.
2098 Return character according to this scheme:
2100 OLD-C NEW-C return
2101 - | +
2102 | - +
2103 + | +
2104 + - +
2107 X / X
2109 other combinations NEW-C"
2111 (cond ((and (= old-c ?- ) (= new-c ?| )) ?+ )
2112 ((and (= old-c ?| ) (= new-c ?- )) ?+ )
2113 ((and (= old-c ?+ ) (= new-c ?- )) ?+ )
2114 ((and (= old-c ?+ ) (= new-c ?| )) ?+ )
2117 ((and (= old-c ?X ) (= new-c ?/ )) ?X )
2119 (t new-c)))
2121 ;; artist-unintersection-char
2122 ;;
2123 ;; Note: If changing this, see the note for artist-vaporize-lines
2124 ;;
2125 (defun artist-unintersection-char (line-c buffer-c)
2126 "Restore character to before intersection when removing LINE-C from BUFFER-C.
2127 Return character according to this scheme:
2129 LINE-C BUFFER-C return
2130 - + |
2131 | + -
2134 other combinations `artist-erase-char'."
2136 (cond ((and (= line-c ?- ) (= buffer-c ?+ )) ?| )
2137 ((and (= line-c ?| ) (= buffer-c ?+ )) ?- )
2140 ((= line-c buffer-c) artist-erase-char)
2141 (t buffer-c)))
2144 ;; Computing the line-char to use
2145 ;; for use with borderless shapes
2146 ;;
2147 (defsubst artist-compute-line-char ()
2148 "Compute which character to use for lines, if any.
2149 Return value is either nil for the default characters that make up lines, or
2150 a character chosen depending on the variables `artist-borderless-shapes',
2151 `artist-fill-char-set', `artist-fill-char' and
2152 `artist-line-char-set' and `artist-line-char'."
2153 (if (and artist-borderless-shapes artist-fill-char-set)
2154 artist-fill-char
2155 (if artist-line-char-set
2156 artist-line-char
2157 nil)))
2160 ;; Things for drawing horizontal, vertical and diagonal (straight) lines.
2161 ;;
2162 ;; A line here is a vector:
2163 ;; [ start-x start-y length direction saved-char-1 saved-char-2 ... ]
2164 ;; directions start with 0 at the x-axis and counts anti clockwise.
2165 ;;
2166 (defvar artist-direction-info
2167 ;; x y char
2168 [ [ 1 0 ?- ] ; direction 0
2170 [ 0 1 ?| ] ; direction 2
2171 [ -1 1 ?/ ] ; direction 3
2172 [ -1 0 ?- ] ; direction 4
2174 [ 0 -1 ?| ] ; direction 6
2175 [ 1 -1 ?/ ] ] ; direction 7
2176 "Table used for stepping x and y coordinates in a specific direction.
2177 This table is also used for determining which char to use for that direction.")
2179 (defsubst artist-direction-step-x (direction)
2180 "Return the x-step for DIRECTION from the `artist-direction-info' table."
2181 (aref (aref artist-direction-info direction) 0))
2183 (defsubst artist-direction-step-y (direction)
2184 "Return the y-step for DIRECTION from the `artist-direction-info' table."
2185 (aref (aref artist-direction-info direction) 1))
2187 (defun artist-direction-char (direction)
2188 "Return the character for DIRECTION from the `artist-direction-info' table."
2189 (aref (aref artist-direction-info direction) 2))
2191 ;; artist-find-direction
2192 ;;
2193 ;;
2194 ;;
2195 (defun artist-find-direction (x1 y1 x2 y2)
2196 "Find the direction from point X1,Y1 to X2,Y2.
2197 Returns a DIRECTION, a number 0--7, coded as follows:
2199 5 6 7
2201 4 - * - 0
2203 3 2 1"
2204 (let ((delta-x (- x2 x1))
2205 (delta-y (- y2 y1)))
2206 (cond ((>= delta-x (* 2 (abs delta-y))) 0)
2207 ((>= delta-y (* 2 (abs delta-x))) 2)
2208 ((>= (- delta-x) (* 2 (abs delta-y))) 4)
2209 ((>= (- delta-y) (* 2 (abs delta-x))) 6)
2210 ((and (>= delta-x 0) (>= delta-y 0)) 1)
2211 ((and (<= delta-x 0) (>= delta-y 0)) 3)
2212 ((and (<= delta-x 0) (<= delta-y 0)) 5)
2213 ((and (>= delta-x 0) (<= delta-y 0)) 7))))
2215 (defun artist-straight-calculate-length (direction x1 y1 x2 y2)
2216 "Calculate length for a straight line in DIRECTION from X1,Y1 to X2,Y2."
2217 (cond ((or (= direction 7)
2218 (= direction 0)
2219 (= direction 1)) (1+ (- x2 x1)))
2220 ((or (= direction 3)
2221 (= direction 4)
2222 (= direction 5)) (1+ (- x1 x2)))
2223 (t (1+ (abs (- y2 y1))))))
2225 (defun artist-sline (x1 y1 x2 y2)
2226 "Create a straight line from X1,Y1 to X2,Y2."
2227 (let* ((direction (artist-find-direction x1 y1 x2 y2))
2228 (length (artist-straight-calculate-length direction x1 y1 x2 y2))
2229 (line (make-vector (+ length 4) x1)))
2230 ;; not needed:
2231 ;; (aset line 0 x1)
2232 ;; because we set all elements to x1
2233 (aset line 1 y1)
2234 (aset line 2 length)
2235 (aset line 3 direction)
2236 line))
2238 (defun artist-save-chars-under-sline (line)
2239 "Save characters under a LINE."
2240 (let ((x (aref line 0))
2241 (y (aref line 1))
2242 (length (+ (aref line 2) 4))
2243 (direction (aref line 3))
2244 (i 4))
2245 (while (< i length)
2246 (aset line i (artist-get-char-at-xy x y))
2247 (setq x (+ x (artist-direction-step-x direction)))
2248 (setq y (+ y (artist-direction-step-y direction)))
2249 (setq i (1+ i))))
2250 line)
2254 ;; Things for drawing lines in all directions.
2255 ;; The line drawing engine is the eight-point algorithm.
2256 ;;
2257 ;; A line is here a list of (x y saved-char new-char)s.
2258 ;;
2259 (defvar artist-octant-info
2260 ;; Initial Step in Step in
2261 ;; coeffs x and y x and y
2262 ;; for if q >= 0 if g < 0
2263 ;; dfdx,dfdy
2264 [ [ 2 1 1 0 1 1 ] ; 1st octant
2265 [ 1 2 1 1 0 1 ] ; 2nd octant
2266 [ -1 2 0 1 -1 1 ] ; 3rd octant
2267 [ -2 1 -1 1 -1 0 ] ; 4th octant
2268 [ -2 -1 -1 0 -1 -1 ] ; 5th octant
2269 [ -1 -2 -1 -1 0 -1 ] ; 6th octant
2270 [ 1 -2 0 -1 1 -1 ] ; 7th octant
2271 [ 2 -1 1 -1 1 0 ] ] ; 8th octant
2272 "Table used by line drawing algorithm (eight point).")
2274 ;; Primitives for the artist-octant-info.
2275 ;; Decrease octant by 1 since elt counts from 0 and octant counts from 1.
2276 ;;
2277 (defsubst artist-get-dfdx-init-coeff (octant)
2278 "Retrieve dfdx component for OCTANT."
2279 (aref (aref artist-octant-info (- octant 1)) 0))
2281 (defsubst artist-get-dfdy-init-coeff (octant)
2282 "Retrieve dfdy component for OCTANT."
2283 (aref (aref artist-octant-info (- octant 1)) 1))
2285 (defsubst artist-get-x-step-q>=0 (octant)
2286 "Retrieve x-step component for OCTANT when q >= 0."
2287 (aref (aref artist-octant-info (- octant 1)) 2))
2289 (defsubst artist-get-y-step-q>=0 (octant)
2290 "Retrieve y-step component for OCTANT when q >= 0."
2291 (aref (aref artist-octant-info (- octant 1)) 3))
2293 (defsubst artist-get-x-step-q<0 (octant)
2294 "Retrieve x-step component for OCTANT for q < 0."
2295 (aref (aref artist-octant-info (- octant 1)) 4))
2297 (defsubst artist-get-y-step-q<0 (octant)
2298 "Retrieve y-step component for OCTANT for q < 0."
2299 (aref (aref artist-octant-info (- octant 1)) 5))
2302 ;; Find octant from x1 y1 x2 y2 coordinates.
2303 ;;
2304 (defun artist-find-octant (x1 y1 x2 y2)
2305 "Find octant for a line from X1,Y1 to X2,Y2.
2306 Octant are numbered 1--8, anti-clockwise as:
2310 ---+---
2314 (if (<= x1 x2) ; quadrant 1 or 4
2315 (if (<= y1 y2) ; quadrant 1, octant 1 or 2
2316 (if (>= (- x2 x1) (- y2 y1))
2317 1
2318 2)
2319 (if (>= (- x2 x1) (- (- y2 y1))) ; quadrant 4, octant 7 or 8
2320 8
2321 7))
2322 (if (<= y1 y2) ; quadrant 2 or 3
2323 (if (>= (- (- x2 x1)) (- y2 y1)) ; quadrant 2, octant 3 or 4
2324 4
2325 3)
2326 (if (>= (- (- x2 x1)) (- (- y2 y1))) ; quadrant 3, octant 5 or 6
2327 5
2328 6))))
2330 ;; Some inline functions for creating, setting and reading
2331 ;; members of a coordinate
2332 ;;
2334 (defsubst artist-new-coord (x y &optional new-char)
2335 "Create a new coordinate at X,Y for use in a line.
2336 Optional argument NEW-CHAR can be used for setting the new-char component
2337 in the coord."
2338 (let ((coord (make-vector 4 x)))
2339 (aset coord 1 y)
2340 (aset coord 3 new-char)
2341 coord))
2343 (defsubst artist-coord-get-x (coord)
2344 "Retrieve the x component of a COORD."
2345 (aref coord 0))
2347 (defsubst artist-coord-get-y (coord)
2348 "Retrieve the y component of a COORD."
2349 (aref coord 1))
2351 (defsubst artist-coord-set-x (coord new-x)
2352 "Set the x component of a COORD to NEW-X."
2353 (aset coord 0 new-x)
2354 coord)
2356 (defsubst artist-coord-set-y (coord new-y)
2357 "Set the y component of a COORD to NEW-Y."
2358 (aset coord 1 new-y)
2359 coord)
2361 (defsubst artist-coord-get-saved-char (coord)
2362 "Retrieve the saved char component of a COORD."
2363 (aref coord 2))
2365 (defsubst artist-coord-get-new-char (coord)
2366 "Retrieve the new char component of a COORD."
2367 (aref coord 3))
2369 (defsubst artist-coord-add-saved-char (coord saved-char)
2370 "Set the saved char component of a COORD to SAVED-CHAR."
2371 (aset coord 2 saved-char)
2372 coord)
2374 (defsubst artist-coord-add-new-char (coord new-char)
2375 "Set the new char component of a COORD to NEW-CHAR."
2376 (aset coord 3 new-char)
2377 coord)
2379 (defsubst artist-coord-set-new-char (coord new-char)
2380 "Set the new char component of a COORD to NEW-CHAR."
2381 (aset coord 3 new-char)
2382 coord)
2385 ;; Pretend we are plotting a pixel. Instead we just list it
2386 ;;
2387 (defmacro artist-put-pixel (point-list x y)
2389 `(setq ,point-list
2390 (append ,point-list (list (artist-new-coord ,x ,y)))))
2392 ;; Calculate list of points using eight point algorithm
2393 ;; return a list of coords
2394 ;;
2395 (defun artist-eight-point (x1 y1 x2 y2)
2396 "Run the eight-point algorithm to get a list of coords from X1,Y1 to X2,Y2."
2397 (let* ((point-list nil)
2398 (octant (artist-find-octant x1 y1 x2 y2))
2399 (dfdx-coeff (artist-get-dfdx-init-coeff octant))
2400 (dfdy-coeff (artist-get-dfdy-init-coeff octant))
2401 (x-step-q>=0 (artist-get-x-step-q>=0 octant))
2402 (y-step-q>=0 (artist-get-y-step-q>=0 octant))
2403 (x-step-q<0 (artist-get-x-step-q<0 octant))
2404 (y-step-q<0 (artist-get-y-step-q<0 octant))
2405 (dfdx (- (- y2 y1)))
2406 (dfdy (- x2 x1))
2407 (x x1)
2408 (y y1)
2409 (f 0)
2410 (q (+ (* 2 f)
2411 (* dfdx-coeff dfdx)
2412 (* dfdy-coeff dfdy))))
2413 (artist-put-pixel point-list x y)
2414 (while (or (not (eq x x2)) (not (eq y y2)))
2415 (if (>= q 0)
2416 (progn
2417 (setq x (+ x x-step-q>=0))
2418 (setq y (+ y y-step-q>=0))
2419 (setq f (+ f (* x-step-q>=0 dfdx) (* y-step-q>=0 dfdy))))
2420 (progn
2421 (setq x (+ x x-step-q<0))
2422 (setq y (+ y y-step-q<0))
2423 (setq f (+ f (* x-step-q<0 dfdx) (* y-step-q<0 dfdy)))))
2424 (setq q (+ (* 2 f) (* dfdx-coeff dfdx) (* dfdy-coeff dfdy)))
2425 (artist-put-pixel point-list x y))
2426 point-list))
2428 ;; artist-save-chars-under-point-list
2429 ;; Remembers the chars that were there before we did draw the line.
2430 ;; Returns point-list.
2431 ;;
2432 (defun artist-save-chars-under-point-list (point-list)
2433 "Save characters originally under POINT-LIST."
2434 (mapcar
2435 (lambda (coord)
2436 (artist-coord-add-saved-char
2437 coord
2438 (artist-get-char-at-xy (artist-coord-get-x coord)
2439 (artist-coord-get-y coord))))
2440 point-list))
2442 ;; artist-calculate-new-char, artist-calculate-new-chars
2443 ;; Calculates which char to insert depending on direction of point-list.
2444 ;;
2445 ;; Depending on new-coord's position relative to last-coord one of the
2446 ;; following chars are returned: \ | / - o, as indicated by this:
2447 ;;
2448 ;; \ | /
2449 ;; - o -
2450 ;; / | \
2451 ;;
2452 ;; artist-calculate-new-char works on one coordinate, returns char.
2453 ;; artist-calculate-new-chars works on a point-list, returns point-list.
2454 ;;
2455 (defun artist-calculate-new-char (last-coord new-coord)
2456 "Return a line-char to use when moving from LAST-COORD to NEW-COORD."
2457 (let ((last-x (artist-coord-get-x last-coord))
2458 (last-y (artist-coord-get-y last-coord))
2459 (new-x (artist-coord-get-x new-coord))
2460 (new-y (artist-coord-get-y new-coord)))
2461 (cond ((> new-x last-x) (cond ((< new-y last-y) ?/ )
2463 (t ?- )))
2465 ((> new-y last-y) ?/ )
2466 (t ?- )))
2467 ((eq new-y last-y) ?o)
2468 (t ?| ))))
2470 (defun artist-calculate-new-chars (point-list)
2471 "Return a list of coords with line-chars calculated. Input: POINT-LIST."
2472 (if (null (cdr point-list))
2473 (list (artist-coord-add-new-char (car point-list) ?o ))
2474 (let ((last-coord (car point-list)))
2475 (cons (artist-coord-add-new-char
2476 (car point-list)
2477 (artist-calculate-new-char (car (cdr point-list))
2478 (car point-list)))
2479 (mapcar
2480 (lambda (this-coord)
2481 (prog1
2482 (artist-coord-add-new-char
2483 this-coord
2484 (artist-calculate-new-char last-coord this-coord))
2485 (setq last-coord this-coord)))
2486 (cdr point-list))))))
2488 ;; artist-modify-new-chars
2489 ;; Replaces some characters with some other characters.
2490 ;;
2491 ;; artist-modify-new-chars works on a point-list, returns point-list.
2492 ;;
2493 (defun artist-modify-new-chars (point-list)
2494 "Replace intersecting characters in POINT-LIST.
2495 This function returns a point-list."
2496 (mapcar
2497 (lambda (coord)
2498 (let* ((new-c (artist-coord-get-new-char coord))
2499 (saved-c (artist-coord-get-saved-char coord))
2500 (modified-c (artist-intersection-char new-c saved-c)))
2501 (artist-coord-set-new-char coord modified-c)))
2502 point-list))
2505 ;;
2506 ;; functions for accessing endpoints and elements in object requiring
2507 ;; 2 endpoints
2508 ;;
2510 (defun artist-make-endpoint (x y)
2511 "Create an endpoint at X, Y."
2512 (let ((new-endpoint (make-vector 2 x)))
2513 (aset new-endpoint 1 y)
2514 new-endpoint))
2516 (defun artist-endpoint-get-x (endpoint)
2517 "Retrieve the x component of an ENDPOINT."
2518 (aref endpoint 0))
2520 (defun artist-endpoint-get-y (endpoint)
2521 "Retrieve the y component of an ENDPOINT."
2522 (aref endpoint 1))
2524 (defun artist-make-2point-object (endpoint1 endpoint2 shapeinfo)
2525 "Create a 2-point object of ENDPOINT1, ENDPOINT2 and SHAPEINFO."
2526 (list endpoint1 endpoint2 shapeinfo))
2528 (defun artist-2point-get-endpoint1 (obj)
2529 "Retrieve the first endpoint of a 2-point object OBJ."
2530 (elt obj 0))
2532 (defun artist-2point-get-endpoint2 (obj)
2533 "Retrieve the second endpoint of a 2-point object OBJ."
2534 (elt obj 1))
2536 (defun artist-2point-get-shapeinfo (obj)
2537 "Retrieve the shapeinfo component of a 2-point object OBJ."
2538 (elt obj 2))
2541 ;;
2542 ;; Drawing and undrawing lines (any direction)
2543 ;;
2545 (defun artist-draw-line (x1 y1 x2 y2)
2546 "Draw a line from X1, Y1 to X2, Y2.
2548 Output is a line, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
2550 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
2551 SHAPE-INFO is a list of vectors [X Y SAVED-CHAR NEW-CHAR]."
2552 (let ((endpoint1 (artist-make-endpoint x1 y1))
2553 (endpoint2 (artist-make-endpoint x2 y2)))
2554 (artist-make-2point-object
2555 endpoint1
2556 endpoint2
2557 (mapcar
2558 (lambda (coord)
2559 (artist-move-to-xy (artist-coord-get-x coord)
2560 (artist-coord-get-y coord))
2561 (if artist-line-char-set
2562 (artist-replace-char artist-line-char)
2563 (artist-replace-char (artist-coord-get-new-char coord)))
2564 coord)
2565 (artist-modify-new-chars
2566 (artist-calculate-new-chars
2567 (artist-save-chars-under-point-list
2568 (artist-eight-point x1 y1 x2 y2))))))))
2570 (defun artist-undraw-line (line)
2571 "Undraw LINE."
2572 (mapcar
2573 (lambda (coord)
2574 (artist-move-to-xy (artist-coord-get-x coord)
2575 (artist-coord-get-y coord))
2576 (artist-replace-char (artist-coord-get-saved-char coord))
2577 coord)
2578 (artist-2point-get-shapeinfo line)))
2580 ;;
2581 ;; Drawing and undrawing straight lines
2582 ;;
2584 (defun artist-draw-sline (x1 y1 x2 y2)
2585 "Draw a straight line from X1, Y1 to X2, Y2.
2586 Straight lines are vertical, horizontal or diagonal lines.
2587 They are faster to draw and most often they are what you need
2588 when drawing a simple image.
2590 Output is a straight line, which is a list on the form
2591 \(END-POINT-1 END-POINT-2 SHAPE-INFO).
2593 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
2594 SHAPE-INFO is a vector [START-X START-Y LENGTH-OF-LINE DIRECTION
2595 ORIGINAL-CHAR-1 ORIGINAL-CHAR-2 ... ]."
2596 (let* ((line (artist-save-chars-under-sline (artist-sline x1 y1 x2 y2)))
2597 (x (aref line 0))
2598 (y (aref line 1))
2599 (length (+ (aref line 2) 4))
2600 (direction (aref line 3))
2601 (line-char (artist-direction-char direction))
2602 (i 4)
2603 (endpoint1 (artist-make-endpoint x y))
2604 (endpoint2 nil))
2605 (while (< i length)
2606 (artist-move-to-xy x y)
2607 (if artist-line-char-set
2608 (artist-replace-char artist-line-char)
2609 (artist-replace-char (artist-intersection-char
2610 line-char
2611 (aref line i))))
2612 (if (not (< (1+ i) length))
2613 ;; This is the last element. Set the second endpoint
2614 (setq endpoint2 (artist-make-endpoint x y)))
2615 (setq x (+ x (artist-direction-step-x direction)))
2616 (setq y (+ y (artist-direction-step-y direction)))
2617 (setq i (1+ i)))
2618 (artist-make-2point-object endpoint1 endpoint2 line)))
2621 (defun artist-undraw-sline (line)
2622 "Undraw a straight line LINE."
2623 (if line
2624 (let* ((shape-info (artist-2point-get-shapeinfo line))
2625 (x (aref shape-info 0))
2626 (y (aref shape-info 1))
2627 (length (+ (aref shape-info 2) 4))
2628 (direction (aref shape-info 3))
2629 (i 4))
2630 (while (< i length)
2631 (artist-move-to-xy x y)
2632 (artist-replace-char (aref shape-info i))
2633 (setq x (+ x (artist-direction-step-x direction)))
2634 (setq y (+ y (artist-direction-step-y direction)))
2635 (setq i (1+ i))))))
2638 ;;
2639 ;; Drawing and undrawing rectangles and squares
2640 ;;
2642 (defun artist-draw-rect (x1 y1 x2 y2)
2643 "Draw a rectangle with corners at X1, Y1 and X2, Y2.
2645 Output is a rectangle, which is a list on the form
2646 \(END-POINT-1 END-POINT-2 SHAPE-INFO).
2648 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
2649 SHAPE-INFO is a list of four straight lines."
2650 (let* ((artist-line-char (artist-compute-line-char))
2651 (artist-line-char-set artist-line-char)
2652 (line1 (artist-draw-sline x1 y1 x2 y1))
2653 (line2 (artist-draw-sline x2 y1 x2 y2))
2654 (line3 (artist-draw-sline x2 y2 x1 y2))
2655 (line4 (artist-draw-sline x1 y2 x1 y1))
2656 (endpoint1 (artist-make-endpoint x1 y1))
2657 (endpoint2 (artist-make-endpoint x2 y2)))
2658 (artist-make-2point-object endpoint1
2659 endpoint2
2660 (list line1 line2 line3 line4))))
2662 (defun artist-undraw-rect (rectangle)
2663 "Undraw RECTANGLE."
2664 (if rectangle
2665 (let ((shape-info (artist-2point-get-shapeinfo rectangle)))
2666 (artist-undraw-sline (elt shape-info 3))
2667 (artist-undraw-sline (elt shape-info 2))
2668 (artist-undraw-sline (elt shape-info 1))
2669 (artist-undraw-sline (elt shape-info 0)))))
2672 (defun artist-rect-corners-squarify (x1 y1 x2 y2)
2673 "Compute square corners from rectangle corners at X1, Y1 and X2, Y2.
2674 The square's first corner will be X1, Y1. The position of the second
2675 corner depends on which of X2 and Y2 is most far away from X1, Y1."
2676 (let* ((delta-x (- x2 x1))
2677 (delta-y (- y2 y1))
2678 (delta-x-sign (if (< delta-x 0) -1 1))
2679 (delta-y-sign (if (< delta-y 0) -1 1))
2680 (new-x2) ; set below
2681 (new-y2)) ; set below
2683 ;; Check which of x2 and y2 is most distant
2684 ;; take care to the aspect ratio
2685 (if (> (abs delta-x) (abs delta-y))
2687 ;; *** x2 more distant than y2 (with care taken to aspect ratio)
2688 (progn
2689 (setq new-x2 x2)
2690 (setq new-y2 (+ y1 (round (/ (* (abs delta-x) delta-y-sign)
2691 artist-aspect-ratio)))))
2693 ;; *** y2 more distant than x2 (with care taken to aspect ratio)
2694 (progn
2695 (setq new-x2 (round (+ x1 (* (* (abs delta-y) delta-x-sign)
2696 artist-aspect-ratio))))
2697 (setq new-y2 y2)))
2699 ;; Return this
2700 (list x1 y1 new-x2 new-y2)))
2703 (defun artist-draw-square (x1 y1 x2 y2)
2704 "Draw a square with corners at X1, Y1 and X2, Y2.
2706 Output is a square, which is a list on the form
2707 \(END-POINT-1 END-POINT-2 SHAPE-INFO).
2709 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
2710 SHAPE-INFO is a list of four straight lines."
2711 (let* ((artist-line-char (artist-compute-line-char))
2712 (artist-line-char-set artist-line-char)
2713 (square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
2714 (new-x1 (elt square-corners 0))
2715 (new-y1 (elt square-corners 1))
2716 (new-x2 (elt square-corners 2))
2717 (new-y2 (elt square-corners 3))
2718 (endpoint1 (artist-make-endpoint new-x1 new-y1))
2719 (endpoint2 (artist-make-endpoint new-x2 new-y2))
2720 (line1 (artist-draw-sline new-x1 new-y1 new-x2 new-y1))
2721 (line2 (artist-draw-sline new-x2 new-y1 new-x2 new-y2))
2722 (line3 (artist-draw-sline new-x2 new-y2 new-x1 new-y2))
2723 (line4 (artist-draw-sline new-x1 new-y2 new-x1 new-y1)))
2724 (artist-make-2point-object endpoint1
2725 endpoint2
2726 (list line1 line2 line3 line4))))
2728 (defun artist-undraw-square (square)
2729 "Undraw SQUARE."
2730 (if square
2731 (let ((shape-info (artist-2point-get-shapeinfo square)))
2732 (artist-undraw-sline (elt shape-info 3))
2733 (artist-undraw-sline (elt shape-info 2))
2734 (artist-undraw-sline (elt shape-info 1))
2735 (artist-undraw-sline (elt shape-info 0)))))
2737 ;;
2738 ;; Filling rectangles and squares
2739 ;;
2741 (defun artist-fill-rect (rect x1 y1 x2 y2)
2742 "Fill rectangle RECT from X1,Y1 to X2,Y2."
2743 (let ((x (1+ (min x1 x2)))
2744 (y (1+ (min y1 y2)))
2745 (x-max (max x1 x2))
2746 (y-max (max y1 y2)))
2747 (let ((w (- x-max x)))
2748 (while (< y y-max)
2749 (artist-move-to-xy x y)
2750 (artist-replace-chars artist-fill-char w)
2751 (setq y (1+ y))))))
2753 (defun artist-fill-square (square x1 y1 x2 y2)
2754 "Fill a SQUARE from X1,Y1 to X2,Y2."
2755 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
2756 (new-x1 (elt square-corners 0))
2757 (new-y1 (elt square-corners 1))
2758 (new-x2 (elt square-corners 2))
2759 (new-y2 (elt square-corners 3))
2760 (x (1+ (min new-x1 new-x2)))
2761 (y (1+ (min new-y1 new-y2)))
2762 (x-max (max new-x1 new-x2))
2763 (y-max (max new-y1 new-y2))
2764 (w (- x-max x)))
2765 (while (< y y-max)
2766 (artist-move-to-xy x y)
2767 (artist-replace-chars artist-fill-char w)
2768 (setq y (1+ y)))))
2771 ;;
2772 ;; Pen drawing
2773 ;;
2775 (defun artist-pen (x1 y1)
2776 "Draw a character at X1, Y1.
2777 The character is replaced with the character in `artist-fill-char'."
2778 (artist-move-to-xy x1 y1)
2779 (artist-replace-char (if artist-line-char-set
2780 artist-line-char
2781 (if artist-fill-char-set
2782 artist-fill-char
2783 artist-default-fill-char))))
2786 (defun artist-pen-line (x1 y1)
2787 "Draw a line from last pen position to X1, Y1.
2788 The character is replaced with the character in `artist-fill-char'.
2789 This will store all points in `artist-key-poly-point-list' in reversed
2790 order (I assume it is faster to cons to the beginning of the list than
2791 to append to the end of the list, when doing free-hand drawing)."
2792 (let ((artist-line-char (if artist-line-char-set
2793 artist-line-char
2794 (if artist-fill-char-set
2795 artist-fill-char
2796 artist-default-fill-char))))
2798 ;; Draw line from last point to this
2799 (let ((x-last (car (car artist-key-poly-point-list)))
2800 (y-last (cdr (car artist-key-poly-point-list))))
2801 (artist-move-to-xy x-last y-last)
2802 (artist-replace-char artist-line-char)
2803 (artist-draw-line x-last y-last x1 y1))
2805 ;; Update the point-list
2806 (setq artist-key-poly-point-list
2807 (cons (cons x1 y1) artist-key-poly-point-list))))
2809 (defun artist-pen-reset-last-xy (x1 y1)
2810 "Reset the last x and y points to X1, Y1 when doing pen-drawing."
2811 (artist-clear-arrow-points)
2812 (setq artist-key-poly-point-list (list (cons x1 y1))))
2815 (defun artist-pen-set-arrow-points (x1 y1)
2816 "Set arrow points for pen drawing using X1, Y1.
2817 Also, the `artist-key-poly-point-list' is reversed."
2819 (setq artist-key-poly-point-list
2820 (artist-uniq artist-key-poly-point-list))
2822 (if (>= (length artist-key-poly-point-list) 2)
2824 ;; Only set arrow-points if the point-list has two or more entries
2825 (let ((xn (car (car artist-key-poly-point-list)))
2826 (yn (cdr (car artist-key-poly-point-list)))
2827 (xn-1 (car (car (cdr artist-key-poly-point-list))))
2828 (yn-1 (cdr (car (cdr artist-key-poly-point-list))))
2829 (dirn)) ; direction for point n
2830 (setq artist-key-poly-point-list (reverse artist-key-poly-point-list))
2831 (let ((x0 (car (car artist-key-poly-point-list)))
2832 (y0 (cdr (car artist-key-poly-point-list)))
2833 (x1 (car (car (cdr artist-key-poly-point-list))))
2834 (y1 (cdr (car (cdr artist-key-poly-point-list))))
2835 (dir0)) ; direction for point 0
2836 (setq dir0 (artist-find-direction x1 y1 x0 y0))
2837 (setq dirn (artist-find-direction xn-1 yn-1 xn yn))
2838 (setq artist-arrow-point-1 (artist-make-arrow-point x0 y0 dir0))
2839 (setq artist-arrow-point-2 (artist-make-arrow-point xn yn dirn))))))
2842 ;;
2843 ;; Text rendering
2844 ;;
2845 (defun artist-figlet-run (text font extra-args)
2846 "Run figlet rendering TEXT using FONT.
2847 EXTRA-ARGS for figlet, for the command line, may be specified."
2848 (let* ((figlet-args (cond ((and font extra-args)
2849 (cons (concat "-f" font)
2851 (font (concat "-f" font))
2852 (extra-args
2854 (t nil)))
2855 (figlet-output (artist-system artist-figlet-program text figlet-args))
2856 (exit-code (elt figlet-output 0))
2857 (stdout (elt figlet-output 1))
2858 (stderr (elt figlet-output 2)))
2859 (if (not (= exit-code 0))
2860 (error "Failed to render font: %s (%d)" stderr exit-code))
2861 stdout))
2863 (defun artist-figlet-get-font-list ()
2864 "Read fonts in with the shell command.
2865 Returns a list of strings."
2866 (let* ((cmd-interpreter "/bin/sh")
2867 (ls-cmd artist-figlet-list-fonts-command)
2868 (result (artist-system cmd-interpreter ls-cmd nil))
2869 (exit-code (elt result 0))
2870 (stdout (elt result 1))
2871 (stderr (elt result 2)))
2872 (if (not (= exit-code 0))
2873 (error "Failed to read available fonts: %s (%d)" stderr exit-code))
2876 (defun artist-figlet-get-font-list-windows ()
2877 "Read in fonts on MS-Windows by collecting output of the `figlet' program.
2878 Returns a list of strings."
2879 (let* ((ls-cmd "figlet -I2")
2880 (result (artist-system shell-file-name nil
2881 (list shell-command-switch ls-cmd)))
2882 (exit-code (elt result 0))
2883 (stdout (elt result 1))
2884 (stderr (elt result 2)))
2885 (if (not (= exit-code 0))
2886 (error "Failed to read available fonts: %s (%d)" stderr exit-code))
2888 result)
2889 (mapc
2890 (lambda (dir)
2891 (let ((default-directory dir))
2892 (setq result (append (file-expand-wildcards "*.flf") result))))
2893 dir-list)
2894 (mapcar
2895 (lambda (file)
2897 result))))
2899 (defun artist-figlet-choose-font ()
2900 "Read any extra arguments for figlet."
2901 (interactive)
2902 (let* ((avail-fonts
2903 (if (memq system-type '(windows-nt ms-dos))
2904 (artist-figlet-get-font-list-windows)
2905 (artist-figlet-get-font-list)))
2906 (font (completing-read (concat "Select font (default "
2907 artist-figlet-default-font
2908 "): ")
2909 (mapcar
2910 (lambda (font) (cons font font))
2911 avail-fonts))))
2912 (if (string= font "") artist-figlet-default-font font)))
2914 (defun artist-figlet-get-extra-args ()
2915 "Read any extra arguments for figlet."
2916 (let ((extra-args (read-string "Extra args to figlet: ")))
2917 (if (string= extra-args "")
2918 nil
2919 extra-args)))
2921 (defun artist-figlet (text)
2922 "Render TEXT using figlet."
2923 (let* ((figlet-font (artist-figlet-choose-font))
2924 (figlet-extra-args (artist-figlet-get-extra-args)))
2925 (artist-figlet-run text figlet-font figlet-extra-args)))
2928 (defun artist-text-insert-common (x y text see-thru)
2929 "At position X, Y, insert text TEXT.
2930 If SEE-THRU is non-nil, then blanks in TEXT do not replace text
2931 in the buffer."
2933 (i 0)
2934 (len (length string-list)))
2935 (while (< i len)
2936 (artist-move-to-xy x (+ y i))
2937 (artist-replace-string (car string-list) see-thru)
2938 (setq string-list (cdr string-list))
2939 (setq i (1+ i)))))
2941 (defun artist-text-insert-see-thru (x y text)
2942 "At position X, Y, insert text TEXT.
2943 Let text already in buffer shine thru the TEXT inserted."
2944 (artist-text-insert-common x y text t))
2946 (defun artist-text-insert-overwrite (x y text)
2947 "At position X, Y, insert text TEXT.
2948 Let blanks in TEXT overwrite any text already in the buffer."
2949 (artist-text-insert-common x y text nil))
2951 (defun artist-text-see-thru (x y)
2952 "Prompt for text to render, render it at X,Y.
2953 This is done by calling the function specified by
2954 `artist-text-renderer-function', which must return a list of strings,
2955 to be inserted in the buffer.
2958 (let* ((input-text (read-string "Type text to render: "))
2959 (rendered-text (artist-funcall artist-text-renderer-function input-text)))
2960 (artist-text-insert-see-thru x y rendered-text)))
2963 (defun artist-text-overwrite (x y)
2964 "Prompt for text to render, render it at X,Y.
2965 This is done by calling the function specified by
2966 `artist-text-renderer-function', which must return a list of strings,
2967 to be inserted in the buffer.
2969 Blanks in the rendered text overwrite any text in the buffer."
2970 (let* ((input-text (read-string "Type text to render: "))
2971 (rendered-text (artist-funcall artist-text-renderer-function input-text)))
2972 (artist-text-insert-overwrite x y rendered-text)))
2974 ;;
2975 ;; Spraying
2976 ;;
2978 (defun artist-spray-get-interval ()
2979 "Retrieve the interval for repeated spray."
2980 artist-spray-interval)
2982 (defun artist-spray-random-points (n radius)
2983 "Generate N random points within a radius of RADIUS.
2984 Returns a list of points. Each point is on the form (X1 . Y1)."
2985 (let ((points))
2986 (while (> n 0)
2987 (let* ((angle (degrees-to-radians (random 359)))
2988 (dist (random radius))
2989 (point (cons (round (* dist (cos angle)))
2990 (round (* dist (sin angle))))))
2991 (setq points (cons point points)))
2992 (setq n (- n 1)))
2993 points))
2995 (defun artist-spray (x1 y1)
2996 "Spray at X1, Y1."
2997 (let* ((num-points (* artist-spray-radius artist-spray-radius))
2998 (spray-points (artist-spray-random-points num-points
2999 artist-spray-radius)))
3000 (while spray-points
3001 ;; Replace one spray point
3002 (let* ((point (car spray-points))
3003 (x (+ x1 (car point)))
3004 (y (+ y1 (cdr point)))
3005 (buf-c (artist-get-char-at-xy-conv x y))
3006 (this-c (memq buf-c artist-spray-chars))
3007 (next-c (cond ((null this-c) artist-spray-new-char)
3008 ((null (cdr this-c)) (car this-c))
3009 (t (car (cdr this-c))))))
3010 (artist-move-to-xy x y)
3011 (artist-replace-char next-c))
3013 ;; Step to next spray point
3014 (setq spray-points (cdr spray-points)))))
3016 (defun artist-spray-clear-circle (circle x1 y1 x2 y2)
3017 "Clear circle CIRCLE at X1, Y1 through X2, Y2."
3018 (artist-undraw-circle circle))
3020 (defun artist-spray-set-radius (circle x1 y1 x2 y2)
3021 "Set spray radius from CIRCLE at X1, Y1 through X2, Y2."
3022 (let ((dx (- x2 x1))
3023 (dy (- y2 y1)))
3024 (setq artist-spray-radius (round (sqrt (+ (* dx dx) (* dy dy)))))
3025 (if (= 0 artist-spray-radius)
3026 (setq artist-spray-radius 1))))
3028 ;;
3029 ;; Erasing
3030 ;;
3032 (defun artist-erase-char (x1 y1)
3033 "Erase a character at X1, Y1.
3034 The character is replaced with the character in `artist-erase-char'."
3035 (artist-move-to-xy x1 y1)
3036 (artist-replace-char artist-erase-char))
3038 (defun artist-erase-rect (rect x1 y1 x2 y2)
3039 "Erase rectangle RECT from X1, Y1, X2, Y2."
3040 (let ((artist-line-char-set t)
3041 (artist-fill-char-set t)
3042 (artist-line-char artist-erase-char)
3043 (artist-fill-char artist-erase-char))
3044 (artist-draw-rect x1 y1 x2 y2)
3045 (artist-fill-rect rect x1 y1 x2 y2)))
3048 ;;
3049 ;; Vaporizing (erasing) line and lines
3050 ;;
3053 (defun artist-vap-find-endpoint (x1 y1 step-x step-y accept-set reject-set)
3054 "Find one endpoint for line through X1, Y1.
3055 The endpoint is searched for in the direction defined by STEP-X, STEP-Y,
3056 accepting characters in the list ACCEPT-SET, stopping immediately
3057 when finding characters in the list REJECT-SET. Fuzziness, that is
3058 the number of consecutive characters not in ACCEPT-SET to allow as
3059 part of the line, is determined by the variable `artist-vaporize-fuzziness'.
3060 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
3061 (let ((x x1)
3062 (y y1)
3063 (x-last x1)
3064 (y-last y1)
3065 (done nil))
3066 (while (not done)
3067 (let ((c (artist-get-char-at-xy-conv x y)))
3068 (cond ((memq c reject-set)
3069 (setq done t))
3071 ;; We found a character we are accepting as part of the line.
3072 ;; Update position
3073 ((memq c accept-set)
3074 (setq x-last x
3075 y-last y
3076 x (+ x step-x)
3077 y (+ y step-y))
3078 (if (or (< x 0) (< y 0)) ;stop at the edge
3079 (setq done t)))
3081 ;; We found a character we are not accepting as part of
3082 ;; the line Search `artist-vaporize-fuzziness'
3083 ;; characters away from this position in the same
3084 ;; direction to see if there are any characters in the
3085 ;; accept-set. If not, we have found the endpoint.
3086 (t
3087 (let ((fuzziness artist-vaporize-fuzziness)
3088 (x-tmp x)
3089 (y-tmp y))
3091 ;; while we have more fuzziness left and we have not
3092 ;; found a character accepted as a line, move
3093 ;; forward!
3094 (while (and (> fuzziness 0) (not (memq c accept-set)))
3095 (setq x-tmp (+ x-tmp step-x))
3096 (setq y-tmp (+ y-tmp step-y))
3097 (setq c (artist-get-char-at-xy-conv x-tmp y-tmp))
3098 (setq fuzziness (- fuzziness 1)))
3099 (if (memq c accept-set)
3101 ;; The line continues on the other side of the
3102 ;; not-accepted character.
3103 (setq x x-tmp
3104 y y-tmp)
3106 ;; Else: We couldn't find any line on the other side.
3107 ;; That means we are done searching for the endpoint.
3108 (setq done t)))))))
3109 (cons x-last y-last)))
3112 (defun artist-vap-find-endpoints-horiz (x y)
3113 "Find endpoints for a horizontal line through X, Y.
3114 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
3115 (list (artist-vap-find-endpoint x y 1 0 '(?- ?+) '(?\s))
3116 (artist-vap-find-endpoint x y -1 0 '(?- ?+) '(?\s))))
3118 (defun artist-vap-find-endpoints-vert (x y)
3119 "Find endpoints for a vertical line through X, Y.
3120 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
3121 (list (artist-vap-find-endpoint x y 0 1 '(?| ?+) '(?\s))
3122 (artist-vap-find-endpoint x y 0 -1 '(?| ?+) '(?\s))))
3124 (defun artist-vap-find-endpoints-swne (x y)
3125 "Find endpoints for a diagonal line (made by /'s) through X, Y.
3126 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
3127 (list (artist-vap-find-endpoint x y 1 -1 '(?/ ?X) '(?\s))
3128 (artist-vap-find-endpoint x y -1 1 '(?/ ?X) '(?\s))))
3130 (defun artist-vap-find-endpoints-nwse (x y)
3132 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
3137 (defun artist-vap-find-endpoints (x y)
3138 "Given a point X1, Y1, return a list of endpoints of lines through X, Y.
3139 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
3140 (if artist-line-char-set
3141 nil
3142 (let ((c (artist-get-char-at-xy-conv x y)))
3143 (cond ((eq c ?-) (artist-vap-find-endpoints-horiz x y))
3144 ((eq c ?|) (artist-vap-find-endpoints-vert x y))
3145 ((eq c ?/) (artist-vap-find-endpoints-swne x y))
3147 ((eq c ?+) (append (artist-vap-find-endpoints-horiz x y)
3148 (artist-vap-find-endpoints-vert x y)))
3149 ((eq c ?X) (append (artist-vap-find-endpoints-swne x y)
3150 (artist-vap-find-endpoints-nwse x y)))
3152 ;; We don't know how to find directions when we are on
3153 ;; another character
3154 (t nil)))))
3157 (defun artist-vap-group-in-pairs (l)
3158 "Group elements in list L in pairs."
3159 (cond ((null l) nil)
3160 ((null (cdr l)) l) ; unevent number of elements in list
3161 (t (append (list (list (car l) (car (cdr l))))
3162 (artist-vap-group-in-pairs (cdr (cdr l)))))))
3164 (defun artist-vaporize-by-endpoints (endpoint1 endpoint2)
3165 "Given ENDPOINT1 and ENDPOINT2, vaporize the line between them.
3166 An endpoint is a pair (X . Y)."
3167 (let* ((x1 (car endpoint1))
3168 (y1 (cdr endpoint1))
3169 (x2 (car endpoint2))
3170 (y2 (cdr endpoint2))
3171 (dir (artist-find-direction x1 y1 x2 y2))
3172 (x-step (aref [1 1 0 -1 -1 -1 0 1] dir))
3173 (y-step (aref [0 1 1 1 0 -1 -1 -1] dir))
3175 (line-len (elt (list (abs (- x2 x1))
3176 (abs (- x2 x1))
3177 (abs (- y2 y1))
3178 (abs (- y2 y1))
3179 (abs (- x1 x2))
3180 (abs (- x1 x2))
3181 (abs (- y1 y2))
3182 (abs (- y1 y2)))
3183 dir))
3184 (x x1)
3185 (y y1))
3186 (while (>= line-len 0)
3187 (let* ((buffer-c (artist-get-char-at-xy-conv x y))
3188 (new-c (artist-unintersection-char line-c buffer-c)))
3189 (artist-move-to-xy x y)
3190 (artist-replace-char new-c))
3191 (setq x (+ x x-step)
3192 y (+ y y-step)
3193 line-len (- line-len 1)))))
3196 (defun artist-vaporize-line (x1 y1)
3197 "Vaporize (erase) the straight line through X1, Y1.
3198 Do this by replacing the characters that forms the line with
3199 `artist-erase-char'. Output is a list of endpoints for lines through
3200 X1, Y1. An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
3201 (let ((endpoints (artist-vap-find-endpoints x1 y1)))
3202 (mapc
3203 (lambda (endpoints)
3204 (let ((ep1 (car endpoints))
3205 (ep2 (car (cdr endpoints))))
3206 (artist-vaporize-by-endpoints ep1 ep2)))
3207 (artist-vap-group-in-pairs endpoints))
3208 endpoints))
3211 ;; Implementation note: This depends on artist-vaporize-line doing
3212 ;; unintersections of intersecting lines.
3213 ;;
3214 ;; Example:
3215 ;; Suppose the buffer looks like this and that we start vaporizing
3216 ;; lines at (3,0) (at the ``*'').
3217 ;;
3218 ;; 0123456
3219 ;; 0+--*--+
3220 ;; 1| |
3221 ;; 2| |
3222 ;; 3+-----+
3223 ;;
3224 ;; We will then push (0,0) and (6,0) on the stack, and vaporize the
3225 ;; topmost horizontal line:
3226 ;;
3227 ;; 0123456
3228 ;; 0| |
3229 ;; 1| |
3230 ;; 2| |
3231 ;; 3+-----+
3232 ;;
3233 ;; We will then pop (0,0) and remove the left-most vertical line while
3234 ;; pushing the lower left corner (0,3) on the stack, and so on until
3235 ;; the entire rectangle is vaporized.
3236 ;;
3237 ;; Now, What if the `+' in the upper left and upper right corners,
3238 ;; had not been changed to `|' but to spaces instead? We would
3239 ;; have failed when popping (0,0) and vaporizing that line because
3240 ;; we wouldn't find any line at (0,0):
3241 ;;
3242 ;; 0123456
3243 ;; 0
3244 ;; 1| |
3245 ;; 2| |
3246 ;; 3+-----+
3247 ;;
3248 ;; That's why we depend on artist-vaporize-line doing unintersecting
3249 ;; of crossing lines. There are alternative ways to handle this
3250 ;; if it becomes too much a trouble.
3251 ;;
3252 (defun artist-vaporize-lines (x1 y1)
3253 "Vaporize lines reachable from point X1, Y1."
3254 (let ((ep-stack nil))
3255 (mapc
3256 (lambda (ep) (push ep ep-stack))
3257 (artist-vap-find-endpoints x1 y1))
3258 (while (not (null ep-stack))
3259 (let* ((vaporize-point (pop ep-stack))
3260 (new-endpoints (artist-vaporize-line (car vaporize-point)
3261 (cdr vaporize-point))))
3262 (mapc
3263 (lambda (endpoint) (push endpoint ep-stack))
3264 new-endpoints)))))
3267 ;;
3268 ;; Circles and ellipses
3269 ;;
3270 (defun artist-ellipse-generate-quadrant (x-radius y-radius)
3271 "Create a point-list for first quadrant.
3272 Points go from (X-RADIUS, 0) to (0, Y-RADIUS).
3273 Quadrant is generated around origin."
3274 (let* ((rx2 (* x-radius x-radius))
3275 (ry2 (* y-radius y-radius))
3276 (2rx2 (* 2 rx2))
3277 (2ry2 (* 2 ry2))
3278 (p)
3279 (x 0)
3280 (y y-radius)
3281 (px 0)
3282 (py (* 2rx2 y))
3283 (point-list nil))
3284 (artist-put-pixel point-list x y)
3285 (setq p (round (+ ry2 (- (* rx2 y-radius)) (* 0.25 rx2))))
3286 (while (< px py)
3287 (setq x (1+ x)
3288 px (+ px 2ry2))
3289 (if (< p 0)
3290 (setq p (+ p ry2 px))
3291 (setq y (- y 1)
3292 py (- py 2rx2)
3293 p (+ p ry2 px (- py))))
3294 (artist-put-pixel point-list x y))
3295 (setq p (round (+ (* ry2 (+ x 0.5) (+ x 0.5))
3296 (* rx2 (- y 1) (- y 1))
3297 (- (* rx2 ry2)))))
3298 (while (> y 0)
3299 (setq y (- y 1)
3300 py (- py 2rx2))
3301 (if (> p 0)
3302 (setq p (+ p rx2 (- py)))
3303 (setq x (1+ x)
3304 px (+ px 2ry2)
3305 p (+ p rx2 (- py) px)))
3306 (artist-put-pixel point-list x y))
3307 point-list))
3309 (defsubst artist-new-fill-item (x y width)
3310 "Create a new item at X, Y, with WIDTH.
3311 This is for use in fill-info in ellipses and circles."
3312 (let ((new-item (make-vector 3 x)))
3313 (aset new-item 1 y)
3314 (aset new-item 2 width)
3315 new-item))
3317 (defsubst artist-fill-item-get-x (fill-item)
3318 "Retrieve the x component of a FILL-ITEM."
3319 (aref fill-item 0))
3321 (defsubst artist-fill-item-set-x (fill-item new-x)
3322 "Set the x component of a FILL-ITEM to NEW-X."
3323 (aset fill-item 0 new-x)
3324 fill-item)
3326 (defsubst artist-fill-item-get-y (fill-item)
3327 "Retrieve the y component of a FILL-ITEM."
3328 (aref fill-item 1))
3330 (defsubst artist-fill-item-set-y (fill-item new-y)
3331 "Set the y component of a FILL-ITEM to NEW-Y."
3332 (aset fill-item 1 new-y)
3333 fill-item)
3335 (defsubst artist-fill-item-get-width (fill-item)
3336 "Retrieve the width component of a FILL-ITEM."
3337 (aref fill-item 2))
3339 (defsubst artist-fill-item-set-width (fill-item new-width)
3340 "Set the width component of a FILL-ITEM to NEW-WIDTH."
3341 (aset fill-item 2 new-width)
3342 fill-item)
3345 (defun artist-ellipse-point-list-add-center (x-center y-center point-list)
3346 "Add offsets X-CENTER and Y-CENTER to coordinates in POINT-LIST."
3347 (mapcar
3348 (lambda (p)
3349 (artist-coord-set-x p (+ x-center (artist-coord-get-x p)))
3350 (artist-coord-set-y p (+ y-center (artist-coord-get-y p))))
3351 point-list))
3354 (defun artist-ellipse-fill-info-add-center (x-center y-center fill-info)
3355 "Add offsets X-CENTER and Y-CENTER to fill-items in FILL-INFO."
3356 (mapcar
3357 (lambda (p)
3358 (artist-fill-item-set-x p (+ x-center (artist-fill-item-get-x p)))
3359 (artist-fill-item-set-y p (+ y-center (artist-fill-item-get-y p))))
3360 fill-info))
3362 (defun artist-ellipse-remove-0-fills (fill-info)
3363 "Remove fill-infos from FILL-INFO that fills a zero-width field."
3364 (cond ((null fill-info)
3365 nil)
3366 ((= 0 (artist-fill-item-get-width (car fill-info)))
3367 (artist-ellipse-remove-0-fills (cdr fill-info)))
3368 (t
3369 (append (list (car fill-info))
3370 (artist-ellipse-remove-0-fills (cdr fill-info))))))
3373 (defun artist-ellipse-compute-fill-info (point-list)
3374 "Compute fill info for ellipse around 0,0 from POINT-LIST.
3375 The POINT-LIST is expected to cover the first quadrant."
3376 (let ((first-half nil)
3377 (both-halves nil)
3378 (last-y nil))
3380 ;; Create first half (the lower one (since y grows downwards)) from
3381 ;; the first quadrant.
3382 (mapc
3383 (lambda (coord)
3384 (let* ((x (artist-coord-get-x coord))
3385 (y (artist-coord-get-y coord))
3386 (width (max (- (* 2 x) 1) 0))
3387 (left-edge (- x width)))
3388 (if (or (null last-y) (not (= y last-y)))
3389 ;; This was either the first time,
3390 ;; or it was the first time on a new line
3391 (setq first-half
3392 (append first-half
3393 ;; Fill info item starts at left-edge on line y
3394 (list (artist-new-fill-item left-edge y width)))))
3395 (setq last-y y)))
3396 point-list)
3398 ;; Create the other half by mirroring the first half.
3399 (setq both-halves
3400 (append first-half
3401 (mapcar
3402 (lambda (i)
3403 (artist-new-fill-item (artist-fill-item-get-x i)
3404 (- (artist-fill-item-get-y i))
3405 (artist-fill-item-get-width i)))
3406 ;; The cdr below is so we don't include fill-info for
3407 ;;; the middle line twice
3408 (cdr (reverse first-half)))))
3409 (artist-ellipse-remove-0-fills both-halves)))
3412 (defun artist-ellipse-mirror-quadrant (point-list)
3413 "Mirror a POINT-LIST describing first quadrant to create a complete ellipse."
3414 (let ((right-half nil)
3415 (left-half nil))
3417 ;; First, if last char in that quadrant is `/', then replace it with `)'
3418 ;; This way we avoids things
3419 ;; --------- ---------
3420 ;; / \ / \
3421 ;; that look like: \ / instead we get: ( )
3422 ;; \ / \ /
3423 ;; --------- ---------
3424 (let ((last-coord (car (last point-list))))
3425 (if (= (artist-coord-get-new-char last-coord) ?/)
3426 (artist-coord-set-new-char last-coord artist-ellipse-right-char)))
3428 ;; Create the other part of the right half by mirroring the first part
3429 (setq right-half
3430 (append
3431 point-list
3432 (mapcar
3433 (lambda (coord)
3434 (let ((c (artist-coord-get-new-char coord)))
3435 (artist-new-coord (artist-coord-get-x coord)
3436 (- (artist-coord-get-y coord))
3439 (t c)))))
3440 ;; The cdr below is so we don't draw the middle right char twice
3441 (cdr (reverse point-list)))))
3443 ;; Create the left half by mirroring the right half.
3444 (setq left-half
3445 (mapcar
3446 (lambda (coord)
3447 (let ((c (artist-coord-get-new-char coord)))
3448 (artist-new-coord (- (artist-coord-get-x coord))
3449 (artist-coord-get-y coord)
3452 ((= c artist-ellipse-right-char)
3453 artist-ellipse-left-char)
3454 (t c)))))
3455 ;; The cdr and butlast below is so we don't draw the middle top
3456 ;; and middle bottom char twice.
3457 (butlast (cdr (reverse right-half)))))
3458 (append right-half left-half)))
3461 (defun artist-draw-ellipse-general (x1 y1 x-radius y-radius)
3462 "Draw an ellipse with center at X1, Y1 and X-RADIUS and Y-RADIUS.
3464 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
3466 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
3467 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].
3469 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
3470 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE].
3472 Ellipses with zero Y-RADIUS are not drawn correctly."
3473 (let* ((point-list (artist-ellipse-generate-quadrant x-radius y-radius))
3474 (fill-info (artist-ellipse-compute-fill-info point-list))
3475 (shape-info (make-vector 2 0)))
3477 (setq point-list (artist-calculate-new-chars point-list))
3478 (setq point-list (artist-ellipse-mirror-quadrant point-list))
3479 (setq point-list (artist-ellipse-point-list-add-center x1 y1 point-list))
3480 (setq fill-info (artist-ellipse-fill-info-add-center x1 y1 fill-info))
3482 ;; Draw the ellipse
3483 (setq point-list
3484 (mapcar
3485 (lambda (coord)
3486 (artist-move-to-xy (artist-coord-get-x coord)
3487 (artist-coord-get-y coord))
3488 (if artist-line-char-set
3489 (artist-replace-char artist-line-char)
3490 (artist-replace-char (artist-coord-get-new-char coord)))
3491 coord)
3492 (artist-modify-new-chars
3493 (artist-save-chars-under-point-list point-list))))
3495 (aset shape-info 0 point-list)
3496 (aset shape-info 1 fill-info)
3497 (artist-make-2point-object (artist-make-endpoint x1 y1)
3498 (artist-make-endpoint x-radius y-radius)
3499 shape-info)))
3501 (defun artist-draw-ellipse-with-0-height (x1 y1 x-radius y-radius)
3502 "Draw an ellipse with center at X1, Y1 and X-RADIUS and Y-RADIUS.
3504 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
3506 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
3507 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].
3509 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
3510 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE].
3512 The Y-RADIUS must be 0, but the X-RADIUS must not be 0."
3513 (let ((point-list nil)
3514 (width (max (- (abs (* 2 x-radius)) 1)))
3515 (left-edge (1+ (- x1 (abs x-radius))))
3516 (line-char (if artist-line-char-set artist-line-char ?-))
3517 (i 0)
3518 (point-list nil)
3519 (fill-info nil)
3520 (shape-info (make-vector 2 0)))
3521 (while (< i width)
3522 (let* ((line-x (+ left-edge i))
3523 (line-y y1)
3524 (new-coord (artist-new-coord line-x line-y)))
3525 (artist-coord-add-saved-char new-coord
3526 (artist-get-char-at-xy line-x line-y))
3527 (artist-move-to-xy line-x line-y)
3528 (artist-replace-char line-char)
3529 (setq point-list (append point-list (list new-coord)))
3530 (setq i (1+ i))))
3531 (aset shape-info 0 point-list)
3532 (aset shape-info 1 fill-info)
3533 (artist-make-2point-object (artist-make-endpoint x1 y1)
3534 (artist-make-endpoint x-radius y-radius)
3535 shape-info)))
3537 (defun artist-draw-ellipse (x1 y1 x2 y2)
3538 "Draw an ellipse with center at X1, Y1 and point X2,Y2.
3540 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
3542 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
3543 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].
3545 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
3546 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]."
3547 (let* ((artist-line-char (artist-compute-line-char))
3548 (artist-line-char-set artist-line-char)
3549 (width (abs (- x2 x1)))
3550 (height (abs (- y2 y1)))
3551 ;;
3552 ;; When we draw our ellipse, we want it to go through the cursor
3553 ;; position, but since x1,y1, x2,y2 marks the corners of one
3554 ;; of the quadrants, we have to enlarge the ellipse a bit.
3555 ;; Ok, so then why by sqrt(2)?
3556 ;; It comes from the equation for the ellipse (where a is the
3557 ;; x-radius and b is the y-radius):
3558 ;; f(x,y) = x^2 / a^2 + y^2 / b^2 - 1 = 0
3559 ;; and the fact that we want the enlarged ellipse to have the
3560 ;; same proportions as the smaller square, therefore we have:
3561 ;; a/b = x/y
3562 ;; Solving this yields a-in-larger-ellipse = a-in-smaller * sqrt(2)
3563 (x-radius (round (* width (sqrt 2))))
3564 (y-radius (round (* height (sqrt 2))))
3565 (x x1)
3566 (y y1))
3567 (if (and (= y1 y2) (not (= x1 x2)))
3568 (artist-draw-ellipse-with-0-height x y x-radius y-radius)
3569 (artist-draw-ellipse-general x y x-radius y-radius))))
3572 (defun artist-undraw-ellipse (ellipse)
3573 "Undraw ELLIPSE."
3574 (if ellipse
3575 (let ((point-list (aref (artist-2point-get-shapeinfo ellipse) 0)))
3576 (mapcar
3577 (lambda (coord)
3578 (artist-move-to-xy (artist-coord-get-x coord)
3579 (artist-coord-get-y coord))
3580 (artist-replace-char (artist-coord-get-saved-char coord))
3581 coord)
3582 point-list))))
3585 (defun artist-draw-circle (x1 y1 x2 y2)
3586 "Draw a circle with center at X1, Y1 and point X2,Y2.
3588 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
3590 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
3591 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].
3593 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
3594 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]."
3595 (let* ((artist-line-char (artist-compute-line-char))
3596 (artist-line-char-set artist-line-char)
3597 (width (abs (- x2 x1)))
3598 (height (abs (- y2 y1)))
3599 ;; When drawing our circle, we want it to through the cursor
3600 ;; just as when drawing the ellipse, but we have to take
3601 ;; care for the aspect-ratio.
3602 ;; The equation for the ellipse (where a is the x-radius and
3603 ;; b is the y-radius):
3604 ;; f(x,y) = x^2 / a^2 + y^2 / b^2 - 1 = 0
3605 ;; together with the relationship
3606 ;; a = aspect-ratio * b
3607 ;; gives
3608 ;; a = sqrt( x^2 + (aspect-ratio * y)^2 ) and
3609 ;; b = a / aspect-ratio
3610 (x-radius (round (sqrt (+ (* width width)
3611 (* (* artist-aspect-ratio height)
3612 (* artist-aspect-ratio height))))))
3613 (y-radius (round (/ x-radius artist-aspect-ratio))))
3614 (artist-draw-ellipse-general x1 y1 x-radius y-radius)))
3616 (defalias 'artist-undraw-circle 'artist-undraw-ellipse)
3619 ;
3620 ; Filling ellipses
3621 ;
3622 (defun artist-fill-ellipse (ellipse x y x-radius y-radius)
3623 "Fill an ELLIPSE centered at X,Y with radius X-RADIUS and Y-RADIUS."
3624 (let ((fill-info (aref (artist-2point-get-shapeinfo ellipse) 1)))
3625 (mapcar
3626 (lambda (fill-item)
3627 (artist-move-to-xy (artist-fill-item-get-x fill-item)
3628 (artist-fill-item-get-y fill-item))
3629 (artist-replace-chars artist-fill-char
3630 (artist-fill-item-get-width fill-item))
3631 fill-item)
3632 fill-info)))
3634 (defalias 'artist-fill-circle 'artist-fill-ellipse)
3637 ;;
3638 ;; Cutting, copying and pasting rectangles and squares
3639 ;; (filling functions)
3640 ;;
3642 (defun artist-cut-rect (rect x1 y1 x2 y2)
3643 "Copy rectangle RECT drawn from X1, Y1 to X2, Y2, then clear it."
3644 (artist-undraw-rect rect)
3645 (artist-copy-generic x1 y1 x2 y2)
3646 (artist-erase-rect rect x1 y1 x2 y2))
3648 (defun artist-cut-square (square x1 y1 x2 y2)
3649 "Copy a SQUARE drawn from X1, Y1 to X2, Y2 (made square), then clears it."
3650 (artist-undraw-square square)
3651 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
3652 (new-x1 (elt square-corners 0))
3653 (new-y1 (elt square-corners 1))
3654 (new-x2 (elt square-corners 2))
3655 (new-y2 (elt square-corners 3)))
3656 (artist-copy-generic new-x1 new-y1 new-x2 new-y2)
3657 (artist-erase-rect square new-x1 new-y1 new-x2 new-y2)))
3660 (defun artist-get-buffer-contents-at-xy (x y width)
3661 "Retrieve contents from the buffer at X, Y. WIDTH characters are returned."
3662 (artist-move-to-xy x y)
3663 (let ((here (point))
3664 (there (save-excursion (artist-move-to-xy (+ x width) y) (point))))
3665 (untabify here there)
3666 (setq there (save-excursion (artist-move-to-xy (+ x width) y) (point)))
3667 (buffer-substring here there)))
3670 (defun artist-copy-generic (x1 y1 x2 y2)
3671 "Copy a rectangular area with corners at X1, Y1 and X2, Y2.
3672 Output is a copy buffer, a list of strings, representing the
3673 original contents of that area in the buffer."
3674 (let* ((x (min x1 x2))
3675 (y (min y1 y2))
3676 (x-max (max x1 x2))
3677 (y-max (max y1 y2))
3678 (w (+ (- x-max x) 1))
3679 (l nil))
3680 (while (<= y y-max)
3681 (setq l (cons (artist-get-buffer-contents-at-xy x y w) l))
3682 (setq y (1+ y)))
3683 (if artist-interface-with-rect
3684 (setq killed-rectangle (reverse l))
3685 (setq artist-copy-buffer (reverse l)))))
3688 (defun artist-copy-rect (rect x1 y1 x2 y2)
3689 "Copy rectangle RECT drawn from X1, Y1 to X2, Y2."
3690 (artist-undraw-rect rect)
3691 (artist-copy-generic x1 y1 x2 y2))
3693 (defun artist-copy-square (square x1 y1 x2 y2)
3694 "Copy a SQUARE drawn from X1, Y1 to X2, Y2 (but made square)."
3695 (artist-undraw-square square)
3696 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
3697 (new-x1 (elt square-corners 0))
3698 (new-y1 (elt square-corners 1))
3699 (new-x2 (elt square-corners 2))
3700 (new-y2 (elt square-corners 3)))
3701 (artist-copy-generic new-x1 new-y1 new-x2 new-y2)))
3703 (defun artist-paste (x y)
3704 "Paste the contents of the copy-buffer at X,Y."
3705 (let ((copy-buf (if artist-interface-with-rect
3706 killed-rectangle
3707 artist-copy-buffer)))
3708 (if (not (null copy-buf))
3709 (while (not (null copy-buf))
3710 (artist-move-to-xy x y)
3711 (artist-replace-string (car copy-buf))
3712 (setq copy-buf (cdr copy-buf))
3713 (setq y (1+ y)))
3714 (message "Nothing to paste"))))
3717 ;;
3718 ;; Flood filling
3719 ;;
3720 (defun artist-ff-too-far-right (x)
3721 "Determine if the position X is too far to the right."
3722 (cond ((numberp artist-flood-fill-right-border)
3723 (> x artist-flood-fill-right-border))
3724 ((eq artist-flood-fill-right-border 'window-width)
3725 (> x (- (window-width) 2)))
3726 ((eq artist-flood-fill-right-border 'fill-column)
3727 (> x fill-column))
3728 (t (error "Invalid value for `artist-flood-fill-right-border'"))))
3730 (defun artist-ff-get-rightmost-from-xy (x y)
3731 "Find the rightmost position in this run, starting at X, Y."
3732 (save-excursion
3733 (let ((char-at-xy (artist-get-char-at-xy-conv x y))
3734 (last-x x))
3735 (setq x (1+ x))
3736 (while (and (not (artist-ff-too-far-right x))
3737 (= char-at-xy (artist-get-char-at-xy-conv x y)))
3738 (setq last-x x)
3739 (setq x (1+ x)))
3740 last-x)))
3742 (defun artist-ff-is-topmost-line (x y)
3743 "Determine whether the position X,Y is on the topmost line or not."
3744 (= y 0))
3746 (defun artist-ff-is-bottommost-line (x y)
3747 "Determine whether the position X,Y is on the bottommost line or not."
3748 (save-excursion
3749 (goto-char (point-max))
3750 (beginning-of-line)
3751 (let ((last-line (artist-current-line)))
3752 (if (= (point) (point-max))
3754 ;; Last line is empty, don't paint on it, report previous line
3755 ;; as last line
3756 (>= y (- last-line 1))
3757 (>= y last-line)))))
3759 (defun artist-flood-fill (x1 y1)
3760 "Flood-fill starting at X1, Y1. Fill with the char in `artist-fill-char'."
3761 (let ((stack nil)
3762 (input-queue nil)
3763 ;; We are flood-filling the area that has this character.
3764 (c (artist-get-char-at-xy-conv x1 y1))
3765 (artist-fill-char (if artist-fill-char-set
3766 artist-fill-char
3767 artist-default-fill-char)))
3769 ;; Fill only if the fill-char is not the same as the character whose
3770 ;; area we are about to fill, or, in other words, don't fill if we
3771 ;; needn't.
3772 (if (not (= c artist-fill-char))
3773 (push (artist-new-coord x1 y1) stack))
3775 (while (not (null stack))
3776 (let* ((coord (pop stack))
3777 (x (artist-coord-get-x coord))
3778 (y (artist-coord-get-y coord))
3780 ;; Here we keep track of the leftmost and rightmost position
3781 ;; for this run
3782 (x-leftmost 0)
3783 (x-rightmost 0)
3784 (last-x 0)
3786 ;; Remember if line above and below are accessible
3787 ;; Lines below the last one, and prior to the first-one
3788 ;; are not accessible.
3789 (lines-above nil)
3790 (lines-below nil)
3792 ;; Remember char for position on line above and below, so we
3793 ;; can find the rightmost positions on the runs.
3794 (last-c-above -1)
3795 (last-c-below -1))
3797 (setq x-rightmost (artist-ff-get-rightmost-from-xy x y))
3798 (setq lines-above (not (artist-ff-is-topmost-line x y)))
3799 (setq lines-below (not (artist-ff-is-bottommost-line x y)))
3800 (setq last-x x-rightmost)
3801 (setq x x-rightmost)
3803 ;; Search line above, push rightmost positions of runs for that line
3804 (while (and (>= x 0) (= c (artist-get-char-at-xy-conv x y)))
3805 (if lines-above
3806 (let ((c-above (artist-get-char-at-xy-conv x (- y 1))))
3807 (if (and (= c-above c) (/= c-above last-c-above))
3808 (push (artist-new-coord x (- y 1)) stack))
3809 (setq last-c-above c-above)))
3810 (setq last-x x)
3811 (setq x (- x 1)))
3813 ;; Remember the left-most position on this run
3814 (setq x-leftmost last-x)
3816 ;; Search line below, push rightmost positions of runs for that line
3817 (setq x x-rightmost)
3818 (while (>= x x-leftmost)
3819 (if lines-below
3820 (let ((c-below (artist-get-char-at-xy-conv x (1+ y))))
3821 (if (and (= c-below c) (/= c-below last-c-below))
3822 (push (artist-new-coord x (1+ y)) stack))
3823 (setq last-c-below c-below)))
3824 (setq x (- x 1)))
3826 (artist-move-to-xy x-leftmost y)
3827 (artist-replace-chars artist-fill-char (1+ (- x-rightmost x-leftmost)))
3829 ;; If we are to show incrementally, we have to remove any pending
3830 ;; input from the input queue, because processing of pending input
3831 ;; always has priority over display updates (although this input
3832 ;; won't be processed until we are done). Later on we will queue
3833 ;; the input on the input queue again.
3834 (if artist-flood-fill-show-incrementally
3835 (progn
3836 (if (input-pending-p)
3837 (discard-input))
3838 (artist-update-display)))))))
3840 ;;
3841 ;; Accessors to arrow-points
3842 ;;
3844 (defun artist-make-arrow-point (x y direction &optional state)
3845 "Create an arrow point at X, Y for a line in direction DIRECTION.
3846 Optional argument STATE can be used to set state (default is nil)."
3847 (save-excursion
3848 (let* ((arrow-point (make-vector 4 0))
3849 (arrow-marker (make-marker)))
3850 (artist-move-to-xy x y)
3851 (set-marker arrow-marker (point))
3852 (aset arrow-point 0 arrow-marker)
3853 (aset arrow-point 1 (artist-get-char-at-xy x y))
3854 (aset arrow-point 2 direction)
3855 (aset arrow-point 3 state)
3856 arrow-point)))
3858 (defsubst artist-arrow-point-get-marker (arrow-point)
3859 "Retrieve the marker component of an ARROW-POINT."
3860 (aref arrow-point 0))
3862 (defsubst artist-arrow-point-get-orig-char (arrow-point)
3863 "Retrieve the orig char component of an ARROW-POINT."
3864 (aref arrow-point 1))
3866 (defsubst artist-arrow-point-get-direction (arrow-point)
3867 "Retrieve the direction component of an ARROW-POINT."
3868 (aref arrow-point 2))
3870 (defsubst artist-arrow-point-get-state (arrow-point)
3871 "Retrieve the state component of an ARROW-POINT."
3872 (aref arrow-point 3))
3874 (defsubst artist-arrow-point-set-state (arrow-point new-state)
3875 "Set the state component of an ARROW-POINT to NEW-STATE."
3876 (aset arrow-point 3 new-state))
3879 (defun artist-clear-arrow-points ()
3880 "Clear current endpoints."
3881 (setq artist-arrow-point-1 nil)
3882 (setq artist-arrow-point-2 nil))
3884 (defun artist-set-arrow-points-for-poly (point-list)
3885 "Generic function for setting arrow-points for poly-shapes from POINT-LIST."
3886 (let* ((ep1 (elt point-list 0))
3887 (ep2 (elt point-list 1))
3888 (x1 (artist-endpoint-get-x ep1))
3889 (y1 (artist-endpoint-get-y ep1))
3890 (x2 (artist-endpoint-get-x ep2))
3891 (y2 (artist-endpoint-get-y ep2))
3892 (dir1 (artist-find-direction x2 y2 x1 y1))
3893 (epn (car (last point-list)))
3894 (epn-1 (car (last point-list 2)))
3895 (xn (artist-endpoint-get-x epn))
3896 (yn (artist-endpoint-get-y epn))
3897 (xn-1 (artist-endpoint-get-x epn-1))
3898 (yn-1 (artist-endpoint-get-y epn-1))
3899 (dirn (artist-find-direction xn-1 yn-1 xn yn)))
3900 (setq artist-arrow-point-1 (artist-make-arrow-point x1 y1 dir1))
3901 (setq artist-arrow-point-2 (artist-make-arrow-point xn yn dirn))))
3904 (defun artist-set-arrow-points-for-2points (shape x1 y1 x2 y2)
3905 "Generic function for setting arrow-points for 2-point shapes.
3906 The 2-point shape SHAPE is drawn from X1, Y1 to X2, Y2."
3907 (let* ((endpoint1 (artist-2point-get-endpoint1 shape))
3908 (endpoint2 (artist-2point-get-endpoint2 shape))
3909 (x1 (artist-endpoint-get-x endpoint1))
3910 (y1 (artist-endpoint-get-y endpoint1))
3911 (x2 (artist-endpoint-get-x endpoint2))
3912 (y2 (artist-endpoint-get-y endpoint2)))
3913 (setq artist-arrow-point-1
3914 (artist-make-arrow-point x1 y1
3915 (artist-find-direction x2 y2 x1 y1)))
3916 (setq artist-arrow-point-2
3917 (artist-make-arrow-point x2 y2
3918 (artist-find-direction x1 y1 x2 y2)))))
3921 ;;
3922 ;; Common routine for drawing/undrawing shapes based
3923 ;; on the draw-how
3924 ;;
3926 (defun artist-key-undraw-continously (x y)
3927 "Undraw current continuous shape with point at X, Y."
3928 ;; No undraw-info for continuous shapes
3929 nil)
3931 (defun artist-key-undraw-poly (x y)
3932 "Undraw current poly shape with point at X, Y."
3933 (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
3934 (x1 (artist-endpoint-get-x artist-key-endpoint1))
3935 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
3936 (artist-funcall undraw-fn artist-key-shape)))
3938 (defun artist-key-undraw-1point (x y)
3939 "Undraw current 1-point shape at X, Y."
3940 ;; No undraw-info for 1-point shapes
3941 nil)
3943 (defun artist-key-undraw-2points (x y)
3944 "Undraw current 2-point shape at X, Y."
3945 (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
3946 (x1 (artist-endpoint-get-x artist-key-endpoint1))
3947 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
3948 (artist-funcall undraw-fn artist-key-shape)))
3950 (defun artist-key-undraw-common ()
3951 "Common routine undrawing current shape."
3952 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go))
3953 (col (artist-current-column))
3954 (row (artist-current-line)))
3956 ;; Depending on what we are currently drawing, call other routines
3957 ;; that knows how to do the job
3958 ;;
3959 (cond ((eq draw-how 'artist-do-continously)
3960 (artist-key-undraw-continously col row))
3961 ((eq draw-how 'artist-do-poly)
3962 (artist-key-undraw-poly col row))
3963 ((and (numberp draw-how) (= draw-how 1))
3964 (artist-key-undraw-1point col row))
3965 ((and (numberp draw-how) (= draw-how 2))
3966 (artist-key-undraw-2points col row))
3969 ;; Now restore the old position
3970 ;;
3971 (artist-move-to-xy col row)))
3975 ;; Implementation note: This really should honor the interval-fn entry
3976 ;; in the master table, `artist-mt', which would mean leaving a timer
3977 ;; that calls `draw-fn' every now and then. That timer would then have
3978 ;; to be canceled and reinstalled whenever the user moves the cursor.
3979 ;; This could be done, but what if the user suddenly switches to another
3980 ;; drawing mode, or even kills the buffer! In the mouse case, it is much
3981 ;; simpler: when at the end of `artist-mouse-draw-continously', the
3982 ;; user has released the button, so the timer will always be canceled
3983 ;; at that point.
3984 (defun artist-key-draw-continously (x y)
3985 "Draw current continuous shape at X,Y."
3986 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)))
3987 (setq artist-key-shape (artist-funcall draw-fn x y))))
3989 (defun artist-key-draw-poly (x y)
3990 "Draw current poly-point shape with nth point at X,Y."
3991 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
3992 (x1 (artist-endpoint-get-x artist-key-endpoint1))
3993 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
3994 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x y))))
3996 (defun artist-key-draw-1point (x y)
3997 "Draw current 1-point shape at X,Y."
3998 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)))
3999 (setq artist-key-shape (artist-funcall draw-fn x y))))
4002 (defun artist-key-draw-2points (x y)
4003 "Draw current 2-point shape at X,Y."
4004 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
4005 (x1 (artist-endpoint-get-x artist-key-endpoint1))
4006 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
4007 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x y))))
4009 (defun artist-key-draw-common ()
4010 "Common routine for drawing current shape."
4011 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go))
4012 (col (artist-current-column))
4013 (row (artist-current-line)))
4015 ;; Depending on what we are currently drawing, call other routines
4016 ;; that knows how to do the job
4017 ;;
4018 (cond ((eq draw-how 'artist-do-continously)
4019 (artist-key-draw-continously col row))
4020 ((eq draw-how 'artist-do-poly)
4021 (artist-key-draw-poly col row))
4022 ((and (numberp draw-how) (= draw-how 1))
4023 (artist-key-draw-1point col row))
4024 ((and (numberp draw-how) (= draw-how 2))
4025 (artist-key-draw-2points col row))
4028 ;; Now restore the old position
4029 ;;
4030 (artist-move-to-xy col row)))
4034 ;;
4035 ;; Functions related to trimming line-endings
4036 ;; The region between the topmost and bottommost visited line is
4037 ;; called a draw-region.
4038 ;;
4040 (defun artist-draw-region-reset ()
4041 "Reset the current draw-region."
4042 (setq artist-draw-region-max-y 0)
4043 (setq artist-draw-region-min-y 1000000))
4045 (defun artist-draw-region-trim-line-endings (min-y max-y)
4046 "Trim lines in current draw-region from MIN-Y to MAX-Y.
4047 Trimming here means removing white space at end of a line."
4048 ;; Safety check: switch min-y and max-y if max-y is smaller
4049 (if (< max-y min-y)
4050 (let ((tmp min-y))
4051 (setq min-y max-y)
4052 (setq max-y tmp)))
4053 (save-excursion
4054 (let ((curr-y min-y))
4055 (while (<= curr-y max-y)
4056 (artist-move-to-xy 0 curr-y)
4057 (end-of-line)
4058 (delete-horizontal-space)
4059 (setq curr-y (1+ curr-y))))))
4061 ;;
4062 ;; Drawing shapes by using keys
4063 ;;
4065 (defun artist-key-do-continously-continously (x y)
4066 "Update current continuous shape at X,Y."
4067 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)))
4068 (artist-funcall draw-fn x y)))
4071 (defun artist-key-do-continously-poly (x y)
4072 "Update current poly-point shape with nth point at X,Y."
4073 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
4074 (undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
4075 (x1 (artist-endpoint-get-x artist-key-endpoint1))
4076 (y1 (artist-endpoint-get-y artist-key-endpoint1))
4077 (x2 x)
4078 (y2 y))
4079 ;; If not rubber-banding, then move the 2
4080 ;; Otherwise re-draw the shape to the new position
4081 ;;
4082 (if (not artist-rubber-banding)
4083 (progn
4084 (artist-no-rb-unset-point2)
4085 (artist-no-rb-set-point2 x y))
4086 (progn
4087 (artist-funcall undraw-fn artist-key-shape)
4088 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))))
4091 (defun artist-key-do-continously-1point (x y)
4092 "Update current 1-point shape at X,Y."
4093 ;; Nothing to do continuously for operations
4094 ;; where we have only one input point
4095 nil)
4097 (defun artist-key-do-continously-2points (x y)
4098 "Update current 2-point shape with 2nd point at X,Y."
4099 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
4100 (undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
4101 (x1 (artist-endpoint-get-x artist-key-endpoint1))
4102 (y1 (artist-endpoint-get-y artist-key-endpoint1))
4103 (x2 x)
4104 (y2 y))
4105 ;; If not rubber-banding, then move the 2
4106 ;; Otherwise re-draw the shape to the new position
4107 ;;
4108 (if (not artist-rubber-banding)
4109 (progn
4110 (artist-no-rb-unset-point2)
4111 (artist-no-rb-set-point2 x y))
4112 (progn
4113 (artist-funcall undraw-fn artist-key-shape)
4114 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))))
4117 (defun artist-key-do-continously-common ()
4118 "Common routine for updating current shape."
4119 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go))
4120 (col (artist-current-column))
4121 (row (artist-current-line)))
4123 ;; Depending on what we are currently drawing, call other routines
4124 ;; that knows how to do the job
4125 ;;
4126 (cond ((eq draw-how 'artist-do-continously)
4127 (artist-key-do-continously-continously col row))
4128 ((eq draw-how 'artist-do-poly)
4129 (artist-key-do-continously-poly col row))
4130 ((and (numberp draw-how) (= draw-how 1))
4131 (artist-key-do-continously-1point col row))
4132 ((and (numberp draw-how) (= draw-how 2))
4133 (artist-key-do-continously-2points col row))
4136 ;; Now restore the old position
4137 ;;
4138 (artist-move-to-xy col row)))
4141 (defun artist-key-set-point-continously (x y)
4142 "Set point for current continuous shape at X,Y."
4143 ;; Maybe set arrow-points for continuous shapes
4144 (let ((arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
4145 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go))
4146 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
4147 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go))
4148 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go)))
4150 (if (not artist-key-is-drawing)
4151 ;; *** We are about to begin drawing
4152 (progn
4153 (artist-funcall init-fn x y))
4155 ;; *** We are about to stop drawing
4156 (progn
4158 (artist-funcall prep-fill-fn x y)
4159 (if (artist-funcall arrow-pred)
4160 (artist-funcall arrow-set-fn x y)
4161 (artist-clear-arrow-points))
4162 (artist-funcall exit-fn x y))))
4164 ;; Toggle the is-drawing flag
4165 (setq artist-key-is-drawing (not artist-key-is-drawing)))
4169 (defun artist-key-set-point-poly (x y &optional this-is-last-point)
4170 "Set point for current poly-point shape at X,Y.
4171 If optional argument THIS-IS-LAST-POINT is non-nil, this point is the last."
4172 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
4173 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
4174 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go))
4175 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
4176 (fill-pred (artist-go-get-fill-pred-from-symbol artist-curr-go))
4177 (fill-fn (artist-go-get-fill-fn-from-symbol artist-curr-go))
4178 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
4179 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go)))
4181 (if (not artist-key-is-drawing)
4183 ;; *** We were not drawing ==> set first point
4184 (progn
4186 (artist-funcall init-fn x y)
4188 ;; If not rubber-banding, set first point.
4189 ;; Otherwise, draw the shape from x,y to x,y
4190 (if (not artist-rubber-banding)
4191 (artist-no-rb-set-point1 x y)
4192 (setq artist-key-shape (artist-funcall draw-fn x y x y)))
4194 ;; Set first endpoint
4195 (setq artist-key-endpoint1 (artist-make-endpoint x y))
4197 ;; Set point-list to contain start point
4198 (setq artist-key-poly-point-list (list (artist-make-endpoint x y)))
4200 ;; Since we are not ready, set the arrow-points to nil
4201 (artist-clear-arrow-points)
4203 ;; Change state to drawing
4204 (setq artist-key-is-drawing t)
4206 ;; Feedback
4207 (message "%s" (substitute-command-keys
4208 (concat "First point set. "
4213 ;; *** We were drawing ==> we are about to set nth point
4214 ;; (last point if the argument this-is-last-point is non-nil)
4215 ;;
4216 (let ((x1 (artist-endpoint-get-x artist-key-endpoint1))
4217 (y1 (artist-endpoint-get-y artist-key-endpoint1))
4218 (x2 x)
4219 (y2 y))
4221 ;; If not rubber-banding, undraw the 1's and 2's, then
4222 ;; draw the shape (if we were rubber-banding, then the
4223 ;; shape is already drawn in artist-key-do-continously-2points.)
4224 ;;
4225 (if (not artist-rubber-banding)
4226 (progn
4227 (artist-no-rb-unset-points)
4228 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))
4230 ;; Set x2 and y2 from shape's second point
4231 ;; (which might be different from the mouse's second point,
4232 ;; if, for example, we are drawing a straight line)
4233 ;;
4234 (if (not (null artist-key-shape))
4235 (let ((endpoint2 (artist-2point-get-endpoint2 artist-key-shape)))
4236 (setq x2 (artist-endpoint-get-x endpoint2))
4237 (setq y2 (artist-endpoint-get-y endpoint2))))
4239 ;; Add the endpoint to the list of poly-points
4240 (setq artist-key-poly-point-list
4241 (append artist-key-poly-point-list
4242 (list (artist-make-endpoint x2 y2))))
4244 ;; Now do handle the case when this is the last point,
4245 ;; and the case when this point isn't the last
4246 ;;
4247 (if (not this-is-last-point)
4248 ;; ** This is not the last point
4249 (progn
4250 ;; Start drawing a new 2-point-shape from last endpoint.
4252 ;; First set the start-point
4253 (setq x1 x2)
4254 (setq y1 y2)
4255 (setq artist-key-endpoint1 (artist-make-endpoint x1 y1))
4257 ;; If we are not rubber-banding, then place the '1
4258 ;; Otherwise, draw the shape from x1,y1 to x1,y1
4259 (if (not artist-rubber-banding)
4260 (artist-no-rb-set-point1 x1 y1)
4261 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x1 y1)))
4263 ;; Feedback
4264 (message "Point set"))
4266 ;; ** This is the last point
4267 (progn
4269 (artist-funcall prep-fill-fn artist-key-poly-point-list)
4271 ;; Maybe fill
4272 (if (artist-funcall fill-pred)
4273 (artist-funcall fill-fn artist-key-shape
4274 artist-key-poly-point-list))
4276 ;; Set the arrow-points
4277 (if (artist-funcall arrow-pred)
4278 (artist-funcall arrow-set-fn artist-key-poly-point-list)
4279 (artist-clear-arrow-points))
4281 (artist-funcall exit-fn artist-key-poly-point-list)
4283 ;; Change state to not drawing
4284 (setq artist-key-shape nil)
4285 (setq artist-key-endpoint1 nil)
4286 (setq artist-key-is-drawing nil)))))))
4289 (defun artist-key-set-point-1point (x y)
4290 "Set point for current 1-point shape at X,Y."
4291 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
4292 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
4293 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go))
4294 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
4295 (draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
4296 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
4297 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go)))
4298 (artist-funcall init-fn x y)
4299 (artist-funcall draw-fn x y)
4300 (artist-funcall prep-fill-fn x y)
4301 (if (artist-funcall arrow-pred)
4302 (artist-funcall arrow-set-fn x y)
4303 (artist-clear-arrow-points))
4304 (artist-funcall exit-fn x y))
4305 (setq artist-key-shape nil)
4306 (setq artist-key-is-drawing nil))
4309 (defun artist-key-set-point-2points (x y)
4310 "Set first or second point in current 2-point shape at X,Y."
4311 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
4312 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
4313 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go))
4314 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
4315 (fill-pred (artist-go-get-fill-pred-from-symbol artist-curr-go))
4316 (fill-fn (artist-go-get-fill-fn-from-symbol artist-curr-go))
4317 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
4318 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go)))
4319 (if (not artist-key-is-drawing)
4321 ;; *** We were not drawing ==> set first point
4322 (progn
4324 (artist-funcall init-fn x y)
4326 ;; If not rubber-banding, set first point.
4327 ;; Otherwise, draw the shape from x,y to x,y
4328 (if (not artist-rubber-banding)
4329 (artist-no-rb-set-point1 x y)
4330 (setq artist-key-shape (artist-funcall draw-fn x y x y)))
4332 ;; Set first endpoint
4333 (setq artist-key-endpoint1 (artist-make-endpoint x y))
4335 ;; Since we are not ready, clear the arrow-points
4336 (artist-clear-arrow-points)
4338 ;; Change state to drawing
4339 (setq artist-key-is-drawing t))
4341 ;; *** We were drawing ==> we are about to set 2nd point
4342 ;; and end the drawing operation
4344 (let ((x1 (artist-endpoint-get-x artist-key-endpoint1))
4345 (y1 (artist-endpoint-get-y artist-key-endpoint1))
4346 (x2 x)
4347 (y2 y))
4349 ;; If not rubber-banding, undraw the 1's and 2's, then
4350 ;; draw the shape (if we were rubber-banding, then the
4351 ;; shape is already drawn in artist-key-do-continously-2points.)
4352 ;;
4353 (if (not artist-rubber-banding)
4354 (progn
4355 (artist-no-rb-unset-points)
4356 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))
4358 (artist-funcall prep-fill-fn artist-key-shape x1 y1 x2 y2)
4360 ;; Maybe fill
4361 ;;
4362 (if (artist-funcall fill-pred)
4363 (artist-funcall fill-fn artist-key-shape x1 y1 x2 y2))
4365 ;; Maybe set the arrow-points
4366 ;;
4367 (if (artist-funcall arrow-pred)
4368 (artist-funcall arrow-set-fn artist-key-shape x1 y1 x2 y2)
4369 (artist-clear-arrow-points))
4371 (artist-funcall exit-fn artist-key-shape x1 y1 x2 y2)
4373 ;; Change state to not drawing
4374 (setq artist-key-is-drawing nil)))))
4377 (defun artist-key-set-point-common (arg)
4378 "Common routine for setting point in current shape.
4379 With non-nil ARG, set the last point."
4380 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go))
4381 (col (artist-current-column))
4382 (row (artist-current-line))
4383 (was-drawing artist-key-is-drawing))
4385 ;; First, if we are about to draw, then reset the draw-region
4386 (if (not artist-key-is-drawing)
4387 (artist-draw-region-reset))
4389 ;; Depending on what we are currently drawing, call other routines
4390 ;; that knows how to do the job
4391 ;;
4392 (cond ((eq draw-how 'artist-do-continously)
4393 (artist-key-set-point-continously col row)
4394 ;; Do this now, otherwise nothing will happen until we move.
4395 (artist-key-do-continously-continously col row))
4396 ((eq draw-how 'artist-do-poly)
4397 (artist-key-set-point-poly col row arg))
4398 ((and (numberp draw-how) (= draw-how 1))
4399 (artist-key-set-point-1point col row))
4400 ((and (numberp draw-how) (= draw-how 2))
4401 (artist-key-set-point-2points col row))
4404 ;; Maybe trim line endings
4405 (if (and artist-trim-line-endings
4406 was-drawing
4407 (not artist-key-is-drawing))
4408 (artist-draw-region-trim-line-endings artist-draw-region-min-y
4409 artist-draw-region-max-y))
4411 ;; Now restore the old position
4412 ;;
4413 (artist-move-to-xy col row)
4414 (artist-mode-line-show-curr-operation artist-key-is-drawing)))
4416 ;;
4417 ;; Key navigation
4418 ;;
4420 (defun artist-previous-line (&optional n)
4421 "Move cursor up N lines (default is 1), updating current shape.
4422 If N is negative, move cursor down."
4423 (interactive "p")
4424 (let ((col (artist-current-column)))
4425 (forward-line (- n))
4426 (move-to-column col t))
4427 (when artist-key-is-drawing
4428 (artist-key-do-continously-common)))
4431 (defun artist-next-line (&optional n)
4432 "Move cursor down N lines (default is 1), updating current shape.
4433 If N is negative, move cursor up."
4434 (interactive "p")
4435 (let ((col (artist-current-column)))
4436 (forward-line n)
4437 (move-to-column col t))
4438 (when artist-key-is-drawing
4439 (artist-key-do-continously-common)))
4441 (defun artist-backward-char (&optional n)
4442 "Move cursor backward N chars (default is 1), updating current shape.
4443 If N is negative, move forward."
4444 (interactive "p")
4445 (if (> n 0)
4446 (artist-forward-char (- n))
4447 (artist-forward-char n)))
4449 (defun artist-forward-char (&optional n)
4450 "Move cursor forward N chars (default is 1), updating current shape.
4451 If N is negative, move backward."
4452 (interactive "p")
4453 (let* ((step-x (if (>= n 0) 1 -1))
4454 (distance (abs n))
4455 (curr-col (artist-current-column))
4456 (new-col (max 0 (+ curr-col (* distance step-x)))))
4457 (if (not artist-key-is-drawing)
4458 (move-to-column new-col t)
4459 (move-to-column new-col t)
4460 (artist-key-do-continously-common))))
4463 (defun artist-key-set-point (&optional arg)
4464 "Set a point for the current shape. With optional ARG, set the last point."
4465 (interactive "P")
4466 (artist-key-set-point-common arg))
4469 (defun artist-select-fill-char (c)
4470 "Set current fill character to be C."
4471 (interactive "cType fill char (type RET to turn off): ")
4473 (message "Fill canceled"))
4474 (t (setq artist-fill-char-set t)
4475 (setq artist-fill-char c)
4479 (defun artist-select-line-char (c)
4480 "Set current line character to be C."
4481 (interactive "cType line char (type RET to turn off): ")
4483 (message "Normal lines"))
4484 (t (setq artist-line-char-set t)
4485 (setq artist-line-char c)
4487 (if artist-key-is-drawing
4488 (artist-key-do-continously-common)))
4491 (defun artist-select-erase-char (c)
4492 "Set current erase character to be C."
4493 (interactive "cType char to use when erasing (type RET for normal): ")
4495 (message "Normal erasing"))
4496 (t (setq artist-erase-char c)
4498 (if artist-key-is-drawing
4499 (artist-key-do-continously-common)))
4501 (defun artist-charlist-to-string (char-list)
4502 "Convert a list of characters, CHAR-LIST, to a string."
4503 (concat char-list))
4505 (defun artist-string-to-charlist (str)
4506 "Convert a string, STR, to list of characters."
4507 (append str nil))
4509 (defun artist-select-spray-chars (chars initial-char)
4510 "Set current spray characters to be CHARS, starting with INITIAL-CHAR."
4511 ;; This huge unreadable `interactive'-clause does the following
4512 ;; 1. Asks for a string of spray-characters
4513 ;; 2. Asks for the initial character (default is the first),
4514 ;; and loops if the answer is not a char within the string in 1.
4515 (interactive
4516 (let* ((str (read-string "Select spray-can characters, lightest first: "
4517 (artist-charlist-to-string artist-spray-chars)))
4518 (char-list (artist-string-to-charlist str))
4519 (initial (let* ((err-msg "")
4520 (ok nil)
4521 (first-char-as-str (char-to-string (car char-list)))
4522 (first-s) (first-c))
4523 (while (not ok)
4524 (setq first-s
4525 (read-string
4526 (format (concat "%sSelect initial-character, "
4528 err-msg str first-char-as-str)))
4529 (if (equal first-s "")
4530 (setq first-s first-char-as-str))
4531 (setq first-c (car (artist-string-to-charlist first-s)))
4532 (setq ok (not (null (member first-c char-list))))
4533 (if (not ok)
4534 (setq err-msg (format
4536 (char-to-string first-c)))))
4537 first-c)))
4538 (list char-list initial)))
4539 (setq artist-spray-chars chars)
4540 (setq artist-spray-new-char initial-char)
4542 (artist-charlist-to-string chars) (char-to-string initial-char)))
4545 (defun artist-select-operation (op-str)
4546 "Select drawing operation OP-STR."
4547 (interactive (list (completing-read "Select operation: "
4548 artist-key-compl-table)))
4549 (let* ((op-symbol (artist-mt-get-symbol-from-keyword op-str))
4550 (draw-how (if op-symbol
4551 (artist-go-get-draw-how-from-symbol op-symbol)
4552 nil)))
4553 ;; First check that the string was valid
4554 (if (null op-symbol)
4555 (error "Unknown drawing method: %s" op-str))
4557 ;; Second, check that we are not about to switch to a different
4558 ;; kind of shape (do that only if we are drawing with keys;
4559 ;; otherwise this function cannot get called).
4560 (if (and artist-key-is-drawing
4561 (not (equal artist-key-draw-how draw-how)))
4562 (error "Cannot switch to a different kind of shape while drawing"))
4564 ;; If we were drawing, undraw the shape
4565 (if (and artist-key-is-drawing
4566 artist-rubber-banding)
4567 (artist-key-undraw-common))
4569 ;; Set the current operation and draw-how
4570 (setq artist-curr-go op-symbol)
4571 (setq artist-key-draw-how draw-how)
4573 ;; If we were drawing, redraw the shape (but don't if shape
4574 ;; is drawn by setting only one point)
4575 (if (and artist-key-is-drawing
4576 artist-rubber-banding
4577 (not (eq artist-key-draw-how 1)))
4578 (artist-key-draw-common)))
4580 ;; Feedback
4581 (artist-mode-line-show-curr-operation artist-key-is-drawing))
4584 (defun artist-toggle-rubber-banding (&optional state)
4585 "Toggle rubber-banding.
4586 If optional argument STATE is positive, turn rubber-banding on."
4587 (interactive)
4588 (if artist-key-is-drawing
4589 (error "Cannot toggle rubber-banding while drawing"))
4590 (if (setq artist-rubber-banding
4591 (if (null state) (not artist-rubber-banding)
4592 (> (prefix-numeric-value state) 0)))
4593 (message "Rubber-banding is now on")
4594 (message "Rubber-banding is now off")))
4597 (defun artist-toggle-trim-line-endings (&optional state)
4598 "Toggle trimming of line-endings.
4599 If optional argument STATE is positive, turn trimming on."
4600 (interactive)
4601 (if (setq artist-trim-line-endings
4602 (if (null state) (not artist-trim-line-endings)
4603 (> (prefix-numeric-value state) 0)))
4604 (message "Trimming is now on")
4605 (message "Trimming is now off")))
4608 (defun artist-toggle-borderless-shapes (&optional state)
4609 "Toggle borders of shapes.
4610 If optional argument STATE is positive, turn borders on."
4611 (interactive)
4612 (if (setq artist-borderless-shapes
4613 (if (null state) (not artist-borderless-shapes)
4614 (> (prefix-numeric-value state) 0)))
4615 (message "Borders are now off")
4616 (message "Borders are now on")))
4619 (defun artist-toggle-first-arrow ()
4620 "Toggle first arrow for shape, if possible."
4621 (interactive)
4622 (save-excursion
4623 (if (not (null artist-arrow-point-1))
4624 (let* ((arrow-point artist-arrow-point-1)
4625 (arrow-state (artist-arrow-point-get-state arrow-point))
4626 (arrow-marker (artist-arrow-point-get-marker arrow-point))
4627 (direction (artist-arrow-point-get-direction arrow-point))
4628 (orig-char (artist-arrow-point-get-orig-char arrow-point))
4629 (arrow-char (aref artist-arrows direction))
4630 (new-state (not arrow-state)))
4632 (goto-char (marker-position arrow-marker))
4634 (if new-state
4635 (if arrow-char
4636 (artist-replace-char arrow-char))
4637 (artist-replace-char orig-char))
4639 (artist-arrow-point-set-state artist-arrow-point-1 new-state)))))
4641 (defun artist-toggle-second-arrow ()
4642 "Toggle second arrow for shape, if possible."
4643 (interactive)
4644 (save-excursion
4645 (if (not (null artist-arrow-point-2))
4646 (let* ((arrow-point artist-arrow-point-2)
4647 (arrow-state (artist-arrow-point-get-state arrow-point))
4648 (arrow-marker (artist-arrow-point-get-marker arrow-point))
4649 (direction (artist-arrow-point-get-direction arrow-point))
4650 (orig-char (artist-arrow-point-get-orig-char arrow-point))
4651 (arrow-char (aref artist-arrows direction))
4652 (new-state (not arrow-state)))
4654 (goto-char (marker-position arrow-marker))
4656 (if new-state
4657 (if arrow-char
4658 (artist-replace-char arrow-char))
4659 (artist-replace-char orig-char))
4661 (artist-arrow-point-set-state artist-arrow-point-2 new-state)))))
4663 (defun artist-select-op-pen-line ()
4664 "Select drawing pen lines."
4665 (interactive)
4666 (artist-select-operation "Pen Line"))
4668 (defun artist-select-op-line ()
4669 "Select drawing lines."
4670 (interactive)
4671 (artist-select-operation "line"))
4673 (defun artist-select-op-straight-line ()
4674 "Select drawing straight lines."
4675 (interactive)
4676 (artist-select-operation "straight line"))
4678 (defun artist-select-op-rectangle ()
4679 "Select drawing rectangles."
4680 (interactive)
4681 (artist-select-operation "rectangle"))
4683 (defun artist-select-op-square ()
4684 "Select drawing squares."
4685 (interactive)
4686 (artist-select-operation "square"))
4688 (defun artist-select-op-poly-line ()
4689 "Select drawing poly-lines."
4690 (interactive)
4691 (artist-select-operation "poly-line"))
4693 (defun artist-select-op-straight-poly-line ()
4694 "Select drawing straight poly-lines."
4695 (interactive)
4696 (artist-select-operation "straight poly-line"))
4698 (defun artist-select-op-ellipse ()
4699 "Select drawing ellipses."
4700 (interactive)
4701 (artist-select-operation "ellipse"))
4703 (defun artist-select-op-circle ()
4704 "Select drawing circles."
4705 (interactive)
4706 (artist-select-operation "circle"))
4708 (defun artist-select-op-text-see-thru ()
4709 "Select rendering text (see thru)."
4710 (interactive)
4711 (artist-select-operation "text see-thru"))
4713 (defun artist-select-op-text-overwrite ()
4714 "Select rendering text (overwrite)."
4715 (interactive)
4716 (artist-select-operation "text overwrite"))
4718 (defun artist-select-op-spray-can ()
4719 "Select spraying."
4720 (interactive)
4721 (artist-select-operation "spray-can"))
4723 (defun artist-select-op-spray-set-size ()
4724 "Select setting size for spraying."
4725 (interactive)
4726 (artist-select-operation "spray set size"))
4728 (defun artist-select-op-erase-char ()
4729 "Select erasing characters."
4730 (interactive)
4731 (artist-select-operation "erase char"))
4733 (defun artist-select-op-erase-rectangle ()
4734 "Select erasing rectangles."
4735 (interactive)
4736 (artist-select-operation "erase rectangle"))
4738 (defun artist-select-op-vaporize-line ()
4739 "Select vaporizing single lines."
4740 (interactive)
4741 (artist-select-operation "vaporize line"))
4743 (defun artist-select-op-vaporize-lines ()
4744 "Select vaporizing connected lines."
4745 (interactive)
4746 (artist-select-operation "vaporize lines"))
4748 (defun artist-select-op-cut-rectangle ()
4749 "Select cutting rectangles."
4750 (interactive)
4751 (artist-select-operation "cut rectangle"))
4753 (defun artist-select-op-cut-square ()
4754 "Select cutting squares."
4755 (interactive)
4756 (artist-select-operation "cut square"))
4758 (defun artist-select-op-copy-rectangle ()
4759 "Select copying rectangles."
4760 (interactive)
4761 (artist-select-operation "copy rectangle"))
4763 (defun artist-select-op-copy-square ()
4764 "Select copying squares."
4765 (interactive)
4766 (artist-select-operation "cut square"))
4768 (defun artist-select-op-paste ()
4769 "Select pasting."
4770 (interactive)
4771 (artist-select-operation "paste"))
4773 (defun artist-select-op-flood-fill ()
4774 "Select flood-filling."
4775 (interactive)
4776 (artist-select-operation "flood-fill"))
4779 ;; Drawing lines by using mouse
4780 ;; Mouse button actions
4781 ;;
4783 (defun artist-update-pointer-shape ()
4784 "Perform the update of the X Windows pointer shape."
4785 (set-mouse-color nil))
4787 (defvar x-pointer-shape)
4789 (defun artist-set-pointer-shape (new-pointer-shape)
4790 "Set the shape of the X Windows pointer to NEW-POINTER-SHAPE."
4791 (setq x-pointer-shape new-pointer-shape)
4792 (artist-update-pointer-shape))
4794 (defsubst artist-event-is-shifted (ev)
4795 "Check whether the shift-key is pressed in event EV."
4796 (memq 'shift (event-modifiers ev)))
4798 (defun artist-do-nothing ()
4799 "Function that does nothing."
4800 (interactive))
4802 (defun artist-compute-up-event-key (ev)
4803 "Compute the corresponding up key sequence for event EV."
4804 (let* ((basic (event-basic-type ev))
4805 (unshifted basic)
4806 (shifted (make-symbol (concat "S-" (symbol-name basic)))))
4807 (if (artist-event-is-shifted ev)
4808 (make-vector 1 shifted)
4809 (make-vector 1 unshifted))))
4811 (defun artist-down-mouse-1 (ev)
4812 "Perform drawing action for event EV."
4813 (interactive "@e")
4814 (let* ((real (artist-go-get-symbol-shift
4815 artist-curr-go (artist-event-is-shifted ev)))
4816 (draw-how (artist-go-get-draw-how-from-symbol real))
4817 ;; Remember original values for draw-region-min-y and max-y
4818 ;; in case we are interrupting a key-draw operation.
4819 (orig-draw-region-min-y artist-draw-region-min-y)
4820 (orig-draw-region-max-y artist-draw-region-max-y)
4821 (orig-pointer-shape (if (eq window-system 'x) x-pointer-shape nil))
4822 (echoq-keystrokes 10000) ; a lot of seconds
4823 ;; Remember original binding for the button-up event to this
4824 ;; button-down event.
4825 (key (artist-compute-up-event-key ev))
4826 (orig-button-up-binding (lookup-key (current-global-map) key)))
4828 (unwind-protect
4829 (progn
4830 (if (eq window-system 'x)
4831 (artist-set-pointer-shape artist-pointer-shape))
4833 ;; Redefine the button-up binding temporarily (the original
4834 ;; binding is restored in the unwind-forms below). This is to
4835 ;; avoid the phenomenon outlined in this scenario:
4836 ;;
4837 ;; 1. A routine which reads something from the mini-buffer (such
4838 ;; as the text renderer) is called from below.
4839 ;; 2. Meanwhile, the users releases the mouse button.
4840 ;; 3. As a (funny :-) coincidence, the binding for the
4841 ;; button-up event is often mouse-set-point, so Emacs
4842 ;; sets the point to where the button was released, which is
4843 ;; in the buffer where the user wants to place the text.
4844 ;; 4. The user types C-x o (or uses the mouse once again)
4845 ;; until he reaches the mini-buffer which is still prompting
4846 ;; for some text to render.
4847 ;;
4848 ;; To do this foolproof, all local and minor-mode maps should
4849 ;; be searched and temporarily changed as well, since they
4850 ;; too might have some binding for the button-up event,
4851 ;; but I hope dealing with the global map will suffice.
4852 (define-key (current-global-map) key 'artist-do-nothing)
4854 (artist-draw-region-reset)
4856 (artist-mode-line-show-curr-operation t)
4858 (cond ((eq draw-how 'artist-do-continously)
4859 (artist-mouse-draw-continously ev))
4860 ((eq draw-how 'artist-do-poly)
4861 (artist-mouse-draw-poly ev))
4862 ((and (numberp draw-how) (= draw-how 1))
4863 (artist-mouse-draw-1point ev))
4864 ((and (numberp draw-how) (= draw-how 2))
4865 (artist-mouse-draw-2points ev))
4867 draw-how)))
4869 (if artist-trim-line-endings
4870 (artist-draw-region-trim-line-endings artist-draw-region-min-y
4871 artist-draw-region-max-y))
4872 (setq artist-draw-region-min-y orig-draw-region-min-y)
4873 (setq artist-draw-region-max-y orig-draw-region-max-y))
4875 ; This is protected
4876 (if (eq window-system 'x)
4877 (artist-set-pointer-shape orig-pointer-shape))
4879 (if orig-button-up-binding
4880 (define-key (current-global-map) key orig-button-up-binding))
4882 (artist-mode-line-show-curr-operation artist-key-is-drawing))))
4885 (defun artist-mouse-choose-operation (ev op)
4886 "Choose operation for event EV and operation OP."
4887 (interactive
4888 (progn
4889 (select-window (posn-window (event-start last-input-event)))
4890 (list last-input-event
4891 (if (display-popup-menus-p)
4892 (x-popup-menu last-nonmenu-event artist-popup-menu-table)
4893 'no-popup-menus))))
4895 (if (eq op 'no-popup-menus)
4896 ;; No popup menus. Call `tmm-prompt' instead, but with the
4897 ;; up-mouse-button, if any, temporarily disabled, otherwise
4898 ;; it'll interfere.
4899 (let* ((key (artist-compute-up-event-key ev))
4900 (orig-button-up-binding (lookup-key (current-global-map) key)))
4901 (unwind-protect
4902 (define-key (current-global-map) key 'artist-do-nothing)
4903 (setq op (tmm-prompt artist-popup-menu-table))
4904 (if orig-button-up-binding
4905 (define-key (current-global-map) key orig-button-up-binding)))))
4907 (let ((draw-fn (artist-go-get-draw-fn-from-symbol (car op)))
4908 (set-fn (artist-fc-get-fn-from-symbol (car op))))
4909 (cond
4911 ;; *** It was a draw-function
4912 ((not (listp draw-fn))
4913 (let* ((unshifted (artist-go-get-symbol-shift (car op) nil))
4914 (shifted (artist-go-get-symbol-shift (car op) t))
4915 (shift-state (artist-event-is-shifted ev))
4916 (selected-op (if shift-state shifted unshifted))
4917 (keyword (artist-go-get-keyword-from-symbol selected-op)))
4918 (artist-select-operation keyword)))
4920 ;; *** It was a set/unset function
4921 ((not (listp set-fn))
4922 (call-interactively set-fn)))))
4925 (defun artist-down-mouse-3 (ev)
4926 "Erase character or rectangle, depending on event EV."
4927 (interactive "@e")
4928 (let ((artist-curr-go 'erase-char))
4929 (artist-down-mouse-1 ev))
4930 ;; Restore mode-line
4931 (artist-mode-line-show-curr-operation artist-key-is-drawing))
4934 ;;
4935 ;; Mouse routines
4936 ;;
4938 (defsubst artist-shift-has-changed (shift-state ev)
4939 "From the last SHIFT-STATE and EV, determine if the shift-state has changed."
4940 ;; This one simply doesn't work.
4941 ;;
4942 ;; There seems to be no way to tell whether the user has pressed shift
4943 ;; while dragging the cursor around when we are in a track-mouse
4944 ;; form. Calling (event-modifiers ev) yields nil :-( Neither is the
4945 ;; (event-basic-type ev) of any help (it is simply `mouse-movement').
4946 ;;
4947 ;; So this doesn't work:
4948 ;; (cond ((and shift-state (not (artist-event-is-shifted ev))) t)
4949 ;; ((and (not shift-state) (artist-event-is-shifted ev)) t)
4950 ;; (t nil))
4951 nil)
4953 (defun artist-coord-win-to-buf (coord)
4954 "Convert a window-relative coordinate COORD to a buffer-relative coordinate."
4955 (let ((window-x (car coord))
4956 (window-y (cdr coord))
4957 (window-start-x (window-hscroll))
4958 (window-start-y (save-excursion (goto-char (window-start))
4959 (artist-current-line))))
4960 (cons (+ window-x window-start-x)
4961 (+ window-y window-start-y))))
4964 (defun artist-mouse-draw-continously (ev)
4965 "Generic function for shapes that require 1 point as input.
4966 Operation is done continuously while the mouse button is hold down.
4967 The event, EV, is the mouse event."
4968 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
4969 (shifted (artist-go-get-symbol-shift artist-curr-go t))
4970 (shift-state (artist-event-is-shifted ev))
4971 (op (if shift-state shifted unshifted))
4972 (draw-how (artist-go-get-draw-how-from-symbol op))
4973 (init-fn (artist-go-get-init-fn-from-symbol op))
4974 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
4975 (exit-fn (artist-go-get-exit-fn-from-symbol op))
4976 (draw-fn (artist-go-get-draw-fn-from-symbol op))
4977 (interval-fn (artist-go-get-interval-fn-from-symbol op))
4978 (interval (artist-funcall interval-fn))
4979 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
4980 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
4981 (ev-start (event-start ev))
4982 (initial-win (posn-window ev-start))
4983 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
4984 (x1 (car ev-start-pos))
4985 (y1 (cdr ev-start-pos))
4986 (shape)
4987 (timer))
4988 (select-window (posn-window ev-start))
4989 (artist-funcall init-fn x1 y1)
4990 (if (not artist-rubber-banding)
4991 (artist-no-rb-set-point1 x1 y1))
4992 (unwind-protect
4993 (track-mouse
4994 ;; We don't want flickering of mouse pointer shape while we
4995 ;; drag the mouse.
4996 (setq track-mouse 'dragging)
4997 (while (or (mouse-movement-p ev)
4998 (member 'down (event-modifiers ev)))
4999 (setq ev-start-pos (artist-coord-win-to-buf
5000 (posn-col-row (event-start ev))))
5001 (setq x1 (car ev-start-pos))
5002 (setq y1 (cdr ev-start-pos))
5004 ;; Cancel previous timer
5005 (if timer
5006 (cancel-timer timer))
5008 (if (not (eq initial-win (posn-window (event-start ev))))
5009 ;; If we moved outside the window, do nothing
5010 nil
5012 ;; Still in same window:
5013 ;;
5014 ;; Check if user presses or releases shift key
5015 (if (artist-shift-has-changed shift-state ev)
5017 ;; First check that the draw-how is the same as we
5018 ;; already have. Otherwise, ignore the changed shift-state.
5019 (if (not (eq draw-how
5020 (artist-go-get-draw-how-from-symbol
5021 (if (not shift-state) shifted unshifted))))
5022 (message "Cannot switch to shifted operation")
5024 ;; progn is "implicit" since this is the else-part
5025 (setq shift-state (not shift-state))
5026 (setq op (if shift-state shifted unshifted))
5027 (setq draw-how (artist-go-get-draw-how-from-symbol op))
5028 (setq draw-fn (artist-go-get-draw-fn-from-symbol op))))
5030 ;; Draw the new shape
5031 (setq shape (artist-funcall draw-fn x1 y1))
5032 (artist-move-to-xy x1 y1)
5034 ;; Start the timer to call `draw-fn' repeatedly every
5035 ;; `interval' second
5036 (if (and interval draw-fn)
5037 (setq timer (run-at-time interval interval draw-fn x1 y1))))
5039 ;; Read next event
5040 (setq ev (read-event))))
5041 ;; Cleanup: get rid of any active timer.
5042 (if timer
5043 (cancel-timer timer)))
5044 ;; Cancel any timers
5045 (if timer
5046 (cancel-timer timer))
5048 (artist-funcall prep-fill-fn x1 y1)
5050 (if (artist-funcall arrow-pred)
5051 (artist-funcall arrow-set-fn x1 y1)
5052 (artist-clear-arrow-points))
5054 (artist-funcall exit-fn x1 y1)
5055 (artist-move-to-xy x1 y1)))
5059 (defun artist-mouse-draw-poly (ev)
5060 "Generic function for shapes requiring several points as input.
5061 The event, EV, is the mouse event."
5062 (interactive "@e")
5063 (message "Mouse-1: set new point, mouse-2: set last point")
5064 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
5065 (shifted (artist-go-get-symbol-shift artist-curr-go t))
5066 (shift-state (artist-event-is-shifted ev))
5067 (op (if shift-state shifted unshifted))
5068 (draw-how (artist-go-get-draw-how-from-symbol op))
5069 (init-fn (artist-go-get-init-fn-from-symbol op))
5070 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
5071 (exit-fn (artist-go-get-exit-fn-from-symbol op))
5072 (draw-fn (artist-go-get-draw-fn-from-symbol op))
5073 (undraw-fn (artist-go-get-undraw-fn-from-symbol op))
5074 (fill-pred (artist-go-get-fill-pred-from-symbol op))
5075 (fill-fn (artist-go-get-fill-fn-from-symbol op))
5076 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
5077 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
5078 (ev-start (event-start ev))
5079 (initial-win (posn-window ev-start))
5080 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
5081 (x1-last (car ev-start-pos))
5082 (y1-last (cdr ev-start-pos))
5083 (x2 x1-last)
5084 (y2 y1-last)
5085 (is-down t)
5086 (shape nil)
5087 (point-list nil)
5088 (done nil))
5089 (select-window (posn-window ev-start))
5090 (artist-funcall init-fn x1-last y1-last)
5091 (if (not artist-rubber-banding)
5092 (artist-no-rb-set-point1 x1-last y1-last))
5093 (track-mouse
5094 (while (not done)
5095 ;; decide what to do
5096 (cond
5098 ;; *** Mouse button is released.
5099 ((and is-down
5100 (or (member 'click (event-modifiers ev))
5101 (member 'drag (event-modifiers ev))))
5102 ;; First, if not rubber-banding, draw the line.
5103 ;;
5104 (if (not artist-rubber-banding)
5105 (progn
5106 (artist-no-rb-unset-points)
5107 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))))
5109 ;; Set the second point to the shape's second point
5110 ;; (which might be different from the mouse's second point,
5111 ;; if, for example, we are drawing a straight line)
5112 ;;
5113 (if (not (null shape))
5114 (let ((endpoint2 (artist-2point-get-endpoint2 shape)))
5115 (setq x1-last (artist-endpoint-get-x endpoint2))
5116 (setq y1-last (artist-endpoint-get-y endpoint2))))
5117 (setq point-list (cons (artist-make-endpoint x1-last y1-last)
5118 point-list))
5119 (setq shape nil)
5120 (setq is-down nil))
5122 ;; *** Mouse button 2 or 3 down
5123 ((and (member 'down (event-modifiers ev))
5124 (or (equal (event-basic-type ev) 'mouse-2)
5125 (equal (event-basic-type ev) 'mouse-3)))
5126 ;; Ignore
5127 nil)
5129 ;; *** Mouse button 2 or 3 released
5130 ((and (or (member 'click (event-modifiers ev))
5131 (member 'drag (event-modifiers ev)))
5132 (or (equal (event-basic-type ev) 'mouse-2)
5133 (equal (event-basic-type ev) 'mouse-3)))
5135 ;; This means the end of our poly-line drawing-session.
5136 ;;
5137 (setq done t))
5139 ;; *** Mouse button 1 went down
5140 ((and (not is-down)
5141 (member 'down (event-modifiers ev))
5142 (equal (event-basic-type ev) 'mouse-1))
5143 ;; Check whether the (possibly new, that depends on if shift
5144 ;; has been pressed or released) symbol has the same draw-how
5145 ;; information as the previous had. If it hasn't, we can't
5146 ;; proceed.
5147 ;;
5148 (if (not (eq draw-how
5149 (artist-go-get-draw-how-from-symbol
5150 (if (not shift-state) shifted unshifted))))
5151 (message "Cannot switch operation")
5152 (progn
5153 ;; Decide operation
5154 ;;
5155 (setq unshifted
5156 (artist-go-get-symbol-shift artist-curr-go nil)
5157 shifted
5158 (artist-go-get-symbol-shift artist-curr-go t)
5159 shift-state (artist-event-is-shifted ev)
5160 op (if shift-state shifted unshifted)
5161 draw-how (artist-go-get-draw-how-from-symbol op)
5162 draw-fn (artist-go-get-draw-fn-from-symbol op)
5163 undraw-fn (artist-go-get-undraw-fn-from-symbol op)
5164 fill-pred (artist-go-get-fill-pred-from-symbol op)
5165 fill-fn (artist-go-get-fill-fn-from-symbol op))
5167 ;; Draw shape from last place to this place
5169 ;; set x2 and y2
5170 ;;
5171 (setq ev-start-pos (artist-coord-win-to-buf
5172 (posn-col-row (event-start ev))))
5173 (setq x2 (car ev-start-pos))
5174 (setq y2 (cdr ev-start-pos))
5176 ;; Draw the new shape (if not rubber-banding, place both marks)
5177 ;;
5178 (if artist-rubber-banding
5179 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))
5180 (progn
5181 (artist-no-rb-set-point1 x1-last y1-last)
5182 (artist-no-rb-set-point2 x2 y2)))
5184 ;; Show new operation in mode-line
5185 (let ((artist-curr-go op))
5186 (artist-mode-line-show-curr-operation t))))
5188 (setq is-down t))
5191 ;; *** Mouse moved, button is down and we are still in orig window
5192 ((and (mouse-movement-p ev)
5193 is-down
5194 (eq initial-win (posn-window (event-start ev))))
5195 ;; Draw shape from last place to this place
5196 ;;
5197 ;; set x2 and y2
5198 (setq ev-start-pos (artist-coord-win-to-buf
5199 (posn-col-row (event-start ev))))
5200 (setq x2 (car ev-start-pos))
5201 (setq y2 (cdr ev-start-pos))
5203 ;; First undraw last shape
5204 ;; (unset last point if not rubberbanding)
5205 ;;
5206 (artist-funcall undraw-fn shape)
5208 ;; Draw the new shape (if not rubberbanding, set 2nd mark)
5209 ;;
5210 (if artist-rubber-banding
5211 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))
5212 (progn
5213 (artist-no-rb-unset-point2)
5214 (artist-no-rb-set-point2 x2 y2)))
5215 ;; Move cursor
5216 (artist-move-to-xy x2 y2))
5218 ;; *** Mouse moved, button is down but we are NOT in orig window
5219 ((and (mouse-movement-p ev)
5220 is-down
5221 (not (eq initial-win (posn-window (event-start ev)))))
5222 ;; Ignore
5223 nil)
5226 ;; *** Moving mouse while mouse button is not down
5227 ((and (mouse-movement-p ev) (not is-down))
5228 ;; don't do anything.
5229 nil)
5232 ;; *** Mouse button 1 went down, first time
5233 ((and is-down
5234 (member 'down (event-modifiers ev))
5235 (equal (event-basic-type ev) 'mouse-1))
5236 ;; don't do anything
5237 nil)
5240 ;; *** Another event
5241 (t
5242 ;; End drawing
5243 ;;
5244 (setq done t)))
5246 ;; Read next event (only if we should not stop)
5247 (if (not done)
5248 (setq ev (read-event)))))
5250 ;; Reverse point-list (last points are cond'ed first)
5251 (setq point-list (reverse point-list))
5253 (artist-funcall prep-fill-fn point-list)
5255 ;; Maybe fill
5256 (if (artist-funcall fill-pred)
5257 (artist-funcall fill-fn point-list))
5259 ;; Maybe set arrow points
5260 (if (and point-list (artist-funcall arrow-pred))
5261 (artist-funcall arrow-set-fn point-list)
5262 (artist-clear-arrow-points))
5264 (artist-funcall exit-fn point-list)
5265 (artist-move-to-xy x2 y2)))
5268 (defun artist-mouse-draw-1point (ev)
5269 "Generic function for shapes requiring only 1 point as input.
5270 Operation is done once. The event, EV, is the mouse event."
5271 (interactive "@e")
5272 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
5273 (shifted (artist-go-get-symbol-shift artist-curr-go t))
5274 (shift-state (artist-event-is-shifted ev))
5275 (op (if shift-state shifted unshifted))
5276 (draw-how (artist-go-get-draw-how-from-symbol op))
5277 (init-fn (artist-go-get-init-fn-from-symbol op))
5278 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
5279 (exit-fn (artist-go-get-exit-fn-from-symbol op))
5280 (draw-fn (artist-go-get-draw-fn-from-symbol op))
5281 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
5282 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
5283 (ev-start (event-start ev))
5284 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
5285 (x1 (car ev-start-pos))
5286 (y1 (cdr ev-start-pos)))
5287 (select-window (posn-window ev-start))
5288 (artist-funcall init-fn x1 y1)
5289 (artist-funcall draw-fn x1 y1)
5290 (artist-funcall prep-fill-fn x1 y1)
5291 (if (artist-funcall arrow-pred)
5292 (artist-funcall arrow-set-fn x1 y1)
5293 (artist-clear-arrow-points))
5294 (artist-funcall exit-fn x1 y1)
5295 (artist-move-to-xy x1 y1)))
5298 (defun artist-mouse-draw-2points (ev)
5299 "Generic function for shapes requiring 2 points as input.
5300 The event, EV, is the mouse event."
5301 (interactive "@e")
5302 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
5303 (shifted (artist-go-get-symbol-shift artist-curr-go t))
5304 (shift-state (artist-event-is-shifted ev))
5305 (op (if shift-state shifted unshifted))
5306 (draw-how (artist-go-get-draw-how-from-symbol op))
5307 (init-fn (artist-go-get-init-fn-from-symbol op))
5308 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
5309 (exit-fn (artist-go-get-exit-fn-from-symbol op))
5310 (draw-fn (artist-go-get-draw-fn-from-symbol op))
5311 (undraw-fn (artist-go-get-undraw-fn-from-symbol op))
5312 (fill-pred (artist-go-get-fill-pred-from-symbol op))
5313 (fill-fn (artist-go-get-fill-fn-from-symbol op))
5314 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
5315 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
5316 (ev-start (event-start ev))
5317 (initial-win (posn-window ev-start))
5318 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
5319 (x1 (car ev-start-pos))
5320 (y1 (cdr ev-start-pos))
5321 (x2)
5322 (y2)
5323 (shape))
5324 (select-window (posn-window ev-start))
5325 (artist-funcall init-fn x1 y1)
5326 (if (not artist-rubber-banding)
5327 (artist-no-rb-set-point1 x1 y1))
5328 (track-mouse
5329 (while (or (mouse-movement-p ev)
5330 (member 'down (event-modifiers ev)))
5331 (setq ev-start-pos (artist-coord-win-to-buf
5332 (posn-col-row (event-start ev))))
5333 (setq x2 (car ev-start-pos))
5334 (setq y2 (cdr ev-start-pos))
5336 (if (not (eq initial-win (posn-window (event-start ev))))
5337 ;; If we moved outside the window, do nothing
5338 nil
5340 ;; Still in same window:
5341 ;;
5342 ;; First undraw last shape (unset last point if not rubberbanding)
5343 (if artist-rubber-banding
5344 (artist-funcall undraw-fn shape)
5345 (artist-no-rb-unset-point2))
5347 ;; Check if user presses or releases shift key
5348 (if (artist-shift-has-changed shift-state ev)
5350 ;; First check that the draw-how is the same as we
5351 ;; already have. Otherwise, ignore the changed shift-state.
5352 (if (not (eq draw-how
5353 (artist-go-get-draw-how-from-symbol
5354 (if (not shift-state) shifted unshifted))))
5355 (message "Cannot switch to shifted operation")
5357 (message "Switching")
5358 ;; progn is "implicit" since this is the else-part
5359 (setq shift-state (not shift-state))
5360 (setq op (if shift-state shifted unshifted))
5361 (setq draw-how (artist-go-get-draw-how-from-symbol op))
5362 (setq draw-fn (artist-go-get-draw-fn-from-symbol op))
5363 (setq undraw-fn (artist-go-get-undraw-fn-from-symbol op))
5364 (setq fill-pred (artist-go-get-fill-pred-from-symbol op))
5365 (setq fill-fn (artist-go-get-fill-fn-from-symbol op))))
5367 ;; Draw the new shape
5368 (if artist-rubber-banding
5369 (setq shape (artist-funcall draw-fn x1 y1 x2 y2))
5370 (artist-no-rb-set-point2 x2 y2))
5371 ;; Move cursor
5372 (artist-move-to-xy x2 y2))
5375 ;; Read next event
5376 (setq ev (read-event))))
5378 ;; If we are not rubber-banding (that is, we were moving around the `2')
5379 ;; draw the shape
5380 (if (not artist-rubber-banding)
5381 (progn
5382 (artist-no-rb-unset-points)
5383 (setq shape (artist-funcall draw-fn x1 y1 x2 y2))))
5385 (artist-funcall prep-fill-fn shape x1 y1 x2 y2)
5387 ;; Maybe fill
5388 (if (artist-funcall fill-pred)
5389 (artist-funcall fill-fn shape x1 y1 x2 y2))
5391 ;; Maybe set arrow-points
5392 (if (artist-funcall arrow-pred)
5393 (artist-funcall arrow-set-fn shape x1 y1 x2 y2)
5394 (artist-clear-arrow-points))
5396 (artist-funcall exit-fn shape x1 y1 x2 y2)
5397 (artist-move-to-xy x2 y2)))
5400 ;;
5401 ;; Bug-report-submitting
5402 ;;
5403 (defun artist-submit-bug-report ()
5404 "Submit via mail a bug report on Artist."
5405 (interactive)
5406 (require 'reporter)
5407 (if (y-or-n-p "Do you want to submit a bug report on Artist? ")
5408 (let ((to artist-maintainer-address)
5409 (vars '(window-system
5410 window-system-version
5411 ;;
5412 artist-rubber-banding
5413 artist-interface-with-rect
5414 artist-aspect-ratio
5415 ;; Now the internal ones
5416 artist-curr-go
5417 artist-key-poly-point-list
5418 artist-key-shape
5419 artist-key-draw-how
5420 artist-arrow-point-1
5421 artist-arrow-point-2)))
5422 ;; Remove those variables from vars that are not bound
5423 (mapc
5424 (function
5425 (lambda (x)
5426 (if (not (and (boundp x) (symbol-value x)))
5427 (setq vars (delq x vars))))) vars)
5428 (reporter-submit-bug-report
5429 artist-maintainer-address
5430 (concat "artist.el " artist-version)
5431 vars
5432 nil nil
5434 "I have a nice bug report on Artist for you! Here it is:")))))
5437 ;;
5438 ;; Now provide this minor mode
5439 ;;
5441 (provide 'artist)
5444 ;;; About adding drawing modes
5445 ;;; --------------------------
5447 ;; If you are going to add a new drawing mode, read the following
5448 ;; sketchy outlines to get started a bit easier.
5449 ;;
5450 ;; 1. If your new drawing mode falls into one of the following
5451 ;; categories, goto point 2, otherwise goto point 3.
5452 ;;
5453 ;; - Modes where the shapes are drawn continuously, as long as
5454 ;; the mouse button is held down (continuous modes).
5455 ;; Example: the erase-char mode, the pen and pen-line modes.
5456 ;;
5457 ;; - Modes where the shape is made up of from 2 points to an
5458 ;; arbitrary number of points (poly-point modes).
5459 ;; Example: the poly-line mode
5460 ;;
5461 ;; - Modes where the shape is made up of 2 points (2-point
5462 ;; modes).
5463 ;; Example: lines, rectangles
5464 ;;
5465 ;; - Modes where the shape is made up of 1 point (1-point
5466 ;; modes). This mode differs from the continuous modes in
5467 ;; that the shape is drawn only once when the mouse button
5468 ;; is pressed.
5469 ;; Examples: paste, a flood-fill, vaporize modes
5470 ;;
5471 ;;
5472 ;; 2. To make it easier and more flexible to program new drawing
5473 ;; modes, you might choose to specify
5474 ;; init-fn: a function to be called at the very beginning
5475 ;; of the drawing phase,
5476 ;; prep-fill-fn: a function to be called before filling,
5477 ;; arrow-set-fn: a function for setting arrows, to be called
5478 ;; after filling, and
5479 ;; exit-fn: a function to be called at the very end of
5480 ;; the drawing phase.
5481 ;; For each of the cases below, the arguments given to the init-fn,
5482 ;; prep-fill-fn, arrow-set-fn and exit-fn are stated.
5483 ;;
5484 ;; If your mode matches the continuous mode or the 1-point mode:
5485 ;;
5486 ;; a. Create a draw-function that draws your shape. Your function
5487 ;; must take x and y as arguments. The return value is not
5488 ;; used.
5489 ;;
5490 ;; b. Add your mode to the master table, `artist-mt'.
5491 ;;
5492 ;; init-fn: x y
5493 ;; prep-fill-fn: x y
5494 ;; arrow-set-fn: x y
5495 ;; exit-fn: x y
5496 ;;
5497 ;; If your mode matches the 2-point mode:
5498 ;;
5499 ;; a. Create one draw-function that draws your shape and one
5500 ;; undraw-function that undraws it.
5501 ;;
5502 ;; The draw-function must take x1, y1, x2 and y2 as
5503 ;; arguments. It must return a list with three elements:
5504 ;; Endpoint1: a vector [x1 y1]
5505 ;; Endpoint2: a vector [x2 y2]
5506 ;; Shapeinfo: all info necessary for your undraw-function to
5507 ;; be able to undraw the shape
5508 ;; Use the artist-endpoint-* accessors to create and inspect
5509 ;; the endpoints.
5510 ;;
5511 ;; If applicable, you must be able to draw your shape without
5512 ;; borders if the `artist-borderless-shapes' is non-nil.
5513 ;; See `artist-draw-rect' for an example.
5514 ;;
5515 ;; The undraw-function must take one argument: the list created
5516 ;; by your draw-function. The return value is not used.
5517 ;;
5518 ;; b. If you want to provide a fill-function, then create a
5519 ;; function that takes 5 arguments: the list created by your
5520 ;; draw-function, x1, y1, x2 and y2. The return value is not
5521 ;; used.
5522 ;;
5523 ;; c. Add your mode to the master table, `artist-mt'.
5524 ;;
5525 ;; init-fn: x1 y1
5526 ;; prep-fill-fn: shape x1 y1 x2 y2
5527 ;; arrow-set-fn: shape x1 y1 x2 y2
5528 ;; exit-fn: shape x1 y1 x2 y2
5529 ;;
5530 ;; If your mode matches the poly-point mode:
5531 ;;
5532 ;; a. Create one draw-function that draws your shape and one
5533 ;; undraw-function that undraws it. The draw- and
5534 ;; undraw-functions are used to draw/undraw a segment of
5535 ;; your poly-point mode between 2 points. The draw- and
5536 ;; undraw-functions are then really 2-point mode functions.
5537 ;; They must take the same arguments and return the same
5538 ;; values as those of the 2-point mode.
5539 ;;
5540 ;; If applicable, you must be able to draw your shape without
5541 ;; borders if the `artist-borderless-shapes' is non-nil.
5542 ;; See `artist-draw-rect' for an example.
5543 ;;
5544 ;; b. If you want to provide a fill-function, then create a
5545 ;; function that takes 1 argument: a list of points where each
5546 ;; point is a vector, [x, y].
5547 ;;
5548 ;; c. Add your mode to the master table, `artist-mt'.
5549 ;;
5550 ;; init-fn: x1 y1
5551 ;; prep-fill-fn: point-list
5552 ;; arrow-set-fn: point-list
5553 ;; exit-fn: point-list
5554 ;;
5555 ;; The arrow-set-fn must set the variables `artist-arrow-point-1'
5556 ;; and `artist-arrow-point-2'. If your mode does not take arrows,
5557 ;; you must set the variables to nil. Use the accessors
5558 ;; artist-arrow-point-* to create and inspect arrow-points.
5559 ;;
5560 ;;
5561 ;; 3. If your mode doesn't match any of the categories, you are facing
5562 ;; a bit more work, and I cannot be as detailed as above. Here is a
5563 ;; brief outline of what you have to do:
5564 ;;
5565 ;; a. Decide on a name for your type of mode. Let's assume that
5566 ;; you decided on `xxx'. Then you should use the draw-how
5567 ;; symbol artist-do-xxx.
5568 ;;
5569 ;; b. Create a function artist-mouse-draw-xxx for drawing with
5570 ;; mouse. It should be called from `artist-down-mouse-1'.
5571 ;;
5572 ;; The all coordinates must be converted from window-relative
5573 ;; to buffer relative before saved or handed over to
5574 ;; any other function. Converting is done with
5575 ;; the function `artist-coord-win-to-buf'.
5576 ;;
5577 ;; It must take care to the `artist-rubber-banding' variable
5578 ;; and perform rubber-banding accordingly. Use the
5579 ;; artist-no-rb-* functions if not rubber-banding.
5580 ;;
5581 ;; If applicable, you must be able to draw your shape without
5582 ;; borders if the `artist-borderless-shapes' is non-nil.
5583 ;; See `artist-draw-rect' for an example.
5584 ;;
5585 ;; You must call the init-fn, the prep-fill-fn, arrow-set-fn
5586 ;; and the exit-fn at the appropriate points.
5587 ;;
5588 ;; When artist-mouse-draw-xxx ends, the shape for your mode
5589 ;; must be completely drawn.
5590 ;;
5591 ;; c. Create functions for drawing with keys:
5592 ;;
5593 ;; - artist-key-set-point-xxx for setting a point in the
5594 ;; mode, to be called from `artist-key-set-point-common'.
5595 ;;
5596 ;; - artist-key-do-continuously-xxx to be called from
5597 ;; `artist-key-do-continuously-common' whenever the user
5598 ;; moves around.
5599 ;;
5600 ;; As for the artist-mouse-draw-xxx, these two functions must
5601 ;; take care to do rubber-banding, borderless shapes and to
5602 ;; set arrows.
5603 ;;
5604 ;; These functions should set the variable `artist-key-shape'
5605 ;; to the shape drawn.
5606 ;;
5607 ;; d. Create artist-key-draw-xxx and artist-key-undraw-xxx for
5608 ;; drawing and undrawing. These are needed when the user
5609 ;; switches operation to draw another shape of the same type
5610 ;; of drawing mode.
5611 ;;
5612 ;; You should provide these functions. You might think that
5613 ;; only you is using your type of mode, so no one will be able
5614 ;; to switch to another operation of the same type of mode,
5615 ;; but someone else might base a new drawing mode upon your
5616 ;; work.
5617 ;;
5618 ;; You must call the init-fn, the prep-fill-fn, arrow-set-fn
5619 ;; and the exit-fn at the appropriate points.
5620 ;;
5621 ;; e. Add your new mode to the master table, `artist-mt'.
5622 ;;
5623 ;;
5624 ;; Happy hacking! Please let me hear if you add any drawing modes!
5625 ;; Don't hesitate to ask me any questions.
5628 ;;; artist.el ends here