1 ;;; artist.el --- draw ascii graphics with your mouse
3 ;; Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc.
5 ;; Author: Tomas Abrahamsson <tab@lysator.liu.se>
6 ;; Maintainer: Tomas Abrahamsson <tab@lysator.liu.se>
9 ;; Release-date: 6-Aug-2004
10 ;; Location: http://www.lysator.liu.se/~tab/artist/
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27 ;; Boston, MA 02110-1301, USA.
34 ;; Artist is an Emacs lisp package that allows you to draw lines,
35 ;; rectangles and ellipses by using your mouse and/or keyboard. The
36 ;; shapes are made up with the ascii characters |, -, / and \.
40 ;; * Intersecting: When a `|' intersects with a `-', a `+' is
41 ;; drawn, like this: | \ /
45 ;; * Rubber-banding: When drawing lines you can interactively see the
46 ;; result while holding the mouse button down and moving the mouse. If
47 ;; your machine is not fast enough (a 386 is a bit to slow, but a
48 ;; pentium is well enough), you can turn this feature off. You will
49 ;; then see 1's and 2's which mark the 1st and 2nd endpoint of the line
52 ;; * Drawing operations: The following drawing operations are implemented:
54 ;; lines straight-lines
56 ;; poly-lines straight poly-lines
58 ;; text (see-thru) text (overwrite)
59 ;; spray-can setting size for spraying
60 ;; vaporize line vaporize lines
61 ;; erase characters erase rectangles
63 ;; Straight lines are lines that go horizontally, vertically or
64 ;; diagonally. Plain lines go in any direction. The operations in
65 ;; the right column are accessed by holding down the shift key while
68 ;; It is possible to vaporize (erase) entire lines and connected lines
69 ;; (rectangles for example) as long as the lines being vaporized are
70 ;; straight and connected at their endpoints. Vaporizing is inspired
71 ;; by the drawrect package by Jari Aalto <jari.aalto@poboxes.com>.
73 ;; * Flood-filling: You can fill any area with a certain character by
76 ;; * Cut copy and paste: You can cut, copy and paste rectangular
77 ;; regions. Artist also interfaces with the rect package (this can be
78 ;; turned off if it causes you any trouble) so anything you cut in
79 ;; artist can be yanked with C-x r y and vice versa.
81 ;; * Drawing with keys: Everything you can do with the mouse, you can
82 ;; also do without the mouse.
84 ;; * Arrows: After having drawn a (straight) line or a (straight)
85 ;; poly-line, you can set arrows on the line-ends by typing < or >.
87 ;; * Aspect-ratio: You can set the variable artist-aspect-ratio to
88 ;; reflect the height-width ratio for the font you are using. Squares
89 ;; and circles are then drawn square/round. Note, that once your
90 ;; ascii-file is shown with font with a different height-width ratio,
91 ;; the squares won't be square and the circles won't be round.
93 ;; * Picture mode compatibility: Artist is picture mode compatible (this
94 ;; can be turned off).
96 ;; See the documentation for the function artist-mode for a detailed
97 ;; description on how to use artist.
100 ;; What about adding my own drawing modes?
101 ;; ---------------------------------------
103 ;; See the short guide at the end of this file.
104 ;; If you add a new drawing mode, send it to me, and I would gladly
105 ;; include in the next release!
110 ;; To use artist, put this in your .emacs:
112 ;; (autoload 'artist-mode "artist" "Enter artist-mode" t)
117 ;; Artist requires Emacs 19.28 or higher.
119 ;; Artist requires the `rect' package (which comes with Emacs) to be
120 ;; loadable, unless the variable `artist-interface-with-rect' is set
123 ;; Artist also requires the Picture mode (which also comes with Emacs)
124 ;; to be loadable, unless the variable `artist-picture-compatibility'
129 ;; The shifted operations are not available when drawing with the mouse
130 ;; in Emacs 19.29 and 19.30.
132 ;; It is not possible to change between shifted and unshifted operation
133 ;; while drawing with the mouse. (See the comment in the function
134 ;; artist-shift-has-changed for further details.)
140 ;; New: Coerced with the artist.el that's in Emacs-21.3.
141 ;; (minor editorial changes)
144 ;; New: Added tool selection via the mouse-wheel
145 ;; Function provided by Andreas Leue <al@sphenon.de>
148 ;; Bugfix: Some operations (the edit menu) got hidden
149 ;; Bugfix: The first arrow for poly-lines was always pointing
151 ;; Changed: Updated with changes made for Emacs 21.1
154 ;; Bugfix: Autoload cookie corrected
157 ;; Changed: More documentation fixes.
158 ;; Bugfix: The arrow characters (`artist-arrows'), which
159 ;; got wrong in 1.1, are now corrected.
162 ;; New: Documentation fixes.
163 ;; Bugfix: Sets next-line-add-newlines to t while in artist-mode.
164 ;; Drawing with keys was confusing without this fix, if
165 ;; next-line-add-newlines was set to nil.
166 ;; Thanks to Tatsuo Furukawa <tatsuo@kobe.hp.com> for this.
169 ;; New: Updated to work with Emacs 21
172 ;; Bugfix: Cursor follows mouse pointer more closely.
173 ;; New: Works with Emacs 20.x
174 ;; New: Variables are customizable
176 ;; 1.1-beta1 21-Apr-1998
177 ;; New: Spray-can (Utterly useless, I believe, but it was fun
178 ;; to implement :-) after an idea by Karl-Johan Karlsson
179 ;; <kj@lysator.liu.se>.
180 ;; New: Freehand drawing (with pen).
181 ;; New: Vaporizing lines.
182 ;; New: Text-rendering using figlet.
183 ;; New: Picture mode compatibility.
184 ;; Changed: All Artist keys now uses the prefix C-c C-a not to conflict
185 ;; with Picture mode.
186 ;; Bugfix: No longer leaves traces of lines when rubberbanding
187 ;; if the buffer auto-scrolls.
188 ;; Bugfix: Infinite loop sometimes when rubberbanding was turned
192 ;; First official release.
198 (defconst artist-version
"1.2.6")
199 (defconst artist-maintainer-address
"tab@lysator.liu.se")
206 (if (and (featurep 'custom
) (fboundp 'custom-declare-variable
))
207 nil
;; We've got what we needed
208 ;; We have the old custom-library, hack around it!
209 (defmacro defgroup
(&rest args
)
211 (defmacro defface
(var values doc
&rest args
)
213 (defmacro defcustom
(var value doc
&rest args
)
214 `(defvar ,var
,value
,doc
))))
217 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
220 "Customization of the Artist mode."
223 (defgroup artist-text nil
224 "Customization of the text rendering."
227 (defcustom artist-rubber-banding t
228 "Interactively do rubber-banding when non-nil."
232 (defcustom artist-first-char ?
1
233 "Character to set at first point when not rubber-banding."
237 (defcustom artist-second-char ?
2
238 "Character to set at second point when not rubber-banding."
242 (defcustom artist-interface-with-rect t
243 "Whether to interface with the rect package or not.
245 Interfacing to the rect package means that the Copy and Paste operations
246 will use the rectangle buffer when accessing the copied area. This means
247 that you can insert a rectangle which is copied using the artist package
250 If this causes any problem for you (for example, if the implementation of
251 the rectangle package changes), you can set this variable to nil, and the
252 artist package will use its own copy buffer."
256 (defvar artist-arrows
[ ?
> nil ?v ?L ?
< nil ?^ nil
]
257 ;; This is a defvar, not a defcustom, since the custom
258 ;; package shows vectors of characters as a vector of integers,
259 ;; which is confusing
260 "A vector of characters to use as arrows.
262 The vector is 8 elements long and contains a character for each
263 direction, or nil if there is no suitable character to use for arrow
266 The directions are as follows:
274 (defcustom artist-aspect-ratio
1
275 "Defines the character height-to-width aspect ratio.
276 This is used when drawing squares and circles. If the height of the"
280 (defcustom artist-trim-line-endings t
281 "Whether or not to remove white-space at end of lines.
283 If non-nil, line-endings are trimmed (that is, extraneous white-space
284 at the end of the line is removed) when the shape is drawn."
289 (defcustom artist-flood-fill-right-border
'window-width
290 "Right edge definition, used when flood-filling.
292 When flood-filling, if the area is not closed off to the right, then
293 flood-filling will fill no more to the right than specified by this
294 variable. This limit is called the fill-border."
296 :type
'(choice (const :tag
"limited to window" window-width
)
297 (const :tag
"limited to value of `fill-column'" fill-column
)))
299 (defcustom artist-flood-fill-show-incrementally t
300 "Whether or not to incrementally update display when flood-filling.
302 If non-nil, incrementally update display when flood-filling.
303 If set to non-nil, this currently implies discarding any input events
304 during the flood-fill."
309 (defcustom artist-ellipse-right-char ?\
)
310 "Character to use at the rightmost position when drawing narrow ellipses.
312 In this figure, it is the right parenthesis (the ``)'' character):
320 (defcustom artist-ellipse-left-char ?\
(
321 "Character to use at the leftmost position when drawing narrow ellipses.
323 In this figure, it is the left parenthesis (the ``('' character):
330 (defcustom artist-picture-compatibility t
331 "Whether or not picture mode compatibility is on."
338 (defcustom artist-vaporize-fuzziness
1
339 "How to vaporize lines that are cut off.
341 Accept this many characters cutting off a line and still treat
344 If `artist-vaporize-fuzziness' is 2, then those will be recognized as
345 lines from A to B (provided you start vaporizing them at the ``*''):
347 A----*------/-----------B
349 A----*----/\\------------B
352 but this one won't, since it is cut off by more than 2 characters:
354 A----*----/\\/----------B
356 (in fact, only the left part (between the A and the leftmost ``/''
357 crossing the line) will be vaporized)"
362 (defvar artist-pointer-shape
(if (eq window-system
'x
) x-pointer-crosshair nil
)
363 "*If in X Windows, use this pointer shape while drawing with the mouse.")
366 (defcustom artist-text-renderer
'artist-figlet
367 "Function for doing text rendering."
372 (defcustom artist-figlet-program
"figlet"
373 "Program to run for `figlet'."
378 (defcustom artist-figlet-default-font
"standard"
379 "Default font for `figlet'."
384 (defcustom artist-figlet-list-fonts-command
385 ;; list files ending with *.flf in any directory printed by the
386 ;; ``figlet -I2'' command. I think this will not produce more than
387 ;; one directory, but it never hurts to be on the safe side...
388 "for dir in `figlet -I2`; do cd $dir; ls *.flf; done"
389 "Command to run to get list of available fonts."
394 (defcustom artist-spray-interval
0.2
395 "Number of seconds between repeated spraying."
400 (defcustom artist-spray-radius
4
401 "Size of the area for spraying."
406 (defvar artist-spray-chars
'(?\ ?. ?- ?
+ ?m ?% ?
* ?
#)
407 ;; This is a defvar, not a defcustom, since the custom
408 ;; package shows lists of characters as a lists of integers,
409 ;; which is confusing
410 "*Characters (``color'') to use when spraying.
411 They should be ordered
412 from the ``lightest'' to the ``heaviest'' since spraying replaces a
413 light character with the next heavier one.")
416 (defvar artist-spray-new-char ?.
417 "*Initial character to use when spraying.
418 This character is used if spraying upon a character that is
419 not in `artist-spray-chars'. The character defined by this variable
420 should be in `artist-spray-chars', or spraying will behave
424 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
425 ;; End of user options
428 ;; Internal variables
430 (defvar artist-mode nil
431 "Non-nil to enable `artist-mode' and nil to disable.")
432 (make-variable-buffer-local 'artist-mode
)
434 (defvar artist-mode-name
" Artist"
435 "Name of artist mode beginning with a space (appears in the mode-line).")
437 (defvar artist-curr-go
'pen-char
438 "Current selected graphics operation.")
439 (make-variable-buffer-local 'artist-curr-go
)
441 (defvar artist-line-char-set nil
442 "Boolean to tell whether user has set some char to use when drawing lines.")
443 (make-variable-buffer-local 'artist-line-char-set
)
445 (defvar artist-line-char nil
446 "Char to use when drawing lines.")
447 (make-variable-buffer-local 'artist-line-char
)
449 (defvar artist-fill-char-set nil
450 "Boolean to tell whether user has set some char to use when filling.")
451 (make-variable-buffer-local 'artist-fill-char-set
)
453 (defvar artist-fill-char nil
454 "Char to use when filling.")
455 (make-variable-buffer-local 'artist-fill-char
)
457 (defvar artist-erase-char ?\s
458 "Char to use when erasing.")
459 (make-variable-buffer-local 'artist-erase-char
)
461 (defvar artist-default-fill-char ?.
462 "Char to use when a fill-char is required but none is set.")
463 (make-variable-buffer-local 'artist-default-fill-char
)
465 ; This variable is not buffer local
466 (defvar artist-copy-buffer nil
469 (defvar artist-draw-region-min-y
0
470 "Line-number for top-most visited line for draw operation.")
471 (make-variable-buffer-local 'artist-draw-region-min-y
)
473 (defvar artist-draw-region-max-y
0
474 "Line-number for bottom-most visited line for draw operation.")
475 (make-variable-buffer-local 'artist-draw-region-max-y
)
477 (defvar artist-borderless-shapes nil
478 "When non-nil, draw shapes without border.
479 The fill char is used instead, if it is set.")
480 (make-variable-buffer-local 'artist-borderless-shapes
)
482 (defvar artist-prev-next-op-alist nil
483 "Assoc list for looking up next and/or previous draw operation.
484 The structure is as follows: (OP . (PREV-OP . NEXT-OP))
485 where the elements are as follows:
486 * OP is an atom: the KEY-SYMBOL in the `artist-mt' structure
487 * PREV-OP and NEXT-OP are strings: the KEYWORD in the `artist-mt' structure
489 This variable is initialized by the artist-make-prev-next-op-alist function.")
492 ;; Make rect available at compile-time
493 (require 'rect
) ; for interfacing with rect
494 (require 'reporter
) ; the bug-reporting tool
495 (require 'picture
)) ; picture mode compatibility
497 (if artist-interface-with-rect
502 (if artist-picture-compatibility
505 ;; Variables that are made local in artist-mode-init
506 (defvar artist-key-is-drawing nil
)
507 (defvar artist-key-endpoint1 nil
)
508 (defvar artist-key-poly-point-list nil
)
509 (defvar artist-key-shape nil
)
510 (defvar artist-key-draw-how nil
)
511 (defvar artist-popup-menu-table nil
)
512 (defvar artist-key-compl-table nil
)
513 (defvar artist-rb-save-data nil
)
514 (defvar artist-arrow-point-1 nil
)
515 (defvar artist-arrow-point-2 nil
)
517 (defvar artist-mode-map
518 (let ((map (make-sparse-keymap)))
519 (setq artist-mode-map
(make-sparse-keymap))
520 (define-key map
[down-mouse-1
] 'artist-down-mouse-1
)
521 (define-key map
[S-down-mouse-1
] 'artist-down-mouse-1
)
522 (define-key map
[down-mouse-2
] 'artist-mouse-choose-operation
)
523 (define-key map
[S-down-mouse-2
] 'artist-mouse-choose-operation
)
524 (define-key map
[down-mouse-3
] 'artist-down-mouse-3
)
525 (define-key map
[S-down-mouse-3
] 'artist-down-mouse-3
)
526 (define-key map
[C-mouse-4
] 'artist-select-prev-op-in-list
)
527 (define-key map
[C-mouse-5
] 'artist-select-next-op-in-list
)
528 (define-key map
"\r" 'artist-key-set-point
) ; return
529 (define-key map
[up] 'artist-previous-line)
530 (define-key map "\C-p" 'artist-previous-line)
531 (define-key map [down] 'artist-next-line)
532 (define-key map "\C-n" 'artist-next-line)
533 (define-key map [left] 'artist-backward-char)
534 (define-key map "\C-b" 'artist-backward-char)
535 (define-key map [right] 'artist-forward-char)
536 (define-key map "\C-f" 'artist-forward-char)
537 (define-key map "<" 'artist-toggle-first-arrow)
538 (define-key map ">" 'artist-toggle-second-arrow)
539 (define-key map "\C-c\C-a\C-e" 'artist-select-erase-char)
540 (define-key map "\C-c\C-a\C-f" 'artist-select-fill-char)
541 (define-key map "\C-c\C-a\C-l" 'artist-select-line-char)
542 (define-key map "\C-c\C-a\C-o" 'artist-select-operation)
543 (define-key map "\C-c\C-a\C-r" 'artist-toggle-rubber-banding)
544 (define-key map "\C-c\C-a\C-t" 'artist-toggle-trim-line-endings)
545 (define-key map "\C-c\C-a\C-s" 'artist-toggle-borderless-shapes)
546 (define-key map "\C-c\C-c" 'artist-mode-off)
547 (define-key map "\C-c\C-al" 'artist-select-op-line)
548 (define-key map "\C-c\C-aL" 'artist-select-op-straight-line)
549 (define-key map "\C-c\C-ar" 'artist-select-op-rectangle)
550 (define-key map "\C-c\C-aR" 'artist-select-op-square)
551 (define-key map "\C-c\C-as" 'artist-select-op-square)
552 (define-key map "\C-c\C-ap" 'artist-select-op-poly-line)
553 (define-key map "\C-c\C-aP" 'artist-select-op-straight-poly-line)
554 (define-key map "\C-c\C-ae" 'artist-select-op-ellipse)
555 (define-key map "\C-c\C-ac" 'artist-select-op-circle)
556 (define-key map "\C-c\C-at" 'artist-select-op-text-see-thru)
557 (define-key map "\C-c\C-aT" 'artist-select-op-text-overwrite)
558 (define-key map "\C-c\C-aS" 'artist-select-op-spray-can)
559 (define-key map "\C-c\C-az" 'artist-select-op-spray-set-size)
560 (define-key map "\C-c\C-a\C-d" 'artist-select-op-erase-char)
561 (define-key map "\C-c\C-aE" 'artist-select-op-erase-rectangle)
562 (define-key map "\C-c\C-av" 'artist-select-op-vaporize-line)
563 (define-key map "\C-c\C-aV" 'artist-select-op-vaporize-lines)
564 (define-key map "\C-c\C-a\C-k" 'artist-select-op-cut-rectangle)
565 (define-key map "\C-c\C-a\M-w" 'artist-select-op-copy-rectangle)
566 (define-key map "\C-c\C-a\C-y" 'artist-select-op-paste)
567 (define-key map "\C-c\C-af" 'artist-select-op-flood-fill)
568 (define-key map "\C-c\C-a\C-b" 'artist-submit-bug-report)
570 "Keymap for `artist-minor-mode'.")
572 (defvar artist-replacement-table (make-vector 256 0)
573 "Replacement table for `artist-replace-char'.")
577 ;;; The table of graphic operations
580 ;; Implementation note: Maybe this should be done using a structure
581 ;; in the cl package?
587 ( "Undo" do-undo undo))
591 ("Pen" (("Pen" pen-char "pen-c"
594 artist-do-continously
597 ("Pen Line" pen-line "pen-l"
598 artist-arrows artist-pen-set-arrow-points
599 artist-pen-reset-last-xy nil nil
600 artist-do-continously
605 ("Line" (("line" line "line"
606 artist-arrows artist-set-arrow-points-for-2points
612 ("straight line" s-line "sline"
613 artist-arrows artist-set-arrow-points-for-2points
621 ("Rectangle" (("rectangle" rect "rect"
627 artist-t-if-fill-char-set artist-fill-rect))
628 ("square" square "square"
633 (artist-undraw-square
634 artist-t-if-fill-char-set artist-fill-square)))))
637 ("Poly-line" (("poly-line" polyline "poly"
638 artist-arrows artist-set-arrow-points-for-poly
644 ("straight poly-line" spolyline "s-poly"
645 artist-arrows artist-set-arrow-points-for-poly
653 ("Ellipse" (("ellipse" ellipse "ellipse"
658 (artist-undraw-ellipse
659 artist-t-if-fill-char-set artist-fill-ellipse))
660 ("circle" circle "circle"
665 (artist-undraw-circle
666 artist-t-if-fill-char-set artist-fill-circle)))))
669 ("Text" (("text see-thru" text-thru "text-thru"
675 ("text overwrite" text-ovwrt "text-ovwrt"
679 artist-text-overwrite
683 ("Spray-can" (("spray-can" spray-can "spray-can"
686 artist-do-continously
688 (artist-spray-get-interval))
689 ("spray set size" spray-get-size "spray-size"
691 nil artist-spray-clear-circle artist-spray-set-radius
694 (artist-undraw-circle
698 ("Erase" (("erase char" erase-char "erase-c"
701 artist-do-continously
704 ("erase rectangle" erase-rect "erase-r"
710 artist-t artist-erase-rect)))))
713 ("Vaporize" (("vaporize line" vaporize-line "vaporize-1"
719 ("vaporize lines" vaporize-lines "vaporize-n"
723 artist-vaporize-lines
729 ("Cut" (("cut rectangle" cut-r "cut-r"
735 artist-t artist-cut-rect)
736 ("cut square" cut-s "cut-s"
741 (artist-undraw-square
742 artist-t artist-cut-square))))))
745 ("Copy" (("copy rectangle" copy-r "copy-r"
751 artist-t artist-copy-rect)
752 ("copy square" copy-s "copy-s"
757 (artist-undraw-square
758 artist-t artist-copy-square))))))
761 ("Paste" (("paste" paste "paste"
767 ("paste" paste "paste"
775 ("Flood-fill" (("flood-fill" flood-fill "flood"
781 ("flood-fill" flood-fill "flood"
791 ("Set Fill" set-fill artist-select-fill-char))
794 ("Set Line" set-line artist-select-line-char))
797 ("Set Erase" set-erase artist-select-erase-char))
800 ("Rubber-banding" rubber-band artist-toggle-rubber-banding))
803 ("Trimming" trimming artist-toggle-trim-line-endings))
806 ("Borders" borders artist-toggle-borderless-shapes))
809 ("Spray-chars" spray-chars artist-select-spray-chars)))))
813 "Master Table for `artist-mode'.
814 This table is primarily a table over the different graphics operations
815 available in artist mode, but it also holds layout information for the
818 The master table is a list of table elements. The elements of this table
823 There are three kinds of TAG:
826 `separator' -- produce a separator in the popup menu
827 `function-call' -- call a function
828 `graphics-operation' -- a graphics operation
830 The layout of the INFO-PART for `menu' is
832 (TITLE ((TAG-1 INFO-PART-1) (TAG-2 INFO-PART-2) ...))
834 TITLE is the title of the submenu; this is followed by a list of
835 menu items, each on the general form (TAG INFO-PART).
838 The layout of the INFO-PART for `separator' is empty and not used.
841 This is the layout of the INFO-PART for `function-call':
845 KEYWORD is a string naming the operation, and appears in the popup menu.
846 SYMBOL is the symbol for the operations.
847 FN is the function performing the operation. This function
848 is called with no arguments. Its return value is ignored.
851 The layout of the INFO-PART for `graphics-operation' is
853 (TITLE (UNSHIFTED SHIFTED))
855 TITLE is the title that appears in the popup menu. UNSHIFTED
856 and SHIFTED specify for unshifted and shifted operation. Both
859 (KEYWORD KEY-SYMBOL MODE-LINE ARROW-PRED ARROW-SET-FN
860 INIT-FN PREP-FILL-FN EXIT-FN DRAW-HOW DRAW-FN EXTRA-DRAW-INFO)
862 KEYWORD is a string specifying the name of the shape to draw.
863 This is used when selecting drawing operation.
864 KEY-SYMBOL is the key which is used when looking up members
865 through the functions `artist-go-get-MEMBER-from-symbol'
866 and `artist-fc-get-MEMBER-from-symbol'.
867 MODE-LINE is a string that appears in the mode-line when drawing
869 ARROW-PRED is a function that is called to find out if the shape
870 can have arrows. The function is called with no arguments and
871 must return nil or t.
872 ARROW-SET-FN is a function that is called to set arrow end-points.
873 Arguments and return values for this funcion are described below.
874 INIT-FN is, if non-nil, a function that is called when the first
875 point of the shape is set. Arguments and return values for
876 this funcion are described below.
877 PREP-FILL-FN is, if non-nil, a function that is called after
878 the last point is set, but before the filling is done.
879 Arguments and return values for this funcion are described below.
880 EXIT-FN is, if non-nil, a function that is called after filling
881 is done. Arguments and return values for this funcion are
883 DRAW-HOW defines the kind of shape. The kinds of shapes are:
884 `artist-do-continously' -- Do drawing operation continously,
885 as long as the mouse button is held down.
886 `artist-do-poly' -- Do drawing operation many times.
887 1 -- Do drawing operation only once.
888 2 -- The drawing operation requires two points.
889 DRAW-FN is the function to call for drawing. Arguments and
890 return values for this funcion are described below.
891 EXTRA-DRAW-INFO the layout of this depends on the value of DRAW-HOW:
892 If DRAW-HOW is `artist-do-continously':
896 INTERVAL-FN is, if non-nil, a function to call for getting
897 an interval between repeated calls to the DRAW-FN.
898 This function is called with no arguments and must
899 return a number, the interval in seconds.
900 If nil, calls to DRAW-FN are done only when the mouse
903 If DRAW-HOW is either `artist-do-poly' or 2:
905 (UNDRAW-FN FILL-PRED FILL-FN)
907 UNDRAW-FN is a function to call for undrawing the shape.
908 Arguments and return values for this funcion are
910 FILL-PRED is a function that is called to find out if the shape
911 can have arrows. The function must take no arguments and
913 FILL-FN is a function to call for filling the shape.
914 Arguments and return values for this funcion are
921 Note! All symbols and keywords (both in the `funcion-call' INFO-PART
922 as well as in the `graphics-operation' INFO-PART) must be unique.
924 The following table describe function arguments and return value
925 for different functions and DRAW-HOWs.
927 If DRAW-HOW is either `artist-do-continously' or 1:
929 INIT-FN X Y ==> ignored
930 PREP-FILL-FN X Y ==> ignored
931 EXIT-FN X Y ==> ignored
932 ARROW-SET-FN X Y ==> ignored
933 DRAW-FN X Y ==> ignored
937 INIT-FN X1 Y1 ==> ignored
938 PREP-FILL-FN X1 Y1 X2 Y2 ==> ignored
939 EXIT-FN X1 Y1 X2 Y2 ==> ignored
940 ARROW-SET-FN X1 Y1 X2 Y2 ==> ignored
941 DRAW-FN X1 Y1 X2 Y2 ==> (ENDPOINT-1 ENDPOINT-2 SHAPE)
942 UNDRAW-FN (ENDPOINT-1 ENDPOINT-2 SHAPE) ==> ignored
943 FILL-FN (ENDPOINT-1 ENDPOINT-2 SHAPE) X1 Y1 X2 Y2 ==> ignored
945 ENDPOINT-1 and ENDPOINT-2 are endpoints which are created with
946 `artist-make-endpoint'
947 SHAPE is an opaque structure, created by the DRAW-FN and intented
948 to be used only by the UNDRAW-FN.
950 If DRAW-HOW is `artist-do-poly':
953 PREP-FILL-FN POINT-LIST
954 ARROW-SET-FN POINT-LIST
956 DRAW-FN X-LAST Y-LAST X-NEW Y-NEW ==> (ENDPOINT-1 ENDPOINT-2 SHAPE)
957 UNDRAW-FN (ENDPOINT-1 ENDPOINT-2 SHAPE)
960 ENDPOINT-1 and ENDPOINT-2 are endpoints which are created with
961 `artist-make-endpoint'.
962 SHAPE is an opaque structure, created by the DRAW-FN and intented
963 to be used only by the UNDRAW-FN.
964 POINT-LIST is a list of vectors [X Y].")
968 ;; Accessors for the master table
971 (defun artist-mt-get-tag (element)
972 "Retrieve the tag component from the master table ELEMENT."
975 (defun artist-mt-get-info-part (element)
976 "Retrieve the info part component from the master table ELEMENT."
979 ;; For the 'graphics-operation info-parts
981 (defsubst artist-go-get-desc (info-part)
982 "Retrieve the description component from a graphics operation INFO-PART."
985 (defsubst artist-go-get-unshifted (info-part)
986 "Retrieve the unshifted info from a graphics operation INFO-PART."
987 (elt (elt info-part 1) 0))
989 (defsubst artist-go-get-shifted (info-part)
990 "Retrieve the shifted info from a graphics operation INFO-PART."
991 (elt (elt info-part 1) 1))
993 (defsubst artist-go-get-keyword (info-variant-part)
994 "Retrieve the keyword component from an INFO-VARIANT-PART.
995 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
996 (elt info-variant-part 0))
998 (defsubst artist-go-get-symbol (info-variant-part)
999 "Retrieve the symbol component from an INFO-VARIANT-PART.
1000 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1001 (elt info-variant-part 1))
1003 (defsubst artist-go-get-mode-line (info-variant-part)
1004 "Retrieve the mode line component from an INFO-VARIANT-PART.
1005 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1006 (elt info-variant-part 2))
1008 (defsubst artist-go-get-arrow-pred (info-variant-part)
1009 "Retrieve the arrow predicate component from an INFO-VARIANT-PART.
1010 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1011 (elt info-variant-part 3))
1013 (defsubst artist-go-get-arrow-set-fn (info-variant-part)
1014 "Retrieve the arrow set component from an INFO-VARIANT-PART.
1015 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1016 (elt info-variant-part 4))
1018 (defsubst artist-go-get-init-fn (info-variant-part)
1019 "Retrieve the init function component from an INFO-VARIANT-PART.
1020 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1021 (elt info-variant-part 5))
1023 (defsubst artist-go-get-prep-fill-fn (info-variant-part)
1024 "Retrieve the fill preparation function component from an INFO-VARIANT-PART.
1025 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1026 (elt info-variant-part 6))
1028 (defsubst artist-go-get-exit-fn (info-variant-part)
1029 "Retrieve the exit component from an INFO-VARIANT-PART.
1030 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1031 (elt info-variant-part 7))
1033 (defsubst artist-go-get-draw-how (info-variant-part)
1034 "Retrieve the draw how component from an INFO-VARIANT-PART.
1035 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1036 (elt info-variant-part 8))
1038 (defsubst artist-go-get-draw-fn (info-variant-part)
1039 "Retrieve the draw function component from an INFO-VARIANT-PART.
1040 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
1041 (elt info-variant-part 9))
1043 (defsubst artist-go-get-undraw-fn (info-variant-part)
1044 "Retrieve the undraw function component from an INFO-VARIANT-PART.
1045 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part.
1046 This interval function component is available only if the `draw-how'
1047 component is other than `artist-do-continously' or 1."
1048 (elt (elt info-variant-part 10) 0))
1050 (defsubst artist-go-get-interval-fn (info-variant-part)
1051 "Retrieve the interval function component from an INFO-VARIANT-PART.
1052 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part.
1053 This interval function component is available only if the `draw-how'
1054 component is `artist-do-continously'."
1055 (elt (elt info-variant-part 10) 0))
1057 (defsubst artist-go-get-fill-pred (info-variant-part)
1058 "Retrieve the fill predicate component from an INFO-VARIANT-PART.
1059 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part.
1060 This interval function component is available only if the `draw-how'
1061 component is other than `artist-do-continously' or 1."
1062 (elt (elt info-variant-part 10) 1))
1064 (defsubst artist-go-get-fill-fn (info-variant-part)
1065 "Retrieve the fill function component from an INFO-VARIANT-PART.
1066 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part.
1067 This interval function component is available only if the `draw-how'
1068 component is other than `artist-do-continously' or 1."
1069 (elt (elt info-variant-part 10) 2))
1071 ;; For the 'function-call info-parts
1073 (defsubst artist-fc-get-keyword (info-part)
1074 "Retrieve the keyword component from a graphics operation INFO-PART."
1077 (defsubst artist-fc-get-symbol (info-part)
1078 "Retrieve the symbol component from a graphics operation INFO-PART."
1081 (defsubst artist-fc-get-fn (info-part)
1082 "Retrieve the function component from a graphics operation INFO-PART."
1085 ;; For the 'menu info-parts
1087 (defsubst artist-mn-get-title (info-part)
1088 "Retrieve the title component from a graphics operation INFO-PART."
1091 (defsubst artist-mn-get-items (info-part)
1092 "Retrieve the items component from a graphics operation INFO-PART."
1095 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1096 ;; mouse wheel cyclic operation selection
1098 (defun artist-get-last-non-nil-op (op-list &optional last-non-nil)
1099 "Find the last non-nil draw operation in OP-LIST.
1100 Optional LAST-NON-NIL will be returned if OP-LIST is nil."
1102 (artist-get-last-non-nil-op (cdr op-list)
1103 (or (car (car op-list)) last-non-nil))
1106 (defun artist-get-first-non-nil-op (op-list)
1107 "Find the first non-nil draw operation in OP-LIST."
1108 (or (car (car op-list)) (artist-get-first-non-nil-op (cdr op-list))))
1110 (defun artist-is-in-op-list-p (op op-list)
1111 "Check whether OP is in OP-LIST."
1113 (or (and (car (car op-list)) (string= op (car (car op-list))))
1114 (artist-is-in-op-list-p op (cdr op-list)))))
1116 (defun artist-make-prev-next-op-alist (op-list
1118 last-non-nil-arg first-non-nil-arg
1119 prev-entry prev-op-arg)
1120 "Build an assoc-list of OP-LIST.
1121 The arguments LAST-NON-NIL-ARG, FIRST-NON-NIL-ARG, PREV-ENTRY and
1122 PREV-OP-ARG are used when invoked recursively during the build-up."
1123 (let* ((last-non-nil (or last-non-nil-arg
1124 (artist-get-last-non-nil-op
1125 artist-key-compl-table)))
1126 (first-non-nil (or first-non-nil-arg
1127 (artist-get-first-non-nil-op
1128 artist-key-compl-table)))
1129 (prev-op (or prev-op-arg last-non-nil))
1130 (op (car (car op-list)))
1131 (opsym (artist-mt-get-symbol-from-keyword op))
1132 (entry (cons opsym (cons prev-op nil))))
1133 (if (or (and op-list (not op))
1134 (artist-is-in-op-list-p op (cdr op-list)))
1135 (artist-make-prev-next-op-alist (cdr op-list)
1136 last-non-nil first-non-nil
1138 (if prev-entry (setcdr (cdr prev-entry) op))
1140 (cons entry (artist-make-prev-next-op-alist
1142 last-non-nil first-non-nil
1144 (progn (setcdr (cdr prev-entry) first-non-nil) nil)))))
1146 (defun artist-select-next-op-in-list ()
1147 "Cyclically select next drawing mode operation."
1149 (let ((next-op (cdr (cdr (assoc artist-curr-go artist-prev-next-op-alist)))))
1150 (artist-select-operation next-op)
1153 (defun artist-select-prev-op-in-list ()
1154 "Cyclically select previous drawing mode operation."
1156 (let ((prev-op (car (cdr (assoc artist-curr-go artist-prev-next-op-alist)))))
1157 (artist-select-operation prev-op)
1160 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1162 ;;; ---------------------------------
1164 ;;; ---------------------------------
1167 (defun artist-mode (&optional state)
1168 "Toggle artist mode. With arg, turn artist mode on if arg is positive.
1169 Artist lets you draw lines, squares, rectangles and poly-lines, ellipses
1170 and circles with your mouse and/or keyboard.
1172 How to quit artist mode
1174 Type \\[artist-mode-off] to quit artist-mode.
1177 How to submit a bug report
1179 Type \\[artist-submit-bug-report] to submit a bug report.
1182 Drawing with the mouse:
1185 shift mouse-2 Pops up a menu where you can select what to draw with
1186 mouse-1, and where you can do some settings (described
1190 shift mouse-1 Draws lines, rectangles or poly-lines, erases, cuts, copies
1193 Operation Not shifted Shifted
1194 --------------------------------------------------------------
1195 Pen fill-char at point line from last point
1197 --------------------------------------------------------------
1198 Line Line in any direction Straight line
1199 --------------------------------------------------------------
1200 Rectangle Rectangle Square
1201 --------------------------------------------------------------
1202 Poly-line Poly-line in any dir Straight poly-lines
1203 --------------------------------------------------------------
1204 Ellipses Ellipses Circles
1205 --------------------------------------------------------------
1206 Text Text (see thru) Text (overwrite)
1207 --------------------------------------------------------------
1208 Spray-can Spray-can Set size for spray
1209 --------------------------------------------------------------
1210 Erase Erase character Erase rectangle
1211 --------------------------------------------------------------
1212 Vaporize Erase single line Erase connected
1214 --------------------------------------------------------------
1215 Cut Cut rectangle Cut square
1216 --------------------------------------------------------------
1217 Copy Copy rectangle Copy square
1218 --------------------------------------------------------------
1220 --------------------------------------------------------------
1221 Flood-fill Flood-fill Flood-fill
1222 --------------------------------------------------------------
1224 * Straight lines can only go horizontally, vertically
1227 * Poly-lines are drawn while holding mouse-1 down. When you
1228 release the button, the point is set. If you want a segment
1229 to be straight, hold down shift before pressing the
1230 mouse-1 button. Click mouse-2 or mouse-3 to stop drawing
1233 * See thru for text means that text already in the buffer
1234 will be visible through blanks in the text rendered, while
1235 overwrite means the opposite.
1237 * Vaporizing connected lines only vaporizes lines whose
1238 _endpoints_ are connected. See also the variable
1239 `artist-vaporize-fuzziness'.
1241 * Cut copies, then clears the rectangle/square.
1243 * When drawing lines or poly-lines, you can set arrows.
1244 See below under ``Arrows'' for more info.
1246 * The mode line shows the currently selected drawing operation.
1247 In addition, if it has an asterisk (*) at the end, you
1248 are currently drawing something.
1250 * Be patient when flood-filling -- large areas take quite
1254 mouse-3 Erases character under pointer
1255 shift mouse-3 Erases rectangle
1260 Set fill Sets the character used when filling rectangles/squares
1262 Set line Sets the character used when drawing lines
1264 Erase char Sets the character used when erasing
1266 Rubber-banding Toggles rubber-banding
1268 Trimming Toggles trimming of line-endings (that is: when the shape
1269 is drawn, extraneous white-space at end of lines is removed)
1271 Borders Toggles the drawing of line borders around filled shapes.
1276 \\[artist-key-set-point] Does one of the following:
1277 For lines/rectangles/squares: sets the first/second endpoint
1278 For poly-lines: sets a point (use C-u \\[artist-key-set-point] to set last point)
1279 When erase characters: toggles erasing
1280 When cutting/copying: Sets first/last endpoint of rect/square
1281 When pasting: Pastes
1283 \\[artist-select-operation] Selects what to draw
1285 Move around with \\[artist-next-line], \\[artist-previous-line], \\[artist-forward-char] and \\[artist-backward-char].
1287 \\[artist-select-fill-char] Sets the charater to use when filling
1288 \\[artist-select-line-char] Sets the charater to use when drawing
1289 \\[artist-select-erase-char] Sets the charater to use when erasing
1290 \\[artist-toggle-rubber-banding] Toggles rubber-banding
1291 \\[artist-toggle-trim-line-endings] Toggles trimming of line-endings
1292 \\[artist-toggle-borderless-shapes] Toggles borders on drawn shapes
1297 \\[artist-toggle-first-arrow] Sets/unsets an arrow at the beginning
1298 of the line/poly-line
1300 \\[artist-toggle-second-arrow] Sets/unsets an arrow at the end
1301 of the line/poly-line
1306 There are some keys for quickly selecting drawing operations:
1308 \\[artist-select-op-line] Selects drawing lines
1309 \\[artist-select-op-straight-line] Selects drawing straight lines
1310 \\[artist-select-op-rectangle] Selects drawing rectangles
1311 \\[artist-select-op-square] Selects drawing squares
1312 \\[artist-select-op-poly-line] Selects drawing poly-lines
1313 \\[artist-select-op-straight-poly-line] Selects drawing straight poly-lines
1314 \\[artist-select-op-ellipse] Selects drawing ellipses
1315 \\[artist-select-op-circle] Selects drawing circles
1316 \\[artist-select-op-text-see-thru] Selects rendering text (see thru)
1317 \\[artist-select-op-text-overwrite] Selects rendering text (overwrite)
1318 \\[artist-select-op-spray-can] Spray with spray-can
1319 \\[artist-select-op-spray-set-size] Set size for the spray-can
1320 \\[artist-select-op-erase-char] Selects erasing characters
1321 \\[artist-select-op-erase-rectangle] Selects erasing rectangles
1322 \\[artist-select-op-vaporize-line] Selects vaporizing single lines
1323 \\[artist-select-op-vaporize-lines] Selects vaporizing connected lines
1324 \\[artist-select-op-cut-rectangle] Selects cutting rectangles
1325 \\[artist-select-op-copy-rectangle] Selects copying rectangles
1326 \\[artist-select-op-paste] Selects pasting
1327 \\[artist-select-op-flood-fill] Selects flood-filling
1332 This is a brief overview of the different varaibles. For more info,
1333 see the documentation for the variables (type \\[describe-variable] <variable> RET).
1335 artist-rubber-banding Interactively do rubber-banding or not
1336 artist-first-char What to set at first/second point...
1337 artist-second-char ...when not rubber-banding
1338 artist-interface-with-rect If cut/copy/paste should interface with rect
1339 artist-arrows The arrows to use when drawing arrows
1340 artist-aspect-ratio Character height-to-width for squares
1341 artist-trim-line-endings Trimming of line endings
1342 artist-flood-fill-right-border Right border when flood-filling
1343 artist-flood-fill-show-incrementally Update display while filling
1344 artist-pointer-shape Pointer shape to use while drawing
1345 artist-ellipse-left-char Character to use for narrow ellipses
1346 artist-ellipse-right-char Character to use for narrow ellipses
1347 artist-borderless-shapes If shapes should have borders
1348 artist-picture-compatibility Whether or not to be picture mode compatible
1349 artist-vaporize-fuzziness Tolerance when recognizing lines
1350 artist-spray-interval Seconds between repeated sprayings
1351 artist-spray-radius Size of the spray-area
1352 artist-spray-chars The spray-``color''
1353 artist-spray-new-chars Initial spray-``color''
1357 When entering artist-mode, the hook `artist-mode-init-hook' is called.
1358 When quitting artist-mode, the hook `artist-mode-exit-hook' is called.
1363 \\{artist-mode-map}"
1365 (if (setq artist-mode
1366 (if (null state) (not artist-mode)
1367 (> (prefix-numeric-value state) 0)))
1369 (artist-mode-exit)))
1371 ;; insert our minor mode string
1372 (or (assq 'artist-mode minor-mode-alist)
1373 (setq minor-mode-alist
1374 (cons '(artist-mode artist-mode-name)
1377 ;; insert our minor mode keymap
1378 (or (assq 'artist-mode minor-mode-map-alist)
1379 (setq minor-mode-map-alist
1380 (cons (cons 'artist-mode artist-mode-map)
1381 minor-mode-map-alist)))
1385 (defun artist-mode-init ()
1386 "Init Artist mode. This will call the hook `artist-mode-init-hook'."
1389 (aset artist-replacement-table i i)
1391 (aset artist-replacement-table ?\n ?\ )
1392 (aset artist-replacement-table ?\t ?\ )
1393 (aset artist-replacement-table 0 ?\ )
1394 (make-local-variable 'artist-key-is-drawing)
1395 (make-local-variable 'artist-key-endpoint1)
1396 (make-local-variable 'artist-key-poly-point-list)
1397 (make-local-variable 'artist-key-shape)
1398 (make-local-variable 'artist-key-draw-how)
1399 (make-local-variable 'artist-popup-menu-table)
1400 (make-local-variable 'artist-key-compl-table)
1401 (make-local-variable 'artist-prev-next-op-alist)
1402 (make-local-variable 'artist-rb-save-data)
1403 (make-local-variable 'artist-arrow-point-1)
1404 (make-local-variable 'artist-arrow-point-2)
1405 (setq artist-key-is-drawing nil)
1406 (setq artist-key-endpoint1 nil)
1407 (setq artist-key-poly-point-list nil)
1408 (setq artist-key-shape nil)
1409 (setq artist-popup-menu-table (artist-compute-popup-menu-table artist-mt))
1410 (setq artist-key-compl-table (artist-compute-key-compl-table artist-mt))
1411 (setq artist-prev-next-op-alist
1412 (artist-make-prev-next-op-alist artist-key-compl-table))
1413 (setq artist-rb-save-data (make-vector 7 0))
1414 (setq artist-arrow-point-1 nil)
1415 (setq artist-arrow-point-2 nil)
1416 (make-local-variable 'next-line-add-newlines)
1417 (setq next-line-add-newlines t)
1418 (setq artist-key-draw-how
1419 (artist-go-get-draw-how-from-symbol artist-curr-go))
1420 (if (and artist-picture-compatibility (not (eq major-mode 'picture-mode)))
1424 (run-hooks 'artist-mode-init-hook)
1425 (artist-mode-line-show-curr-operation artist-key-is-drawing))
1427 (defun artist-mode-exit ()
1428 "Exit Artist mode. This will call the hook `artist-mode-exit-hook'."
1429 (if (and artist-picture-compatibility (eq major-mode 'picture-mode))
1430 (picture-mode-exit))
1431 (kill-local-variable 'next-line-add-newlines)
1432 (run-hooks 'artist-mode-exit-hook))
1434 (defun artist-mode-off ()
1435 "Turn Artist mode off."
1438 (force-mode-line-update))
1444 (defun artist-update-display ()
1445 "Repaint the display."
1448 (defun artist-mode-line-show-curr-operation (is-drawing)
1449 "Show current operation in mode-line. If IS-DRAWING, show that."
1450 (let ((mtext (concat artist-mode-name "/"
1451 (artist-go-get-mode-line-from-symbol artist-curr-go)
1452 (if is-drawing "/*" ""))))
1453 (setcdr (assq 'artist-mode minor-mode-alist) (list mtext)))
1454 (force-mode-line-update))
1457 (defun artist-t-if-fill-char-set ()
1458 "Return the value of the variable `artist-fill-char-set'."
1459 artist-fill-char-set)
1465 (defun artist-nil ()
1466 "Always return nil."
1469 (defun artist-arrows ()
1470 "Say yes to arrows!"
1473 (defun artist-no-arrows ()
1478 ;; Auxiliary init-routines
1482 ; Computing the table for the x-popup-menu from the master table
1485 (defun artist-compute-popup-menu-table (menu-table)
1486 "Create a menu from from MENU-TABLE data.
1487 The returned value is suitable for the `x-popup-menu' function."
1489 (artist-compute-popup-menu-table-sub menu-table)))
1491 (defun artist-compute-popup-menu-table-sub (menu-table)
1492 "Compute operation table suitable for `x-popup-menu' from MENU-TABLE."
1495 (let ((element-tag (artist-mt-get-tag element)))
1496 (cond ((eq element-tag 'graphics-operation)
1497 (let* ((info-part (artist-mt-get-info-part element))
1498 (descr (artist-go-get-desc info-part))
1499 (unshifted (artist-go-get-unshifted info-part))
1500 (symbol (artist-go-get-symbol unshifted)))
1501 (list descr symbol)))
1503 ((eq element-tag 'function-call)
1504 (let* ((info-part (artist-mt-get-info-part element))
1505 (keyword (artist-fc-get-keyword info-part))
1506 (symbol (artist-fc-get-symbol info-part)))
1507 (list keyword symbol)))
1509 ((eq element-tag 'separator)
1512 ((eq element-tag 'menu)
1513 (let* ((info-part (artist-mt-get-info-part element))
1514 (title (artist-mn-get-title info-part))
1515 (items (artist-mn-get-items info-part)))
1516 (cons title (artist-compute-popup-menu-table-sub items))))
1519 (error "Internal error: unknown element-tag: \"%s\""
1524 ; Computing the completion table from the master table
1527 (defun artist-compute-key-compl-table (menu-table)
1528 "Compute completion table from MENU-TABLE, suitable for `completing-read'."
1534 (let ((element-tag (artist-mt-get-tag element)))
1535 (cond ((eq element-tag 'graphics-operation)
1536 (let* ((info-part (artist-mt-get-info-part element))
1537 (unshifted (artist-go-get-unshifted info-part))
1538 (shifted (artist-go-get-shifted info-part))
1539 (unshifted-kwd (artist-go-get-keyword unshifted))
1540 (shifted-kwd (artist-go-get-keyword shifted)))
1541 (list (list unshifted-kwd) (list shifted-kwd))))
1542 ((eq element-tag 'menu)
1543 (let* ((info-part (artist-mt-get-info-part element))
1544 (items (artist-mn-get-items info-part)))
1545 (artist-compute-key-compl-table items)))
1552 ; Retrieving a symbol (graphics operation or function-call) from a keyword
1555 (defun artist-mt-get-symbol-from-keyword (kwd)
1556 "Search master table for keyword KWD and return its symbol."
1557 (artist-mt-get-symbol-from-keyword-sub artist-mt kwd))
1559 (defun artist-mt-get-symbol-from-keyword-sub (table kwd)
1560 "Search TABLE for keyword KWD and return its symbol."
1564 (let ((element-tag (artist-mt-get-tag element)))
1565 (cond ((eq element-tag 'graphics-operation)
1566 (let* ((info-part (artist-mt-get-info-part element))
1567 (unshifted (artist-go-get-unshifted info-part))
1568 (shifted (artist-go-get-shifted info-part))
1569 (unshifted-kwd (artist-go-get-keyword unshifted))
1570 (shifted-kwd (artist-go-get-keyword shifted))
1571 (unshifted-sym (artist-go-get-symbol unshifted))
1572 (shifted-sym (artist-go-get-symbol shifted)))
1573 (if (string-equal kwd unshifted-kwd)
1574 (throw 'found unshifted-sym))
1575 (if (string-equal kwd shifted-kwd)
1576 (throw 'found shifted-sym))))
1578 ((eq element-tag 'function-call)
1579 (let* ((info-part (artist-mt-get-info-part element))
1580 (keyword (artist-fc-get-keyword info-part))
1581 (symbol (artist-fc-get-symbol info-part)))
1582 (if (string-equal kwd keyword)
1583 (throw 'found symbol))))
1584 ((eq element-tag 'menu)
1585 (let* ((info-part (artist-mt-get-info-part element))
1586 (items (artist-mn-get-items info-part))
1587 (answer (artist-mt-get-symbol-from-keyword-sub
1589 (if answer (throw 'found answer))))
1597 ; Retrieving info from a graphics operation symbol
1600 (defun artist-go-retrieve-from-symbol (symbol retrieve-fn)
1601 "Search the master table for a graphics operation SYMBOL.
1602 Calls RETRIEVE-FN to retrieve information from that symbol's
1604 (artist-go-retrieve-from-symbol-sub artist-mt symbol retrieve-fn))
1606 (defun artist-go-retrieve-from-symbol-sub (table symbol retrieve-fn)
1607 "Search the TABLE for a graphics operation SYMBOL.
1608 Calls RETRIEVE-FN to retrieve information from that symbol's
1613 (let ((element-tag (artist-mt-get-tag element)))
1614 (cond ((eq element-tag 'graphics-operation)
1615 (let* ((info-part (artist-mt-get-info-part element))
1616 (unshifted (artist-go-get-unshifted info-part))
1617 (shifted (artist-go-get-shifted info-part))
1618 (unshifted-sym (artist-go-get-symbol unshifted))
1619 (shifted-sym (artist-go-get-symbol shifted))
1621 ((eq unshifted-sym symbol) unshifted)
1622 ((eq shifted-sym symbol) shifted)
1624 (if variant-part ; if found do:
1625 (throw 'found (funcall retrieve-fn variant-part)))))
1627 ((eq element-tag 'menu)
1628 (let* ((info-part (artist-mt-get-info-part element))
1629 (items (artist-mn-get-items info-part))
1630 (answer (artist-go-retrieve-from-symbol-sub
1631 items symbol retrieve-fn)))
1632 (if answer (throw 'found answer)))))))
1637 (defun artist-go-get-keyword-from-symbol (symbol)
1638 "Search the master table, get keyword from a graphics operation SYMBOL."
1639 (artist-go-retrieve-from-symbol symbol 'artist-go-get-keyword))
1641 (defun artist-go-get-mode-line-from-symbol (symbol)
1642 "Search the master table, get mode-line from a graphics operation SYMBOL."
1643 (artist-go-retrieve-from-symbol symbol 'artist-go-get-mode-line))
1645 (defun artist-go-get-arrow-pred-from-symbol (symbol)
1646 "Search the master table, get arrow-pred from a graphics operation SYMBOL."
1647 (artist-go-retrieve-from-symbol symbol 'artist-go-get-arrow-pred))
1649 (defun artist-go-get-arrow-set-fn-from-symbol (symbol)
1650 "Search the master table, get arrow-set-fn from a graphics operation SYMBOL."
1651 (artist-go-retrieve-from-symbol symbol 'artist-go-get-arrow-set-fn))
1653 (defun artist-go-get-init-fn-from-symbol (symbol)
1654 "Search the master table, get init-fn from a graphics operation SYMBOL."
1655 (artist-go-retrieve-from-symbol symbol 'artist-go-get-init-fn))
1657 (defun artist-go-get-prep-fill-fn-from-symbol (symbol)
1658 "Search the master table, get prep-fill-fn from a graphics operation SYMBOL."
1659 (artist-go-retrieve-from-symbol symbol 'artist-go-get-prep-fill-fn))
1661 (defun artist-go-get-exit-fn-from-symbol (symbol)
1662 "Search the master table, get exit-fn from a graphics operation SYMBOL."
1663 (artist-go-retrieve-from-symbol symbol 'artist-go-get-exit-fn))
1665 (defun artist-go-get-draw-fn-from-symbol (symbol)
1666 "Search the master table, get draw-fn from a graphics operation SYMBOL."
1667 (artist-go-retrieve-from-symbol symbol 'artist-go-get-draw-fn))
1669 (defun artist-go-get-draw-how-from-symbol (symbol)
1670 "Search the master table, get draw-how from a graphics operation SYMBOL."
1671 (artist-go-retrieve-from-symbol symbol 'artist-go-get-draw-how))
1673 (defun artist-go-get-undraw-fn-from-symbol (symbol)
1674 "Search the master table, get undraw-fn from a graphics operation SYMBOL."
1675 (artist-go-retrieve-from-symbol symbol 'artist-go-get-undraw-fn))
1677 (defun artist-go-get-interval-fn-from-symbol (symbol)
1678 "Search the master table, get interval-fn from a graphics operation SYMBOL."
1679 (artist-go-retrieve-from-symbol symbol 'artist-go-get-interval-fn))
1681 (defun artist-go-get-fill-pred-from-symbol (symbol)
1682 "Search the master table, get fill-pred from a graphics operation SYMBOL."
1683 (artist-go-retrieve-from-symbol symbol 'artist-go-get-fill-pred))
1685 (defun artist-go-get-fill-fn-from-symbol (symbol)
1686 "Search the master table, get fill-fn from a graphics operation SYMBOL."
1687 (artist-go-retrieve-from-symbol symbol 'artist-go-get-fill-fn))
1689 (defun artist-go-get-symbol-shift (symbol is-shifted)
1690 "Search for (shifted or unshifted) graphics operation SYMBOL.
1691 If IS-SHIFTED is non-nil, return the shifted symbol,
1692 otherwise the shifted symbol."
1693 (artist-go-get-symbol-shift-sub artist-mt symbol is-shifted))
1695 (defun artist-go-get-symbol-shift-sub (table symbol is-shifted)
1696 "Search TABLE for (shifted or unshifted) graphics SYMBOL.
1697 If IS-SHIFTED is non-nil, return the shifted symbol,
1698 otherwise the shifted symbol."
1702 (let ((element-tag (artist-mt-get-tag element)))
1703 (cond ((eq element-tag 'graphics-operation)
1704 (let* ((info-part (artist-mt-get-info-part element))
1705 (unshift-variant (artist-go-get-unshifted info-part))
1706 (shift-variant (artist-go-get-shifted info-part))
1707 (unshift-sym (artist-go-get-symbol unshift-variant))
1708 (shift-sym (artist-go-get-symbol shift-variant)))
1709 (if (or (eq symbol unshift-sym) (eq symbol shift-sym))
1710 (throw 'found (if is-shifted shift-sym unshift-sym)))))
1712 ((eq element-tag 'menu)
1713 (let* ((info-part (artist-mt-get-info-part element))
1714 (items (artist-mn-get-items info-part))
1715 (answer (artist-go-get-symbol-shift-sub
1716 items symbol is-shifted)))
1717 (if answer (throw 'found answer)))))))
1723 ; Retrieving info from a function-call symbol
1726 (defun artist-fc-retrieve-from-symbol (symbol retrieve-fn)
1727 "Search the master table for a function call SYMBOL.
1728 Calls RETRIEVE-FN to retrieve information from that symbol's
1730 (artist-fc-retrieve-from-symbol-sub artist-mt symbol retrieve-fn))
1732 (defun artist-fc-retrieve-from-symbol-sub (table symbol retrieve-fn)
1733 "Search TABLE for a function-call SYMBOL.
1734 Calls RETRIEVE-FN to retrieve information from that symbol's
1739 (let ((element-tag (artist-mt-get-tag element)))
1740 (cond ((eq element-tag 'function-call)
1741 (let* ((info-part (artist-mt-get-info-part element))
1742 (fc-symbol (artist-fc-get-symbol info-part)))
1743 (if (eq fc-symbol symbol)
1744 (throw 'found (funcall retrieve-fn info-part)))))
1746 ((eq element-tag 'menu)
1747 (let* ((info-part (artist-mt-get-info-part element))
1748 (items (artist-mn-get-items info-part))
1749 (answer (artist-fc-retrieve-from-symbol-sub
1750 items symbol retrieve-fn)))
1751 (if answer (throw 'found answer)))))))
1756 (defun artist-fc-get-fn-from-symbol (symbol)
1757 "Search the master table to get function from a function call SYMBOL."
1758 (artist-fc-retrieve-from-symbol symbol 'artist-fc-get-fn))
1765 ;; Macro that won't funcall the function if it is nil.
1767 (defmacro artist-funcall (fn &rest args)
1768 "Call function FN with ARGS iff FN is not nil."
1769 (list 'if fn (cons 'funcall (cons fn args))))
1771 (defun artist-uniq (l)
1772 "Remove consecutive duplicates in list L. Comparison is done with `equal'."
1773 (cond ((null l) nil)
1774 ((null (cdr l)) l) ; only one element in list
1775 ((equal (car l) (car (cdr l))) (artist-uniq (cdr l))) ; first 2 equal
1776 (t (cons (car l) (artist-uniq (cdr l)))))) ; first 2 are different
1778 (defun artist-string-split (str r)
1779 "Split string STR at occurrences of regexp R, returning a list of strings."
1783 (while (setq match-pos (string-match r str start))
1784 (setq res (cons (copy-sequence (substring str start match-pos)) res))
1785 (setq start (match-end 0)))
1788 (if (< (match-end 0) (- (length str) 1))
1789 (setq res (cons (substring str (match-end 0) (length str)) res)))
1792 (defun artist-string-to-file (str file-name)
1793 "Write string STR to file FILE-NAME."
1794 (write-region str 'end-is-ignored file-name nil 'no-message))
1796 (defun artist-file-to-string (file-name)
1797 "Read from file FILE-NAME into a string."
1799 (let ((tmp-buffer (get-buffer-create (concat "*artist-" file-name "*"))))
1800 (set-buffer tmp-buffer)
1801 (goto-char (point-min))
1802 (insert-file-contents file-name nil nil nil t)
1803 (let ((str (copy-sequence (buffer-substring (point-min)
1805 (kill-buffer tmp-buffer)
1808 (defun artist-clear-buffer (buf)
1809 "Clear contents of buffer BUF."
1812 (goto-char (point-min))
1813 (delete-char (- (point-max) (point-min)) nil)))
1816 (defun artist-system (program stdin &optional program-args)
1817 "Run PROGRAM synchronously with the contents of string STDIN to stdin.
1818 Optional args PROGRAM-ARGS are arguments to PROGRAM.
1819 Return a list (RETURN-CODE STDOUT STDERR)."
1821 (let* ((tmp-stdin-file-name (if stdin
1823 (concat (file-name-as-directory
1824 (or (getenv "TMPDIR") "/tmp"))
1827 (tmp-stdout-buffer (get-buffer-create
1828 (concat "*artist-" program "*")))
1829 (tmp-stderr-file-name (make-temp-file
1830 (concat (file-name-as-directory
1831 (or (getenv "TMPDIR") "/tmp"))
1833 (binary-process-input nil) ; for msdos
1834 (binary-process-output nil))
1837 (if stdin (artist-string-to-file stdin tmp-stdin-file-name))
1840 (artist-clear-buffer tmp-stdout-buffer)
1842 ;; Start the program
1844 (let ((res (if program-args
1845 (apply 'call-process
1848 (list tmp-stdout-buffer
1849 tmp-stderr-file-name)
1851 (if (stringp program-args)
1854 (apply 'call-process
1857 (list tmp-stdout-buffer
1858 tmp-stderr-file-name)
1864 (set-buffer tmp-stdout-buffer)
1865 (copy-sequence (buffer-substring (point-min)
1867 (artist-file-to-string tmp-stderr-file-name)))
1869 ;; Unwind: remove temporary files and buffers
1870 (if (and stdin (file-exists-p tmp-stdin-file-name))
1871 (delete-file tmp-stdin-file-name))
1872 (if (file-exists-p tmp-stderr-file-name)
1873 (delete-file tmp-stderr-file-name))
1874 (if (memq tmp-stdout-buffer (buffer-list))
1875 (kill-buffer tmp-stdout-buffer))))))
1877 ;; Routines that deal with the buffer
1879 ;; artist-current-line get line number (top of buffer is 0)
1881 ;; artist-move-to-xy move to (x,y) (0,0) is beg-of-buffer
1883 ;; artist-get-char-at-xy get char in at (x,y)
1885 ;; artist-replace-char overwrite (replace) char at point
1886 ;; artist-replace-chars overwrite (replace) chars at point
1889 (defsubst artist-current-column ()
1890 "Return point's current column."
1893 (defsubst artist-current-line ()
1894 "Return point's current line, buffer-relative. Top of buffer is 0."
1895 (+ (count-lines 1 (point))
1896 (if (= (current-column) 0) 1 0)
1899 (defsubst artist-move-to-xy (x y)
1900 "Move to column X, at row Y from the top of buffer. Top line is 0."
1902 ;; Q: Why do we do forward-line twice?
1903 ;; A: The documentation for forward-line says
1905 ;; "... Returns the count of lines left to move. ... With
1906 ;; positive N, a non-empty line at the end counts as one
1907 ;; line successfully moved (for the return value)."
1909 ;; This means that if we are trying to move forward past the end
1910 ;; of the buffer, and that last line happened to be longer than
1911 ;; the current column, then we end up at the end of that last
1912 ;; line, and forward-line returns one less than we actually
1915 ;; Example: In the figure below, the `X' is the very last
1916 ;; character in the buffer ("a non-empty line at the
1917 ;; end"). Suppose point is at at P. Then (forward-line 1)
1918 ;; returns 0 and puts point after the `X'.
1920 ;; --------top of buffer--------
1923 ;; -------bottom of buffer------
1925 ;; But, if we are at the end of buffer when trying to move
1926 ;; forward, then forward-line will return the (for us) correct
1927 ;; value, which is good, because we will come to the end of the
1928 ;; buffer by the first forward-line. The second forward-line
1929 ;; will then get us where we really wanted to go.
1931 ;; If we are not moving past the end of the buffer, then the
1932 ;; second forward-line will return 0.
1934 ;; Q: What happens if we are moving upwards?
1935 ;; A: That will work good. insert-char won't insert a negative
1936 ;; number of chars, and forward-line will fail silently if we are
1937 ;; moving past the beginning of the buffer.
1939 (forward-line (- y (artist-current-line)))
1940 (insert-char ?\n (forward-line (- y (artist-current-line))))
1941 (move-to-column (max x 0) t)
1942 (let ((curr-y (artist-current-line)))
1943 (setq artist-draw-region-min-y (min curr-y artist-draw-region-min-y))
1944 (setq artist-draw-region-max-y (max curr-y artist-draw-region-max-y))))
1946 (defsubst artist-get-char-at-xy (x y)
1947 "Return the character found at column X, row Y.
1948 Also updates the variables `artist-draw-min-y' and `artist-draw-max-y'."
1949 (artist-move-to-xy x y)
1950 (let ((curr-y (artist-current-line)))
1951 (setq artist-draw-region-min-y (min curr-y artist-draw-region-min-y))
1952 (setq artist-draw-region-max-y (max curr-y artist-draw-region-max-y)))
1956 (defun artist-get-char-at-xy-conv (x y)
1957 "Retrieve the character at X, Y, converting tabs and new-lines to spaces."
1959 (aref artist-replacement-table (artist-get-char-at-xy x y))))
1962 (defun artist-replace-char (new-char)
1963 "Replace the character at point with NEW-CHAR."
1964 ;; Check that the variable exists first. The doc says it was added in 19.23.
1965 (if (and (and (boundp 'emacs-major-version) (= emacs-major-version 20))
1966 (and (boundp 'emacs-minor-version) (<= emacs-minor-version 3)))
1967 ;; This is a bug workaround for Emacs 20, versions up to 20.3:
1968 ;; The self-insert-command doesn't care about the overwrite-mode,
1969 ;; so the insertion is done in the same way as in picture mode.
1970 ;; This seems to be a little bit slower.
1972 (artist-move-to-xy (1+ (artist-current-column))
1973 (artist-current-line))
1975 (insert (aref artist-replacement-table new-char)))
1976 ;; In emacs-19, the self-insert-command works better and faster
1977 (let ((overwrite-mode 'overwrite-mode-textual)
1978 (fill-column 32765) ; Large :-)
1979 (blink-matching-paren nil))
1980 (setq last-command-event (aref artist-replacement-table new-char))
1981 (self-insert-command 1))))
1983 (defun artist-replace-chars (new-char count)
1984 "Replace characters at point with NEW-CHAR. COUNT chars are replaced."
1985 ;; Check that the variable exists first. The doc says it was added in 19.23.
1986 (if (and (and (boundp 'emacs-major-version) (= emacs-major-version 20))
1987 (and (boundp 'emacs-minor-version) (<= emacs-minor-version 3)))
1988 ;; This is a bug workaround for Emacs 20, versions up to 20.3:
1989 ;; The self-insert-command doesn't care about the overwrite-mode,
1990 ;; so the insertion is done in the same way as in picture mode.
1991 ;; This seems to be a little bit slower.
1992 (let* ((replaced-c (aref artist-replacement-table new-char))
1993 (replaced-s (make-string count replaced-c)))
1994 (artist-move-to-xy (+ (artist-current-column) count)
1995 (artist-current-line))
1996 (delete-char (- count))
1997 (insert replaced-s))
1998 ;; In emacs-19, the self-insert-command works better
1999 (let ((overwrite-mode 'overwrite-mode-textual)
2000 (fill-column 32765) ; Large :-)
2001 (blink-matching-paren nil))
2002 (setq last-command-event (aref artist-replacement-table new-char))
2003 (self-insert-command count))))
2005 (defsubst artist-replace-string (string &optional see-thru)
2006 "Replace contents at point with STRING.
2007 With optional argument SEE-THRU, set to non-nil, text in the buffer
2008 ``shines thru'' blanks in the STRING."
2009 (let ((char-list (append string nil)) ; convert the string to a list
2010 (overwrite-mode 'overwrite-mode-textual)
2011 (fill-column 32765) ; Large :-)
2012 (blink-matching-paren nil))
2014 (let ((c (car char-list)))
2015 (if (and see-thru (= (aref artist-replacement-table c) ?\ ))
2016 (artist-move-to-xy (1+ (artist-current-column))
2017 (artist-current-line))
2018 (artist-replace-char c)))
2019 (setq char-list (cdr char-list)))))
2022 ;; Routines for setting and unsetting points
2023 ;; Used when not rubber-banding
2025 (defun artist-no-rb-unset-point1 ()
2026 "Unsets point 1 when not rubber-banding."
2027 (let ((x-now (artist-current-column))
2028 (y-now (artist-current-line))
2029 (x (aref artist-rb-save-data 0))
2030 (y (aref artist-rb-save-data 1)))
2031 (artist-move-to-xy x y)
2032 (artist-replace-char (aref artist-rb-save-data 2))
2033 (artist-move-to-xy x-now y-now)))
2035 (defun artist-no-rb-set-point1 (x y)
2036 "Set point 1 at X, Y when not rubber-banding."
2037 (let ((x-now (artist-current-column))
2038 (y-now (artist-current-line)))
2039 (aset artist-rb-save-data 0 x)
2040 (aset artist-rb-save-data 1 y)
2041 (aset artist-rb-save-data 2 (artist-get-char-at-xy x y))
2042 (artist-move-to-xy x y)
2043 (artist-replace-char artist-first-char)
2044 (artist-move-to-xy x-now y-now)
2045 (aset artist-rb-save-data 6 0)))
2047 (defun artist-no-rb-unset-point2 ()
2048 "This function unsets point 2 when not rubber-banding."
2049 (if (= (aref artist-rb-save-data 6) 1)
2050 (let ((x-now (artist-current-column))
2051 (y-now (artist-current-line))
2052 (x (aref artist-rb-save-data 3))
2053 (y (aref artist-rb-save-data 4)))
2054 (artist-move-to-xy x y)
2055 (artist-replace-char (aref artist-rb-save-data 5))
2056 (artist-move-to-xy x-now y-now))))
2058 (defun artist-no-rb-set-point2 (x y)
2059 "Set point 2 at X, Y when not rubber-banding."
2060 (let ((x-now (artist-current-column))
2061 (y-now (artist-current-line)))
2062 (aset artist-rb-save-data 3 x)
2063 (aset artist-rb-save-data 4 y)
2064 (aset artist-rb-save-data 5 (artist-get-char-at-xy x y))
2065 (artist-move-to-xy x y)
2066 (artist-replace-char artist-second-char)
2067 (artist-move-to-xy x-now y-now)
2068 (aset artist-rb-save-data 6 1)))
2070 (defun artist-no-rb-unset-points ()
2071 "This function unsets point 1 and 2 when not rubber-banding."
2072 (artist-no-rb-unset-point1)
2073 (artist-no-rb-unset-point2))
2076 ;; artist-intersection-char
2078 ;; Note: If changing this, see the notes for artist-unintersection-char
2079 ;; and artist-vaporize-lines
2081 (defun artist-intersection-char (new-c old-c)
2082 "Calculates intersection character when drawing a NEW-C on top of an OLD-C.
2083 Return character according to this scheme:
2094 other combinations NEW-C"
2096 (cond ((and (= old-c ?- ) (= new-c ?| )) ?+ )
2097 ((and (= old-c ?| ) (= new-c ?- )) ?+ )
2098 ((and (= old-c ?+ ) (= new-c ?- )) ?+ )
2099 ((and (= old-c ?+ ) (= new-c ?| )) ?+ )
2100 ((and (= old-c ?\\ ) (= new-c ?/ )) ?X )
2101 ((and (= old-c ?/ ) (= new-c ?\\ )) ?X )
2102 ((and (= old-c ?X ) (= new-c ?/ )) ?X )
2103 ((and (= old-c ?X ) (= new-c ?\\ )) ?X )
2106 ;; artist-unintersection-char
2108 ;; Note: If changing this, see the note for artist-vaporize-lines
2110 (defun artist-unintersection-char (line-c buffer-c)
2111 "Restore character to before intersection when removing LINE-C from BUFFER-C.
2112 Return character according to this scheme:
2114 LINE-C BUFFER-C return
2119 other combinations `artist-erase-char'."
2121 (cond ((and (= line-c ?- ) (= buffer-c ?+ )) ?| )
2122 ((and (= line-c ?| ) (= buffer-c ?+ )) ?- )
2123 ((and (= line-c ?\\ ) (= buffer-c ?X )) ?/ )
2124 ((and (= line-c ?/ ) (= buffer-c ?X )) ?\\ )
2125 ((= line-c buffer-c) artist-erase-char)
2129 ;; Computing the line-char to use
2130 ;; for use with borderless shapes
2132 (defsubst artist-compute-line-char ()
2133 "Compute which character to use for lines, if any.
2134 Return value is either nil for the default characters that make up lines, or
2135 a character chosen depending on the variables `artist-borderless-shapes',
2136 `artist-fill-char-set', `artist-fill-char' and
2137 `artist-line-char-set' and `artist-line-char'."
2138 (if (and artist-borderless-shapes artist-fill-char-set)
2140 (if artist-line-char-set
2145 ;; Things for drawing horizontal, vertical and diagonal (straight) lines.
2147 ;; A line here is a vector:
2148 ;; [ start-x start-y length direction saved-char-1 saved-char-2 ... ]
2149 ;; directions start with 0 at the x-axis and counts anti clockwise.
2151 (defvar artist-direction-info
2153 [ [ 1 0 ?- ] ; direction 0
2154 [ 1 1 ?\\ ] ; direction 1
2155 [ 0 1 ?| ] ; direction 2
2156 [ -1 1 ?/ ] ; direction 3
2157 [ -1 0 ?- ] ; direction 4
2158 [ -1 -1 ?\\ ] ; direction 5
2159 [ 0 -1 ?| ] ; direction 6
2160 [ 1 -1 ?/ ] ] ; direction 7
2161 "Table used for stepping x and y coordinates in a specific direction.
2162 This table is also used for determining which char to use for that direction.")
2164 (defsubst artist-direction-step-x (direction)
2165 "Return the x-step for DIRECTION from the `artist-direction-info' table."
2166 (aref (aref artist-direction-info direction) 0))
2168 (defsubst artist-direction-step-y (direction)
2169 "Return the y-step for DIRECTION from the `artist-direction-info' table."
2170 (aref (aref artist-direction-info direction) 1))
2172 (defun artist-direction-char (direction)
2173 "Return the character for DIRECTION from the `artist-direction-info' table."
2174 (aref (aref artist-direction-info direction) 2))
2176 ;; artist-find-direction
2180 (defun artist-find-direction (x1 y1 x2 y2)
2181 "Find the direction from point X1,Y1 to X2,Y2.
2182 Returns a DIRECTION, a number 0--7, coded as follows:
2189 (let ((delta-x (- x2 x1))
2190 (delta-y (- y2 y1)))
2191 (cond ((>= delta-x (* 2 (abs delta-y))) 0)
2192 ((>= delta-y (* 2 (abs delta-x))) 2)
2193 ((>= (- delta-x) (* 2 (abs delta-y))) 4)
2194 ((>= (- delta-y) (* 2 (abs delta-x))) 6)
2195 ((and (>= delta-x 0) (>= delta-y 0)) 1)
2196 ((and (<= delta-x 0) (>= delta-y 0)) 3)
2197 ((and (<= delta-x 0) (<= delta-y 0)) 5)
2198 ((and (>= delta-x 0) (<= delta-y 0)) 7))))
2200 (defun artist-straight-calculate-length (direction x1 y1 x2 y2)
2201 "Calculate length for a straight line in DIRECTION from X1,Y1 to X2,Y2."
2202 (cond ((or (= direction 7)
2204 (= direction 1)) (1+ (- x2 x1)))
2205 ((or (= direction 3)
2207 (= direction 5)) (1+ (- x1 x2)))
2208 (t (1+ (abs (- y2 y1))))))
2210 (defun artist-sline (x1 y1 x2 y2)
2211 "Create a straight line from X1,Y1 to X2,Y2."
2212 (let* ((direction (artist-find-direction x1 y1 x2 y2))
2213 (length (artist-straight-calculate-length direction x1 y1 x2 y2))
2214 (line (make-vector (+ length 4) x1)))
2217 ;; because we set all elements to x1
2219 (aset line 2 length)
2220 (aset line 3 direction)
2223 (defun artist-save-chars-under-sline (line)
2224 "Save characters under a LINE."
2225 (let ((x (aref line 0))
2227 (length (+ (aref line 2) 4))
2228 (direction (aref line 3))
2231 (aset line i (artist-get-char-at-xy x y))
2232 (setq x (+ x (artist-direction-step-x direction)))
2233 (setq y (+ y (artist-direction-step-y direction)))
2239 ;; Things for drawing lines in all directions.
2240 ;; The line drawing engine is the eight-point alrogithm.
2242 ;; A line is here a list of (x y saved-char new-char)s.
2244 (defvar artist-octant-info
2245 ;; Initial Step in Step in
2246 ;; coeffs x and y x and y
2247 ;; for if q >= 0 if g < 0
2249 [ [ 2 1 1 0 1 1 ] ; 1st octant
2250 [ 1 2 1 1 0 1 ] ; 2nd octant
2251 [ -1 2 0 1 -1 1 ] ; 3rd octant
2252 [ -2 1 -1 1 -1 0 ] ; 4th octant
2253 [ -2 -1 -1 0 -1 -1 ] ; 5th octant
2254 [ -1 -2 -1 -1 0 -1 ] ; 6th octant
2255 [ 1 -2 0 -1 1 -1 ] ; 7th octant
2256 [ 2 -1 1 -1 1 0 ] ] ; 8th octant
2257 "Table used by line drawing algorithm (eight point).")
2259 ;; Primitives for the artist-octant-info.
2260 ;; Decrease octant by 1 since elt counts from 0 and octant counts from 1.
2262 (defsubst artist-get-dfdx-init-coeff (octant)
2263 "Retrieve dfdx component for OCTANT."
2264 (aref (aref artist-octant-info (- octant 1)) 0))
2266 (defsubst artist-get-dfdy-init-coeff (octant)
2267 "Retrieve dfdy component for OCTANT."
2268 (aref (aref artist-octant-info (- octant 1)) 1))
2270 (defsubst artist-get-x-step-q>=0 (octant)
2271 "Retrieve x-step component for OCTANT when q >= 0."
2272 (aref (aref artist-octant-info (- octant 1)) 2))
2274 (defsubst artist-get-y-step-q>=0 (octant)
2275 "Retrieve y-step component for OCTANT when q >= 0."
2276 (aref (aref artist-octant-info (- octant 1)) 3))
2278 (defsubst artist-get-x-step-q<0 (octant)
2279 "Retrieve x-step component for OCTANT for q < 0."
2280 (aref (aref artist-octant-info (- octant 1)) 4))
2282 (defsubst artist-get-y-step-q<0 (octant)
2283 "Retrieve y-step component for OCTANT for q < 0."
2284 (aref (aref artist-octant-info (- octant 1)) 5))
2287 ;; Find octant from x1 y1 x2 y2 coordinates.
2289 (defun artist-find-octant (x1 y1 x2 y2)
2290 "Find octant for a line from X1,Y1 to X2,Y2.
2291 Octant are numbered 1--8, anti-clockwise as:
2299 (if (<= x1 x2) ; quadrant 1 or 4
2300 (if (<= y1 y2) ; quadrant 1, octant 1 or 2
2301 (if (>= (- x2 x1) (- y2 y1))
2304 (if (>= (- x2 x1) (- (- y2 y1))) ; quadrant 4, octant 7 or 8
2307 (if (<= y1 y2) ; quadrant 2 or 3
2308 (if (>= (- (- x2 x1)) (- y2 y1)) ; quadrant 2, octant 3 or 4
2311 (if (>= (- (- x2 x1)) (- (- y2 y1))) ; quadrant 3, octant 5 or 6
2315 ;; Some inline funtions for creating, setting and reading
2316 ;; members of a coordinate
2318 (defsubst artist-new-coord (x y &optional new-char)
2319 "Create a new coordinate at X,Y for use in a line.
2320 Optional argument NEW-CHAR can be used for setting the new-char component
2322 (let ((coord (make-vector 4 x)))
2324 (aset coord 3 new-char)
2327 (defsubst artist-coord-get-x (coord)
2328 "Retrieve the x component of a COORD."
2331 (defsubst artist-coord-get-y (coord)
2332 "Retrieve the y component of a COORD."
2335 (defsubst artist-coord-set-x (coord new-x)
2336 "Set the x component of a COORD to NEW-X."
2337 (aset coord 0 new-x)
2340 (defsubst artist-coord-set-y (coord new-y)
2341 "Set the y component of a COORD to NEW-Y."
2342 (aset coord 1 new-y)
2345 (defsubst artist-coord-get-saved-char (coord)
2346 "Retrieve the saved char component of a COORD."
2349 (defsubst artist-coord-get-new-char (coord)
2350 "Retrieve the new char component of a COORD."
2353 (defsubst artist-coord-add-saved-char (coord saved-char)
2354 "Set the saved char component of a COORD to SAVED-CHAR."
2355 (aset coord 2 saved-char)
2358 (defsubst artist-coord-add-new-char (coord new-char)
2359 "Set the new char component of a COORD to NEW-CHAR."
2360 (aset coord 3 new-char)
2363 (defsubst artist-coord-set-new-char (coord new-char)
2364 "Set the new char component of a COORD to NEW-CHAR."
2365 (aset coord 3 new-char)
2369 ;; Pretend we are plotting a pixel. Instead we just list it
2371 (defmacro artist-put-pixel (point-list x y)
2372 "In POINT-LIST, store a ``pixel'' at coord X,Y."
2373 (list 'setq point-list
2374 (list 'append point-list (list 'list (list 'artist-new-coord x y)))))
2376 ;; Calculate list of points using eight point algorithm
2377 ;; return a list of coords
2379 (defun artist-eight-point (x1 y1 x2 y2)
2380 "Run the eight-point algorithm to get a list of coords from X1,Y1 to X2,Y2."
2381 (let* ((point-list nil)
2382 (octant (artist-find-octant x1 y1 x2 y2))
2383 (dfdx-coeff (artist-get-dfdx-init-coeff octant))
2384 (dfdy-coeff (artist-get-dfdy-init-coeff octant))
2385 (x-step-q>=0 (artist-get-x-step-q>=0 octant))
2386 (y-step-q>=0 (artist-get-y-step-q>=0 octant))
2387 (x-step-q<0 (artist-get-x-step-q<0 octant))
2388 (y-step-q<0 (artist-get-y-step-q<0 octant))
2389 (dfdx (- (- y2 y1)))
2396 (* dfdy-coeff dfdy))))
2397 (artist-put-pixel point-list x y)
2398 (while (or (not (eq x x2)) (not (eq y y2)))
2401 (setq x (+ x x-step-q>=0))
2402 (setq y (+ y y-step-q>=0))
2403 (setq f (+ f (* x-step-q>=0 dfdx) (* y-step-q>=0 dfdy))))
2405 (setq x (+ x x-step-q<0))
2406 (setq y (+ y y-step-q<0))
2407 (setq f (+ f (* x-step-q<0 dfdx) (* y-step-q<0 dfdy)))))
2408 (setq q (+ (* 2 f) (* dfdx-coeff dfdx) (* dfdy-coeff dfdy)))
2409 (artist-put-pixel point-list x y))
2412 ;; artist-save-chars-under-point-list
2413 ;; Remebers the chars that were there before we did draw the line.
2414 ;; Returns point-list.
2416 (defun artist-save-chars-under-point-list (point-list)
2417 "Save characters originally under POINT-LIST."
2420 (artist-coord-add-saved-char
2422 (artist-get-char-at-xy (artist-coord-get-x coord)
2423 (artist-coord-get-y coord))))
2426 ;; artist-calculate-new-char, artist-calculate-new-chars
2427 ;; Calculates which char to insert depending on direction of point-list.
2429 ;; Depending on new-coord's position relative to last-coord one of the
2430 ;; following chars are returned: \ | / - o, as indicated by this:
2436 ;; artist-calculate-new-char works on one coordinate, returns char.
2437 ;; artist-calculate-new-chars works on a point-list, returns point-list.
2439 (defun artist-calculate-new-char (last-coord new-coord)
2440 "Return a line-char to use when moving from LAST-COORD to NEW-COORD."
2441 (let ((last-x (artist-coord-get-x last-coord))
2442 (last-y (artist-coord-get-y last-coord))
2443 (new-x (artist-coord-get-x new-coord))
2444 (new-y (artist-coord-get-y new-coord)))
2445 (cond ((> new-x last-x) (cond ((< new-y last-y) ?/ )
2446 ((> new-y last-y) ?\\ )
2448 ((< new-x last-x) (cond ((< new-y last-y) ?\\ )
2449 ((> new-y last-y) ?/ )
2451 ((eq new-y last-y) ?o)
2454 (defun artist-calculate-new-chars (point-list)
2455 "Return a list of coords with line-chars calculated. Input: POINT-LIST."
2456 (if (null (cdr point-list))
2457 (list (artist-coord-add-new-char (car point-list) ?o ))
2458 (let ((last-coord (car point-list)))
2459 (cons (artist-coord-add-new-char
2461 (artist-calculate-new-char (car (cdr point-list))
2464 (lambda (this-coord)
2466 (artist-coord-add-new-char
2468 (artist-calculate-new-char last-coord this-coord))
2469 (setq last-coord this-coord)))
2470 (cdr point-list))))))
2472 ;; artist-modify-new-chars
2473 ;; Replaces some characters with some other characters.
2475 ;; artist-modify-new-chars works on a point-list, returns point-list.
2477 (defun artist-modify-new-chars (point-list)
2478 "Replace intersecting characters in POINT-LIST.
2479 This function returns a point-list."
2482 (let* ((new-c (artist-coord-get-new-char coord))
2483 (saved-c (artist-coord-get-saved-char coord))
2484 (modified-c (artist-intersection-char new-c saved-c)))
2485 (artist-coord-set-new-char coord modified-c)))
2490 ;; functions for accessing endoints and elements in object requiring
2494 (defun artist-make-endpoint (x y)
2495 "Create an endpoint at X, Y."
2496 (let ((new-endpoint (make-vector 2 x)))
2497 (aset new-endpoint 1 y)
2500 (defun artist-endpoint-get-x (endpoint)
2501 "Retrieve the x component of an ENDPOINT."
2504 (defun artist-endpoint-get-y (endpoint)
2505 "Retrieve the y component of an ENDPOINT."
2508 (defun artist-make-2point-object (endpoint1 endpoint2 shapeinfo)
2509 "Create a 2-point object of ENDPOINT1, ENDPOINT2 and SHAPEINFO."
2510 (list endpoint1 endpoint2 shapeinfo))
2512 (defun artist-2point-get-endpoint1 (obj)
2513 "Retrieve the first endpoint of a 2-point object OBJ."
2516 (defun artist-2point-get-endpoint2 (obj)
2517 "Retrieve the second endpoint of a 2-point object OBJ."
2520 (defun artist-2point-get-shapeinfo (obj)
2521 "Retrieve the shapeinfo component of a 2-point object OBJ."
2526 ;; Drawing and undrawing lines (any direction)
2529 (defun artist-draw-line (x1 y1 x2 y2)
2530 "Draws a line from X1, Y1 to X2, Y2.
2532 Output is a line, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
2534 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
2535 SHAPE-INFO is a list of vectors [X Y SAVED-CHAR NEW-CHAR]."
2536 (let ((endpoint1 (artist-make-endpoint x1 y1))
2537 (endpoint2 (artist-make-endpoint x2 y2)))
2538 (artist-make-2point-object
2543 (artist-move-to-xy (artist-coord-get-x coord)
2544 (artist-coord-get-y coord))
2545 (if artist-line-char-set
2546 (artist-replace-char artist-line-char)
2547 (artist-replace-char (artist-coord-get-new-char coord)))
2549 (artist-modify-new-chars
2550 (artist-calculate-new-chars
2551 (artist-save-chars-under-point-list
2552 (artist-eight-point x1 y1 x2 y2))))))))
2554 (defun artist-undraw-line (line)
2558 (artist-move-to-xy (artist-coord-get-x coord)
2559 (artist-coord-get-y coord))
2560 (artist-replace-char (artist-coord-get-saved-char coord))
2562 (artist-2point-get-shapeinfo line)))
2565 ;; Drawing and undrawing straight lines
2568 (defun artist-draw-sline (x1 y1 x2 y2)
2569 "Draw a strait line from X1, Y1 to X2, Y2.
2570 Straight lines are vertical, horizontal or diagonal lines.
2571 They are faster to draw and most often they are what you need
2572 when drawing a simple image.
2574 Output is a straight line, which is a list on the form
2575 \(END-POINT-1 END-POINT-2 SHAPE-INFO).
2577 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
2578 SHAPE-INFO is a vector [START-X START-Y LENGTH-OF-LINE DIRECTION
2579 ORIGINAL-CHAR-1 ORIGINAL-CHAR-2 ... ]."
2580 (let* ((line (artist-save-chars-under-sline (artist-sline x1 y1 x2 y2)))
2583 (length (+ (aref line 2) 4))
2584 (direction (aref line 3))
2585 (line-char (artist-direction-char direction))
2587 (endpoint1 (artist-make-endpoint x y))
2590 (artist-move-to-xy x y)
2591 (if artist-line-char-set
2592 (artist-replace-char artist-line-char)
2593 (artist-replace-char (artist-intersection-char
2596 (if (not (< (1+ i) length))
2597 ;; This is the last element. Set the second endpoint
2598 (setq endpoint2 (artist-make-endpoint x y)))
2599 (setq x (+ x (artist-direction-step-x direction)))
2600 (setq y (+ y (artist-direction-step-y direction)))
2602 (artist-make-2point-object endpoint1 endpoint2 line)))
2605 (defun artist-undraw-sline (line)
2606 "Undraw a straight line LINE."
2608 (let* ((shape-info (artist-2point-get-shapeinfo line))
2609 (x (aref shape-info 0))
2610 (y (aref shape-info 1))
2611 (length (+ (aref shape-info 2) 4))
2612 (direction (aref shape-info 3))
2615 (artist-move-to-xy x y)
2616 (artist-replace-char (aref shape-info i))
2617 (setq x (+ x (artist-direction-step-x direction)))
2618 (setq y (+ y (artist-direction-step-y direction)))
2623 ;; Drawing and undrawing rectangles and squares
2626 (defun artist-draw-rect (x1 y1 x2 y2)
2627 "Draws a rectangle with corners at X1, Y1 and X2, Y2.
2629 Output is a rectangle, which is a list on the form
2630 \(END-POINT-1 END-POINT-2 SHAPE-INFO).
2632 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
2633 SHAPE-INFO is a list of four straight lines."
2634 (let* ((artist-line-char (artist-compute-line-char))
2635 (artist-line-char-set artist-line-char)
2636 (line1 (artist-draw-sline x1 y1 x2 y1))
2637 (line2 (artist-draw-sline x2 y1 x2 y2))
2638 (line3 (artist-draw-sline x2 y2 x1 y2))
2639 (line4 (artist-draw-sline x1 y2 x1 y1))
2640 (endpoint1 (artist-make-endpoint x1 y1))
2641 (endpoint2 (artist-make-endpoint x2 y2)))
2642 (artist-make-2point-object endpoint1
2644 (list line1 line2 line3 line4))))
2646 (defun artist-undraw-rect (rectangle)
2647 "Undraws RECTANGLE."
2649 (let ((shape-info (artist-2point-get-shapeinfo rectangle)))
2650 (artist-undraw-sline (elt shape-info 3))
2651 (artist-undraw-sline (elt shape-info 2))
2652 (artist-undraw-sline (elt shape-info 1))
2653 (artist-undraw-sline (elt shape-info 0)))))
2656 (defun artist-rect-corners-squarify (x1 y1 x2 y2)
2657 "Compute square corners from rectangle corners at X1, Y1 and X2, Y2.
2658 The square's first corner will be X1, Y1. The position of the second corner
2659 depends on which of X2 and Y2 is most far away from X1, Y1."
2660 (let* ((delta-x (- x2 x1))
2662 (delta-x-sign (if (< delta-x 0) -1 1))
2663 (delta-y-sign (if (< delta-y 0) -1 1))
2664 (new-x2) ; set below
2665 (new-y2)) ; set below
2667 ;; Check which of x2 and y2 is most distant
2668 ;; take care to the aspect ratio
2669 (if (> (abs delta-x) (abs delta-y))
2671 ;; *** x2 more distant than y2 (with care taken to aspect ratio)
2674 (setq new-y2 (+ y1 (round (/ (* (abs delta-x) delta-y-sign)
2675 artist-aspect-ratio)))))
2677 ;; *** y2 more distant than x2 (with care taken to aspect ratio)
2679 (setq new-x2 (round (+ x1 (* (* (abs delta-y) delta-x-sign)
2680 artist-aspect-ratio))))
2684 (list x1 y1 new-x2 new-y2)))
2687 (defun artist-draw-square (x1 y1 x2 y2)
2688 "Draw a square with corners at X1, Y1 and X2, Y2.
2690 Output is a square, which is a list on the form
2691 \(END-POINT-1 END-POINT-2 SHAPE-INFO).
2693 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
2694 SHAPE-INFO is a list of four straight lines."
2695 (let* ((artist-line-char (artist-compute-line-char))
2696 (artist-line-char-set artist-line-char)
2697 (square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
2698 (new-x1 (elt square-corners 0))
2699 (new-y1 (elt square-corners 1))
2700 (new-x2 (elt square-corners 2))
2701 (new-y2 (elt square-corners 3))
2702 (endpoint1 (artist-make-endpoint new-x1 new-y1))
2703 (endpoint2 (artist-make-endpoint new-x2 new-y2))
2704 (line1 (artist-draw-sline new-x1 new-y1 new-x2 new-y1))
2705 (line2 (artist-draw-sline new-x2 new-y1 new-x2 new-y2))
2706 (line3 (artist-draw-sline new-x2 new-y2 new-x1 new-y2))
2707 (line4 (artist-draw-sline new-x1 new-y2 new-x1 new-y1)))
2708 (artist-make-2point-object endpoint1
2710 (list line1 line2 line3 line4))))
2712 (defun artist-undraw-square (square)
2715 (let ((shape-info (artist-2point-get-shapeinfo square)))
2716 (artist-undraw-sline (elt shape-info 3))
2717 (artist-undraw-sline (elt shape-info 2))
2718 (artist-undraw-sline (elt shape-info 1))
2719 (artist-undraw-sline (elt shape-info 0)))))
2722 ;; Filling rectangles and squares
2725 (defun artist-fill-rect (rect x1 y1 x2 y2)
2726 "Fill rectangle RECT from X1,Y1 to X2,Y2."
2727 (let ((x (1+ (min x1 x2)))
2728 (y (1+ (min y1 y2)))
2730 (y-max (max y1 y2)))
2731 (let ((w (- x-max x)))
2733 (artist-move-to-xy x y)
2734 (artist-replace-chars artist-fill-char w)
2737 (defun artist-fill-square (square x1 y1 x2 y2)
2738 "Fills a SQUARE from X1,Y1 to X2,Y2."
2739 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
2740 (new-x1 (elt square-corners 0))
2741 (new-y1 (elt square-corners 1))
2742 (new-x2 (elt square-corners 2))
2743 (new-y2 (elt square-corners 3))
2744 (x (1+ (min new-x1 new-x2)))
2745 (y (1+ (min new-y1 new-y2)))
2746 (x-max (max new-x1 new-x2))
2747 (y-max (max new-y1 new-y2))
2750 (artist-move-to-xy x y)
2751 (artist-replace-chars artist-fill-char w)
2759 (defun artist-pen (x1 y1)
2760 "Draws a character at X1, Y1.
2761 The character is replaced with the character in `artist-fill-char'."
2762 (artist-move-to-xy x1 y1)
2763 (artist-replace-char (if artist-line-char-set
2765 (if artist-fill-char-set
2767 artist-default-fill-char))))
2770 (defun artist-pen-line (x1 y1)
2771 "Draws a line from last pen position to X1, Y1.
2772 The character is replaced with the character in `artist-fill-char'.
2773 This will store all points in `artist-key-poly-point-list' in reversed
2774 order (I assume it is faster to cons to the beginning of the list than
2775 to append to the end of the list, when doing free-hand drawing)."
2776 (let ((artist-line-char (if artist-line-char-set
2778 (if artist-fill-char-set
2780 artist-default-fill-char))))
2782 ;; Draw line from last point to this
2783 (let ((x-last (car (car artist-key-poly-point-list)))
2784 (y-last (cdr (car artist-key-poly-point-list))))
2785 (artist-move-to-xy x-last y-last)
2786 (artist-replace-char artist-line-char)
2787 (artist-draw-line x-last y-last x1 y1))
2789 ;; Update the point-list
2790 (setq artist-key-poly-point-list
2791 (cons (cons x1 y1) artist-key-poly-point-list))))
2793 (defun artist-pen-reset-last-xy (x1 y1)
2794 "Reset the last x and y points to X1, Y1 when doing pen-drawing."
2795 (artist-clear-arrow-points)
2796 (setq artist-key-poly-point-list (list (cons x1 y1))))
2799 (defun artist-pen-set-arrow-points (x1 y1)
2800 "Set arrow points for pen drawing using X1, Y1.
2801 Also, the `artist-key-poly-point-list' is reversed."
2803 (setq artist-key-poly-point-list
2804 (artist-uniq artist-key-poly-point-list))
2806 (if (>= (length artist-key-poly-point-list) 2)
2808 ;; Only set arrow-points if the point-list has two or more entries
2809 (let ((xn (car (car artist-key-poly-point-list)))
2810 (yn (cdr (car artist-key-poly-point-list)))
2811 (xn-1 (car (car (cdr artist-key-poly-point-list))))
2812 (yn-1 (cdr (car (cdr artist-key-poly-point-list))))
2813 (dirn)) ; direction for point n
2814 (setq artist-key-poly-point-list (reverse artist-key-poly-point-list))
2815 (let ((x0 (car (car artist-key-poly-point-list)))
2816 (y0 (cdr (car artist-key-poly-point-list)))
2817 (x1 (car (car (cdr artist-key-poly-point-list))))
2818 (y1 (cdr (car (cdr artist-key-poly-point-list))))
2819 (dir0)) ; direction for point 0
2820 (setq dir0 (artist-find-direction x1 y1 x0 y0))
2821 (setq dirn (artist-find-direction xn-1 yn-1 xn yn))
2822 (setq artist-arrow-point-1 (artist-make-arrow-point x0 y0 dir0))
2823 (setq artist-arrow-point-2 (artist-make-arrow-point xn yn dirn))))))
2829 (defun artist-figlet-run (text font extra-args)
2830 "Run figlet rendering TEXT using FONT.
2831 EXTRA-ARGS for figlet, for the command line, may be specified."
2832 (let* ((figlet-args (cond ((and font extra-args)
2833 (cons (concat "-f" font)
2834 (artist-string-split extra-args "[ \t]+")))
2835 (font (concat "-f" font))
2837 (artist-string-split extra-args "[ \t]+"))
2839 (figlet-output (artist-system artist-figlet-program text figlet-args))
2840 (exit-code (elt figlet-output 0))
2841 (stdout (elt figlet-output 1))
2842 (stderr (elt figlet-output 2)))
2843 (if (not (= exit-code 0))
2844 (error "Failed to render font: %s (%d)" stderr exit-code))
2847 (defun artist-figlet-get-font-list ()
2848 "Read fonts in with the shell command.
2849 Returns a list of strings."
2850 (let* ((cmd-interpreter "/bin/sh")
2851 (ls-cmd artist-figlet-list-fonts-command)
2852 (result (artist-system cmd-interpreter ls-cmd nil))
2853 (exit-code (elt result 0))
2854 (stdout (elt result 1))
2855 (stderr (elt result 2)))
2856 (if (not (= exit-code 0))
2857 (error "Failed to read available fonts: %s (%d)" stderr exit-code))
2858 (artist-string-split stdout ".flf\n")))
2860 (defun artist-figlet-choose-font ()
2861 "Read any extra arguments for figlet."
2863 (let* ((avail-fonts (artist-figlet-get-font-list))
2864 (font (completing-read (concat "Select font: (default "
2865 artist-figlet-default-font
2868 (lambda (font) (cons font font))
2870 (if (string= font "") artist-figlet-default-font font)))
2872 (defun artist-figlet-get-extra-args ()
2873 "Read any extra arguments for figlet."
2874 (let ((extra-args (read-string "Extra args to figlet: ")))
2875 (if (string= extra-args "")
2879 (defun artist-figlet (text)
2880 "Render TEXT using figlet."
2881 (let* ((figlet-font (artist-figlet-choose-font))
2882 (figlet-extra-args (artist-figlet-get-extra-args)))
2883 (artist-figlet-run text figlet-font figlet-extra-args)))
2886 (defun artist-text-insert-common (x y text see-thru)
2887 "At position X, Y, insert text TEXT.
2888 If SEE-THRU is non-nil, then blanks in TEXT does not replace text
2890 (let* ((string-list (artist-string-split text "\n"))
2892 (len (length string-list)))
2894 (artist-move-to-xy x (+ y i))
2895 (artist-replace-string (car string-list) see-thru)
2896 (setq string-list (cdr string-list))
2899 (defun artist-text-insert-see-thru (x y text)
2900 "At position X, Y, insert text TEXT.
2901 Let text already in buffer shine thru the TEXT inserted."
2902 (artist-text-insert-common x y text t))
2904 (defun artist-text-insert-overwrite (x y text)
2905 "At position X, Y, insert text TEXT.
2906 Let blanks in TEXT overwrite any text already in the buffer."
2907 (artist-text-insert-common x y text nil))
2909 (defun artist-text-see-thru (x y)
2910 "Prompt for text to render, render it at X,Y.
2911 This is done by calling the function specified by `artist-text-renderer',
2912 which must return a list of strings, to be inserted in the buffer.
2914 Text already in the buffer ``shines thru'' blanks in the rendered text."
2915 (let* ((input-text (read-string "Type text to render: "))
2916 (rendered-text (artist-funcall artist-text-renderer input-text)))
2917 (artist-text-insert-see-thru x y rendered-text)))
2920 (defun artist-text-overwrite (x y)
2921 "Prompt for text to render, render it at X,Y.
2922 This is done by calling the function specified by `artist-text-renderer',
2923 which must return a list of strings, to be inserted in the buffer.
2925 Blanks in the rendered text overwrites any text in the buffer."
2926 (let* ((input-text (read-string "Type text to render: "))
2927 (rendered-text (artist-funcall artist-text-renderer input-text)))
2928 (artist-text-insert-overwrite x y rendered-text)))
2934 (defun artist-spray-get-interval ()
2935 "Retrieves the interval for repeated spray."
2936 artist-spray-interval)
2938 (defun artist-spray-random-points (n radius)
2939 "Generate N random points within a radius of RADIUS.
2940 Returns a list of points. Each point is on the form (X1 . Y1)."
2943 (let* ((angle (* (random 359) (/ pi 180)))
2944 (dist (random radius))
2945 (point (cons (round (* dist (cos angle)))
2946 (round (* dist (sin angle))))))
2947 (setq points (cons point points)))
2951 (defun artist-spray (x1 y1)
2953 (let* ((num-points (* artist-spray-radius artist-spray-radius))
2954 (spray-points (artist-spray-random-points num-points
2955 artist-spray-radius)))
2957 ;; Replace one spray point
2958 (let* ((point (car spray-points))
2959 (x (+ x1 (car point)))
2960 (y (+ y1 (cdr point)))
2961 (buf-c (artist-get-char-at-xy-conv x y))
2962 (this-c (memq buf-c artist-spray-chars))
2963 (next-c (cond ((null this-c) artist-spray-new-char)
2964 ((null (cdr this-c)) (car this-c))
2965 (t (car (cdr this-c))))))
2966 (artist-move-to-xy x y)
2967 (artist-replace-char next-c))
2969 ;; Step to next spray point
2970 (setq spray-points (cdr spray-points)))))
2972 (defun artist-spray-clear-circle (circle x1 y1 x2 y2)
2973 "Clears circle CIRCLE at X1, Y1 through X2, Y2."
2974 (artist-undraw-circle circle))
2976 (defun artist-spray-set-radius (circle x1 y1 x2 y2)
2977 "Set spray radius from CIRCLE at X1, Y1 through X2, Y2."
2978 (let ((dx (- x2 x1))
2980 (setq artist-spray-radius (round (sqrt (+ (* dx dx) (* dy dy)))))
2981 (if (= 0 artist-spray-radius)
2982 (setq artist-spray-radius 1))))
2988 (defun artist-erase-char (x1 y1)
2989 "Erases a character at X1, Y1.
2990 The character is replaced with the character in `artist-erase-char'."
2991 (artist-move-to-xy x1 y1)
2992 (artist-replace-char artist-erase-char))
2994 (defun artist-erase-rect (rect x1 y1 x2 y2)
2995 "Erase rectangle RECT from X1, Y1, X2, Y2."
2996 (let ((artist-line-char-set t)
2997 (artist-fill-char-set t)
2998 (artist-line-char artist-erase-char)
2999 (artist-fill-char artist-erase-char))
3000 (artist-draw-rect x1 y1 x2 y2)
3001 (artist-fill-rect rect x1 y1 x2 y2)))
3005 ;; Vaporizing (erasing) line and lines
3009 (defun artist-vap-find-endpoint (x1 y1 step-x step-y accept-set reject-set)
3010 "Find one endpoint for line through X1, Y1.
3011 The endpoint is searched for in the direction defined by STEP-X, STEP-Y,
3012 accepting characters in the list ACCEPT-SET, stopping immediately
3013 when finding characters in the list REJECT-SET. Fuzziness, that is
3014 the number of consecutive characters not in ACCEPT-SET to allow as
3015 part of the line, is determined by the variable `artist-vaporize-fuzziness'.
3016 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
3023 (let ((c (artist-get-char-at-xy-conv x y)))
3024 (cond ((memq c reject-set)
3027 ;; We found a character we are accepting as part of the line.
3029 ((memq c accept-set)
3034 (if (or (< x 0) (< y 0)) ;stop at the edge
3037 ;; We found a character we are not accepting as part of
3038 ;; the line Search `artist-vaporize-fuzziness'
3039 ;; characters away from this position in the same
3040 ;; direction to see if there are any characters in the
3041 ;; accept-set. If not, we have found the endpoint.
3043 (let ((fuzziness artist-vaporize-fuzziness)
3047 ;; while we have more fuzziness left and we have not
3048 ;; found a character accepted as a line, move
3050 (while (and (> fuzziness 0) (not (memq c accept-set)))
3051 (setq x-tmp (+ x-tmp step-x))
3052 (setq y-tmp (+ y-tmp step-y))
3053 (setq c (artist-get-char-at-xy-conv x-tmp y-tmp))
3054 (setq fuzziness (- fuzziness 1)))
3055 (if (memq c accept-set)
3057 ;; The line continues on the other side of the
3058 ;; not-accepted character.
3062 ;; Else: We couldn't find any line on the other side.
3063 ;; That means we are done searching for the endpoint.
3065 (cons x-last y-last)))
3068 (defun artist-vap-find-endpoints-horiz (x y)
3069 "Find endpoints for a horizontal line through X, Y.
3070 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
3071 (list (artist-vap-find-endpoint x y 1 0 '(?- ?+) '(? ))
3072 (artist-vap-find-endpoint x y -1 0 '(?- ?+) '(? ))))
3074 (defun artist-vap-find-endpoints-vert (x y)
3075 "Find endpoints for a vertical line through X, Y.
3076 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
3077 (list (artist-vap-find-endpoint x y 0 1 '(?| ?+) '(? ))
3078 (artist-vap-find-endpoint x y 0 -1 '(?| ?+) '(? ))))
3080 (defun artist-vap-find-endpoints-swne (x y)
3081 "Find endpoints for a diagonal line (made by /'s) through X, Y.
3082 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
3083 (list (artist-vap-find-endpoint x y 1 -1 '(?/ ?X) '(? ))
3084 (artist-vap-find-endpoint x y -1 1 '(?/ ?X) '(? ))))
3086 (defun artist-vap-find-endpoints-nwse (x y)
3087 "Find endpoints for a diagonal line (made by \\'s) through X, Y.
3088 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
3089 (list (artist-vap-find-endpoint x y 1 1 '(?\\ ?X) '(? ))
3090 (artist-vap-find-endpoint x y -1 -1 '(?\\ ?X) '(? ))))
3093 (defun artist-vap-find-endpoints (x y)
3094 "Given a point X1, Y1, return a list of endpoints of lines through X, Y.
3095 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
3096 (if artist-line-char-set
3098 (let ((c (artist-get-char-at-xy-conv x y)))
3099 (cond ((eq c ?-) (artist-vap-find-endpoints-horiz x y))
3100 ((eq c ?|) (artist-vap-find-endpoints-vert x y))
3101 ((eq c ?/) (artist-vap-find-endpoints-swne x y))
3102 ((eq c ?\\) (artist-vap-find-endpoints-nwse x y))
3103 ((eq c ?+) (append (artist-vap-find-endpoints-horiz x y)
3104 (artist-vap-find-endpoints-vert x y)))
3105 ((eq c ?X) (append (artist-vap-find-endpoints-swne x y)
3106 (artist-vap-find-endpoints-nwse x y)))
3108 ;; We don't know how to find directions when we are on
3109 ;; another character
3113 (defun artist-vap-group-in-pairs (l)
3114 "Group elements in list L in pairs."
3115 (cond ((null l) nil)
3116 ((null (cdr l)) l) ; unevent number of elements in list
3117 (t (append (list (list (car l) (car (cdr l))))
3118 (artist-vap-group-in-pairs (cdr (cdr l)))))))
3120 (defun artist-vaporize-by-endpoints (endpoint1 endpoint2)
3121 "Given ENDPOINT1 and ENDPOINT2, vaporize the line between them.
3122 An endpoint is a pair (X . Y)."
3123 (let* ((x1 (car endpoint1))
3124 (y1 (cdr endpoint1))
3125 (x2 (car endpoint2))
3126 (y2 (cdr endpoint2))
3127 (dir (artist-find-direction x1 y1 x2 y2))
3128 (x-step (aref [1 1 0 -1 -1 -1 0 1] dir))
3129 (y-step (aref [0 1 1 1 0 -1 -1 -1] dir))
3130 (line-c (aref [?- ?\\ ?| ?/ ?- ?\\ ?| ?/] dir))
3131 (line-len (elt (list (abs (- x2 x1))
3142 (while (>= line-len 0)
3143 (let* ((buffer-c (artist-get-char-at-xy-conv x y))
3144 (new-c (artist-unintersection-char line-c buffer-c)))
3145 (artist-move-to-xy x y)
3146 (artist-replace-char new-c))
3147 (setq x (+ x x-step)
3149 line-len (- line-len 1)))))
3152 (defun artist-vaporize-line (x1 y1)
3153 "Vaporize (erase) the straight line through X1, Y1.
3154 Do this by replacing the characters that forms the line with
3155 `artist-erase-char'. Output is a list of endpoints for lines
3156 through X1, Y1. An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
3157 (let ((endpoints (artist-vap-find-endpoints x1 y1)))
3160 (let ((ep1 (car endpoints))
3161 (ep2 (car (cdr endpoints))))
3162 (artist-vaporize-by-endpoints ep1 ep2)))
3163 (artist-vap-group-in-pairs endpoints))
3167 ;; Implementation note: This depends on artist-vaporize-line doing
3168 ;; unintersections of intersecting lines.
3171 ;; Suppose the buffer looks like this and that we start vaporizing
3172 ;; lines at (3,0) (at the ``*'').
3180 ;; We will then push (0,0) and (6,0) on the stack, and vaporize the
3181 ;; topmost horizontal line:
3189 ;; We will then pop (0,0) and remove the left-most vertival line while
3190 ;; pushing the lower left corner (0,3) on the stack, and so on until
3191 ;; the entire rectangle is vaporized.
3193 ;; Now, What if the `+' in the upper left and upper right corners,
3194 ;; had not been changed to `|' but to spaces instead? We would
3195 ;; have failed when popping (0,0) and vaporizing that line because
3196 ;; we wouldn't find any line at (0,0):
3204 ;; That's why we depend on artist-vaporize-line doing unintersecting
3205 ;; of crossing lines. There are alternative ways to handle this
3206 ;; if it becomes too much a trouble.
3208 (defun artist-vaporize-lines (x1 y1)
3209 "Vaporize lines reachable from point X1, Y1."
3210 (let ((ep-stack nil))
3212 (lambda (ep) (push ep ep-stack))
3213 (artist-vap-find-endpoints x1 y1))
3214 (while (not (null ep-stack))
3215 (let* ((vaporize-point (pop ep-stack))
3216 (new-endpoints (artist-vaporize-line (car vaporize-point)
3217 (cdr vaporize-point))))
3219 (lambda (endpoint) (push endpoint ep-stack))
3224 ;; Circles and ellipses
3226 (defun artist-ellipse-generate-quadrant (x-radius y-radius)
3227 "Create a point-list for first quadrant.
3228 Points go from (X-RADIUS, 0) to (0, Y-RADIUS).
3229 Quadrant is generated around origo."
3230 (let* ((rx2 (* x-radius x-radius))
3231 (ry2 (* y-radius y-radius))
3240 (artist-put-pixel point-list x y)
3241 (setq p (round (+ ry2 (- (* rx2 y-radius)) (* 0.25 rx2))))
3246 (setq p (+ p ry2 px))
3249 p (+ p ry2 px (- py))))
3250 (artist-put-pixel point-list x y))
3251 (setq p (round (+ (* ry2 (+ x 0.5) (+ x 0.5))
3252 (* rx2 (- y 1) (- y 1))
3258 (setq p (+ p rx2 (- py)))
3261 p (+ p rx2 (- py) px)))
3262 (artist-put-pixel point-list x y))
3265 (defsubst artist-new-fill-item (x y width)
3266 "Create a new item at X, Y, with WIDTH.
3267 This is for use in fill-info in ellipses and circles."
3268 (let ((new-item (make-vector 3 x)))
3270 (aset new-item 2 width)
3273 (defsubst artist-fill-item-get-x (fill-item)
3274 "Retrieve the x component of a FILL-ITEM."
3277 (defsubst artist-fill-item-set-x (fill-item new-x)
3278 "Set the x component of a FILL-ITEM to NEW-X."
3279 (aset fill-item 0 new-x)
3282 (defsubst artist-fill-item-get-y (fill-item)
3283 "Retrieve the y component of a FILL-ITEM."
3286 (defsubst artist-fill-item-set-y (fill-item new-y)
3287 "Set the y component of a FILL-ITEM to NEW-Y."
3288 (aset fill-item 1 new-y)
3291 (defsubst artist-fill-item-get-width (fill-item)
3292 "Retrieve the width component of a FILL-ITEM."
3295 (defsubst artist-fill-item-set-width (fill-item new-width)
3296 "Set the width component of a FILL-ITEM to NEW-WIDTH."
3297 (aset fill-item 2 new-width)
3301 (defun artist-ellipse-point-list-add-center (x-center y-center point-list)
3302 "Add offsets X-CENTER and Y-CENTER to coordinates in POINT-LIST."
3305 (artist-coord-set-x p (+ x-center (artist-coord-get-x p)))
3306 (artist-coord-set-y p (+ y-center (artist-coord-get-y p))))
3310 (defun artist-ellipse-fill-info-add-center (x-center y-center fill-info)
3311 "Add offsets X-CENTER and Y-CENTER to fill-items in FILL-INFO."
3314 (artist-fill-item-set-x p (+ x-center (artist-fill-item-get-x p)))
3315 (artist-fill-item-set-y p (+ y-center (artist-fill-item-get-y p))))
3318 (defun artist-ellipse-remove-0-fills (fill-info)
3319 "Remove fill-infos from FILL-INFO that fills a zero-width field."
3320 (cond ((null fill-info)
3322 ((= 0 (artist-fill-item-get-width (car fill-info)))
3323 (artist-ellipse-remove-0-fills (cdr fill-info)))
3325 (append (list (car fill-info))
3326 (artist-ellipse-remove-0-fills (cdr fill-info))))))
3329 (defun artist-ellipse-compute-fill-info (point-list)
3330 "Compute fill info for ellipse around 0,0 from POINT-LIST.
3331 The POINT-LIST is expected to cover the first quadrant."
3332 (let ((first-half nil)
3336 ;; Create first half (the lower one (since y grows downwards)) from
3337 ;; the first quadrant.
3340 (let* ((x (artist-coord-get-x coord))
3341 (y (artist-coord-get-y coord))
3342 (width (max (- (* 2 x) 1) 0))
3343 (left-edge (- x width)))
3344 (if (or (null last-y) (not (= y last-y)))
3345 ;; This was either the first time,
3346 ;; or it was the first time on a new line
3349 ;; Fill info item starts at left-edge on line y
3350 (list (artist-new-fill-item left-edge y width)))))
3354 ;; Create the other half by mirroring the first half.
3359 (artist-new-fill-item (artist-fill-item-get-x i)
3360 (- (artist-fill-item-get-y i))
3361 (artist-fill-item-get-width i)))
3362 ;; The cdr below is so we don't include fill-info for
3363 ;;; the middle line twice
3364 (cdr (reverse first-half)))))
3365 (artist-ellipse-remove-0-fills both-halves)))
3368 (defun artist-ellipse-mirror-quadrant (point-list)
3369 "Mirror a POINT-LIST describing first quadrant to create a complete ellipse."
3370 (let ((right-half nil)
3373 ;; First, if last char in that quadrant is `/', then replace it with `)'
3374 ;; This way we avoids things
3375 ;; --------- ---------
3377 ;; that look like: \ / instead we get: ( )
3379 ;; --------- ---------
3380 (let ((last-coord (last point-list)))
3381 (if (= (artist-coord-get-new-char last-coord) ?/)
3382 (artist-coord-set-new-char last-coord artist-ellipse-right-char)))
3384 ;; Create the other part of the right half by mirroring the first part
3390 (let ((c (artist-coord-get-new-char coord)))
3391 (artist-new-coord (artist-coord-get-x coord)
3392 (- (artist-coord-get-y coord))
3393 (cond ((= c ?/) ?\\)
3396 ;; The cdr below is so we don't draw the middle right char twice
3397 (cdr (reverse point-list)))))
3399 ;; Create the left half by mirroring the right half.
3403 (let ((c (artist-coord-get-new-char coord)))
3404 (artist-new-coord (- (artist-coord-get-x coord))
3405 (artist-coord-get-y coord)
3406 (cond ((= c ?/) ?\\)
3408 ((= c artist-ellipse-right-char)
3409 artist-ellipse-left-char)
3411 ;; The cdr and butlast below is so we don't draw the middle top
3412 ;; and middle bottom char twice.
3413 (butlast (cdr (reverse right-half)))))
3414 (append right-half left-half)))
3417 (defun artist-draw-ellipse-general (x1 y1 x-radius y-radius)
3418 "Draw an ellipse with center at X1, Y1 and X-RADIUS and Y-RADIUS.
3420 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
3422 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
3423 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].
3425 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
3426 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE].
3428 Ellipses with zero Y-RADIUS are not drawn correctly."
3429 (let* ((point-list (artist-ellipse-generate-quadrant x-radius y-radius))
3430 (fill-info (artist-ellipse-compute-fill-info point-list))
3431 (shape-info (make-vector 2 0)))
3433 (setq point-list (artist-calculate-new-chars point-list))
3434 (setq point-list (artist-ellipse-mirror-quadrant point-list))
3435 (setq point-list (artist-ellipse-point-list-add-center x1 y1 point-list))
3436 (setq fill-info (artist-ellipse-fill-info-add-center x1 y1 fill-info))
3442 (artist-move-to-xy (artist-coord-get-x coord)
3443 (artist-coord-get-y coord))
3444 (if artist-line-char-set
3445 (artist-replace-char artist-line-char)
3446 (artist-replace-char (artist-coord-get-new-char coord)))
3448 (artist-modify-new-chars
3449 (artist-save-chars-under-point-list point-list))))
3451 (aset shape-info 0 point-list)
3452 (aset shape-info 1 fill-info)
3453 (artist-make-2point-object (artist-make-endpoint x1 y1)
3454 (artist-make-endpoint x-radius y-radius)
3457 (defun artist-draw-ellipse-with-0-height (x1 y1 x-radius y-radius)
3458 "Draw an ellipse with center at X1, Y1 and X-RADIUS and Y-RADIUS.
3460 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
3462 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
3463 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].
3465 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
3466 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE].
3468 The Y-RADIUS must be 0, but the X-RADIUS must not be 0."
3469 (let ((point-list nil)
3470 (width (max (- (abs (* 2 x-radius)) 1)))
3471 (left-edge (1+ (- x1 (abs x-radius))))
3472 (line-char (if artist-line-char-set artist-line-char ?-))
3476 (shape-info (make-vector 2 0)))
3478 (let* ((line-x (+ left-edge i))
3480 (new-coord (artist-new-coord line-x line-y)))
3481 (artist-coord-add-saved-char new-coord
3482 (artist-get-char-at-xy line-x line-y))
3483 (artist-move-to-xy line-x line-y)
3484 (artist-replace-char line-char)
3485 (setq point-list (append point-list (list new-coord)))
3487 (aset shape-info 0 point-list)
3488 (aset shape-info 1 fill-info)
3489 (artist-make-2point-object (artist-make-endpoint x1 y1)
3490 (artist-make-endpoint x-radius y-radius)
3493 (defun artist-draw-ellipse (x1 y1 x2 y2)
3494 "Draw an ellipse with center at X1, Y1 and point X2,Y2.
3496 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
3498 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
3499 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].
3501 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
3502 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]."
3503 (let* ((artist-line-char (artist-compute-line-char))
3504 (artist-line-char-set artist-line-char)
3505 (width (abs (- x2 x1)))
3506 (height (abs (- y2 y1)))
3508 ;; When we draw our ellipse, we want it to go through the cursor
3509 ;; position, but since x1,y1, x2,y2 marks the corners of one
3510 ;; of the quadrants, we have to enlarge the ellipse a bit.
3511 ;; Ok, so then why by sqrt(2)?
3512 ;; It comes from the equation for the ellipse (where a is the
3513 ;; x-radius and b is the y-radius):
3514 ;; f(x,y) = x^2 / a^2 + y^2 / b^2 - 1 = 0
3515 ;; and the fact that we want the enlarged ellipse to have the
3516 ;; same proportions as the smaller square, therefore we have:
3518 ;; Solving this yields a-in-larger-ellipse = a-in-smaller * sqrt(2)
3519 (x-radius (round (* width (sqrt 2))))
3520 (y-radius (round (* height (sqrt 2))))
3523 (if (and (= y1 y2) (not (= x1 x2)))
3524 (artist-draw-ellipse-with-0-height x y x-radius y-radius)
3525 (artist-draw-ellipse-general x y x-radius y-radius))))
3528 (defun artist-undraw-ellipse (ellipse)
3531 (let ((point-list (aref (artist-2point-get-shapeinfo ellipse) 0)))
3534 (artist-move-to-xy (artist-coord-get-x coord)
3535 (artist-coord-get-y coord))
3536 (artist-replace-char (artist-coord-get-saved-char coord))
3541 (defun artist-draw-circle (x1 y1 x2 y2)
3542 "Draw a circle with center at X1, Y1 and point X2,Y2.
3544 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
3546 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
3547 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].
3549 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
3550 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]."
3551 (let* ((artist-line-char (artist-compute-line-char))
3552 (artist-line-char-set artist-line-char)
3553 (width (abs (- x2 x1)))
3554 (height (abs (- y2 y1)))
3555 ;; When drawing our circle, we want it to through the cursor
3556 ;; just as when drawing the ellispe, but we have to take
3557 ;; care for the aspect-ratio.
3558 ;; The equation for the ellipse (where a is the x-radius and
3559 ;; b is the y-radius):
3560 ;; f(x,y) = x^2 / a^2 + y^2 / b^2 - 1 = 0
3561 ;; together with the relationship
3562 ;; a = aspect-ratio * b
3564 ;; a = sqrt( x^2 + (aspect-ratio * y)^2 ) and
3565 ;; b = a / aspect-ratio
3566 (x-radius (round (sqrt (+ (* width width)
3567 (* (* artist-aspect-ratio height)
3568 (* artist-aspect-ratio height))))))
3569 (y-radius (round (/ x-radius artist-aspect-ratio))))
3570 (artist-draw-ellipse-general x1 y1 x-radius y-radius)))
3572 (defalias 'artist-undraw-circle 'artist-undraw-ellipse)
3578 (defun artist-fill-ellipse (ellipse x y x-radius y-radius)
3579 "Fill an ELLIPSE centered at X,Y with radius X-RADIUS and Y-RADIUS."
3580 (let ((fill-info (aref (artist-2point-get-shapeinfo ellipse) 1)))
3583 (artist-move-to-xy (artist-fill-item-get-x fill-item)
3584 (artist-fill-item-get-y fill-item))
3585 (artist-replace-chars artist-fill-char
3586 (artist-fill-item-get-width fill-item))
3590 (defalias 'artist-fill-circle 'artist-fill-ellipse)
3594 ;; Cutting, copying and pasting rectangles and squares
3595 ;; (filling functions)
3598 (defun artist-cut-rect (rect x1 y1 x2 y2)
3599 "Copy rectangle RECT drawn from X1, Y1 to X2, Y2, then clear it."
3600 (artist-undraw-rect rect)
3601 (artist-copy-generic x1 y1 x2 y2)
3602 (artist-erase-rect rect x1 y1 x2 y2))
3604 (defun artist-cut-square (square x1 y1 x2 y2)
3605 "Copy a SQUARE drawn from X1, Y1 to X2, Y2 (made square), then clears it."
3606 (artist-undraw-square square)
3607 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
3608 (new-x1 (elt square-corners 0))
3609 (new-y1 (elt square-corners 1))
3610 (new-x2 (elt square-corners 2))
3611 (new-y2 (elt square-corners 3)))
3612 (artist-copy-generic new-x1 new-y1 new-x2 new-y2)
3613 (artist-erase-rect square new-x1 new-y1 new-x2 new-y2)))
3616 (defun artist-get-buffer-contents-at-xy (x y width)
3617 "Retrieve contents from the buffer at X, Y. WIDTH characters are returned."
3618 (artist-move-to-xy x y)
3619 (let ((here (point))
3620 (there (save-excursion (artist-move-to-xy (+ x width) y) (point))))
3621 (untabify here there)
3622 (setq there (save-excursion (artist-move-to-xy (+ x width) y) (point)))
3623 (buffer-substring here there)))
3626 (defun artist-copy-generic (x1 y1 x2 y2)
3627 "Copy a rectangular area with corners at X1, Y1 and X2, Y2.
3628 Output is a copy buffer, a list of strings, representing the
3629 original contents of that area in the buffer."
3630 (let* ((x (min x1 x2))
3634 (w (+ (- x-max x) 1))
3637 (setq l (cons (artist-get-buffer-contents-at-xy x y w) l))
3639 (if artist-interface-with-rect
3640 (setq killed-rectangle (reverse l))
3641 (setq artist-copy-buffer (reverse l)))))
3644 (defun artist-copy-rect (rect x1 y1 x2 y2)
3645 "Copy rectangle RECT drawn from X1, Y1 to X2, Y2."
3646 (artist-undraw-rect rect)
3647 (artist-copy-generic x1 y1 x2 y2))
3649 (defun artist-copy-square (square x1 y1 x2 y2)
3650 "Copies a SQUARE drawn from X1, Y1 to X2, Y2 (but made square)."
3651 (artist-undraw-square square)
3652 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
3653 (new-x1 (elt square-corners 0))
3654 (new-y1 (elt square-corners 1))
3655 (new-x2 (elt square-corners 2))
3656 (new-y2 (elt square-corners 3)))
3657 (artist-copy-generic new-x1 new-y1 new-x2 new-y2)))
3659 (defun artist-paste (x y)
3660 "Pastes the contents of the copy-buffer at X,Y."
3661 (let ((copy-buf (if artist-interface-with-rect
3663 artist-copy-buffer)))
3664 (if (not (null copy-buf))
3665 (while (not (null copy-buf))
3666 (artist-move-to-xy x y)
3667 (artist-replace-string (car copy-buf))
3668 (setq copy-buf (cdr copy-buf))
3670 (message "Nothing to paste"))))
3676 (defun artist-ff-too-far-right (x)
3677 "Determine if the position X is too far to the right."
3678 (cond ((numberp artist-flood-fill-right-border)
3679 (> x artist-flood-fill-right-border))
3680 ((eq artist-flood-fill-right-border 'window-width)
3681 (> x (- (window-width) 2)))
3682 ((eq artist-flood-fill-right-border 'fill-column)
3684 (t (error "Invalid value for `artist-flood-fill-right-border'"))))
3686 (defun artist-ff-get-rightmost-from-xy (x y)
3687 "Find the rightmost position in this run, starting at X, Y."
3689 (let ((char-at-xy (artist-get-char-at-xy-conv x y))
3692 (while (and (not (artist-ff-too-far-right x))
3693 (= char-at-xy (artist-get-char-at-xy-conv x y)))
3698 (defun artist-ff-is-topmost-line (x y)
3699 "Determine whether the position X,Y is on the topmost line or not."
3702 (defun artist-ff-is-bottommost-line (x y)
3703 "Determine whether the position X,Y is on the bottommost line or not."
3705 (goto-char (point-max))
3707 (let ((last-line (artist-current-line)))
3708 (if (= (point) (point-max))
3710 ;; Last line is empty, don't paint on it, report previous line
3712 (>= y (- last-line 1))
3713 (>= y last-line)))))
3715 (defun artist-flood-fill (x1 y1)
3716 "Flood-fill starting at X1, Y1. Fill with the char in `artist-fill-char'."
3719 ;; We are flood-filling the area that has this character.
3720 (c (artist-get-char-at-xy-conv x1 y1))
3721 (artist-fill-char (if artist-fill-char-set
3723 artist-default-fill-char)))
3725 ;; Fill only if the fill-char is not the same as the character whose
3726 ;; area we are about to fill, or, in other words, don't fill if we
3728 (if (not (= c artist-fill-char))
3729 (push (artist-new-coord x1 y1) stack))
3731 (while (not (null stack))
3732 (let* ((coord (pop stack))
3733 (x (artist-coord-get-x coord))
3734 (y (artist-coord-get-y coord))
3736 ;; Here we keep track of the leftmost and rightmost position
3742 ;; Remember if line above and below are accessible
3743 ;; Lines below the last one, and prior to the first-one
3744 ;; are not accessible.
3748 ;; Remember char for position on line above and below, so we
3749 ;; can find the rightmost positions on the runs.
3753 (setq x-rightmost (artist-ff-get-rightmost-from-xy x y))
3754 (setq lines-above (not (artist-ff-is-topmost-line x y)))
3755 (setq lines-below (not (artist-ff-is-bottommost-line x y)))
3756 (setq last-x x-rightmost)
3757 (setq x x-rightmost)
3759 ;; Search line above, push rightmost positions of runs for that line
3760 (while (and (>= x 0) (= c (artist-get-char-at-xy-conv x y)))
3762 (let ((c-above (artist-get-char-at-xy-conv x (- y 1))))
3763 (if (and (= c-above c) (/= c-above last-c-above))
3764 (push (artist-new-coord x (- y 1)) stack))
3765 (setq last-c-above c-above)))
3769 ;; Remember the left-most position on this run
3770 (setq x-leftmost last-x)
3772 ;; Search line below, push rightmost positions of runs for that line
3773 (setq x x-rightmost)
3774 (while (>= x x-leftmost)
3776 (let ((c-below (artist-get-char-at-xy-conv x (1+ y))))
3777 (if (and (= c-below c) (/= c-below last-c-below))
3778 (push (artist-new-coord x (1+ y)) stack))
3779 (setq last-c-below c-below)))
3782 (artist-move-to-xy x-leftmost y)
3783 (artist-replace-chars artist-fill-char (1+ (- x-rightmost x-leftmost)))
3785 ;; If we are to show incrementally, we have to remove any pending
3786 ;; input from the input queue, because processing of pending input
3787 ;; always has priority over display updates (although this input
3788 ;; won't be processed until we are done). Later on we will queue
3789 ;; the input on the input queue again.
3790 (if artist-flood-fill-show-incrementally
3792 (if (input-pending-p)
3794 (artist-update-display)))))))
3797 ;; Accessors to arrow-points
3800 (defun artist-make-arrow-point (x y direction &optional state)
3801 "Create an arrow point at X, Y for a line in direction DIRECTION.
3802 Optional argument STATE can be used to set state (default is nil)."
3804 (let* ((arrow-point (make-vector 4 0))
3805 (arrow-marker (make-marker)))
3806 (artist-move-to-xy x y)
3807 (set-marker arrow-marker (point))
3808 (aset arrow-point 0 arrow-marker)
3809 (aset arrow-point 1 (artist-get-char-at-xy x y))
3810 (aset arrow-point 2 direction)
3811 (aset arrow-point 3 state)
3814 (defsubst artist-arrow-point-get-marker (arrow-point)
3815 "Retrieve the marker component of an ARROW-POINT."
3816 (aref arrow-point 0))
3818 (defsubst artist-arrow-point-get-orig-char (arrow-point)
3819 "Retrieve the orig char component of an ARROW-POINT."
3820 (aref arrow-point 1))
3822 (defsubst artist-arrow-point-get-direction (arrow-point)
3823 "Retrieve the direction component of an ARROW-POINT."
3824 (aref arrow-point 2))
3826 (defsubst artist-arrow-point-get-state (arrow-point)
3827 "Retrieve the state component of an ARROW-POINT."
3828 (aref arrow-point 3))
3830 (defsubst artist-arrow-point-set-state (arrow-point new-state)
3831 "Set the state component of an ARROW-POINT to NEW-STATE."
3832 (aset arrow-point 3 new-state))
3835 (defun artist-clear-arrow-points ()
3836 "Clear current endpoints."
3837 (setq artist-arrow-point-1 nil)
3838 (setq artist-arrow-point-2 nil))
3840 (defun artist-set-arrow-points-for-poly (point-list)
3841 "Generic function for setting arrow-points for poly-shapes from POINT-LIST."
3842 (let* ((ep1 (elt point-list 0))
3843 (ep2 (elt point-list 1))
3844 (x1 (artist-endpoint-get-x ep1))
3845 (y1 (artist-endpoint-get-y ep1))
3846 (x2 (artist-endpoint-get-x ep2))
3847 (y2 (artist-endpoint-get-y ep2))
3848 (dir1 (artist-find-direction x2 y2 x1 y1))
3849 (epn (last point-list))
3850 (epn-1 (last point-list 2))
3851 (xn (artist-endpoint-get-x epn))
3852 (yn (artist-endpoint-get-y epn))
3853 (xn-1 (artist-endpoint-get-x epn-1))
3854 (yn-1 (artist-endpoint-get-y epn-1))
3855 (dirn (artist-find-direction xn-1 yn-1 xn yn)))
3856 (setq artist-arrow-point-1 (artist-make-arrow-point x1 y1 dir1))
3857 (setq artist-arrow-point-2 (artist-make-arrow-point xn yn dirn))))
3860 (defun artist-set-arrow-points-for-2points (shape x1 y1 x2 y2)
3861 "Generic function for setting arrow-points for 2-point shapes.
3862 The 2-point shape SHAPE is drawn from X1, Y1 to X2, Y2."
3863 (let* ((endpoint1 (artist-2point-get-endpoint1 shape))
3864 (endpoint2 (artist-2point-get-endpoint2 shape))
3865 (x1 (artist-endpoint-get-x endpoint1))
3866 (y1 (artist-endpoint-get-y endpoint1))
3867 (x2 (artist-endpoint-get-x endpoint2))
3868 (y2 (artist-endpoint-get-y endpoint2)))
3869 (setq artist-arrow-point-1
3870 (artist-make-arrow-point x1 y1
3871 (artist-find-direction x2 y2 x1 y1)))
3872 (setq artist-arrow-point-2
3873 (artist-make-arrow-point x2 y2
3874 (artist-find-direction x1 y1 x2 y2)))))
3878 ;; Common routine for drawing/undrawing shapes based
3882 (defun artist-key-undraw-continously (x y)
3883 "Undraw current continous shape with point at X, Y."
3884 ;; No undraw-info for continous shapes
3887 (defun artist-key-undraw-poly (x y)
3888 "Undraw current poly shape with point at X, Y."
3889 (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
3890 (x1 (artist-endpoint-get-x artist-key-endpoint1))
3891 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
3892 (artist-funcall undraw-fn artist-key-shape)))
3894 (defun artist-key-undraw-1point (x y)
3895 "Undraw current 1-point shape at X, Y."
3896 ;; No undraw-info for 1-point shapes
3899 (defun artist-key-undraw-2points (x y)
3900 "Undraw current 2-point shape at X, Y."
3901 (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
3902 (x1 (artist-endpoint-get-x artist-key-endpoint1))
3903 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
3904 (artist-funcall undraw-fn artist-key-shape)))
3906 (defun artist-key-undraw-common ()
3907 "Common routine undrawing current shape."
3908 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go))
3909 (col (artist-current-column))
3910 (row (artist-current-line)))
3912 ;; Depending on what we are currently drawing, call other routines
3913 ;; that knows how to do the job
3915 (cond ((eq draw-how 'artist-do-continously)
3916 (artist-key-undraw-continously col row))
3917 ((eq draw-how 'artist-do-poly)
3918 (artist-key-undraw-poly col row))
3919 ((and (numberp draw-how) (= draw-how 1))
3920 (artist-key-undraw-1point col row))
3921 ((and (numberp draw-how) (= draw-how 2))
3922 (artist-key-undraw-2points col row))
3923 (t (message "Undrawing \"%s\"s is not yet implemented" draw-how)))
3925 ;; Now restore the old position
3927 (artist-move-to-xy col row)))
3931 ;; Implementation note: This really should honor the interval-fn entry
3932 ;; in the master table, `artist-mt', which would mean leaving a timer
3933 ;; that calls `draw-fn' every now and then. That timer would then have
3934 ;; to be cancelled and reinstalled whenever the user moves the cursor.
3935 ;; This could be done, but what if the user suddenly switches to another
3936 ;; drawing mode, or even kills the buffer! In the mouse case, it is much
3937 ;; simpler: when at the end of `artist-mouse-draw-continously', the
3938 ;; user has released the button, so the timer will always be cancelled
3940 (defun artist-key-draw-continously (x y)
3941 "Draws current continous shape at X,Y."
3942 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)))
3943 (setq artist-key-shape (artist-funcall draw-fn x y))))
3945 (defun artist-key-draw-poly (x y)
3946 "Draws current poly-point shape with nth point at X,Y."
3947 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
3948 (x1 (artist-endpoint-get-x artist-key-endpoint1))
3949 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
3950 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x y))))
3952 (defun artist-key-draw-1point (x y)
3953 "Draws current 1-point shape at X,Y."
3954 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)))
3955 (setq artist-key-shape (artist-funcall draw-fn x y))))
3958 (defun artist-key-draw-2points (x y)
3959 "Draws current 2-point shape at X,Y."
3960 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
3961 (x1 (artist-endpoint-get-x artist-key-endpoint1))
3962 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
3963 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x y))))
3965 (defun artist-key-draw-common ()
3966 "Common routine for drawing current shape."
3967 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go))
3968 (col (artist-current-column))
3969 (row (artist-current-line)))
3971 ;; Depending on what we are currently drawing, call other routines
3972 ;; that knows how to do the job
3974 (cond ((eq draw-how 'artist-do-continously)
3975 (artist-key-draw-continously col row))
3976 ((eq draw-how 'artist-do-poly)
3977 (artist-key-draw-poly col row))
3978 ((and (numberp draw-how) (= draw-how 1))
3979 (artist-key-draw-1point col row))
3980 ((and (numberp draw-how) (= draw-how 2))
3981 (artist-key-draw-2points col row))
3982 (t (message "Drawing \"%s\"s is not yet implemented" draw-how)))
3984 ;; Now restore the old position
3986 (artist-move-to-xy col row)))
3991 ;; Functions related to trimming line-endings
3992 ;; The region between the topmost and bottommost visited line is
3993 ;; called a draw-region.
3996 (defun artist-draw-region-reset ()
3997 "Reset the current draw-region."
3998 (setq artist-draw-region-max-y 0)
3999 (setq artist-draw-region-min-y 1000000))
4001 (defun artist-draw-region-trim-line-endings (min-y max-y)
4002 "Trim lines in current draw-region from MIN-Y to MAX-Y.
4003 Trimming here means removing white space at end of a line."
4004 ;; Safetyc check: switch min-y and max-y if if max-y is smaller
4010 (let ((curr-y min-y))
4011 (while (<= curr-y max-y)
4012 (artist-move-to-xy 0 curr-y)
4014 (delete-horizontal-space)
4015 (setq curr-y (1+ curr-y))))))
4018 ;; Drawing shapes by using keys
4021 (defun artist-key-do-continously-continously (x y)
4022 "Update current continous shape at X,Y."
4023 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)))
4024 (artist-funcall draw-fn x y)))
4027 (defun artist-key-do-continously-poly (x y)
4028 "Update current poly-point shape with nth point at X,Y."
4029 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
4030 (undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
4031 (x1 (artist-endpoint-get-x artist-key-endpoint1))
4032 (y1 (artist-endpoint-get-y artist-key-endpoint1))
4035 ;; If not rubber-banding, then move the 2
4036 ;; Otherwise re-draw the shape to the new position
4038 (if (not artist-rubber-banding)
4040 (artist-no-rb-unset-point2)
4041 (artist-no-rb-set-point2 x y))
4043 (artist-funcall undraw-fn artist-key-shape)
4044 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))))
4047 (defun artist-key-do-continously-1point (x y)
4048 "Update current 1-point shape at X,Y."
4049 ;; Nothing to do continously for operations
4050 ;; where we have only one input point
4053 (defun artist-key-do-continously-2points (x y)
4054 "Update current 2-point shape with 2nd point at X,Y."
4055 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
4056 (undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
4057 (x1 (artist-endpoint-get-x artist-key-endpoint1))
4058 (y1 (artist-endpoint-get-y artist-key-endpoint1))
4061 ;; If not rubber-banding, then move the 2
4062 ;; Otherwise re-draw the shape to the new position
4064 (if (not artist-rubber-banding)
4066 (artist-no-rb-unset-point2)
4067 (artist-no-rb-set-point2 x y))
4069 (artist-funcall undraw-fn artist-key-shape)
4070 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))))
4073 (defun artist-key-do-continously-common ()
4074 "Common routine for updating current shape."
4075 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go))
4076 (col (artist-current-column))
4077 (row (artist-current-line)))
4079 ;; Depending on what we are currently drawing, call other routines
4080 ;; that knows how to do the job
4082 (cond ((eq draw-how 'artist-do-continously)
4083 (artist-key-do-continously-continously col row))
4084 ((eq draw-how 'artist-do-poly)
4085 (artist-key-do-continously-poly col row))
4086 ((and (numberp draw-how) (= draw-how 1))
4087 (artist-key-do-continously-1point col row))
4088 ((and (numberp draw-how) (= draw-how 2))
4089 (artist-key-do-continously-2points col row))
4090 (t (message "Drawing \"%s\"s is not yet implemented" draw-how)))
4092 ;; Now restore the old position
4094 (artist-move-to-xy col row)))
4097 (defun artist-key-set-point-continously (x y)
4098 "Set point for current continous shape at X,Y."
4099 ;; Maybe set arrow-points for continous shapes
4100 (let ((arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
4101 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go))
4102 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
4103 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go))
4104 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go)))
4106 (if (not artist-key-is-drawing)
4107 ;; *** We are about to begin drawing
4109 (artist-funcall init-fn x y))
4111 ;; *** We are about to stop drawing
4114 (artist-funcall prep-fill-fn x y)
4115 (if (artist-funcall arrow-pred)
4116 (artist-funcall arrow-set-fn x y)
4117 (artist-clear-arrow-points))
4118 (artist-funcall exit-fn x y))))
4120 ;; Toggle the is-drawing flag
4121 (setq artist-key-is-drawing (not artist-key-is-drawing)))
4125 (defun artist-key-set-point-poly (x y &optional this-is-last-point)
4126 "Set point for current poly-point shape at X,Y.
4127 If optional argument THIS-IS-LAST-POINT is non-nil, this point is the last."
4128 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
4129 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
4130 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go))
4131 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
4132 (fill-pred (artist-go-get-fill-pred-from-symbol artist-curr-go))
4133 (fill-fn (artist-go-get-fill-fn-from-symbol artist-curr-go))
4134 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
4135 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go)))
4137 (if (not artist-key-is-drawing)
4139 ;; *** We were not drawing ==> set first point
4142 (artist-funcall init-fn x y)
4144 ;; If not rubber-banding, set first point.
4145 ;; Otherwise, draw the shape from x,y to x,y
4146 (if (not artist-rubber-banding)
4147 (artist-no-rb-set-point1 x y)
4148 (setq artist-key-shape (artist-funcall draw-fn x y x y)))
4150 ;; Set first endpoint
4151 (setq artist-key-endpoint1 (artist-make-endpoint x y))
4153 ;; Set point-list to contain start point
4154 (setq artist-key-poly-point-list (list (artist-make-endpoint x y)))
4156 ;; Since we are not ready, set the arrow-points to nil
4157 (artist-clear-arrow-points)
4159 ;; Change state to drawing
4160 (setq artist-key-is-drawing t)
4163 (message (substitute-command-keys
4164 (concat "First point set. "
4165 "Set next with \\[artist-key-set-point], "
4166 "set last with C-u \\[artist-key-set-point]"))))
4169 ;; *** We were drawing ==> we are about to set nth point
4170 ;; (last point if the argument this-is-last-point is non-nil)
4172 (let ((x1 (artist-endpoint-get-x artist-key-endpoint1))
4173 (y1 (artist-endpoint-get-y artist-key-endpoint1))
4177 ;; If not rubber-banding, undraw the 1's and 2's, then
4178 ;; draw the shape (if we were rubber-banding, then the
4179 ;; shape is already drawn in artist-key-do-continously-2points.)
4181 (if (not artist-rubber-banding)
4183 (artist-no-rb-unset-points)
4184 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))
4186 ;; Set x2 and y2 from shape's second point
4187 ;; (which might be different from the mouse's second point,
4188 ;; if, for example, we are drawing a straight line)
4190 (if (not (null artist-key-shape))
4191 (let ((endpoint2 (artist-2point-get-endpoint2 artist-key-shape)))
4192 (setq x2 (artist-endpoint-get-x endpoint2))
4193 (setq y2 (artist-endpoint-get-y endpoint2))))
4195 ;; Add the endpoint to the list of poly-points
4196 (setq artist-key-poly-point-list
4197 (append artist-key-poly-point-list
4198 (list (artist-make-endpoint x2 y2))))
4200 ;; Now do handle the case when this is the last point,
4201 ;; and the case when this point isn't the last
4203 (if (not this-is-last-point)
4204 ;; ** This is not the last point
4206 ;; Start drawing a new 2-point-shape from last endpoint.
4208 ;; First set the start-point
4211 (setq artist-key-endpoint1 (artist-make-endpoint x1 y1))
4213 ;; If we are not rubber-banding, then place the '1
4214 ;; Otherwise, draw the shape from x1,y1 to x1,y1
4215 (if (not artist-rubber-banding)
4216 (artist-no-rb-set-point1 x1 y1)
4217 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x1 y1)))
4220 (message "Point set"))
4222 ;; ** This is the last point
4225 (artist-funcall prep-fill-fn artist-key-poly-point-list)
4228 (if (artist-funcall fill-pred)
4229 (artist-funcall fill-fn artist-key-shape
4230 artist-key-poly-point-list))
4232 ;; Set the arrow-points
4233 (if (artist-funcall arrow-pred)
4234 (artist-funcall arrow-set-fn artist-key-poly-point-list)
4235 (artist-clear-arrow-points))
4237 (artist-funcall exit-fn artist-key-poly-point-list)
4239 ;; Change state to not drawing
4240 (setq artist-key-shape nil)
4241 (setq artist-key-endpoint1 nil)
4242 (setq artist-key-is-drawing nil)))))))
4245 (defun artist-key-set-point-1point (x y)
4246 "Set point for current 1-point shape at X,Y."
4247 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
4248 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
4249 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go))
4250 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
4251 (draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
4252 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
4253 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go)))
4254 (artist-funcall init-fn x y)
4255 (artist-funcall draw-fn x y)
4256 (artist-funcall prep-fill-fn x y)
4257 (if (artist-funcall arrow-pred)
4258 (artist-funcall arrow-set-fn x y)
4259 (artist-clear-arrow-points))
4260 (artist-funcall exit-fn x y))
4261 (setq artist-key-shape nil)
4262 (setq artist-key-is-drawing nil))
4265 (defun artist-key-set-point-2points (x y)
4266 "Set first or second point in current 2-point shape at X,Y."
4267 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
4268 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
4269 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go))
4270 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
4271 (fill-pred (artist-go-get-fill-pred-from-symbol artist-curr-go))
4272 (fill-fn (artist-go-get-fill-fn-from-symbol artist-curr-go))
4273 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
4274 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go)))
4275 (if (not artist-key-is-drawing)
4277 ;; *** We were not drawing ==> set first point
4280 (artist-funcall init-fn x y)
4282 ;; If not rubber-banding, set first point.
4283 ;; Otherwise, draw the shape from x,y to x,y
4284 (if (not artist-rubber-banding)
4285 (artist-no-rb-set-point1 x y)
4286 (setq artist-key-shape (artist-funcall draw-fn x y x y)))
4288 ;; Set first endpoint
4289 (setq artist-key-endpoint1 (artist-make-endpoint x y))
4291 ;; Since we are not ready, clear the arrow-points
4292 (artist-clear-arrow-points)
4294 ;; Change state to drawing
4295 (setq artist-key-is-drawing t))
4297 ;; *** We were drawing ==> we are about to set 2nd point
4298 ;; and end the drawing operation
4300 (let ((x1 (artist-endpoint-get-x artist-key-endpoint1))
4301 (y1 (artist-endpoint-get-y artist-key-endpoint1))
4305 ;; If not rubber-banding, undraw the 1's and 2's, then
4306 ;; draw the shape (if we were rubber-banding, then the
4307 ;; shape is already drawn in artist-key-do-continously-2points.)
4309 (if (not artist-rubber-banding)
4311 (artist-no-rb-unset-points)
4312 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))
4314 (artist-funcall prep-fill-fn artist-key-shape x1 y1 x2 y2)
4318 (if (artist-funcall fill-pred)
4319 (artist-funcall fill-fn artist-key-shape x1 y1 x2 y2))
4321 ;; Maybe set the arrow-points
4323 (if (artist-funcall arrow-pred)
4324 (artist-funcall arrow-set-fn artist-key-shape x1 y1 x2 y2)
4325 (artist-clear-arrow-points))
4327 (artist-funcall exit-fn artist-key-shape x1 y1 x2 y2)
4329 ;; Change state to not drawing
4330 (setq artist-key-is-drawing nil)))))
4333 (defun artist-key-set-point-common (arg)
4334 "Common routine for setting point in current shape.
4335 With non-nil ARG, set the last point."
4336 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go))
4337 (col (artist-current-column))
4338 (row (artist-current-line))
4339 (was-drawing artist-key-is-drawing))
4341 ;; First, if we are about to draw, then reset the draw-region
4342 (if (not artist-key-is-drawing)
4343 (artist-draw-region-reset))
4345 ;; Depending on what we are currently drawing, call other routines
4346 ;; that knows how to do the job
4348 (cond ((eq draw-how 'artist-do-continously)
4349 (artist-key-set-point-continously col row)
4350 ;; Do this now, otherwise nothing will happen until we move.
4351 (artist-key-do-continously-continously col row))
4352 ((eq draw-how 'artist-do-poly)
4353 (artist-key-set-point-poly col row arg))
4354 ((and (numberp draw-how) (= draw-how 1))
4355 (artist-key-set-point-1point col row))
4356 ((and (numberp draw-how) (= draw-how 2))
4357 (artist-key-set-point-2points col row))
4358 (t (message "Drawing \"%s\"s is not yet implemented" draw-how)))
4360 ;; Maybe trim line endings
4361 (if (and artist-trim-line-endings
4363 (not artist-key-is-drawing))
4364 (artist-draw-region-trim-line-endings artist-draw-region-min-y
4365 artist-draw-region-max-y))
4367 ;; Now restore the old position
4369 (artist-move-to-xy col row)
4370 (artist-mode-line-show-curr-operation artist-key-is-drawing)))
4376 (defun artist-previous-line (&optional n)
4377 "Move cursor up optional N lines (default is 1), updating current shape.
4378 If N is negative, move cursor down."
4380 (let ((col (artist-current-column)))
4381 (if (not artist-key-is-drawing)
4384 (move-to-column col t))
4386 (move-to-column col t)
4387 (artist-key-do-continously-common))))
4390 (defun artist-next-line (&optional n)
4391 "Move cursor down optional N lines (default is 1), updating current shape.
4392 If N is negative, move cursor up."
4394 (let ((col (artist-current-column)))
4395 (if (not artist-key-is-drawing)
4398 (move-to-column col t))
4400 (move-to-column col t)
4401 (artist-key-do-continously-common))))
4403 (defun artist-backward-char (&optional n)
4404 "Move cursor backward optional N chars (default is 1), updating curr shape.
4405 If N is negative, move forward."
4408 (artist-forward-char (- n))
4409 (artist-forward-char n)))
4411 (defun artist-forward-char (&optional n)
4412 "Move cursor forward optional N chars (default is 1), updating curr shape.
4413 If N is negative, move backward."
4415 (let* ((step-x (if (>= n 0) 1 -1))
4417 (curr-col (artist-current-column))
4418 (new-col (max 0 (+ curr-col (* distance step-x)))))
4419 (if (not artist-key-is-drawing)
4420 (move-to-column new-col t)
4421 (move-to-column new-col t)
4422 (artist-key-do-continously-common))))
4425 (defun artist-key-set-point (&optional arg)
4426 "Set a point for the current shape. With optional ARG, set the last point."
4428 (artist-key-set-point-common arg))
4431 (defun artist-select-fill-char (c)
4432 "Set current fill character to be C."
4433 (interactive "cType fill char (type RET to turn off): ")
4434 (cond ((eq c ?\r) (setq artist-fill-char-set nil)
4435 (message "Fill cancelled"))
4436 (t (setq artist-fill-char-set t)
4437 (setq artist-fill-char c)
4438 (message "Fill set to \"%c\"" c))))
4441 (defun artist-select-line-char (c)
4442 "Set current line character to be C."
4443 (interactive "cType line char (type RET to turn off): ")
4444 (cond ((eq c ?\r) (setq artist-line-char-set nil)
4445 (message "Normal lines"))
4446 (t (setq artist-line-char-set t)
4447 (setq artist-line-char c)
4448 (message "Line drawn with \"%c\"" c)))
4449 (if artist-key-is-drawing
4450 (artist-key-do-continously-common)))
4453 (defun artist-select-erase-char (c)
4454 "Set current erase character to be C."
4455 (interactive "cType char to use when erasing (type RET for normal): ")
4456 (cond ((eq c ?\r) (setq artist-erase-char ?\ )
4457 (message "Normal erasing"))
4458 (t (setq artist-erase-char c)
4459 (message "Erasing with \"%c\"" c)))
4460 (if artist-key-is-drawing
4461 (artist-key-do-continously-common)))
4463 (defun artist-charlist-to-string (char-list)
4464 "Convert a list of characters, CHAR-LIST, to a string."
4466 (while (not (null char-list))
4467 (setq result (concat result (char-to-string (car char-list))))
4468 (setq char-list (cdr char-list)))
4471 (defun artist-string-to-charlist (str)
4472 "Convert a string, STR, to list of characters."
4475 (defun artist-select-spray-chars (chars initial-char)
4476 "Set current spray characters to be CHARS, starting with INITIAL-CHAR."
4477 ;; This huge unreadable `interactive'-clause does the following
4478 ;; 1. Asks for a string of spray-characters
4479 ;; 2. Asks for the initial character (default is the first),
4480 ;; and loops if the answer is not a char within the string in 1.
4482 (let* ((str (read-string "Select spray-can characters, lightest first: "
4483 (artist-charlist-to-string artist-spray-chars)))
4484 (char-list (artist-string-to-charlist str))
4485 (initial (let* ((err-msg "")
4487 (first-char-as-str (char-to-string (car char-list)))
4488 (first-s) (first-c))
4492 (format (concat "%sSelect initial-character, "
4493 "one of \"%s\" (%s): ")
4494 err-msg str first-char-as-str)))
4495 (if (equal first-s "")
4496 (setq first-s first-char-as-str))
4497 (setq first-c (car (artist-string-to-charlist first-s)))
4498 (setq ok (not (null (member first-c char-list))))
4500 (setq err-msg (format
4501 "Not in spray-chars: \"%s\". "
4502 (char-to-string first-c)))))
4504 (list char-list initial)))
4505 (setq artist-spray-chars chars)
4506 (setq artist-spray-new-char initial-char)
4507 (message "Spray-chars set to \"%s\", initial: \"%s\""
4508 (artist-charlist-to-string chars) (char-to-string initial-char)))
4511 (defun artist-select-operation (op-str)
4512 "Select drawing operation OP-STR."
4513 (interactive (list (completing-read "Select operation: "
4514 artist-key-compl-table)))
4515 (let* ((op-symbol (artist-mt-get-symbol-from-keyword op-str))
4516 (draw-how (if op-symbol
4517 (artist-go-get-draw-how-from-symbol op-symbol)
4519 ;; First check that the string was valid
4520 (if (null op-symbol)
4521 (error "Unknown drawing method: %s" op-str))
4523 ;; Second, check that we are not about to switch to a different
4524 ;; kind of shape (do that only if we are drawing with keys;
4525 ;; otherwise this function cannot get called).
4526 (if (and artist-key-is-drawing
4527 (not (equal artist-key-draw-how draw-how)))
4528 (error "Cannot switch to a different kind of shape while drawing"))
4530 ;; If we were drawing, undraw the shape
4531 (if (and artist-key-is-drawing
4532 artist-rubber-banding)
4533 (artist-key-undraw-common))
4535 ;; Set the current operation and draw-how
4536 (setq artist-curr-go op-symbol)
4537 (setq artist-key-draw-how draw-how)
4539 ;; If we were drawing, redraw the shape (but don't if shape
4540 ;; is drawn by setting only one point)
4541 (if (and artist-key-is-drawing
4542 artist-rubber-banding
4543 (not (eq artist-key-draw-how 1)))
4544 (artist-key-draw-common)))
4547 (artist-mode-line-show-curr-operation artist-key-is-drawing))
4550 (defun artist-toggle-rubber-banding (&optional state)
4551 "Toggle rubber-banding.
4552 If optional argument STATE is positive, turn rubber-banding on."
4554 (if artist-key-is-drawing
4555 (error "Cannot toggle rubber-banding while drawing"))
4556 (if (setq artist-rubber-banding
4557 (if (null state) (not artist-rubber-banding)
4558 (> (prefix-numeric-value state) 0)))
4559 (message "Rubber-banding is now on")
4560 (message "Rubber-banding is now off")))
4563 (defun artist-toggle-trim-line-endings (&optional state)
4564 "Toggle trimming of line-endings.
4565 If optional argument STATE is positive, turn trimming on."
4567 (if (setq artist-trim-line-endings
4568 (if (null state) (not artist-trim-line-endings)
4569 (> (prefix-numeric-value state) 0)))
4570 (message "Trimming is now on")
4571 (message "Trimming is now off")))
4574 (defun artist-toggle-borderless-shapes (&optional state)
4575 "Toggle borders of shapes.
4576 If optional argument STATE is positive, turn borders on."
4578 (if (setq artist-borderless-shapes
4579 (if (null state) (not artist-borderless-shapes)
4580 (> (prefix-numeric-value state) 0)))
4581 (message "Borders are now off")
4582 (message "Borders are now on")))
4585 (defun artist-toggle-first-arrow ()
4586 "Toggle first arrow for shape, if possible."
4589 (if (not (null artist-arrow-point-1))
4590 (let* ((arrow-point artist-arrow-point-1)
4591 (arrow-state (artist-arrow-point-get-state arrow-point))
4592 (arrow-marker (artist-arrow-point-get-marker arrow-point))
4593 (direction (artist-arrow-point-get-direction arrow-point))
4594 (orig-char (artist-arrow-point-get-orig-char arrow-point))
4595 (arrow-char (aref artist-arrows direction))
4596 (new-state (not arrow-state)))
4598 (goto-char (marker-position arrow-marker))
4602 (artist-replace-char arrow-char))
4603 (artist-replace-char orig-char))
4605 (artist-arrow-point-set-state artist-arrow-point-1 new-state)))))
4607 (defun artist-toggle-second-arrow ()
4608 "Toggle second arrow for shape, if possible."
4611 (if (not (null artist-arrow-point-2))
4612 (let* ((arrow-point artist-arrow-point-2)
4613 (arrow-state (artist-arrow-point-get-state arrow-point))
4614 (arrow-marker (artist-arrow-point-get-marker arrow-point))
4615 (direction (artist-arrow-point-get-direction arrow-point))
4616 (orig-char (artist-arrow-point-get-orig-char arrow-point))
4617 (arrow-char (aref artist-arrows direction))
4618 (new-state (not arrow-state)))
4620 (goto-char (marker-position arrow-marker))
4624 (artist-replace-char arrow-char))
4625 (artist-replace-char orig-char))
4627 (artist-arrow-point-set-state artist-arrow-point-2 new-state)))))
4630 (defun artist-select-op-line ()
4631 "Select drawing lines."
4633 (artist-select-operation "line"))
4635 (defun artist-select-op-straight-line ()
4636 "Select drawing straight lines."
4638 (artist-select-operation "straight line"))
4640 (defun artist-select-op-rectangle ()
4641 "Select drawing rectangles."
4643 (artist-select-operation "rectangle"))
4645 (defun artist-select-op-square ()
4646 "Select drawing squares."
4648 (artist-select-operation "square"))
4650 (defun artist-select-op-poly-line ()
4651 "Select drawing poly-lines."
4653 (artist-select-operation "poly-line"))
4655 (defun artist-select-op-straight-poly-line ()
4656 "Select drawing straight poly-lines."
4658 (artist-select-operation "straight poly-line"))
4660 (defun artist-select-op-ellipse ()
4661 "Select drawing ellipses."
4663 (artist-select-operation "ellipse"))
4665 (defun artist-select-op-circle ()
4666 "Select drawing circles."
4668 (artist-select-operation "circle"))
4670 (defun artist-select-op-text-see-thru ()
4671 "Select rendering text (see thru)."
4673 (artist-select-operation "text see-thru"))
4675 (defun artist-select-op-text-overwrite ()
4676 "Select rendering text (overwrite)."
4678 (artist-select-operation "text overwrite"))
4680 (defun artist-select-op-spray-can ()
4683 (artist-select-operation "spray-can"))
4685 (defun artist-select-op-spray-set-size ()
4686 "Select setting size for spraying."
4688 (artist-select-operation "spray set size"))
4690 (defun artist-select-op-erase-char ()
4691 "Select erasing characters."
4693 (artist-select-operation "erase char"))
4695 (defun artist-select-op-erase-rectangle ()
4696 "Select erasing rectangles."
4698 (artist-select-operation "erase rectangle"))
4700 (defun artist-select-op-vaporize-line ()
4701 "Select vaporizing single lines."
4703 (artist-select-operation "vaporize line"))
4705 (defun artist-select-op-vaporize-lines ()
4706 "Select vaporizing connected lines."
4708 (artist-select-operation "vaporize lines"))
4710 (defun artist-select-op-cut-rectangle ()
4711 "Select cutting rectangles."
4713 (artist-select-operation "cut rectangle"))
4715 (defun artist-select-op-cut-square ()
4716 "Select cutting squares."
4718 (artist-select-operation "cut square"))
4720 (defun artist-select-op-copy-rectangle ()
4721 "Select copying rectangles."
4723 (artist-select-operation "copy rectangle"))
4725 (defun artist-select-op-copy-square ()
4726 "Select copying squares."
4728 (artist-select-operation "cut square"))
4730 (defun artist-select-op-paste ()
4733 (artist-select-operation "paste"))
4735 (defun artist-select-op-flood-fill ()
4736 "Select flood-filling."
4738 (artist-select-operation "flood-fill"))
4741 ;; Drawing lines by using mouse
4742 ;; Mouse button actions
4745 (defun artist-update-pointer-shape ()
4746 "Perform the update of the X Windows pointer shape."
4747 (set-mouse-color nil))
4749 (defun artist-set-pointer-shape (new-pointer-shape)
4750 "Set the shape of the X Windows pointer to NEW-POINTER-SHAPE."
4751 (setq x-pointer-shape new-pointer-shape)
4752 (artist-update-pointer-shape))
4754 (defsubst artist-event-is-shifted (ev)
4755 "Check whether the shift-key is pressed in event EV."
4756 (memq 'shift (event-modifiers ev)))
4758 (defun artist-do-nothing ()
4759 "Function that does nothing."
4762 (defun artist-down-mouse-1 (ev)
4763 "Perform drawing action for event EV."
4765 (let* ((real (artist-go-get-symbol-shift
4766 artist-curr-go (artist-event-is-shifted ev)))
4767 (draw-how (artist-go-get-draw-how-from-symbol real))
4768 ;; Remember original values for draw-region-min-y and max-y
4769 ;; in case we are interrupting a key-draw operation.
4770 (orig-draw-region-min-y artist-draw-region-min-y)
4771 (orig-draw-region-max-y artist-draw-region-max-y)
4772 (orig-pointer-shape (if (eq window-system 'x) x-pointer-shape nil))
4773 (echo-keystrokes 10000) ; a lot of seconds
4774 ;; Remember original binding for the button-up event to this
4775 ;; button-down event.
4776 (key (let* ((basic (event-basic-type ev))
4778 (shifted (make-symbol (concat "S-" (symbol-name basic)))))
4779 (if (artist-event-is-shifted ev)
4780 (make-vector 1 shifted)
4781 (make-vector 1 unshifted))))
4782 (orig-button-up-binding (lookup-key (current-global-map) key)))
4786 (if (eq window-system 'x)
4787 (artist-set-pointer-shape artist-pointer-shape))
4789 ;; Redefine the button-up binding temporarily (the original
4790 ;; binding is restored in the unwind-forms below). This is to
4791 ;; avoid the phenomenon outlined in this scenario:
4793 ;; 1. A routine which reads something from the mini-buffer (such
4794 ;; as the text renderer) is called from below.
4795 ;; 2. Meanwhile, the users releases the mouse button.
4796 ;; 3. As a (funny :-) coincidence, the binding for the
4797 ;; button-up event is often mouse-set-point, so Emacs
4798 ;; sets the point to where the button was released, which is
4799 ;; in the buffer where the user wants to place the text.
4800 ;; 4. The user types C-x o (or uses the mouse once again)
4801 ;; until he reaches the mini-buffer which is still prompting
4802 ;; for some text to render.
4804 ;; To do this foolproof, all local and minor-mode maps should
4805 ;; be searched and temporarily changed as well, since they
4806 ;; too might have some binding for the button-up event,
4807 ;; but I hope dealing with the global map will suffice.
4808 (define-key (current-global-map) key 'artist-do-nothing)
4810 (artist-draw-region-reset)
4812 (artist-mode-line-show-curr-operation t)
4814 (cond ((eq draw-how 'artist-do-continously)
4815 (artist-mouse-draw-continously ev))
4816 ((eq draw-how 'artist-do-poly)
4817 (artist-mouse-draw-poly ev))
4818 ((and (numberp draw-how) (= draw-how 1))
4819 (artist-mouse-draw-1point ev))
4820 ((and (numberp draw-how) (= draw-how 2))
4821 (artist-mouse-draw-2points ev))
4822 (t (message "Drawing \"%s\"s is not yet implemented"
4825 (if artist-trim-line-endings
4826 (artist-draw-region-trim-line-endings artist-draw-region-min-y
4827 artist-draw-region-max-y))
4828 (setq artist-draw-region-min-y orig-draw-region-min-y)
4829 (setq artist-draw-region-max-y orig-draw-region-max-y))
4832 (if (eq window-system 'x)
4833 (artist-set-pointer-shape orig-pointer-shape))
4835 (if orig-button-up-binding
4836 (define-key (current-global-map) key orig-button-up-binding))
4838 (artist-mode-line-show-curr-operation artist-key-is-drawing))))
4841 (defun artist-mouse-choose-operation (ev op)
4842 "Choose operation for event EV and operation OP."
4845 (select-window (posn-window (event-start last-input-event)))
4846 (list last-input-event
4847 (x-popup-menu last-nonmenu-event artist-popup-menu-table))))
4849 (let ((draw-fn (artist-go-get-draw-fn-from-symbol (car op)))
4850 (set-fn (artist-fc-get-fn-from-symbol (car op))))
4853 ;; *** It was a draw-function
4854 ((not (listp draw-fn))
4855 (let* ((unshifted (artist-go-get-symbol-shift (car op) nil))
4856 (shifted (artist-go-get-symbol-shift (car op) t))
4857 (shift-state (artist-event-is-shifted ev))
4858 (selected-op (if shift-state shifted unshifted))
4859 (keyword (artist-go-get-keyword-from-symbol selected-op)))
4860 (artist-select-operation keyword)))
4862 ;; *** It was a set/unset function
4863 ((not (listp set-fn))
4864 (call-interactively set-fn)))))
4867 (defun artist-down-mouse-3 (ev)
4868 "Erase character or rectangle, depending on event EV."
4870 (let ((artist-curr-go 'erase-char))
4871 (artist-down-mouse-1 ev))
4872 ;; Restore mode-line
4873 (artist-mode-line-show-curr-operation artist-key-is-drawing))
4880 (defsubst artist-shift-has-changed (shift-state ev)
4881 "From the last SHIFT-STATE and EV, determine if the shift-state has changed."
4882 ;; This one simply doesn't work.
4884 ;; There seems to be no way to tell whether the user has pressed shift
4885 ;; while dragging the cursor around when we are in a track-mouse
4886 ;; form. Calling (event-modifiers ev) yields nil :-( Neither is the
4887 ;; (event-basic-type ev) of any help (it is simply `mouse-movement').
4889 ;; So this doesn't work:
4890 ;; (cond ((and shift-state (not (artist-event-is-shifted ev))) t)
4891 ;; ((and (not shift-state) (artist-event-is-shifted ev)) t)
4895 (defun artist-coord-win-to-buf (coord)
4896 "Convert a window-relative coordinate COORD to a buffer-relative coordinate."
4897 (let ((window-x (car coord))
4898 (window-y (cdr coord))
4899 (window-start-x (window-hscroll))
4900 (window-start-y (save-excursion (goto-char (window-start))
4901 (artist-current-line))))
4902 (cons (+ window-x window-start-x)
4903 (+ window-y window-start-y))))
4906 (defun artist-mouse-draw-continously (ev)
4907 "Generic function for shapes that requires 1 point as input.
4908 Operation is done continously while the mouse button is hold down.
4909 The event, EV, is the mouse event."
4910 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
4911 (shifted (artist-go-get-symbol-shift artist-curr-go t))
4912 (shift-state (artist-event-is-shifted ev))
4913 (op (if shift-state shifted unshifted))
4914 (draw-how (artist-go-get-draw-how-from-symbol op))
4915 (init-fn (artist-go-get-init-fn-from-symbol op))
4916 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
4917 (exit-fn (artist-go-get-exit-fn-from-symbol op))
4918 (draw-fn (artist-go-get-draw-fn-from-symbol op))
4919 (interval-fn (artist-go-get-interval-fn-from-symbol op))
4920 (interval (artist-funcall interval-fn))
4921 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
4922 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
4923 (ev-start (event-start ev))
4924 (initial-win (posn-window ev-start))
4925 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
4926 (x1 (car ev-start-pos))
4927 (y1 (cdr ev-start-pos))
4930 (select-window (posn-window ev-start))
4931 (artist-funcall init-fn x1 y1)
4932 (if (not artist-rubber-banding)
4933 (artist-no-rb-set-point1 x1 y1))
4935 (while (or (mouse-movement-p ev)
4936 (member 'down (event-modifiers ev)))
4937 (setq ev-start-pos (artist-coord-win-to-buf
4938 (posn-col-row (event-start ev))))
4939 (setq x1 (car ev-start-pos))
4940 (setq y1 (cdr ev-start-pos))
4942 ;; Cancel previous timer
4944 (cancel-timer timer))
4946 (if (not (eq initial-win (posn-window (event-start ev))))
4947 ;; If we moved outside the window, do nothing
4950 ;; Still in same window:
4952 ;; Check if user presses or releases shift key
4953 (if (artist-shift-has-changed shift-state ev)
4955 ;; First check that the draw-how is the same as we
4956 ;; already have. Otherwise, ignore the changed shift-state.
4957 (if (not (eq draw-how
4958 (artist-go-get-draw-how-from-symbol
4959 (if (not shift-state) shifted unshifted))))
4960 (message "Cannot switch to shifted operation")
4962 ;; progn is "implicit" since this is the else-part
4963 (setq shift-state (not shift-state))
4964 (setq op (if shift-state shifted unshifted))
4965 (setq draw-how (artist-go-get-draw-how-from-symbol op))
4966 (setq draw-fn (artist-go-get-draw-fn-from-symbol op))))
4968 ;; Draw the new shape
4969 (setq shape (artist-funcall draw-fn x1 y1))
4970 (artist-move-to-xy x1 y1)
4972 ;; Start the timer to call `draw-fn' repeatedly every
4973 ;; `interval' second
4974 (if (and interval draw-fn)
4975 (setq timer (run-at-time interval interval draw-fn x1 y1))))
4978 (setq ev (read-event))))
4980 ;; Cancel any timers
4982 (cancel-timer timer))
4984 (artist-funcall prep-fill-fn x1 y1)
4986 (if (artist-funcall arrow-pred)
4987 (artist-funcall arrow-set-fn x1 y1)
4988 (artist-clear-arrow-points))
4990 (artist-funcall exit-fn x1 y1)
4991 (artist-move-to-xy x1 y1)))
4995 (defun artist-mouse-draw-poly (ev)
4996 "Generic function for shapes requiring several points as input.
4997 The event, EV, is the mouse event."
4999 (message "Mouse-1: set new point, mouse-2: set last point")
5000 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
5001 (shifted (artist-go-get-symbol-shift artist-curr-go t))
5002 (shift-state (artist-event-is-shifted ev))
5003 (op (if shift-state shifted unshifted))
5004 (draw-how (artist-go-get-draw-how-from-symbol op))
5005 (init-fn (artist-go-get-init-fn-from-symbol op))
5006 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
5007 (exit-fn (artist-go-get-exit-fn-from-symbol op))
5008 (draw-fn (artist-go-get-draw-fn-from-symbol op))
5009 (undraw-fn (artist-go-get-undraw-fn-from-symbol op))
5010 (fill-pred (artist-go-get-fill-pred-from-symbol op))
5011 (fill-fn (artist-go-get-fill-fn-from-symbol op))
5012 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
5013 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
5014 (ev-start (event-start ev))
5015 (initial-win (posn-window ev-start))
5016 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
5017 (x1-last (car ev-start-pos))
5018 (y1-last (cdr ev-start-pos))
5025 (select-window (posn-window ev-start))
5026 (artist-funcall init-fn x1-last y1-last)
5027 (if (not artist-rubber-banding)
5028 (artist-no-rb-set-point1 x1-last y1-last))
5031 ;; decide what to do
5034 ;; *** Mouse button is released.
5036 (or (member 'click (event-modifiers ev))
5037 (member 'drag (event-modifiers ev))))
5038 ;; First, if not rubber-banding, draw the line.
5040 (if (not artist-rubber-banding)
5042 (artist-no-rb-unset-points)
5043 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))))
5045 ;; Set the second point to the shape's second point
5046 ;; (which might be different from the mouse's second point,
5047 ;; if, for example, we are drawing a straight line)
5049 (if (not (null shape))
5050 (let ((endpoint2 (artist-2point-get-endpoint2 shape)))
5051 (setq x1-last (artist-endpoint-get-x endpoint2))
5052 (setq y1-last (artist-endpoint-get-y endpoint2))))
5053 (setq point-list (cons (artist-make-endpoint x1-last y1-last)
5058 ;; *** Mouse button 2 or 3 down
5059 ((and (member 'down (event-modifiers ev))
5060 (or (equal (event-basic-type ev) 'mouse-2)
5061 (equal (event-basic-type ev) 'mouse-3)))
5065 ;; *** Mouse button 2 or 3 released
5066 ((and (or (member 'click (event-modifiers ev))
5067 (member 'drag (event-modifiers ev)))
5068 (or (equal (event-basic-type ev) 'mouse-2)
5069 (equal (event-basic-type ev) 'mouse-3)))
5071 ;; This means the end of our poly-line drawing-session.
5075 ;; *** Mouse button 1 went down
5077 (member 'down (event-modifiers ev))
5078 (equal (event-basic-type ev) 'mouse-1))
5079 ;; Check whether the (possibly new, that depends on if shift
5080 ;; has been pressed or released) symbol has the same draw-how
5081 ;; information as the previous had. If it hasn't, we can't
5084 (if (not (eq draw-how
5085 (artist-go-get-draw-how-from-symbol
5086 (if (not shift-state) shifted unshifted))))
5087 (message "Cannot switch operation")
5092 (artist-go-get-symbol-shift artist-curr-go nil)
5094 (artist-go-get-symbol-shift artist-curr-go t)
5095 shift-state (artist-event-is-shifted ev)
5096 op (if shift-state shifted unshifted)
5097 draw-how (artist-go-get-draw-how-from-symbol op)
5098 draw-fn (artist-go-get-draw-fn-from-symbol op)
5099 undraw-fn (artist-go-get-undraw-fn-from-symbol op)
5100 fill-pred (artist-go-get-fill-pred-from-symbol op)
5101 fill-fn (artist-go-get-fill-fn-from-symbol op))
5103 ;; Draw shape from last place to this place
5107 (setq ev-start-pos (artist-coord-win-to-buf
5108 (posn-col-row (event-start ev))))
5109 (setq x2 (car ev-start-pos))
5110 (setq y2 (cdr ev-start-pos))
5112 ;; Draw the new shape (if not rubber-banding, place both marks)
5114 (if artist-rubber-banding
5115 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))
5117 (artist-no-rb-set-point1 x1-last y1-last)
5118 (artist-no-rb-set-point2 x2 y2)))
5120 ;; Show new operation in mode-line
5121 (let ((artist-curr-go op))
5122 (artist-mode-line-show-curr-operation t))))
5127 ;; *** Mouse moved, button is down and we are still in orig window
5128 ((and (mouse-movement-p ev)
5130 (eq initial-win (posn-window (event-start ev))))
5131 ;; Draw shape from last place to this place
5134 (setq ev-start-pos (artist-coord-win-to-buf
5135 (posn-col-row (event-start ev))))
5136 (setq x2 (car ev-start-pos))
5137 (setq y2 (cdr ev-start-pos))
5139 ;; First undraw last shape
5140 ;; (unset last point if not rubberbanding)
5142 (artist-funcall undraw-fn shape)
5144 ;; Draw the new shape (if not rubberbanding, set 2nd mark)
5146 (if artist-rubber-banding
5147 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))
5149 (artist-no-rb-unset-point2)
5150 (artist-no-rb-set-point2 x2 y2)))
5152 (artist-move-to-xy x2 y2))
5154 ;; *** Mouse moved, button is down but we are NOT in orig window
5155 ((and (mouse-movement-p ev)
5157 (not (eq initial-win (posn-window (event-start ev)))))
5162 ;; *** Moving mouse while mouse button is not down
5163 ((and (mouse-movement-p ev) (not is-down))
5164 ;; don't do anything.
5168 ;; *** Mouse button 1 went down, first time
5170 (member 'down (event-modifiers ev))
5171 (equal (event-basic-type ev) 'mouse-1))
5172 ;; don't do anything
5176 ;; *** Another event
5182 ;; Read next event (only if we should not stop)
5184 (setq ev (read-event)))))
5186 ;; Reverse point-list (last points are cond'ed first)
5187 (setq point-list (reverse point-list))
5189 (artist-funcall prep-fill-fn point-list)
5192 (if (artist-funcall fill-pred)
5193 (artist-funcall fill-fn point-list))
5195 ;; Maybe set arrow points
5196 (if (and point-list (artist-funcall arrow-pred))
5197 (artist-funcall arrow-set-fn point-list)
5198 (artist-clear-arrow-points))
5200 (artist-funcall exit-fn point-list)
5201 (artist-move-to-xy x2 y2)))
5204 (defun artist-mouse-draw-1point (ev)
5205 "Generic function for shapes requiring only 1 point as input.
5206 Operation is done once. The event, EV, is the mouse event."
5208 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
5209 (shifted (artist-go-get-symbol-shift artist-curr-go t))
5210 (shift-state (artist-event-is-shifted ev))
5211 (op (if shift-state shifted unshifted))
5212 (draw-how (artist-go-get-draw-how-from-symbol op))
5213 (init-fn (artist-go-get-init-fn-from-symbol op))
5214 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
5215 (exit-fn (artist-go-get-exit-fn-from-symbol op))
5216 (draw-fn (artist-go-get-draw-fn-from-symbol op))
5217 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
5218 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
5219 (ev-start (event-start ev))
5220 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
5221 (x1 (car ev-start-pos))
5222 (y1 (cdr ev-start-pos)))
5223 (select-window (posn-window ev-start))
5224 (artist-funcall init-fn x1 y1)
5225 (artist-funcall draw-fn x1 y1)
5226 (artist-funcall prep-fill-fn x1 y1)
5227 (if (artist-funcall arrow-pred)
5228 (artist-funcall arrow-set-fn x1 y1)
5229 (artist-clear-arrow-points))
5230 (artist-funcall exit-fn x1 y1)
5231 (artist-move-to-xy x1 y1)))
5234 (defun artist-mouse-draw-2points (ev)
5235 "Generic function for shapes requiring 2 points as input.
5236 The event, EV, is the mouse event."
5238 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
5239 (shifted (artist-go-get-symbol-shift artist-curr-go t))
5240 (shift-state (artist-event-is-shifted ev))
5241 (op (if shift-state shifted unshifted))
5242 (draw-how (artist-go-get-draw-how-from-symbol op))
5243 (init-fn (artist-go-get-init-fn-from-symbol op))
5244 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
5245 (exit-fn (artist-go-get-exit-fn-from-symbol op))
5246 (draw-fn (artist-go-get-draw-fn-from-symbol op))
5247 (undraw-fn (artist-go-get-undraw-fn-from-symbol op))
5248 (fill-pred (artist-go-get-fill-pred-from-symbol op))
5249 (fill-fn (artist-go-get-fill-fn-from-symbol op))
5250 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
5251 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
5252 (ev-start (event-start ev))
5253 (initial-win (posn-window ev-start))
5254 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
5255 (x1 (car ev-start-pos))
5256 (y1 (cdr ev-start-pos))
5260 (select-window (posn-window ev-start))
5261 (artist-funcall init-fn x1 y1)
5262 (if (not artist-rubber-banding)
5263 (artist-no-rb-set-point1 x1 y1))
5265 (while (or (mouse-movement-p ev)
5266 (member 'down (event-modifiers ev)))
5267 (setq ev-start-pos (artist-coord-win-to-buf
5268 (posn-col-row (event-start ev))))
5269 (setq x2 (car ev-start-pos))
5270 (setq y2 (cdr ev-start-pos))
5272 (if (not (eq initial-win (posn-window (event-start ev))))
5273 ;; If we moved outside the window, do nothing
5276 ;; Still in same window:
5278 ;; First undraw last shape (unset last point if not rubberbanding)
5279 (if artist-rubber-banding
5280 (artist-funcall undraw-fn shape)
5281 (artist-no-rb-unset-point2))
5283 ;; Check if user presses or releases shift key
5284 (if (artist-shift-has-changed shift-state ev)
5286 ;; First check that the draw-how is the same as we
5287 ;; already have. Otherwise, ignore the changed shift-state.
5288 (if (not (eq draw-how
5289 (artist-go-get-draw-how-from-symbol
5290 (if (not shift-state) shifted unshifted))))
5291 (message "Cannot switch to shifted operation")
5293 (message "Switching")
5294 ;; progn is "implicit" since this is the else-part
5295 (setq shift-state (not shift-state))
5296 (setq op (if shift-state shifted unshifted))
5297 (setq draw-how (artist-go-get-draw-how-from-symbol op))
5298 (setq draw-fn (artist-go-get-draw-fn-from-symbol op))
5299 (setq undraw-fn (artist-go-get-undraw-fn-from-symbol op))
5300 (setq fill-pred (artist-go-get-fill-pred-from-symbol op))
5301 (setq fill-fn (artist-go-get-fill-fn-from-symbol op))))
5303 ;; Draw the new shape
5304 (if artist-rubber-banding
5305 (setq shape (artist-funcall draw-fn x1 y1 x2 y2))
5306 (artist-no-rb-set-point2 x2 y2))
5308 (artist-move-to-xy x2 y2))
5312 (setq ev (read-event))))
5314 ;; If we are not rubber-banding (that is, we were moving around the `2')
5316 (if (not artist-rubber-banding)
5318 (artist-no-rb-unset-points)
5319 (setq shape (artist-funcall draw-fn x1 y1 x2 y2))))
5321 (artist-funcall prep-fill-fn shape x1 y1 x2 y2)
5324 (if (artist-funcall fill-pred)
5325 (artist-funcall fill-fn shape x1 y1 x2 y2))
5327 ;; Maybe set arrow-points
5328 (if (artist-funcall arrow-pred)
5329 (artist-funcall arrow-set-fn shape x1 y1 x2 y2)
5330 (artist-clear-arrow-points))
5332 (artist-funcall exit-fn shape x1 y1 x2 y2)
5333 (artist-move-to-xy x2 y2)))
5337 ;; Bug-report-submitting
5339 (defun artist-submit-bug-report ()
5340 "Submit via mail a bug report on Artist."
5343 (if (y-or-n-p "Do you want to submit a bug report on Artist? ")
5344 (let ((to artist-maintainer-address)
5345 (vars '(window-system
5346 window-system-version
5348 artist-rubber-banding
5349 artist-interface-with-rect
5351 ;; Now the internal ones
5353 artist-key-poly-point-list
5356 artist-arrow-point-1
5357 artist-arrow-point-2)))
5358 ;; Remove those variables from vars that are not bound
5362 (if (not (and (boundp x) (symbol-value x)))
5363 (setq vars (delq x vars))))) vars)
5364 (reporter-submit-bug-report
5365 artist-maintainer-address
5366 (concat "artist.el " artist-version)
5369 (concat "Hello Tomas,\n\n"
5370 "I have a nice bug report on Artist for you! Here it is:")))))
5374 ;; Now provide this minor mode
5380 ;;; About adding drawing modes
5381 ;;; --------------------------
5383 ;; If you are going to add a new drawing mode, read the following
5384 ;; sketchy outlines to get started a bit easier.
5386 ;; 1. If your new drawing mode falls into one of the following
5387 ;; categories, goto point 2, otherwise goto point 3.
5389 ;; - Modes where the shapes are drawn continously, as long as
5390 ;; the mouse button is held down (continous modes).
5391 ;; Example: the erase-char mode, the pen and pen-line modes.
5393 ;; - Modes where the shape is made up of from 2 points to an
5394 ;; arbitrary number of points (poly-point modes).
5395 ;; Example: the poly-line mode
5397 ;; - Modes where the shape is made up of 2 points (2-point
5399 ;; Example: lines, rectangles
5401 ;; - Modes where the shape is made up of 1 point (1-point
5402 ;; modes). This mode differs from the continous modes in
5403 ;; that the shape is drawn only once when the mouse button
5405 ;; Examples: paste, a flood-fill, vaporize modes
5408 ;; 2. To make it easier and more flexible to program new drawing
5409 ;; modes, you might choose to specify
5410 ;; init-fn: a function to be called at the very beginning
5411 ;; of the drawing phase,
5412 ;; prep-fill-fn: a function to be called before filling,
5413 ;; arrow-set-fn: a function for setting arrows, to be called
5414 ;; after filling, and
5415 ;; exit-fn: a function to be called at the very end of
5416 ;; the drawing phase.
5417 ;; For each of the cases below, the arguments given to the init-fn,
5418 ;; prep-fill-fn, arrow-set-fn and exit-fn are stated.
5420 ;; If your mode matches the continous mode or the 1-point mode:
5422 ;; a. Create a draw-function that draws your shape. Your function
5423 ;; must take x and y as arguments. The return value is not
5426 ;; b. Add your mode to the master table, `artist-mt'.
5429 ;; prep-fill-fn: x y
5430 ;; arrow-set-fn: x y
5433 ;; If your mode matches the 2-point mode:
5435 ;; a. Create one draw-function that draws your shape and one
5436 ;; undraw-function that undraws it.
5438 ;; The draw-function must take x1, y1, x2 and y2 as
5439 ;; arguments. It must return a list with three elements:
5440 ;; Endpoint1: a vector [x1 y1]
5441 ;; Endpoint2: a vector [x2 y2]
5442 ;; Shapeinfo: all info necessary for your undraw-function to
5443 ;; be able to undraw the shape
5444 ;; Use the artist-endpoint-* accessors to create and inspect
5447 ;; If applicable, you must be able to draw your shape without
5448 ;; borders if the `artist-borderless-shapes' is non-nil.
5449 ;; See `artist-draw-rect' for an example.
5451 ;; The undraw-function must take one argument: the list created
5452 ;; by your draw-function. The return value is not used.
5454 ;; b. If you want to provide a fill-function, then create a
5455 ;; function that takes 5 arguments: the list created by your
5456 ;; draw-function, x1, y1, x2 and y2. The return value is not
5459 ;; c. Add your mode to the master table, `artist-mt'.
5462 ;; prep-fill-fn: shape x1 y1 x2 y2
5463 ;; arrow-set-fn: shape x1 y1 x2 y2
5464 ;; exit-fn: shape x1 y1 x2 y2
5466 ;; If your mode matches the poly-point mode:
5468 ;; a. Create one draw-function that draws your shape and one
5469 ;; undraw-function that undraws it. The draw- and
5470 ;; undraw-functions are used to draw/undraw a segment of
5471 ;; your poly-point mode between 2 points. The draw- and
5472 ;; undraw-functions are then really 2-point mode functions.
5473 ;; They must take the same arguments and return the same
5474 ;; values as those of the 2-point mode.
5476 ;; If applicable, you must be able to draw your shape without
5477 ;; borders if the `artist-borderless-shapes' is non-nil.
5478 ;; See `artist-draw-rect' for an example.
5480 ;; b. If you want to provide a fill-function, then create a
5481 ;; function that takes 1 argument: a list of points where each
5482 ;; point is a vector, [x, y].
5484 ;; c. Add your mode to the master table, `artist-mt'.
5487 ;; prep-fill-fn: point-list
5488 ;; arrow-set-fn: point-list
5489 ;; exit-fn: point-list
5491 ;; The arrow-set-fn must set the variables `artist-arrow-point-1'
5492 ;; and `artist-arrow-point-2'. If your mode does not take arrows,
5493 ;; you must set the variables to nil. Use the accessors
5494 ;; artist-arrow-point-* to create and inspect arrow-points.
5497 ;; 3. If your mode doesn't match any of the categories, you are facing
5498 ;; a bit more work, and I cannot be as detailed as above. Here is a
5499 ;; brief outline of what you have to do:
5501 ;; a. Decide on a name for your type of mode. Let's assume that
5502 ;; you decided on `xxx'. Then you should use the draw-how
5503 ;; symbol artist-do-xxx.
5505 ;; b. Create a function artist-mouse-draw-xxx for drawing with
5506 ;; mouse. It should be called from `artist-down-mouse-1'.
5508 ;; The all coordinates must be converted from window-relative
5509 ;; to buffer relative before saved or handed over to
5510 ;; any other function. Converting is done with
5511 ;; the function `artist-coord-win-to-buf'.
5513 ;; It must take care to the `artist-rubber-banding' variable
5514 ;; and perform rubber-banding accordingly. Use the
5515 ;; artist-no-rb-* functions if not rubber-banding.
5517 ;; If applicable, you must be able to draw your shape without
5518 ;; borders if the `artist-borderless-shapes' is non-nil.
5519 ;; See `artist-draw-rect' for an example.
5521 ;; You must call the init-fn, the prep-fill-fn, arrow-set-fn
5522 ;; and the exit-fn at the apropriate points.
5524 ;; When artist-mouse-draw-xxx ends, the shape for your mode
5525 ;; must be completely drawn.
5527 ;; c. Create functions for drawing with keys:
5529 ;; - artist-key-set-point-xxx for setting a point in the
5530 ;; mode, to be called from `artist-key-set-point-common'.
5532 ;; - artist-key-do-continously-xxx to be called from
5533 ;; `artist-key-do-continously-common' whenever the user
5536 ;; As for the artist-mouse-draw-xxx, these two functions must
5537 ;; take care to do rubber-banding, borderless shapes and to
5540 ;; These functions should set the variable `artist-key-shape'
5541 ;; to the shape drawn.
5543 ;; d. Create artist-key-draw-xxx and artist-key-undraw-xxx for
5544 ;; drawing and undrawing. These are needed when the user
5545 ;; switches operation to draw another shape of the same type
5548 ;; You should provide these functions. You might think that
5549 ;; only you is using your type of mode, so noone will be able
5550 ;; to switch to another operation of the same type of mode,
5551 ;; but someone else might base a new drawing mode upon your
5554 ;; You must call the init-fn, the prep-fill-fn, arrow-set-fn
5555 ;; and the exit-fn at the apropriate points.
5557 ;; e. Add your new mode to the master table, `artist-mt'.
5560 ;; Happy hacking! Please let me hear if you add any drawing modes!
5561 ;; Don't hesitate to ask me any questions.
5564 ;;; arch-tag: 3e63b881-aaaa-4b83-a072-220d4661a8a3
5565 ;;; artist.el ends here