Mercurial > emacs
annotate lisp/textmodes/artist.el @ 49506:ac9e2eeeb03d
New format of AUTHORS file; list each
author name once followed by contributed and changed files.
Improve selection of entries to include in list, and generate list
of unrecognized entries indicating syntax errors in ChangeLog files.
(authors-coding-system): New variable.
(authors-many-files): Update doc string.
(authors-aliases): Change format. Now one entry with multiple
aliases per author.
(authors-valid-file-names, authors-renamed-files-alist)
(authors-renamed-files-regexps): New variables.
(authors-canonical-file-name): New function. Validates that file
exists or occurs in one of the above lists. Record unrecognized
file names in global authors-invalid-file-names list.
(authors-add): Change to record per-change counts.
(authors-canonical-author-name): Handle new format of
authors-aliases list.
(authors-scan-change-log): Rename FILE arg to LOG-FILE.
Change doc string to describe new entry format.
Only add author entries for valid file names.
(authors-print): Replace by authors-add-to-author-list.
(authors-add-to-author-list): New function which reorders
per-file entries and adds them to global authors-author-list.
(authors): Instead of authors-print to insert in *Authors* buffer,
use authors-add-to-author-list to reorder the list and then
insert result in *Authors* buffer with new format.
Generate *Authors Errors* compilation-mode buffer listing
unrecognized ChangeLog entries.
author | Kim F. Storm <storm@cua.dk> |
---|---|
date | Wed, 29 Jan 2003 00:13:11 +0000 |
parents | 126b6cb8740d |
children | e56cb5adb76f d7ddb3e565de |
rev | line source |
---|---|
33618 | 1 ;;; artist.el --- draw ascii graphics with your mouse |
2 | |
40323 | 3 ;; Copyright (C) 2000, 2001 Free Software Foundation, Inc. |
33618 | 4 |
5 ;; Author: Tomas Abrahamsson <tab@lysator.liu.se> | |
6 ;; Maintainer: Tomas Abrahamsson <tab@lysator.liu.se> | |
7 ;; Keywords: mouse | |
40323 | 8 ;; Version: 1.2.4 |
9 ;; Release-date: 25-Oct-2001 | |
33618 | 10 ;; Location: http://www.lysator.liu.se/~tab/artist/ |
11 | |
12 ;; This file is part of GNU Emacs. | |
13 | |
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) | |
17 ;; any later version. | |
18 | |
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. | |
23 | |
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., 59 Temple Place - Suite 330, | |
27 ;; Boston, MA 02111-1307, USA. | |
28 | |
29 ;;; Commentary: | |
30 | |
31 ;; What is artist? | |
32 ;; --------------- | |
33 ;; | |
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 \. | |
37 ;; | |
38 ;; Features are: | |
39 ;; | |
40 ;; * Intersecting: When a `|' intersects with a `-', a `+' is | |
41 ;; drawn, like this: | \ / | |
42 ;; --+-- X | |
43 ;; | / \ | |
44 ;; | |
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 | |
50 ;; you are drawing. | |
51 ;; | |
52 ;; * Drawing operations: The following drawing operations are implemented: | |
53 ;; | |
54 ;; lines straight-lines | |
55 ;; rectangles squares | |
56 ;; poly-lines straight poly-lines | |
57 ;; ellipses circles | |
58 ;; text (see-thru) text (overwrite) | |
59 ;; spray-can setting size for spraying | |
60 ;; vaporize line vaporize lines | |
61 ;; erase characters erase rectangles | |
62 ;; | |
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 | |
66 ;; drawing. | |
67 ;; | |
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>. | |
72 ;; | |
73 ;; * Flood-filling: You can fill any area with a certain character by | |
74 ;; flood-filling. | |
75 ;; | |
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. | |
80 ;; | |
81 ;; * Drawing with keys: Everything you can do with the mouse, you can | |
82 ;; also do without the mouse. | |
83 ;; | |
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 >. | |
86 ;; | |
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. | |
92 ;; | |
93 ;; * Picture mode compatibility: Artist is picture mode compatible (this | |
94 ;; can be turned off). | |
95 ;; | |
96 ;; See the documentation for the function artist-mode for a detailed | |
97 ;; description on how to use artist. | |
98 ;; | |
99 ;; | |
100 ;; What about adding my own drawing modes? | |
101 ;; --------------------------------------- | |
102 ;; | |
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! | |
106 | |
107 | |
108 ;;; Installation: | |
109 | |
110 ;; To use artist, put this in your .emacs: | |
111 ;; | |
112 ;; (autoload 'artist-mode "artist" "Enter artist-mode" t) | |
113 | |
114 | |
115 ;;; Requirements: | |
116 | |
117 ;; Artist requires Emacs 19.28 or higher. | |
118 ;; | |
119 ;; Artist requires the `rect' package (which comes with Emacs) to be | |
120 ;; loadable, unless the variable `artist-interface-with-rect' is set | |
121 ;; to nil. | |
122 ;; | |
123 ;; Artist also requires the Picture mode (which also comes with Emacs) | |
124 ;; to be loadable, unless the variable `artist-picture-compatibility' | |
125 ;; is set to nil. | |
126 | |
127 ;;; Known bugs: | |
128 | |
129 ;; The shifted operations are not available when drawing with the mouse | |
130 ;; in Emacs 19.29 and 19.30. | |
131 ;; | |
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.) | |
135 | |
136 | |
137 ;;; ChangeLog: | |
138 | |
40323 | 139 ;; 1.2.4 25-Oct-2001 |
140 ;; Bugfix: Some operations (the edit menu) got hidden | |
141 ;; Bugfix: The first arrow for poly-lines was always pointing | |
142 ;; to the right | |
143 ;; Changed: Updated with changes made for Emacs 21.1 | |
144 ;; | |
145 ;; 1.2.3 20-Nov-2000 | |
146 ;; Bugfix: Autoload cookie corrected | |
147 ;; | |
33618 | 148 ;; 1.2.2 19-Nov-2000 |
149 ;; Changed: More documentation fixes. | |
47953
126b6cb8740d
(artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents:
46163
diff
changeset
|
150 ;; Bugfix: The arrow characters (`artist-arrows'), which |
33618 | 151 ;; got wrong in 1.1, are now corrected. |
152 ;; | |
153 ;; 1.2.1 15-Nov-2000 | |
154 ;; New: Documentation fixes. | |
155 ;; Bugfix: Sets next-line-add-newlines to t while in artist-mode. | |
156 ;; Drawing with keys was confusing without this fix, if | |
157 ;; next-line-add-newlines was set to nil. | |
158 ;; Thanks to Tatsuo Furukawa <tatsuo@kobe.hp.com> for this. | |
159 ;; | |
160 ;; 1.2 22-Oct-2000 | |
161 ;; New: Updated to work with Emacs 21 | |
162 ;; | |
163 ;; 1.1 15-Aug-2000 | |
164 ;; Bugfix: Cursor follows mouse pointer more closely. | |
165 ;; New: Works with Emacs 20.x | |
166 ;; New: Variables are customizable | |
167 ;; | |
168 ;; 1.1-beta1 21-Apr-1998 | |
169 ;; New: Spray-can (Utterly useless, I believe, but it was fun | |
170 ;; to implement :-) after an idea by Karl-Johan Karlsson | |
171 ;; <kj@lysator.liu.se>. | |
172 ;; New: Freehand drawing (with pen). | |
173 ;; New: Vaporizing lines. | |
174 ;; New: Text-rendering using figlet. | |
175 ;; New: Picture mode compatibility. | |
176 ;; Changed: All Artist keys now uses the prefix C-c C-a not to conflict | |
177 ;; with Picture mode. | |
178 ;; Bugfix: No longer leaves traces of lines when rubberbanding | |
179 ;; if the buffer auto-scrolls. | |
180 ;; Bugfix: Infinite loop sometimes when rubberbanding was turned | |
181 ;; off. | |
182 ;; | |
183 ;; 1.0 01-Mar-1998 | |
184 ;; First official release. | |
185 | |
186 ;;; Code: | |
187 | |
188 ;; Variables | |
189 | |
40323 | 190 (defconst artist-version "1.2.4") |
33618 | 191 (defconst artist-maintainer-address "tab@lysator.liu.se") |
192 | |
193 | |
194 (eval-and-compile | |
41608
45db352a0971
Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents:
40323
diff
changeset
|
195 (condition-case () |
45db352a0971
Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents:
40323
diff
changeset
|
196 (require 'custom) |
45db352a0971
Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents:
40323
diff
changeset
|
197 (error nil)) |
45db352a0971
Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents:
40323
diff
changeset
|
198 (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) |
45db352a0971
Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents:
40323
diff
changeset
|
199 nil ;; We've got what we needed |
45db352a0971
Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents:
40323
diff
changeset
|
200 ;; We have the old custom-library, hack around it! |
45db352a0971
Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents:
40323
diff
changeset
|
201 (defmacro defgroup (&rest args) |
45db352a0971
Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents:
40323
diff
changeset
|
202 nil) |
45db352a0971
Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents:
40323
diff
changeset
|
203 (defmacro defface (var values doc &rest args) |
45db352a0971
Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents:
40323
diff
changeset
|
204 `(make-face ,var)) |
47953
126b6cb8740d
(artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents:
46163
diff
changeset
|
205 (defmacro defcustom (var value doc &rest args) |
41608
45db352a0971
Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents:
40323
diff
changeset
|
206 `(defvar ,var ,value ,doc)))) |
33618 | 207 |
208 ;; User options | |
209 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv | |
210 | |
211 (defgroup artist nil | |
212 "Customization of the Artist mode." | |
213 :group 'mouse) | |
214 | |
215 (defgroup artist-text nil | |
216 "Customization of the text rendering." | |
217 :group 'artist) | |
218 | |
219 (defcustom artist-rubber-banding t | |
220 "Interactively do rubber-banding when non-nil." | |
221 :group 'artist | |
222 :type 'boolean) | |
223 | |
224 (defcustom artist-first-char ?1 | |
225 "Character to set at first point when not rubber-banding." | |
226 :group 'artist | |
227 :type 'character) | |
228 | |
229 (defcustom artist-second-char ?2 | |
230 "Character to set at second point when not rubber-banding." | |
231 :group 'artist | |
232 :type 'character) | |
233 | |
234 (defcustom artist-interface-with-rect t | |
235 "Whether to interface with the rect package or not. | |
236 | |
237 Interfacing to the rect package means that the Copy and Paste operations | |
238 will use the rectangle buffer when accessing the copied area. This means | |
239 that you can insert a rectangle which is copied using the artist package | |
240 and vice versa. | |
241 | |
242 If this causes any problem for you (for example, if the implementation of | |
243 the rectangle package changes), you can set this variable to nil, and the | |
244 artist package will use its own copy buffer." | |
245 :group 'artist | |
246 :type 'boolean) | |
247 | |
248 (defvar artist-arrows [ ?> nil ?v ?L ?< nil ?^ nil ] | |
249 ;; This is a defvar, not a defcustom, since the custom | |
250 ;; package shows vectors of characters as a vector of integers, | |
251 ;; which is confusing | |
252 "A vector of characters to use as arrows. | |
253 | |
254 The vector is 8 elements long and contains a character for each | |
255 direction, or nil if there is no suitable character to use for arrow | |
256 in that direction. | |
257 | |
258 The directions are as follows: | |
259 | |
260 5 6 7 | |
261 \\ | / | |
262 4 - * - 0 | |
263 / | \\ | |
264 3 2 1") | |
265 | |
266 (defcustom artist-aspect-ratio 1 | |
267 "Defines the character height-to-width aspect ratio. | |
268 This is used when drawing squares and circles. If the height of the" | |
269 :group 'artist | |
270 :type 'number) | |
271 | |
272 (defcustom artist-trim-line-endings t | |
273 "Whether or not to remove white-space at end of lines. | |
274 | |
275 If non-nil, line-endings are trimmed (that is, extraneous white-space | |
276 at the end of the line is removed) when the shape is drawn." | |
277 :group 'artist | |
278 :type 'boolean) | |
279 | |
280 | |
281 (defcustom artist-flood-fill-right-border 'window-width | |
282 "Right edge definition, used when flood-filling. | |
283 | |
284 When flood-filling, if the area is not closed off to the right, then | |
285 flood-filling will fill no more to the right than specified by this | |
286 variable. This limit is called the fill-border." | |
287 :group 'artist | |
288 :type '(choice (const :tag "limited to window" window-width) | |
289 (const :tag "limited to value of `fill-column'" fill-column))) | |
290 | |
291 (defcustom artist-flood-fill-show-incrementally t | |
292 "Whether or not to incrementally update display when flood-filling. | |
293 | |
294 If non-nil, incrementally update display when flood-filling. | |
295 If set to non-nil, this currently implies discarding any input events | |
296 during the flood-fill." | |
297 :group 'artist | |
298 :type 'boolean) | |
299 | |
300 | |
301 (defcustom artist-ellipse-right-char ?\) | |
302 "Character to use at the rightmost position when drawing narrow ellipses. | |
303 | |
304 In this figure, it is the right parenthesis (the ``)'' character): | |
305 ----- | |
306 ( ) | |
307 -----" | |
308 :group 'artist | |
309 :type 'character) | |
310 | |
311 | |
312 (defcustom artist-ellipse-left-char ?\( | |
313 "Character to use at the leftmost position when drawing narrow ellipses. | |
314 | |
315 In this figure, it is the left parenthesis (the ``('' character): | |
316 ----- | |
317 ( ) | |
318 -----" | |
319 :group 'artist | |
320 :type 'character) | |
321 | |
322 (defcustom artist-picture-compatibility t | |
323 "Whether or not picture mode compatibility is on." | |
324 :group 'artist | |
325 :type 'boolean) | |
326 | |
327 | |
328 | |
329 | |
330 (defcustom artist-vaporize-fuzziness 1 | |
331 "How to vaporize lines that are cut off. | |
332 | |
333 Accept this many characters cutting off a line and still treat | |
334 it as one line. | |
335 Example: | |
336 If `artist-vaporize-fuzziness' is 2, then those will be recognized as | |
337 lines from A to B (provided you start vaporizing them at the ``*''): | |
338 / | |
339 A----*------/-----------B | |
340 \\/ | |
341 A----*----/\\------------B | |
342 / \\ | |
343 | |
344 but this one won't, since it is cut off by more than 2 characters: | |
345 \\/ / | |
346 A----*----/\\/----------B | |
347 / /\\ | |
348 (in fact, only the left part (between the A and the leftmost ``/'' | |
349 crossing the line) will be vaporized)" | |
350 :group 'artist | |
351 :type 'integer) | |
352 | |
353 | |
354 (defvar artist-pointer-shape (if (eq window-system 'x) x-pointer-crosshair nil) | |
355 "*If in X Windows, use this pointer shape while drawing with the mouse.") | |
356 | |
357 | |
358 (defcustom artist-text-renderer 'artist-figlet | |
359 "Function for doing text rendering." | |
360 :group 'artist-text | |
361 :type 'symbol) | |
362 | |
363 | |
364 (defcustom artist-figlet-program "figlet" | |
365 "Program to run for `figlet'." | |
366 :group 'artist-text | |
367 :type 'string) | |
368 | |
369 | |
370 (defcustom artist-figlet-default-font "standard" | |
371 "Default font for `figlet'." | |
372 :group 'artist-text | |
373 :type 'string) | |
374 | |
375 | |
376 (defcustom artist-figlet-list-fonts-command | |
377 ;; list files ending with *.flf in any directory printed by the | |
378 ;; ``figlet -I2'' command. I think this will not produce more than | |
379 ;; one directory, but it never hurts to be on the safe side... | |
380 "for dir in `figlet -I2`; do cd $dir; ls *.flf; done" | |
381 "Command to run to get list of available fonts." | |
382 :group 'artist-text | |
383 :type 'string) | |
384 | |
385 | |
386 (defcustom artist-spray-interval 0.2 | |
387 "Number of seconds between repeated spraying." | |
388 :group 'artist | |
389 :type 'number) | |
390 | |
391 | |
392 (defcustom artist-spray-radius 4 | |
393 "Size of the area for spraying." | |
394 :group 'artist | |
395 :type 'integer) | |
396 | |
397 | |
398 (defvar artist-spray-chars '(?\ ?. ?- ?+ ?m ?% ?* ?#) | |
399 ;; This is a defvar, not a defcustom, since the custom | |
400 ;; package shows lists of characters as a lists of integers, | |
401 ;; which is confusing | |
402 "*Characters (``color'') to use when spraying. | |
403 They should be ordered | |
404 from the ``lightest'' to the ``heaviest'' since spraying replaces a | |
405 light character with the next heavier one.") | |
406 | |
407 | |
408 (defvar artist-spray-new-char ?. | |
409 "*Initial character to use when spraying. | |
410 This character is used if spraying upon a character that is | |
411 not in `artist-spray-chars'. The character defined by this variable | |
412 should be in `artist-spray-chars', or spraying will behave | |
413 strangely.") | |
414 | |
415 | |
416 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ | |
417 ;; End of user options | |
418 | |
419 | |
420 ;; Internal variables | |
421 ;; | |
422 (defvar artist-mode nil | |
423 "Non-nil to enable `artist-mode' and nil to disable.") | |
424 (make-variable-buffer-local 'artist-mode) | |
425 | |
426 (defvar artist-mode-name " Artist" | |
427 "Name of artist mode beginning with a space (appears in the mode-line).") | |
428 | |
429 (defvar artist-curr-go 'pen-char | |
430 "Current selected graphics operation.") | |
431 (make-variable-buffer-local 'artist-curr-go) | |
432 | |
433 (defvar artist-line-char-set nil | |
434 "Boolean to tell whether user has set some char to use when drawing lines.") | |
435 (make-variable-buffer-local 'artist-line-char-set) | |
436 | |
437 (defvar artist-line-char nil | |
438 "Char to use when drawing lines.") | |
439 (make-variable-buffer-local 'artist-line-char) | |
440 | |
441 (defvar artist-fill-char-set nil | |
442 "Boolean to tell whether user has set some char to use when filling.") | |
443 (make-variable-buffer-local 'artist-fill-char-set) | |
444 | |
445 (defvar artist-fill-char nil | |
446 "Char to use when filling.") | |
447 (make-variable-buffer-local 'artist-fill-char) | |
448 | |
47953
126b6cb8740d
(artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents:
46163
diff
changeset
|
449 (defvar artist-erase-char ?\ |
33618 | 450 "Char to use when erasing.") |
451 (make-variable-buffer-local 'artist-erase-char) | |
452 | |
453 (defvar artist-default-fill-char ?. | |
454 "Char to use when a fill-char is required but none is set.") | |
455 (make-variable-buffer-local 'artist-default-fill-char) | |
456 | |
457 ; This variable is not buffer local | |
458 (defvar artist-copy-buffer nil | |
459 "Copy buffer.") | |
460 | |
461 (defvar artist-draw-region-min-y 0 | |
462 "Line-number for top-most visited line for draw operation.") | |
463 (make-variable-buffer-local 'artist-draw-region-min-y) | |
464 | |
465 (defvar artist-draw-region-max-y 0 | |
466 "Line-number for bottom-most visited line for draw operation.") | |
467 (make-variable-buffer-local 'artist-draw-region-max-y) | |
468 | |
469 (defvar artist-borderless-shapes nil | |
470 "When non-nil, draw shapes without border. | |
471 The fill char is used instead, if it is set.") | |
472 (make-variable-buffer-local 'artist-borderless-shapes) | |
473 | |
474 | |
475 (eval-when-compile | |
476 ;; Make rect available at compile-time | |
477 (require 'rect) ; for interfacing with rect | |
478 (require 'reporter) ; the bug-reporting tool | |
479 (require 'picture)) ; picture mode compatibility | |
480 | |
481 (if artist-interface-with-rect | |
482 (require 'rect)) | |
483 | |
484 (require 'reporter) | |
485 | |
486 (if artist-picture-compatibility | |
487 (require 'picture)) | |
488 | |
489 | |
490 (defvar artist-mode-map | |
491 (let ((map (make-sparse-keymap))) | |
492 (setq artist-mode-map (make-sparse-keymap)) | |
493 (define-key map [down-mouse-1] 'artist-down-mouse-1) | |
494 (define-key map [S-down-mouse-1] 'artist-down-mouse-1) | |
495 (define-key map [down-mouse-2] 'artist-mouse-choose-operation) | |
496 (define-key map [S-down-mouse-2] 'artist-mouse-choose-operation) | |
497 (define-key map [down-mouse-3] 'artist-down-mouse-3) | |
498 (define-key map [S-down-mouse-3] 'artist-down-mouse-3) | |
499 (define-key map "\r" 'artist-key-set-point) ; return | |
500 (define-key map [up] 'artist-previous-line) | |
501 (define-key map "\C-p" 'artist-previous-line) | |
502 (define-key map [down] 'artist-next-line) | |
503 (define-key map "\C-n" 'artist-next-line) | |
504 (define-key map [left] 'artist-backward-char) | |
505 (define-key map "\C-b" 'artist-backward-char) | |
506 (define-key map [right] 'artist-forward-char) | |
507 (define-key map "\C-f" 'artist-forward-char) | |
508 (define-key map "<" 'artist-toggle-first-arrow) | |
509 (define-key map ">" 'artist-toggle-second-arrow) | |
510 (define-key map "\C-c\C-a\C-e" 'artist-select-erase-char) | |
511 (define-key map "\C-c\C-a\C-f" 'artist-select-fill-char) | |
512 (define-key map "\C-c\C-a\C-l" 'artist-select-line-char) | |
513 (define-key map "\C-c\C-a\C-o" 'artist-select-operation) | |
514 (define-key map "\C-c\C-a\C-r" 'artist-toggle-rubber-banding) | |
515 (define-key map "\C-c\C-a\C-t" 'artist-toggle-trim-line-endings) | |
516 (define-key map "\C-c\C-a\C-s" 'artist-toggle-borderless-shapes) | |
517 (define-key map "\C-c\C-c" 'artist-mode-off) | |
518 (define-key map "\C-c\C-al" 'artist-select-op-line) | |
519 (define-key map "\C-c\C-aL" 'artist-select-op-straight-line) | |
520 (define-key map "\C-c\C-ar" 'artist-select-op-rectangle) | |
521 (define-key map "\C-c\C-aR" 'artist-select-op-square) | |
522 (define-key map "\C-c\C-as" 'artist-select-op-square) | |
523 (define-key map "\C-c\C-ap" 'artist-select-op-poly-line) | |
524 (define-key map "\C-c\C-aP" 'artist-select-op-straight-poly-line) | |
525 (define-key map "\C-c\C-ae" 'artist-select-op-ellipse) | |
526 (define-key map "\C-c\C-ac" 'artist-select-op-circle) | |
527 (define-key map "\C-c\C-at" 'artist-select-op-text-see-thru) | |
528 (define-key map "\C-c\C-aT" 'artist-select-op-text-overwrite) | |
529 (define-key map "\C-c\C-aS" 'artist-select-op-spray-can) | |
530 (define-key map "\C-c\C-az" 'artist-select-op-spray-set-size) | |
531 (define-key map "\C-c\C-a\C-d" 'artist-select-op-erase-char) | |
532 (define-key map "\C-c\C-aE" 'artist-select-op-erase-rectangle) | |
533 (define-key map "\C-c\C-av" 'artist-select-op-vaporize-line) | |
534 (define-key map "\C-c\C-aV" 'artist-select-op-vaporize-lines) | |
535 (define-key map "\C-c\C-a\C-k" 'artist-select-op-cut-rectangle) | |
536 (define-key map "\C-c\C-a\M-w" 'artist-select-op-copy-rectangle) | |
537 (define-key map "\C-c\C-a\C-y" 'artist-select-op-paste) | |
538 (define-key map "\C-c\C-af" 'artist-select-op-flood-fill) | |
539 (define-key map "\C-c\C-a\C-b" 'artist-submit-bug-report) | |
540 map) | |
541 "Keymap for `artist-minor-mode'.") | |
542 | |
543 (defvar artist-replacement-table (make-vector 256 0) | |
544 "Replacement table for `artist-replace-char'.") | |
545 | |
546 | |
547 ;;; | |
548 ;;; The table of graphic operations | |
549 ;;; | |
550 (defvar artist-mt | |
551 ;; Implementation note: Maybe this should be done using a structure | |
552 ;; in the cl package? | |
553 ;; | |
554 '( | |
555 (menu | |
556 ("Drawing" | |
557 ((function-call | |
558 ( "Undo" do-undo undo)) | |
559 | |
560 (separator ) | |
561 (graphics-operation | |
562 ("Pen" (("Pen" pen-char "pen-c" | |
563 artist-no-arrows nil | |
564 nil nil nil | |
565 artist-do-continously | |
566 artist-pen | |
567 (nil)) | |
568 ("Pen Line" pen-line "pen-l" | |
569 artist-arrows artist-pen-set-arrow-points | |
570 artist-pen-reset-last-xy nil nil | |
571 artist-do-continously | |
572 artist-pen-line | |
573 (nil))))) | |
574 | |
575 (graphics-operation | |
576 ("Line" (("line" line "line" | |
577 artist-arrows artist-set-arrow-points-for-2points | |
578 nil nil nil | |
579 2 | |
580 artist-draw-line | |
581 (artist-undraw-line | |
582 artist-nil nil)) | |
583 ("straight line" s-line "sline" | |
584 artist-arrows artist-set-arrow-points-for-2points | |
585 nil nil nil | |
586 2 | |
587 artist-draw-sline | |
588 (artist-undraw-sline | |
589 artist-nil nil))))) | |
590 | |
591 (graphics-operation | |
592 ("Rectangle" (("rectangle" rect "rect" | |
593 artist-no-arrows nil | |
594 nil nil nil | |
595 2 | |
596 artist-draw-rect | |
597 (artist-undraw-rect | |
598 artist-t-if-fill-char-set artist-fill-rect)) | |
599 ("square" square "square" | |
600 artist-no-arrows nil | |
601 nil nil nil | |
602 2 | |
603 artist-draw-square | |
604 (artist-undraw-square | |
605 artist-t-if-fill-char-set artist-fill-square))))) | |
606 | |
607 (graphics-operation | |
608 ("Poly-line" (("poly-line" polyline "poly" | |
609 artist-arrows artist-set-arrow-points-for-poly | |
610 nil nil nil | |
611 artist-do-poly | |
612 artist-draw-line | |
613 (artist-undraw-line | |
614 artist-nil nil)) | |
615 ("straight poly-line" spolyline "s-poly" | |
616 artist-arrows artist-set-arrow-points-for-poly | |
617 nil nil nil | |
618 artist-do-poly | |
619 artist-draw-sline | |
620 (artist-undraw-sline | |
621 artist-nil nil))))) | |
622 | |
623 (graphics-operation | |
624 ("Ellipse" (("ellipse" ellipse "ellipse" | |
625 artist-no-arrows nil | |
626 nil nil nil | |
627 2 | |
628 artist-draw-ellipse | |
629 (artist-undraw-ellipse | |
630 artist-t-if-fill-char-set artist-fill-ellipse)) | |
631 ("circle" circle "circle" | |
632 artist-no-arrows nil | |
633 nil nil nil | |
634 2 | |
635 artist-draw-circle | |
636 (artist-undraw-circle | |
637 artist-t-if-fill-char-set artist-fill-circle))))) | |
638 | |
639 (graphics-operation | |
640 ("Text" (("text see-thru" text-thru "text-thru" | |
641 artist-no-arrows nil | |
642 nil nil nil | |
643 1 | |
644 artist-text-see-thru | |
645 nil) | |
646 ("text overwrite" text-ovwrt "text-ovwrt" | |
647 artist-no-arrows nil | |
648 nil nil nil | |
649 1 | |
650 artist-text-overwrite | |
651 nil)))) | |
652 | |
653 (graphics-operation | |
654 ("Spray-can" (("spray-can" spray-can "spray-can" | |
655 artist-no-arrows nil | |
656 nil nil nil | |
657 artist-do-continously | |
658 artist-spray | |
659 (artist-spray-get-interval)) | |
660 ("spray set size" spray-get-size "spray-size" | |
661 artist-no-arrows nil | |
662 nil artist-spray-clear-circle artist-spray-set-radius | |
663 2 | |
664 artist-draw-circle | |
665 (artist-undraw-circle | |
666 artist-nil nil))))) | |
667 | |
668 (graphics-operation | |
669 ("Erase" (("erase char" erase-char "erase-c" | |
670 artist-no-arrows nil | |
671 nil nil nil | |
672 artist-do-continously | |
673 artist-erase-char | |
674 (nil)) | |
675 ("erase rectangle" erase-rect "erase-r" | |
676 artist-no-arrows nil | |
677 nil nil nil | |
678 2 | |
679 artist-draw-rect | |
680 (artist-undraw-rect | |
681 artist-t artist-erase-rect))))) | |
682 | |
683 (graphics-operation | |
684 ("Vaporize" (("vaporize line" vaporize-line "vaporize-1" | |
685 artist-no-arrows nil | |
686 nil nil nil | |
687 1 | |
688 artist-vaporize-line | |
689 nil) | |
690 ("vaporize lines" vaporize-lines "vaporize-n" | |
691 artist-no-arrows nil | |
692 nil nil nil | |
693 1 | |
694 artist-vaporize-lines | |
695 nil))))))) | |
696 | |
697 (menu | |
698 ("Edit" | |
699 ((graphics-operation | |
700 ("Cut" (("cut rectangle" cut-r "cut-r" | |
701 artist-no-arrows nil | |
702 nil nil nil | |
703 2 | |
704 artist-draw-rect | |
705 (artist-undraw-rect | |
706 artist-t artist-cut-rect) | |
707 ("cut square" cut-s "cut-s" | |
708 artist-no-arrows nil | |
709 nil nil nil | |
710 2 | |
711 artist-draw-square | |
712 (artist-undraw-square | |
40323 | 713 artist-t artist-cut-square)))))) |
33618 | 714 |
715 (graphics-operation | |
716 ("Copy" (("copy rectangle" copy-r "copy-r" | |
717 artist-no-arrows nil | |
718 nil nil nil | |
719 2 | |
720 artist-draw-rect | |
721 (artist-undraw-rect | |
722 artist-t artist-copy-rect) | |
723 ("copy square" copy-s "copy-s" | |
724 artist-no-arrows nil | |
725 nil nil nil | |
726 2 | |
727 artist-draw-square | |
728 (artist-undraw-square | |
40323 | 729 artist-t artist-copy-square)))))) |
33618 | 730 |
731 (graphics-operation | |
732 ("Paste" (("paste" paste "paste" | |
733 artist-no-arrows nil | |
734 nil nil nil | |
735 1 | |
736 artist-paste | |
737 nil) | |
738 ("paste" paste "paste" | |
739 artist-no-arrows nil | |
740 nil nil nil | |
741 1 | |
742 artist-paste | |
743 nil)))) | |
744 | |
745 (graphics-operation | |
746 ("Flood-fill" (("flood-fill" flood-fill "flood" | |
747 artist-no-arrows nil | |
748 nil nil nil | |
749 1 | |
750 artist-flood-fill | |
751 nil) | |
752 ("flood-fill" flood-fill "flood" | |
753 artist-no-arrows nil | |
754 nil nil nil | |
755 1 | |
756 artist-flood-fill | |
40323 | 757 nil))))))) |
33618 | 758 |
759 (menu | |
760 ("Settings" | |
761 ((function-call | |
762 ("Set Fill" set-fill artist-select-fill-char)) | |
763 | |
764 (function-call | |
765 ("Set Line" set-line artist-select-line-char)) | |
766 | |
767 (function-call | |
768 ("Set Erase" set-erase artist-select-erase-char)) | |
769 | |
770 (function-call | |
771 ("Rubber-banding" rubber-band artist-toggle-rubber-banding)) | |
772 | |
773 (function-call | |
774 ("Trimming" trimming artist-toggle-trim-line-endings)) | |
775 | |
776 (function-call | |
777 ("Borders" borders artist-toggle-borderless-shapes)) | |
778 | |
779 (function-call | |
780 ("Spray-chars" spray-chars artist-select-spray-chars))))) | |
781 | |
782 ) ;; end of list | |
783 | |
784 "Master Table for `artist-mode'. | |
785 This table is primarily a table over the different graphics operations | |
786 available in artist mode, but it also holds layout information for the | |
787 popup menu. | |
788 | |
789 The master table is a list of table elements. The elements of this table | |
790 have the layout | |
791 | |
792 (TAG INFO-PART) | |
793 | |
794 There are three kinds of TAG: | |
795 | |
796 `menu' -- a sub-menu | |
797 `separator' -- produce a separator in the popup menu | |
798 `function-call' -- call a function | |
799 `graphics-operation' -- a graphics operation | |
800 | |
801 The layout of the INFO-PART for `menu' is | |
802 | |
803 (TITLE ((TAG-1 INFO-PART-1) (TAG-2 INFO-PART-2) ...)) | |
804 | |
805 TITLE is the title of the submenu; this is followed by a list of | |
806 menu items, each on the general form (TAG INFO-PART). | |
807 | |
808 | |
809 The layout of the INFO-PART for `separator' is empty and not used. | |
810 | |
811 | |
812 This is the layout of the INFO-PART for `function-call': | |
813 | |
814 (KEYWORD SYMBOL FN) | |
815 | |
816 KEYWORD is a string naming the operation, and appears in the popup menu. | |
817 SYMBOL is the symbol for the operations. | |
818 FN is the function performing the operation. This function | |
819 is called with no arguments. Its return value is ignored. | |
820 | |
821 | |
822 The layout of the INFO-PART for `graphics-operation' is | |
823 | |
824 (TITLE (UNSHIFTED SHIFTED)) | |
825 | |
42706 | 826 TITLE is the title that appears in the popup menu. UNSHIFTED |
33618 | 827 and SHIFTED specify for unshifted and shifted operation. Both |
828 have the form | |
829 | |
830 (KEYWORD KEY-SYMBOL MODE-LINE ARROW-PRED ARROW-SET-FN | |
831 INIT-FN PREP-FILL-FN EXIT-FN DRAW-HOW DRAW-FN EXTRA-DRAW-INFO) | |
832 | |
833 KEYWORD is a string specifying the name of the shape to draw. | |
834 This is used when selecting drawing operation. | |
835 KEY-SYMBOL is the key which is used when looking up members | |
836 through the functions `artist-go-get-MEMBER-from-symbol' | |
837 and `artist-fc-get-MEMBER-from-symbol'. | |
838 MODE-LINE is a string that appears in the mode-line when drawing | |
839 the shape. | |
840 ARROW-PRED is a function that is called to find out if the shape | |
841 can have arrows. The function is called with no arguments and | |
842 must return nil or t. | |
843 ARROW-SET-FN is a function that is called to set arrow end-points. | |
844 Arguments and return values for this funcion are described below. | |
845 INIT-FN is, if non-nil, a function that is called when the first | |
846 point of the shape is set. Arguments and return values for | |
847 this funcion are described below. | |
848 PREP-FILL-FN is, if non-nil, a function that is called after | |
849 the last point is set, but before the filling is done. | |
850 Arguments and return values for this funcion are described below. | |
851 EXIT-FN is, if non-nil, a function that is called after filling | |
852 is done. Arguments and return values for this funcion are | |
853 described below. | |
854 DRAW-HOW defines the kind of shape. The kinds of shapes are: | |
855 `artist-do-continously' -- Do drawing operation continously, | |
856 as long as the mouse button is held down. | |
857 `artist-do-poly' -- Do drawing operation many times. | |
858 1 -- Do drawing operation only once. | |
859 2 -- The drawing operation requires two points. | |
860 DRAW-FN is the function to call for drawing. Arguments and | |
861 return values for this funcion are described below. | |
862 EXTRA-DRAW-INFO the layout of this depends on the value of DRAW-HOW: | |
863 If DRAW-HOW is `artist-do-continously': | |
864 | |
865 (INTERVAL-FN) | |
866 | |
867 INTERVAL-FN is, if non-nil, a function to call for getting | |
868 an interval between repeated calls to the DRAW-FN. | |
869 This function is called with no arguments and must | |
870 return a number, the interval in seconds. | |
871 If nil, calls to DRAW-FN are done only when the mouse | |
872 or cursor is moved. | |
873 | |
874 If DRAW-HOW is either `artist-do-poly' or 2: | |
875 | |
876 (UNDRAW-FN FILL-PRED FILL-FN) | |
877 | |
878 UNDRAW-FN is a function to call for undrawing the shape. | |
879 Arguments and return values for this funcion are | |
880 described below. | |
881 FILL-PRED is a function that is called to find out if the shape | |
882 can have arrows. The function must take no arguments and | |
883 return nil or t. | |
884 FILL-FN is a function to call for filling the shape. | |
885 Arguments and return values for this funcion are | |
886 described below. | |
887 | |
888 If DRAW-HOW is 1: | |
889 | |
890 () | |
891 | |
892 Note! All symbols and keywords (both in the `funcion-call' INFO-PART | |
893 as well as in the `graphics-operation' INFO-PART) must be unique. | |
894 | |
895 The following table describe function arguments and return value | |
896 for different functions and DRAW-HOWs. | |
897 | |
898 If DRAW-HOW is either `artist-do-continously' or 1: | |
899 | |
900 INIT-FN X Y ==> ignored | |
901 PREP-FILL-FN X Y ==> ignored | |
902 EXIT-FN X Y ==> ignored | |
903 ARROW-SET-FN X Y ==> ignored | |
904 DRAW-FN X Y ==> ignored | |
905 | |
906 If DRAW-HOW is 2: | |
907 | |
908 INIT-FN X1 Y1 ==> ignored | |
909 PREP-FILL-FN X1 Y1 X2 Y2 ==> ignored | |
910 EXIT-FN X1 Y1 X2 Y2 ==> ignored | |
911 ARROW-SET-FN X1 Y1 X2 Y2 ==> ignored | |
912 DRAW-FN X1 Y1 X2 Y2 ==> (ENDPOINT-1 ENDPOINT-2 SHAPE) | |
913 UNDRAW-FN (ENDPOINT-1 ENDPOINT-2 SHAPE) ==> ignored | |
914 FILL-FN (ENDPOINT-1 ENDPOINT-2 SHAPE) X1 Y1 X2 Y2 ==> ignored | |
915 | |
916 ENDPOINT-1 and ENDPOINT-2 are endpoints which are created with | |
917 `artist-make-endpoint' | |
918 SHAPE is an opaque structure, created by the DRAW-FN and intented | |
919 to be used only by the UNDRAW-FN. | |
920 | |
921 If DRAW-HOW is `artist-do-poly': | |
922 | |
923 INIT-FN X1 Y1 | |
924 PREP-FILL-FN POINT-LIST | |
925 ARROW-SET-FN POINT-LIST | |
926 EXIT-FN POINT-LIST | |
927 DRAW-FN X-LAST Y-LAST X-NEW Y-NEW ==> (ENDPOINT-1 ENDPOINT-2 SHAPE) | |
928 UNDRAW-FN (ENDPOINT-1 ENDPOINT-2 SHAPE) | |
929 FILL-FN POINT-LIST | |
930 | |
931 ENDPOINT-1 and ENDPOINT-2 are endpoints which are created with | |
932 `artist-make-endpoint'. | |
933 SHAPE is an opaque structure, created by the DRAW-FN and intented | |
934 to be used only by the UNDRAW-FN. | |
935 POINT-LIST is a list of vectors [X Y].") | |
936 | |
937 | |
938 ;; | |
939 ;; Accessors for the master table | |
940 ;; | |
941 | |
942 (defun artist-mt-get-tag (element) | |
943 "Retrieve the tag component from the master table ELEMENT." | |
944 (elt element 0)) | |
945 | |
946 (defun artist-mt-get-info-part (element) | |
947 "Retrieve the info part component from the master table ELEMENT." | |
948 (elt element 1)) | |
949 | |
950 ;; For the 'graphics-operation info-parts | |
951 ;; | |
952 (defsubst artist-go-get-desc (info-part) | |
953 "Retrieve the description component from a graphics operation INFO-PART." | |
954 (elt info-part 0)) | |
955 | |
956 (defsubst artist-go-get-unshifted (info-part) | |
957 "Retrieve the unshifted info from a graphics operation INFO-PART." | |
958 (elt (elt info-part 1) 0)) | |
959 | |
960 (defsubst artist-go-get-shifted (info-part) | |
961 "Retrieve the shifted info from a graphics operation INFO-PART." | |
962 (elt (elt info-part 1) 1)) | |
963 | |
964 (defsubst artist-go-get-keyword (info-variant-part) | |
965 "Retrieve the keyword component from an INFO-VARIANT-PART. | |
966 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part." | |
967 (elt info-variant-part 0)) | |
968 | |
969 (defsubst artist-go-get-symbol (info-variant-part) | |
970 "Retrieve the symbol component from an INFO-VARIANT-PART. | |
971 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part." | |
972 (elt info-variant-part 1)) | |
973 | |
974 (defsubst artist-go-get-mode-line (info-variant-part) | |
975 "Retrieve the mode line component from an INFO-VARIANT-PART. | |
976 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part." | |
977 (elt info-variant-part 2)) | |
978 | |
979 (defsubst artist-go-get-arrow-pred (info-variant-part) | |
980 "Retrieve the arrow predicate component from an INFO-VARIANT-PART. | |
981 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part." | |
982 (elt info-variant-part 3)) | |
983 | |
984 (defsubst artist-go-get-arrow-set-fn (info-variant-part) | |
985 "Retrieve the arrow set component from an INFO-VARIANT-PART. | |
986 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part." | |
987 (elt info-variant-part 4)) | |
988 | |
989 (defsubst artist-go-get-init-fn (info-variant-part) | |
990 "Retrieve the init function component from an INFO-VARIANT-PART. | |
991 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part." | |
992 (elt info-variant-part 5)) | |
993 | |
994 (defsubst artist-go-get-prep-fill-fn (info-variant-part) | |
995 "Retrieve the fill preparation function component from an INFO-VARIANT-PART. | |
996 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part." | |
997 (elt info-variant-part 6)) | |
998 | |
999 (defsubst artist-go-get-exit-fn (info-variant-part) | |
1000 "Retrieve the exit component from an INFO-VARIANT-PART. | |
1001 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part." | |
1002 (elt info-variant-part 7)) | |
1003 | |
1004 (defsubst artist-go-get-draw-how (info-variant-part) | |
1005 "Retrieve the draw how component from an INFO-VARIANT-PART. | |
1006 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part." | |
1007 (elt info-variant-part 8)) | |
1008 | |
1009 (defsubst artist-go-get-draw-fn (info-variant-part) | |
1010 "Retrieve the draw function component from an INFO-VARIANT-PART. | |
1011 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part." | |
1012 (elt info-variant-part 9)) | |
1013 | |
1014 (defsubst artist-go-get-undraw-fn (info-variant-part) | |
1015 "Retrieve the undraw function component from an INFO-VARIANT-PART. | |
1016 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part. | |
1017 This interval function component is available only if the `draw-how' | |
1018 component is other than `artist-do-continously' or 1." | |
1019 (elt (elt info-variant-part 10) 0)) | |
1020 | |
1021 (defsubst artist-go-get-interval-fn (info-variant-part) | |
1022 "Retrieve the interval function component from an INFO-VARIANT-PART. | |
1023 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part. | |
1024 This interval function component is available only if the `draw-how' | |
1025 component is `artist-do-continously'." | |
1026 (elt (elt info-variant-part 10) 0)) | |
1027 | |
1028 (defsubst artist-go-get-fill-pred (info-variant-part) | |
1029 "Retrieve the fill predicate component from an INFO-VARIANT-PART. | |
1030 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part. | |
1031 This interval function component is available only if the `draw-how' | |
1032 component is other than `artist-do-continously' or 1." | |
1033 (elt (elt info-variant-part 10) 1)) | |
1034 | |
1035 (defsubst artist-go-get-fill-fn (info-variant-part) | |
1036 "Retrieve the fill function component from an INFO-VARIANT-PART. | |
1037 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part. | |
1038 This interval function component is available only if the `draw-how' | |
1039 component is other than `artist-do-continously' or 1." | |
1040 (elt (elt info-variant-part 10) 2)) | |
1041 | |
1042 ;; For the 'function-call info-parts | |
1043 ;; | |
1044 (defsubst artist-fc-get-keyword (info-part) | |
1045 "Retrieve the keyword component from a graphics operation INFO-PART." | |
1046 (elt info-part 0)) | |
1047 | |
1048 (defsubst artist-fc-get-symbol (info-part) | |
1049 "Retrieve the symbol component from a graphics operation INFO-PART." | |
1050 (elt info-part 1)) | |
1051 | |
1052 (defsubst artist-fc-get-fn (info-part) | |
1053 "Retrieve the function component from a graphics operation INFO-PART." | |
1054 (elt info-part 2)) | |
1055 | |
1056 ;; For the 'menu info-parts | |
1057 ;; | |
1058 (defsubst artist-mn-get-title (info-part) | |
1059 "Retrieve the title component from a graphics operation INFO-PART." | |
1060 (elt info-part 0)) | |
1061 | |
1062 (defsubst artist-mn-get-items (info-part) | |
1063 "Retrieve the items component from a graphics operation INFO-PART." | |
1064 (elt info-part 1)) | |
1065 | |
1066 ;;; --------------------------------- | |
1067 ;;; The artist-mode | |
1068 ;;; --------------------------------- | |
1069 | |
33653
55d418b6992e
(artist-mode): Fix autoload cookie.
Gerd Moellmann <gerd@gnu.org>
parents:
33618
diff
changeset
|
1070 ;;;###autoload |
33618 | 1071 (defun artist-mode (&optional state) |
1072 "Toggle artist mode. With arg, turn artist mode on if arg is positive. | |
1073 Artist lets you draw lines, squares, rectangles and poly-lines, ellipses | |
1074 and circles with your mouse and/or keyboard. | |
1075 | |
1076 How to quit artist mode | |
1077 | |
1078 Type \\[artist-mode-off] to quit artist-mode. | |
1079 | |
1080 | |
1081 How to submit a bug report | |
1082 | |
1083 Type \\[artist-submit-bug-report] to submit a bug report. | |
1084 | |
1085 | |
1086 Drawing with the mouse: | |
1087 | |
1088 mouse-2 | |
1089 shift mouse-2 Pops up a menu where you can select what to draw with | |
1090 mouse-1, and where you can do some settings (described | |
1091 below). | |
1092 | |
1093 mouse-1 | |
1094 shift mouse-1 Draws lines, rectangles or poly-lines, erases, cuts, copies | |
1095 or pastes: | |
1096 | |
1097 Operation Not shifted Shifted | |
1098 -------------------------------------------------------------- | |
1099 Pen fill-char at point line from last point | |
1100 to new point | |
1101 -------------------------------------------------------------- | |
1102 Line Line in any direction Straight line | |
1103 -------------------------------------------------------------- | |
1104 Rectangle Rectangle Square | |
1105 -------------------------------------------------------------- | |
1106 Poly-line Poly-line in any dir Straight poly-lines | |
1107 -------------------------------------------------------------- | |
1108 Ellipses Ellipses Circles | |
1109 -------------------------------------------------------------- | |
1110 Text Text (see thru) Text (overwrite) | |
1111 -------------------------------------------------------------- | |
1112 Spray-can Spray-can Set size for spray | |
1113 -------------------------------------------------------------- | |
1114 Erase Erase character Erase rectangle | |
1115 -------------------------------------------------------------- | |
1116 Vaporize Erase single line Erase connected | |
1117 lines | |
1118 -------------------------------------------------------------- | |
1119 Cut Cut rectangle Cut square | |
1120 -------------------------------------------------------------- | |
1121 Copy Copy rectangle Copy square | |
1122 -------------------------------------------------------------- | |
1123 Paste Paste Paste | |
1124 -------------------------------------------------------------- | |
1125 Flood-fill Flood-fill Flood-fill | |
1126 -------------------------------------------------------------- | |
1127 | |
37825
8968ceca1581
(artist-mode): Fix a typo. From Pavel Janik <Pavel@Janik.cz>.
Eli Zaretskii <eliz@gnu.org>
parents:
34903
diff
changeset
|
1128 * Straight lines can only go horizontally, vertically |
33618 | 1129 or diagonally. |
1130 | |
1131 * Poly-lines are drawn while holding mouse-1 down. When you | |
1132 release the button, the point is set. If you want a segment | |
1133 to be straight, hold down shift before pressing the | |
1134 mouse-1 button. Click mouse-2 or mouse-3 to stop drawing | |
1135 poly-lines. | |
1136 | |
1137 * See thru for text means that text already in the buffer | |
1138 will be visible through blanks in the text rendered, while | |
1139 overwrite means the opposite. | |
1140 | |
1141 * Vaporizing connected lines only vaporizes lines whose | |
1142 _endpoints_ are connected. See also the variable | |
1143 `artist-vaporize-fuzziness'. | |
1144 | |
1145 * Cut copies, then clears the rectangle/square. | |
1146 | |
1147 * When drawing lines or poly-lines, you can set arrows. | |
1148 See below under ``Arrows'' for more info. | |
1149 | |
1150 * The mode line shows the currently selected drawing operation. | |
1151 In addition, if it has an asterisk (*) at the end, you | |
1152 are currently drawing something. | |
1153 | |
1154 * Be patient when flood-filling -- large areas take quite | |
1155 some time to fill. | |
1156 | |
1157 | |
1158 mouse-3 Erases character under pointer | |
1159 shift mouse-3 Erases rectangle | |
1160 | |
1161 | |
1162 Settings | |
1163 | |
1164 Set fill Sets the character used when filling rectangles/squares | |
1165 | |
1166 Set line Sets the character used when drawing lines | |
1167 | |
1168 Erase char Sets the character used when erasing | |
1169 | |
1170 Rubber-banding Toggles rubber-banding | |
1171 | |
1172 Trimming Toggles trimming of line-endings (that is: when the shape | |
1173 is drawn, extraneous white-space at end of lines is removed) | |
1174 | |
1175 Borders Toggles the drawing of line borders around filled shapes. | |
1176 | |
1177 | |
1178 Drawing with keys | |
1179 | |
1180 \\[artist-key-set-point] Does one of the following: | |
1181 For lines/rectangles/squares: sets the first/second endpoint | |
1182 For poly-lines: sets a point (use C-u \\[artist-key-set-point] to set last point) | |
1183 When erase characters: toggles erasing | |
1184 When cutting/copying: Sets first/last endpoint of rect/square | |
1185 When pasting: Pastes | |
1186 | |
1187 \\[artist-select-operation] Selects what to draw | |
1188 | |
1189 Move around with \\[artist-next-line], \\[artist-previous-line], \\[artist-forward-char] and \\[artist-backward-char]. | |
1190 | |
1191 \\[artist-select-fill-char] Sets the charater to use when filling | |
1192 \\[artist-select-line-char] Sets the charater to use when drawing | |
1193 \\[artist-select-erase-char] Sets the charater to use when erasing | |
1194 \\[artist-toggle-rubber-banding] Toggles rubber-banding | |
1195 \\[artist-toggle-trim-line-endings] Toggles trimming of line-endings | |
1196 \\[artist-toggle-borderless-shapes] Toggles borders on drawn shapes | |
1197 | |
1198 | |
1199 Arrows | |
1200 | |
1201 \\[artist-toggle-first-arrow] Sets/unsets an arrow at the beginning | |
1202 of the line/poly-line | |
1203 | |
1204 \\[artist-toggle-second-arrow] Sets/unsets an arrow at the end | |
1205 of the line/poly-line | |
1206 | |
1207 | |
1208 Selecting operation | |
1209 | |
1210 There are some keys for quickly selecting drawing operations: | |
1211 | |
1212 \\[artist-select-op-line] Selects drawing lines | |
1213 \\[artist-select-op-straight-line] Selects drawing straight lines | |
1214 \\[artist-select-op-rectangle] Selects drawing rectangles | |
1215 \\[artist-select-op-square] Selects drawing squares | |
1216 \\[artist-select-op-poly-line] Selects drawing poly-lines | |
1217 \\[artist-select-op-straight-poly-line] Selects drawing straight poly-lines | |
1218 \\[artist-select-op-ellipse] Selects drawing ellipses | |
1219 \\[artist-select-op-circle] Selects drawing circles | |
1220 \\[artist-select-op-text-see-thru] Selects rendering text (see thru) | |
1221 \\[artist-select-op-text-overwrite] Selects rendering text (overwrite) | |
1222 \\[artist-select-op-spray-can] Spray with spray-can | |
1223 \\[artist-select-op-spray-set-size] Set size for the spray-can | |
1224 \\[artist-select-op-erase-char] Selects erasing characters | |
1225 \\[artist-select-op-erase-rectangle] Selects erasing rectangles | |
1226 \\[artist-select-op-vaporize-line] Selects vaporizing single lines | |
1227 \\[artist-select-op-vaporize-lines] Selects vaporizing connected lines | |
1228 \\[artist-select-op-cut-rectangle] Selects cutting rectangles | |
1229 \\[artist-select-op-copy-rectangle] Selects copying rectangles | |
1230 \\[artist-select-op-paste] Selects pasting | |
1231 \\[artist-select-op-flood-fill] Selects flood-filling | |
1232 | |
1233 | |
1234 Variables | |
1235 | |
1236 This is a brief overview of the different varaibles. For more info, | |
1237 see the documentation for the variables (type \\[describe-variable] <variable> RET). | |
1238 | |
1239 artist-rubber-banding Interactively do rubber-banding or not | |
1240 artist-first-char What to set at first/second point... | |
1241 artist-second-char ...when not rubber-banding | |
1242 artist-interface-with-rect If cut/copy/paste should interface with rect | |
1243 artist-arrows The arrows to use when drawing arrows | |
1244 artist-aspect-ratio Character height-to-width for squares | |
1245 artist-trim-line-endings Trimming of line endings | |
1246 artist-flood-fill-right-border Right border when flood-filling | |
1247 artist-flood-fill-show-incrementally Update display while filling | |
1248 artist-pointer-shape Pointer shape to use while drawing | |
1249 artist-ellipse-left-char Character to use for narrow ellipses | |
1250 artist-ellipse-right-char Character to use for narrow ellipses | |
1251 artist-borderless-shapes If shapes should have borders | |
1252 artist-picture-compatibility Whether or not to be picture mode compatible | |
1253 artist-vaporize-fuzziness Tolerance when recognizing lines | |
1254 artist-spray-interval Seconds between repeated sprayings | |
1255 artist-spray-radius Size of the spray-area | |
1256 artist-spray-chars The spray-``color'' | |
1257 artist-spray-new-chars Initial spray-``color'' | |
1258 | |
1259 Hooks | |
1260 | |
1261 When entering artist-mode, the hook `artist-mode-init-hook' is called. | |
1262 When quitting artist-mode, the hook `artist-mode-exit-hook' is called. | |
1263 | |
1264 | |
1265 Keymap summary | |
1266 | |
1267 \\{artist-mode-map}" | |
1268 (interactive) | |
1269 (if (setq artist-mode | |
1270 (if (null state) (not artist-mode) | |
1271 (> (prefix-numeric-value state) 0))) | |
1272 (artist-mode-init) | |
1273 (artist-mode-exit))) | |
1274 | |
1275 ;; insert our minor mode string | |
1276 (or (assq 'artist-mode minor-mode-alist) | |
1277 (setq minor-mode-alist | |
1278 (cons '(artist-mode artist-mode-name) | |
1279 minor-mode-alist))) | |
1280 | |
1281 ;; insert our minor mode keymap | |
1282 (or (assq 'artist-mode minor-mode-map-alist) | |
1283 (setq minor-mode-map-alist | |
1284 (cons (cons 'artist-mode artist-mode-map) | |
1285 minor-mode-map-alist))) | |
1286 | |
1287 | |
1288 | |
1289 (eval-when-compile | |
1290 ;; Variables that are made local in artist-mode-init | |
1291 (defvar artist-key-is-drawing nil) | |
1292 (defvar artist-key-endpoint1 nil) | |
1293 (defvar artist-key-poly-point-list nil) | |
1294 (defvar artist-key-shape nil) | |
1295 (defvar artist-key-draw-how nil) | |
1296 (defvar artist-popup-menu-table nil) | |
1297 (defvar artist-key-compl-table nil) | |
1298 (defvar artist-rb-save-data nil) | |
1299 (defvar artist-arrow-point-1 nil) | |
1300 (defvar artist-arrow-point-2 nil)) | |
1301 | |
1302 | |
1303 ;; Init and exit | |
1304 (defun artist-mode-init () | |
1305 "Init Artist mode. This will call the hook `artist-mode-init-hook'." | |
1306 (let ((i 0)) | |
1307 (while (< i 256) | |
1308 (aset artist-replacement-table i i) | |
1309 (setq i (1+ i)))) | |
1310 (aset artist-replacement-table ?\n ?\ ) | |
1311 (aset artist-replacement-table ?\t ?\ ) | |
1312 (aset artist-replacement-table 0 ?\ ) | |
1313 (make-local-variable 'artist-key-is-drawing) | |
1314 (make-local-variable 'artist-key-endpoint1) | |
1315 (make-local-variable 'artist-key-poly-point-list) | |
1316 (make-local-variable 'artist-key-shape) | |
1317 (make-local-variable 'artist-key-draw-how) | |
1318 (make-local-variable 'artist-popup-menu-table) | |
1319 (make-local-variable 'artist-key-compl-table) | |
1320 (make-local-variable 'artist-rb-save-data) | |
1321 (make-local-variable 'artist-arrow-point-1) | |
1322 (make-local-variable 'artist-arrow-point-2) | |
1323 (setq artist-key-is-drawing nil) | |
1324 (setq artist-key-endpoint1 nil) | |
1325 (setq artist-key-poly-point-list nil) | |
1326 (setq artist-key-shape nil) | |
1327 (setq artist-popup-menu-table (artist-compute-popup-menu-table artist-mt)) | |
1328 (setq artist-key-compl-table (artist-compute-key-compl-table artist-mt)) | |
1329 (setq artist-rb-save-data (make-vector 7 0)) | |
1330 (setq artist-arrow-point-1 nil) | |
1331 (setq artist-arrow-point-2 nil) | |
1332 (make-local-variable 'next-line-add-newlines) | |
1333 (setq next-line-add-newlines t) | |
1334 (setq artist-key-draw-how | |
1335 (artist-go-get-draw-how-from-symbol artist-curr-go)) | |
1336 (if (and artist-picture-compatibility (not (eq major-mode 'picture-mode))) | |
1337 (progn | |
1338 (picture-mode) | |
1339 (message ""))) | |
1340 (run-hooks 'artist-mode-init-hook) | |
1341 (artist-mode-line-show-curr-operation artist-key-is-drawing)) | |
1342 | |
1343 (defun artist-mode-exit () | |
1344 "Exit Artist mode. This will call the hook `artist-mode-exit-hook'." | |
1345 (if (and artist-picture-compatibility (eq major-mode 'picture-mode)) | |
1346 (picture-mode-exit)) | |
1347 (kill-local-variable 'next-line-add-newlines) | |
1348 (run-hooks 'artist-mode-exit-hook)) | |
1349 | |
1350 (defun artist-mode-off () | |
1351 "Turn Artist mode off." | |
1352 (interactive) | |
1353 (artist-mode -1) | |
1354 (force-mode-line-update)) | |
1355 | |
1356 ;; | |
1357 ;; General routines | |
1358 ;; | |
1359 | |
1360 (defun artist-update-display () | |
1361 "Repaint the display." | |
1362 (sit-for 0)) | |
1363 | |
1364 (defun artist-mode-line-show-curr-operation (is-drawing) | |
1365 "Show current operation in mode-line. If IS-DRAWING, show that." | |
1366 (let ((mtext (concat artist-mode-name "/" | |
1367 (artist-go-get-mode-line-from-symbol artist-curr-go) | |
1368 (if is-drawing "/*" "")))) | |
1369 (setcdr (assq 'artist-mode minor-mode-alist) (list mtext))) | |
1370 (force-mode-line-update)) | |
1371 | |
1372 | |
1373 (defun artist-t-if-fill-char-set () | |
1374 "Return the value of the variable `artist-fill-char-set'." | |
1375 artist-fill-char-set) | |
1376 | |
1377 (defun artist-t () | |
1378 "Always return t." | |
1379 t) | |
1380 | |
1381 (defun artist-nil () | |
1382 "Always return nil." | |
1383 nil) | |
1384 | |
1385 (defun artist-arrows () | |
1386 "Say yes to arrows!" | |
1387 t) | |
1388 | |
1389 (defun artist-no-arrows () | |
1390 "Say no to arrows!" | |
1391 nil) | |
1392 | |
1393 ;; | |
1394 ;; Auxiliary init-routines | |
1395 ;; | |
1396 | |
1397 ; | |
1398 ; Computing the table for the x-popup-menu from the master table | |
1399 ; | |
1400 | |
1401 (defun artist-compute-popup-menu-table (menu-table) | |
1402 "Create a menu from from MENU-TABLE data. | |
1403 The returned value is suitable for the `x-popup-menu' function." | |
1404 (cons "Artist menu" | |
1405 (artist-compute-popup-menu-table-sub menu-table))) | |
1406 | |
1407 (defun artist-compute-popup-menu-table-sub (menu-table) | |
1408 "Compute operation table suitable for `x-popup-menu' from MENU-TABLE." | |
1409 (mapcar | |
1410 (lambda (element) | |
1411 (let ((element-tag (artist-mt-get-tag element))) | |
1412 (cond ((eq element-tag 'graphics-operation) | |
1413 (let* ((info-part (artist-mt-get-info-part element)) | |
1414 (descr (artist-go-get-desc info-part)) | |
1415 (unshifted (artist-go-get-unshifted info-part)) | |
1416 (symbol (artist-go-get-symbol unshifted))) | |
1417 (list descr symbol))) | |
1418 | |
1419 ((eq element-tag 'function-call) | |
1420 (let* ((info-part (artist-mt-get-info-part element)) | |
1421 (keyword (artist-fc-get-keyword info-part)) | |
1422 (symbol (artist-fc-get-symbol info-part))) | |
1423 (list keyword symbol))) | |
1424 | |
1425 ((eq element-tag 'separator) | |
1426 '("" "")) | |
1427 | |
1428 ((eq element-tag 'menu) | |
1429 (let* ((info-part (artist-mt-get-info-part element)) | |
1430 (title (artist-mn-get-title info-part)) | |
1431 (items (artist-mn-get-items info-part))) | |
1432 (cons title (artist-compute-popup-menu-table-sub items)))) | |
1433 | |
1434 (t | |
1435 (error "Internal error: unknown element-tag: \"%s\"" | |
1436 element-tag))))) | |
1437 menu-table)) | |
1438 | |
1439 ; | |
1440 ; Computing the completion table from the master table | |
1441 ; | |
1442 | |
1443 (defun artist-compute-key-compl-table (menu-table) | |
1444 "Compute completion table from MENU-TABLE, suitable for `completing-read'." | |
1445 (apply | |
1446 'nconc | |
1447 (artist-remove-nulls | |
1448 (mapcar | |
1449 (lambda (element) | |
1450 (let ((element-tag (artist-mt-get-tag element))) | |
1451 (cond ((eq element-tag 'graphics-operation) | |
1452 (let* ((info-part (artist-mt-get-info-part element)) | |
1453 (unshifted (artist-go-get-unshifted info-part)) | |
1454 (shifted (artist-go-get-shifted info-part)) | |
1455 (unshifted-kwd (artist-go-get-keyword unshifted)) | |
1456 (shifted-kwd (artist-go-get-keyword shifted))) | |
1457 (list (list unshifted-kwd) (list shifted-kwd)))) | |
1458 ((eq element-tag 'menu) | |
1459 (let* ((info-part (artist-mt-get-info-part element)) | |
1460 (items (artist-mn-get-items info-part))) | |
1461 (artist-compute-key-compl-table items))) | |
1462 (t | |
1463 nil)))) | |
1464 menu-table)))) | |
1465 | |
1466 | |
1467 ; | |
1468 ; Retrieving a symbol (graphics operation or function-call) from a keyword | |
1469 ; | |
1470 | |
1471 (defun artist-mt-get-symbol-from-keyword (kwd) | |
1472 "Search master table for keyword KWD and return its symbol." | |
1473 (artist-mt-get-symbol-from-keyword-sub artist-mt kwd)) | |
1474 | |
1475 (defun artist-mt-get-symbol-from-keyword-sub (table kwd) | |
1476 "Search TABLE for keyword KWD and return its symbol." | |
1477 (catch 'found | |
1478 (mapcar | |
1479 (lambda (element) | |
1480 (let ((element-tag (artist-mt-get-tag element))) | |
1481 (cond ((eq element-tag 'graphics-operation) | |
1482 (let* ((info-part (artist-mt-get-info-part element)) | |
1483 (unshifted (artist-go-get-unshifted info-part)) | |
1484 (shifted (artist-go-get-shifted info-part)) | |
1485 (unshifted-kwd (artist-go-get-keyword unshifted)) | |
1486 (shifted-kwd (artist-go-get-keyword shifted)) | |
1487 (unshifted-sym (artist-go-get-symbol unshifted)) | |
1488 (shifted-sym (artist-go-get-symbol shifted))) | |
1489 (if (string-equal kwd unshifted-kwd) | |
1490 (throw 'found unshifted-sym)) | |
1491 (if (string-equal kwd shifted-kwd) | |
1492 (throw 'found shifted-sym)))) | |
1493 | |
1494 ((eq element-tag 'function-call) | |
1495 (let* ((info-part (artist-mt-get-info-part element)) | |
1496 (keyword (artist-fc-get-keyword info-part)) | |
1497 (symbol (artist-fc-get-symbol info-part))) | |
1498 (if (string-equal kwd keyword) | |
1499 (throw 'found symbol)))) | |
1500 ((eq element-tag 'menu) | |
1501 (let* ((info-part (artist-mt-get-info-part element)) | |
1502 (items (artist-mn-get-items info-part)) | |
1503 (answer (artist-mt-get-symbol-from-keyword-sub | |
1504 items kwd))) | |
1505 (if answer (throw 'found answer)))) | |
1506 (t | |
1507 nil)))) | |
1508 table) | |
1509 nil)) | |
1510 | |
1511 | |
1512 ; | |
1513 ; Retrieving info from a graphics operation symbol | |
1514 ; | |
1515 | |
1516 (defun artist-go-retrieve-from-symbol (symbol retrieve-fn) | |
1517 "Search the master table for a graphics operation SYMBOL. | |
1518 Calls RETRIEVE-FN to retrieve information from that symbol's | |
1519 info-variant-part." | |
1520 (artist-go-retrieve-from-symbol-sub artist-mt symbol retrieve-fn)) | |
1521 | |
1522 (defun artist-go-retrieve-from-symbol-sub (table symbol retrieve-fn) | |
1523 "Search the TABLE for a graphics operation SYMBOL. | |
1524 Calls RETRIEVE-FN to retrieve information from that symbol's | |
1525 info-variant-part." | |
1526 (catch 'found | |
1527 (mapcar | |
1528 (lambda (element) | |
1529 (let ((element-tag (artist-mt-get-tag element))) | |
1530 (cond ((eq element-tag 'graphics-operation) | |
1531 (let* ((info-part (artist-mt-get-info-part element)) | |
1532 (unshifted (artist-go-get-unshifted info-part)) | |
1533 (shifted (artist-go-get-shifted info-part)) | |
1534 (unshifted-sym (artist-go-get-symbol unshifted)) | |
1535 (shifted-sym (artist-go-get-symbol shifted)) | |
1536 (variant-part (cond | |
1537 ((eq unshifted-sym symbol) unshifted) | |
1538 ((eq shifted-sym symbol) shifted) | |
1539 (t nil)))) | |
1540 (if variant-part ; if found do: | |
1541 (throw 'found (funcall retrieve-fn variant-part))))) | |
1542 | |
1543 ((eq element-tag 'menu) | |
1544 (let* ((info-part (artist-mt-get-info-part element)) | |
1545 (items (artist-mn-get-items info-part)) | |
1546 (answer (artist-go-retrieve-from-symbol-sub | |
1547 items symbol retrieve-fn))) | |
1548 (if answer (throw 'found answer))))))) | |
1549 | |
1550 table) | |
1551 nil)) | |
1552 | |
1553 (defun artist-go-get-keyword-from-symbol (symbol) | |
1554 "Search the master table, get keyword from a graphics operation SYMBOL." | |
1555 (artist-go-retrieve-from-symbol symbol 'artist-go-get-keyword)) | |
1556 | |
1557 (defun artist-go-get-mode-line-from-symbol (symbol) | |
1558 "Search the master table, get mode-line from a graphics operation SYMBOL." | |
1559 (artist-go-retrieve-from-symbol symbol 'artist-go-get-mode-line)) | |
1560 | |
1561 (defun artist-go-get-arrow-pred-from-symbol (symbol) | |
1562 "Search the master table, get arrow-pred from a graphics operation SYMBOL." | |
1563 (artist-go-retrieve-from-symbol symbol 'artist-go-get-arrow-pred)) | |
1564 | |
1565 (defun artist-go-get-arrow-set-fn-from-symbol (symbol) | |
1566 "Search the master table, get arrow-set-fn from a graphics operation SYMBOL." | |
1567 (artist-go-retrieve-from-symbol symbol 'artist-go-get-arrow-set-fn)) | |
1568 | |
1569 (defun artist-go-get-init-fn-from-symbol (symbol) | |
1570 "Search the master table, get init-fn from a graphics operation SYMBOL." | |
1571 (artist-go-retrieve-from-symbol symbol 'artist-go-get-init-fn)) | |
1572 | |
1573 (defun artist-go-get-prep-fill-fn-from-symbol (symbol) | |
1574 "Search the master table, get prep-fill-fn from a graphics operation SYMBOL." | |
1575 (artist-go-retrieve-from-symbol symbol 'artist-go-get-prep-fill-fn)) | |
1576 | |
1577 (defun artist-go-get-exit-fn-from-symbol (symbol) | |
1578 "Search the master table, get exit-fn from a graphics operation SYMBOL." | |
1579 (artist-go-retrieve-from-symbol symbol 'artist-go-get-exit-fn)) | |
1580 | |
1581 (defun artist-go-get-draw-fn-from-symbol (symbol) | |
1582 "Search the master table, get draw-fn from a graphics operation SYMBOL." | |
1583 (artist-go-retrieve-from-symbol symbol 'artist-go-get-draw-fn)) | |
1584 | |
1585 (defun artist-go-get-draw-how-from-symbol (symbol) | |
1586 "Search the master table, get draw-how from a graphics operation SYMBOL." | |
1587 (artist-go-retrieve-from-symbol symbol 'artist-go-get-draw-how)) | |
1588 | |
1589 (defun artist-go-get-undraw-fn-from-symbol (symbol) | |
1590 "Search the master table, get undraw-fn from a graphics operation SYMBOL." | |
1591 (artist-go-retrieve-from-symbol symbol 'artist-go-get-undraw-fn)) | |
1592 | |
1593 (defun artist-go-get-interval-fn-from-symbol (symbol) | |
1594 "Search the master table, get interval-fn from a graphics operation SYMBOL." | |
1595 (artist-go-retrieve-from-symbol symbol 'artist-go-get-interval-fn)) | |
1596 | |
1597 (defun artist-go-get-fill-pred-from-symbol (symbol) | |
1598 "Search the master table, get fill-pred from a graphics operation SYMBOL." | |
1599 (artist-go-retrieve-from-symbol symbol 'artist-go-get-fill-pred)) | |
1600 | |
1601 (defun artist-go-get-fill-fn-from-symbol (symbol) | |
1602 "Search the master table, get fill-fn from a graphics operation SYMBOL." | |
1603 (artist-go-retrieve-from-symbol symbol 'artist-go-get-fill-fn)) | |
1604 | |
1605 (defun artist-go-get-symbol-shift (symbol is-shifted) | |
1606 "Search for (shifted or unshifted) graphics operation SYMBOL. | |
1607 If IS-SHIFTED is non-nil, return the shifted symbol, | |
1608 otherwise the shifted symbol." | |
1609 (artist-go-get-symbol-shift-sub artist-mt symbol is-shifted)) | |
1610 | |
1611 (defun artist-go-get-symbol-shift-sub (table symbol is-shifted) | |
1612 "Search TABLE for (shifted or unshifted) graphics SYMBOL. | |
1613 If IS-SHIFTED is non-nil, return the shifted symbol, | |
1614 otherwise the shifted symbol." | |
1615 (catch 'found | |
1616 (mapcar | |
1617 (lambda (element) | |
1618 (let ((element-tag (artist-mt-get-tag element))) | |
1619 (cond ((eq element-tag 'graphics-operation) | |
1620 (let* ((info-part (artist-mt-get-info-part element)) | |
1621 (unshift-variant (artist-go-get-unshifted info-part)) | |
1622 (shift-variant (artist-go-get-shifted info-part)) | |
1623 (unshift-sym (artist-go-get-symbol unshift-variant)) | |
1624 (shift-sym (artist-go-get-symbol shift-variant))) | |
1625 (if (or (eq symbol unshift-sym) (eq symbol shift-sym)) | |
1626 (throw 'found (if is-shifted shift-sym unshift-sym))))) | |
1627 | |
1628 ((eq element-tag 'menu) | |
1629 (let* ((info-part (artist-mt-get-info-part element)) | |
1630 (items (artist-mn-get-items info-part)) | |
1631 (answer (artist-go-get-symbol-shift-sub | |
1632 items symbol is-shifted))) | |
1633 (if answer (throw 'found answer))))))) | |
1634 | |
1635 table) | |
1636 nil)) | |
1637 | |
1638 ; | |
1639 ; Retrieving info from a function-call symbol | |
1640 ; | |
1641 | |
1642 (defun artist-fc-retrieve-from-symbol (symbol retrieve-fn) | |
1643 "Search the master table for a function call SYMBOL. | |
1644 Calls RETRIEVE-FN to retrieve information from that symbol's | |
1645 info-variant-part." | |
1646 (artist-fc-retrieve-from-symbol-sub artist-mt symbol retrieve-fn)) | |
1647 | |
1648 (defun artist-fc-retrieve-from-symbol-sub (table symbol retrieve-fn) | |
1649 "Search TABLE for a function-call SYMBOL. | |
1650 Calls RETRIEVE-FN to retrieve information from that symbol's | |
1651 info-variant-part." | |
1652 (catch 'found | |
1653 (mapcar | |
1654 (lambda (element) | |
1655 (let ((element-tag (artist-mt-get-tag element))) | |
1656 (cond ((eq element-tag 'function-call) | |
1657 (let* ((info-part (artist-mt-get-info-part element)) | |
1658 (fc-symbol (artist-fc-get-symbol info-part))) | |
1659 (if (eq fc-symbol symbol) | |
1660 (throw 'found (funcall retrieve-fn info-part))))) | |
1661 | |
1662 ((eq element-tag 'menu) | |
1663 (let* ((info-part (artist-mt-get-info-part element)) | |
1664 (items (artist-mn-get-items info-part)) | |
1665 (answer (artist-fc-retrieve-from-symbol-sub | |
1666 items symbol retrieve-fn))) | |
1667 (if answer (throw 'found answer))))))) | |
1668 | |
1669 table) | |
1670 nil)) | |
1671 | |
1672 (defun artist-fc-get-fn-from-symbol (symbol) | |
1673 "Search the master table to get function from a function call SYMBOL." | |
1674 (artist-fc-retrieve-from-symbol symbol 'artist-fc-get-fn)) | |
1675 | |
1676 | |
1677 ;; | |
1678 ;; Utilities | |
1679 ;; | |
1680 | |
1681 ;; Macro that won't funcall the function if it is nil. | |
1682 ;; | |
1683 (defmacro artist-funcall (fn &rest args) | |
1684 "Call function FN with ARGS iff FN is not nil." | |
1685 (list 'if fn (cons 'funcall (cons fn args)))) | |
1686 | |
40323 | 1687 (defvar artist-butlast-fn 'artist-butlast |
1688 "The butlast function") | |
1689 | |
1690 (if (fboundp 'butlast) | |
1691 (setq artist-butlast-fn 'butlast) | |
1692 (setq artist-butlast-fn 'artist-butlast)) | |
1693 | |
1694 (defun artist-butlast (l) | |
1695 "Return the list L with all elements but the last." | |
1696 (cond ((null l) nil) | |
1697 ((null (cdr l)) nil) | |
1698 (t (cons (car l) (artist-butlast (cdr l)))))) | |
1699 | |
1700 | |
33618 | 1701 (defun artist-last (seq &optional n) |
1702 "Return the last link in the list SEQ. | |
1703 With optional argument N, returns Nth-to-last link (default 1)." | |
1704 (if (not n) | |
1705 (setq n 1)) | |
1706 (let ((len (length seq))) | |
1707 (elt seq (- len n)))) | |
1708 | |
1709 (defun artist-remove-nulls (l) | |
1710 "Remove nils in list L." | |
1711 (cond ((null l) nil) | |
1712 ((null (car l)) (artist-remove-nulls (cdr l))) | |
1713 (t (cons (car l) (artist-remove-nulls (cdr l)))))) | |
1714 | |
1715 (defun artist-uniq (l) | |
1716 "Remove consecutive duplicates in list L. Comparison is done with `equal'." | |
1717 (cond ((null l) nil) | |
1718 ((null (cdr l)) l) ; only one element in list | |
1719 ((equal (car l) (car (cdr l))) (artist-uniq (cdr l))) ; first 2 equal | |
1720 (t (cons (car l) (artist-uniq (cdr l)))))) ; first 2 are different | |
1721 | |
1722 (defmacro artist-push (x stack) | |
1723 "Push element X to a STACK." | |
1724 (list 'setq stack (list 'cons x stack))) | |
1725 | |
1726 (defmacro artist-pop (stack) | |
1727 "Pop an element from a STACK." | |
1728 (list 'prog1 | |
1729 (list 'car stack) | |
1730 (list 'setq stack (list 'cdr stack)))) | |
1731 | |
1732 (defun artist-string-split (str r) | |
1733 "Split string STR at occurrences of regexp R, returning a list of strings." | |
1734 (let ((res nil) | |
1735 (start 0) | |
1736 (match-pos 0)) | |
1737 (while (setq match-pos (string-match r str start)) | |
1738 (setq res (cons (copy-sequence (substring str start match-pos)) res)) | |
1739 (setq start (match-end 0))) | |
1740 (if (null res) | |
1741 (list str) | |
1742 (if (< (match-end 0) (- (length str) 1)) | |
1743 (setq res (cons (substring str (match-end 0) (length str)) res))) | |
1744 (reverse res)))) | |
1745 | |
1746 (defun artist-string-to-file (str file-name) | |
1747 "Write string STR to file FILE-NAME." | |
1748 (write-region str 'end-is-ignored file-name nil 'no-message)) | |
1749 | |
1750 (defun artist-file-to-string (file-name) | |
1751 "Read from file FILE-NAME into a string." | |
1752 (save-excursion | |
1753 (let ((tmp-buffer (get-buffer-create (concat "*artist-" file-name "*")))) | |
1754 (set-buffer tmp-buffer) | |
1755 (goto-char (point-min)) | |
1756 (insert-file-contents file-name nil nil nil t) | |
1757 (let ((str (copy-sequence (buffer-substring (point-min) | |
1758 (point-max))))) | |
1759 (kill-buffer tmp-buffer) | |
1760 str)))) | |
1761 | |
1762 (defun artist-clear-buffer (buf) | |
1763 "Clear contents of buffer BUF." | |
1764 (save-excursion | |
1765 (set-buffer buf) | |
1766 (goto-char (point-min)) | |
1767 (delete-char (- (point-max) (point-min)) nil))) | |
1768 | |
47953
126b6cb8740d
(artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents:
46163
diff
changeset
|
1769 |
33618 | 1770 (defun artist-system (program stdin &optional program-args) |
1771 "Run PROGRAM synchronously with the contents of string STDIN to stdin. | |
1772 Optional args PROGRAM-ARGS are arguments to PROGRAM. | |
1773 Return a list (RETURN-CODE STDOUT STDERR)." | |
1774 (save-excursion | |
1775 (let* ((tmp-stdin-file-name (if stdin | |
43685
498bad2aca78
(artist-system): Use make-temp-file.
Richard M. Stallman <rms@gnu.org>
parents:
42706
diff
changeset
|
1776 (make-temp-file |
33618 | 1777 (concat (file-name-as-directory |
1778 (or (getenv "TMPDIR") "/tmp")) | |
1779 "artist-stdin.")) | |
1780 nil)) | |
1781 (tmp-stdout-buffer (get-buffer-create | |
1782 (concat "*artist-" program "*"))) | |
43685
498bad2aca78
(artist-system): Use make-temp-file.
Richard M. Stallman <rms@gnu.org>
parents:
42706
diff
changeset
|
1783 (tmp-stderr-file-name (make-temp-file |
33618 | 1784 (concat (file-name-as-directory |
1785 (or (getenv "TMPDIR") "/tmp")) | |
1786 "artist-stdout."))) | |
1787 (binary-process-input nil) ; for msdos | |
1788 (binary-process-output nil)) | |
1789 | |
1790 ;; Prepare stdin | |
1791 (if stdin (artist-string-to-file stdin tmp-stdin-file-name)) | |
1792 | |
1793 ;; Clear the buffer | |
1794 (artist-clear-buffer tmp-stdout-buffer) | |
1795 | |
1796 ;; Start the program | |
1797 (unwind-protect | |
1798 (let ((res (if program-args | |
1799 (apply 'call-process | |
1800 program | |
1801 tmp-stdin-file-name | |
1802 (list tmp-stdout-buffer | |
1803 tmp-stderr-file-name) | |
1804 nil | |
1805 (if (stringp program-args) | |
1806 (list program-args) | |
1807 program-args)) | |
1808 (apply 'call-process | |
1809 program | |
1810 tmp-stdin-file-name | |
1811 (list tmp-stdout-buffer | |
1812 tmp-stderr-file-name) | |
1813 nil)))) | |
1814 | |
1815 ;; the return value | |
1816 (list res | |
1817 (save-excursion | |
1818 (set-buffer tmp-stdout-buffer) | |
1819 (copy-sequence (buffer-substring (point-min) | |
1820 (point-max)))) | |
1821 (artist-file-to-string tmp-stderr-file-name))) | |
1822 | |
1823 ;; Unwind: remove temporary files and buffers | |
1824 (if (and stdin (file-exists-p tmp-stdin-file-name)) | |
1825 (delete-file tmp-stdin-file-name)) | |
1826 (if (file-exists-p tmp-stderr-file-name) | |
1827 (delete-file tmp-stderr-file-name)) | |
1828 (if (memq tmp-stdout-buffer (buffer-list)) | |
1829 (kill-buffer tmp-stdout-buffer)))))) | |
1830 | |
1831 ;; Routines that deal with the buffer | |
1832 ;; | |
1833 ;; artist-current-line get line number (top of buffer is 0) | |
1834 ;; | |
1835 ;; artist-move-to-xy move to (x,y) (0,0) is beg-of-buffer | |
1836 ;; | |
1837 ;; artist-get-char-at-xy get char in at (x,y) | |
1838 ;; | |
1839 ;; artist-replace-char overwrite (replace) char at point | |
1840 ;; artist-replace-chars overwrite (replace) chars at point | |
1841 ;; | |
1842 | |
1843 (defsubst artist-current-column () | |
1844 "Return point's current column." | |
1845 (current-column)) | |
1846 | |
1847 (defsubst artist-current-line () | |
1848 "Return point's current line, buffer-relative. Top of buffer is 0." | |
1849 (+ (count-lines 1 (point)) | |
1850 (if (= (current-column) 0) 1 0) | |
1851 -1)) | |
1852 | |
1853 (defsubst artist-move-to-xy (x y) | |
1854 "Move to column X, at row Y from the top of buffer. Top line is 0." | |
1855 ;; | |
1856 ;; Q: Why do we do forward-line twice? | |
1857 ;; A: The documentation for forward-line says | |
1858 ;; | |
1859 ;; "... Returns the count of lines left to move. ... With | |
1860 ;; positive N, a non-empty line at the end counts as one | |
1861 ;; line successfully moved (for the return value)." | |
1862 ;; | |
1863 ;; This means that if we are trying to move forward past the end | |
1864 ;; of the buffer, and that last line happened to be longer than | |
1865 ;; the current column, then we end up at the end of that last | |
1866 ;; line, and forward-line returns one less than we actually | |
1867 ;; wanted to move. | |
1868 ;; | |
1869 ;; Example: In the figure below, the `X' is the very last | |
1870 ;; character in the buffer ("a non-empty line at the | |
1871 ;; end"). Suppose point is at at P. Then (forward-line 1) | |
1872 ;; returns 0 and puts point after the `X'. | |
1873 ;; | |
1874 ;; --------top of buffer-------- | |
1875 ;; | |
1876 ;; P X | |
1877 ;; -------bottom of buffer------ | |
1878 ;; | |
1879 ;; But, if we are at the end of buffer when trying to move | |
1880 ;; forward, then forward-line will return the (for us) correct | |
1881 ;; value, which is good, because we will come to the end of the | |
1882 ;; buffer by the first forward-line. The second forward-line | |
1883 ;; will then get us where we really wanted to go. | |
1884 ;; | |
1885 ;; If we are not moving past the end of the buffer, then the | |
1886 ;; second forward-line will return 0. | |
1887 ;; | |
1888 ;; Q: What happens if we are moving upwards? | |
1889 ;; A: That will work good. insert-char won't insert a negative | |
1890 ;; number of chars, and forward-line will fail silently if we are | |
1891 ;; moving past the beginning of the buffer. | |
1892 ;; | |
1893 (forward-line (- y (artist-current-line))) | |
1894 (insert-char ?\n (forward-line (- y (artist-current-line)))) | |
1895 (move-to-column (max x 0) t) | |
1896 (let ((curr-y (artist-current-line))) | |
1897 (setq artist-draw-region-min-y (min curr-y artist-draw-region-min-y)) | |
1898 (setq artist-draw-region-max-y (max curr-y artist-draw-region-max-y)))) | |
1899 | |
1900 (defsubst artist-get-char-at-xy (x y) | |
1901 "Return the character found at column X, row Y. | |
1902 Also updates the variables `artist-draw-min-y' and `artist-draw-max-y'." | |
1903 (artist-move-to-xy x y) | |
1904 (let ((curr-y (artist-current-line))) | |
1905 (setq artist-draw-region-min-y (min curr-y artist-draw-region-min-y)) | |
1906 (setq artist-draw-region-max-y (max curr-y artist-draw-region-max-y))) | |
1907 (following-char)) | |
1908 | |
1909 | |
1910 (defun artist-get-char-at-xy-conv (x y) | |
1911 "Retrieve the character at X, Y, converting tabs and new-lines to spaces." | |
1912 (save-excursion | |
1913 (aref artist-replacement-table (artist-get-char-at-xy x y)))) | |
1914 | |
1915 | |
1916 (defun artist-replace-char (new-char) | |
1917 "Replace the character at point with NEW-CHAR." | |
1918 ;; Check that the variable exists first. The doc says it was added in 19.23. | |
34648
e787281bcf24
(artist-replace-chars, artist-replace-char):
Miles Bader <miles@gnu.org>
parents:
33653
diff
changeset
|
1919 (if (and (and (boundp 'emacs-major-version) (= emacs-major-version 20)) |
33618 | 1920 (and (boundp 'emacs-minor-version) (<= emacs-minor-version 3))) |
1921 ;; This is a bug workaround for Emacs 20, versions up to 20.3: | |
1922 ;; The self-insert-command doesn't care about the overwrite-mode, | |
1923 ;; so the insertion is done in the same way as in picture mode. | |
1924 ;; This seems to be a little bit slower. | |
1925 (progn | |
1926 (artist-move-to-xy (1+ (artist-current-column)) | |
1927 (artist-current-line)) | |
1928 (delete-char -1) | |
1929 (insert (aref artist-replacement-table new-char))) | |
1930 ;; In emacs-19, the self-insert-command works better and faster | |
1931 (let ((overwrite-mode 'overwrite-mode-textual) | |
1932 (fill-column 32765) ; Large :-) | |
1933 (blink-matching-paren nil)) | |
1934 (setq last-command-event (aref artist-replacement-table new-char)) | |
1935 (self-insert-command 1)))) | |
1936 | |
1937 (defun artist-replace-chars (new-char count) | |
1938 "Replace characters at point with NEW-CHAR. COUNT chars are replaced." | |
1939 ;; Check that the variable exists first. The doc says it was added in 19.23. | |
34648
e787281bcf24
(artist-replace-chars, artist-replace-char):
Miles Bader <miles@gnu.org>
parents:
33653
diff
changeset
|
1940 (if (and (and (boundp 'emacs-major-version) (= emacs-major-version 20)) |
33618 | 1941 (and (boundp 'emacs-minor-version) (<= emacs-minor-version 3))) |
1942 ;; This is a bug workaround for Emacs 20, versions up to 20.3: | |
1943 ;; The self-insert-command doesn't care about the overwrite-mode, | |
1944 ;; so the insertion is done in the same way as in picture mode. | |
1945 ;; This seems to be a little bit slower. | |
1946 (let* ((replaced-c (aref artist-replacement-table new-char)) | |
34648
e787281bcf24
(artist-replace-chars, artist-replace-char):
Miles Bader <miles@gnu.org>
parents:
33653
diff
changeset
|
1947 (replaced-s (make-string count replaced-c))) |
33618 | 1948 (artist-move-to-xy (+ (artist-current-column) count) |
1949 (artist-current-line)) | |
1950 (delete-char (- count)) | |
1951 (insert replaced-s)) | |
1952 ;; In emacs-19, the self-insert-command works better | |
1953 (let ((overwrite-mode 'overwrite-mode-textual) | |
1954 (fill-column 32765) ; Large :-) | |
1955 (blink-matching-paren nil)) | |
1956 (setq last-command-event (aref artist-replacement-table new-char)) | |
1957 (self-insert-command count)))) | |
1958 | |
1959 (defsubst artist-replace-string (string &optional see-thru) | |
1960 "Replace contents at point with STRING. | |
1961 With optional argument SEE-THRU, set to non-nil, text in the buffer | |
1962 ``shines thru'' blanks in the STRING." | |
1963 (let ((char-list (append string nil)) ; convert the string to a list | |
1964 (overwrite-mode 'overwrite-mode-textual) | |
1965 (fill-column 32765) ; Large :-) | |
1966 (blink-matching-paren nil)) | |
1967 (while char-list | |
1968 (let ((c (car char-list))) | |
1969 (if (and see-thru (= (aref artist-replacement-table c) ?\ )) | |
1970 (artist-move-to-xy (1+ (artist-current-column)) | |
1971 (artist-current-line)) | |
1972 (artist-replace-char c))) | |
1973 (setq char-list (cdr char-list))))) | |
1974 | |
1975 ;; | |
1976 ;; Routines for setting and unsetting points | |
1977 ;; Used when not rubber-banding | |
1978 ;; | |
1979 (defun artist-no-rb-unset-point1 () | |
1980 "Unsets point 1 when not rubber-banding." | |
1981 (let ((x-now (artist-current-column)) | |
1982 (y-now (artist-current-line)) | |
1983 (x (aref artist-rb-save-data 0)) | |
1984 (y (aref artist-rb-save-data 1))) | |
1985 (artist-move-to-xy x y) | |
1986 (artist-replace-char (aref artist-rb-save-data 2)) | |
1987 (artist-move-to-xy x-now y-now))) | |
1988 | |
1989 (defun artist-no-rb-set-point1 (x y) | |
1990 "Set point 1 at X, Y when not rubber-banding." | |
1991 (let ((x-now (artist-current-column)) | |
1992 (y-now (artist-current-line))) | |
1993 (aset artist-rb-save-data 0 x) | |
1994 (aset artist-rb-save-data 1 y) | |
1995 (aset artist-rb-save-data 2 (artist-get-char-at-xy x y)) | |
1996 (artist-move-to-xy x y) | |
1997 (artist-replace-char artist-first-char) | |
1998 (artist-move-to-xy x-now y-now) | |
1999 (aset artist-rb-save-data 6 0))) | |
2000 | |
2001 (defun artist-no-rb-unset-point2 () | |
2002 "This function unsets point 2 when not rubber-banding." | |
2003 (if (= (aref artist-rb-save-data 6) 1) | |
2004 (let ((x-now (artist-current-column)) | |
2005 (y-now (artist-current-line)) | |
2006 (x (aref artist-rb-save-data 3)) | |
2007 (y (aref artist-rb-save-data 4))) | |
2008 (artist-move-to-xy x y) | |
2009 (artist-replace-char (aref artist-rb-save-data 5)) | |
2010 (artist-move-to-xy x-now y-now)))) | |
2011 | |
2012 (defun artist-no-rb-set-point2 (x y) | |
2013 "Set point 2 at X, Y when not rubber-banding." | |
2014 (let ((x-now (artist-current-column)) | |
2015 (y-now (artist-current-line))) | |
2016 (aset artist-rb-save-data 3 x) | |
2017 (aset artist-rb-save-data 4 y) | |
2018 (aset artist-rb-save-data 5 (artist-get-char-at-xy x y)) | |
2019 (artist-move-to-xy x y) | |
2020 (artist-replace-char artist-second-char) | |
2021 (artist-move-to-xy x-now y-now) | |
2022 (aset artist-rb-save-data 6 1))) | |
2023 | |
2024 (defun artist-no-rb-unset-points () | |
2025 "This function unsets point 1 and 2 when not rubber-banding." | |
2026 (artist-no-rb-unset-point1) | |
2027 (artist-no-rb-unset-point2)) | |
2028 | |
2029 | |
2030 ;; artist-intersection-char | |
2031 ;; | |
2032 ;; Note: If changing this, see the notes for artist-unintersection-char | |
2033 ;; and artist-vaporize-lines | |
2034 ;; | |
2035 (defun artist-intersection-char (new-c old-c) | |
2036 "Calculates intersection character when drawing a NEW-C on top of an OLD-C. | |
2037 Return character according to this scheme: | |
2038 | |
2039 OLD-C NEW-C return | |
2040 - | + | |
2041 | - + | |
2042 + | + | |
2043 + - + | |
2044 \\ / X | |
2045 / \\ X | |
2046 X / X | |
2047 X \\ X | |
2048 other combinations NEW-C" | |
2049 | |
2050 (cond ((and (= old-c ?- ) (= new-c ?| )) ?+ ) | |
2051 ((and (= old-c ?| ) (= new-c ?- )) ?+ ) | |
2052 ((and (= old-c ?+ ) (= new-c ?- )) ?+ ) | |
2053 ((and (= old-c ?+ ) (= new-c ?| )) ?+ ) | |
2054 ((and (= old-c ?\\ ) (= new-c ?/ )) ?X ) | |
2055 ((and (= old-c ?/ ) (= new-c ?\\ )) ?X ) | |
2056 ((and (= old-c ?X ) (= new-c ?/ )) ?X ) | |
2057 ((and (= old-c ?X ) (= new-c ?\\ )) ?X ) | |
2058 (t new-c))) | |
2059 | |
2060 ;; artist-unintersection-char | |
2061 ;; | |
2062 ;; Note: If changing this, see the note for artist-vaporize-lines | |
2063 ;; | |
2064 (defun artist-unintersection-char (line-c buffer-c) | |
2065 "Restore character to before intersection when removing LINE-C from BUFFER-C. | |
2066 Return character according to this scheme: | |
2067 | |
2068 LINE-C BUFFER-C return | |
2069 - + | | |
2070 | + - | |
2071 \\ X / | |
2072 / X \\ | |
2073 other combinations `artist-erase-char'." | |
2074 | |
2075 (cond ((and (= line-c ?- ) (= buffer-c ?+ )) ?| ) | |
2076 ((and (= line-c ?| ) (= buffer-c ?+ )) ?- ) | |
2077 ((and (= line-c ?\\ ) (= buffer-c ?X )) ?/ ) | |
2078 ((and (= line-c ?/ ) (= buffer-c ?X )) ?\\ ) | |
2079 ((= line-c buffer-c) artist-erase-char) | |
2080 (t buffer-c))) | |
2081 | |
2082 | |
2083 ;; Computing the line-char to use | |
2084 ;; for use with borderless shapes | |
2085 ;; | |
2086 (defsubst artist-compute-line-char () | |
2087 "Compute which character to use for lines, if any. | |
2088 Return value is either nil for the default characters that make up lines, or | |
2089 a character chosen depending on the variables `artist-borderless-shapes', | |
2090 `artist-fill-char-set', `artist-fill-char' and | |
2091 `artist-line-char-set' and `artist-line-char'." | |
2092 (if (and artist-borderless-shapes artist-fill-char-set) | |
2093 artist-fill-char | |
2094 (if artist-line-char-set | |
2095 artist-line-char | |
2096 nil))) | |
2097 | |
2098 | |
2099 ;; Things for drawing horizontal, vertical and diagonal (straight) lines. | |
2100 ;; | |
2101 ;; A line here is a vector: | |
2102 ;; [ start-x start-y length direction saved-char-1 saved-char-2 ... ] | |
2103 ;; directions start with 0 at the x-axis and counts anti clockwise. | |
2104 ;; | |
2105 (defvar artist-direction-info | |
2106 ;; x y char | |
2107 [ [ 1 0 ?- ] ; direction 0 | |
2108 [ 1 1 ?\\ ] ; direction 1 | |
2109 [ 0 1 ?| ] ; direction 2 | |
2110 [ -1 1 ?/ ] ; direction 3 | |
2111 [ -1 0 ?- ] ; direction 4 | |
2112 [ -1 -1 ?\\ ] ; direction 5 | |
2113 [ 0 -1 ?| ] ; direction 6 | |
2114 [ 1 -1 ?/ ] ] ; direction 7 | |
2115 "Table used for stepping x and y coordinates in a specific direction. | |
2116 This table is also used for determining which char to use for that direction.") | |
2117 | |
2118 (defsubst artist-direction-step-x (direction) | |
2119 "Return the x-step for DIRECTION from the `artist-direction-info' table." | |
2120 (aref (aref artist-direction-info direction) 0)) | |
2121 | |
2122 (defsubst artist-direction-step-y (direction) | |
2123 "Return the y-step for DIRECTION from the `artist-direction-info' table." | |
2124 (aref (aref artist-direction-info direction) 1)) | |
2125 | |
2126 (defun artist-direction-char (direction) | |
2127 "Return the character for DIRECTION from the `artist-direction-info' table." | |
2128 (aref (aref artist-direction-info direction) 2)) | |
2129 | |
2130 ;; artist-find-direction | |
2131 ;; | |
2132 ;; | |
2133 ;; | |
2134 (defun artist-find-direction (x1 y1 x2 y2) | |
2135 "Find the direction from point X1,Y1 to X2,Y2. | |
2136 Returns a DIRECTION, a number 0--7, coded as follows: | |
2137 | |
2138 5 6 7 | |
2139 \\ | / | |
2140 4 - * - 0 | |
2141 / | \\ | |
2142 3 2 1" | |
2143 (let ((delta-x (- x2 x1)) | |
2144 (delta-y (- y2 y1))) | |
2145 (cond ((>= delta-x (* 2 (abs delta-y))) 0) | |
2146 ((>= delta-y (* 2 (abs delta-x))) 2) | |
2147 ((>= (- delta-x) (* 2 (abs delta-y))) 4) | |
2148 ((>= (- delta-y) (* 2 (abs delta-x))) 6) | |
2149 ((and (>= delta-x 0) (>= delta-y 0)) 1) | |
2150 ((and (<= delta-x 0) (>= delta-y 0)) 3) | |
2151 ((and (<= delta-x 0) (<= delta-y 0)) 5) | |
2152 ((and (>= delta-x 0) (<= delta-y 0)) 7)))) | |
2153 | |
2154 (defun artist-straight-calculate-length (direction x1 y1 x2 y2) | |
2155 "Calculate length for a straight line in DIRECTION from X1,Y1 to X2,Y2." | |
2156 (cond ((or (= direction 7) | |
2157 (= direction 0) | |
2158 (= direction 1)) (1+ (- x2 x1))) | |
2159 ((or (= direction 3) | |
2160 (= direction 4) | |
2161 (= direction 5)) (1+ (- x1 x2))) | |
2162 (t (1+ (abs (- y2 y1)))))) | |
2163 | |
2164 (defun artist-sline (x1 y1 x2 y2) | |
2165 "Create a straight line from X1,Y1 to X2,Y2." | |
2166 (let* ((direction (artist-find-direction x1 y1 x2 y2)) | |
2167 (length (artist-straight-calculate-length direction x1 y1 x2 y2)) | |
2168 (line (make-vector (+ length 4) x1))) | |
2169 ;; not needed: | |
2170 ;; (aset line 0 x1) | |
2171 ;; because we set all elements to x1 | |
2172 (aset line 1 y1) | |
2173 (aset line 2 length) | |
2174 (aset line 3 direction) | |
2175 line)) | |
2176 | |
2177 (defun artist-save-chars-under-sline (line) | |
2178 "Save characters under a LINE." | |
2179 (let ((x (aref line 0)) | |
2180 (y (aref line 1)) | |
2181 (length (+ (aref line 2) 4)) | |
2182 (direction (aref line 3)) | |
2183 (i 4)) | |
2184 (while (< i length) | |
2185 (aset line i (artist-get-char-at-xy x y)) | |
2186 (setq x (+ x (artist-direction-step-x direction))) | |
2187 (setq y (+ y (artist-direction-step-y direction))) | |
2188 (setq i (1+ i)))) | |
2189 line) | |
2190 | |
2191 | |
2192 | |
2193 ;; Things for drawing lines in all directions. | |
2194 ;; The line drawing engine is the eight-point alrogithm. | |
2195 ;; | |
2196 ;; A line is here a list of (x y saved-char new-char)s. | |
2197 ;; | |
2198 (defvar artist-octant-info | |
2199 ;; Initial Step in Step in | |
2200 ;; coeffs x and y x and y | |
2201 ;; for if q >= 0 if g < 0 | |
2202 ;; dfdx,dfdy | |
2203 [ [ 2 1 1 0 1 1 ] ; 1st octant | |
2204 [ 1 2 1 1 0 1 ] ; 2nd octant | |
2205 [ -1 2 0 1 -1 1 ] ; 3rd octant | |
2206 [ -2 1 -1 1 -1 0 ] ; 4th octant | |
2207 [ -2 -1 -1 0 -1 -1 ] ; 5th octant | |
2208 [ -1 -2 -1 -1 0 -1 ] ; 6th octant | |
2209 [ 1 -2 0 -1 1 -1 ] ; 7th octant | |
2210 [ 2 -1 1 -1 1 0 ] ] ; 8th octant | |
2211 "Table used by line drawing algorithm (eight point).") | |
2212 | |
2213 ;; Primitives for the artist-octant-info. | |
2214 ;; Decrease octant by 1 since elt counts from 0 and octant counts from 1. | |
2215 ;; | |
2216 (defsubst artist-get-dfdx-init-coeff (octant) | |
2217 "Retrieve dfdx component for OCTANT." | |
2218 (aref (aref artist-octant-info (- octant 1)) 0)) | |
2219 | |
2220 (defsubst artist-get-dfdy-init-coeff (octant) | |
2221 "Retrieve dfdy component for OCTANT." | |
2222 (aref (aref artist-octant-info (- octant 1)) 1)) | |
2223 | |
2224 (defsubst artist-get-x-step-q>=0 (octant) | |
2225 "Retrieve x-step component for OCTANT when q >= 0." | |
2226 (aref (aref artist-octant-info (- octant 1)) 2)) | |
2227 | |
2228 (defsubst artist-get-y-step-q>=0 (octant) | |
2229 "Retrieve y-step component for OCTANT when q >= 0." | |
2230 (aref (aref artist-octant-info (- octant 1)) 3)) | |
2231 | |
2232 (defsubst artist-get-x-step-q<0 (octant) | |
2233 "Retrieve x-step component for OCTANT for q < 0." | |
2234 (aref (aref artist-octant-info (- octant 1)) 4)) | |
2235 | |
2236 (defsubst artist-get-y-step-q<0 (octant) | |
2237 "Retrieve y-step component for OCTANT for q < 0." | |
2238 (aref (aref artist-octant-info (- octant 1)) 5)) | |
2239 | |
2240 | |
2241 ;; Find octant from x1 y1 x2 y2 coordinates. | |
2242 ;; | |
2243 (defun artist-find-octant (x1 y1 x2 y2) | |
2244 "Find octant for a line from X1,Y1 to X2,Y2. | |
2245 Octant are numbered 1--8, anti-clockwise as: | |
2246 | |
2247 \\3|2/ | |
2248 4\\|/1 | |
2249 ---+--- | |
2250 5/|\\8 | |
2251 /6|7\\" | |
2252 | |
2253 (if (<= x1 x2) ; quadrant 1 or 4 | |
2254 (if (<= y1 y2) ; quadrant 1, octant 1 or 2 | |
2255 (if (>= (- x2 x1) (- y2 y1)) | |
2256 1 | |
2257 2) | |
2258 (if (>= (- x2 x1) (- (- y2 y1))) ; quadrant 4, octant 7 or 8 | |
2259 8 | |
2260 7)) | |
2261 (if (<= y1 y2) ; quadrant 2 or 3 | |
2262 (if (>= (- (- x2 x1)) (- y2 y1)) ; quadrant 2, octant 3 or 4 | |
2263 4 | |
2264 3) | |
2265 (if (>= (- (- x2 x1)) (- (- y2 y1))) ; quadrant 3, octant 5 or 6 | |
2266 5 | |
2267 6)))) | |
2268 | |
2269 ;; Some inline funtions for creating, setting and reading | |
2270 ;; members of a coordinate | |
2271 ;; | |
2272 (defsubst artist-new-coord (x y &optional new-char) | |
2273 "Create a new coordinate at X,Y for use in a line. | |
2274 Optional argument NEW-CHAR can be used for setting the new-char component | |
2275 in the coord." | |
2276 (let ((coord (make-vector 4 x))) | |
2277 (aset coord 1 y) | |
2278 (aset coord 3 new-char) | |
2279 coord)) | |
2280 | |
2281 (defsubst artist-coord-get-x (coord) | |
2282 "Retrieve the x component of a COORD." | |
2283 (aref coord 0)) | |
2284 | |
2285 (defsubst artist-coord-get-y (coord) | |
2286 "Retrieve the y component of a COORD." | |
2287 (aref coord 1)) | |
2288 | |
2289 (defsubst artist-coord-set-x (coord new-x) | |
2290 "Set the x component of a COORD to NEW-X." | |
2291 (aset coord 0 new-x) | |
2292 coord) | |
2293 | |
2294 (defsubst artist-coord-set-y (coord new-y) | |
2295 "Set the y component of a COORD to NEW-Y." | |
2296 (aset coord 1 new-y) | |
2297 coord) | |
2298 | |
2299 (defsubst artist-coord-get-saved-char (coord) | |
2300 "Retrieve the saved char component of a COORD." | |
2301 (aref coord 2)) | |
2302 | |
2303 (defsubst artist-coord-get-new-char (coord) | |
2304 "Retrieve the new char component of a COORD." | |
2305 (aref coord 3)) | |
2306 | |
2307 (defsubst artist-coord-add-saved-char (coord saved-char) | |
2308 "Set the saved char component of a COORD to SAVED-CHAR." | |
2309 (aset coord 2 saved-char) | |
2310 coord) | |
2311 | |
2312 (defsubst artist-coord-add-new-char (coord new-char) | |
2313 "Set the new char component of a COORD to NEW-CHAR." | |
2314 (aset coord 3 new-char) | |
2315 coord) | |
2316 | |
2317 (defsubst artist-coord-set-new-char (coord new-char) | |
2318 "Set the new char component of a COORD to NEW-CHAR." | |
2319 (aset coord 3 new-char) | |
2320 coord) | |
2321 | |
2322 | |
2323 ;; Pretend we are plotting a pixel. Instead we just list it | |
2324 ;; | |
2325 (defmacro artist-put-pixel (point-list x y) | |
2326 "In POINT-LIST, store a ``pixel'' at coord X,Y." | |
2327 (list 'setq point-list | |
2328 (list 'append point-list (list 'list (list 'artist-new-coord x y))))) | |
2329 | |
2330 ;; Calculate list of points using eight point algorithm | |
2331 ;; return a list of coords | |
2332 ;; | |
2333 (defun artist-eight-point (x1 y1 x2 y2) | |
2334 "Run the eight-point algorithm to get a list of coords from X1,Y1 to X2,Y2." | |
2335 (let* ((point-list nil) | |
2336 (octant (artist-find-octant x1 y1 x2 y2)) | |
2337 (dfdx-coeff (artist-get-dfdx-init-coeff octant)) | |
2338 (dfdy-coeff (artist-get-dfdy-init-coeff octant)) | |
2339 (x-step-q>=0 (artist-get-x-step-q>=0 octant)) | |
2340 (y-step-q>=0 (artist-get-y-step-q>=0 octant)) | |
2341 (x-step-q<0 (artist-get-x-step-q<0 octant)) | |
2342 (y-step-q<0 (artist-get-y-step-q<0 octant)) | |
2343 (dfdx (- (- y2 y1))) | |
2344 (dfdy (- x2 x1)) | |
2345 (x x1) | |
2346 (y y1) | |
2347 (f 0) | |
2348 (q (+ (* 2 f) | |
2349 (* dfdx-coeff dfdx) | |
2350 (* dfdy-coeff dfdy)))) | |
2351 (artist-put-pixel point-list x y) | |
2352 (while (or (not (eq x x2)) (not (eq y y2))) | |
2353 (if (>= q 0) | |
2354 (progn | |
2355 (setq x (+ x x-step-q>=0)) | |
2356 (setq y (+ y y-step-q>=0)) | |
2357 (setq f (+ f (* x-step-q>=0 dfdx) (* y-step-q>=0 dfdy)))) | |
2358 (progn | |
2359 (setq x (+ x x-step-q<0)) | |
2360 (setq y (+ y y-step-q<0)) | |
2361 (setq f (+ f (* x-step-q<0 dfdx) (* y-step-q<0 dfdy))))) | |
2362 (setq q (+ (* 2 f) (* dfdx-coeff dfdx) (* dfdy-coeff dfdy))) | |
2363 (artist-put-pixel point-list x y)) | |
2364 point-list)) | |
2365 | |
2366 ;; artist-save-chars-under-point-list | |
2367 ;; Remebers the chars that were there before we did draw the line. | |
2368 ;; Returns point-list. | |
2369 ;; | |
2370 (defun artist-save-chars-under-point-list (point-list) | |
2371 "Save characters originally under POINT-LIST." | |
2372 (mapcar | |
2373 (lambda (coord) | |
2374 (artist-coord-add-saved-char | |
2375 coord | |
2376 (artist-get-char-at-xy (artist-coord-get-x coord) | |
2377 (artist-coord-get-y coord)))) | |
2378 point-list)) | |
2379 | |
2380 ;; artist-calculate-new-char, artist-calculate-new-chars | |
2381 ;; Calculates which char to insert depending on direction of point-list. | |
2382 ;; | |
2383 ;; Depending on new-coord's position relative to last-coord one of the | |
2384 ;; following chars are returned: \ | / - o, as indicated by this: | |
2385 ;; | |
2386 ;; \ | / | |
2387 ;; - o - | |
2388 ;; / | \ | |
2389 ;; | |
2390 ;; artist-calculate-new-char works on one coordinate, returns char. | |
2391 ;; artist-calculate-new-chars works on a point-list, returns point-list. | |
2392 ;; | |
2393 (defun artist-calculate-new-char (last-coord new-coord) | |
2394 "Return a line-char to use when moving from LAST-COORD to NEW-COORD." | |
2395 (let ((last-x (artist-coord-get-x last-coord)) | |
2396 (last-y (artist-coord-get-y last-coord)) | |
2397 (new-x (artist-coord-get-x new-coord)) | |
2398 (new-y (artist-coord-get-y new-coord))) | |
2399 (cond ((> new-x last-x) (cond ((< new-y last-y) ?/ ) | |
2400 ((> new-y last-y) ?\\ ) | |
2401 (t ?- ))) | |
2402 ((< new-x last-x) (cond ((< new-y last-y) ?\\ ) | |
2403 ((> new-y last-y) ?/ ) | |
2404 (t ?- ))) | |
2405 ((eq new-y last-y) ?o) | |
2406 (t ?| )))) | |
2407 | |
2408 (defun artist-calculate-new-chars (point-list) | |
2409 "Return a list of coords with line-chars calculated. Input: POINT-LIST." | |
2410 (if (null (cdr point-list)) | |
2411 (list (artist-coord-add-new-char (car point-list) ?o )) | |
2412 (let ((last-coord (car point-list))) | |
2413 (cons (artist-coord-add-new-char | |
2414 (car point-list) | |
2415 (artist-calculate-new-char (car (cdr point-list)) | |
2416 (car point-list))) | |
2417 (mapcar | |
2418 (lambda (this-coord) | |
2419 (prog1 | |
2420 (artist-coord-add-new-char | |
2421 this-coord | |
2422 (artist-calculate-new-char last-coord this-coord)) | |
2423 (setq last-coord this-coord))) | |
2424 (cdr point-list)))))) | |
2425 | |
2426 ;; artist-modify-new-chars | |
2427 ;; Replaces some characters with some other characters. | |
2428 ;; | |
2429 ;; artist-modify-new-chars works on a point-list, returns point-list. | |
2430 ;; | |
2431 (defun artist-modify-new-chars (point-list) | |
2432 "Replace intersecting characters in POINT-LIST. | |
2433 This function returns a point-list." | |
2434 (mapcar | |
2435 (lambda (coord) | |
2436 (let* ((new-c (artist-coord-get-new-char coord)) | |
2437 (saved-c (artist-coord-get-saved-char coord)) | |
2438 (modified-c (artist-intersection-char new-c saved-c))) | |
2439 (artist-coord-set-new-char coord modified-c))) | |
2440 point-list)) | |
2441 | |
2442 | |
2443 ;; | |
2444 ;; functions for accessing endoints and elements in object requiring | |
2445 ;; 2 endpoints | |
2446 ;; | |
2447 | |
2448 (defun artist-make-endpoint (x y) | |
2449 "Create an endpoint at X, Y." | |
2450 (let ((new-endpoint (make-vector 2 x))) | |
2451 (aset new-endpoint 1 y) | |
2452 new-endpoint)) | |
2453 | |
2454 (defun artist-endpoint-get-x (endpoint) | |
2455 "Retrieve the x component of an ENDPOINT." | |
2456 (aref endpoint 0)) | |
2457 | |
2458 (defun artist-endpoint-get-y (endpoint) | |
2459 "Retrieve the y component of an ENDPOINT." | |
2460 (aref endpoint 1)) | |
2461 | |
2462 (defun artist-make-2point-object (endpoint1 endpoint2 shapeinfo) | |
2463 "Create a 2-point object of ENDPOINT1, ENDPOINT2 and SHAPEINFO." | |
2464 (list endpoint1 endpoint2 shapeinfo)) | |
2465 | |
2466 (defun artist-2point-get-endpoint1 (obj) | |
2467 "Retrieve the first endpoint of a 2-point object OBJ." | |
2468 (elt obj 0)) | |
2469 | |
2470 (defun artist-2point-get-endpoint2 (obj) | |
2471 "Retrieve the second endpoint of a 2-point object OBJ." | |
2472 (elt obj 1)) | |
2473 | |
2474 (defun artist-2point-get-shapeinfo (obj) | |
2475 "Retrieve the shapeinfo component of a 2-point object OBJ." | |
2476 (elt obj 2)) | |
2477 | |
2478 | |
2479 ;; | |
2480 ;; Drawing and undrawing lines (any direction) | |
2481 ;; | |
2482 | |
2483 (defun artist-draw-line (x1 y1 x2 y2) | |
2484 "Draws a line from X1, Y1 to X2, Y2. | |
2485 | |
2486 Output is a line, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO). | |
2487 | |
2488 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y]. | |
2489 SHAPE-INFO is a list of vectors [X Y SAVED-CHAR NEW-CHAR]." | |
2490 (let ((endpoint1 (artist-make-endpoint x1 y1)) | |
2491 (endpoint2 (artist-make-endpoint x2 y2))) | |
2492 (artist-make-2point-object | |
2493 endpoint1 | |
2494 endpoint2 | |
2495 (mapcar | |
2496 (lambda (coord) | |
2497 (artist-move-to-xy (artist-coord-get-x coord) | |
2498 (artist-coord-get-y coord)) | |
2499 (if artist-line-char-set | |
2500 (artist-replace-char artist-line-char) | |
2501 (artist-replace-char (artist-coord-get-new-char coord))) | |
2502 coord) | |
2503 (artist-modify-new-chars | |
2504 (artist-calculate-new-chars | |
2505 (artist-save-chars-under-point-list | |
2506 (artist-eight-point x1 y1 x2 y2)))))))) | |
2507 | |
2508 (defun artist-undraw-line (line) | |
2509 "Undraws LINE." | |
2510 (mapcar | |
2511 (lambda (coord) | |
2512 (artist-move-to-xy (artist-coord-get-x coord) | |
2513 (artist-coord-get-y coord)) | |
2514 (artist-replace-char (artist-coord-get-saved-char coord)) | |
2515 coord) | |
2516 (artist-2point-get-shapeinfo line))) | |
2517 | |
2518 ;; | |
2519 ;; Drawing and undrawing straight lines | |
2520 ;; | |
2521 | |
2522 (defun artist-draw-sline (x1 y1 x2 y2) | |
2523 "Draw a strait line from X1, Y1 to X2, Y2. | |
2524 Straight lines are vertical, horizontal or diagonal lines. | |
2525 They are faster to draw and most often they are what you need | |
2526 when drawing a simple image. | |
2527 | |
2528 Output is a straight line, which is a list on the form | |
2529 (END-POINT-1 END-POINT-2 SHAPE-INFO). | |
2530 | |
2531 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y]. | |
2532 SHAPE-INFO is a vector [START-X START-Y LENGTH-OF-LINE DIRECTION | |
2533 ORIGINAL-CHAR-1 ORIGINAL-CHAR-2 ... ]." | |
2534 (let* ((line (artist-save-chars-under-sline (artist-sline x1 y1 x2 y2))) | |
2535 (x (aref line 0)) | |
2536 (y (aref line 1)) | |
2537 (length (+ (aref line 2) 4)) | |
2538 (direction (aref line 3)) | |
2539 (line-char (artist-direction-char direction)) | |
2540 (i 4) | |
2541 (endpoint1 (artist-make-endpoint x y)) | |
2542 (endpoint2 nil)) | |
2543 (while (< i length) | |
2544 (artist-move-to-xy x y) | |
2545 (if artist-line-char-set | |
2546 (artist-replace-char artist-line-char) | |
2547 (artist-replace-char (artist-intersection-char | |
2548 line-char | |
2549 (aref line i)))) | |
2550 (if (not (< (1+ i) length)) | |
2551 ;; This is the last element. Set the second endpoint | |
2552 (setq endpoint2 (artist-make-endpoint x y))) | |
2553 (setq x (+ x (artist-direction-step-x direction))) | |
2554 (setq y (+ y (artist-direction-step-y direction))) | |
2555 (setq i (1+ i))) | |
2556 (artist-make-2point-object endpoint1 endpoint2 line))) | |
2557 | |
2558 | |
2559 (defun artist-undraw-sline (line) | |
2560 "Undraw a straight line LINE." | |
2561 (if line | |
2562 (let* ((shape-info (artist-2point-get-shapeinfo line)) | |
2563 (x (aref shape-info 0)) | |
2564 (y (aref shape-info 1)) | |
2565 (length (+ (aref shape-info 2) 4)) | |
2566 (direction (aref shape-info 3)) | |
2567 (i 4)) | |
2568 (while (< i length) | |
2569 (artist-move-to-xy x y) | |
2570 (artist-replace-char (aref shape-info i)) | |
2571 (setq x (+ x (artist-direction-step-x direction))) | |
2572 (setq y (+ y (artist-direction-step-y direction))) | |
2573 (setq i (1+ i)))))) | |
2574 | |
2575 | |
2576 ;; | |
2577 ;; Drawing and undrawing rectangles and squares | |
2578 ;; | |
2579 | |
2580 (defun artist-draw-rect (x1 y1 x2 y2) | |
2581 "Draws a rectangle with corners at X1, Y1 and X2, Y2. | |
2582 | |
2583 Output is a rectangle, which is a list on the form | |
2584 (END-POINT-1 END-POINT-2 SHAPE-INFO). | |
2585 | |
2586 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y]. | |
2587 SHAPE-INFO is a list of four straight lines." | |
2588 (let* ((artist-line-char (artist-compute-line-char)) | |
2589 (artist-line-char-set artist-line-char) | |
2590 (line1 (artist-draw-sline x1 y1 x2 y1)) | |
2591 (line2 (artist-draw-sline x2 y1 x2 y2)) | |
2592 (line3 (artist-draw-sline x2 y2 x1 y2)) | |
2593 (line4 (artist-draw-sline x1 y2 x1 y1)) | |
2594 (endpoint1 (artist-make-endpoint x1 y1)) | |
2595 (endpoint2 (artist-make-endpoint x2 y2))) | |
2596 (artist-make-2point-object endpoint1 | |
2597 endpoint2 | |
2598 (list line1 line2 line3 line4)))) | |
2599 | |
2600 (defun artist-undraw-rect (rectangle) | |
2601 "Undraws RECTANGLE." | |
2602 (if rectangle | |
2603 (let ((shape-info (artist-2point-get-shapeinfo rectangle))) | |
2604 (artist-undraw-sline (elt shape-info 3)) | |
2605 (artist-undraw-sline (elt shape-info 2)) | |
2606 (artist-undraw-sline (elt shape-info 1)) | |
2607 (artist-undraw-sline (elt shape-info 0))))) | |
2608 | |
2609 | |
2610 (defun artist-rect-corners-squarify (x1 y1 x2 y2) | |
2611 "Compute square corners from rectangle corners at X1, Y1 and X2, Y2. | |
2612 The square's first corner will be X1, Y1. The position of the second corner | |
2613 depends on which of X2 and Y2 is most far away from X1, Y1." | |
2614 (let* ((delta-x (- x2 x1)) | |
2615 (delta-y (- y2 y1)) | |
2616 (delta-x-sign (if (< delta-x 0) -1 1)) | |
2617 (delta-y-sign (if (< delta-y 0) -1 1)) | |
2618 (new-x2) ; set below | |
2619 (new-y2)) ; set below | |
2620 | |
2621 ;; Check which of x2 and y2 is most distant | |
2622 ;; take care to the aspect ratio | |
2623 (if (> (abs delta-x) (abs delta-y)) | |
2624 | |
2625 ;; *** x2 more distant than y2 (with care taken to aspect ratio) | |
2626 (progn | |
2627 (setq new-x2 x2) | |
2628 (setq new-y2 (+ y1 (round (/ (* (abs delta-x) delta-y-sign) | |
2629 artist-aspect-ratio))))) | |
2630 | |
2631 ;; *** y2 more distant than x2 (with care taken to aspect ratio) | |
2632 (progn | |
2633 (setq new-x2 (round (+ x1 (* (* (abs delta-y) delta-x-sign) | |
2634 artist-aspect-ratio)))) | |
2635 (setq new-y2 y2))) | |
2636 | |
2637 ;; Return this | |
2638 (list x1 y1 new-x2 new-y2))) | |
2639 | |
2640 | |
2641 (defun artist-draw-square (x1 y1 x2 y2) | |
2642 "Draw a square with corners at X1, Y1 and X2, Y2. | |
2643 | |
2644 Output is a square, which is a list on the form | |
2645 (END-POINT-1 END-POINT-2 SHAPE-INFO). | |
2646 | |
2647 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y]. | |
2648 SHAPE-INFO is a list of four straight lines." | |
2649 (let* ((artist-line-char (artist-compute-line-char)) | |
2650 (artist-line-char-set artist-line-char) | |
2651 (square-corners (artist-rect-corners-squarify x1 y1 x2 y2)) | |
2652 (new-x1 (elt square-corners 0)) | |
2653 (new-y1 (elt square-corners 1)) | |
2654 (new-x2 (elt square-corners 2)) | |
2655 (new-y2 (elt square-corners 3)) | |
2656 (endpoint1 (artist-make-endpoint new-x1 new-y1)) | |
2657 (endpoint2 (artist-make-endpoint new-x2 new-y2)) | |
2658 (line1 (artist-draw-sline new-x1 new-y1 new-x2 new-y1)) | |
2659 (line2 (artist-draw-sline new-x2 new-y1 new-x2 new-y2)) | |
2660 (line3 (artist-draw-sline new-x2 new-y2 new-x1 new-y2)) | |
2661 (line4 (artist-draw-sline new-x1 new-y2 new-x1 new-y1))) | |
2662 (artist-make-2point-object endpoint1 | |
2663 endpoint2 | |
2664 (list line1 line2 line3 line4)))) | |
2665 | |
2666 (defun artist-undraw-square (square) | |
2667 "Undraws SQUARE." | |
2668 (if square | |
2669 (let ((shape-info (artist-2point-get-shapeinfo square))) | |
2670 (artist-undraw-sline (elt shape-info 3)) | |
2671 (artist-undraw-sline (elt shape-info 2)) | |
2672 (artist-undraw-sline (elt shape-info 1)) | |
2673 (artist-undraw-sline (elt shape-info 0))))) | |
2674 | |
2675 ;; | |
2676 ;; Filling rectangles and squares | |
2677 ;; | |
2678 | |
2679 (defun artist-fill-rect (rect x1 y1 x2 y2) | |
2680 "Fill rectangle RECT from X1,Y1 to X2,Y2." | |
2681 (let ((x (1+ (min x1 x2))) | |
2682 (y (1+ (min y1 y2))) | |
2683 (x-max (max x1 x2)) | |
2684 (y-max (max y1 y2))) | |
2685 (let ((w (- x-max x))) | |
2686 (while (< y y-max) | |
2687 (artist-move-to-xy x y) | |
2688 (artist-replace-chars artist-fill-char w) | |
2689 (setq y (1+ y)))))) | |
2690 | |
2691 (defun artist-fill-square (square x1 y1 x2 y2) | |
2692 "Fills a SQUARE from X1,Y1 to X2,Y2." | |
2693 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2)) | |
2694 (new-x1 (elt square-corners 0)) | |
2695 (new-y1 (elt square-corners 1)) | |
2696 (new-x2 (elt square-corners 2)) | |
2697 (new-y2 (elt square-corners 3)) | |
2698 (x (1+ (min new-x1 new-x2))) | |
2699 (y (1+ (min new-y1 new-y2))) | |
2700 (x-max (max new-x1 new-x2)) | |
2701 (y-max (max new-y1 new-y2)) | |
2702 (w (- x-max x))) | |
2703 (while (< y y-max) | |
2704 (artist-move-to-xy x y) | |
2705 (artist-replace-chars artist-fill-char w) | |
2706 (setq y (1+ y))))) | |
2707 | |
2708 | |
2709 ;; | |
2710 ;; Pen drawing | |
2711 ;; | |
2712 | |
2713 (defun artist-pen (x1 y1) | |
2714 "Draws a character at X1, Y1. | |
2715 The character is replaced with the character in `artist-fill-char'." | |
2716 (artist-move-to-xy x1 y1) | |
2717 (artist-replace-char (if artist-line-char-set | |
2718 artist-line-char | |
2719 (if artist-fill-char-set | |
2720 artist-fill-char | |
2721 artist-default-fill-char)))) | |
2722 | |
2723 | |
2724 (defun artist-pen-line (x1 y1) | |
2725 "Draws a line from last pen position to X1, Y1. | |
2726 The character is replaced with the character in `artist-fill-char'. | |
2727 This will store all points in `artist-key-poly-point-list' in reversed | |
2728 order (I assume it is faster to cons to the beginning of the list than | |
2729 to append to the end of the list, when doing free-hand drawing)." | |
2730 (let ((artist-line-char (if artist-line-char-set | |
2731 artist-line-char | |
2732 (if artist-fill-char-set | |
2733 artist-fill-char | |
2734 artist-default-fill-char)))) | |
2735 | |
2736 ;; Draw line from last point to this | |
2737 (let ((x-last (car (car artist-key-poly-point-list))) | |
2738 (y-last (cdr (car artist-key-poly-point-list)))) | |
2739 (artist-move-to-xy x-last y-last) | |
2740 (artist-replace-char artist-line-char) | |
2741 (artist-draw-line x-last y-last x1 y1)) | |
2742 | |
2743 ;; Update the point-list | |
2744 (setq artist-key-poly-point-list | |
2745 (cons (cons x1 y1) artist-key-poly-point-list)))) | |
2746 | |
2747 (defun artist-pen-reset-last-xy (x1 y1) | |
2748 "Reset the last x and y points to X1, Y1 when doing pen-drawing." | |
2749 (artist-clear-arrow-points) | |
2750 (setq artist-key-poly-point-list (list (cons x1 y1)))) | |
2751 | |
2752 | |
2753 (defun artist-pen-set-arrow-points (x1 y1) | |
2754 "Set arrow points for pen drawing using X1, Y1. | |
2755 Also, the `artist-key-poly-point-list' is reversed." | |
2756 | |
2757 (setq artist-key-poly-point-list | |
2758 (artist-uniq artist-key-poly-point-list)) | |
2759 | |
2760 (if (>= (length artist-key-poly-point-list) 2) | |
2761 | |
2762 ;; Only set arrow-points if the point-list has two or more entries | |
2763 (let ((xn (car (car artist-key-poly-point-list))) | |
2764 (yn (cdr (car artist-key-poly-point-list))) | |
2765 (xn-1 (car (car (cdr artist-key-poly-point-list)))) | |
2766 (yn-1 (cdr (car (cdr artist-key-poly-point-list)))) | |
2767 (dirn)) ; direction for point n | |
2768 (setq artist-key-poly-point-list (reverse artist-key-poly-point-list)) | |
2769 (let ((x0 (car (car artist-key-poly-point-list))) | |
2770 (y0 (cdr (car artist-key-poly-point-list))) | |
2771 (x1 (car (car (cdr artist-key-poly-point-list)))) | |
2772 (y1 (cdr (car (cdr artist-key-poly-point-list)))) | |
2773 (dir0)) ; direction for point 0 | |
2774 (setq dir0 (artist-find-direction x1 y1 x0 y0)) | |
2775 (setq dirn (artist-find-direction xn-1 yn-1 xn yn)) | |
2776 (setq artist-arrow-point-1 (artist-make-arrow-point x0 y0 dir0)) | |
2777 (setq artist-arrow-point-2 (artist-make-arrow-point xn yn dirn)))))) | |
2778 | |
2779 | |
2780 ;; | |
2781 ;; Text rendering | |
2782 ;; | |
2783 (defun artist-figlet-run (text font extra-args) | |
2784 "Run figlet rendering TEXT using FONT. | |
2785 EXTRA-ARGS for figlet, for the command line, may be specified." | |
2786 (let* ((figlet-args (cond ((and font extra-args) | |
2787 (cons (concat "-f" font) | |
2788 (artist-string-split extra-args "[ \t]+"))) | |
2789 (font (concat "-f" font)) | |
2790 (extra-args | |
2791 (artist-string-split extra-args "[ \t]+")) | |
2792 (t nil))) | |
2793 (figlet-output (artist-system artist-figlet-program text figlet-args)) | |
2794 (exit-code (elt figlet-output 0)) | |
2795 (stdout (elt figlet-output 1)) | |
2796 (stderr (elt figlet-output 2))) | |
2797 (if (not (= exit-code 0)) | |
2798 (error "Failed to render font: %s (%d)" stderr exit-code)) | |
2799 stdout)) | |
2800 | |
2801 (defun artist-figlet-get-font-list () | |
2802 "Read fonts in with the shell command. | |
2803 Returns a list of strings." | |
2804 (let* ((cmd-interpreter "/bin/sh") | |
2805 (ls-cmd artist-figlet-list-fonts-command) | |
2806 (result (artist-system cmd-interpreter ls-cmd nil)) | |
2807 (exit-code (elt result 0)) | |
2808 (stdout (elt result 1)) | |
2809 (stderr (elt result 2))) | |
2810 (if (not (= exit-code 0)) | |
2811 (error "Failed to read available fonts: %s (%d)" stderr exit-code)) | |
2812 (artist-string-split stdout ".flf\n"))) | |
2813 | |
2814 (defun artist-figlet-choose-font () | |
2815 "Read any extra arguments for figlet." | |
2816 (interactive) | |
2817 (let* ((avail-fonts (artist-figlet-get-font-list)) | |
2818 (font (completing-read (concat "Select font: (default " | |
2819 artist-figlet-default-font | |
2820 ") ") | |
2821 (mapcar | |
2822 (lambda (font) (cons font font)) | |
2823 avail-fonts)))) | |
2824 (if (string= font "") artist-figlet-default-font font))) | |
2825 | |
2826 (defun artist-figlet-get-extra-args () | |
2827 "Read any extra arguments for figlet." | |
2828 (let ((extra-args (read-input "Extra args to figlet: "))) | |
2829 (if (string= extra-args "") | |
2830 nil | |
2831 extra-args))) | |
2832 | |
2833 (defun artist-figlet (text) | |
2834 "Render TEXT using figlet." | |
2835 (let* ((figlet-font (artist-figlet-choose-font)) | |
2836 (figlet-extra-args (artist-figlet-get-extra-args))) | |
2837 (artist-figlet-run text figlet-font figlet-extra-args))) | |
2838 | |
2839 | |
2840 (defun artist-text-insert-common (x y text see-thru) | |
2841 "At position X, Y, insert text TEXT. | |
2842 If SEE-THRU is non-nil, then blanks in TEXT does not replace text | |
2843 in the buffer." | |
2844 (let* ((string-list (artist-string-split text "\n")) | |
2845 (i 0) | |
2846 (len (length string-list))) | |
2847 (while (< i len) | |
2848 (artist-move-to-xy x (+ y i)) | |
2849 (artist-replace-string (car string-list) see-thru) | |
2850 (setq string-list (cdr string-list)) | |
2851 (setq i (1+ i))))) | |
47953
126b6cb8740d
(artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents:
46163
diff
changeset
|
2852 |
33618 | 2853 (defun artist-text-insert-see-thru (x y text) |
2854 "At position X, Y, insert text TEXT. | |
2855 Let text already in buffer shine thru the TEXT inserted." | |
2856 (artist-text-insert-common x y text t)) | |
2857 | |
2858 (defun artist-text-insert-overwrite (x y text) | |
2859 "At position X, Y, insert text TEXT. | |
2860 Let blanks in TEXT overwrite any text already in the buffer." | |
2861 (artist-text-insert-common x y text nil)) | |
2862 | |
2863 (defun artist-text-see-thru (x y) | |
2864 "Prompt for text to render, render it at X,Y. | |
2865 This is done by calling the function specified by `artist-text-renderer', | |
2866 which must return a list of strings, to be inserted in the buffer. | |
2867 | |
2868 Text already in the buffer ``shines thru'' blanks in the rendered text." | |
2869 (let* ((input-text (read-input "Type text to render: ")) | |
2870 (rendered-text (artist-funcall artist-text-renderer input-text))) | |
2871 (artist-text-insert-see-thru x y rendered-text))) | |
2872 | |
2873 | |
2874 (defun artist-text-overwrite (x y) | |
2875 "Prompt for text to render, render it at X,Y. | |
2876 This is done by calling the function specified by `artist-text-renderer', | |
2877 which must return a list of strings, to be inserted in the buffer. | |
2878 | |
2879 Blanks in the rendered text overwrites any text in the buffer." | |
2880 (let* ((input-text (read-input "Type text to render: ")) | |
2881 (rendered-text (artist-funcall artist-text-renderer input-text))) | |
2882 (artist-text-insert-overwrite x y rendered-text))) | |
2883 | |
2884 ;; | |
2885 ;; Spraying | |
47953
126b6cb8740d
(artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents:
46163
diff
changeset
|
2886 ;; |
33618 | 2887 |
2888 (defun artist-spray-get-interval () | |
2889 "Retrieves the interval for repeated spray." | |
2890 artist-spray-interval) | |
2891 | |
2892 (defun artist-spray-random-points (n radius) | |
2893 "Generate N random points within a radius of RADIUS. | |
2894 Returns a list of points. Each point is on the form (X1 . Y1)." | |
2895 (let ((points)) | |
2896 (while (> n 0) | |
2897 (let* ((angle (* (random 359) (/ pi 180))) | |
2898 (dist (random radius)) | |
2899 (point (cons (round (* dist (cos angle))) | |
2900 (round (* dist (sin angle)))))) | |
2901 (setq points (cons point points))) | |
2902 (setq n (- n 1))) | |
2903 points)) | |
2904 | |
2905 (defun artist-spray (x1 y1) | |
2906 "Spray at X1, Y1." | |
2907 (let* ((num-points (* artist-spray-radius artist-spray-radius)) | |
2908 (spray-points (artist-spray-random-points num-points | |
2909 artist-spray-radius))) | |
2910 (while spray-points | |
2911 ;; Replace one spray point | |
2912 (let* ((point (car spray-points)) | |
2913 (x (+ x1 (car point))) | |
2914 (y (+ y1 (cdr point))) | |
2915 (buf-c (artist-get-char-at-xy-conv x y)) | |
2916 (this-c (memq buf-c artist-spray-chars)) | |
2917 (next-c (cond ((null this-c) artist-spray-new-char) | |
2918 ((null (cdr this-c)) (car this-c)) | |
2919 (t (car (cdr this-c)))))) | |
2920 (artist-move-to-xy x y) | |
2921 (artist-replace-char next-c)) | |
2922 | |
2923 ;; Step to next spray point | |
2924 (setq spray-points (cdr spray-points))))) | |
2925 | |
2926 (defun artist-spray-clear-circle (circle x1 y1 x2 y2) | |
2927 "Clears circle CIRCLE at X1, Y1 through X2, Y2." | |
2928 (artist-undraw-circle circle)) | |
2929 | |
2930 (defun artist-spray-set-radius (circle x1 y1 x2 y2) | |
2931 "Set spray radius from CIRCLE at X1, Y1 through X2, Y2." | |
2932 (let ((dx (- x2 x1)) | |
2933 (dy (- y2 y1))) | |
2934 (setq artist-spray-radius (round (sqrt (+ (* dx dx) (* dy dy))))) | |
2935 (if (= 0 artist-spray-radius) | |
2936 (setq artist-spray-radius 1)))) | |
2937 | |
2938 ;; | |
2939 ;; Erasing | |
2940 ;; | |
2941 | |
2942 (defun artist-erase-char (x1 y1) | |
2943 "Erases a character at X1, Y1. | |
2944 The character is replaced with the character in `artist-erase-char'." | |
2945 (artist-move-to-xy x1 y1) | |
2946 (artist-replace-char artist-erase-char)) | |
2947 | |
2948 (defun artist-erase-rect (rect x1 y1 x2 y2) | |
2949 "Erase rectangle RECT from X1, Y1, X2, Y2." | |
2950 (let ((artist-line-char-set t) | |
2951 (artist-fill-char-set t) | |
2952 (artist-line-char artist-erase-char) | |
2953 (artist-fill-char artist-erase-char)) | |
2954 (artist-draw-rect x1 y1 x2 y2) | |
2955 (artist-fill-rect rect x1 y1 x2 y2))) | |
2956 | |
2957 | |
2958 ;; | |
2959 ;; Vaporizing (erasing) line and lines | |
2960 ;; | |
2961 | |
2962 | |
2963 (defun artist-vap-find-endpoint (x1 y1 step-x step-y accept-set reject-set) | |
2964 "Find one endpoint for line through X1, Y1. | |
2965 The endpoint is searched for in the direction defined by STEP-X, STEP-Y, | |
2966 accepting characters in the list ACCEPT-SET, stopping immediately | |
2967 when finding characters in the list REJECT-SET. Fuzziness, that is | |
2968 the number of consecutive characters not in ACCEPT-SET to allow as | |
2969 part of the line, is determined by the variable `artist-vaporize-fuzziness'. | |
2970 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)." | |
2971 (let ((x x1) | |
2972 (y y1) | |
2973 (x-last x1) | |
2974 (y-last y1) | |
2975 (done nil)) | |
2976 (while (not done) | |
2977 (let ((c (artist-get-char-at-xy-conv x y))) | |
2978 (cond ((memq c reject-set) | |
2979 (setq done t)) | |
2980 | |
2981 ;; We found a character we are accepting as part of the line. | |
2982 ;; Update position | |
2983 ((memq c accept-set) | |
2984 (setq x-last x | |
2985 y-last y | |
2986 x (+ x step-x) | |
2987 y (+ y step-y)) | |
2988 (if (or (< x 0) (< y 0)) ;stop at the edge | |
2989 (setq done t))) | |
2990 | |
2991 ;; We found a character we are not accepting as part of | |
2992 ;; the line Search `artist-vaporize-fuzziness' | |
2993 ;; characters away from this position in the same | |
2994 ;; direction to see if there are any characters in the | |
2995 ;; accept-set. If not, we have found the endpoint. | |
2996 (t | |
2997 (let ((fuzziness artist-vaporize-fuzziness) | |
2998 (x-tmp x) | |
2999 (y-tmp y)) | |
3000 | |
3001 ;; while we have more fuzziness left and we have not | |
3002 ;; found a character accepted as a line, move | |
3003 ;; forward! | |
3004 (while (and (> fuzziness 0) (not (memq c accept-set))) | |
3005 (setq x-tmp (+ x-tmp step-x)) | |
3006 (setq y-tmp (+ y-tmp step-y)) | |
3007 (setq c (artist-get-char-at-xy-conv x-tmp y-tmp)) | |
3008 (setq fuzziness (- fuzziness 1))) | |
3009 (if (memq c accept-set) | |
3010 | |
3011 ;; The line continues on the other side of the | |
3012 ;; not-accepted character. | |
3013 (setq x x-tmp | |
3014 y y-tmp) | |
3015 | |
3016 ;; Else: We couldn't find any line on the other side. | |
3017 ;; That means we are done searching for the endpoint. | |
3018 (setq done t))))))) | |
3019 (cons x-last y-last))) | |
3020 | |
3021 | |
3022 (defun artist-vap-find-endpoints-horiz (x y) | |
3023 "Find endpoints for a horizontal line through X, Y. | |
3024 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)." | |
3025 (list (artist-vap-find-endpoint x y 1 0 '(?- ?+) '(? )) | |
3026 (artist-vap-find-endpoint x y -1 0 '(?- ?+) '(? )))) | |
3027 | |
3028 (defun artist-vap-find-endpoints-vert (x y) | |
3029 "Find endpoints for a vertical line through X, Y. | |
3030 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)." | |
3031 (list (artist-vap-find-endpoint x y 0 1 '(?| ?+) '(? )) | |
3032 (artist-vap-find-endpoint x y 0 -1 '(?| ?+) '(? )))) | |
3033 | |
3034 (defun artist-vap-find-endpoints-swne (x y) | |
3035 "Find endpoints for a diagonal line (made by /'s) through X, Y. | |
3036 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)." | |
3037 (list (artist-vap-find-endpoint x y 1 -1 '(?/ ?X) '(? )) | |
3038 (artist-vap-find-endpoint x y -1 1 '(?/ ?X) '(? )))) | |
3039 | |
3040 (defun artist-vap-find-endpoints-nwse (x y) | |
3041 "Find endpoints for a diagonal line (made by \\'s) through X, Y. | |
3042 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)." | |
3043 (list (artist-vap-find-endpoint x y 1 1 '(?\\ ?X) '(? )) | |
3044 (artist-vap-find-endpoint x y -1 -1 '(?\\ ?X) '(? )))) | |
3045 | |
3046 | |
3047 (defun artist-vap-find-endpoints (x y) | |
3048 "Given a point X1, Y1, return a list of endpoints of lines through X, Y. | |
3049 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)." | |
3050 (if artist-line-char-set | |
3051 nil | |
3052 (let ((c (artist-get-char-at-xy-conv x y))) | |
3053 (cond ((eq c ?-) (artist-vap-find-endpoints-horiz x y)) | |
3054 ((eq c ?|) (artist-vap-find-endpoints-vert x y)) | |
3055 ((eq c ?/) (artist-vap-find-endpoints-swne x y)) | |
3056 ((eq c ?\\) (artist-vap-find-endpoints-nwse x y)) | |
3057 ((eq c ?+) (append (artist-vap-find-endpoints-horiz x y) | |
3058 (artist-vap-find-endpoints-vert x y))) | |
3059 ((eq c ?X) (append (artist-vap-find-endpoints-swne x y) | |
3060 (artist-vap-find-endpoints-nwse x y))) | |
3061 | |
3062 ;; We don't know how to find directions when we are on | |
3063 ;; another character | |
3064 (t nil))))) | |
3065 | |
3066 | |
3067 (defun artist-vap-group-in-pairs (l) | |
3068 "Group elements in list L in pairs." | |
3069 (cond ((null l) nil) | |
3070 ((null (cdr l)) l) ; unevent number of elements in list | |
3071 (t (append (list (list (car l) (car (cdr l)))) | |
3072 (artist-vap-group-in-pairs (cdr (cdr l))))))) | |
3073 | |
3074 (defun artist-vaporize-by-endpoints (endpoint1 endpoint2) | |
3075 "Given ENDPOINT1 and ENDPOINT2, vaporize the line between them. | |
3076 An endpoint is a pair (X . Y)." | |
3077 (let* ((x1 (car endpoint1)) | |
3078 (y1 (cdr endpoint1)) | |
3079 (x2 (car endpoint2)) | |
3080 (y2 (cdr endpoint2)) | |
3081 (dir (artist-find-direction x1 y1 x2 y2)) | |
3082 (x-step (aref [1 1 0 -1 -1 -1 0 1] dir)) | |
3083 (y-step (aref [0 1 1 1 0 -1 -1 -1] dir)) | |
3084 (line-c (aref [?- ?\\ ?| ?/ ?- ?\\ ?| ?/] dir)) | |
3085 (line-len (elt (list (abs (- x2 x1)) | |
3086 (abs (- x2 x1)) | |
3087 (abs (- y2 y1)) | |
3088 (abs (- y2 y1)) | |
3089 (abs (- x1 x2)) | |
3090 (abs (- x1 x2)) | |
3091 (abs (- y1 y2)) | |
3092 (abs (- y1 y2))) | |
3093 dir)) | |
3094 (x x1) | |
3095 (y y1)) | |
3096 (while (>= line-len 0) | |
3097 (let* ((buffer-c (artist-get-char-at-xy-conv x y)) | |
3098 (new-c (artist-unintersection-char line-c buffer-c))) | |
3099 (artist-move-to-xy x y) | |
3100 (artist-replace-char new-c)) | |
3101 (setq x (+ x x-step) | |
3102 y (+ y y-step) | |
3103 line-len (- line-len 1))))) | |
3104 | |
3105 | |
3106 (defun artist-vaporize-line (x1 y1) | |
3107 "Vaporize (erase) the straight line through X1, Y1. | |
3108 Do this by replacing the characters that forms the line with | |
3109 `artist-erase-char'. Output is a list of endpoints for lines | |
3110 through X1, Y1. An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)." | |
3111 (let ((endpoints (artist-vap-find-endpoints x1 y1))) | |
3112 (mapcar | |
3113 (lambda (endpoints) | |
3114 (let ((ep1 (car endpoints)) | |
3115 (ep2 (car (cdr endpoints)))) | |
3116 (artist-vaporize-by-endpoints ep1 ep2))) | |
3117 (artist-vap-group-in-pairs endpoints)) | |
3118 endpoints)) | |
3119 | |
3120 | |
3121 ;; Implementation note: This depends on artist-vaporize-line doing | |
3122 ;; unintersections of intersecting lines. | |
3123 ;; | |
3124 ;; Example: | |
3125 ;; Suppose the buffer looks like this and that we start vaporizing | |
3126 ;; lines at (3,0) (at the ``*''). | |
3127 ;; | |
3128 ;; 0123456 | |
3129 ;; 0+--*--+ | |
3130 ;; 1| | | |
3131 ;; 2| | | |
3132 ;; 3+-----+ | |
3133 ;; | |
3134 ;; We will then push (0,0) and (6,0) on the stack, and vaporize the | |
3135 ;; topmost horizontal line: | |
3136 ;; | |
3137 ;; 0123456 | |
3138 ;; 0| | | |
3139 ;; 1| | | |
3140 ;; 2| | | |
3141 ;; 3+-----+ | |
3142 ;; | |
3143 ;; We will then pop (0,0) and remove the left-most vertival line while | |
3144 ;; pushing the lower left corner (0,3) on the stack, and so on until | |
3145 ;; the entire rectangle is vaporized. | |
3146 ;; | |
3147 ;; Now, What if the `+' in the upper left and upper right corners, | |
47953
126b6cb8740d
(artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents:
46163
diff
changeset
|
3148 ;; had not been changed to `|' but to spaces instead? We would |
33618 | 3149 ;; have failed when popping (0,0) and vaporizing that line because |
3150 ;; we wouldn't find any line at (0,0): | |
47953
126b6cb8740d
(artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents:
46163
diff
changeset
|
3151 ;; |
33618 | 3152 ;; 0123456 |
47953
126b6cb8740d
(artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents:
46163
diff
changeset
|
3153 ;; 0 |
33618 | 3154 ;; 1| | |
3155 ;; 2| | | |
3156 ;; 3+-----+ | |
3157 ;; | |
3158 ;; That's why we depend on artist-vaporize-line doing unintersecting | |
3159 ;; of crossing lines. There are alternative ways to handle this | |
3160 ;; if it becomes too much a trouble. | |
3161 ;; | |
3162 (defun artist-vaporize-lines (x1 y1) | |
3163 "Vaporize lines reachable from point X1, Y1." | |
3164 (let ((ep-stack nil)) | |
3165 (mapcar | |
3166 (lambda (ep) (artist-push ep ep-stack)) | |
3167 (artist-vap-find-endpoints x1 y1)) | |
3168 (while (not (null ep-stack)) | |
3169 (let* ((vaporize-point (artist-pop ep-stack)) | |
3170 (new-endpoints (artist-vaporize-line (car vaporize-point) | |
3171 (cdr vaporize-point)))) | |
3172 (mapcar | |
3173 (lambda (endpoint) (artist-push endpoint ep-stack)) | |
3174 new-endpoints))))) | |
3175 | |
3176 | |
3177 ;; | |
3178 ;; Circles and ellipses | |
3179 ;; | |
3180 (defun artist-ellipse-generate-quadrant (x-radius y-radius) | |
3181 "Create a point-list for first quadrant. | |
3182 Points go from (X-RADIUS, 0) to (0, Y-RADIUS). | |
3183 Quadrant is generated around origo." | |
3184 (let* ((rx2 (* x-radius x-radius)) | |
3185 (ry2 (* y-radius y-radius)) | |
3186 (2rx2 (* 2 rx2)) | |
3187 (2ry2 (* 2 ry2)) | |
3188 (p) | |
3189 (x 0) | |
3190 (y y-radius) | |
3191 (px 0) | |
3192 (py (* 2rx2 y)) | |
3193 (point-list nil)) | |
3194 (artist-put-pixel point-list x y) | |
3195 (setq p (round (+ ry2 (- (* rx2 y-radius)) (* 0.25 rx2)))) | |
3196 (while (< px py) | |
3197 (setq x (1+ x) | |
3198 px (+ px 2ry2)) | |
3199 (if (< p 0) | |
3200 (setq p (+ p ry2 px)) | |
3201 (setq y (- y 1) | |
3202 py (- py 2rx2) | |
3203 p (+ p ry2 px (- py)))) | |
3204 (artist-put-pixel point-list x y)) | |
3205 (setq p (round (+ (* ry2 (+ x 0.5) (+ x 0.5)) | |
3206 (* rx2 (- y 1) (- y 1)) | |
3207 (- (* rx2 ry2))))) | |
3208 (while (> y 0) | |
3209 (setq y (- y 1) | |
3210 py (- py 2rx2)) | |
3211 (if (> p 0) | |
3212 (setq p (+ p rx2 (- py))) | |
3213 (setq x (1+ x) | |
3214 px (+ px 2ry2) | |
3215 p (+ p rx2 (- py) px))) | |
3216 (artist-put-pixel point-list x y)) | |
3217 point-list)) | |
3218 | |
3219 (defsubst artist-new-fill-item (x y width) | |
3220 "Create a new item at X, Y, with WIDTH. | |
3221 This is for use in fill-info in ellipses and circles." | |
3222 (let ((new-item (make-vector 3 x))) | |
3223 (aset new-item 1 y) | |
3224 (aset new-item 2 width) | |
3225 new-item)) | |
3226 | |
3227 (defsubst artist-fill-item-get-x (fill-item) | |
3228 "Retrieve the x component of a FILL-ITEM." | |
3229 (aref fill-item 0)) | |
3230 | |
3231 (defsubst artist-fill-item-set-x (fill-item new-x) | |
3232 "Set the x component of a FILL-ITEM to NEW-X." | |
3233 (aset fill-item 0 new-x) | |
3234 fill-item) | |
3235 | |
3236 (defsubst artist-fill-item-get-y (fill-item) | |
3237 "Retrieve the y component of a FILL-ITEM." | |
3238 (aref fill-item 1)) | |
3239 | |
3240 (defsubst artist-fill-item-set-y (fill-item new-y) | |
3241 "Set the y component of a FILL-ITEM to NEW-Y." | |
3242 (aset fill-item 1 new-y) | |
3243 fill-item) | |
3244 | |
3245 (defsubst artist-fill-item-get-width (fill-item) | |
3246 "Retrieve the width component of a FILL-ITEM." | |
3247 (aref fill-item 2)) | |
3248 | |
3249 (defsubst artist-fill-item-set-width (fill-item new-width) | |
3250 "Set the width component of a FILL-ITEM to NEW-WIDTH." | |
3251 (aset fill-item 2 new-width) | |
3252 fill-item) | |
3253 | |
3254 | |
3255 (defun artist-ellipse-point-list-add-center (x-center y-center point-list) | |
3256 "Add offsets X-CENTER and Y-CENTER to coordinates in POINT-LIST." | |
3257 (mapcar | |
3258 (lambda (p) | |
3259 (artist-coord-set-x p (+ x-center (artist-coord-get-x p))) | |
3260 (artist-coord-set-y p (+ y-center (artist-coord-get-y p)))) | |
3261 point-list)) | |
3262 | |
3263 | |
3264 (defun artist-ellipse-fill-info-add-center (x-center y-center fill-info) | |
3265 "Add offsets X-CENTER and Y-CENTER to fill-items in FILL-INFO." | |
3266 (mapcar | |
3267 (lambda (p) | |
3268 (artist-fill-item-set-x p (+ x-center (artist-fill-item-get-x p))) | |
3269 (artist-fill-item-set-y p (+ y-center (artist-fill-item-get-y p)))) | |
3270 fill-info)) | |
3271 | |
3272 (defun artist-ellipse-remove-0-fills (fill-info) | |
3273 "Remove fill-infos from FILL-INFO that fills a zero-width field." | |
3274 (cond ((null fill-info) | |
3275 nil) | |
3276 ((= 0 (artist-fill-item-get-width (car fill-info))) | |
3277 (artist-ellipse-remove-0-fills (cdr fill-info))) | |
3278 (t | |
3279 (append (list (car fill-info)) | |
3280 (artist-ellipse-remove-0-fills (cdr fill-info)))))) | |
3281 | |
3282 | |
3283 (defun artist-ellipse-compute-fill-info (point-list) | |
3284 "Compute fill info for ellipse around 0,0 from POINT-LIST. | |
3285 The POINT-LIST is expected to cover the first quadrant." | |
3286 (let ((first-half nil) | |
3287 (both-halves nil) | |
3288 (last-y nil)) | |
3289 | |
3290 ;; Create first half (the lower one (since y grows downwards)) from | |
3291 ;; the first quadrant. | |
3292 (mapcar | |
3293 (lambda (coord) | |
3294 (let* ((x (artist-coord-get-x coord)) | |
3295 (y (artist-coord-get-y coord)) | |
3296 (width (max (- (* 2 x) 1) 0)) | |
3297 (left-edge (- x width))) | |
3298 (if (or (null last-y) (not (= y last-y))) | |
3299 ;; This was either the first time, | |
3300 ;; or it was the first time on a new line | |
3301 (setq first-half | |
3302 (append first-half | |
3303 ;; Fill info item starts at left-edge on line y | |
3304 (list (artist-new-fill-item left-edge y width))))) | |
3305 (setq last-y y))) | |
3306 point-list) | |
3307 | |
3308 ;; Create the other half by mirroring the first half. | |
3309 (setq both-halves | |
3310 (append first-half | |
3311 (mapcar | |
3312 (lambda (i) | |
3313 (artist-new-fill-item (artist-fill-item-get-x i) | |
3314 (- (artist-fill-item-get-y i)) | |
3315 (artist-fill-item-get-width i))) | |
3316 ;; The cdr below is so we don't include fill-info for | |
3317 ;;; the middle line twice | |
3318 (cdr (reverse first-half))))) | |
3319 (artist-ellipse-remove-0-fills both-halves))) | |
3320 | |
3321 | |
3322 (defun artist-ellipse-mirror-quadrant (point-list) | |
3323 "Mirror a POINT-LIST describing first quadrant to create a complete ellipse." | |
3324 (let ((right-half nil) | |
3325 (left-half nil)) | |
3326 | |
3327 ;; First, if last char in that quadrant is `/', then replace it with `)' | |
3328 ;; This way we avoids things | |
3329 ;; --------- --------- | |
3330 ;; / \ / \ | |
3331 ;; that look like: \ / instead we get: ( ) | |
3332 ;; \ / \ / | |
3333 ;; --------- --------- | |
3334 (let ((last-coord (artist-last point-list))) | |
3335 (if (= (artist-coord-get-new-char last-coord) ?/) | |
3336 (artist-coord-set-new-char last-coord artist-ellipse-right-char))) | |
3337 | |
3338 ;; Create the other part of the right half by mirroring the first part | |
3339 (setq right-half | |
3340 (append | |
3341 point-list | |
3342 (mapcar | |
3343 (lambda (coord) | |
3344 (let ((c (artist-coord-get-new-char coord))) | |
3345 (artist-new-coord (artist-coord-get-x coord) | |
3346 (- (artist-coord-get-y coord)) | |
3347 (cond ((= c ?/) ?\\) | |
3348 ((= c ?\\) ?/) | |
3349 (t c))))) | |
3350 ;; The cdr below is so we don't draw the middle right char twice | |
3351 (cdr (reverse point-list))))) | |
3352 | |
3353 ;; Create the left half by mirroring the right half. | |
3354 (setq left-half | |
3355 (mapcar | |
3356 (lambda (coord) | |
3357 (let ((c (artist-coord-get-new-char coord))) | |
3358 (artist-new-coord (- (artist-coord-get-x coord)) | |
3359 (artist-coord-get-y coord) | |
3360 (cond ((= c ?/) ?\\) | |
3361 ((= c ?\\) ?/) | |
3362 ((= c artist-ellipse-right-char) | |
3363 artist-ellipse-left-char) | |
3364 (t c))))) | |
3365 ;; The cdr and butlast below is so we don't draw the middle top | |
3366 ;; and middle bottom char twice. | |
40323 | 3367 (funcall artist-butlast-fn (cdr (reverse right-half))))) |
33618 | 3368 (append right-half left-half))) |
3369 | |
3370 | |
3371 (defun artist-draw-ellipse-general (x y x-radius y-radius) | |
3372 "Draw an ellipse with center at X, Y and X-RADIUS and Y-RADIUS. | |
3373 | |
3374 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO). | |
3375 | |
3376 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y]. | |
3377 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO]. | |
3378 | |
3379 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR]. | |
3380 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]. | |
3381 | |
3382 Ellipses with zero y-radius are not drawn correctly." | |
3383 (let* ((point-list (artist-ellipse-generate-quadrant x-radius y-radius)) | |
3384 (fill-info (artist-ellipse-compute-fill-info point-list)) | |
3385 (shape-info (make-vector 2 0))) | |
3386 | |
3387 (setq point-list (artist-calculate-new-chars point-list)) | |
3388 (setq point-list (artist-ellipse-mirror-quadrant point-list)) | |
3389 (setq point-list (artist-ellipse-point-list-add-center x y point-list)) | |
3390 (setq fill-info (artist-ellipse-fill-info-add-center x y fill-info)) | |
3391 | |
3392 ;; Draw the ellipse | |
3393 (setq point-list | |
3394 (mapcar | |
3395 (lambda (coord) | |
3396 (artist-move-to-xy (artist-coord-get-x coord) | |
3397 (artist-coord-get-y coord)) | |
3398 (if artist-line-char-set | |
3399 (artist-replace-char artist-line-char) | |
3400 (artist-replace-char (artist-coord-get-new-char coord))) | |
3401 coord) | |
3402 (artist-modify-new-chars | |
3403 (artist-save-chars-under-point-list point-list)))) | |
3404 | |
3405 (aset shape-info 0 point-list) | |
3406 (aset shape-info 1 fill-info) | |
3407 (artist-make-2point-object (artist-make-endpoint x y) | |
3408 (artist-make-endpoint x-radius y-radius) | |
3409 shape-info))) | |
3410 | |
3411 (defun artist-draw-ellipse-with-0-height (x y x-radius y-radius) | |
3412 "Draw an ellipse with center at X, Y and X-RADIUS and Y-RADIUS. | |
3413 | |
3414 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO). | |
3415 | |
3416 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y]. | |
3417 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO]. | |
3418 | |
3419 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR]. | |
3420 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]. | |
3421 | |
3422 The Y-RADIUS must be 0, but the X-RADUIS must not be 0." | |
3423 (let ((point-list nil) | |
3424 (width (max (- (abs (* 2 x-radius)) 1))) | |
3425 (left-edge (1+ (- x (abs x-radius)))) | |
3426 (line-char (if artist-line-char-set artist-line-char ?-)) | |
3427 (i 0) | |
3428 (point-list nil) | |
3429 (fill-info nil) | |
3430 (shape-info (make-vector 2 0))) | |
3431 (while (< i width) | |
3432 (let* ((line-x (+ left-edge i)) | |
3433 (line-y y) | |
3434 (new-coord (artist-new-coord line-x line-y))) | |
3435 (artist-coord-add-saved-char new-coord | |
3436 (artist-get-char-at-xy line-x line-y)) | |
3437 (artist-move-to-xy line-x line-y) | |
3438 (artist-replace-char line-char) | |
3439 (setq point-list (append point-list (list new-coord))) | |
3440 (setq i (1+ i)))) | |
3441 (aset shape-info 0 point-list) | |
3442 (aset shape-info 1 fill-info) | |
3443 (artist-make-2point-object (artist-make-endpoint x y) | |
3444 (artist-make-endpoint x-radius y-radius) | |
3445 shape-info))) | |
3446 | |
3447 (defun artist-draw-ellipse (x1 y1 x2 y2) | |
3448 "Draw an ellipse with center at X1, Y1 and point X2,Y2. | |
3449 | |
3450 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO). | |
3451 | |
3452 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y]. | |
3453 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO]. | |
3454 | |
3455 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR]. | |
3456 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]." | |
3457 (let* ((artist-line-char (artist-compute-line-char)) | |
3458 (artist-line-char-set artist-line-char) | |
3459 (width (abs (- x2 x1))) | |
3460 (height (abs (- y2 y1))) | |
3461 ;; | |
3462 ;; When we draw our ellipse, we want it to go through the cursor | |
3463 ;; position, but since x1,y1, x2,y2 marks the corners of one | |
3464 ;; of the quadrants, we have to enlarge the ellipse a bit. | |
3465 ;; Ok, so then why by sqrt(2)? | |
3466 ;; It comes from the equation for the ellipse (where a is the | |
3467 ;; x-radius and b is the y-radius): | |
3468 ;; f(x,y) = x^2 / a^2 + y^2 / b^2 - 1 = 0 | |
3469 ;; and the fact that we want the enlarged ellipse to have the | |
3470 ;; same proportions as the smaller square, therefore we have: | |
3471 ;; a/b = x/y | |
3472 ;; Solving this yields a-in-larger-ellipse = a-in-smaller * sqrt(2) | |
3473 (x-radius (round (* width (sqrt 2)))) | |
3474 (y-radius (round (* height (sqrt 2)))) | |
3475 (x x1) | |
3476 (y y1)) | |
3477 (if (and (= y1 y2) (not (= x1 x2))) | |
3478 (artist-draw-ellipse-with-0-height x y x-radius y-radius) | |
3479 (artist-draw-ellipse-general x y x-radius y-radius)))) | |
3480 | |
3481 | |
3482 (defun artist-undraw-ellipse (ellipse) | |
3483 "Undraw ELLIPSE." | |
3484 (if ellipse | |
3485 (let ((point-list (aref (artist-2point-get-shapeinfo ellipse) 0))) | |
3486 (mapcar | |
3487 (lambda (coord) | |
3488 (artist-move-to-xy (artist-coord-get-x coord) | |
3489 (artist-coord-get-y coord)) | |
3490 (artist-replace-char (artist-coord-get-saved-char coord)) | |
3491 coord) | |
3492 point-list)))) | |
3493 | |
3494 | |
3495 (defun artist-draw-circle (x1 y1 x2 y2) | |
3496 "Draw a circle with center at X1, Y1 and point X2,Y2. | |
3497 | |
3498 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO). | |
3499 | |
3500 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y]. | |
3501 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO]. | |
3502 | |
3503 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR]. | |
3504 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]." | |
3505 (let* ((artist-line-char (artist-compute-line-char)) | |
3506 (artist-line-char-set artist-line-char) | |
3507 (width (abs (- x2 x1))) | |
3508 (height (abs (- y2 y1))) | |
3509 ;; When drawing our circle, we want it to through the cursor | |
3510 ;; just as when drawing the ellispe, but we have to take | |
3511 ;; care for the aspect-ratio. | |
3512 ;; The equation for the ellipse (where a is the x-radius and | |
3513 ;; b is the y-radius): | |
3514 ;; f(x,y) = x^2 / a^2 + y^2 / b^2 - 1 = 0 | |
3515 ;; together with the relationship | |
3516 ;; a = aspect-ratio * b | |
3517 ;; gives | |
3518 ;; a = sqrt( x^2 + (aspect-ratio * y)^2 ) and | |
3519 ;; b = a / aspect-ratio | |
3520 (x-radius (round (sqrt (+ (* width width) | |
3521 (* (* artist-aspect-ratio height) | |
3522 (* artist-aspect-ratio height)))))) | |
3523 (y-radius (round (/ x-radius artist-aspect-ratio)))) | |
3524 (artist-draw-ellipse-general x1 y1 x-radius y-radius))) | |
3525 | |
3526 (defalias 'artist-undraw-circle 'artist-undraw-ellipse) | |
3527 | |
3528 | |
3529 ; | |
3530 ; Filling ellipses | |
3531 ; | |
3532 (defun artist-fill-ellipse (ellipse x y x-radius y-radius) | |
3533 "Fill an ELLIPSE centered at X,Y with radius X-RADIUS and Y-RADIUS." | |
3534 (let ((fill-info (aref (artist-2point-get-shapeinfo ellipse) 1))) | |
3535 (mapcar | |
3536 (lambda (fill-item) | |
3537 (artist-move-to-xy (artist-fill-item-get-x fill-item) | |
3538 (artist-fill-item-get-y fill-item)) | |
3539 (artist-replace-chars artist-fill-char | |
3540 (artist-fill-item-get-width fill-item)) | |
3541 fill-item) | |
3542 fill-info))) | |
3543 | |
3544 (defalias 'artist-fill-circle 'artist-fill-ellipse) | |
3545 | |
3546 | |
3547 ;; | |
3548 ;; Cutting, copying and pasting rectangles and squares | |
3549 ;; (filling functions) | |
3550 ;; | |
3551 | |
3552 (defun artist-cut-rect (rect x1 y1 x2 y2) | |
3553 "Copy rectangle RECT drawn from X1, Y1 to X2, Y2, then clear it." | |
3554 (artist-undraw-rect rect) | |
3555 (artist-copy-generic x1 y1 x2 y2) | |
3556 (artist-erase-rect rect x1 y1 x2 y2)) | |
3557 | |
3558 (defun artist-cut-square (square x1 y1 x2 y2) | |
3559 "Copy a SQUARE drawn from X1, Y1 to X2, Y2 (made square), then clears it." | |
3560 (artist-undraw-square square) | |
3561 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2)) | |
3562 (new-x1 (elt square-corners 0)) | |
3563 (new-y1 (elt square-corners 1)) | |
3564 (new-x2 (elt square-corners 2)) | |
3565 (new-y2 (elt square-corners 3))) | |
3566 (artist-copy-generic new-x1 new-y1 new-x2 new-y2) | |
3567 (artist-erase-rect square new-x1 new-y1 new-x2 new-y2))) | |
3568 | |
3569 | |
3570 (defun artist-get-buffer-contents-at-xy (x y width) | |
3571 "Retrieve contents from the buffer at X, Y. WIDTH characters are returned." | |
3572 (artist-move-to-xy x y) | |
3573 (let ((here (point)) | |
3574 (there (save-excursion (artist-move-to-xy (+ x width) y) (point)))) | |
3575 (untabify here there) | |
3576 (setq there (save-excursion (artist-move-to-xy (+ x width) y) (point))) | |
3577 (buffer-substring here there))) | |
3578 | |
3579 | |
3580 (defun artist-copy-generic (x1 y1 x2 y2) | |
3581 "Copy a rectangular area with corners at X1, Y1 and X2, Y2. | |
3582 Output is a copy buffer, a list of strings, representing the | |
3583 original contents of that area in the buffer." | |
3584 (let* ((x (min x1 x2)) | |
3585 (y (min y1 y2)) | |
3586 (x-max (max x1 x2)) | |
3587 (y-max (max y1 y2)) | |
3588 (w (+ (- x-max x) 1)) | |
3589 (l nil)) | |
3590 (while (<= y y-max) | |
3591 (setq l (cons (artist-get-buffer-contents-at-xy x y w) l)) | |
3592 (setq y (1+ y))) | |
3593 (if artist-interface-with-rect | |
3594 (setq killed-rectangle (reverse l)) | |
3595 (setq artist-copy-buffer (reverse l))))) | |
3596 | |
3597 | |
3598 (defun artist-copy-rect (rect x1 y1 x2 y2) | |
3599 "Copy rectangle RECT drawn from X1, Y1 to X2, Y2." | |
3600 (artist-undraw-rect rect) | |
3601 (artist-copy-generic x1 y1 x2 y2)) | |
3602 | |
3603 (defun artist-copy-square (square x1 y1 x2 y2) | |
3604 "Copies a SQUARE drawn from X1, Y1 to X2, Y2 (but made square)." | |
3605 (artist-undraw-square square) | |
3606 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2)) | |
3607 (new-x1 (elt square-corners 0)) | |
3608 (new-y1 (elt square-corners 1)) | |
3609 (new-x2 (elt square-corners 2)) | |
3610 (new-y2 (elt square-corners 3))) | |
3611 (artist-copy-generic new-x1 new-y1 new-x2 new-y2))) | |
3612 | |
3613 (defun artist-paste (x y) | |
3614 "Pastes the contents of the copy-buffer at X,Y." | |
3615 (let ((copy-buf (if artist-interface-with-rect | |
3616 killed-rectangle | |
3617 artist-copy-buffer))) | |
3618 (if (not (null copy-buf)) | |
3619 (while (not (null copy-buf)) | |
3620 (artist-move-to-xy x y) | |
3621 (artist-replace-string (car copy-buf)) | |
3622 (setq copy-buf (cdr copy-buf)) | |
3623 (setq y (1+ y))) | |
3624 (message "Nothing to paste")))) | |
3625 | |
3626 | |
3627 ;; | |
3628 ;; Flood filling | |
3629 ;; | |
3630 (defun artist-ff-too-far-right (x) | |
3631 "Determine if the position X is too far to the right." | |
3632 (cond ((numberp artist-flood-fill-right-border) | |
3633 (> x artist-flood-fill-right-border)) | |
3634 ((eq artist-flood-fill-right-border 'window-width) | |
3635 (> x (- (window-width) 2))) | |
3636 ((eq artist-flood-fill-right-border 'fill-column) | |
3637 (> x fill-column)) | |
3638 (t (error "Invalid value for `artist-flood-fill-right-border'")))) | |
3639 | |
3640 (defun artist-ff-get-rightmost-from-xy (x y) | |
3641 "Find the rightmost position in this run, starting at X, Y." | |
3642 (save-excursion | |
3643 (let ((char-at-xy (artist-get-char-at-xy-conv x y)) | |
3644 (last-x x)) | |
3645 (setq x (1+ x)) | |
3646 (while (and (not (artist-ff-too-far-right x)) | |
3647 (= char-at-xy (artist-get-char-at-xy-conv x y))) | |
3648 (setq last-x x) | |
3649 (setq x (1+ x))) | |
3650 last-x))) | |
3651 | |
3652 (defun artist-ff-is-topmost-line (x y) | |
3653 "Determine whether the position X,Y is on the topmost line or not." | |
3654 (= y 0)) | |
3655 | |
3656 (defun artist-ff-is-bottommost-line (x y) | |
3657 "Determine whether the position X,Y is on the bottommost line or not." | |
3658 (save-excursion | |
3659 (goto-char (point-max)) | |
3660 (beginning-of-line) | |
3661 (let ((last-line (artist-current-line))) | |
3662 (if (= (point) (point-max)) | |
3663 | |
3664 ;; Last line is empty, don't paint on it, report previous line | |
3665 ;; as last line | |
47953
126b6cb8740d
(artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents:
46163
diff
changeset
|
3666 (>= y (- last-line 1)) |
126b6cb8740d
(artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents:
46163
diff
changeset
|
3667 (>= y last-line))))) |
33618 | 3668 |
3669 (defun artist-flood-fill (x1 y1) | |
3670 "Flood-fill starting at X1, Y1. Fill with the char in `artist-fill-char'." | |
3671 (let ((stack nil) | |
3672 (input-queue nil) | |
3673 ;; We are flood-filling the area that has this character. | |
3674 (c (artist-get-char-at-xy-conv x1 y1)) | |
3675 (artist-fill-char (if artist-fill-char-set | |
3676 artist-fill-char | |
3677 artist-default-fill-char))) | |
3678 | |
3679 ;; Fill only if the fill-char is not the same as the character whose | |
3680 ;; area we are about to fill, or, in other words, don't fill if we | |
3681 ;; needn't. | |
3682 (if (not (= c artist-fill-char)) | |
3683 (artist-push (artist-new-coord x1 y1) stack)) | |
3684 | |
3685 (while (not (null stack)) | |
3686 (let* ((coord (artist-pop stack)) | |
3687 (x (artist-coord-get-x coord)) | |
3688 (y (artist-coord-get-y coord)) | |
3689 | |
3690 ;; Here we keep track of the leftmost and rightmost position | |
3691 ;; for this run | |
3692 (x-leftmost 0) | |
3693 (x-rightmost 0) | |
3694 (last-x 0) | |
3695 | |
3696 ;; Remember if line above and below are accessible | |
3697 ;; Lines below the last one, and prior to the first-one | |
3698 ;; are not accessible. | |
3699 (lines-above nil) | |
3700 (lines-below nil) | |
3701 | |
3702 ;; Remember char for position on line above and below, so we | |
3703 ;; can find the rightmost positions on the runs. | |
3704 (last-c-above -1) | |
3705 (last-c-below -1)) | |
3706 | |
3707 (setq x-rightmost (artist-ff-get-rightmost-from-xy x y)) | |
3708 (setq lines-above (not (artist-ff-is-topmost-line x y))) | |
3709 (setq lines-below (not (artist-ff-is-bottommost-line x y))) | |
3710 (setq last-x x-rightmost) | |
3711 (setq x x-rightmost) | |
3712 | |
3713 ;; Search line above, push rightmost positions of runs for that line | |
3714 (while (and (>= x 0) (= c (artist-get-char-at-xy-conv x y))) | |
3715 (if lines-above | |
3716 (let ((c-above (artist-get-char-at-xy-conv x (- y 1)))) | |
3717 (if (and (= c-above c) (/= c-above last-c-above)) | |
3718 (artist-push (artist-new-coord x (- y 1)) stack)) | |
3719 (setq last-c-above c-above))) | |
3720 (setq last-x x) | |
3721 (setq x (- x 1))) | |
3722 | |
3723 ;; Remember the left-most position on this run | |
3724 (setq x-leftmost last-x) | |
3725 | |
3726 ;; Search line below, push rightmost positions of runs for that line | |
3727 (setq x x-rightmost) | |
3728 (while (>= x x-leftmost) | |
3729 (if lines-below | |
3730 (let ((c-below (artist-get-char-at-xy-conv x (1+ y)))) | |
3731 (if (and (= c-below c) (/= c-below last-c-below)) | |
3732 (artist-push (artist-new-coord x (1+ y)) stack)) | |
3733 (setq last-c-below c-below))) | |
3734 (setq x (- x 1))) | |
3735 | |
3736 (artist-move-to-xy x-leftmost y) | |
3737 (artist-replace-chars artist-fill-char (1+ (- x-rightmost x-leftmost))) | |
3738 | |
3739 ;; If we are to show incrementally, we have to remove any pending | |
3740 ;; input from the input queue, because processing of pending input | |
3741 ;; always has priority over display updates (although this input | |
3742 ;; won't be processed until we are done). Later on we will queue | |
3743 ;; the input on the input queue again. | |
3744 (if artist-flood-fill-show-incrementally | |
3745 (progn | |
3746 (if (input-pending-p) | |
3747 (discard-input)) | |
3748 (artist-update-display))))))) | |
3749 | |
3750 ;; | |
3751 ;; Accessors to arrow-points | |
3752 ;; | |
3753 | |
3754 (defun artist-make-arrow-point (x y direction &optional state) | |
3755 "Create an arrow point at X, Y for a line in direction DIRECTION. | |
3756 Optional argument STATE can be used to set state (default is nil)." | |
3757 (save-excursion | |
3758 (let* ((arrow-point (make-vector 4 0)) | |
3759 (arrow-marker (make-marker))) | |
3760 (artist-move-to-xy x y) | |
3761 (set-marker arrow-marker (point)) | |
3762 (aset arrow-point 0 arrow-marker) | |
3763 (aset arrow-point 1 (artist-get-char-at-xy x y)) | |
3764 (aset arrow-point 2 direction) | |
3765 (aset arrow-point 3 state) | |
3766 arrow-point))) | |
3767 | |
3768 (defsubst artist-arrow-point-get-marker (arrow-point) | |
3769 "Retrieve the marker component of an ARROW-POINT." | |
3770 (aref arrow-point 0)) | |
3771 | |
3772 (defsubst artist-arrow-point-get-orig-char (arrow-point) | |
3773 "Retrieve the orig char component of an ARROW-POINT." | |
3774 (aref arrow-point 1)) | |
3775 | |
3776 (defsubst artist-arrow-point-get-direction (arrow-point) | |
3777 "Retrieve the direction component of an ARROW-POINT." | |
3778 (aref arrow-point 2)) | |
3779 | |
3780 (defsubst artist-arrow-point-get-state (arrow-point) | |
3781 "Retrieve the state component of an ARROW-POINT." | |
3782 (aref arrow-point 3)) | |
3783 | |
3784 (defsubst artist-arrow-point-set-state (arrow-point new-state) | |
3785 "Set the state component of an ARROW-POINT to NEW-STATE." | |
3786 (aset arrow-point 3 new-state)) | |
3787 | |
3788 | |
3789 (defun artist-clear-arrow-points () | |
3790 "Clear current endpoints." | |
3791 (setq artist-arrow-point-1 nil) | |
3792 (setq artist-arrow-point-2 nil)) | |
3793 | |
3794 (defun artist-set-arrow-points-for-poly (point-list) | |
3795 "Generic function for setting arrow-points for poly-shapes from POINT-LIST." | |
3796 (let* ((ep1 (elt point-list 0)) | |
3797 (ep2 (elt point-list 1)) | |
3798 (x1 (artist-endpoint-get-x ep1)) | |
3799 (y1 (artist-endpoint-get-y ep1)) | |
3800 (x2 (artist-endpoint-get-x ep2)) | |
3801 (y2 (artist-endpoint-get-y ep2)) | |
3802 (dir1 (artist-find-direction x2 y2 x1 y1)) | |
3803 (epn (artist-last point-list)) | |
3804 (epn-1 (artist-last point-list 2)) | |
3805 (xn (artist-endpoint-get-x epn)) | |
3806 (yn (artist-endpoint-get-y epn)) | |
3807 (xn-1 (artist-endpoint-get-x epn-1)) | |
3808 (yn-1 (artist-endpoint-get-y epn-1)) | |
3809 (dirn (artist-find-direction xn-1 yn-1 xn yn))) | |
3810 (setq artist-arrow-point-1 (artist-make-arrow-point x1 y1 dir1)) | |
3811 (setq artist-arrow-point-2 (artist-make-arrow-point xn yn dirn)))) | |
3812 | |
3813 | |
3814 (defun artist-set-arrow-points-for-2points (shape x1 y1 x2 y2) | |
3815 "Generic function for setting arrow-points for 2-point shapes. | |
3816 The 2-point shape SHAPE is drawn from X1, Y1 to X2, Y2." | |
3817 (let* ((endpoint1 (artist-2point-get-endpoint1 shape)) | |
3818 (endpoint2 (artist-2point-get-endpoint2 shape)) | |
3819 (x1 (artist-endpoint-get-x endpoint1)) | |
3820 (y1 (artist-endpoint-get-y endpoint1)) | |
3821 (x2 (artist-endpoint-get-x endpoint2)) | |
3822 (y2 (artist-endpoint-get-y endpoint2))) | |
3823 (setq artist-arrow-point-1 | |
3824 (artist-make-arrow-point x1 y1 | |
3825 (artist-find-direction x2 y2 x1 y1))) | |
3826 (setq artist-arrow-point-2 | |
3827 (artist-make-arrow-point x2 y2 | |
3828 (artist-find-direction x1 y1 x2 y2))))) | |
3829 | |
3830 | |
3831 ;; | |
3832 ;; Common routine for drawing/undrawing shapes based | |
3833 ;; on the draw-how | |
3834 ;; | |
3835 | |
3836 (defun artist-key-undraw-continously (x y) | |
3837 "Undraw current continous shape with point at X, Y." | |
3838 ;; No undraw-info for continous shapes | |
3839 nil) | |
3840 | |
3841 (defun artist-key-undraw-poly (x y) | |
3842 "Undraw current poly shape with point at X, Y." | |
3843 (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go)) | |
3844 (x1 (artist-endpoint-get-x artist-key-endpoint1)) | |
3845 (y1 (artist-endpoint-get-y artist-key-endpoint1))) | |
3846 (artist-funcall undraw-fn artist-key-shape))) | |
3847 | |
3848 (defun artist-key-undraw-1point (x y) | |
3849 "Undraw current 1-point shape at X, Y." | |
3850 ;; No undraw-info for 1-point shapes | |
3851 nil) | |
3852 | |
3853 (defun artist-key-undraw-2points (x y) | |
3854 "Undraw current 2-point shape at X, Y." | |
3855 (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go)) | |
3856 (x1 (artist-endpoint-get-x artist-key-endpoint1)) | |
3857 (y1 (artist-endpoint-get-y artist-key-endpoint1))) | |
3858 (artist-funcall undraw-fn artist-key-shape))) | |
3859 | |
3860 (defun artist-key-undraw-common () | |
3861 "Common routine undrawing current shape." | |
3862 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go)) | |
3863 (col (artist-current-column)) | |
3864 (row (artist-current-line))) | |
3865 | |
3866 ;; Depending on what we are currently drawing, call other routines | |
3867 ;; that knows how to do the job | |
3868 ;; | |
3869 (cond ((eq draw-how 'artist-do-continously) | |
3870 (artist-key-undraw-continously col row)) | |
3871 ((eq draw-how 'artist-do-poly) | |
3872 (artist-key-undraw-poly col row)) | |
3873 ((and (numberp draw-how) (= draw-how 1)) | |
3874 (artist-key-undraw-1point col row)) | |
3875 ((and (numberp draw-how) (= draw-how 2)) | |
3876 (artist-key-undraw-2points col row)) | |
3877 (t (message "Undrawing \"%s\"s is not yet implemented" draw-how))) | |
3878 | |
3879 ;; Now restore the old position | |
3880 ;; | |
3881 (artist-move-to-xy col row))) | |
3882 | |
3883 | |
3884 | |
3885 ;; Implementation note: This really should honor the interval-fn entry | |
3886 ;; in the master table, `artist-mt', which would mean leaving a timer | |
3887 ;; that calls `draw-fn' every now and then. That timer would then have | |
3888 ;; to be cancelled and reinstalled whenever the user moves the cursor. | |
3889 ;; This could be done, but what if the user suddenly switches to another | |
3890 ;; drawing mode, or even kills the buffer! In the mouse case, it is much | |
3891 ;; simpler: when at the end of `artist-mouse-draw-continously', the | |
3892 ;; user has released the button, so the timer will always be cancelled | |
3893 ;; at that point. | |
3894 (defun artist-key-draw-continously (x y) | |
3895 "Draws current continous shape at X,Y." | |
3896 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))) | |
3897 (setq artist-key-shape (artist-funcall draw-fn x y)))) | |
3898 | |
3899 (defun artist-key-draw-poly (x y) | |
3900 "Draws current poly-point shape with nth point at X,Y." | |
3901 (let ((draw-fn (artist-go-get-draw-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 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x y)))) | |
3905 | |
3906 (defun artist-key-draw-1point (x y) | |
3907 "Draws current 1-point shape at X,Y." | |
3908 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))) | |
3909 (setq artist-key-shape (artist-funcall draw-fn x y)))) | |
3910 | |
3911 | |
3912 (defun artist-key-draw-2points (x y) | |
3913 "Draws current 2-point shape at X,Y." | |
3914 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)) | |
3915 (x1 (artist-endpoint-get-x artist-key-endpoint1)) | |
3916 (y1 (artist-endpoint-get-y artist-key-endpoint1))) | |
3917 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x y)))) | |
3918 | |
3919 (defun artist-key-draw-common () | |
3920 "Common routine for drawing current shape." | |
3921 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go)) | |
3922 (col (artist-current-column)) | |
3923 (row (artist-current-line))) | |
3924 | |
3925 ;; Depending on what we are currently drawing, call other routines | |
3926 ;; that knows how to do the job | |
3927 ;; | |
3928 (cond ((eq draw-how 'artist-do-continously) | |
3929 (artist-key-draw-continously col row)) | |
3930 ((eq draw-how 'artist-do-poly) | |
3931 (artist-key-draw-poly col row)) | |
3932 ((and (numberp draw-how) (= draw-how 1)) | |
3933 (artist-key-draw-1point col row)) | |
3934 ((and (numberp draw-how) (= draw-how 2)) | |
3935 (artist-key-draw-2points col row)) | |
3936 (t (message "Drawing \"%s\"s is not yet implemented" draw-how))) | |
3937 | |
3938 ;; Now restore the old position | |
3939 ;; | |
3940 (artist-move-to-xy col row))) | |
3941 | |
3942 | |
3943 | |
3944 ;; | |
3945 ;; Functions related to trimming line-endings | |
3946 ;; The region between the topmost and bottommost visited line is | |
3947 ;; called a draw-region. | |
3948 ;; | |
3949 | |
3950 (defun artist-draw-region-reset () | |
3951 "Reset the current draw-region." | |
3952 (setq artist-draw-region-max-y 0) | |
3953 (setq artist-draw-region-min-y 1000000)) | |
3954 | |
3955 (defun artist-draw-region-trim-line-endings (min-y max-y) | |
3956 "Trim lines in current draw-region from MIN-Y to MAX-Y. | |
3957 Trimming here means removing white space at end of a line" | |
3958 ;; Safetyc check: switch min-y and max-y if if max-y is smaller | |
3959 (if (< max-y min-y) | |
3960 (let ((tmp min-y)) | |
3961 (setq min-y max-y) | |
3962 (setq max-y tmp))) | |
3963 (save-excursion | |
3964 (let ((curr-y min-y)) | |
3965 (while (<= curr-y max-y) | |
3966 (artist-move-to-xy 0 curr-y) | |
3967 (end-of-line) | |
3968 (delete-horizontal-space) | |
3969 (setq curr-y (1+ curr-y)))))) | |
3970 | |
3971 ;; | |
3972 ;; Drawing shapes by using keys | |
3973 ;; | |
3974 | |
3975 (defun artist-key-do-continously-continously (x y) | |
3976 "Update current continous shape at X,Y." | |
3977 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))) | |
3978 (artist-funcall draw-fn x y))) | |
3979 | |
3980 | |
3981 (defun artist-key-do-continously-poly (x y) | |
3982 "Update current poly-point shape with nth point at X,Y." | |
3983 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)) | |
3984 (undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go)) | |
3985 (x1 (artist-endpoint-get-x artist-key-endpoint1)) | |
3986 (y1 (artist-endpoint-get-y artist-key-endpoint1)) | |
3987 (x2 x) | |
3988 (y2 y)) | |
3989 ;; If not rubber-banding, then move the 2 | |
3990 ;; Otherwise re-draw the shape to the new position | |
3991 ;; | |
3992 (if (not artist-rubber-banding) | |
3993 (progn | |
3994 (artist-no-rb-unset-point2) | |
3995 (artist-no-rb-set-point2 x y)) | |
3996 (progn | |
3997 (artist-funcall undraw-fn artist-key-shape) | |
3998 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2)))))) | |
3999 | |
4000 | |
4001 (defun artist-key-do-continously-1point (x y) | |
4002 "Update current 1-point shape at X,Y." | |
4003 ;; Nothing to do continously for operations | |
4004 ;; where we have only one input point | |
4005 nil) | |
4006 | |
4007 (defun artist-key-do-continously-2points (x y) | |
4008 "Update current 2-point shape with 2nd point at X,Y." | |
4009 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)) | |
4010 (undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go)) | |
4011 (x1 (artist-endpoint-get-x artist-key-endpoint1)) | |
4012 (y1 (artist-endpoint-get-y artist-key-endpoint1)) | |
4013 (x2 x) | |
4014 (y2 y)) | |
4015 ;; If not rubber-banding, then move the 2 | |
4016 ;; Otherwise re-draw the shape to the new position | |
4017 ;; | |
4018 (if (not artist-rubber-banding) | |
4019 (progn | |
4020 (artist-no-rb-unset-point2) | |
4021 (artist-no-rb-set-point2 x y)) | |
4022 (progn | |
4023 (artist-funcall undraw-fn artist-key-shape) | |
4024 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2)))))) | |
4025 | |
4026 | |
4027 (defun artist-key-do-continously-common () | |
4028 "Common routine for updating current shape." | |
4029 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go)) | |
4030 (col (artist-current-column)) | |
4031 (row (artist-current-line))) | |
4032 | |
4033 ;; Depending on what we are currently drawing, call other routines | |
4034 ;; that knows how to do the job | |
4035 ;; | |
4036 (cond ((eq draw-how 'artist-do-continously) | |
4037 (artist-key-do-continously-continously col row)) | |
4038 ((eq draw-how 'artist-do-poly) | |
4039 (artist-key-do-continously-poly col row)) | |
4040 ((and (numberp draw-how) (= draw-how 1)) | |
4041 (artist-key-do-continously-1point col row)) | |
4042 ((and (numberp draw-how) (= draw-how 2)) | |
4043 (artist-key-do-continously-2points col row)) | |
4044 (t (message "Drawing \"%s\"s is not yet implemented" draw-how))) | |
4045 | |
4046 ;; Now restore the old position | |
4047 ;; | |
4048 (artist-move-to-xy col row))) | |
4049 | |
4050 | |
4051 (defun artist-key-set-point-continously (x y) | |
4052 "Set point for current continous shape at X,Y." | |
4053 ;; Maybe set arrow-points for continous shapes | |
4054 (let ((arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go)) | |
4055 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go)) | |
4056 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go)) | |
4057 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go)) | |
4058 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))) | |
4059 | |
4060 (if (not artist-key-is-drawing) | |
4061 ;; *** We are about to begin drawing | |
4062 (progn | |
4063 (artist-funcall init-fn x y)) | |
4064 | |
4065 ;; *** We are about to stop drawing | |
4066 (progn | |
4067 | |
4068 (artist-funcall prep-fill-fn x y) | |
4069 (if (artist-funcall arrow-pred) | |
4070 (artist-funcall arrow-set-fn x y) | |
4071 (artist-clear-arrow-points)) | |
4072 (artist-funcall exit-fn x y)))) | |
4073 | |
4074 ;; Toggle the is-drawing flag | |
4075 (setq artist-key-is-drawing (not artist-key-is-drawing))) | |
4076 | |
4077 | |
4078 | |
4079 (defun artist-key-set-point-poly (x y &optional this-is-last-point) | |
4080 "Set point for current poly-point shape at X,Y. | |
4081 If optional argument THIS-IS-LAST-POINT is non-nil, this point is the last." | |
4082 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)) | |
4083 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go)) | |
4084 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go)) | |
4085 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go)) | |
4086 (fill-pred (artist-go-get-fill-pred-from-symbol artist-curr-go)) | |
4087 (fill-fn (artist-go-get-fill-fn-from-symbol artist-curr-go)) | |
4088 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go)) | |
4089 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go))) | |
4090 | |
4091 (if (not artist-key-is-drawing) | |
4092 | |
4093 ;; *** We were not drawing ==> set first point | |
4094 (progn | |
4095 | |
4096 (artist-funcall init-fn x y) | |
4097 | |
4098 ;; If not rubber-banding, set first point. | |
4099 ;; Otherwise, draw the shape from x,y to x,y | |
4100 (if (not artist-rubber-banding) | |
4101 (artist-no-rb-set-point1 x y) | |
4102 (setq artist-key-shape (artist-funcall draw-fn x y x y))) | |
4103 | |
4104 ;; Set first endpoint | |
4105 (setq artist-key-endpoint1 (artist-make-endpoint x y)) | |
4106 | |
4107 ;; Set point-list to contain start point | |
4108 (setq artist-key-poly-point-list (list (artist-make-endpoint x y))) | |
4109 | |
4110 ;; Since we are not ready, set the arrow-points to nil | |
4111 (artist-clear-arrow-points) | |
4112 | |
4113 ;; Change state to drawing | |
4114 (setq artist-key-is-drawing t) | |
4115 | |
4116 ;; Feedback | |
4117 (message (substitute-command-keys | |
4118 (concat "First point set. " | |
4119 "Set next with \\[artist-key-set-point], " | |
4120 "set last with C-u \\[artist-key-set-point]")))) | |
4121 | |
4122 | |
4123 ;; *** We were drawing ==> we are about to set nth point | |
4124 ;; (last point if the argument this-is-last-point is non-nil) | |
4125 ;; | |
4126 (let ((x1 (artist-endpoint-get-x artist-key-endpoint1)) | |
4127 (y1 (artist-endpoint-get-y artist-key-endpoint1)) | |
4128 (x2 x) | |
4129 (y2 y)) | |
4130 | |
4131 ;; If not rubber-banding, undraw the 1's and 2's, then | |
4132 ;; draw the shape (if we were rubber-banding, then the | |
4133 ;; shape is already drawn in artist-key-do-continously-2points.) | |
4134 ;; | |
4135 (if (not artist-rubber-banding) | |
4136 (progn | |
4137 (artist-no-rb-unset-points) | |
4138 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2)))) | |
4139 | |
4140 ;; Set x2 and y2 from shape's second point | |
4141 ;; (which might be different from the mouse's second point, | |
4142 ;; if, for example, we are drawing a straight line) | |
4143 ;; | |
4144 (if (not (null artist-key-shape)) | |
4145 (let ((endpoint2 (artist-2point-get-endpoint2 artist-key-shape))) | |
4146 (setq x2 (artist-endpoint-get-x endpoint2)) | |
4147 (setq y2 (artist-endpoint-get-y endpoint2)))) | |
4148 | |
4149 ;; Add the endpoint to the list of poly-points | |
4150 (setq artist-key-poly-point-list | |
4151 (append artist-key-poly-point-list | |
4152 (list (artist-make-endpoint x2 y2)))) | |
4153 | |
4154 ;; Now do handle the case when this is the last point, | |
4155 ;; and the case when this point isn't the last | |
4156 ;; | |
4157 (if (not this-is-last-point) | |
4158 ;; ** This is not the last point | |
4159 (progn | |
4160 ;; Start drawing a new 2-point-shape from last endpoint. | |
4161 | |
4162 ;; First set the start-point | |
4163 (setq x1 x2) | |
4164 (setq y1 y2) | |
4165 (setq artist-key-endpoint1 (artist-make-endpoint x1 y1)) | |
4166 | |
4167 ;; If we are not rubber-banding, then place the '1 | |
4168 ;; Otherwise, draw the shape from x1,y1 to x1,y1 | |
4169 (if (not artist-rubber-banding) | |
4170 (artist-no-rb-set-point1 x1 y1) | |
4171 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x1 y1))) | |
4172 | |
4173 ;; Feedback | |
4174 (message "Point set")) | |
4175 | |
4176 ;; ** This is the last point | |
4177 (progn | |
4178 | |
4179 (artist-funcall prep-fill-fn artist-key-poly-point-list) | |
4180 | |
4181 ;; Maybe fill | |
4182 (if (artist-funcall fill-pred) | |
4183 (artist-funcall fill-fn artist-key-shape | |
4184 artist-key-poly-point-list)) | |
4185 | |
4186 ;; Set the arrow-points | |
4187 (if (artist-funcall arrow-pred) | |
4188 (artist-funcall arrow-set-fn artist-key-poly-point-list) | |
4189 (artist-clear-arrow-points)) | |
4190 | |
4191 (artist-funcall exit-fn artist-key-poly-point-list) | |
4192 | |
4193 ;; Change state to not drawing | |
4194 (setq artist-key-shape nil) | |
4195 (setq artist-key-endpoint1 nil) | |
4196 (setq artist-key-is-drawing nil))))))) | |
4197 | |
4198 | |
4199 (defun artist-key-set-point-1point (x y) | |
4200 "Set point for current 1-point shape at X,Y." | |
4201 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)) | |
4202 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go)) | |
4203 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go)) | |
4204 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go)) | |
4205 (draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)) | |
4206 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go)) | |
4207 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go))) | |
4208 (artist-funcall init-fn x y) | |
4209 (artist-funcall draw-fn x y) | |
4210 (artist-funcall prep-fill-fn x y) | |
4211 (if (artist-funcall arrow-pred) | |
4212 (artist-funcall arrow-set-fn x y) | |
4213 (artist-clear-arrow-points)) | |
4214 (artist-funcall exit-fn x y)) | |
4215 (setq artist-key-shape nil) | |
4216 (setq artist-key-is-drawing nil)) | |
4217 | |
4218 | |
4219 (defun artist-key-set-point-2points (x y) | |
4220 "Set first or second point in current 2-point shape at X,Y." | |
4221 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)) | |
4222 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go)) | |
4223 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go)) | |
4224 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go)) | |
4225 (fill-pred (artist-go-get-fill-pred-from-symbol artist-curr-go)) | |
4226 (fill-fn (artist-go-get-fill-fn-from-symbol artist-curr-go)) | |
4227 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go)) | |
4228 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go))) | |
4229 (if (not artist-key-is-drawing) | |
4230 | |
4231 ;; *** We were not drawing ==> set first point | |
4232 (progn | |
4233 | |
4234 (artist-funcall init-fn x y) | |
4235 | |
4236 ;; If not rubber-banding, set first point. | |
4237 ;; Otherwise, draw the shape from x,y to x,y | |
4238 (if (not artist-rubber-banding) | |
4239 (artist-no-rb-set-point1 x y) | |
4240 (setq artist-key-shape (artist-funcall draw-fn x y x y))) | |
4241 | |
4242 ;; Set first endpoint | |
4243 (setq artist-key-endpoint1 (artist-make-endpoint x y)) | |
4244 | |
4245 ;; Since we are not ready, clear the arrow-points | |
4246 (artist-clear-arrow-points) | |
4247 | |
4248 ;; Change state to drawing | |
4249 (setq artist-key-is-drawing t)) | |
4250 | |
4251 ;; *** We were drawing ==> we are about to set 2nd point | |
4252 ;; and end the drawing operation | |
4253 | |
4254 (let ((x1 (artist-endpoint-get-x artist-key-endpoint1)) | |
4255 (y1 (artist-endpoint-get-y artist-key-endpoint1)) | |
4256 (x2 x) | |
4257 (y2 y)) | |
4258 | |
4259 ;; If not rubber-banding, undraw the 1's and 2's, then | |
4260 ;; draw the shape (if we were rubber-banding, then the | |
4261 ;; shape is already drawn in artist-key-do-continously-2points.) | |
4262 ;; | |
4263 (if (not artist-rubber-banding) | |
4264 (progn | |
4265 (artist-no-rb-unset-points) | |
4266 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2)))) | |
4267 | |
4268 (artist-funcall prep-fill-fn artist-key-shape x1 y1 x2 y2) | |
4269 | |
4270 ;; Maybe fill | |
4271 ;; | |
4272 (if (artist-funcall fill-pred) | |
4273 (artist-funcall fill-fn artist-key-shape x1 y1 x2 y2)) | |
4274 | |
4275 ;; Maybe set the arrow-points | |
4276 ;; | |
4277 (if (artist-funcall arrow-pred) | |
4278 (artist-funcall arrow-set-fn artist-key-shape x1 y1 x2 y2) | |
4279 (artist-clear-arrow-points)) | |
4280 | |
4281 (artist-funcall exit-fn artist-key-shape x1 y1 x2 y2) | |
4282 | |
4283 ;; Change state to not drawing | |
4284 (setq artist-key-is-drawing nil))))) | |
4285 | |
4286 | |
4287 (defun artist-key-set-point-common (arg) | |
4288 "Common routine for setting point in current shape. | |
4289 With ARG set to t, set the last point." | |
4290 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go)) | |
4291 (col (artist-current-column)) | |
4292 (row (artist-current-line)) | |
4293 (was-drawing artist-key-is-drawing)) | |
4294 | |
4295 ;; First, if we are about to draw, then reset the draw-region | |
4296 (if (not artist-key-is-drawing) | |
4297 (artist-draw-region-reset)) | |
4298 | |
4299 ;; Depending on what we are currently drawing, call other routines | |
4300 ;; that knows how to do the job | |
4301 ;; | |
4302 (cond ((eq draw-how 'artist-do-continously) | |
4303 (artist-key-set-point-continously col row) | |
4304 ;; Do this now, otherwise nothing will happen until we move. | |
4305 (artist-key-do-continously-continously col row)) | |
4306 ((eq draw-how 'artist-do-poly) | |
4307 (artist-key-set-point-poly col row arg)) | |
4308 ((and (numberp draw-how) (= draw-how 1)) | |
4309 (artist-key-set-point-1point col row)) | |
4310 ((and (numberp draw-how) (= draw-how 2)) | |
4311 (artist-key-set-point-2points col row)) | |
4312 (t (message "Drawing \"%s\"s is not yet implemented" draw-how))) | |
4313 | |
4314 ;; Maybe trim line endings | |
4315 (if (and artist-trim-line-endings | |
4316 was-drawing | |
4317 (not artist-key-is-drawing)) | |
4318 (artist-draw-region-trim-line-endings artist-draw-region-min-y | |
4319 artist-draw-region-max-y)) | |
4320 | |
4321 ;; Now restore the old position | |
4322 ;; | |
4323 (artist-move-to-xy col row) | |
4324 (artist-mode-line-show-curr-operation artist-key-is-drawing))) | |
4325 | |
4326 ;; | |
4327 ;; Key navigation | |
4328 ;; | |
4329 | |
4330 (defun artist-previous-line (&optional n) | |
4331 "Move cursor up optional N lines (default is 1), updating current shape. | |
4332 If N is negative, move cursor down." | |
4333 (interactive "p") | |
4334 (let ((col (artist-current-column))) | |
4335 (if (not artist-key-is-drawing) | |
4336 (progn | |
4337 (previous-line n) | |
4338 (move-to-column col t)) | |
4339 (previous-line n) | |
4340 (move-to-column col t) | |
4341 (artist-key-do-continously-common)))) | |
4342 | |
4343 | |
4344 (defun artist-next-line (&optional n) | |
4345 "Move cursor down optional N lines (default is 1), updating current shape. | |
4346 If N is negative, move cursor up." | |
4347 (interactive "p") | |
4348 (let ((col (artist-current-column))) | |
4349 (if (not artist-key-is-drawing) | |
4350 (progn | |
4351 (next-line n) | |
4352 (move-to-column col t)) | |
4353 (next-line n) | |
4354 (move-to-column col t) | |
4355 (artist-key-do-continously-common)))) | |
4356 | |
4357 (defun artist-backward-char (&optional n) | |
4358 "Move cursor backward optional N chars (default is 1), updating curr shape. | |
4359 If N is negative, move forward." | |
4360 (interactive "p") | |
4361 (if (> n 0) | |
4362 (artist-forward-char (- n)) | |
4363 (artist-forward-char n))) | |
4364 | |
4365 (defun artist-forward-char (&optional n) | |
4366 "Move cursor forward optional N chars (default is 1), updating curr shape. | |
4367 If N is negative, move backward." | |
4368 (interactive "p") | |
4369 (let* ((step-x (if (>= n 0) 1 -1)) | |
4370 (distance (abs n)) | |
4371 (curr-col (artist-current-column)) | |
4372 (new-col (max 0 (+ curr-col (* distance step-x))))) | |
4373 (if (not artist-key-is-drawing) | |
4374 (move-to-column new-col t) | |
4375 (move-to-column new-col t) | |
4376 (artist-key-do-continously-common)))) | |
4377 | |
4378 | |
4379 (defun artist-key-set-point (&optional arg) | |
4380 "Set a point for the current shape. With optional ARG, set the last point." | |
4381 (interactive "P") | |
4382 (artist-key-set-point-common arg)) | |
4383 | |
4384 | |
4385 (defun artist-select-fill-char (c) | |
4386 "Set current fill character to be C." | |
4387 (interactive "cType fill char (type RET to turn off): ") | |
4388 (cond ((eq c ?\r) (setq artist-fill-char-set nil) | |
4389 (message "Fill cancelled")) | |
4390 (t (setq artist-fill-char-set t) | |
4391 (setq artist-fill-char c) | |
4392 (message "Fill set to \"%c\"" c)))) | |
4393 | |
4394 | |
4395 (defun artist-select-line-char (c) | |
4396 "Set current line character to be C." | |
4397 (interactive "cType line char (type RET to turn off): ") | |
4398 (cond ((eq c ?\r) (setq artist-line-char-set nil) | |
4399 (message "Normal lines")) | |
4400 (t (setq artist-line-char-set t) | |
4401 (setq artist-line-char c) | |
4402 (message "Line drawn with \"%c\"" c))) | |
4403 (if artist-key-is-drawing | |
4404 (artist-key-do-continously-common))) | |
4405 | |
4406 | |
4407 (defun artist-select-erase-char (c) | |
4408 "Set current erase character to be C." | |
4409 (interactive "cType char to use when erasing (type RET for normal): ") | |
4410 (cond ((eq c ?\r) (setq artist-erase-char ?\ ) | |
4411 (message "Normal erasing")) | |
4412 (t (setq artist-erase-char c) | |
4413 (message "Erasing with \"%c\"" c))) | |
4414 (if artist-key-is-drawing | |
4415 (artist-key-do-continously-common))) | |
4416 | |
4417 (defun artist-charlist-to-string (char-list) | |
4418 "Convert a list of characters, CHAR-LIST, to a string." | |
4419 (let ((result "")) | |
4420 (while (not (null char-list)) | |
4421 (setq result (concat result (char-to-string (car char-list)))) | |
4422 (setq char-list (cdr char-list))) | |
4423 result)) | |
4424 | |
4425 (defun artist-string-to-charlist (str) | |
4426 "Convert a string, STR, to list of characters." | |
4427 (append str nil)) | |
4428 | |
4429 (defun artist-select-spray-chars (chars initial-char) | |
4430 "Set current spray characters to be CHARS, starting with INITIAL-CHAR." | |
4431 ;; This huge unreadable `interactive'-clause does the following | |
4432 ;; 1. Asks for a string of spray-characters | |
4433 ;; 2. Asks for the initial character (default is the first), | |
4434 ;; and loops if the answer is not a char within the string in 1. | |
4435 (interactive | |
4436 (let* ((str (read-string "Select spray-can characters, lightest first: " | |
4437 (artist-charlist-to-string artist-spray-chars))) | |
4438 (char-list (artist-string-to-charlist str)) | |
4439 (initial (let* ((err-msg "") | |
4440 (ok nil) | |
4441 (first-char-as-str (char-to-string (car char-list))) | |
4442 (first-s) (first-c)) | |
4443 (while (not ok) | |
4444 (setq first-s | |
4445 (read-string | |
4446 (format (concat "%sSelect initial-character, " | |
4447 "one of \"%s\" (%s): ") | |
4448 err-msg str first-char-as-str))) | |
4449 (if (equal first-s "") | |
4450 (setq first-s first-char-as-str)) | |
4451 (setq first-c (car (artist-string-to-charlist first-s))) | |
4452 (setq ok (not (null (member first-c char-list)))) | |
4453 (if (not ok) | |
4454 (setq err-msg (format | |
4455 "Not in spray-chars: \"%s\". " | |
4456 (char-to-string first-c))))) | |
4457 first-c))) | |
4458 (list char-list initial))) | |
4459 (setq artist-spray-chars chars) | |
4460 (setq artist-spray-new-char initial-char) | |
4461 (message "Spray-chars set to \"%s\", initial: \"%s\"" | |
4462 (artist-charlist-to-string chars) (char-to-string initial-char))) | |
4463 | |
4464 | |
4465 (defun artist-select-operation (op-str) | |
4466 "Select drawing operation OP-STR." | |
4467 (interactive (list (completing-read "Select operation: " | |
4468 artist-key-compl-table))) | |
4469 (let* ((op-symbol (artist-mt-get-symbol-from-keyword op-str)) | |
4470 (draw-how (if op-symbol | |
4471 (artist-go-get-draw-how-from-symbol op-symbol) | |
4472 nil))) | |
4473 ;; First check that the string was valid | |
4474 (if (null op-symbol) | |
4475 (error "Unknown drawing method: %s" op-str)) | |
4476 | |
4477 ;; Second, check that we are not about to switch to a different | |
4478 ;; kind of shape (do that only if we are drawing with keys; | |
4479 ;; otherwise this function cannot get called). | |
4480 (if (and artist-key-is-drawing | |
4481 (not (equal artist-key-draw-how draw-how))) | |
4482 (error "Cannot switch to a different kind of shape while drawing")) | |
4483 | |
4484 ;; If we were drawing, undraw the shape | |
4485 (if (and artist-key-is-drawing | |
4486 artist-rubber-banding) | |
4487 (artist-key-undraw-common)) | |
4488 | |
4489 ;; Set the current operation and draw-how | |
4490 (setq artist-curr-go op-symbol) | |
4491 (setq artist-key-draw-how draw-how) | |
4492 | |
4493 ;; If we were drawing, redraw the shape (but don't if shape | |
4494 ;; is drawn by setting only one point) | |
4495 (if (and artist-key-is-drawing | |
4496 artist-rubber-banding | |
4497 (not (eq artist-key-draw-how 1))) | |
4498 (artist-key-draw-common))) | |
4499 | |
4500 ;; Feedback | |
4501 (artist-mode-line-show-curr-operation artist-key-is-drawing)) | |
4502 | |
4503 | |
4504 (defun artist-toggle-rubber-banding (&optional state) | |
4505 "Toggle rubber-banding. | |
4506 If optional argument STATE is positive, turn rubber-banding on." | |
4507 (interactive) | |
4508 (if artist-key-is-drawing | |
4509 (error "Cannot toggle rubber-banding while drawing")) | |
4510 (if (setq artist-rubber-banding | |
4511 (if (null state) (not artist-rubber-banding) | |
4512 (> (prefix-numeric-value state) 0))) | |
4513 (message "Rubber-banding is now on") | |
4514 (message "Rubber-banding is now off"))) | |
4515 | |
4516 | |
4517 (defun artist-toggle-trim-line-endings (&optional state) | |
4518 "Toggle trimming of line-endings. | |
4519 If optional argument STATE is positive, turn trimming on." | |
4520 (interactive) | |
4521 (if (setq artist-trim-line-endings | |
4522 (if (null state) (not artist-trim-line-endings) | |
4523 (> (prefix-numeric-value state) 0))) | |
4524 (message "Trimming is now on") | |
4525 (message "Trimming is now off"))) | |
4526 | |
4527 | |
4528 (defun artist-toggle-borderless-shapes (&optional state) | |
4529 "Toggle borders of shapes. | |
4530 If optional argument STATE is positive, turn borders on." | |
4531 (interactive) | |
4532 (if (setq artist-borderless-shapes | |
4533 (if (null state) (not artist-borderless-shapes) | |
4534 (> (prefix-numeric-value state) 0))) | |
4535 (message "Borders are now off") | |
4536 (message "Borders are now on"))) | |
4537 | |
4538 | |
4539 (defun artist-toggle-first-arrow () | |
4540 "Toggle first arrow for shape, if possible." | |
4541 (interactive) | |
4542 (save-excursion | |
4543 (if (not (null artist-arrow-point-1)) | |
4544 (let* ((arrow-point artist-arrow-point-1) | |
4545 (arrow-state (artist-arrow-point-get-state arrow-point)) | |
4546 (arrow-marker (artist-arrow-point-get-marker arrow-point)) | |
4547 (direction (artist-arrow-point-get-direction arrow-point)) | |
4548 (orig-char (artist-arrow-point-get-orig-char arrow-point)) | |
4549 (arrow-char (aref artist-arrows direction)) | |
4550 (new-state (not arrow-state))) | |
4551 | |
4552 (goto-char (marker-position arrow-marker)) | |
4553 | |
4554 (if new-state | |
4555 (if arrow-char | |
4556 (artist-replace-char arrow-char)) | |
4557 (artist-replace-char orig-char)) | |
4558 | |
4559 (artist-arrow-point-set-state artist-arrow-point-1 new-state))))) | |
4560 | |
4561 (defun artist-toggle-second-arrow () | |
4562 "Toggle second arrow for shape, if possible." | |
4563 (interactive) | |
4564 (save-excursion | |
4565 (if (not (null artist-arrow-point-2)) | |
4566 (let* ((arrow-point artist-arrow-point-2) | |
4567 (arrow-state (artist-arrow-point-get-state arrow-point)) | |
4568 (arrow-marker (artist-arrow-point-get-marker arrow-point)) | |
4569 (direction (artist-arrow-point-get-direction arrow-point)) | |
4570 (orig-char (artist-arrow-point-get-orig-char arrow-point)) | |
4571 (arrow-char (aref artist-arrows direction)) | |
4572 (new-state (not arrow-state))) | |
4573 | |
4574 (goto-char (marker-position arrow-marker)) | |
4575 | |
4576 (if new-state | |
4577 (if arrow-char | |
4578 (artist-replace-char arrow-char)) | |
4579 (artist-replace-char orig-char)) | |
4580 | |
4581 (artist-arrow-point-set-state artist-arrow-point-2 new-state))))) | |
4582 | |
4583 | |
4584 (defun artist-select-op-line () | |
4585 "Select drawing lines." | |
4586 (interactive) | |
4587 (artist-select-operation "line")) | |
4588 | |
4589 (defun artist-select-op-straight-line () | |
4590 "Select drawing straight lines." | |
4591 (interactive) | |
4592 (artist-select-operation "straight line")) | |
4593 | |
4594 (defun artist-select-op-rectangle () | |
4595 "Select drawing rectangles." | |
4596 (interactive) | |
4597 (artist-select-operation "rectangle")) | |
4598 | |
4599 (defun artist-select-op-square () | |
4600 "Select drawing squares." | |
4601 (interactive) | |
4602 (artist-select-operation "square")) | |
4603 | |
4604 (defun artist-select-op-poly-line () | |
4605 "Select drawing poly-lines." | |
4606 (interactive) | |
4607 (artist-select-operation "poly-line")) | |
4608 | |
4609 (defun artist-select-op-straight-poly-line () | |
4610 "Select drawing straight poly-lines." | |
4611 (interactive) | |
4612 (artist-select-operation "straight poly-line")) | |
4613 | |
4614 (defun artist-select-op-ellipse () | |
4615 "Select drawing ellipses." | |
4616 (interactive) | |
4617 (artist-select-operation "ellipse")) | |
4618 | |
4619 (defun artist-select-op-circle () | |
4620 "Select drawing circles." | |
4621 (interactive) | |
4622 (artist-select-operation "circle")) | |
4623 | |
4624 (defun artist-select-op-text-see-thru () | |
4625 "Select rendering text (see thru)." | |
4626 (interactive) | |
4627 (artist-select-operation "text see-thru")) | |
4628 | |
4629 (defun artist-select-op-text-overwrite () | |
4630 "Select rendering text (overwrite)." | |
4631 (interactive) | |
4632 (artist-select-operation "text overwrite")) | |
4633 | |
4634 (defun artist-select-op-spray-can () | |
4635 "Select spraying." | |
4636 (interactive) | |
4637 (artist-select-operation "spray-can")) | |
4638 | |
4639 (defun artist-select-op-spray-set-size () | |
4640 "Select setting size for spraying." | |
4641 (interactive) | |
4642 (artist-select-operation "spray set size")) | |
4643 | |
4644 (defun artist-select-op-erase-char () | |
4645 "Select erasing characters." | |
4646 (interactive) | |
4647 (artist-select-operation "erase char")) | |
4648 | |
4649 (defun artist-select-op-erase-rectangle () | |
4650 "Select erasing rectangles." | |
4651 (interactive) | |
4652 (artist-select-operation "erase rectangle")) | |
4653 | |
4654 (defun artist-select-op-vaporize-line () | |
4655 "Select vaporizing single lines." | |
4656 (interactive) | |
4657 (artist-select-operation "vaporize line")) | |
4658 | |
4659 (defun artist-select-op-vaporize-lines () | |
4660 "Select vaporizing connected lines." | |
4661 (interactive) | |
4662 (artist-select-operation "vaporize lines")) | |
4663 | |
4664 (defun artist-select-op-cut-rectangle () | |
4665 "Select cutting rectangles." | |
4666 (interactive) | |
4667 (artist-select-operation "cut rectangle")) | |
4668 | |
4669 (defun artist-select-op-cut-square () | |
4670 "Select cutting squares." | |
4671 (interactive) | |
4672 (artist-select-operation "cut square")) | |
4673 | |
4674 (defun artist-select-op-copy-rectangle () | |
4675 "Select copying rectangles." | |
4676 (interactive) | |
4677 (artist-select-operation "copy rectangle")) | |
4678 | |
4679 (defun artist-select-op-copy-square () | |
4680 "Select copying squares." | |
4681 (interactive) | |
4682 (artist-select-operation "cut square")) | |
4683 | |
4684 (defun artist-select-op-paste () | |
4685 "Select pasting." | |
4686 (interactive) | |
4687 (artist-select-operation "paste")) | |
4688 | |
4689 (defun artist-select-op-flood-fill () | |
4690 "Select flood-filling." | |
4691 (interactive) | |
4692 (artist-select-operation "flood-fill")) | |
4693 | |
4694 | |
4695 ;; Drawing lines by using mouse | |
4696 ;; Mouse button actions | |
4697 ;; | |
4698 | |
4699 (defun artist-update-pointer-shape () | |
4700 "Perform the update of the X Windows pointer shape." | |
4701 (set-mouse-color nil)) | |
4702 | |
4703 (defun artist-set-pointer-shape (new-pointer-shape) | |
4704 "Set the shape of the X Windows pointer to NEW-POINTER-SHAPE." | |
4705 (setq x-pointer-shape new-pointer-shape) | |
4706 (artist-update-pointer-shape)) | |
4707 | |
4708 (defsubst artist-event-is-shifted (ev) | |
4709 "Check whether the shift-key is pressed in event EV." | |
4710 (memq 'shift (event-modifiers ev))) | |
4711 | |
4712 (defun artist-do-nothing () | |
4713 "Function that does nothing." | |
4714 (interactive)) | |
4715 | |
4716 (defun artist-down-mouse-1 (ev) | |
4717 "Perform drawing action for event EV." | |
4718 (interactive "@e") | |
4719 (let* ((real (artist-go-get-symbol-shift | |
4720 artist-curr-go (artist-event-is-shifted ev))) | |
4721 (draw-how (artist-go-get-draw-how-from-symbol real)) | |
4722 ;; Remember original values for draw-region-min-y and max-y | |
4723 ;; in case we are interrupting a key-draw operation. | |
4724 (orig-draw-region-min-y artist-draw-region-min-y) | |
4725 (orig-draw-region-max-y artist-draw-region-max-y) | |
4726 (orig-pointer-shape (if (eq window-system 'x) x-pointer-shape nil)) | |
4727 (echo-keystrokes 10000) ; a lot of seconds | |
4728 ;; Remember original binding for the button-up event to this | |
4729 ;; button-down event. | |
4730 (key (let* ((basic (event-basic-type ev)) | |
4731 (unshifted basic) | |
4732 (shifted (make-symbol (concat "S-" (symbol-name basic))))) | |
4733 (if (artist-event-is-shifted ev) | |
4734 (make-vector 1 shifted) | |
4735 (make-vector 1 unshifted)))) | |
4736 (orig-button-up-binding (lookup-key (current-global-map) key))) | |
4737 | |
4738 (unwind-protect | |
4739 (progn | |
4740 (if (eq window-system 'x) | |
4741 (artist-set-pointer-shape artist-pointer-shape)) | |
4742 | |
47953
126b6cb8740d
(artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents:
46163
diff
changeset
|
4743 ;; Redefine the button-up binding temporarily (the original |
33618 | 4744 ;; binding is restored in the unwind-forms below). This is to |
4745 ;; avoid the phenomenon outlined in this scenario: | |
4746 ;; | |
4747 ;; 1. A routine which reads something from the mini-buffer (such | |
4748 ;; as the text renderer) is called from below. | |
4749 ;; 2. Meanwhile, the users releases the mouse button. | |
47953
126b6cb8740d
(artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents:
46163
diff
changeset
|
4750 ;; 3. As a (funny :-) coincidence, the binding for the |
33618 | 4751 ;; button-up event is often mouse-set-point, so Emacs |
4752 ;; sets the point to where the button was released, which is | |
4753 ;; in the buffer where the user wants to place the text. | |
4754 ;; 4. The user types C-x o (or uses the mouse once again) | |
4755 ;; until he reaches the mini-buffer which is still prompting | |
4756 ;; for some text to render. | |
4757 ;; | |
4758 ;; To do this foolproof, all local and minor-mode maps should | |
4759 ;; be searched and temporarily changed as well, since they | |
4760 ;; too might have some binding for the button-up event, | |
4761 ;; but I hope dealing with the global map will suffice. | |
4762 (define-key (current-global-map) key 'artist-do-nothing) | |
4763 | |
4764 (artist-draw-region-reset) | |
4765 | |
4766 (artist-mode-line-show-curr-operation t) | |
4767 | |
4768 (cond ((eq draw-how 'artist-do-continously) | |
4769 (artist-mouse-draw-continously ev)) | |
4770 ((eq draw-how 'artist-do-poly) | |
4771 (artist-mouse-draw-poly ev)) | |
4772 ((and (numberp draw-how) (= draw-how 1)) | |
4773 (artist-mouse-draw-1point ev)) | |
4774 ((and (numberp draw-how) (= draw-how 2)) | |
4775 (artist-mouse-draw-2points ev)) | |
4776 (t (message "Drawing \"%s\"s is not yet implemented" | |
4777 draw-how))) | |
4778 | |
4779 (if artist-trim-line-endings | |
4780 (artist-draw-region-trim-line-endings artist-draw-region-min-y | |
4781 artist-draw-region-max-y)) | |
4782 (setq artist-draw-region-min-y orig-draw-region-min-y) | |
4783 (setq artist-draw-region-max-y orig-draw-region-max-y)) | |
4784 | |
4785 ; This is protected | |
4786 (if (eq window-system 'x) | |
4787 (artist-set-pointer-shape orig-pointer-shape)) | |
4788 | |
4789 (if orig-button-up-binding | |
4790 (define-key (current-global-map) key orig-button-up-binding)) | |
4791 | |
4792 (artist-mode-line-show-curr-operation artist-key-is-drawing)))) | |
4793 | |
4794 | |
4795 (defun artist-mouse-choose-operation (ev op) | |
4796 "Choose operation for evenvt EV and operation OP." | |
4797 (interactive | |
4798 (progn | |
4799 (select-window (posn-window (event-start last-input-event))) | |
4800 (list last-input-event | |
4801 (x-popup-menu last-nonmenu-event artist-popup-menu-table)))) | |
4802 | |
4803 (let ((draw-fn (artist-go-get-draw-fn-from-symbol (car op))) | |
4804 (set-fn (artist-fc-get-fn-from-symbol (car op)))) | |
4805 (cond | |
4806 | |
4807 ;; *** It was a draw-function | |
4808 ((not (listp draw-fn)) | |
4809 (let* ((unshifted (artist-go-get-symbol-shift (car op) nil)) | |
4810 (shifted (artist-go-get-symbol-shift (car op) t)) | |
4811 (shift-state (artist-event-is-shifted ev)) | |
4812 (selected-op (if shift-state shifted unshifted)) | |
4813 (keyword (artist-go-get-keyword-from-symbol selected-op))) | |
4814 (artist-select-operation keyword))) | |
4815 | |
4816 ;; *** It was a set/unset function | |
4817 ((not (listp set-fn)) | |
4818 (call-interactively set-fn))))) | |
4819 | |
4820 | |
4821 (defun artist-down-mouse-3 (ev) | |
4822 "Erase character or rectangle, depending on event EV." | |
4823 (interactive "@e") | |
4824 (let ((artist-curr-go 'erase-char)) | |
4825 (artist-down-mouse-1 ev)) | |
4826 ;; Restore mode-line | |
4827 (artist-mode-line-show-curr-operation artist-key-is-drawing)) | |
4828 | |
4829 | |
4830 ;; | |
4831 ;; Mouse routines | |
4832 ;; | |
4833 | |
4834 (defsubst artist-shift-has-changed (shift-state ev) | |
4835 "From the last SHIFT-STATE and EV, determine if the shift-state has changed." | |
4836 ;; This one simply doesn't work. | |
4837 ;; | |
4838 ;; There seems to be no way to tell whether the user has pressed shift | |
4839 ;; while dragging the cursor around when we are in a track-mouse | |
4840 ;; form. Calling (event-modifiers ev) yields nil :-( Neither is the | |
4841 ;; (event-basic-type ev) of any help (it is simply `mouse-movement'). | |
4842 ;; | |
4843 ;; So this doesn't work: | |
4844 ;; (cond ((and shift-state (not (artist-event-is-shifted ev))) t) | |
4845 ;; ((and (not shift-state) (artist-event-is-shifted ev)) t) | |
4846 ;; (t nil)) | |
4847 nil) | |
4848 | |
4849 (defun artist-coord-win-to-buf (coord) | |
4850 "Convert a window-relative coordinate COORD to a buffer-relative coordinate." | |
4851 (let ((window-x (car coord)) | |
4852 (window-y (cdr coord)) | |
4853 (window-start-x (window-hscroll)) | |
4854 (window-start-y (save-excursion (goto-char (window-start)) | |
4855 (artist-current-line)))) | |
4856 (cons (+ window-x window-start-x) | |
4857 (+ window-y window-start-y)))) | |
4858 | |
4859 | |
4860 (defun artist-mouse-draw-continously (ev) | |
4861 "Generic function for shapes that requires 1 point as input. | |
4862 Operation is done continously while the mouse button is hold down. | |
4863 The event, EV, is the mouse event." | |
4864 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil)) | |
4865 (shifted (artist-go-get-symbol-shift artist-curr-go t)) | |
4866 (shift-state (artist-event-is-shifted ev)) | |
4867 (op (if shift-state shifted unshifted)) | |
4868 (draw-how (artist-go-get-draw-how-from-symbol op)) | |
4869 (init-fn (artist-go-get-init-fn-from-symbol op)) | |
4870 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op)) | |
4871 (exit-fn (artist-go-get-exit-fn-from-symbol op)) | |
4872 (draw-fn (artist-go-get-draw-fn-from-symbol op)) | |
4873 (interval-fn (artist-go-get-interval-fn-from-symbol op)) | |
4874 (interval (artist-funcall interval-fn)) | |
4875 (arrow-pred (artist-go-get-arrow-pred-from-symbol op)) | |
4876 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op)) | |
4877 (ev-start (event-start ev)) | |
4878 (initial-win (posn-window ev-start)) | |
4879 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start))) | |
4880 (x1 (car ev-start-pos)) | |
4881 (y1 (cdr ev-start-pos)) | |
4882 (shape) | |
4883 (timer)) | |
4884 (select-window (posn-window ev-start)) | |
4885 (artist-funcall init-fn x1 y1) | |
4886 (if (not artist-rubber-banding) | |
4887 (artist-no-rb-set-point1 x1 y1)) | |
4888 (track-mouse | |
4889 (while (or (mouse-movement-p ev) | |
4890 (member 'down (event-modifiers ev))) | |
4891 (setq ev-start-pos (artist-coord-win-to-buf | |
4892 (posn-col-row (event-start ev)))) | |
4893 (setq x1 (car ev-start-pos)) | |
4894 (setq y1 (cdr ev-start-pos)) | |
4895 | |
4896 ;; Cancel previous timer | |
4897 (if timer | |
4898 (cancel-timer timer)) | |
4899 | |
4900 (if (not (eq initial-win (posn-window (event-start ev)))) | |
4901 ;; If we moved outside the window, do nothing | |
4902 nil | |
4903 | |
4904 ;; Still in same window: | |
4905 ;; | |
4906 ;; Check if user presses or releases shift key | |
4907 (if (artist-shift-has-changed shift-state ev) | |
4908 | |
4909 ;; First check that the draw-how is the same as we | |
4910 ;; already have. Otherwise, ignore the changed shift-state. | |
4911 (if (not (eq draw-how | |
4912 (artist-go-get-draw-how-from-symbol | |
4913 (if (not shift-state) shifted unshifted)))) | |
4914 (message "Cannot switch to shifted operation") | |
4915 | |
4916 ;; progn is "implicit" since this is the else-part | |
4917 (setq shift-state (not shift-state)) | |
4918 (setq op (if shift-state shifted unshifted)) | |
4919 (setq draw-how (artist-go-get-draw-how-from-symbol op)) | |
4920 (setq draw-fn (artist-go-get-draw-fn-from-symbol op)))) | |
4921 | |
4922 ;; Draw the new shape | |
4923 (setq shape (artist-funcall draw-fn x1 y1)) | |
4924 (artist-move-to-xy x1 y1) | |
4925 | |
4926 ;; Start the timer to call `draw-fn' repeatedly every | |
4927 ;; `interval' second | |
4928 (if (and interval draw-fn) | |
4929 (setq timer (run-at-time interval interval draw-fn x1 y1)))) | |
4930 | |
4931 ;; Read next event | |
4932 (setq ev (read-event)))) | |
4933 | |
4934 ;; Cancel any timers | |
4935 (if timer | |
4936 (cancel-timer timer)) | |
4937 | |
4938 (artist-funcall prep-fill-fn x1 y1) | |
4939 | |
4940 (if (artist-funcall arrow-pred) | |
4941 (artist-funcall arrow-set-fn x1 y1) | |
4942 (artist-clear-arrow-points)) | |
4943 | |
4944 (artist-funcall exit-fn x1 y1) | |
4945 (artist-move-to-xy x1 y1))) | |
4946 | |
4947 | |
4948 | |
4949 (defun artist-mouse-draw-poly (ev) | |
4950 "Generic function for shapes requiring several points as input. | |
4951 The event, EV, is the mouse event." | |
4952 (interactive "@e") | |
4953 (message "Mouse-1: set new point, mouse-2: set last point") | |
4954 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil)) | |
4955 (shifted (artist-go-get-symbol-shift artist-curr-go t)) | |
4956 (shift-state (artist-event-is-shifted ev)) | |
4957 (op (if shift-state shifted unshifted)) | |
4958 (draw-how (artist-go-get-draw-how-from-symbol op)) | |
4959 (init-fn (artist-go-get-init-fn-from-symbol op)) | |
4960 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op)) | |
4961 (exit-fn (artist-go-get-exit-fn-from-symbol op)) | |
4962 (draw-fn (artist-go-get-draw-fn-from-symbol op)) | |
4963 (undraw-fn (artist-go-get-undraw-fn-from-symbol op)) | |
4964 (fill-pred (artist-go-get-fill-pred-from-symbol op)) | |
4965 (fill-fn (artist-go-get-fill-fn-from-symbol op)) | |
4966 (arrow-pred (artist-go-get-arrow-pred-from-symbol op)) | |
4967 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op)) | |
4968 (ev-start (event-start ev)) | |
4969 (initial-win (posn-window ev-start)) | |
4970 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start))) | |
4971 (x1-last (car ev-start-pos)) | |
4972 (y1-last (cdr ev-start-pos)) | |
4973 (x2 x1-last) | |
4974 (y2 y1-last) | |
4975 (is-down t) | |
4976 (shape nil) | |
40323 | 4977 (point-list nil) |
33618 | 4978 (done nil)) |
4979 (select-window (posn-window ev-start)) | |
4980 (artist-funcall init-fn x1-last y1-last) | |
4981 (if (not artist-rubber-banding) | |
4982 (artist-no-rb-set-point1 x1-last y1-last)) | |
4983 (track-mouse | |
4984 (while (not done) | |
4985 ;; decide what to do | |
4986 (cond | |
4987 | |
4988 ;; *** Mouse button is released. | |
4989 ((and is-down | |
4990 (or (member 'click (event-modifiers ev)) | |
4991 (member 'drag (event-modifiers ev)))) | |
4992 ;; First, if not rubber-banding, draw the line. | |
4993 ;; | |
4994 (if (not artist-rubber-banding) | |
4995 (progn | |
4996 (artist-no-rb-unset-points) | |
4997 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2)))) | |
4998 | |
4999 ;; Set the second point to the shape's second point | |
5000 ;; (which might be different from the mouse's second point, | |
5001 ;; if, for example, we are drawing a straight line) | |
5002 ;; | |
5003 (if (not (null shape)) | |
5004 (let ((endpoint2 (artist-2point-get-endpoint2 shape))) | |
5005 (setq x1-last (artist-endpoint-get-x endpoint2)) | |
5006 (setq y1-last (artist-endpoint-get-y endpoint2)))) | |
5007 (setq point-list (cons (artist-make-endpoint x1-last y1-last) | |
5008 point-list)) | |
5009 (setq shape nil) | |
5010 (setq is-down nil)) | |
5011 | |
5012 ;; *** Mouse button 2 or 3 down | |
5013 ((and (member 'down (event-modifiers ev)) | |
5014 (or (equal (event-basic-type ev) 'mouse-2) | |
5015 (equal (event-basic-type ev) 'mouse-3))) | |
5016 ;; Ignore | |
5017 nil) | |
5018 | |
5019 ;; *** Mouse button 2 or 3 released | |
5020 ((and (or (member 'click (event-modifiers ev)) | |
5021 (member 'drag (event-modifiers ev))) | |
5022 (or (equal (event-basic-type ev) 'mouse-2) | |
5023 (equal (event-basic-type ev) 'mouse-3))) | |
5024 | |
5025 ;; This means the end of our poly-line drawing-session. | |
5026 ;; | |
5027 (setq done t)) | |
5028 | |
5029 ;; *** Mouse button 1 went down | |
5030 ((and (not is-down) | |
5031 (member 'down (event-modifiers ev)) | |
5032 (equal (event-basic-type ev) 'mouse-1)) | |
5033 ;; Check whether the (possibly new, that depends on if shift | |
5034 ;; has been pressed or released) symbol has the same draw-how | |
5035 ;; information as the previous had. If it hasn't, we can't | |
5036 ;; proceed. | |
5037 ;; | |
5038 (if (not (eq draw-how | |
5039 (artist-go-get-draw-how-from-symbol | |
5040 (if (not shift-state) shifted unshifted)))) | |
5041 (message "Cannot switch operation") | |
5042 (progn | |
5043 ;; Decide operation | |
5044 ;; | |
5045 (setq unshifted | |
5046 (artist-go-get-symbol-shift artist-curr-go nil) | |
5047 shifted | |
5048 (artist-go-get-symbol-shift artist-curr-go t) | |
5049 shift-state (artist-event-is-shifted ev) | |
5050 op (if shift-state shifted unshifted) | |
5051 draw-how (artist-go-get-draw-how-from-symbol op) | |
5052 draw-fn (artist-go-get-draw-fn-from-symbol op) | |
5053 undraw-fn (artist-go-get-undraw-fn-from-symbol op) | |
5054 fill-pred (artist-go-get-fill-pred-from-symbol op) | |
5055 fill-fn (artist-go-get-fill-fn-from-symbol op)) | |
5056 | |
5057 ;; Draw shape from last place to this place | |
5058 | |
5059 ;; set x2 and y2 | |
5060 ;; | |
5061 (setq ev-start-pos (artist-coord-win-to-buf | |
5062 (posn-col-row (event-start ev)))) | |
5063 (setq x2 (car ev-start-pos)) | |
5064 (setq y2 (cdr ev-start-pos)) | |
5065 | |
5066 ;; Draw the new shape (if not rubber-banding, place both marks) | |
5067 ;; | |
5068 (if artist-rubber-banding | |
5069 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2)) | |
5070 (progn | |
5071 (artist-no-rb-set-point1 x1-last y1-last) | |
5072 (artist-no-rb-set-point2 x2 y2))) | |
5073 | |
5074 ;; Show new operation in mode-line | |
5075 (let ((artist-curr-go op)) | |
5076 (artist-mode-line-show-curr-operation t)))) | |
5077 | |
5078 (setq is-down t)) | |
5079 | |
5080 | |
5081 ;; *** Mouse moved, button is down and we are still in orig window | |
5082 ((and (mouse-movement-p ev) | |
5083 is-down | |
5084 (eq initial-win (posn-window (event-start ev)))) | |
5085 ;; Draw shape from last place to this place | |
5086 ;; | |
5087 ;; set x2 and y2 | |
5088 (setq ev-start-pos (artist-coord-win-to-buf | |
5089 (posn-col-row (event-start ev)))) | |
5090 (setq x2 (car ev-start-pos)) | |
5091 (setq y2 (cdr ev-start-pos)) | |
5092 | |
5093 ;; First undraw last shape | |
5094 ;; (unset last point if not rubberbanding) | |
5095 ;; | |
5096 (artist-funcall undraw-fn shape) | |
5097 | |
5098 ;; Draw the new shape (if not rubberbanding, set 2nd mark) | |
5099 ;; | |
5100 (if artist-rubber-banding | |
5101 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2)) | |
5102 (progn | |
5103 (artist-no-rb-unset-point2) | |
5104 (artist-no-rb-set-point2 x2 y2))) | |
5105 ;; Move cursor | |
5106 (artist-move-to-xy x2 y2)) | |
5107 | |
5108 ;; *** Mouse moved, button is down but we are NOT in orig window | |
5109 ((and (mouse-movement-p ev) | |
5110 is-down | |
5111 (not (eq initial-win (posn-window (event-start ev))))) | |
5112 ;; Ignore | |
5113 nil) | |
5114 | |
5115 | |
5116 ;; *** Moving mouse while mouse button is not down | |
5117 ((and (mouse-movement-p ev) (not is-down)) | |
5118 ;; don't do anything. | |
5119 nil) | |
5120 | |
5121 | |
5122 ;; *** Mouse button 1 went down, first time | |
5123 ((and is-down | |
5124 (member 'down (event-modifiers ev)) | |
5125 (equal (event-basic-type ev) 'mouse-1)) | |
5126 ;; don't do anything | |
5127 nil) | |
5128 | |
5129 | |
5130 ;; *** Another event | |
5131 (t | |
5132 ;; End drawing | |
5133 ;; | |
5134 (setq done t))) | |
5135 | |
5136 ;; Read next event (only if we should not stop) | |
5137 (if (not done) | |
5138 (setq ev (read-event))))) | |
5139 | |
5140 ;; Reverse point-list (last points are cond'ed first) | |
5141 (setq point-list (reverse point-list)) | |
5142 | |
5143 (artist-funcall prep-fill-fn point-list) | |
5144 | |
5145 ;; Maybe fill | |
5146 (if (artist-funcall fill-pred) | |
5147 (artist-funcall fill-fn point-list)) | |
5148 | |
5149 ;; Maybe set arrow points | |
40323 | 5150 (if (and point-list (artist-funcall arrow-pred)) |
33618 | 5151 (artist-funcall arrow-set-fn point-list) |
5152 (artist-clear-arrow-points)) | |
5153 | |
5154 (artist-funcall exit-fn point-list) | |
5155 (artist-move-to-xy x2 y2))) | |
5156 | |
5157 | |
5158 (defun artist-mouse-draw-1point (ev) | |
5159 "Generic function for shapes requiring only 1 point as input. | |
5160 Operation is done once. The event, EV, is the mouse event." | |
5161 (interactive "@e") | |
5162 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil)) | |
5163 (shifted (artist-go-get-symbol-shift artist-curr-go t)) | |
5164 (shift-state (artist-event-is-shifted ev)) | |
5165 (op (if shift-state shifted unshifted)) | |
5166 (draw-how (artist-go-get-draw-how-from-symbol op)) | |
5167 (init-fn (artist-go-get-init-fn-from-symbol op)) | |
5168 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op)) | |
5169 (exit-fn (artist-go-get-exit-fn-from-symbol op)) | |
5170 (draw-fn (artist-go-get-draw-fn-from-symbol op)) | |
5171 (arrow-pred (artist-go-get-arrow-pred-from-symbol op)) | |
5172 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op)) | |
5173 (ev-start (event-start ev)) | |
5174 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start))) | |
5175 (x1 (car ev-start-pos)) | |
5176 (y1 (cdr ev-start-pos))) | |
5177 (select-window (posn-window ev-start)) | |
5178 (artist-funcall init-fn x1 y1) | |
5179 (artist-funcall draw-fn x1 y1) | |
5180 (artist-funcall prep-fill-fn x1 y1) | |
5181 (if (artist-funcall arrow-pred) | |
5182 (artist-funcall arrow-set-fn x1 y1) | |
5183 (artist-clear-arrow-points)) | |
5184 (artist-funcall exit-fn x1 y1) | |
5185 (artist-move-to-xy x1 y1))) | |
5186 | |
5187 | |
5188 (defun artist-mouse-draw-2points (ev) | |
5189 "Generic function for shapes requiring 2 points as input. | |
5190 The event, EV, is the mouse event." | |
5191 (interactive "@e") | |
5192 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil)) | |
5193 (shifted (artist-go-get-symbol-shift artist-curr-go t)) | |
5194 (shift-state (artist-event-is-shifted ev)) | |
5195 (op (if shift-state shifted unshifted)) | |
5196 (draw-how (artist-go-get-draw-how-from-symbol op)) | |
5197 (init-fn (artist-go-get-init-fn-from-symbol op)) | |
5198 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op)) | |
5199 (exit-fn (artist-go-get-exit-fn-from-symbol op)) | |
5200 (draw-fn (artist-go-get-draw-fn-from-symbol op)) | |
5201 (undraw-fn (artist-go-get-undraw-fn-from-symbol op)) | |
5202 (fill-pred (artist-go-get-fill-pred-from-symbol op)) | |
5203 (fill-fn (artist-go-get-fill-fn-from-symbol op)) | |
5204 (arrow-pred (artist-go-get-arrow-pred-from-symbol op)) | |
5205 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op)) | |
5206 (ev-start (event-start ev)) | |
5207 (initial-win (posn-window ev-start)) | |
5208 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start))) | |
5209 (x1 (car ev-start-pos)) | |
5210 (y1 (cdr ev-start-pos)) | |
5211 (x2) | |
5212 (y2) | |
5213 (shape)) | |
5214 (select-window (posn-window ev-start)) | |
5215 (artist-funcall init-fn x1 y1) | |
5216 (if (not artist-rubber-banding) | |
5217 (artist-no-rb-set-point1 x1 y1)) | |
5218 (track-mouse | |
5219 (while (or (mouse-movement-p ev) | |
5220 (member 'down (event-modifiers ev))) | |
5221 (setq ev-start-pos (artist-coord-win-to-buf | |
5222 (posn-col-row (event-start ev)))) | |
5223 (setq x2 (car ev-start-pos)) | |
5224 (setq y2 (cdr ev-start-pos)) | |
5225 | |
5226 (if (not (eq initial-win (posn-window (event-start ev)))) | |
5227 ;; If we moved outside the window, do nothing | |
5228 nil | |
5229 | |
5230 ;; Still in same window: | |
5231 ;; | |
5232 ;; First undraw last shape (unset last point if not rubberbanding) | |
5233 (if artist-rubber-banding | |
5234 (artist-funcall undraw-fn shape) | |
5235 (artist-no-rb-unset-point2)) | |
5236 | |
5237 ;; Check if user presses or releases shift key | |
5238 (if (artist-shift-has-changed shift-state ev) | |
5239 | |
5240 ;; First check that the draw-how is the same as we | |
5241 ;; already have. Otherwise, ignore the changed shift-state. | |
5242 (if (not (eq draw-how | |
5243 (artist-go-get-draw-how-from-symbol | |
5244 (if (not shift-state) shifted unshifted)))) | |
5245 (message "Cannot switch to shifted operation") | |
5246 | |
5247 (message "Switching") | |
5248 ;; progn is "implicit" since this is the else-part | |
5249 (setq shift-state (not shift-state)) | |
5250 (setq op (if shift-state shifted unshifted)) | |
5251 (setq draw-how (artist-go-get-draw-how-from-symbol op)) | |
5252 (setq draw-fn (artist-go-get-draw-fn-from-symbol op)) | |
5253 (setq undraw-fn (artist-go-get-undraw-fn-from-symbol op)) | |
5254 (setq fill-pred (artist-go-get-fill-pred-from-symbol op)) | |
5255 (setq fill-fn (artist-go-get-fill-fn-from-symbol op)))) | |
5256 | |
5257 ;; Draw the new shape | |
5258 (if artist-rubber-banding | |
5259 (setq shape (artist-funcall draw-fn x1 y1 x2 y2)) | |
5260 (artist-no-rb-set-point2 x2 y2)) | |
5261 ;; Move cursor | |
5262 (artist-move-to-xy x2 y2)) | |
5263 | |
5264 | |
5265 ;; Read next event | |
5266 (setq ev (read-event)))) | |
5267 | |
5268 ;; If we are not rubber-banding (that is, we were moving around the `2') | |
5269 ;; draw the shape | |
5270 (if (not artist-rubber-banding) | |
5271 (progn | |
5272 (artist-no-rb-unset-points) | |
5273 (setq shape (artist-funcall draw-fn x1 y1 x2 y2)))) | |
5274 | |
5275 (artist-funcall prep-fill-fn shape x1 y1 x2 y2) | |
5276 | |
5277 ;; Maybe fill | |
5278 (if (artist-funcall fill-pred) | |
5279 (artist-funcall fill-fn shape x1 y1 x2 y2)) | |
5280 | |
5281 ;; Maybe set arrow-points | |
5282 (if (artist-funcall arrow-pred) | |
5283 (artist-funcall arrow-set-fn shape x1 y1 x2 y2) | |
5284 (artist-clear-arrow-points)) | |
5285 | |
5286 (artist-funcall exit-fn shape x1 y1 x2 y2) | |
5287 (artist-move-to-xy x2 y2))) | |
5288 | |
5289 | |
5290 ;; | |
5291 ;; Bug-report-submitting | |
5292 ;; | |
5293 (defun artist-submit-bug-report () | |
5294 "Submit via mail a bug report on Artist." | |
5295 (interactive) | |
5296 (require 'reporter) | |
5297 (if (y-or-n-p "Do you want to submit a bug report on Artist? ") | |
5298 (let ((to artist-maintainer-address) | |
5299 (vars '(window-system | |
5300 window-system-version | |
5301 ;; | |
5302 artist-rubber-banding | |
5303 artist-interface-with-rect | |
5304 artist-aspect-ratio | |
5305 ;; Now the internal ones | |
5306 artist-curr-go | |
5307 artist-key-poly-point-list | |
5308 artist-key-shape | |
5309 artist-key-draw-how | |
5310 artist-arrow-point-1 | |
5311 artist-arrow-point-2))) | |
5312 ;; Remove those variables from vars that are not bound | |
5313 (mapcar | |
5314 (function | |
5315 (lambda (x) | |
5316 (if (not (and (boundp x) (symbol-value x))) | |
5317 (setq vars (delq x vars))))) vars) | |
5318 (reporter-submit-bug-report | |
5319 artist-maintainer-address | |
5320 (concat "artist.el " artist-version) | |
5321 vars | |
5322 nil nil | |
5323 (concat "Hello Tomas,\n\n" | |
5324 "I have a nice bug report on Artist for you! Here it is:"))))) | |
5325 | |
5326 | |
5327 ;; | |
5328 ;; Now provide this minor mode | |
5329 ;; | |
5330 | |
5331 (provide 'artist) | |
5332 | |
5333 | |
5334 ;;; About adding drawing modes | |
5335 ;;; -------------------------- | |
5336 | |
5337 ;; If you are going to add a new drawing mode, read the following | |
5338 ;; sketchy outlines to get started a bit easier. | |
5339 ;; | |
5340 ;; 1. If your new drawing mode falls into one of the following | |
5341 ;; categories, goto point 2, otherwise goto point 3. | |
5342 ;; | |
5343 ;; - Modes where the shapes are drawn continously, as long as | |
5344 ;; the mouse button is held down (continous modes). | |
5345 ;; Example: the erase-char mode, the pen and pen-line modes. | |
5346 ;; | |
5347 ;; - Modes where the shape is made up of from 2 points to an | |
5348 ;; arbitrary number of points (poly-point modes). | |
5349 ;; Example: the poly-line mode | |
5350 ;; | |
5351 ;; - Modes where the shape is made up of 2 points (2-point | |
5352 ;; modes). | |
5353 ;; Example: lines, rectangles | |
5354 ;; | |
5355 ;; - Modes where the shape is made up of 1 point (1-point | |
5356 ;; modes). This mode differs from the continous modes in | |
5357 ;; that the shape is drawn only once when the mouse button | |
5358 ;; is pressed. | |
5359 ;; Examples: paste, a flood-fill, vaporize modes | |
5360 ;; | |
5361 ;; | |
5362 ;; 2. To make it easier and more flexible to program new drawing | |
5363 ;; modes, you might choose to specify | |
5364 ;; init-fn: a function to be called at the very beginning | |
5365 ;; of the drawing phase, | |
5366 ;; prep-fill-fn: a function to be called before filling, | |
5367 ;; arrow-set-fn: a function for setting arrows, to be called | |
5368 ;; after filling, and | |
5369 ;; exit-fn: a function to be called at the very end of | |
5370 ;; the drawing phase. | |
5371 ;; For each of the cases below, the arguments given to the init-fn, | |
5372 ;; prep-fill-fn, arrow-set-fn and exit-fn are stated. | |
5373 ;; | |
5374 ;; If your mode matches the continous mode or the 1-point mode: | |
5375 ;; | |
5376 ;; a. Create a draw-function that draws your shape. Your function | |
5377 ;; must take x and y as arguments. The return value is not | |
5378 ;; used. | |
5379 ;; | |
5380 ;; b. Add your mode to the master table, `artist-mt'. | |
5381 ;; | |
5382 ;; init-fn: x y | |
5383 ;; prep-fill-fn: x y | |
5384 ;; arrow-set-fn: x y | |
5385 ;; exit-fn: x y | |
5386 ;; | |
5387 ;; If your mode matches the 2-point mode: | |
5388 ;; | |
5389 ;; a. Create one draw-function that draws your shape and one | |
5390 ;; undraw-function that undraws it. | |
5391 ;; | |
5392 ;; The draw-function must take x1, y1, x2 and y2 as | |
5393 ;; arguments. It must return a list with three elements: | |
5394 ;; Endpoint1: a vector [x1 y1] | |
5395 ;; Endpoint2: a vector [x2 y2] | |
5396 ;; Shapeinfo: all info necessary for your undraw-function to | |
5397 ;; be able to undraw the shape | |
5398 ;; Use the artist-endpoint-* accessors to create and inspect | |
5399 ;; the endpoints. | |
5400 ;; | |
5401 ;; If applicable, you must be able to draw your shape without | |
5402 ;; borders if the `artist-borderless-shapes' is non-nil. | |
5403 ;; See `artist-draw-rect' for an example. | |
5404 ;; | |
5405 ;; The undraw-function must take one argument: the list created | |
5406 ;; by your draw-function. The return value is not used. | |
5407 ;; | |
5408 ;; b. If you want to provide a fill-function, then create a | |
5409 ;; function that takes 5 arguments: the list created by your | |
5410 ;; draw-function, x1, y1, x2 and y2. The return value is not | |
5411 ;; used. | |
5412 ;; | |
5413 ;; c. Add your mode to the master table, `artist-mt'. | |
5414 ;; | |
5415 ;; init-fn: x1 y1 | |
5416 ;; prep-fill-fn: shape x1 y1 x2 y2 | |
5417 ;; arrow-set-fn: shape x1 y1 x2 y2 | |
5418 ;; exit-fn: shape x1 y1 x2 y2 | |
5419 ;; | |
5420 ;; If your mode matches the poly-point mode: | |
5421 ;; | |
5422 ;; a. Create one draw-function that draws your shape and one | |
5423 ;; undraw-function that undraws it. The draw- and | |
46163 | 5424 ;; undraw-functions are used to draw/undraw a segment of |
33618 | 5425 ;; your poly-point mode between 2 points. The draw- and |
5426 ;; undraw-functions are then really 2-point mode functions. | |
5427 ;; They must take the same arguments and return the same | |
5428 ;; values as those of the 2-point mode. | |
5429 ;; | |
5430 ;; If applicable, you must be able to draw your shape without | |
5431 ;; borders if the `artist-borderless-shapes' is non-nil. | |
5432 ;; See `artist-draw-rect' for an example. | |
5433 ;; | |
5434 ;; b. If you want to provide a fill-function, then create a | |
5435 ;; function that takes 1 argument: a list of points where each | |
5436 ;; point is a vector, [x, y]. | |
5437 ;; | |
5438 ;; c. Add your mode to the master table, `artist-mt'. | |
5439 ;; | |
5440 ;; init-fn: x1 y1 | |
5441 ;; prep-fill-fn: point-list | |
5442 ;; arrow-set-fn: point-list | |
5443 ;; exit-fn: point-list | |
5444 ;; | |
5445 ;; The arrow-set-fn must set the variables `artist-arrow-point-1' | |
5446 ;; and `artist-arrow-point-2'. If your mode does not take arrows, | |
5447 ;; you must set the variables to nil. Use the accessors | |
5448 ;; artist-arrow-point-* to create and inspect arrow-points. | |
5449 ;; | |
5450 ;; | |
5451 ;; 3. If your mode doesn't match any of the categories, you are facing | |
5452 ;; a bit more work, and I cannot be as detailed as above. Here is a | |
5453 ;; brief outline of what you have to do: | |
5454 ;; | |
5455 ;; a. Decide on a name for your type of mode. Let's assume that | |
5456 ;; you decided on `xxx'. Then you should use the draw-how | |
5457 ;; symbol artist-do-xxx. | |
5458 ;; | |
5459 ;; b. Create a function artist-mouse-draw-xxx for drawing with | |
5460 ;; mouse. It should be called from `artist-down-mouse-1'. | |
5461 ;; | |
5462 ;; The all coordinates must be converted from window-relative | |
5463 ;; to buffer relative before saved or handed over to | |
5464 ;; any other function. Converting is done with | |
5465 ;; the function `artist-coord-win-to-buf'. | |
5466 ;; | |
5467 ;; It must take care to the `artist-rubber-banding' variable | |
5468 ;; and perform rubber-banding accordingly. Use the | |
5469 ;; artist-no-rb-* functions if not rubber-banding. | |
5470 ;; | |
5471 ;; If applicable, you must be able to draw your shape without | |
5472 ;; borders if the `artist-borderless-shapes' is non-nil. | |
5473 ;; See `artist-draw-rect' for an example. | |
5474 ;; | |
5475 ;; You must call the init-fn, the prep-fill-fn, arrow-set-fn | |
5476 ;; and the exit-fn at the apropriate points. | |
5477 ;; | |
5478 ;; When artist-mouse-draw-xxx ends, the shape for your mode | |
5479 ;; must be completely drawn. | |
5480 ;; | |
5481 ;; c. Create functions for drawing with keys: | |
5482 ;; | |
5483 ;; - artist-key-set-point-xxx for setting a point in the | |
5484 ;; mode, to be called from `artist-key-set-point-common'. | |
5485 ;; | |
5486 ;; - artist-key-do-continously-xxx to be called from | |
5487 ;; `artist-key-do-continously-common' whenever the user | |
5488 ;; moves around. | |
5489 ;; | |
5490 ;; As for the artist-mouse-draw-xxx, these two functions must | |
5491 ;; take care to do rubber-banding, borderless shapes and to | |
5492 ;; set arrows. | |
5493 ;; | |
5494 ;; These functions should set the variable `artist-key-shape' | |
5495 ;; to the shape drawn. | |
5496 ;; | |
5497 ;; d. Create artist-key-draw-xxx and artist-key-undraw-xxx for | |
5498 ;; drawing and undrawing. These are needed when the user | |
5499 ;; switches operation to draw another shape of the same type | |
5500 ;; of drawing mode. | |
5501 ;; | |
5502 ;; You should provide these functions. You might think that | |
5503 ;; only you is using your type of mode, so noone will be able | |
5504 ;; to switch to another operation of the same type of mode, | |
5505 ;; but someone else might base a new drawing mode upon your | |
5506 ;; work. | |
5507 ;; | |
5508 ;; You must call the init-fn, the prep-fill-fn, arrow-set-fn | |
5509 ;; and the exit-fn at the apropriate points. | |
5510 ;; | |
5511 ;; e. Add your new mode to the master table, `artist-mt'. | |
5512 ;; | |
5513 ;; | |
5514 ;; Happy hacking! Please let me hear if you add any drawing modes! | |
5515 ;; Don't hesitate to ask me any questions. | |
5516 | |
5517 | |
38436
b174db545cfd
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
37825
diff
changeset
|
5518 ;;; artist.el ends here |