annotate lisp/textmodes/artist.el @ 55954:f2ed4a5f31ab

New file
author Jan Djärv <jan.h.d@swipnet.se>
date Sun, 06 Jun 2004 20:13:35 +0000
parents 812519af46fd
children f467c038c83e 4c90ffeb71c5
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1 ;;; artist.el --- draw ascii graphics with your mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3 ;; Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc.
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5 ;; Author: Tomas Abrahamsson <tab@lysator.liu.se>
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
6 ;; Maintainer: Tomas Abrahamsson <tab@lysator.liu.se>
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
7 ;; Keywords: mouse
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
8 ;; Version: 1.2.4
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
9 ;; Release-date: 25-Oct-2001
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
10 ;; Location: http://www.lysator.liu.se/~tab/artist/
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
11
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
12 ;; This file is part of GNU Emacs.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
13
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
14 ;; GNU Emacs is free software; you can redistribute it and/or modify
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
15 ;; it under the terms of the GNU General Public License as published by
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
16 ;; the Free Software Foundation; either version 2, or (at your option)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
17 ;; any later version.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
18
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
19 ;; GNU Emacs is distributed in the hope that it will be useful,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
22 ;; GNU General Public License for more details.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
23
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
24 ;; You should have received a copy of the GNU General Public License
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
27 ;; Boston, MA 02111-1307, USA.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
28
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
29 ;;; Commentary:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
30
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
31 ;; What is artist?
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
32 ;; ---------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
33 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
34 ;; Artist is an Emacs lisp package that allows you to draw lines,
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
35 ;; rectangles and ellipses by using your mouse and/or keyboard. The
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
36 ;; shapes are made up with the ascii characters |, -, / and \.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
37 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
38 ;; Features are:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
39 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
40 ;; * Intersecting: When a `|' intersects with a `-', a `+' is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
41 ;; drawn, like this: | \ /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
42 ;; --+-- X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
43 ;; | / \
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
44 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
45 ;; * Rubber-banding: When drawing lines you can interactively see the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
46 ;; result while holding the mouse button down and moving the mouse. If
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
47 ;; your machine is not fast enough (a 386 is a bit to slow, but a
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
48 ;; pentium is well enough), you can turn this feature off. You will
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
49 ;; then see 1's and 2's which mark the 1st and 2nd endpoint of the line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
50 ;; you are drawing.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
51 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
52 ;; * Drawing operations: The following drawing operations are implemented:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
53 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
54 ;; lines straight-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
55 ;; rectangles squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
56 ;; poly-lines straight poly-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
57 ;; ellipses circles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
58 ;; text (see-thru) text (overwrite)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
59 ;; spray-can setting size for spraying
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
60 ;; vaporize line vaporize lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
61 ;; erase characters erase rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
62 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
63 ;; Straight lines are lines that go horizontally, vertically or
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
64 ;; diagonally. Plain lines go in any direction. The operations in
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
65 ;; the right column are accessed by holding down the shift key while
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
66 ;; drawing.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
67 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
68 ;; It is possible to vaporize (erase) entire lines and connected lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
69 ;; (rectangles for example) as long as the lines being vaporized are
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
70 ;; straight and connected at their endpoints. Vaporizing is inspired
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
71 ;; by the drawrect package by Jari Aalto <jari.aalto@poboxes.com>.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
72 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
73 ;; * Flood-filling: You can fill any area with a certain character by
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
74 ;; flood-filling.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
75 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
76 ;; * Cut copy and paste: You can cut, copy and paste rectangular
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
77 ;; regions. Artist also interfaces with the rect package (this can be
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
78 ;; turned off if it causes you any trouble) so anything you cut in
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
79 ;; artist can be yanked with C-x r y and vice versa.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
80 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
81 ;; * Drawing with keys: Everything you can do with the mouse, you can
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
82 ;; also do without the mouse.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
83 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
84 ;; * Arrows: After having drawn a (straight) line or a (straight)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
85 ;; poly-line, you can set arrows on the line-ends by typing < or >.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
86 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
87 ;; * Aspect-ratio: You can set the variable artist-aspect-ratio to
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
88 ;; reflect the height-width ratio for the font you are using. Squares
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
89 ;; and circles are then drawn square/round. Note, that once your
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
90 ;; ascii-file is shown with font with a different height-width ratio,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
91 ;; the squares won't be square and the circles won't be round.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
92 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
93 ;; * Picture mode compatibility: Artist is picture mode compatible (this
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
94 ;; can be turned off).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
95 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
96 ;; See the documentation for the function artist-mode for a detailed
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
97 ;; description on how to use artist.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
98 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
99 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
100 ;; What about adding my own drawing modes?
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
101 ;; ---------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
102 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
103 ;; See the short guide at the end of this file.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
104 ;; If you add a new drawing mode, send it to me, and I would gladly
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
105 ;; include in the next release!
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
106
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
107
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
108 ;;; Installation:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
109
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
110 ;; To use artist, put this in your .emacs:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
111 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
112 ;; (autoload 'artist-mode "artist" "Enter artist-mode" t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
113
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
114
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
115 ;;; Requirements:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
116
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
117 ;; Artist requires Emacs 19.28 or higher.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
118 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
119 ;; Artist requires the `rect' package (which comes with Emacs) to be
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
120 ;; loadable, unless the variable `artist-interface-with-rect' is set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
121 ;; to nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
122 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
123 ;; Artist also requires the Picture mode (which also comes with Emacs)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
124 ;; to be loadable, unless the variable `artist-picture-compatibility'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
125 ;; is set to nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
126
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
127 ;;; Known bugs:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
128
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
129 ;; The shifted operations are not available when drawing with the mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
130 ;; in Emacs 19.29 and 19.30.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
131 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
132 ;; It is not possible to change between shifted and unshifted operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
133 ;; while drawing with the mouse. (See the comment in the function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
134 ;; artist-shift-has-changed for further details.)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
135
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
136
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
137 ;;; ChangeLog:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
138
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
139 ;; 1.2.4 25-Oct-2001
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
140 ;; Bugfix: Some operations (the edit menu) got hidden
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
141 ;; Bugfix: The first arrow for poly-lines was always pointing
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
142 ;; to the right
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
143 ;; Changed: Updated with changes made for Emacs 21.1
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
144 ;;
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
145 ;; 1.2.3 20-Nov-2000
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
146 ;; Bugfix: Autoload cookie corrected
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
147 ;;
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
148 ;; 1.2.2 19-Nov-2000
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
151 ;; got wrong in 1.1, are now corrected.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
152 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
153 ;; 1.2.1 15-Nov-2000
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
154 ;; New: Documentation fixes.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
155 ;; Bugfix: Sets next-line-add-newlines to t while in artist-mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
156 ;; Drawing with keys was confusing without this fix, if
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
157 ;; next-line-add-newlines was set to nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
158 ;; Thanks to Tatsuo Furukawa <tatsuo@kobe.hp.com> for this.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
159 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
160 ;; 1.2 22-Oct-2000
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
161 ;; New: Updated to work with Emacs 21
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
162 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
163 ;; 1.1 15-Aug-2000
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
164 ;; Bugfix: Cursor follows mouse pointer more closely.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
165 ;; New: Works with Emacs 20.x
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
166 ;; New: Variables are customizable
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
167 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
168 ;; 1.1-beta1 21-Apr-1998
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
169 ;; New: Spray-can (Utterly useless, I believe, but it was fun
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
170 ;; to implement :-) after an idea by Karl-Johan Karlsson
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
171 ;; <kj@lysator.liu.se>.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
172 ;; New: Freehand drawing (with pen).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
173 ;; New: Vaporizing lines.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
174 ;; New: Text-rendering using figlet.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
175 ;; New: Picture mode compatibility.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
176 ;; Changed: All Artist keys now uses the prefix C-c C-a not to conflict
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
177 ;; with Picture mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
178 ;; Bugfix: No longer leaves traces of lines when rubberbanding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
179 ;; if the buffer auto-scrolls.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
180 ;; Bugfix: Infinite loop sometimes when rubberbanding was turned
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
181 ;; off.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
182 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
183 ;; 1.0 01-Mar-1998
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
184 ;; First official release.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
185
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
186 ;;; Code:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
187
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
188 ;; Variables
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
189
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
190 (defconst artist-version "1.2.4")
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
191 (defconst artist-maintainer-address "tab@lysator.liu.se")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
192
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
193
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
207
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
208 ;; User options
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
209 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
210
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
211 (defgroup artist nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
212 "Customization of the Artist mode."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
213 :group 'mouse)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
214
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
215 (defgroup artist-text nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
216 "Customization of the text rendering."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
217 :group 'artist)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
218
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
219 (defcustom artist-rubber-banding t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
220 "Interactively do rubber-banding when non-nil."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
221 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
222 :type 'boolean)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
223
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
224 (defcustom artist-first-char ?1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
225 "Character to set at first point when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
226 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
227 :type 'character)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
228
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
229 (defcustom artist-second-char ?2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
230 "Character to set at second point when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
231 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
232 :type 'character)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
233
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
234 (defcustom artist-interface-with-rect t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
235 "Whether to interface with the rect package or not.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
236
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
237 Interfacing to the rect package means that the Copy and Paste operations
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
238 will use the rectangle buffer when accessing the copied area. This means
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
239 that you can insert a rectangle which is copied using the artist package
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
240 and vice versa.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
241
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
242 If this causes any problem for you (for example, if the implementation of
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
243 the rectangle package changes), you can set this variable to nil, and the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
244 artist package will use its own copy buffer."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
245 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
246 :type 'boolean)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
247
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
248 (defvar artist-arrows [ ?> nil ?v ?L ?< nil ?^ nil ]
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
249 ;; This is a defvar, not a defcustom, since the custom
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
250 ;; package shows vectors of characters as a vector of integers,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
251 ;; which is confusing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
252 "A vector of characters to use as arrows.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
253
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
254 The vector is 8 elements long and contains a character for each
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
255 direction, or nil if there is no suitable character to use for arrow
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
256 in that direction.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
257
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
258 The directions are as follows:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
259
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
260 5 6 7
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
261 \\ | /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
262 4 - * - 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
263 / | \\
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
264 3 2 1")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
265
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
266 (defcustom artist-aspect-ratio 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
267 "Defines the character height-to-width aspect ratio.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
268 This is used when drawing squares and circles. If the height of the"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
269 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
270 :type 'number)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
271
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
272 (defcustom artist-trim-line-endings t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
273 "Whether or not to remove white-space at end of lines.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
274
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
275 If non-nil, line-endings are trimmed (that is, extraneous white-space
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
276 at the end of the line is removed) when the shape is drawn."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
277 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
278 :type 'boolean)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
279
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
280
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
281 (defcustom artist-flood-fill-right-border 'window-width
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
282 "Right edge definition, used when flood-filling.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
283
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
284 When flood-filling, if the area is not closed off to the right, then
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
285 flood-filling will fill no more to the right than specified by this
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
286 variable. This limit is called the fill-border."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
287 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
288 :type '(choice (const :tag "limited to window" window-width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
289 (const :tag "limited to value of `fill-column'" fill-column)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
290
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
291 (defcustom artist-flood-fill-show-incrementally t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
292 "Whether or not to incrementally update display when flood-filling.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
293
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
294 If non-nil, incrementally update display when flood-filling.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
295 If set to non-nil, this currently implies discarding any input events
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
296 during the flood-fill."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
297 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
298 :type 'boolean)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
299
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
300
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
301 (defcustom artist-ellipse-right-char ?\)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
302 "Character to use at the rightmost position when drawing narrow ellipses.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
303
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
304 In this figure, it is the right parenthesis (the ``)'' character):
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
305 -----
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
306 ( )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
307 -----"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
308 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
309 :type 'character)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
310
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
311
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
312 (defcustom artist-ellipse-left-char ?\(
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
313 "Character to use at the leftmost position when drawing narrow ellipses.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
314
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
315 In this figure, it is the left parenthesis (the ``('' character):
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
316 -----
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
317 ( )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
318 -----"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
319 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
320 :type 'character)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
321
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
322 (defcustom artist-picture-compatibility t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
323 "Whether or not picture mode compatibility is on."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
324 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
325 :type 'boolean)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
326
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
327
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
328
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
329
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
330 (defcustom artist-vaporize-fuzziness 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
331 "How to vaporize lines that are cut off.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
332
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
333 Accept this many characters cutting off a line and still treat
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
334 it as one line.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
335 Example:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
336 If `artist-vaporize-fuzziness' is 2, then those will be recognized as
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
337 lines from A to B (provided you start vaporizing them at the ``*''):
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
338 /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
339 A----*------/-----------B
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
340 \\/
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
341 A----*----/\\------------B
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
342 / \\
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
343
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
344 but this one won't, since it is cut off by more than 2 characters:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
345 \\/ /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
346 A----*----/\\/----------B
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
347 / /\\
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
348 (in fact, only the left part (between the A and the leftmost ``/''
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
349 crossing the line) will be vaporized)"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
350 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
351 :type 'integer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
352
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
353
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
354 (defvar artist-pointer-shape (if (eq window-system 'x) x-pointer-crosshair nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
355 "*If in X Windows, use this pointer shape while drawing with the mouse.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
356
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
357
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
358 (defcustom artist-text-renderer 'artist-figlet
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
359 "Function for doing text rendering."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
360 :group 'artist-text
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
361 :type 'symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
362
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
363
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
364 (defcustom artist-figlet-program "figlet"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
365 "Program to run for `figlet'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
366 :group 'artist-text
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
367 :type 'string)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
368
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
369
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
370 (defcustom artist-figlet-default-font "standard"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
371 "Default font for `figlet'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
372 :group 'artist-text
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
373 :type 'string)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
374
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
375
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
376 (defcustom artist-figlet-list-fonts-command
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
377 ;; list files ending with *.flf in any directory printed by the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
378 ;; ``figlet -I2'' command. I think this will not produce more than
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
379 ;; one directory, but it never hurts to be on the safe side...
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
380 "for dir in `figlet -I2`; do cd $dir; ls *.flf; done"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
381 "Command to run to get list of available fonts."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
382 :group 'artist-text
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
383 :type 'string)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
384
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
385
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
386 (defcustom artist-spray-interval 0.2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
387 "Number of seconds between repeated spraying."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
388 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
389 :type 'number)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
390
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
391
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
392 (defcustom artist-spray-radius 4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
393 "Size of the area for spraying."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
394 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
395 :type 'integer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
396
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
397
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
398 (defvar artist-spray-chars '(?\ ?. ?- ?+ ?m ?% ?* ?#)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
399 ;; This is a defvar, not a defcustom, since the custom
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
400 ;; package shows lists of characters as a lists of integers,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
401 ;; which is confusing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
402 "*Characters (``color'') to use when spraying.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
403 They should be ordered
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
404 from the ``lightest'' to the ``heaviest'' since spraying replaces a
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
405 light character with the next heavier one.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
406
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
407
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
408 (defvar artist-spray-new-char ?.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
409 "*Initial character to use when spraying.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
410 This character is used if spraying upon a character that is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
411 not in `artist-spray-chars'. The character defined by this variable
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
412 should be in `artist-spray-chars', or spraying will behave
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
413 strangely.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
414
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
415
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
416 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
417 ;; End of user options
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
418
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
419
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
420 ;; Internal variables
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
421 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
422 (defvar artist-mode nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
423 "Non-nil to enable `artist-mode' and nil to disable.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
424 (make-variable-buffer-local 'artist-mode)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
425
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
426 (defvar artist-mode-name " Artist"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
427 "Name of artist mode beginning with a space (appears in the mode-line).")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
428
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
429 (defvar artist-curr-go 'pen-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
430 "Current selected graphics operation.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
431 (make-variable-buffer-local 'artist-curr-go)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
432
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
433 (defvar artist-line-char-set nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
434 "Boolean to tell whether user has set some char to use when drawing lines.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
435 (make-variable-buffer-local 'artist-line-char-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
436
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
437 (defvar artist-line-char nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
438 "Char to use when drawing lines.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
439 (make-variable-buffer-local 'artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
440
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
441 (defvar artist-fill-char-set nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
442 "Boolean to tell whether user has set some char to use when filling.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
443 (make-variable-buffer-local 'artist-fill-char-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
444
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
445 (defvar artist-fill-char nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
446 "Char to use when filling.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
447 (make-variable-buffer-local 'artist-fill-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
448
51965
5a62d5472383 (artist-erase-char): Fix default value using ?\s.
Markus Rost <rost@math.uni-bielefeld.de>
parents: 51961
diff changeset
449 (defvar artist-erase-char ?\s
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
450 "Char to use when erasing.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
451 (make-variable-buffer-local 'artist-erase-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
452
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
453 (defvar artist-default-fill-char ?.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
454 "Char to use when a fill-char is required but none is set.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
455 (make-variable-buffer-local 'artist-default-fill-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
456
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
457 ; This variable is not buffer local
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
458 (defvar artist-copy-buffer nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
459 "Copy buffer.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
460
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
461 (defvar artist-draw-region-min-y 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
462 "Line-number for top-most visited line for draw operation.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
463 (make-variable-buffer-local 'artist-draw-region-min-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
464
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
465 (defvar artist-draw-region-max-y 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
466 "Line-number for bottom-most visited line for draw operation.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
467 (make-variable-buffer-local 'artist-draw-region-max-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
468
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
469 (defvar artist-borderless-shapes nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
470 "When non-nil, draw shapes without border.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
471 The fill char is used instead, if it is set.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
472 (make-variable-buffer-local 'artist-borderless-shapes)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
473
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
474
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
475 (eval-when-compile
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
476 ;; Make rect available at compile-time
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
477 (require 'rect) ; for interfacing with rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
478 (require 'reporter) ; the bug-reporting tool
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
479 (require 'picture)) ; picture mode compatibility
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
480
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
481 (if artist-interface-with-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
482 (require 'rect))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
483
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
484 (require 'reporter)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
485
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
486 (if artist-picture-compatibility
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
487 (require 'picture))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
488
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
489
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
490 (defvar artist-mode-map
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
491 (let ((map (make-sparse-keymap)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
492 (setq artist-mode-map (make-sparse-keymap))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
493 (define-key map [down-mouse-1] 'artist-down-mouse-1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
494 (define-key map [S-down-mouse-1] 'artist-down-mouse-1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
495 (define-key map [down-mouse-2] 'artist-mouse-choose-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
496 (define-key map [S-down-mouse-2] 'artist-mouse-choose-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
497 (define-key map [down-mouse-3] 'artist-down-mouse-3)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
498 (define-key map [S-down-mouse-3] 'artist-down-mouse-3)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
499 (define-key map "\r" 'artist-key-set-point) ; return
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
500 (define-key map [up] 'artist-previous-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
501 (define-key map "\C-p" 'artist-previous-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
502 (define-key map [down] 'artist-next-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
503 (define-key map "\C-n" 'artist-next-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
504 (define-key map [left] 'artist-backward-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
505 (define-key map "\C-b" 'artist-backward-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
506 (define-key map [right] 'artist-forward-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
507 (define-key map "\C-f" 'artist-forward-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
508 (define-key map "<" 'artist-toggle-first-arrow)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
509 (define-key map ">" 'artist-toggle-second-arrow)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
510 (define-key map "\C-c\C-a\C-e" 'artist-select-erase-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
511 (define-key map "\C-c\C-a\C-f" 'artist-select-fill-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
512 (define-key map "\C-c\C-a\C-l" 'artist-select-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
513 (define-key map "\C-c\C-a\C-o" 'artist-select-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
514 (define-key map "\C-c\C-a\C-r" 'artist-toggle-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
515 (define-key map "\C-c\C-a\C-t" 'artist-toggle-trim-line-endings)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
516 (define-key map "\C-c\C-a\C-s" 'artist-toggle-borderless-shapes)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
517 (define-key map "\C-c\C-c" 'artist-mode-off)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
518 (define-key map "\C-c\C-al" 'artist-select-op-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
519 (define-key map "\C-c\C-aL" 'artist-select-op-straight-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
520 (define-key map "\C-c\C-ar" 'artist-select-op-rectangle)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
521 (define-key map "\C-c\C-aR" 'artist-select-op-square)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
522 (define-key map "\C-c\C-as" 'artist-select-op-square)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
523 (define-key map "\C-c\C-ap" 'artist-select-op-poly-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
524 (define-key map "\C-c\C-aP" 'artist-select-op-straight-poly-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
525 (define-key map "\C-c\C-ae" 'artist-select-op-ellipse)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
526 (define-key map "\C-c\C-ac" 'artist-select-op-circle)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
527 (define-key map "\C-c\C-at" 'artist-select-op-text-see-thru)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
528 (define-key map "\C-c\C-aT" 'artist-select-op-text-overwrite)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
529 (define-key map "\C-c\C-aS" 'artist-select-op-spray-can)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
530 (define-key map "\C-c\C-az" 'artist-select-op-spray-set-size)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
531 (define-key map "\C-c\C-a\C-d" 'artist-select-op-erase-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
532 (define-key map "\C-c\C-aE" 'artist-select-op-erase-rectangle)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
533 (define-key map "\C-c\C-av" 'artist-select-op-vaporize-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
534 (define-key map "\C-c\C-aV" 'artist-select-op-vaporize-lines)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
535 (define-key map "\C-c\C-a\C-k" 'artist-select-op-cut-rectangle)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
536 (define-key map "\C-c\C-a\M-w" 'artist-select-op-copy-rectangle)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
537 (define-key map "\C-c\C-a\C-y" 'artist-select-op-paste)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
538 (define-key map "\C-c\C-af" 'artist-select-op-flood-fill)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
539 (define-key map "\C-c\C-a\C-b" 'artist-submit-bug-report)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
540 map)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
541 "Keymap for `artist-minor-mode'.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
542
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
543 (defvar artist-replacement-table (make-vector 256 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
544 "Replacement table for `artist-replace-char'.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
545
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
546
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
547 ;;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
548 ;;; The table of graphic operations
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
549 ;;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
550 (defvar artist-mt
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
551 ;; Implementation note: Maybe this should be done using a structure
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
552 ;; in the cl package?
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
553 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
554 '(
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
555 (menu
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
556 ("Drawing"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
557 ((function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
558 ( "Undo" do-undo undo))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
559
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
560 (separator )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
561 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
562 ("Pen" (("Pen" pen-char "pen-c"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
563 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
564 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
565 artist-do-continously
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
566 artist-pen
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
567 (nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
568 ("Pen Line" pen-line "pen-l"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
569 artist-arrows artist-pen-set-arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
570 artist-pen-reset-last-xy nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
571 artist-do-continously
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
572 artist-pen-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
573 (nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
574
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
575 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
576 ("Line" (("line" line "line"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
577 artist-arrows artist-set-arrow-points-for-2points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
578 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
579 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
580 artist-draw-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
581 (artist-undraw-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
582 artist-nil nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
583 ("straight line" s-line "sline"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
584 artist-arrows artist-set-arrow-points-for-2points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
585 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
586 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
587 artist-draw-sline
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
588 (artist-undraw-sline
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
589 artist-nil nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
590
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
591 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
592 ("Rectangle" (("rectangle" rect "rect"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
593 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
594 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
595 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
596 artist-draw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
597 (artist-undraw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
598 artist-t-if-fill-char-set artist-fill-rect))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
599 ("square" square "square"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
600 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
601 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
602 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
603 artist-draw-square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
604 (artist-undraw-square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
605 artist-t-if-fill-char-set artist-fill-square)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
606
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
607 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
608 ("Poly-line" (("poly-line" polyline "poly"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
609 artist-arrows artist-set-arrow-points-for-poly
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
610 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
611 artist-do-poly
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
612 artist-draw-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
613 (artist-undraw-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
614 artist-nil nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
615 ("straight poly-line" spolyline "s-poly"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
616 artist-arrows artist-set-arrow-points-for-poly
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
617 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
618 artist-do-poly
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
619 artist-draw-sline
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
620 (artist-undraw-sline
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
621 artist-nil nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
622
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
623 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
624 ("Ellipse" (("ellipse" ellipse "ellipse"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
625 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
626 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
627 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
628 artist-draw-ellipse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
629 (artist-undraw-ellipse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
630 artist-t-if-fill-char-set artist-fill-ellipse))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
631 ("circle" circle "circle"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
632 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
633 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
634 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
635 artist-draw-circle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
636 (artist-undraw-circle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
637 artist-t-if-fill-char-set artist-fill-circle)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
638
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
639 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
640 ("Text" (("text see-thru" text-thru "text-thru"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
641 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
642 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
643 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
644 artist-text-see-thru
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
645 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
646 ("text overwrite" text-ovwrt "text-ovwrt"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
647 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
648 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
649 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
650 artist-text-overwrite
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
651 nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
652
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
653 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
654 ("Spray-can" (("spray-can" spray-can "spray-can"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
655 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
656 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
657 artist-do-continously
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
658 artist-spray
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
659 (artist-spray-get-interval))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
660 ("spray set size" spray-get-size "spray-size"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
661 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
662 nil artist-spray-clear-circle artist-spray-set-radius
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
663 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
664 artist-draw-circle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
665 (artist-undraw-circle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
666 artist-nil nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
667
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
668 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
669 ("Erase" (("erase char" erase-char "erase-c"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
670 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
671 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
672 artist-do-continously
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
673 artist-erase-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
674 (nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
675 ("erase rectangle" erase-rect "erase-r"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
676 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
677 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
678 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
679 artist-draw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
680 (artist-undraw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
681 artist-t artist-erase-rect)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
682
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
683 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
684 ("Vaporize" (("vaporize line" vaporize-line "vaporize-1"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
685 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
686 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
687 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
688 artist-vaporize-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
689 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
690 ("vaporize lines" vaporize-lines "vaporize-n"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
691 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
692 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
693 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
694 artist-vaporize-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
695 nil)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
696
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
697 (menu
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
698 ("Edit"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
699 ((graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
700 ("Cut" (("cut rectangle" cut-r "cut-r"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
701 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
702 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
703 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
704 artist-draw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
705 (artist-undraw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
706 artist-t artist-cut-rect)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
707 ("cut square" cut-s "cut-s"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
708 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
709 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
710 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
711 artist-draw-square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
712 (artist-undraw-square
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
713 artist-t artist-cut-square))))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
714
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
715 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
716 ("Copy" (("copy rectangle" copy-r "copy-r"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
717 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
718 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
719 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
720 artist-draw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
721 (artist-undraw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
722 artist-t artist-copy-rect)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
723 ("copy square" copy-s "copy-s"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
724 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
725 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
726 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
727 artist-draw-square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
728 (artist-undraw-square
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
729 artist-t artist-copy-square))))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
730
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
731 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
732 ("Paste" (("paste" paste "paste"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
733 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
734 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
735 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
736 artist-paste
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
737 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
738 ("paste" paste "paste"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
739 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
740 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
741 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
742 artist-paste
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
743 nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
744
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
745 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
746 ("Flood-fill" (("flood-fill" flood-fill "flood"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
747 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
748 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
749 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
750 artist-flood-fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
751 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
752 ("flood-fill" flood-fill "flood"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
753 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
754 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
755 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
756 artist-flood-fill
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
757 nil)))))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
758
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
759 (menu
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
760 ("Settings"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
761 ((function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
762 ("Set Fill" set-fill artist-select-fill-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
763
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
764 (function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
765 ("Set Line" set-line artist-select-line-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
766
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
767 (function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
768 ("Set Erase" set-erase artist-select-erase-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
769
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
770 (function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
771 ("Rubber-banding" rubber-band artist-toggle-rubber-banding))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
772
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
773 (function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
774 ("Trimming" trimming artist-toggle-trim-line-endings))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
775
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
776 (function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
777 ("Borders" borders artist-toggle-borderless-shapes))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
778
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
779 (function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
780 ("Spray-chars" spray-chars artist-select-spray-chars)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
781
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
782 ) ;; end of list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
783
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
784 "Master Table for `artist-mode'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
785 This table is primarily a table over the different graphics operations
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
786 available in artist mode, but it also holds layout information for the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
787 popup menu.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
788
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
789 The master table is a list of table elements. The elements of this table
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
790 have the layout
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
791
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
792 (TAG INFO-PART)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
793
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
794 There are three kinds of TAG:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
795
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
796 `menu' -- a sub-menu
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
797 `separator' -- produce a separator in the popup menu
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
798 `function-call' -- call a function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
799 `graphics-operation' -- a graphics operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
800
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
801 The layout of the INFO-PART for `menu' is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
802
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
803 (TITLE ((TAG-1 INFO-PART-1) (TAG-2 INFO-PART-2) ...))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
804
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
805 TITLE is the title of the submenu; this is followed by a list of
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
806 menu items, each on the general form (TAG INFO-PART).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
807
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
808
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
809 The layout of the INFO-PART for `separator' is empty and not used.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
810
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
811
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
812 This is the layout of the INFO-PART for `function-call':
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
813
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
814 (KEYWORD SYMBOL FN)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
815
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
816 KEYWORD is a string naming the operation, and appears in the popup menu.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
817 SYMBOL is the symbol for the operations.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
818 FN is the function performing the operation. This function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
819 is called with no arguments. Its return value is ignored.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
820
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
821
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
822 The layout of the INFO-PART for `graphics-operation' is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
823
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
824 (TITLE (UNSHIFTED SHIFTED))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
825
42706
be541feb06cc Fix typo.
Pavel Janík <Pavel@Janik.cz>
parents: 41608
diff changeset
826 TITLE is the title that appears in the popup menu. UNSHIFTED
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
827 and SHIFTED specify for unshifted and shifted operation. Both
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
828 have the form
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
829
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
830 (KEYWORD KEY-SYMBOL MODE-LINE ARROW-PRED ARROW-SET-FN
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
831 INIT-FN PREP-FILL-FN EXIT-FN DRAW-HOW DRAW-FN EXTRA-DRAW-INFO)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
832
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
833 KEYWORD is a string specifying the name of the shape to draw.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
834 This is used when selecting drawing operation.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
835 KEY-SYMBOL is the key which is used when looking up members
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
836 through the functions `artist-go-get-MEMBER-from-symbol'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
837 and `artist-fc-get-MEMBER-from-symbol'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
838 MODE-LINE is a string that appears in the mode-line when drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
839 the shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
840 ARROW-PRED is a function that is called to find out if the shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
841 can have arrows. The function is called with no arguments and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
842 must return nil or t.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
843 ARROW-SET-FN is a function that is called to set arrow end-points.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
844 Arguments and return values for this funcion are described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
845 INIT-FN is, if non-nil, a function that is called when the first
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
846 point of the shape is set. Arguments and return values for
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
847 this funcion are described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
848 PREP-FILL-FN is, if non-nil, a function that is called after
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
849 the last point is set, but before the filling is done.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
850 Arguments and return values for this funcion are described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
851 EXIT-FN is, if non-nil, a function that is called after filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
852 is done. Arguments and return values for this funcion are
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
853 described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
854 DRAW-HOW defines the kind of shape. The kinds of shapes are:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
855 `artist-do-continously' -- Do drawing operation continously,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
856 as long as the mouse button is held down.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
857 `artist-do-poly' -- Do drawing operation many times.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
858 1 -- Do drawing operation only once.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
859 2 -- The drawing operation requires two points.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
860 DRAW-FN is the function to call for drawing. Arguments and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
861 return values for this funcion are described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
862 EXTRA-DRAW-INFO the layout of this depends on the value of DRAW-HOW:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
863 If DRAW-HOW is `artist-do-continously':
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
864
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
865 (INTERVAL-FN)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
866
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
867 INTERVAL-FN is, if non-nil, a function to call for getting
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
868 an interval between repeated calls to the DRAW-FN.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
869 This function is called with no arguments and must
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
870 return a number, the interval in seconds.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
871 If nil, calls to DRAW-FN are done only when the mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
872 or cursor is moved.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
873
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
874 If DRAW-HOW is either `artist-do-poly' or 2:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
875
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
876 (UNDRAW-FN FILL-PRED FILL-FN)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
877
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
878 UNDRAW-FN is a function to call for undrawing the shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
879 Arguments and return values for this funcion are
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
880 described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
881 FILL-PRED is a function that is called to find out if the shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
882 can have arrows. The function must take no arguments and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
883 return nil or t.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
884 FILL-FN is a function to call for filling the shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
885 Arguments and return values for this funcion are
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
886 described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
887
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
888 If DRAW-HOW is 1:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
889
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
890 ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
891
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
892 Note! All symbols and keywords (both in the `funcion-call' INFO-PART
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
893 as well as in the `graphics-operation' INFO-PART) must be unique.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
894
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
895 The following table describe function arguments and return value
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
896 for different functions and DRAW-HOWs.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
897
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
898 If DRAW-HOW is either `artist-do-continously' or 1:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
899
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
900 INIT-FN X Y ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
901 PREP-FILL-FN X Y ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
902 EXIT-FN X Y ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
903 ARROW-SET-FN X Y ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
904 DRAW-FN X Y ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
905
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
906 If DRAW-HOW is 2:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
907
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
908 INIT-FN X1 Y1 ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
909 PREP-FILL-FN X1 Y1 X2 Y2 ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
910 EXIT-FN X1 Y1 X2 Y2 ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
911 ARROW-SET-FN X1 Y1 X2 Y2 ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
912 DRAW-FN X1 Y1 X2 Y2 ==> (ENDPOINT-1 ENDPOINT-2 SHAPE)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
913 UNDRAW-FN (ENDPOINT-1 ENDPOINT-2 SHAPE) ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
914 FILL-FN (ENDPOINT-1 ENDPOINT-2 SHAPE) X1 Y1 X2 Y2 ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
915
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
916 ENDPOINT-1 and ENDPOINT-2 are endpoints which are created with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
917 `artist-make-endpoint'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
918 SHAPE is an opaque structure, created by the DRAW-FN and intented
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
919 to be used only by the UNDRAW-FN.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
920
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
921 If DRAW-HOW is `artist-do-poly':
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
922
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
923 INIT-FN X1 Y1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
924 PREP-FILL-FN POINT-LIST
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
925 ARROW-SET-FN POINT-LIST
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
926 EXIT-FN POINT-LIST
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
927 DRAW-FN X-LAST Y-LAST X-NEW Y-NEW ==> (ENDPOINT-1 ENDPOINT-2 SHAPE)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
928 UNDRAW-FN (ENDPOINT-1 ENDPOINT-2 SHAPE)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
929 FILL-FN POINT-LIST
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
930
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
931 ENDPOINT-1 and ENDPOINT-2 are endpoints which are created with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
932 `artist-make-endpoint'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
933 SHAPE is an opaque structure, created by the DRAW-FN and intented
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
934 to be used only by the UNDRAW-FN.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
935 POINT-LIST is a list of vectors [X Y].")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
936
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
937
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
938 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
939 ;; Accessors for the master table
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
940 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
941
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
942 (defun artist-mt-get-tag (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
943 "Retrieve the tag component from the master table ELEMENT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
944 (elt element 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
945
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
946 (defun artist-mt-get-info-part (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
947 "Retrieve the info part component from the master table ELEMENT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
948 (elt element 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
949
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
950 ;; For the 'graphics-operation info-parts
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
951 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
952 (defsubst artist-go-get-desc (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
953 "Retrieve the description component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
954 (elt info-part 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
955
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
956 (defsubst artist-go-get-unshifted (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
957 "Retrieve the unshifted info from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
958 (elt (elt info-part 1) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
959
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
960 (defsubst artist-go-get-shifted (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
961 "Retrieve the shifted info from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
962 (elt (elt info-part 1) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
963
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
964 (defsubst artist-go-get-keyword (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
965 "Retrieve the keyword component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
966 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
967 (elt info-variant-part 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
968
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
969 (defsubst artist-go-get-symbol (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
970 "Retrieve the symbol component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
971 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
972 (elt info-variant-part 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
973
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
974 (defsubst artist-go-get-mode-line (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
975 "Retrieve the mode line component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
976 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
977 (elt info-variant-part 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
978
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
979 (defsubst artist-go-get-arrow-pred (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
980 "Retrieve the arrow predicate component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
981 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
982 (elt info-variant-part 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
983
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
984 (defsubst artist-go-get-arrow-set-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
985 "Retrieve the arrow set component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
986 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
987 (elt info-variant-part 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
988
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
989 (defsubst artist-go-get-init-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
990 "Retrieve the init function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
991 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
992 (elt info-variant-part 5))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
993
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
994 (defsubst artist-go-get-prep-fill-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
995 "Retrieve the fill preparation function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
996 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
997 (elt info-variant-part 6))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
998
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
999 (defsubst artist-go-get-exit-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1000 "Retrieve the exit component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1001 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1002 (elt info-variant-part 7))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1003
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1004 (defsubst artist-go-get-draw-how (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1005 "Retrieve the draw how component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1006 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1007 (elt info-variant-part 8))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1008
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1009 (defsubst artist-go-get-draw-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1010 "Retrieve the draw function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1011 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1012 (elt info-variant-part 9))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1013
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1014 (defsubst artist-go-get-undraw-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1015 "Retrieve the undraw function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1016 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1017 This interval function component is available only if the `draw-how'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1018 component is other than `artist-do-continously' or 1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1019 (elt (elt info-variant-part 10) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1020
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1021 (defsubst artist-go-get-interval-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1022 "Retrieve the interval function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1023 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1024 This interval function component is available only if the `draw-how'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1025 component is `artist-do-continously'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1026 (elt (elt info-variant-part 10) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1027
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1028 (defsubst artist-go-get-fill-pred (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1029 "Retrieve the fill predicate component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1030 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1031 This interval function component is available only if the `draw-how'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1032 component is other than `artist-do-continously' or 1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1033 (elt (elt info-variant-part 10) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1034
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1035 (defsubst artist-go-get-fill-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1036 "Retrieve the fill function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1037 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1038 This interval function component is available only if the `draw-how'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1039 component is other than `artist-do-continously' or 1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1040 (elt (elt info-variant-part 10) 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1041
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1042 ;; For the 'function-call info-parts
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1043 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1044 (defsubst artist-fc-get-keyword (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1045 "Retrieve the keyword component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1046 (elt info-part 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1047
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1048 (defsubst artist-fc-get-symbol (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1049 "Retrieve the symbol component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1050 (elt info-part 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1051
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1052 (defsubst artist-fc-get-fn (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1053 "Retrieve the function component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1054 (elt info-part 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1055
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1056 ;; For the 'menu info-parts
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1057 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1058 (defsubst artist-mn-get-title (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1059 "Retrieve the title component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1060 (elt info-part 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1061
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1062 (defsubst artist-mn-get-items (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1063 "Retrieve the items component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1064 (elt info-part 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1065
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1066 ;;; ---------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1067 ;;; The artist-mode
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1068 ;;; ---------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1069
33653
55d418b6992e (artist-mode): Fix autoload cookie.
Gerd Moellmann <gerd@gnu.org>
parents: 33618
diff changeset
1070 ;;;###autoload
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1071 (defun artist-mode (&optional state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1072 "Toggle artist mode. With arg, turn artist mode on if arg is positive.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1073 Artist lets you draw lines, squares, rectangles and poly-lines, ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1074 and circles with your mouse and/or keyboard.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1075
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1076 How to quit artist mode
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1077
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1078 Type \\[artist-mode-off] to quit artist-mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1079
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1080
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1081 How to submit a bug report
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1082
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1083 Type \\[artist-submit-bug-report] to submit a bug report.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1084
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1085
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1086 Drawing with the mouse:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1087
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1088 mouse-2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1089 shift mouse-2 Pops up a menu where you can select what to draw with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1090 mouse-1, and where you can do some settings (described
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1091 below).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1092
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1093 mouse-1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1094 shift mouse-1 Draws lines, rectangles or poly-lines, erases, cuts, copies
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1095 or pastes:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1096
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1097 Operation Not shifted Shifted
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1098 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1099 Pen fill-char at point line from last point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1100 to new point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1101 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1102 Line Line in any direction Straight line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1103 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1104 Rectangle Rectangle Square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1105 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1106 Poly-line Poly-line in any dir Straight poly-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1107 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1108 Ellipses Ellipses Circles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1109 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1110 Text Text (see thru) Text (overwrite)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1111 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1112 Spray-can Spray-can Set size for spray
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1113 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1114 Erase Erase character Erase rectangle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1115 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1116 Vaporize Erase single line Erase connected
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1117 lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1118 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1119 Cut Cut rectangle Cut square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1120 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1121 Copy Copy rectangle Copy square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1122 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1123 Paste Paste Paste
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1124 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1125 Flood-fill Flood-fill Flood-fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1126 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1129 or diagonally.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1130
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1131 * Poly-lines are drawn while holding mouse-1 down. When you
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1132 release the button, the point is set. If you want a segment
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1133 to be straight, hold down shift before pressing the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1134 mouse-1 button. Click mouse-2 or mouse-3 to stop drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1135 poly-lines.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1136
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1137 * See thru for text means that text already in the buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1138 will be visible through blanks in the text rendered, while
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1139 overwrite means the opposite.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1140
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1141 * Vaporizing connected lines only vaporizes lines whose
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1142 _endpoints_ are connected. See also the variable
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1143 `artist-vaporize-fuzziness'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1144
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1145 * Cut copies, then clears the rectangle/square.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1146
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1147 * When drawing lines or poly-lines, you can set arrows.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1148 See below under ``Arrows'' for more info.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1149
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1150 * The mode line shows the currently selected drawing operation.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1151 In addition, if it has an asterisk (*) at the end, you
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1152 are currently drawing something.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1153
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1154 * Be patient when flood-filling -- large areas take quite
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1155 some time to fill.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1156
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1157
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1158 mouse-3 Erases character under pointer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1159 shift mouse-3 Erases rectangle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1160
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1161
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1162 Settings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1163
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1164 Set fill Sets the character used when filling rectangles/squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1165
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1166 Set line Sets the character used when drawing lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1167
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1168 Erase char Sets the character used when erasing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1169
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1170 Rubber-banding Toggles rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1171
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1172 Trimming Toggles trimming of line-endings (that is: when the shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1173 is drawn, extraneous white-space at end of lines is removed)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1174
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1175 Borders Toggles the drawing of line borders around filled shapes.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1176
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1177
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1178 Drawing with keys
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1179
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1180 \\[artist-key-set-point] Does one of the following:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1181 For lines/rectangles/squares: sets the first/second endpoint
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1182 For poly-lines: sets a point (use C-u \\[artist-key-set-point] to set last point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1183 When erase characters: toggles erasing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1184 When cutting/copying: Sets first/last endpoint of rect/square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1185 When pasting: Pastes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1186
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1187 \\[artist-select-operation] Selects what to draw
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1188
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1189 Move around with \\[artist-next-line], \\[artist-previous-line], \\[artist-forward-char] and \\[artist-backward-char].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1190
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1191 \\[artist-select-fill-char] Sets the charater to use when filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1192 \\[artist-select-line-char] Sets the charater to use when drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1193 \\[artist-select-erase-char] Sets the charater to use when erasing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1194 \\[artist-toggle-rubber-banding] Toggles rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1195 \\[artist-toggle-trim-line-endings] Toggles trimming of line-endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1196 \\[artist-toggle-borderless-shapes] Toggles borders on drawn shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1197
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1198
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1199 Arrows
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1200
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1201 \\[artist-toggle-first-arrow] Sets/unsets an arrow at the beginning
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1202 of the line/poly-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1203
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1204 \\[artist-toggle-second-arrow] Sets/unsets an arrow at the end
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1205 of the line/poly-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1206
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1207
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1208 Selecting operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1209
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1210 There are some keys for quickly selecting drawing operations:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1211
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1212 \\[artist-select-op-line] Selects drawing lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1213 \\[artist-select-op-straight-line] Selects drawing straight lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1214 \\[artist-select-op-rectangle] Selects drawing rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1215 \\[artist-select-op-square] Selects drawing squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1216 \\[artist-select-op-poly-line] Selects drawing poly-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1217 \\[artist-select-op-straight-poly-line] Selects drawing straight poly-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1218 \\[artist-select-op-ellipse] Selects drawing ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1219 \\[artist-select-op-circle] Selects drawing circles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1220 \\[artist-select-op-text-see-thru] Selects rendering text (see thru)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1221 \\[artist-select-op-text-overwrite] Selects rendering text (overwrite)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1222 \\[artist-select-op-spray-can] Spray with spray-can
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1223 \\[artist-select-op-spray-set-size] Set size for the spray-can
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1224 \\[artist-select-op-erase-char] Selects erasing characters
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1225 \\[artist-select-op-erase-rectangle] Selects erasing rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1226 \\[artist-select-op-vaporize-line] Selects vaporizing single lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1227 \\[artist-select-op-vaporize-lines] Selects vaporizing connected lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1228 \\[artist-select-op-cut-rectangle] Selects cutting rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1229 \\[artist-select-op-copy-rectangle] Selects copying rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1230 \\[artist-select-op-paste] Selects pasting
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1231 \\[artist-select-op-flood-fill] Selects flood-filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1232
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1233
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1234 Variables
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1235
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1236 This is a brief overview of the different varaibles. For more info,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1237 see the documentation for the variables (type \\[describe-variable] <variable> RET).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1238
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1239 artist-rubber-banding Interactively do rubber-banding or not
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1240 artist-first-char What to set at first/second point...
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1241 artist-second-char ...when not rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1242 artist-interface-with-rect If cut/copy/paste should interface with rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1243 artist-arrows The arrows to use when drawing arrows
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1244 artist-aspect-ratio Character height-to-width for squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1245 artist-trim-line-endings Trimming of line endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1246 artist-flood-fill-right-border Right border when flood-filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1247 artist-flood-fill-show-incrementally Update display while filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1248 artist-pointer-shape Pointer shape to use while drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1249 artist-ellipse-left-char Character to use for narrow ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1250 artist-ellipse-right-char Character to use for narrow ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1251 artist-borderless-shapes If shapes should have borders
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1252 artist-picture-compatibility Whether or not to be picture mode compatible
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1253 artist-vaporize-fuzziness Tolerance when recognizing lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1254 artist-spray-interval Seconds between repeated sprayings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1255 artist-spray-radius Size of the spray-area
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1256 artist-spray-chars The spray-``color''
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1257 artist-spray-new-chars Initial spray-``color''
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1258
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1259 Hooks
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1260
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1261 When entering artist-mode, the hook `artist-mode-init-hook' is called.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1262 When quitting artist-mode, the hook `artist-mode-exit-hook' is called.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1263
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1264
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1265 Keymap summary
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1266
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1267 \\{artist-mode-map}"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1268 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1269 (if (setq artist-mode
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1270 (if (null state) (not artist-mode)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1271 (> (prefix-numeric-value state) 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1272 (artist-mode-init)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1273 (artist-mode-exit)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1274
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1275 ;; insert our minor mode string
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1276 (or (assq 'artist-mode minor-mode-alist)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1277 (setq minor-mode-alist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1278 (cons '(artist-mode artist-mode-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1279 minor-mode-alist)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1280
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1281 ;; insert our minor mode keymap
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1282 (or (assq 'artist-mode minor-mode-map-alist)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1283 (setq minor-mode-map-alist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1284 (cons (cons 'artist-mode artist-mode-map)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1285 minor-mode-map-alist)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1286
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1287
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1288
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1289 (eval-when-compile
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1290 ;; Variables that are made local in artist-mode-init
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1291 (defvar artist-key-is-drawing nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1292 (defvar artist-key-endpoint1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1293 (defvar artist-key-poly-point-list nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1294 (defvar artist-key-shape nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1295 (defvar artist-key-draw-how nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1296 (defvar artist-popup-menu-table nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1297 (defvar artist-key-compl-table nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1298 (defvar artist-rb-save-data nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1299 (defvar artist-arrow-point-1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1300 (defvar artist-arrow-point-2 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1301
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1302
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1303 ;; Init and exit
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1304 (defun artist-mode-init ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1305 "Init Artist mode. This will call the hook `artist-mode-init-hook'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1306 (let ((i 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1307 (while (< i 256)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1308 (aset artist-replacement-table i i)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1309 (setq i (1+ i))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1310 (aset artist-replacement-table ?\n ?\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1311 (aset artist-replacement-table ?\t ?\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1312 (aset artist-replacement-table 0 ?\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1313 (make-local-variable 'artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1314 (make-local-variable 'artist-key-endpoint1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1315 (make-local-variable 'artist-key-poly-point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1316 (make-local-variable 'artist-key-shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1317 (make-local-variable 'artist-key-draw-how)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1318 (make-local-variable 'artist-popup-menu-table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1319 (make-local-variable 'artist-key-compl-table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1320 (make-local-variable 'artist-rb-save-data)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1321 (make-local-variable 'artist-arrow-point-1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1322 (make-local-variable 'artist-arrow-point-2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1323 (setq artist-key-is-drawing nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1324 (setq artist-key-endpoint1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1325 (setq artist-key-poly-point-list nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1326 (setq artist-key-shape nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1327 (setq artist-popup-menu-table (artist-compute-popup-menu-table artist-mt))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1328 (setq artist-key-compl-table (artist-compute-key-compl-table artist-mt))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1329 (setq artist-rb-save-data (make-vector 7 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1330 (setq artist-arrow-point-1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1331 (setq artist-arrow-point-2 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1332 (make-local-variable 'next-line-add-newlines)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1333 (setq next-line-add-newlines t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1334 (setq artist-key-draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1335 (artist-go-get-draw-how-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1336 (if (and artist-picture-compatibility (not (eq major-mode 'picture-mode)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1337 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1338 (picture-mode)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1339 (message "")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1340 (run-hooks 'artist-mode-init-hook)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1341 (artist-mode-line-show-curr-operation artist-key-is-drawing))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1342
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1343 (defun artist-mode-exit ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1344 "Exit Artist mode. This will call the hook `artist-mode-exit-hook'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1345 (if (and artist-picture-compatibility (eq major-mode 'picture-mode))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1346 (picture-mode-exit))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1347 (kill-local-variable 'next-line-add-newlines)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1348 (run-hooks 'artist-mode-exit-hook))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1349
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1350 (defun artist-mode-off ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1351 "Turn Artist mode off."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1352 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1353 (artist-mode -1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1354 (force-mode-line-update))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1355
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1356 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1357 ;; General routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1358 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1359
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1360 (defun artist-update-display ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1361 "Repaint the display."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1362 (sit-for 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1363
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1364 (defun artist-mode-line-show-curr-operation (is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1365 "Show current operation in mode-line. If IS-DRAWING, show that."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1366 (let ((mtext (concat artist-mode-name "/"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1367 (artist-go-get-mode-line-from-symbol artist-curr-go)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1368 (if is-drawing "/*" ""))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1369 (setcdr (assq 'artist-mode minor-mode-alist) (list mtext)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1370 (force-mode-line-update))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1371
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1372
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1373 (defun artist-t-if-fill-char-set ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1374 "Return the value of the variable `artist-fill-char-set'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1375 artist-fill-char-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1376
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1377 (defun artist-t ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1378 "Always return t."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1379 t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1380
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1381 (defun artist-nil ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1382 "Always return nil."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1383 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1384
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1385 (defun artist-arrows ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1386 "Say yes to arrows!"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1387 t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1388
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1389 (defun artist-no-arrows ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1390 "Say no to arrows!"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1391 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1392
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1393 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1394 ;; Auxiliary init-routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1395 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1396
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1397 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1398 ; Computing the table for the x-popup-menu from the master table
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1399 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1400
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1401 (defun artist-compute-popup-menu-table (menu-table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1402 "Create a menu from from MENU-TABLE data.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1403 The returned value is suitable for the `x-popup-menu' function."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1404 (cons "Artist menu"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1405 (artist-compute-popup-menu-table-sub menu-table)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1406
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1407 (defun artist-compute-popup-menu-table-sub (menu-table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1408 "Compute operation table suitable for `x-popup-menu' from MENU-TABLE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1409 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1410 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1411 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1412 (cond ((eq element-tag 'graphics-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1413 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1414 (descr (artist-go-get-desc info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1415 (unshifted (artist-go-get-unshifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1416 (symbol (artist-go-get-symbol unshifted)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1417 (list descr symbol)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1418
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1419 ((eq element-tag 'function-call)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1420 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1421 (keyword (artist-fc-get-keyword info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1422 (symbol (artist-fc-get-symbol info-part)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1423 (list keyword symbol)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1424
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1425 ((eq element-tag 'separator)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1426 '("" ""))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1427
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1428 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1429 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1430 (title (artist-mn-get-title info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1431 (items (artist-mn-get-items info-part)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1432 (cons title (artist-compute-popup-menu-table-sub items))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1433
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1434 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1435 (error "Internal error: unknown element-tag: \"%s\""
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1436 element-tag)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1437 menu-table))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1438
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1439 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1440 ; Computing the completion table from the master table
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1441 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1442
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1443 (defun artist-compute-key-compl-table (menu-table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1444 "Compute completion table from MENU-TABLE, suitable for `completing-read'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1445 (apply
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1446 'nconc
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1447 (artist-remove-nulls
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1448 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1449 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1450 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1451 (cond ((eq element-tag 'graphics-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1452 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1453 (unshifted (artist-go-get-unshifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1454 (shifted (artist-go-get-shifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1455 (unshifted-kwd (artist-go-get-keyword unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1456 (shifted-kwd (artist-go-get-keyword shifted)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1457 (list (list unshifted-kwd) (list shifted-kwd))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1458 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1459 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1460 (items (artist-mn-get-items info-part)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1461 (artist-compute-key-compl-table items)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1462 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1463 nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1464 menu-table))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1465
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1466
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1467 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1468 ; Retrieving a symbol (graphics operation or function-call) from a keyword
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1469 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1470
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1471 (defun artist-mt-get-symbol-from-keyword (kwd)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1472 "Search master table for keyword KWD and return its symbol."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1473 (artist-mt-get-symbol-from-keyword-sub artist-mt kwd))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1474
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1475 (defun artist-mt-get-symbol-from-keyword-sub (table kwd)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1476 "Search TABLE for keyword KWD and return its symbol."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1477 (catch 'found
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1478 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1479 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1480 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1481 (cond ((eq element-tag 'graphics-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1482 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1483 (unshifted (artist-go-get-unshifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1484 (shifted (artist-go-get-shifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1485 (unshifted-kwd (artist-go-get-keyword unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1486 (shifted-kwd (artist-go-get-keyword shifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1487 (unshifted-sym (artist-go-get-symbol unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1488 (shifted-sym (artist-go-get-symbol shifted)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1489 (if (string-equal kwd unshifted-kwd)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1490 (throw 'found unshifted-sym))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1491 (if (string-equal kwd shifted-kwd)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1492 (throw 'found shifted-sym))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1493
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1494 ((eq element-tag 'function-call)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1495 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1496 (keyword (artist-fc-get-keyword info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1497 (symbol (artist-fc-get-symbol info-part)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1498 (if (string-equal kwd keyword)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1499 (throw 'found symbol))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1500 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1501 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1502 (items (artist-mn-get-items info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1503 (answer (artist-mt-get-symbol-from-keyword-sub
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1504 items kwd)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1505 (if answer (throw 'found answer))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1506 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1507 nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1508 table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1509 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1510
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1511
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1512 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1513 ; Retrieving info from a graphics operation symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1514 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1515
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1516 (defun artist-go-retrieve-from-symbol (symbol retrieve-fn)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1517 "Search the master table for a graphics operation SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1518 Calls RETRIEVE-FN to retrieve information from that symbol's
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1519 info-variant-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1520 (artist-go-retrieve-from-symbol-sub artist-mt symbol retrieve-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1521
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1522 (defun artist-go-retrieve-from-symbol-sub (table symbol retrieve-fn)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1523 "Search the TABLE for a graphics operation SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1524 Calls RETRIEVE-FN to retrieve information from that symbol's
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1525 info-variant-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1526 (catch 'found
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1527 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1528 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1529 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1530 (cond ((eq element-tag 'graphics-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1531 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1532 (unshifted (artist-go-get-unshifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1533 (shifted (artist-go-get-shifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1534 (unshifted-sym (artist-go-get-symbol unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1535 (shifted-sym (artist-go-get-symbol shifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1536 (variant-part (cond
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1537 ((eq unshifted-sym symbol) unshifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1538 ((eq shifted-sym symbol) shifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1539 (t nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1540 (if variant-part ; if found do:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1541 (throw 'found (funcall retrieve-fn variant-part)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1542
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1543 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1544 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1545 (items (artist-mn-get-items info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1546 (answer (artist-go-retrieve-from-symbol-sub
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1547 items symbol retrieve-fn)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1548 (if answer (throw 'found answer)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1549
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1550 table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1551 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1552
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1553 (defun artist-go-get-keyword-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1554 "Search the master table, get keyword from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1555 (artist-go-retrieve-from-symbol symbol 'artist-go-get-keyword))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1556
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1557 (defun artist-go-get-mode-line-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1558 "Search the master table, get mode-line from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1559 (artist-go-retrieve-from-symbol symbol 'artist-go-get-mode-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1560
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1561 (defun artist-go-get-arrow-pred-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1562 "Search the master table, get arrow-pred from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1563 (artist-go-retrieve-from-symbol symbol 'artist-go-get-arrow-pred))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1564
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1565 (defun artist-go-get-arrow-set-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1566 "Search the master table, get arrow-set-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1567 (artist-go-retrieve-from-symbol symbol 'artist-go-get-arrow-set-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1568
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1569 (defun artist-go-get-init-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1570 "Search the master table, get init-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1571 (artist-go-retrieve-from-symbol symbol 'artist-go-get-init-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1572
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1573 (defun artist-go-get-prep-fill-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1574 "Search the master table, get prep-fill-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1575 (artist-go-retrieve-from-symbol symbol 'artist-go-get-prep-fill-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1576
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1577 (defun artist-go-get-exit-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1578 "Search the master table, get exit-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1579 (artist-go-retrieve-from-symbol symbol 'artist-go-get-exit-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1580
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1581 (defun artist-go-get-draw-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1582 "Search the master table, get draw-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1583 (artist-go-retrieve-from-symbol symbol 'artist-go-get-draw-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1584
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1585 (defun artist-go-get-draw-how-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1586 "Search the master table, get draw-how from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1587 (artist-go-retrieve-from-symbol symbol 'artist-go-get-draw-how))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1588
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1589 (defun artist-go-get-undraw-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1590 "Search the master table, get undraw-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1591 (artist-go-retrieve-from-symbol symbol 'artist-go-get-undraw-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1592
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1593 (defun artist-go-get-interval-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1594 "Search the master table, get interval-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1595 (artist-go-retrieve-from-symbol symbol 'artist-go-get-interval-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1596
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1597 (defun artist-go-get-fill-pred-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1598 "Search the master table, get fill-pred from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1599 (artist-go-retrieve-from-symbol symbol 'artist-go-get-fill-pred))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1600
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1601 (defun artist-go-get-fill-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1602 "Search the master table, get fill-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1603 (artist-go-retrieve-from-symbol symbol 'artist-go-get-fill-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1604
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1605 (defun artist-go-get-symbol-shift (symbol is-shifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1606 "Search for (shifted or unshifted) graphics operation SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1607 If IS-SHIFTED is non-nil, return the shifted symbol,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1608 otherwise the shifted symbol."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1609 (artist-go-get-symbol-shift-sub artist-mt symbol is-shifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1610
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1611 (defun artist-go-get-symbol-shift-sub (table symbol is-shifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1612 "Search TABLE for (shifted or unshifted) graphics SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1613 If IS-SHIFTED is non-nil, return the shifted symbol,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1614 otherwise the shifted symbol."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1615 (catch 'found
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1616 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1617 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1618 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1619 (cond ((eq element-tag 'graphics-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1620 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1621 (unshift-variant (artist-go-get-unshifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1622 (shift-variant (artist-go-get-shifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1623 (unshift-sym (artist-go-get-symbol unshift-variant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1624 (shift-sym (artist-go-get-symbol shift-variant)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1625 (if (or (eq symbol unshift-sym) (eq symbol shift-sym))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1626 (throw 'found (if is-shifted shift-sym unshift-sym)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1627
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1628 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1629 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1630 (items (artist-mn-get-items info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1631 (answer (artist-go-get-symbol-shift-sub
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1632 items symbol is-shifted)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1633 (if answer (throw 'found answer)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1634
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1635 table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1636 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1637
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1638 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1639 ; Retrieving info from a function-call symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1640 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1641
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1642 (defun artist-fc-retrieve-from-symbol (symbol retrieve-fn)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1643 "Search the master table for a function call SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1644 Calls RETRIEVE-FN to retrieve information from that symbol's
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1645 info-variant-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1646 (artist-fc-retrieve-from-symbol-sub artist-mt symbol retrieve-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1647
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1648 (defun artist-fc-retrieve-from-symbol-sub (table symbol retrieve-fn)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1649 "Search TABLE for a function-call SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1650 Calls RETRIEVE-FN to retrieve information from that symbol's
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1651 info-variant-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1652 (catch 'found
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1653 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1654 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1655 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1656 (cond ((eq element-tag 'function-call)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1657 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1658 (fc-symbol (artist-fc-get-symbol info-part)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1659 (if (eq fc-symbol symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1660 (throw 'found (funcall retrieve-fn info-part)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1661
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1662 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1663 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1664 (items (artist-mn-get-items info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1665 (answer (artist-fc-retrieve-from-symbol-sub
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1666 items symbol retrieve-fn)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1667 (if answer (throw 'found answer)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1668
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1669 table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1670 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1671
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1672 (defun artist-fc-get-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1673 "Search the master table to get function from a function call SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1674 (artist-fc-retrieve-from-symbol symbol 'artist-fc-get-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1675
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1676
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1677 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1678 ;; Utilities
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1679 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1680
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1681 ;; Macro that won't funcall the function if it is nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1682 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1683 (defmacro artist-funcall (fn &rest args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1684 "Call function FN with ARGS iff FN is not nil."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1685 (list 'if fn (cons 'funcall (cons fn args))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1686
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
1687 (defvar artist-butlast-fn 'artist-butlast
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
1688 "The butlast function.")
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
1689
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
1690 (if (fboundp 'butlast)
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
1691 (setq artist-butlast-fn 'butlast)
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
1692 (setq artist-butlast-fn 'artist-butlast))
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
1693
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
1694 (defun artist-butlast (l)
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
1695 "Return the list L with all elements but the last."
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
1696 (cond ((null l) nil)
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
1697 ((null (cdr l)) nil)
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
1698 (t (cons (car l) (artist-butlast (cdr l))))))
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
1699
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
1700
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
1701 (defun artist-last (l &optional n)
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
1702 "Return the last link in the list L.
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1703 With optional argument N, returns Nth-to-last link (default 1)."
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
1704 (nth (- (length l) (or n 1)) l))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1705
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1706 (defun artist-remove-nulls (l)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1707 "Remove nils in list L."
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
1708 (remq nil l))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1709
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1710 (defun artist-uniq (l)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1711 "Remove consecutive duplicates in list L. Comparison is done with `equal'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1712 (cond ((null l) nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1713 ((null (cdr l)) l) ; only one element in list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1714 ((equal (car l) (car (cdr l))) (artist-uniq (cdr l))) ; first 2 equal
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1715 (t (cons (car l) (artist-uniq (cdr l)))))) ; first 2 are different
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1716
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1717 (defmacro artist-push (x stack)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1718 "Push element X to a STACK."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1719 (list 'setq stack (list 'cons x stack)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1720
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1721 (defmacro artist-pop (stack)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1722 "Pop an element from a STACK."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1723 (list 'prog1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1724 (list 'car stack)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1725 (list 'setq stack (list 'cdr stack))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1726
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1727 (defun artist-string-split (str r)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1728 "Split string STR at occurrences of regexp R, returning a list of strings."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1729 (let ((res nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1730 (start 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1731 (match-pos 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1732 (while (setq match-pos (string-match r str start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1733 (setq res (cons (copy-sequence (substring str start match-pos)) res))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1734 (setq start (match-end 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1735 (if (null res)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1736 (list str)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1737 (if (< (match-end 0) (- (length str) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1738 (setq res (cons (substring str (match-end 0) (length str)) res)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1739 (reverse res))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1740
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1741 (defun artist-string-to-file (str file-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1742 "Write string STR to file FILE-NAME."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1743 (write-region str 'end-is-ignored file-name nil 'no-message))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1744
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1745 (defun artist-file-to-string (file-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1746 "Read from file FILE-NAME into a string."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1747 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1748 (let ((tmp-buffer (get-buffer-create (concat "*artist-" file-name "*"))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1749 (set-buffer tmp-buffer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1750 (goto-char (point-min))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1751 (insert-file-contents file-name nil nil nil t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1752 (let ((str (copy-sequence (buffer-substring (point-min)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1753 (point-max)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1754 (kill-buffer tmp-buffer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1755 str))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1756
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1757 (defun artist-clear-buffer (buf)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1758 "Clear contents of buffer BUF."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1759 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1760 (set-buffer buf)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1761 (goto-char (point-min))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1762 (delete-char (- (point-max) (point-min)) nil)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1763
47953
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
1764
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1765 (defun artist-system (program stdin &optional program-args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1766 "Run PROGRAM synchronously with the contents of string STDIN to stdin.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1767 Optional args PROGRAM-ARGS are arguments to PROGRAM.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1768 Return a list (RETURN-CODE STDOUT STDERR)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1769 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1770 (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
1771 (make-temp-file
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1772 (concat (file-name-as-directory
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1773 (or (getenv "TMPDIR") "/tmp"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1774 "artist-stdin."))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1775 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1776 (tmp-stdout-buffer (get-buffer-create
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1777 (concat "*artist-" program "*")))
43685
498bad2aca78 (artist-system): Use make-temp-file.
Richard M. Stallman <rms@gnu.org>
parents: 42706
diff changeset
1778 (tmp-stderr-file-name (make-temp-file
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1779 (concat (file-name-as-directory
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1780 (or (getenv "TMPDIR") "/tmp"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1781 "artist-stdout.")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1782 (binary-process-input nil) ; for msdos
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1783 (binary-process-output nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1784
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1785 ;; Prepare stdin
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1786 (if stdin (artist-string-to-file stdin tmp-stdin-file-name))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1787
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1788 ;; Clear the buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1789 (artist-clear-buffer tmp-stdout-buffer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1790
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1791 ;; Start the program
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1792 (unwind-protect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1793 (let ((res (if program-args
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1794 (apply 'call-process
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1795 program
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1796 tmp-stdin-file-name
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1797 (list tmp-stdout-buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1798 tmp-stderr-file-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1799 nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1800 (if (stringp program-args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1801 (list program-args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1802 program-args))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1803 (apply 'call-process
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1804 program
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1805 tmp-stdin-file-name
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1806 (list tmp-stdout-buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1807 tmp-stderr-file-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1808 nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1809
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1810 ;; the return value
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1811 (list res
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1812 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1813 (set-buffer tmp-stdout-buffer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1814 (copy-sequence (buffer-substring (point-min)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1815 (point-max))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1816 (artist-file-to-string tmp-stderr-file-name)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1817
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1818 ;; Unwind: remove temporary files and buffers
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1819 (if (and stdin (file-exists-p tmp-stdin-file-name))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1820 (delete-file tmp-stdin-file-name))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1821 (if (file-exists-p tmp-stderr-file-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1822 (delete-file tmp-stderr-file-name))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1823 (if (memq tmp-stdout-buffer (buffer-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1824 (kill-buffer tmp-stdout-buffer))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1825
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1826 ;; Routines that deal with the buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1827 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1828 ;; artist-current-line get line number (top of buffer is 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1829 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1830 ;; artist-move-to-xy move to (x,y) (0,0) is beg-of-buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1831 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1832 ;; artist-get-char-at-xy get char in at (x,y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1833 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1834 ;; artist-replace-char overwrite (replace) char at point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1835 ;; artist-replace-chars overwrite (replace) chars at point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1836 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1837
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1838 (defsubst artist-current-column ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1839 "Return point's current column."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1840 (current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1841
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1842 (defsubst artist-current-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1843 "Return point's current line, buffer-relative. Top of buffer is 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1844 (+ (count-lines 1 (point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1845 (if (= (current-column) 0) 1 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1846 -1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1847
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1848 (defsubst artist-move-to-xy (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1849 "Move to column X, at row Y from the top of buffer. Top line is 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1850 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1851 ;; Q: Why do we do forward-line twice?
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1852 ;; A: The documentation for forward-line says
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1853 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1854 ;; "... Returns the count of lines left to move. ... With
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1855 ;; positive N, a non-empty line at the end counts as one
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1856 ;; line successfully moved (for the return value)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1857 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1858 ;; This means that if we are trying to move forward past the end
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1859 ;; of the buffer, and that last line happened to be longer than
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1860 ;; the current column, then we end up at the end of that last
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1861 ;; line, and forward-line returns one less than we actually
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1862 ;; wanted to move.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1863 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1864 ;; Example: In the figure below, the `X' is the very last
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1865 ;; character in the buffer ("a non-empty line at the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1866 ;; end"). Suppose point is at at P. Then (forward-line 1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1867 ;; returns 0 and puts point after the `X'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1868 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1869 ;; --------top of buffer--------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1870 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1871 ;; P X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1872 ;; -------bottom of buffer------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1873 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1874 ;; But, if we are at the end of buffer when trying to move
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1875 ;; forward, then forward-line will return the (for us) correct
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1876 ;; value, which is good, because we will come to the end of the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1877 ;; buffer by the first forward-line. The second forward-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1878 ;; will then get us where we really wanted to go.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1879 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1880 ;; If we are not moving past the end of the buffer, then the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1881 ;; second forward-line will return 0.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1882 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1883 ;; Q: What happens if we are moving upwards?
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1884 ;; A: That will work good. insert-char won't insert a negative
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1885 ;; number of chars, and forward-line will fail silently if we are
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1886 ;; moving past the beginning of the buffer.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1887 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1888 (forward-line (- y (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1889 (insert-char ?\n (forward-line (- y (artist-current-line))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1890 (move-to-column (max x 0) t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1891 (let ((curr-y (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1892 (setq artist-draw-region-min-y (min curr-y artist-draw-region-min-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1893 (setq artist-draw-region-max-y (max curr-y artist-draw-region-max-y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1894
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1895 (defsubst artist-get-char-at-xy (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1896 "Return the character found at column X, row Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1897 Also updates the variables `artist-draw-min-y' and `artist-draw-max-y'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1898 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1899 (let ((curr-y (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1900 (setq artist-draw-region-min-y (min curr-y artist-draw-region-min-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1901 (setq artist-draw-region-max-y (max curr-y artist-draw-region-max-y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1902 (following-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1903
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1904
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1905 (defun artist-get-char-at-xy-conv (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1906 "Retrieve the character at X, Y, converting tabs and new-lines to spaces."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1907 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1908 (aref artist-replacement-table (artist-get-char-at-xy x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1909
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1910
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1911 (defun artist-replace-char (new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1912 "Replace the character at point with NEW-CHAR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1913 ;; 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
1914 (if (and (and (boundp 'emacs-major-version) (= emacs-major-version 20))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1915 (and (boundp 'emacs-minor-version) (<= emacs-minor-version 3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1916 ;; This is a bug workaround for Emacs 20, versions up to 20.3:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1917 ;; The self-insert-command doesn't care about the overwrite-mode,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1918 ;; so the insertion is done in the same way as in picture mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1919 ;; This seems to be a little bit slower.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1920 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1921 (artist-move-to-xy (1+ (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1922 (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1923 (delete-char -1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1924 (insert (aref artist-replacement-table new-char)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1925 ;; In emacs-19, the self-insert-command works better and faster
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1926 (let ((overwrite-mode 'overwrite-mode-textual)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1927 (fill-column 32765) ; Large :-)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1928 (blink-matching-paren nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1929 (setq last-command-event (aref artist-replacement-table new-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1930 (self-insert-command 1))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1931
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1932 (defun artist-replace-chars (new-char count)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1933 "Replace characters at point with NEW-CHAR. COUNT chars are replaced."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1934 ;; 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
1935 (if (and (and (boundp 'emacs-major-version) (= emacs-major-version 20))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1936 (and (boundp 'emacs-minor-version) (<= emacs-minor-version 3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1937 ;; This is a bug workaround for Emacs 20, versions up to 20.3:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1938 ;; The self-insert-command doesn't care about the overwrite-mode,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1939 ;; so the insertion is done in the same way as in picture mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1940 ;; This seems to be a little bit slower.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1941 (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
1942 (replaced-s (make-string count replaced-c)))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1943 (artist-move-to-xy (+ (artist-current-column) count)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1944 (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1945 (delete-char (- count))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1946 (insert replaced-s))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1947 ;; In emacs-19, the self-insert-command works better
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1948 (let ((overwrite-mode 'overwrite-mode-textual)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1949 (fill-column 32765) ; Large :-)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1950 (blink-matching-paren nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1951 (setq last-command-event (aref artist-replacement-table new-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1952 (self-insert-command count))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1953
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1954 (defsubst artist-replace-string (string &optional see-thru)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1955 "Replace contents at point with STRING.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1956 With optional argument SEE-THRU, set to non-nil, text in the buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1957 ``shines thru'' blanks in the STRING."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1958 (let ((char-list (append string nil)) ; convert the string to a list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1959 (overwrite-mode 'overwrite-mode-textual)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1960 (fill-column 32765) ; Large :-)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1961 (blink-matching-paren nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1962 (while char-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1963 (let ((c (car char-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1964 (if (and see-thru (= (aref artist-replacement-table c) ?\ ))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1965 (artist-move-to-xy (1+ (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1966 (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1967 (artist-replace-char c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1968 (setq char-list (cdr char-list)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1969
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1970 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1971 ;; Routines for setting and unsetting points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1972 ;; Used when not rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1973 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1974 (defun artist-no-rb-unset-point1 ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1975 "Unsets point 1 when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1976 (let ((x-now (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1977 (y-now (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1978 (x (aref artist-rb-save-data 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1979 (y (aref artist-rb-save-data 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1980 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1981 (artist-replace-char (aref artist-rb-save-data 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1982 (artist-move-to-xy x-now y-now)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1983
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1984 (defun artist-no-rb-set-point1 (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1985 "Set point 1 at X, Y when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1986 (let ((x-now (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1987 (y-now (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1988 (aset artist-rb-save-data 0 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1989 (aset artist-rb-save-data 1 y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1990 (aset artist-rb-save-data 2 (artist-get-char-at-xy x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1991 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1992 (artist-replace-char artist-first-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1993 (artist-move-to-xy x-now y-now)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1994 (aset artist-rb-save-data 6 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1995
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1996 (defun artist-no-rb-unset-point2 ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1997 "This function unsets point 2 when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1998 (if (= (aref artist-rb-save-data 6) 1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1999 (let ((x-now (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2000 (y-now (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2001 (x (aref artist-rb-save-data 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2002 (y (aref artist-rb-save-data 4)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2003 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2004 (artist-replace-char (aref artist-rb-save-data 5))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2005 (artist-move-to-xy x-now y-now))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2006
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2007 (defun artist-no-rb-set-point2 (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2008 "Set point 2 at X, Y when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2009 (let ((x-now (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2010 (y-now (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2011 (aset artist-rb-save-data 3 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2012 (aset artist-rb-save-data 4 y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2013 (aset artist-rb-save-data 5 (artist-get-char-at-xy x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2014 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2015 (artist-replace-char artist-second-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2016 (artist-move-to-xy x-now y-now)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2017 (aset artist-rb-save-data 6 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2018
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2019 (defun artist-no-rb-unset-points ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2020 "This function unsets point 1 and 2 when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2021 (artist-no-rb-unset-point1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2022 (artist-no-rb-unset-point2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2023
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2024
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2025 ;; artist-intersection-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2026 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2027 ;; Note: If changing this, see the notes for artist-unintersection-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2028 ;; and artist-vaporize-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2029 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2030 (defun artist-intersection-char (new-c old-c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2031 "Calculates intersection character when drawing a NEW-C on top of an OLD-C.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2032 Return character according to this scheme:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2033
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2034 OLD-C NEW-C return
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2035 - | +
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2036 | - +
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2037 + | +
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2038 + - +
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2039 \\ / X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2040 / \\ X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2041 X / X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2042 X \\ X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2043 other combinations NEW-C"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2044
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2045 (cond ((and (= old-c ?- ) (= new-c ?| )) ?+ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2046 ((and (= old-c ?| ) (= new-c ?- )) ?+ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2047 ((and (= old-c ?+ ) (= new-c ?- )) ?+ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2048 ((and (= old-c ?+ ) (= new-c ?| )) ?+ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2049 ((and (= old-c ?\\ ) (= new-c ?/ )) ?X )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2050 ((and (= old-c ?/ ) (= new-c ?\\ )) ?X )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2051 ((and (= old-c ?X ) (= new-c ?/ )) ?X )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2052 ((and (= old-c ?X ) (= new-c ?\\ )) ?X )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2053 (t new-c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2054
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2055 ;; artist-unintersection-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2056 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2057 ;; Note: If changing this, see the note for artist-vaporize-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2058 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2059 (defun artist-unintersection-char (line-c buffer-c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2060 "Restore character to before intersection when removing LINE-C from BUFFER-C.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2061 Return character according to this scheme:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2062
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2063 LINE-C BUFFER-C return
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2064 - + |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2065 | + -
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2066 \\ X /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2067 / X \\
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2068 other combinations `artist-erase-char'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2069
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2070 (cond ((and (= line-c ?- ) (= buffer-c ?+ )) ?| )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2071 ((and (= line-c ?| ) (= buffer-c ?+ )) ?- )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2072 ((and (= line-c ?\\ ) (= buffer-c ?X )) ?/ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2073 ((and (= line-c ?/ ) (= buffer-c ?X )) ?\\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2074 ((= line-c buffer-c) artist-erase-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2075 (t buffer-c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2076
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2077
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2078 ;; Computing the line-char to use
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2079 ;; for use with borderless shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2080 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2081 (defsubst artist-compute-line-char ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2082 "Compute which character to use for lines, if any.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2083 Return value is either nil for the default characters that make up lines, or
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2084 a character chosen depending on the variables `artist-borderless-shapes',
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2085 `artist-fill-char-set', `artist-fill-char' and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2086 `artist-line-char-set' and `artist-line-char'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2087 (if (and artist-borderless-shapes artist-fill-char-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2088 artist-fill-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2089 (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2090 artist-line-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2091 nil)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2092
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2093
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2094 ;; Things for drawing horizontal, vertical and diagonal (straight) lines.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2095 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2096 ;; A line here is a vector:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2097 ;; [ start-x start-y length direction saved-char-1 saved-char-2 ... ]
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2098 ;; directions start with 0 at the x-axis and counts anti clockwise.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2099 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2100 (defvar artist-direction-info
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2101 ;; x y char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2102 [ [ 1 0 ?- ] ; direction 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2103 [ 1 1 ?\\ ] ; direction 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2104 [ 0 1 ?| ] ; direction 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2105 [ -1 1 ?/ ] ; direction 3
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2106 [ -1 0 ?- ] ; direction 4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2107 [ -1 -1 ?\\ ] ; direction 5
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2108 [ 0 -1 ?| ] ; direction 6
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2109 [ 1 -1 ?/ ] ] ; direction 7
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2110 "Table used for stepping x and y coordinates in a specific direction.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2111 This table is also used for determining which char to use for that direction.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2112
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2113 (defsubst artist-direction-step-x (direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2114 "Return the x-step for DIRECTION from the `artist-direction-info' table."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2115 (aref (aref artist-direction-info direction) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2116
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2117 (defsubst artist-direction-step-y (direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2118 "Return the y-step for DIRECTION from the `artist-direction-info' table."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2119 (aref (aref artist-direction-info direction) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2120
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2121 (defun artist-direction-char (direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2122 "Return the character for DIRECTION from the `artist-direction-info' table."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2123 (aref (aref artist-direction-info direction) 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2124
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2125 ;; artist-find-direction
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2126 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2127 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2128 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2129 (defun artist-find-direction (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2130 "Find the direction from point X1,Y1 to X2,Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2131 Returns a DIRECTION, a number 0--7, coded as follows:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2132
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2133 5 6 7
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2134 \\ | /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2135 4 - * - 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2136 / | \\
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2137 3 2 1"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2138 (let ((delta-x (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2139 (delta-y (- y2 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2140 (cond ((>= delta-x (* 2 (abs delta-y))) 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2141 ((>= delta-y (* 2 (abs delta-x))) 2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2142 ((>= (- delta-x) (* 2 (abs delta-y))) 4)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2143 ((>= (- delta-y) (* 2 (abs delta-x))) 6)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2144 ((and (>= delta-x 0) (>= delta-y 0)) 1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2145 ((and (<= delta-x 0) (>= delta-y 0)) 3)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2146 ((and (<= delta-x 0) (<= delta-y 0)) 5)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2147 ((and (>= delta-x 0) (<= delta-y 0)) 7))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2148
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2149 (defun artist-straight-calculate-length (direction x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2150 "Calculate length for a straight line in DIRECTION from X1,Y1 to X2,Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2151 (cond ((or (= direction 7)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2152 (= direction 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2153 (= direction 1)) (1+ (- x2 x1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2154 ((or (= direction 3)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2155 (= direction 4)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2156 (= direction 5)) (1+ (- x1 x2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2157 (t (1+ (abs (- y2 y1))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2158
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2159 (defun artist-sline (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2160 "Create a straight line from X1,Y1 to X2,Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2161 (let* ((direction (artist-find-direction x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2162 (length (artist-straight-calculate-length direction x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2163 (line (make-vector (+ length 4) x1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2164 ;; not needed:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2165 ;; (aset line 0 x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2166 ;; because we set all elements to x1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2167 (aset line 1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2168 (aset line 2 length)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2169 (aset line 3 direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2170 line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2171
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2172 (defun artist-save-chars-under-sline (line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2173 "Save characters under a LINE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2174 (let ((x (aref line 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2175 (y (aref line 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2176 (length (+ (aref line 2) 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2177 (direction (aref line 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2178 (i 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2179 (while (< i length)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2180 (aset line i (artist-get-char-at-xy x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2181 (setq x (+ x (artist-direction-step-x direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2182 (setq y (+ y (artist-direction-step-y direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2183 (setq i (1+ i))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2184 line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2185
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2186
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2187
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2188 ;; Things for drawing lines in all directions.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2189 ;; The line drawing engine is the eight-point alrogithm.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2190 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2191 ;; A line is here a list of (x y saved-char new-char)s.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2192 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2193 (defvar artist-octant-info
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2194 ;; Initial Step in Step in
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2195 ;; coeffs x and y x and y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2196 ;; for if q >= 0 if g < 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2197 ;; dfdx,dfdy
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2198 [ [ 2 1 1 0 1 1 ] ; 1st octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2199 [ 1 2 1 1 0 1 ] ; 2nd octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2200 [ -1 2 0 1 -1 1 ] ; 3rd octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2201 [ -2 1 -1 1 -1 0 ] ; 4th octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2202 [ -2 -1 -1 0 -1 -1 ] ; 5th octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2203 [ -1 -2 -1 -1 0 -1 ] ; 6th octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2204 [ 1 -2 0 -1 1 -1 ] ; 7th octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2205 [ 2 -1 1 -1 1 0 ] ] ; 8th octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2206 "Table used by line drawing algorithm (eight point).")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2207
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2208 ;; Primitives for the artist-octant-info.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2209 ;; Decrease octant by 1 since elt counts from 0 and octant counts from 1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2210 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2211 (defsubst artist-get-dfdx-init-coeff (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2212 "Retrieve dfdx component for OCTANT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2213 (aref (aref artist-octant-info (- octant 1)) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2214
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2215 (defsubst artist-get-dfdy-init-coeff (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2216 "Retrieve dfdy component for OCTANT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2217 (aref (aref artist-octant-info (- octant 1)) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2218
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2219 (defsubst artist-get-x-step-q>=0 (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2220 "Retrieve x-step component for OCTANT when q >= 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2221 (aref (aref artist-octant-info (- octant 1)) 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2222
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2223 (defsubst artist-get-y-step-q>=0 (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2224 "Retrieve y-step component for OCTANT when q >= 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2225 (aref (aref artist-octant-info (- octant 1)) 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2226
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2227 (defsubst artist-get-x-step-q<0 (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2228 "Retrieve x-step component for OCTANT for q < 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2229 (aref (aref artist-octant-info (- octant 1)) 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2230
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2231 (defsubst artist-get-y-step-q<0 (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2232 "Retrieve y-step component for OCTANT for q < 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2233 (aref (aref artist-octant-info (- octant 1)) 5))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2234
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2235
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2236 ;; Find octant from x1 y1 x2 y2 coordinates.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2237 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2238 (defun artist-find-octant (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2239 "Find octant for a line from X1,Y1 to X2,Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2240 Octant are numbered 1--8, anti-clockwise as:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2241
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2242 \\3|2/
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2243 4\\|/1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2244 ---+---
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2245 5/|\\8
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2246 /6|7\\"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2247
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2248 (if (<= x1 x2) ; quadrant 1 or 4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2249 (if (<= y1 y2) ; quadrant 1, octant 1 or 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2250 (if (>= (- x2 x1) (- y2 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2251 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2252 2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2253 (if (>= (- x2 x1) (- (- y2 y1))) ; quadrant 4, octant 7 or 8
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2254 8
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2255 7))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2256 (if (<= y1 y2) ; quadrant 2 or 3
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2257 (if (>= (- (- x2 x1)) (- y2 y1)) ; quadrant 2, octant 3 or 4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2258 4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2259 3)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2260 (if (>= (- (- x2 x1)) (- (- y2 y1))) ; quadrant 3, octant 5 or 6
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2261 5
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2262 6))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2263
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2264 ;; Some inline funtions for creating, setting and reading
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2265 ;; members of a coordinate
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2266 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2267 (defsubst artist-new-coord (x y &optional new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2268 "Create a new coordinate at X,Y for use in a line.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2269 Optional argument NEW-CHAR can be used for setting the new-char component
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2270 in the coord."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2271 (let ((coord (make-vector 4 x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2272 (aset coord 1 y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2273 (aset coord 3 new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2274 coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2275
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2276 (defsubst artist-coord-get-x (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2277 "Retrieve the x component of a COORD."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2278 (aref coord 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2279
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2280 (defsubst artist-coord-get-y (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2281 "Retrieve the y component of a COORD."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2282 (aref coord 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2283
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2284 (defsubst artist-coord-set-x (coord new-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2285 "Set the x component of a COORD to NEW-X."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2286 (aset coord 0 new-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2287 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2288
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2289 (defsubst artist-coord-set-y (coord new-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2290 "Set the y component of a COORD to NEW-Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2291 (aset coord 1 new-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2292 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2293
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2294 (defsubst artist-coord-get-saved-char (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2295 "Retrieve the saved char component of a COORD."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2296 (aref coord 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2297
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2298 (defsubst artist-coord-get-new-char (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2299 "Retrieve the new char component of a COORD."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2300 (aref coord 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2301
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2302 (defsubst artist-coord-add-saved-char (coord saved-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2303 "Set the saved char component of a COORD to SAVED-CHAR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2304 (aset coord 2 saved-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2305 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2306
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2307 (defsubst artist-coord-add-new-char (coord new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2308 "Set the new char component of a COORD to NEW-CHAR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2309 (aset coord 3 new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2310 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2311
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2312 (defsubst artist-coord-set-new-char (coord new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2313 "Set the new char component of a COORD to NEW-CHAR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2314 (aset coord 3 new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2315 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2316
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2317
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2318 ;; Pretend we are plotting a pixel. Instead we just list it
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2319 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2320 (defmacro artist-put-pixel (point-list x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2321 "In POINT-LIST, store a ``pixel'' at coord X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2322 (list 'setq point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2323 (list 'append point-list (list 'list (list 'artist-new-coord x y)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2324
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2325 ;; Calculate list of points using eight point algorithm
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2326 ;; return a list of coords
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2327 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2328 (defun artist-eight-point (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2329 "Run the eight-point algorithm to get a list of coords from X1,Y1 to X2,Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2330 (let* ((point-list nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2331 (octant (artist-find-octant x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2332 (dfdx-coeff (artist-get-dfdx-init-coeff octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2333 (dfdy-coeff (artist-get-dfdy-init-coeff octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2334 (x-step-q>=0 (artist-get-x-step-q>=0 octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2335 (y-step-q>=0 (artist-get-y-step-q>=0 octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2336 (x-step-q<0 (artist-get-x-step-q<0 octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2337 (y-step-q<0 (artist-get-y-step-q<0 octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2338 (dfdx (- (- y2 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2339 (dfdy (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2340 (x x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2341 (y y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2342 (f 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2343 (q (+ (* 2 f)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2344 (* dfdx-coeff dfdx)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2345 (* dfdy-coeff dfdy))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2346 (artist-put-pixel point-list x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2347 (while (or (not (eq x x2)) (not (eq y y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2348 (if (>= q 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2349 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2350 (setq x (+ x x-step-q>=0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2351 (setq y (+ y y-step-q>=0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2352 (setq f (+ f (* x-step-q>=0 dfdx) (* y-step-q>=0 dfdy))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2353 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2354 (setq x (+ x x-step-q<0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2355 (setq y (+ y y-step-q<0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2356 (setq f (+ f (* x-step-q<0 dfdx) (* y-step-q<0 dfdy)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2357 (setq q (+ (* 2 f) (* dfdx-coeff dfdx) (* dfdy-coeff dfdy)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2358 (artist-put-pixel point-list x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2359 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2360
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2361 ;; artist-save-chars-under-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2362 ;; Remebers the chars that were there before we did draw the line.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2363 ;; Returns point-list.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2364 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2365 (defun artist-save-chars-under-point-list (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2366 "Save characters originally under POINT-LIST."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2367 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2368 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2369 (artist-coord-add-saved-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2370 coord
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2371 (artist-get-char-at-xy (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2372 (artist-coord-get-y coord))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2373 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2374
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2375 ;; artist-calculate-new-char, artist-calculate-new-chars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2376 ;; Calculates which char to insert depending on direction of point-list.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2377 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2378 ;; Depending on new-coord's position relative to last-coord one of the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2379 ;; following chars are returned: \ | / - o, as indicated by this:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2380 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2381 ;; \ | /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2382 ;; - o -
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2383 ;; / | \
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2384 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2385 ;; artist-calculate-new-char works on one coordinate, returns char.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2386 ;; artist-calculate-new-chars works on a point-list, returns point-list.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2387 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2388 (defun artist-calculate-new-char (last-coord new-coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2389 "Return a line-char to use when moving from LAST-COORD to NEW-COORD."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2390 (let ((last-x (artist-coord-get-x last-coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2391 (last-y (artist-coord-get-y last-coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2392 (new-x (artist-coord-get-x new-coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2393 (new-y (artist-coord-get-y new-coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2394 (cond ((> new-x last-x) (cond ((< new-y last-y) ?/ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2395 ((> new-y last-y) ?\\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2396 (t ?- )))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2397 ((< new-x last-x) (cond ((< new-y last-y) ?\\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2398 ((> new-y last-y) ?/ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2399 (t ?- )))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2400 ((eq new-y last-y) ?o)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2401 (t ?| ))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2402
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2403 (defun artist-calculate-new-chars (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2404 "Return a list of coords with line-chars calculated. Input: POINT-LIST."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2405 (if (null (cdr point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2406 (list (artist-coord-add-new-char (car point-list) ?o ))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2407 (let ((last-coord (car point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2408 (cons (artist-coord-add-new-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2409 (car point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2410 (artist-calculate-new-char (car (cdr point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2411 (car point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2412 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2413 (lambda (this-coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2414 (prog1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2415 (artist-coord-add-new-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2416 this-coord
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2417 (artist-calculate-new-char last-coord this-coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2418 (setq last-coord this-coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2419 (cdr point-list))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2420
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2421 ;; artist-modify-new-chars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2422 ;; Replaces some characters with some other characters.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2423 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2424 ;; artist-modify-new-chars works on a point-list, returns point-list.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2425 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2426 (defun artist-modify-new-chars (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2427 "Replace intersecting characters in POINT-LIST.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2428 This function returns a point-list."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2429 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2430 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2431 (let* ((new-c (artist-coord-get-new-char coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2432 (saved-c (artist-coord-get-saved-char coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2433 (modified-c (artist-intersection-char new-c saved-c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2434 (artist-coord-set-new-char coord modified-c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2435 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2436
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2437
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2438 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2439 ;; functions for accessing endoints and elements in object requiring
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2440 ;; 2 endpoints
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2441 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2442
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2443 (defun artist-make-endpoint (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2444 "Create an endpoint at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2445 (let ((new-endpoint (make-vector 2 x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2446 (aset new-endpoint 1 y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2447 new-endpoint))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2448
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2449 (defun artist-endpoint-get-x (endpoint)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2450 "Retrieve the x component of an ENDPOINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2451 (aref endpoint 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2452
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2453 (defun artist-endpoint-get-y (endpoint)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2454 "Retrieve the y component of an ENDPOINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2455 (aref endpoint 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2456
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2457 (defun artist-make-2point-object (endpoint1 endpoint2 shapeinfo)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2458 "Create a 2-point object of ENDPOINT1, ENDPOINT2 and SHAPEINFO."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2459 (list endpoint1 endpoint2 shapeinfo))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2460
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2461 (defun artist-2point-get-endpoint1 (obj)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2462 "Retrieve the first endpoint of a 2-point object OBJ."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2463 (elt obj 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2464
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2465 (defun artist-2point-get-endpoint2 (obj)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2466 "Retrieve the second endpoint of a 2-point object OBJ."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2467 (elt obj 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2468
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2469 (defun artist-2point-get-shapeinfo (obj)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2470 "Retrieve the shapeinfo component of a 2-point object OBJ."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2471 (elt obj 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2472
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2473
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2474 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2475 ;; Drawing and undrawing lines (any direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2476 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2477
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2478 (defun artist-draw-line (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2479 "Draws a line from X1, Y1 to X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2480
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2481 Output is a line, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2482
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2483 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2484 SHAPE-INFO is a list of vectors [X Y SAVED-CHAR NEW-CHAR]."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2485 (let ((endpoint1 (artist-make-endpoint x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2486 (endpoint2 (artist-make-endpoint x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2487 (artist-make-2point-object
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2488 endpoint1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2489 endpoint2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2490 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2491 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2492 (artist-move-to-xy (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2493 (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2494 (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2495 (artist-replace-char artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2496 (artist-replace-char (artist-coord-get-new-char coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2497 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2498 (artist-modify-new-chars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2499 (artist-calculate-new-chars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2500 (artist-save-chars-under-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2501 (artist-eight-point x1 y1 x2 y2))))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2502
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2503 (defun artist-undraw-line (line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2504 "Undraws LINE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2505 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2506 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2507 (artist-move-to-xy (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2508 (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2509 (artist-replace-char (artist-coord-get-saved-char coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2510 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2511 (artist-2point-get-shapeinfo line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2512
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2513 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2514 ;; Drawing and undrawing straight lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2515 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2516
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2517 (defun artist-draw-sline (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2518 "Draw a strait line from X1, Y1 to X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2519 Straight lines are vertical, horizontal or diagonal lines.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2520 They are faster to draw and most often they are what you need
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2521 when drawing a simple image.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2522
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2523 Output is a straight line, which is a list on the form
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
2524 \(END-POINT-1 END-POINT-2 SHAPE-INFO).
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2525
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2526 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2527 SHAPE-INFO is a vector [START-X START-Y LENGTH-OF-LINE DIRECTION
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2528 ORIGINAL-CHAR-1 ORIGINAL-CHAR-2 ... ]."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2529 (let* ((line (artist-save-chars-under-sline (artist-sline x1 y1 x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2530 (x (aref line 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2531 (y (aref line 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2532 (length (+ (aref line 2) 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2533 (direction (aref line 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2534 (line-char (artist-direction-char direction))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2535 (i 4)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2536 (endpoint1 (artist-make-endpoint x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2537 (endpoint2 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2538 (while (< i length)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2539 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2540 (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2541 (artist-replace-char artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2542 (artist-replace-char (artist-intersection-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2543 line-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2544 (aref line i))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2545 (if (not (< (1+ i) length))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2546 ;; This is the last element. Set the second endpoint
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2547 (setq endpoint2 (artist-make-endpoint x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2548 (setq x (+ x (artist-direction-step-x direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2549 (setq y (+ y (artist-direction-step-y direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2550 (setq i (1+ i)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2551 (artist-make-2point-object endpoint1 endpoint2 line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2552
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2553
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2554 (defun artist-undraw-sline (line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2555 "Undraw a straight line LINE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2556 (if line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2557 (let* ((shape-info (artist-2point-get-shapeinfo line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2558 (x (aref shape-info 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2559 (y (aref shape-info 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2560 (length (+ (aref shape-info 2) 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2561 (direction (aref shape-info 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2562 (i 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2563 (while (< i length)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2564 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2565 (artist-replace-char (aref shape-info i))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2566 (setq x (+ x (artist-direction-step-x direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2567 (setq y (+ y (artist-direction-step-y direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2568 (setq i (1+ i))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2569
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2570
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2571 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2572 ;; Drawing and undrawing rectangles and squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2573 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2574
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2575 (defun artist-draw-rect (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2576 "Draws a rectangle with corners at X1, Y1 and X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2577
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2578 Output is a rectangle, which is a list on the form
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
2579 \(END-POINT-1 END-POINT-2 SHAPE-INFO).
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2580
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2581 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2582 SHAPE-INFO is a list of four straight lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2583 (let* ((artist-line-char (artist-compute-line-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2584 (artist-line-char-set artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2585 (line1 (artist-draw-sline x1 y1 x2 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2586 (line2 (artist-draw-sline x2 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2587 (line3 (artist-draw-sline x2 y2 x1 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2588 (line4 (artist-draw-sline x1 y2 x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2589 (endpoint1 (artist-make-endpoint x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2590 (endpoint2 (artist-make-endpoint x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2591 (artist-make-2point-object endpoint1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2592 endpoint2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2593 (list line1 line2 line3 line4))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2594
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2595 (defun artist-undraw-rect (rectangle)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2596 "Undraws RECTANGLE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2597 (if rectangle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2598 (let ((shape-info (artist-2point-get-shapeinfo rectangle)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2599 (artist-undraw-sline (elt shape-info 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2600 (artist-undraw-sline (elt shape-info 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2601 (artist-undraw-sline (elt shape-info 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2602 (artist-undraw-sline (elt shape-info 0)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2603
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2604
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2605 (defun artist-rect-corners-squarify (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2606 "Compute square corners from rectangle corners at X1, Y1 and X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2607 The square's first corner will be X1, Y1. The position of the second corner
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2608 depends on which of X2 and Y2 is most far away from X1, Y1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2609 (let* ((delta-x (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2610 (delta-y (- y2 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2611 (delta-x-sign (if (< delta-x 0) -1 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2612 (delta-y-sign (if (< delta-y 0) -1 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2613 (new-x2) ; set below
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2614 (new-y2)) ; set below
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2615
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2616 ;; Check which of x2 and y2 is most distant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2617 ;; take care to the aspect ratio
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2618 (if (> (abs delta-x) (abs delta-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2619
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2620 ;; *** x2 more distant than y2 (with care taken to aspect ratio)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2621 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2622 (setq new-x2 x2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2623 (setq new-y2 (+ y1 (round (/ (* (abs delta-x) delta-y-sign)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2624 artist-aspect-ratio)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2625
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2626 ;; *** y2 more distant than x2 (with care taken to aspect ratio)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2627 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2628 (setq new-x2 (round (+ x1 (* (* (abs delta-y) delta-x-sign)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2629 artist-aspect-ratio))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2630 (setq new-y2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2631
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2632 ;; Return this
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2633 (list x1 y1 new-x2 new-y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2634
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2635
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2636 (defun artist-draw-square (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2637 "Draw a square with corners at X1, Y1 and X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2638
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2639 Output is a square, which is a list on the form
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
2640 \(END-POINT-1 END-POINT-2 SHAPE-INFO).
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2641
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2642 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2643 SHAPE-INFO is a list of four straight lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2644 (let* ((artist-line-char (artist-compute-line-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2645 (artist-line-char-set artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2646 (square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2647 (new-x1 (elt square-corners 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2648 (new-y1 (elt square-corners 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2649 (new-x2 (elt square-corners 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2650 (new-y2 (elt square-corners 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2651 (endpoint1 (artist-make-endpoint new-x1 new-y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2652 (endpoint2 (artist-make-endpoint new-x2 new-y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2653 (line1 (artist-draw-sline new-x1 new-y1 new-x2 new-y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2654 (line2 (artist-draw-sline new-x2 new-y1 new-x2 new-y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2655 (line3 (artist-draw-sline new-x2 new-y2 new-x1 new-y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2656 (line4 (artist-draw-sline new-x1 new-y2 new-x1 new-y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2657 (artist-make-2point-object endpoint1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2658 endpoint2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2659 (list line1 line2 line3 line4))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2660
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2661 (defun artist-undraw-square (square)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2662 "Undraws SQUARE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2663 (if square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2664 (let ((shape-info (artist-2point-get-shapeinfo square)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2665 (artist-undraw-sline (elt shape-info 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2666 (artist-undraw-sline (elt shape-info 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2667 (artist-undraw-sline (elt shape-info 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2668 (artist-undraw-sline (elt shape-info 0)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2669
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2670 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2671 ;; Filling rectangles and squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2672 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2673
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2674 (defun artist-fill-rect (rect x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2675 "Fill rectangle RECT from X1,Y1 to X2,Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2676 (let ((x (1+ (min x1 x2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2677 (y (1+ (min y1 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2678 (x-max (max x1 x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2679 (y-max (max y1 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2680 (let ((w (- x-max x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2681 (while (< y y-max)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2682 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2683 (artist-replace-chars artist-fill-char w)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2684 (setq y (1+ y))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2685
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2686 (defun artist-fill-square (square x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2687 "Fills a SQUARE from X1,Y1 to X2,Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2688 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2689 (new-x1 (elt square-corners 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2690 (new-y1 (elt square-corners 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2691 (new-x2 (elt square-corners 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2692 (new-y2 (elt square-corners 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2693 (x (1+ (min new-x1 new-x2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2694 (y (1+ (min new-y1 new-y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2695 (x-max (max new-x1 new-x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2696 (y-max (max new-y1 new-y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2697 (w (- x-max x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2698 (while (< y y-max)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2699 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2700 (artist-replace-chars artist-fill-char w)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2701 (setq y (1+ y)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2702
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2703
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2704 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2705 ;; Pen drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2706 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2707
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2708 (defun artist-pen (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2709 "Draws a character at X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2710 The character is replaced with the character in `artist-fill-char'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2711 (artist-move-to-xy x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2712 (artist-replace-char (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2713 artist-line-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2714 (if artist-fill-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2715 artist-fill-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2716 artist-default-fill-char))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2717
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2718
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2719 (defun artist-pen-line (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2720 "Draws a line from last pen position to X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2721 The character is replaced with the character in `artist-fill-char'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2722 This will store all points in `artist-key-poly-point-list' in reversed
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2723 order (I assume it is faster to cons to the beginning of the list than
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2724 to append to the end of the list, when doing free-hand drawing)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2725 (let ((artist-line-char (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2726 artist-line-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2727 (if artist-fill-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2728 artist-fill-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2729 artist-default-fill-char))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2730
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2731 ;; Draw line from last point to this
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2732 (let ((x-last (car (car artist-key-poly-point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2733 (y-last (cdr (car artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2734 (artist-move-to-xy x-last y-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2735 (artist-replace-char artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2736 (artist-draw-line x-last y-last x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2737
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2738 ;; Update the point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2739 (setq artist-key-poly-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2740 (cons (cons x1 y1) artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2741
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2742 (defun artist-pen-reset-last-xy (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2743 "Reset the last x and y points to X1, Y1 when doing pen-drawing."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2744 (artist-clear-arrow-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2745 (setq artist-key-poly-point-list (list (cons x1 y1))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2746
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2747
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2748 (defun artist-pen-set-arrow-points (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2749 "Set arrow points for pen drawing using X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2750 Also, the `artist-key-poly-point-list' is reversed."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2751
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2752 (setq artist-key-poly-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2753 (artist-uniq artist-key-poly-point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2754
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2755 (if (>= (length artist-key-poly-point-list) 2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2756
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2757 ;; Only set arrow-points if the point-list has two or more entries
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2758 (let ((xn (car (car artist-key-poly-point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2759 (yn (cdr (car artist-key-poly-point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2760 (xn-1 (car (car (cdr artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2761 (yn-1 (cdr (car (cdr artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2762 (dirn)) ; direction for point n
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2763 (setq artist-key-poly-point-list (reverse artist-key-poly-point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2764 (let ((x0 (car (car artist-key-poly-point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2765 (y0 (cdr (car artist-key-poly-point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2766 (x1 (car (car (cdr artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2767 (y1 (cdr (car (cdr artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2768 (dir0)) ; direction for point 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2769 (setq dir0 (artist-find-direction x1 y1 x0 y0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2770 (setq dirn (artist-find-direction xn-1 yn-1 xn yn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2771 (setq artist-arrow-point-1 (artist-make-arrow-point x0 y0 dir0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2772 (setq artist-arrow-point-2 (artist-make-arrow-point xn yn dirn))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2773
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2774
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2775 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2776 ;; Text rendering
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2777 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2778 (defun artist-figlet-run (text font extra-args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2779 "Run figlet rendering TEXT using FONT.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2780 EXTRA-ARGS for figlet, for the command line, may be specified."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2781 (let* ((figlet-args (cond ((and font extra-args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2782 (cons (concat "-f" font)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2783 (artist-string-split extra-args "[ \t]+")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2784 (font (concat "-f" font))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2785 (extra-args
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2786 (artist-string-split extra-args "[ \t]+"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2787 (t nil)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2788 (figlet-output (artist-system artist-figlet-program text figlet-args))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2789 (exit-code (elt figlet-output 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2790 (stdout (elt figlet-output 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2791 (stderr (elt figlet-output 2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2792 (if (not (= exit-code 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2793 (error "Failed to render font: %s (%d)" stderr exit-code))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2794 stdout))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2795
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2796 (defun artist-figlet-get-font-list ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2797 "Read fonts in with the shell command.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2798 Returns a list of strings."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2799 (let* ((cmd-interpreter "/bin/sh")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2800 (ls-cmd artist-figlet-list-fonts-command)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2801 (result (artist-system cmd-interpreter ls-cmd nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2802 (exit-code (elt result 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2803 (stdout (elt result 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2804 (stderr (elt result 2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2805 (if (not (= exit-code 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2806 (error "Failed to read available fonts: %s (%d)" stderr exit-code))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2807 (artist-string-split stdout ".flf\n")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2808
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2809 (defun artist-figlet-choose-font ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2810 "Read any extra arguments for figlet."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2811 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2812 (let* ((avail-fonts (artist-figlet-get-font-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2813 (font (completing-read (concat "Select font: (default "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2814 artist-figlet-default-font
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2815 ") ")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2816 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2817 (lambda (font) (cons font font))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2818 avail-fonts))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2819 (if (string= font "") artist-figlet-default-font font)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2820
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2821 (defun artist-figlet-get-extra-args ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2822 "Read any extra arguments for figlet."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2823 (let ((extra-args (read-input "Extra args to figlet: ")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2824 (if (string= extra-args "")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2825 nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2826 extra-args)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2827
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2828 (defun artist-figlet (text)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2829 "Render TEXT using figlet."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2830 (let* ((figlet-font (artist-figlet-choose-font))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2831 (figlet-extra-args (artist-figlet-get-extra-args)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2832 (artist-figlet-run text figlet-font figlet-extra-args)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2833
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2834
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2835 (defun artist-text-insert-common (x y text see-thru)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2836 "At position X, Y, insert text TEXT.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2837 If SEE-THRU is non-nil, then blanks in TEXT does not replace text
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2838 in the buffer."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2839 (let* ((string-list (artist-string-split text "\n"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2840 (i 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2841 (len (length string-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2842 (while (< i len)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2843 (artist-move-to-xy x (+ y i))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2844 (artist-replace-string (car string-list) see-thru)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2845 (setq string-list (cdr string-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2846 (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
2847
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2848 (defun artist-text-insert-see-thru (x y text)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2849 "At position X, Y, insert text TEXT.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2850 Let text already in buffer shine thru the TEXT inserted."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2851 (artist-text-insert-common x y text t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2852
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2853 (defun artist-text-insert-overwrite (x y text)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2854 "At position X, Y, insert text TEXT.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2855 Let blanks in TEXT overwrite any text already in the buffer."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2856 (artist-text-insert-common x y text nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2857
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2858 (defun artist-text-see-thru (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2859 "Prompt for text to render, render it at X,Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2860 This is done by calling the function specified by `artist-text-renderer',
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2861 which must return a list of strings, to be inserted in the buffer.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2862
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2863 Text already in the buffer ``shines thru'' blanks in the rendered text."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2864 (let* ((input-text (read-input "Type text to render: "))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2865 (rendered-text (artist-funcall artist-text-renderer input-text)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2866 (artist-text-insert-see-thru x y rendered-text)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2867
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2868
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2869 (defun artist-text-overwrite (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2870 "Prompt for text to render, render it at X,Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2871 This is done by calling the function specified by `artist-text-renderer',
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2872 which must return a list of strings, to be inserted in the buffer.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2873
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2874 Blanks in the rendered text overwrites any text in the buffer."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2875 (let* ((input-text (read-input "Type text to render: "))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2876 (rendered-text (artist-funcall artist-text-renderer input-text)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2877 (artist-text-insert-overwrite x y rendered-text)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2878
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2879 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2880 ;; Spraying
47953
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
2881 ;;
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2882
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2883 (defun artist-spray-get-interval ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2884 "Retrieves the interval for repeated spray."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2885 artist-spray-interval)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2886
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2887 (defun artist-spray-random-points (n radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2888 "Generate N random points within a radius of RADIUS.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2889 Returns a list of points. Each point is on the form (X1 . Y1)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2890 (let ((points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2891 (while (> n 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2892 (let* ((angle (* (random 359) (/ pi 180)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2893 (dist (random radius))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2894 (point (cons (round (* dist (cos angle)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2895 (round (* dist (sin angle))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2896 (setq points (cons point points)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2897 (setq n (- n 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2898 points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2899
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2900 (defun artist-spray (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2901 "Spray at X1, Y1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2902 (let* ((num-points (* artist-spray-radius artist-spray-radius))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2903 (spray-points (artist-spray-random-points num-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2904 artist-spray-radius)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2905 (while spray-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2906 ;; Replace one spray point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2907 (let* ((point (car spray-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2908 (x (+ x1 (car point)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2909 (y (+ y1 (cdr point)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2910 (buf-c (artist-get-char-at-xy-conv x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2911 (this-c (memq buf-c artist-spray-chars))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2912 (next-c (cond ((null this-c) artist-spray-new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2913 ((null (cdr this-c)) (car this-c))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2914 (t (car (cdr this-c))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2915 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2916 (artist-replace-char next-c))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2917
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2918 ;; Step to next spray point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2919 (setq spray-points (cdr spray-points)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2920
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2921 (defun artist-spray-clear-circle (circle x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2922 "Clears circle CIRCLE at X1, Y1 through X2, Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2923 (artist-undraw-circle circle))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2924
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2925 (defun artist-spray-set-radius (circle x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2926 "Set spray radius from CIRCLE at X1, Y1 through X2, Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2927 (let ((dx (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2928 (dy (- y2 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2929 (setq artist-spray-radius (round (sqrt (+ (* dx dx) (* dy dy)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2930 (if (= 0 artist-spray-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2931 (setq artist-spray-radius 1))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2932
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2933 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2934 ;; Erasing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2935 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2936
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2937 (defun artist-erase-char (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2938 "Erases a character at X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2939 The character is replaced with the character in `artist-erase-char'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2940 (artist-move-to-xy x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2941 (artist-replace-char artist-erase-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2942
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2943 (defun artist-erase-rect (rect x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2944 "Erase rectangle RECT from X1, Y1, X2, Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2945 (let ((artist-line-char-set t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2946 (artist-fill-char-set t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2947 (artist-line-char artist-erase-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2948 (artist-fill-char artist-erase-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2949 (artist-draw-rect x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2950 (artist-fill-rect rect x1 y1 x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2951
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2952
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2953 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2954 ;; Vaporizing (erasing) line and lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2955 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2956
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2957
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2958 (defun artist-vap-find-endpoint (x1 y1 step-x step-y accept-set reject-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2959 "Find one endpoint for line through X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2960 The endpoint is searched for in the direction defined by STEP-X, STEP-Y,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2961 accepting characters in the list ACCEPT-SET, stopping immediately
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2962 when finding characters in the list REJECT-SET. Fuzziness, that is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2963 the number of consecutive characters not in ACCEPT-SET to allow as
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2964 part of the line, is determined by the variable `artist-vaporize-fuzziness'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2965 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2966 (let ((x x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2967 (y y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2968 (x-last x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2969 (y-last y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2970 (done nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2971 (while (not done)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2972 (let ((c (artist-get-char-at-xy-conv x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2973 (cond ((memq c reject-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2974 (setq done t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2975
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2976 ;; We found a character we are accepting as part of the line.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2977 ;; Update position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2978 ((memq c accept-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2979 (setq x-last x
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2980 y-last y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2981 x (+ x step-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2982 y (+ y step-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2983 (if (or (< x 0) (< y 0)) ;stop at the edge
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2984 (setq done t)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2985
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2986 ;; We found a character we are not accepting as part of
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2987 ;; the line Search `artist-vaporize-fuzziness'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2988 ;; characters away from this position in the same
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2989 ;; direction to see if there are any characters in the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2990 ;; accept-set. If not, we have found the endpoint.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2991 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2992 (let ((fuzziness artist-vaporize-fuzziness)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2993 (x-tmp x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2994 (y-tmp y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2995
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2996 ;; while we have more fuzziness left and we have not
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2997 ;; found a character accepted as a line, move
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2998 ;; forward!
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2999 (while (and (> fuzziness 0) (not (memq c accept-set)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3000 (setq x-tmp (+ x-tmp step-x))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3001 (setq y-tmp (+ y-tmp step-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3002 (setq c (artist-get-char-at-xy-conv x-tmp y-tmp))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3003 (setq fuzziness (- fuzziness 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3004 (if (memq c accept-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3005
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3006 ;; The line continues on the other side of the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3007 ;; not-accepted character.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3008 (setq x x-tmp
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3009 y y-tmp)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3010
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3011 ;; Else: We couldn't find any line on the other side.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3012 ;; That means we are done searching for the endpoint.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3013 (setq done t)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3014 (cons x-last y-last)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3015
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3016
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3017 (defun artist-vap-find-endpoints-horiz (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3018 "Find endpoints for a horizontal line through X, Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3019 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3020 (list (artist-vap-find-endpoint x y 1 0 '(?- ?+) '(? ))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3021 (artist-vap-find-endpoint x y -1 0 '(?- ?+) '(? ))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3022
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3023 (defun artist-vap-find-endpoints-vert (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3024 "Find endpoints for a vertical line through X, Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3025 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3026 (list (artist-vap-find-endpoint x y 0 1 '(?| ?+) '(? ))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3027 (artist-vap-find-endpoint x y 0 -1 '(?| ?+) '(? ))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3028
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3029 (defun artist-vap-find-endpoints-swne (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3030 "Find endpoints for a diagonal line (made by /'s) through X, Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3031 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3032 (list (artist-vap-find-endpoint x y 1 -1 '(?/ ?X) '(? ))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3033 (artist-vap-find-endpoint x y -1 1 '(?/ ?X) '(? ))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3034
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3035 (defun artist-vap-find-endpoints-nwse (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3036 "Find endpoints for a diagonal line (made by \\'s) through X, Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3037 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3038 (list (artist-vap-find-endpoint x y 1 1 '(?\\ ?X) '(? ))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3039 (artist-vap-find-endpoint x y -1 -1 '(?\\ ?X) '(? ))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3040
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3041
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3042 (defun artist-vap-find-endpoints (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3043 "Given a point X1, Y1, return a list of endpoints of lines through X, Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3044 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3045 (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3046 nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3047 (let ((c (artist-get-char-at-xy-conv x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3048 (cond ((eq c ?-) (artist-vap-find-endpoints-horiz x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3049 ((eq c ?|) (artist-vap-find-endpoints-vert x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3050 ((eq c ?/) (artist-vap-find-endpoints-swne x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3051 ((eq c ?\\) (artist-vap-find-endpoints-nwse x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3052 ((eq c ?+) (append (artist-vap-find-endpoints-horiz x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3053 (artist-vap-find-endpoints-vert x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3054 ((eq c ?X) (append (artist-vap-find-endpoints-swne x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3055 (artist-vap-find-endpoints-nwse x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3056
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3057 ;; We don't know how to find directions when we are on
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3058 ;; another character
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3059 (t nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3060
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3061
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3062 (defun artist-vap-group-in-pairs (l)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3063 "Group elements in list L in pairs."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3064 (cond ((null l) nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3065 ((null (cdr l)) l) ; unevent number of elements in list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3066 (t (append (list (list (car l) (car (cdr l))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3067 (artist-vap-group-in-pairs (cdr (cdr l)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3068
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3069 (defun artist-vaporize-by-endpoints (endpoint1 endpoint2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3070 "Given ENDPOINT1 and ENDPOINT2, vaporize the line between them.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3071 An endpoint is a pair (X . Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3072 (let* ((x1 (car endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3073 (y1 (cdr endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3074 (x2 (car endpoint2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3075 (y2 (cdr endpoint2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3076 (dir (artist-find-direction x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3077 (x-step (aref [1 1 0 -1 -1 -1 0 1] dir))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3078 (y-step (aref [0 1 1 1 0 -1 -1 -1] dir))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3079 (line-c (aref [?- ?\\ ?| ?/ ?- ?\\ ?| ?/] dir))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3080 (line-len (elt (list (abs (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3081 (abs (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3082 (abs (- y2 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3083 (abs (- y2 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3084 (abs (- x1 x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3085 (abs (- x1 x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3086 (abs (- y1 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3087 (abs (- y1 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3088 dir))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3089 (x x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3090 (y y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3091 (while (>= line-len 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3092 (let* ((buffer-c (artist-get-char-at-xy-conv x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3093 (new-c (artist-unintersection-char line-c buffer-c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3094 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3095 (artist-replace-char new-c))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3096 (setq x (+ x x-step)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3097 y (+ y y-step)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3098 line-len (- line-len 1)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3099
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3100
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3101 (defun artist-vaporize-line (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3102 "Vaporize (erase) the straight line through X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3103 Do this by replacing the characters that forms the line with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3104 `artist-erase-char'. Output is a list of endpoints for lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3105 through X1, Y1. An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3106 (let ((endpoints (artist-vap-find-endpoints x1 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3107 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3108 (lambda (endpoints)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3109 (let ((ep1 (car endpoints))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3110 (ep2 (car (cdr endpoints))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3111 (artist-vaporize-by-endpoints ep1 ep2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3112 (artist-vap-group-in-pairs endpoints))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3113 endpoints))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3114
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3115
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3116 ;; Implementation note: This depends on artist-vaporize-line doing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3117 ;; unintersections of intersecting lines.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3118 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3119 ;; Example:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3120 ;; Suppose the buffer looks like this and that we start vaporizing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3121 ;; lines at (3,0) (at the ``*'').
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3122 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3123 ;; 0123456
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3124 ;; 0+--*--+
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3125 ;; 1| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3126 ;; 2| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3127 ;; 3+-----+
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3128 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3129 ;; We will then push (0,0) and (6,0) on the stack, and vaporize the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3130 ;; topmost horizontal line:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3131 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3132 ;; 0123456
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3133 ;; 0| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3134 ;; 1| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3135 ;; 2| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3136 ;; 3+-----+
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3137 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3138 ;; We will then pop (0,0) and remove the left-most vertival line while
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3139 ;; pushing the lower left corner (0,3) on the stack, and so on until
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3140 ;; the entire rectangle is vaporized.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3141 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3142 ;; 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
3143 ;; had not been changed to `|' but to spaces instead? We would
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3144 ;; have failed when popping (0,0) and vaporizing that line because
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3145 ;; 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
3146 ;;
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3147 ;; 0123456
47953
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
3148 ;; 0
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3149 ;; 1| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3150 ;; 2| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3151 ;; 3+-----+
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3152 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3153 ;; That's why we depend on artist-vaporize-line doing unintersecting
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3154 ;; of crossing lines. There are alternative ways to handle this
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3155 ;; if it becomes too much a trouble.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3156 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3157 (defun artist-vaporize-lines (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3158 "Vaporize lines reachable from point X1, Y1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3159 (let ((ep-stack nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3160 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3161 (lambda (ep) (artist-push ep ep-stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3162 (artist-vap-find-endpoints x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3163 (while (not (null ep-stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3164 (let* ((vaporize-point (artist-pop ep-stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3165 (new-endpoints (artist-vaporize-line (car vaporize-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3166 (cdr vaporize-point))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3167 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3168 (lambda (endpoint) (artist-push endpoint ep-stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3169 new-endpoints)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3170
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3171
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3172 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3173 ;; Circles and ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3174 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3175 (defun artist-ellipse-generate-quadrant (x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3176 "Create a point-list for first quadrant.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3177 Points go from (X-RADIUS, 0) to (0, Y-RADIUS).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3178 Quadrant is generated around origo."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3179 (let* ((rx2 (* x-radius x-radius))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3180 (ry2 (* y-radius y-radius))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3181 (2rx2 (* 2 rx2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3182 (2ry2 (* 2 ry2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3183 (p)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3184 (x 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3185 (y y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3186 (px 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3187 (py (* 2rx2 y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3188 (point-list nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3189 (artist-put-pixel point-list x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3190 (setq p (round (+ ry2 (- (* rx2 y-radius)) (* 0.25 rx2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3191 (while (< px py)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3192 (setq x (1+ x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3193 px (+ px 2ry2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3194 (if (< p 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3195 (setq p (+ p ry2 px))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3196 (setq y (- y 1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3197 py (- py 2rx2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3198 p (+ p ry2 px (- py))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3199 (artist-put-pixel point-list x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3200 (setq p (round (+ (* ry2 (+ x 0.5) (+ x 0.5))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3201 (* rx2 (- y 1) (- y 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3202 (- (* rx2 ry2)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3203 (while (> y 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3204 (setq y (- y 1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3205 py (- py 2rx2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3206 (if (> p 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3207 (setq p (+ p rx2 (- py)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3208 (setq x (1+ x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3209 px (+ px 2ry2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3210 p (+ p rx2 (- py) px)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3211 (artist-put-pixel point-list x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3212 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3213
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3214 (defsubst artist-new-fill-item (x y width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3215 "Create a new item at X, Y, with WIDTH.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3216 This is for use in fill-info in ellipses and circles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3217 (let ((new-item (make-vector 3 x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3218 (aset new-item 1 y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3219 (aset new-item 2 width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3220 new-item))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3221
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3222 (defsubst artist-fill-item-get-x (fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3223 "Retrieve the x component of a FILL-ITEM."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3224 (aref fill-item 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3225
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3226 (defsubst artist-fill-item-set-x (fill-item new-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3227 "Set the x component of a FILL-ITEM to NEW-X."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3228 (aset fill-item 0 new-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3229 fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3230
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3231 (defsubst artist-fill-item-get-y (fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3232 "Retrieve the y component of a FILL-ITEM."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3233 (aref fill-item 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3234
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3235 (defsubst artist-fill-item-set-y (fill-item new-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3236 "Set the y component of a FILL-ITEM to NEW-Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3237 (aset fill-item 1 new-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3238 fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3239
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3240 (defsubst artist-fill-item-get-width (fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3241 "Retrieve the width component of a FILL-ITEM."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3242 (aref fill-item 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3243
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3244 (defsubst artist-fill-item-set-width (fill-item new-width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3245 "Set the width component of a FILL-ITEM to NEW-WIDTH."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3246 (aset fill-item 2 new-width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3247 fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3248
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3249
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3250 (defun artist-ellipse-point-list-add-center (x-center y-center point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3251 "Add offsets X-CENTER and Y-CENTER to coordinates in POINT-LIST."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3252 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3253 (lambda (p)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3254 (artist-coord-set-x p (+ x-center (artist-coord-get-x p)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3255 (artist-coord-set-y p (+ y-center (artist-coord-get-y p))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3256 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3257
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3258
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3259 (defun artist-ellipse-fill-info-add-center (x-center y-center fill-info)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3260 "Add offsets X-CENTER and Y-CENTER to fill-items in FILL-INFO."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3261 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3262 (lambda (p)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3263 (artist-fill-item-set-x p (+ x-center (artist-fill-item-get-x p)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3264 (artist-fill-item-set-y p (+ y-center (artist-fill-item-get-y p))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3265 fill-info))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3266
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3267 (defun artist-ellipse-remove-0-fills (fill-info)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3268 "Remove fill-infos from FILL-INFO that fills a zero-width field."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3269 (cond ((null fill-info)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3270 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3271 ((= 0 (artist-fill-item-get-width (car fill-info)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3272 (artist-ellipse-remove-0-fills (cdr fill-info)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3273 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3274 (append (list (car fill-info))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3275 (artist-ellipse-remove-0-fills (cdr fill-info))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3276
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3277
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3278 (defun artist-ellipse-compute-fill-info (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3279 "Compute fill info for ellipse around 0,0 from POINT-LIST.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3280 The POINT-LIST is expected to cover the first quadrant."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3281 (let ((first-half nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3282 (both-halves nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3283 (last-y nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3284
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3285 ;; Create first half (the lower one (since y grows downwards)) from
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3286 ;; the first quadrant.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3287 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3288 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3289 (let* ((x (artist-coord-get-x coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3290 (y (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3291 (width (max (- (* 2 x) 1) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3292 (left-edge (- x width)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3293 (if (or (null last-y) (not (= y last-y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3294 ;; This was either the first time,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3295 ;; or it was the first time on a new line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3296 (setq first-half
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3297 (append first-half
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3298 ;; Fill info item starts at left-edge on line y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3299 (list (artist-new-fill-item left-edge y width)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3300 (setq last-y y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3301 point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3302
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3303 ;; Create the other half by mirroring the first half.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3304 (setq both-halves
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3305 (append first-half
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3306 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3307 (lambda (i)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3308 (artist-new-fill-item (artist-fill-item-get-x i)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3309 (- (artist-fill-item-get-y i))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3310 (artist-fill-item-get-width i)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3311 ;; The cdr below is so we don't include fill-info for
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3312 ;;; the middle line twice
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3313 (cdr (reverse first-half)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3314 (artist-ellipse-remove-0-fills both-halves)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3315
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3316
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3317 (defun artist-ellipse-mirror-quadrant (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3318 "Mirror a POINT-LIST describing first quadrant to create a complete ellipse."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3319 (let ((right-half nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3320 (left-half nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3321
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3322 ;; First, if last char in that quadrant is `/', then replace it with `)'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3323 ;; This way we avoids things
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3324 ;; --------- ---------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3325 ;; / \ / \
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3326 ;; that look like: \ / instead we get: ( )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3327 ;; \ / \ /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3328 ;; --------- ---------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3329 (let ((last-coord (artist-last point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3330 (if (= (artist-coord-get-new-char last-coord) ?/)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3331 (artist-coord-set-new-char last-coord artist-ellipse-right-char)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3332
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3333 ;; Create the other part of the right half by mirroring the first part
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3334 (setq right-half
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3335 (append
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3336 point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3337 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3338 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3339 (let ((c (artist-coord-get-new-char coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3340 (artist-new-coord (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3341 (- (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3342 (cond ((= c ?/) ?\\)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3343 ((= c ?\\) ?/)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3344 (t c)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3345 ;; The cdr below is so we don't draw the middle right char twice
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3346 (cdr (reverse point-list)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3347
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3348 ;; Create the left half by mirroring the right half.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3349 (setq left-half
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3350 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3351 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3352 (let ((c (artist-coord-get-new-char coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3353 (artist-new-coord (- (artist-coord-get-x coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3354 (artist-coord-get-y coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3355 (cond ((= c ?/) ?\\)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3356 ((= c ?\\) ?/)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3357 ((= c artist-ellipse-right-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3358 artist-ellipse-left-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3359 (t c)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3360 ;; The cdr and butlast below is so we don't draw the middle top
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3361 ;; and middle bottom char twice.
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
3362 (funcall artist-butlast-fn (cdr (reverse right-half)))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3363 (append right-half left-half)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3364
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3365
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3366 (defun artist-draw-ellipse-general (x1 y1 x-radius y-radius)
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3367 "Draw an ellipse with center at X1, Y1 and X-RADIUS and Y-RADIUS.
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3368
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3369 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3370
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3371 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3372 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3373
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3374 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3375 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3376
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3377 Ellipses with zero Y-RADIUS are not drawn correctly."
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3378 (let* ((point-list (artist-ellipse-generate-quadrant x-radius y-radius))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3379 (fill-info (artist-ellipse-compute-fill-info point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3380 (shape-info (make-vector 2 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3381
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3382 (setq point-list (artist-calculate-new-chars point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3383 (setq point-list (artist-ellipse-mirror-quadrant point-list))
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3384 (setq point-list (artist-ellipse-point-list-add-center x1 y1 point-list))
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3385 (setq fill-info (artist-ellipse-fill-info-add-center x1 y1 fill-info))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3386
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3387 ;; Draw the ellipse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3388 (setq point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3389 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3390 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3391 (artist-move-to-xy (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3392 (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3393 (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3394 (artist-replace-char artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3395 (artist-replace-char (artist-coord-get-new-char coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3396 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3397 (artist-modify-new-chars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3398 (artist-save-chars-under-point-list point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3399
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3400 (aset shape-info 0 point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3401 (aset shape-info 1 fill-info)
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3402 (artist-make-2point-object (artist-make-endpoint x1 y1)
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3403 (artist-make-endpoint x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3404 shape-info)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3405
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3406 (defun artist-draw-ellipse-with-0-height (x1 y1 x-radius y-radius)
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3407 "Draw an ellipse with center at X1, Y1 and X-RADIUS and Y-RADIUS.
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3408
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3409 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3410
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3411 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3412 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3413
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3414 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3415 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3416
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3417 The Y-RADIUS must be 0, but the X-RADIUS must not be 0."
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3418 (let ((point-list nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3419 (width (max (- (abs (* 2 x-radius)) 1)))
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3420 (left-edge (1+ (- x1 (abs x-radius))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3421 (line-char (if artist-line-char-set artist-line-char ?-))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3422 (i 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3423 (point-list nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3424 (fill-info nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3425 (shape-info (make-vector 2 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3426 (while (< i width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3427 (let* ((line-x (+ left-edge i))
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3428 (line-y y1)
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3429 (new-coord (artist-new-coord line-x line-y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3430 (artist-coord-add-saved-char new-coord
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3431 (artist-get-char-at-xy line-x line-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3432 (artist-move-to-xy line-x line-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3433 (artist-replace-char line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3434 (setq point-list (append point-list (list new-coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3435 (setq i (1+ i))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3436 (aset shape-info 0 point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3437 (aset shape-info 1 fill-info)
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3438 (artist-make-2point-object (artist-make-endpoint x1 y1)
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3439 (artist-make-endpoint x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3440 shape-info)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3441
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3442 (defun artist-draw-ellipse (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3443 "Draw an ellipse with center at X1, Y1 and point X2,Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3444
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3445 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3446
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3447 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3448 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3449
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3450 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3451 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3452 (let* ((artist-line-char (artist-compute-line-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3453 (artist-line-char-set artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3454 (width (abs (- x2 x1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3455 (height (abs (- y2 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3456 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3457 ;; When we draw our ellipse, we want it to go through the cursor
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3458 ;; position, but since x1,y1, x2,y2 marks the corners of one
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3459 ;; of the quadrants, we have to enlarge the ellipse a bit.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3460 ;; Ok, so then why by sqrt(2)?
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3461 ;; It comes from the equation for the ellipse (where a is the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3462 ;; x-radius and b is the y-radius):
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3463 ;; f(x,y) = x^2 / a^2 + y^2 / b^2 - 1 = 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3464 ;; and the fact that we want the enlarged ellipse to have the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3465 ;; same proportions as the smaller square, therefore we have:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3466 ;; a/b = x/y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3467 ;; Solving this yields a-in-larger-ellipse = a-in-smaller * sqrt(2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3468 (x-radius (round (* width (sqrt 2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3469 (y-radius (round (* height (sqrt 2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3470 (x x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3471 (y y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3472 (if (and (= y1 y2) (not (= x1 x2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3473 (artist-draw-ellipse-with-0-height x y x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3474 (artist-draw-ellipse-general x y x-radius y-radius))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3475
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3476
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3477 (defun artist-undraw-ellipse (ellipse)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3478 "Undraw ELLIPSE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3479 (if ellipse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3480 (let ((point-list (aref (artist-2point-get-shapeinfo ellipse) 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3481 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3482 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3483 (artist-move-to-xy (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3484 (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3485 (artist-replace-char (artist-coord-get-saved-char coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3486 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3487 point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3488
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3489
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3490 (defun artist-draw-circle (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3491 "Draw a circle with center at X1, Y1 and point X2,Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3492
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3493 Output is an ellipse, which is a list (END-POINT-1 END-POINT-2 SHAPE-INFO).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3494
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3495 END-POINT-1 and END-POINT-2 are two-element vectors on the form [X Y].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3496 SHAPE-INFO is a two-element vector on the form [POINT-LIST FILL-INFO].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3497
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3498 POINT-LIST is a list of vectors on the form [X Y SAVED-CHAR NEW-CHAR].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3499 FILL-INFO is a list of vectors on the form [X Y ELLIPSE-WIDTH-ON-THIS-LINE]."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3500 (let* ((artist-line-char (artist-compute-line-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3501 (artist-line-char-set artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3502 (width (abs (- x2 x1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3503 (height (abs (- y2 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3504 ;; When drawing our circle, we want it to through the cursor
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3505 ;; just as when drawing the ellispe, but we have to take
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3506 ;; care for the aspect-ratio.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3507 ;; The equation for the ellipse (where a is the x-radius and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3508 ;; b is the y-radius):
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3509 ;; f(x,y) = x^2 / a^2 + y^2 / b^2 - 1 = 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3510 ;; together with the relationship
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3511 ;; a = aspect-ratio * b
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3512 ;; gives
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3513 ;; a = sqrt( x^2 + (aspect-ratio * y)^2 ) and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3514 ;; b = a / aspect-ratio
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3515 (x-radius (round (sqrt (+ (* width width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3516 (* (* artist-aspect-ratio height)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3517 (* artist-aspect-ratio height))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3518 (y-radius (round (/ x-radius artist-aspect-ratio))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3519 (artist-draw-ellipse-general x1 y1 x-radius y-radius)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3520
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3521 (defalias 'artist-undraw-circle 'artist-undraw-ellipse)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3522
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3523
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3524 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3525 ; Filling ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3526 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3527 (defun artist-fill-ellipse (ellipse x y x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3528 "Fill an ELLIPSE centered at X,Y with radius X-RADIUS and Y-RADIUS."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3529 (let ((fill-info (aref (artist-2point-get-shapeinfo ellipse) 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3530 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3531 (lambda (fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3532 (artist-move-to-xy (artist-fill-item-get-x fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3533 (artist-fill-item-get-y fill-item))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3534 (artist-replace-chars artist-fill-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3535 (artist-fill-item-get-width fill-item))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3536 fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3537 fill-info)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3538
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3539 (defalias 'artist-fill-circle 'artist-fill-ellipse)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3540
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3541
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3542 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3543 ;; Cutting, copying and pasting rectangles and squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3544 ;; (filling functions)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3545 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3546
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3547 (defun artist-cut-rect (rect x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3548 "Copy rectangle RECT drawn from X1, Y1 to X2, Y2, then clear it."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3549 (artist-undraw-rect rect)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3550 (artist-copy-generic x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3551 (artist-erase-rect rect x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3552
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3553 (defun artist-cut-square (square x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3554 "Copy a SQUARE drawn from X1, Y1 to X2, Y2 (made square), then clears it."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3555 (artist-undraw-square square)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3556 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3557 (new-x1 (elt square-corners 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3558 (new-y1 (elt square-corners 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3559 (new-x2 (elt square-corners 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3560 (new-y2 (elt square-corners 3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3561 (artist-copy-generic new-x1 new-y1 new-x2 new-y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3562 (artist-erase-rect square new-x1 new-y1 new-x2 new-y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3563
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3564
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3565 (defun artist-get-buffer-contents-at-xy (x y width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3566 "Retrieve contents from the buffer at X, Y. WIDTH characters are returned."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3567 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3568 (let ((here (point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3569 (there (save-excursion (artist-move-to-xy (+ x width) y) (point))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3570 (untabify here there)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3571 (setq there (save-excursion (artist-move-to-xy (+ x width) y) (point)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3572 (buffer-substring here there)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3573
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3574
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3575 (defun artist-copy-generic (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3576 "Copy a rectangular area with corners at X1, Y1 and X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3577 Output is a copy buffer, a list of strings, representing the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3578 original contents of that area in the buffer."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3579 (let* ((x (min x1 x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3580 (y (min y1 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3581 (x-max (max x1 x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3582 (y-max (max y1 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3583 (w (+ (- x-max x) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3584 (l nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3585 (while (<= y y-max)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3586 (setq l (cons (artist-get-buffer-contents-at-xy x y w) l))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3587 (setq y (1+ y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3588 (if artist-interface-with-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3589 (setq killed-rectangle (reverse l))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3590 (setq artist-copy-buffer (reverse l)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3591
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3592
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3593 (defun artist-copy-rect (rect x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3594 "Copy rectangle RECT drawn from X1, Y1 to X2, Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3595 (artist-undraw-rect rect)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3596 (artist-copy-generic x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3597
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3598 (defun artist-copy-square (square x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3599 "Copies a SQUARE drawn from X1, Y1 to X2, Y2 (but made square)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3600 (artist-undraw-square square)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3601 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3602 (new-x1 (elt square-corners 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3603 (new-y1 (elt square-corners 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3604 (new-x2 (elt square-corners 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3605 (new-y2 (elt square-corners 3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3606 (artist-copy-generic new-x1 new-y1 new-x2 new-y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3607
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3608 (defun artist-paste (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3609 "Pastes the contents of the copy-buffer at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3610 (let ((copy-buf (if artist-interface-with-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3611 killed-rectangle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3612 artist-copy-buffer)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3613 (if (not (null copy-buf))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3614 (while (not (null copy-buf))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3615 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3616 (artist-replace-string (car copy-buf))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3617 (setq copy-buf (cdr copy-buf))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3618 (setq y (1+ y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3619 (message "Nothing to paste"))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3620
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3621
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3622 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3623 ;; Flood filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3624 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3625 (defun artist-ff-too-far-right (x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3626 "Determine if the position X is too far to the right."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3627 (cond ((numberp artist-flood-fill-right-border)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3628 (> x artist-flood-fill-right-border))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3629 ((eq artist-flood-fill-right-border 'window-width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3630 (> x (- (window-width) 2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3631 ((eq artist-flood-fill-right-border 'fill-column)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3632 (> x fill-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3633 (t (error "Invalid value for `artist-flood-fill-right-border'"))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3634
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3635 (defun artist-ff-get-rightmost-from-xy (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3636 "Find the rightmost position in this run, starting at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3637 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3638 (let ((char-at-xy (artist-get-char-at-xy-conv x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3639 (last-x x))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3640 (setq x (1+ x))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3641 (while (and (not (artist-ff-too-far-right x))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3642 (= char-at-xy (artist-get-char-at-xy-conv x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3643 (setq last-x x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3644 (setq x (1+ x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3645 last-x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3646
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3647 (defun artist-ff-is-topmost-line (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3648 "Determine whether the position X,Y is on the topmost line or not."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3649 (= y 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3650
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3651 (defun artist-ff-is-bottommost-line (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3652 "Determine whether the position X,Y is on the bottommost line or not."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3653 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3654 (goto-char (point-max))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3655 (beginning-of-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3656 (let ((last-line (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3657 (if (= (point) (point-max))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3658
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3659 ;; Last line is empty, don't paint on it, report previous line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3660 ;; 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
3661 (>= 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
3662 (>= y last-line)))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3663
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3664 (defun artist-flood-fill (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3665 "Flood-fill starting at X1, Y1. Fill with the char in `artist-fill-char'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3666 (let ((stack nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3667 (input-queue nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3668 ;; We are flood-filling the area that has this character.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3669 (c (artist-get-char-at-xy-conv x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3670 (artist-fill-char (if artist-fill-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3671 artist-fill-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3672 artist-default-fill-char)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3673
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3674 ;; Fill only if the fill-char is not the same as the character whose
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3675 ;; area we are about to fill, or, in other words, don't fill if we
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3676 ;; needn't.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3677 (if (not (= c artist-fill-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3678 (artist-push (artist-new-coord x1 y1) stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3679
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3680 (while (not (null stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3681 (let* ((coord (artist-pop stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3682 (x (artist-coord-get-x coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3683 (y (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3684
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3685 ;; Here we keep track of the leftmost and rightmost position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3686 ;; for this run
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3687 (x-leftmost 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3688 (x-rightmost 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3689 (last-x 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3690
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3691 ;; Remember if line above and below are accessible
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3692 ;; Lines below the last one, and prior to the first-one
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3693 ;; are not accessible.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3694 (lines-above nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3695 (lines-below nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3696
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3697 ;; Remember char for position on line above and below, so we
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3698 ;; can find the rightmost positions on the runs.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3699 (last-c-above -1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3700 (last-c-below -1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3701
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3702 (setq x-rightmost (artist-ff-get-rightmost-from-xy x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3703 (setq lines-above (not (artist-ff-is-topmost-line x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3704 (setq lines-below (not (artist-ff-is-bottommost-line x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3705 (setq last-x x-rightmost)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3706 (setq x x-rightmost)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3707
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3708 ;; Search line above, push rightmost positions of runs for that line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3709 (while (and (>= x 0) (= c (artist-get-char-at-xy-conv x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3710 (if lines-above
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3711 (let ((c-above (artist-get-char-at-xy-conv x (- y 1))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3712 (if (and (= c-above c) (/= c-above last-c-above))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3713 (artist-push (artist-new-coord x (- y 1)) stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3714 (setq last-c-above c-above)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3715 (setq last-x x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3716 (setq x (- x 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3717
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3718 ;; Remember the left-most position on this run
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3719 (setq x-leftmost last-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3720
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3721 ;; Search line below, push rightmost positions of runs for that line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3722 (setq x x-rightmost)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3723 (while (>= x x-leftmost)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3724 (if lines-below
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3725 (let ((c-below (artist-get-char-at-xy-conv x (1+ y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3726 (if (and (= c-below c) (/= c-below last-c-below))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3727 (artist-push (artist-new-coord x (1+ y)) stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3728 (setq last-c-below c-below)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3729 (setq x (- x 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3730
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3731 (artist-move-to-xy x-leftmost y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3732 (artist-replace-chars artist-fill-char (1+ (- x-rightmost x-leftmost)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3733
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3734 ;; If we are to show incrementally, we have to remove any pending
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3735 ;; input from the input queue, because processing of pending input
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3736 ;; always has priority over display updates (although this input
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3737 ;; won't be processed until we are done). Later on we will queue
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3738 ;; the input on the input queue again.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3739 (if artist-flood-fill-show-incrementally
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3740 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3741 (if (input-pending-p)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3742 (discard-input))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3743 (artist-update-display)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3744
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3745 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3746 ;; Accessors to arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3747 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3748
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3749 (defun artist-make-arrow-point (x y direction &optional state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3750 "Create an arrow point at X, Y for a line in direction DIRECTION.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3751 Optional argument STATE can be used to set state (default is nil)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3752 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3753 (let* ((arrow-point (make-vector 4 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3754 (arrow-marker (make-marker)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3755 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3756 (set-marker arrow-marker (point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3757 (aset arrow-point 0 arrow-marker)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3758 (aset arrow-point 1 (artist-get-char-at-xy x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3759 (aset arrow-point 2 direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3760 (aset arrow-point 3 state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3761 arrow-point)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3762
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3763 (defsubst artist-arrow-point-get-marker (arrow-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3764 "Retrieve the marker component of an ARROW-POINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3765 (aref arrow-point 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3766
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3767 (defsubst artist-arrow-point-get-orig-char (arrow-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3768 "Retrieve the orig char component of an ARROW-POINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3769 (aref arrow-point 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3770
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3771 (defsubst artist-arrow-point-get-direction (arrow-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3772 "Retrieve the direction component of an ARROW-POINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3773 (aref arrow-point 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3774
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3775 (defsubst artist-arrow-point-get-state (arrow-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3776 "Retrieve the state component of an ARROW-POINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3777 (aref arrow-point 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3778
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3779 (defsubst artist-arrow-point-set-state (arrow-point new-state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3780 "Set the state component of an ARROW-POINT to NEW-STATE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3781 (aset arrow-point 3 new-state))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3782
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3783
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3784 (defun artist-clear-arrow-points ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3785 "Clear current endpoints."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3786 (setq artist-arrow-point-1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3787 (setq artist-arrow-point-2 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3788
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3789 (defun artist-set-arrow-points-for-poly (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3790 "Generic function for setting arrow-points for poly-shapes from POINT-LIST."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3791 (let* ((ep1 (elt point-list 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3792 (ep2 (elt point-list 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3793 (x1 (artist-endpoint-get-x ep1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3794 (y1 (artist-endpoint-get-y ep1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3795 (x2 (artist-endpoint-get-x ep2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3796 (y2 (artist-endpoint-get-y ep2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3797 (dir1 (artist-find-direction x2 y2 x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3798 (epn (artist-last point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3799 (epn-1 (artist-last point-list 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3800 (xn (artist-endpoint-get-x epn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3801 (yn (artist-endpoint-get-y epn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3802 (xn-1 (artist-endpoint-get-x epn-1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3803 (yn-1 (artist-endpoint-get-y epn-1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3804 (dirn (artist-find-direction xn-1 yn-1 xn yn)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3805 (setq artist-arrow-point-1 (artist-make-arrow-point x1 y1 dir1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3806 (setq artist-arrow-point-2 (artist-make-arrow-point xn yn dirn))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3807
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3808
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3809 (defun artist-set-arrow-points-for-2points (shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3810 "Generic function for setting arrow-points for 2-point shapes.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3811 The 2-point shape SHAPE is drawn from X1, Y1 to X2, Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3812 (let* ((endpoint1 (artist-2point-get-endpoint1 shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3813 (endpoint2 (artist-2point-get-endpoint2 shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3814 (x1 (artist-endpoint-get-x endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3815 (y1 (artist-endpoint-get-y endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3816 (x2 (artist-endpoint-get-x endpoint2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3817 (y2 (artist-endpoint-get-y endpoint2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3818 (setq artist-arrow-point-1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3819 (artist-make-arrow-point x1 y1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3820 (artist-find-direction x2 y2 x1 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3821 (setq artist-arrow-point-2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3822 (artist-make-arrow-point x2 y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3823 (artist-find-direction x1 y1 x2 y2)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3824
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3825
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3826 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3827 ;; Common routine for drawing/undrawing shapes based
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3828 ;; on the draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3829 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3830
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3831 (defun artist-key-undraw-continously (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3832 "Undraw current continous shape with point at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3833 ;; No undraw-info for continous shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3834 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3835
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3836 (defun artist-key-undraw-poly (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3837 "Undraw current poly shape with point at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3838 (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3839 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3840 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3841 (artist-funcall undraw-fn artist-key-shape)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3842
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3843 (defun artist-key-undraw-1point (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3844 "Undraw current 1-point shape at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3845 ;; No undraw-info for 1-point shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3846 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3847
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3848 (defun artist-key-undraw-2points (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3849 "Undraw current 2-point shape at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3850 (let ((undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3851 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3852 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3853 (artist-funcall undraw-fn artist-key-shape)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3854
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3855 (defun artist-key-undraw-common ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3856 "Common routine undrawing current shape."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3857 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3858 (col (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3859 (row (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3860
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3861 ;; Depending on what we are currently drawing, call other routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3862 ;; that knows how to do the job
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3863 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3864 (cond ((eq draw-how 'artist-do-continously)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3865 (artist-key-undraw-continously col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3866 ((eq draw-how 'artist-do-poly)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3867 (artist-key-undraw-poly col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3868 ((and (numberp draw-how) (= draw-how 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3869 (artist-key-undraw-1point col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3870 ((and (numberp draw-how) (= draw-how 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3871 (artist-key-undraw-2points col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3872 (t (message "Undrawing \"%s\"s is not yet implemented" draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3873
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3874 ;; Now restore the old position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3875 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3876 (artist-move-to-xy col row)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3877
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3878
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3879
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3880 ;; Implementation note: This really should honor the interval-fn entry
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3881 ;; in the master table, `artist-mt', which would mean leaving a timer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3882 ;; that calls `draw-fn' every now and then. That timer would then have
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3883 ;; to be cancelled and reinstalled whenever the user moves the cursor.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3884 ;; This could be done, but what if the user suddenly switches to another
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3885 ;; drawing mode, or even kills the buffer! In the mouse case, it is much
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3886 ;; simpler: when at the end of `artist-mouse-draw-continously', the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3887 ;; user has released the button, so the timer will always be cancelled
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3888 ;; at that point.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3889 (defun artist-key-draw-continously (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3890 "Draws current continous shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3891 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3892 (setq artist-key-shape (artist-funcall draw-fn x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3893
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3894 (defun artist-key-draw-poly (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3895 "Draws current poly-point shape with nth point at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3896 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3897 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3898 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3899 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3900
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3901 (defun artist-key-draw-1point (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3902 "Draws current 1-point shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3903 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3904 (setq artist-key-shape (artist-funcall draw-fn x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3905
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3906
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3907 (defun artist-key-draw-2points (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3908 "Draws current 2-point shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3909 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3910 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3911 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3912 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3913
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3914 (defun artist-key-draw-common ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3915 "Common routine for drawing current shape."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3916 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3917 (col (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3918 (row (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3919
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3920 ;; Depending on what we are currently drawing, call other routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3921 ;; that knows how to do the job
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3922 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3923 (cond ((eq draw-how 'artist-do-continously)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3924 (artist-key-draw-continously col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3925 ((eq draw-how 'artist-do-poly)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3926 (artist-key-draw-poly col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3927 ((and (numberp draw-how) (= draw-how 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3928 (artist-key-draw-1point col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3929 ((and (numberp draw-how) (= draw-how 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3930 (artist-key-draw-2points col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3931 (t (message "Drawing \"%s\"s is not yet implemented" draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3932
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3933 ;; Now restore the old position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3934 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3935 (artist-move-to-xy col row)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3936
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3937
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3938
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3939 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3940 ;; Functions related to trimming line-endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3941 ;; The region between the topmost and bottommost visited line is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3942 ;; called a draw-region.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3943 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3944
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3945 (defun artist-draw-region-reset ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3946 "Reset the current draw-region."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3947 (setq artist-draw-region-max-y 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3948 (setq artist-draw-region-min-y 1000000))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3949
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3950 (defun artist-draw-region-trim-line-endings (min-y max-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3951 "Trim lines in current draw-region from MIN-Y to MAX-Y.
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3952 Trimming here means removing white space at end of a line."
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3953 ;; Safetyc check: switch min-y and max-y if if max-y is smaller
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3954 (if (< max-y min-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3955 (let ((tmp min-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3956 (setq min-y max-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3957 (setq max-y tmp)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3958 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3959 (let ((curr-y min-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3960 (while (<= curr-y max-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3961 (artist-move-to-xy 0 curr-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3962 (end-of-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3963 (delete-horizontal-space)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3964 (setq curr-y (1+ curr-y))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3965
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3966 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3967 ;; Drawing shapes by using keys
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3968 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3969
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3970 (defun artist-key-do-continously-continously (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3971 "Update current continous shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3972 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3973 (artist-funcall draw-fn x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3974
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3975
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3976 (defun artist-key-do-continously-poly (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3977 "Update current poly-point shape with nth point at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3978 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3979 (undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3980 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3981 (y1 (artist-endpoint-get-y artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3982 (x2 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3983 (y2 y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3984 ;; If not rubber-banding, then move the 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3985 ;; Otherwise re-draw the shape to the new position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3986 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3987 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3988 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3989 (artist-no-rb-unset-point2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3990 (artist-no-rb-set-point2 x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3991 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3992 (artist-funcall undraw-fn artist-key-shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3993 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3994
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3995
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3996 (defun artist-key-do-continously-1point (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3997 "Update current 1-point shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3998 ;; Nothing to do continously for operations
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3999 ;; where we have only one input point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4000 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4001
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4002 (defun artist-key-do-continously-2points (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4003 "Update current 2-point shape with 2nd point at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4004 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4005 (undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4006 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4007 (y1 (artist-endpoint-get-y artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4008 (x2 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4009 (y2 y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4010 ;; If not rubber-banding, then move the 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4011 ;; Otherwise re-draw the shape to the new position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4012 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4013 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4014 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4015 (artist-no-rb-unset-point2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4016 (artist-no-rb-set-point2 x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4017 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4018 (artist-funcall undraw-fn artist-key-shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4019 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4020
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4021
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4022 (defun artist-key-do-continously-common ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4023 "Common routine for updating current shape."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4024 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4025 (col (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4026 (row (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4027
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4028 ;; Depending on what we are currently drawing, call other routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4029 ;; that knows how to do the job
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4030 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4031 (cond ((eq draw-how 'artist-do-continously)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4032 (artist-key-do-continously-continously col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4033 ((eq draw-how 'artist-do-poly)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4034 (artist-key-do-continously-poly col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4035 ((and (numberp draw-how) (= draw-how 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4036 (artist-key-do-continously-1point col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4037 ((and (numberp draw-how) (= draw-how 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4038 (artist-key-do-continously-2points col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4039 (t (message "Drawing \"%s\"s is not yet implemented" draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4040
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4041 ;; Now restore the old position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4042 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4043 (artist-move-to-xy col row)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4044
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4045
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4046 (defun artist-key-set-point-continously (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4047 "Set point for current continous shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4048 ;; Maybe set arrow-points for continous shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4049 (let ((arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4050 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4051 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4052 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4053 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4054
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4055 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4056 ;; *** We are about to begin drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4057 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4058 (artist-funcall init-fn x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4059
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4060 ;; *** We are about to stop drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4061 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4062
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4063 (artist-funcall prep-fill-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4064 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4065 (artist-funcall arrow-set-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4066 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4067 (artist-funcall exit-fn x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4068
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4069 ;; Toggle the is-drawing flag
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4070 (setq artist-key-is-drawing (not artist-key-is-drawing)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4071
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4072
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4073
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4074 (defun artist-key-set-point-poly (x y &optional this-is-last-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4075 "Set point for current poly-point shape at X,Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4076 If optional argument THIS-IS-LAST-POINT is non-nil, this point is the last."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4077 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4078 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4079 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4080 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4081 (fill-pred (artist-go-get-fill-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4082 (fill-fn (artist-go-get-fill-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4083 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4084 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4085
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4086 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4087
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4088 ;; *** We were not drawing ==> set first point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4089 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4090
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4091 (artist-funcall init-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4092
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4093 ;; If not rubber-banding, set first point.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4094 ;; Otherwise, draw the shape from x,y to x,y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4095 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4096 (artist-no-rb-set-point1 x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4097 (setq artist-key-shape (artist-funcall draw-fn x y x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4098
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4099 ;; Set first endpoint
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4100 (setq artist-key-endpoint1 (artist-make-endpoint x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4101
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4102 ;; Set point-list to contain start point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4103 (setq artist-key-poly-point-list (list (artist-make-endpoint x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4104
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4105 ;; Since we are not ready, set the arrow-points to nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4106 (artist-clear-arrow-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4107
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4108 ;; Change state to drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4109 (setq artist-key-is-drawing t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4110
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4111 ;; Feedback
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4112 (message (substitute-command-keys
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4113 (concat "First point set. "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4114 "Set next with \\[artist-key-set-point], "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4115 "set last with C-u \\[artist-key-set-point]"))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4116
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4117
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4118 ;; *** We were drawing ==> we are about to set nth point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4119 ;; (last point if the argument this-is-last-point is non-nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4120 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4121 (let ((x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4122 (y1 (artist-endpoint-get-y artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4123 (x2 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4124 (y2 y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4125
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4126 ;; If not rubber-banding, undraw the 1's and 2's, then
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4127 ;; draw the shape (if we were rubber-banding, then the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4128 ;; shape is already drawn in artist-key-do-continously-2points.)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4129 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4130 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4131 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4132 (artist-no-rb-unset-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4133 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4134
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4135 ;; Set x2 and y2 from shape's second point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4136 ;; (which might be different from the mouse's second point,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4137 ;; if, for example, we are drawing a straight line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4138 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4139 (if (not (null artist-key-shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4140 (let ((endpoint2 (artist-2point-get-endpoint2 artist-key-shape)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4141 (setq x2 (artist-endpoint-get-x endpoint2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4142 (setq y2 (artist-endpoint-get-y endpoint2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4143
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4144 ;; Add the endpoint to the list of poly-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4145 (setq artist-key-poly-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4146 (append artist-key-poly-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4147 (list (artist-make-endpoint x2 y2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4148
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4149 ;; Now do handle the case when this is the last point,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4150 ;; and the case when this point isn't the last
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4151 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4152 (if (not this-is-last-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4153 ;; ** This is not the last point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4154 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4155 ;; Start drawing a new 2-point-shape from last endpoint.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4156
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4157 ;; First set the start-point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4158 (setq x1 x2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4159 (setq y1 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4160 (setq artist-key-endpoint1 (artist-make-endpoint x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4161
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4162 ;; If we are not rubber-banding, then place the '1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4163 ;; Otherwise, draw the shape from x1,y1 to x1,y1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4164 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4165 (artist-no-rb-set-point1 x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4166 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x1 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4167
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4168 ;; Feedback
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4169 (message "Point set"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4170
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4171 ;; ** This is the last point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4172 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4173
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4174 (artist-funcall prep-fill-fn artist-key-poly-point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4175
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4176 ;; Maybe fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4177 (if (artist-funcall fill-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4178 (artist-funcall fill-fn artist-key-shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4179 artist-key-poly-point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4180
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4181 ;; Set the arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4182 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4183 (artist-funcall arrow-set-fn artist-key-poly-point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4184 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4185
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4186 (artist-funcall exit-fn artist-key-poly-point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4187
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4188 ;; Change state to not drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4189 (setq artist-key-shape nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4190 (setq artist-key-endpoint1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4191 (setq artist-key-is-drawing nil)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4192
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4193
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4194 (defun artist-key-set-point-1point (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4195 "Set point for current 1-point shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4196 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4197 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4198 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4199 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4200 (draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4201 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4202 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4203 (artist-funcall init-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4204 (artist-funcall draw-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4205 (artist-funcall prep-fill-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4206 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4207 (artist-funcall arrow-set-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4208 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4209 (artist-funcall exit-fn x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4210 (setq artist-key-shape nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4211 (setq artist-key-is-drawing nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4212
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4213
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4214 (defun artist-key-set-point-2points (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4215 "Set first or second point in current 2-point shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4216 (let ((draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4217 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4218 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4219 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4220 (fill-pred (artist-go-get-fill-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4221 (fill-fn (artist-go-get-fill-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4222 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4223 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol artist-curr-go)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4224 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4225
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4226 ;; *** We were not drawing ==> set first point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4227 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4228
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4229 (artist-funcall init-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4230
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4231 ;; If not rubber-banding, set first point.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4232 ;; Otherwise, draw the shape from x,y to x,y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4233 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4234 (artist-no-rb-set-point1 x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4235 (setq artist-key-shape (artist-funcall draw-fn x y x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4236
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4237 ;; Set first endpoint
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4238 (setq artist-key-endpoint1 (artist-make-endpoint x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4239
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4240 ;; Since we are not ready, clear the arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4241 (artist-clear-arrow-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4242
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4243 ;; Change state to drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4244 (setq artist-key-is-drawing t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4245
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4246 ;; *** We were drawing ==> we are about to set 2nd point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4247 ;; and end the drawing operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4248
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4249 (let ((x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4250 (y1 (artist-endpoint-get-y artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4251 (x2 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4252 (y2 y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4253
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4254 ;; If not rubber-banding, undraw the 1's and 2's, then
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4255 ;; draw the shape (if we were rubber-banding, then the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4256 ;; shape is already drawn in artist-key-do-continously-2points.)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4257 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4258 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4259 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4260 (artist-no-rb-unset-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4261 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4262
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4263 (artist-funcall prep-fill-fn artist-key-shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4264
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4265 ;; Maybe fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4266 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4267 (if (artist-funcall fill-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4268 (artist-funcall fill-fn artist-key-shape x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4269
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4270 ;; Maybe set the arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4271 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4272 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4273 (artist-funcall arrow-set-fn artist-key-shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4274 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4275
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4276 (artist-funcall exit-fn artist-key-shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4277
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4278 ;; Change state to not drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4279 (setq artist-key-is-drawing nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4280
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4281
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4282 (defun artist-key-set-point-common (arg)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4283 "Common routine for setting point in current shape.
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
4284 With non-nil ARG, set the last point."
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4285 (let ((draw-how (artist-go-get-draw-how-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4286 (col (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4287 (row (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4288 (was-drawing artist-key-is-drawing))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4289
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4290 ;; First, if we are about to draw, then reset the draw-region
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4291 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4292 (artist-draw-region-reset))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4293
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4294 ;; Depending on what we are currently drawing, call other routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4295 ;; that knows how to do the job
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4296 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4297 (cond ((eq draw-how 'artist-do-continously)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4298 (artist-key-set-point-continously col row)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4299 ;; Do this now, otherwise nothing will happen until we move.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4300 (artist-key-do-continously-continously col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4301 ((eq draw-how 'artist-do-poly)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4302 (artist-key-set-point-poly col row arg))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4303 ((and (numberp draw-how) (= draw-how 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4304 (artist-key-set-point-1point col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4305 ((and (numberp draw-how) (= draw-how 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4306 (artist-key-set-point-2points col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4307 (t (message "Drawing \"%s\"s is not yet implemented" draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4308
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4309 ;; Maybe trim line endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4310 (if (and artist-trim-line-endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4311 was-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4312 (not artist-key-is-drawing))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4313 (artist-draw-region-trim-line-endings artist-draw-region-min-y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4314 artist-draw-region-max-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4315
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4316 ;; Now restore the old position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4317 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4318 (artist-move-to-xy col row)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4319 (artist-mode-line-show-curr-operation artist-key-is-drawing)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4320
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4321 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4322 ;; Key navigation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4323 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4324
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4325 (defun artist-previous-line (&optional n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4326 "Move cursor up optional N lines (default is 1), updating current shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4327 If N is negative, move cursor down."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4328 (interactive "p")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4329 (let ((col (artist-current-column)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4330 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4331 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4332 (previous-line n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4333 (move-to-column col t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4334 (previous-line n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4335 (move-to-column col t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4336 (artist-key-do-continously-common))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4337
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4338
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4339 (defun artist-next-line (&optional n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4340 "Move cursor down optional N lines (default is 1), updating current shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4341 If N is negative, move cursor up."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4342 (interactive "p")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4343 (let ((col (artist-current-column)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4344 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4345 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4346 (next-line n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4347 (move-to-column col t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4348 (next-line n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4349 (move-to-column col t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4350 (artist-key-do-continously-common))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4351
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4352 (defun artist-backward-char (&optional n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4353 "Move cursor backward optional N chars (default is 1), updating curr shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4354 If N is negative, move forward."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4355 (interactive "p")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4356 (if (> n 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4357 (artist-forward-char (- n))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4358 (artist-forward-char n)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4359
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4360 (defun artist-forward-char (&optional n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4361 "Move cursor forward optional N chars (default is 1), updating curr shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4362 If N is negative, move backward."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4363 (interactive "p")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4364 (let* ((step-x (if (>= n 0) 1 -1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4365 (distance (abs n))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4366 (curr-col (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4367 (new-col (max 0 (+ curr-col (* distance step-x)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4368 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4369 (move-to-column new-col t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4370 (move-to-column new-col t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4371 (artist-key-do-continously-common))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4372
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4373
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4374 (defun artist-key-set-point (&optional arg)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4375 "Set a point for the current shape. With optional ARG, set the last point."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4376 (interactive "P")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4377 (artist-key-set-point-common arg))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4378
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4379
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4380 (defun artist-select-fill-char (c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4381 "Set current fill character to be C."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4382 (interactive "cType fill char (type RET to turn off): ")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4383 (cond ((eq c ?\r) (setq artist-fill-char-set nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4384 (message "Fill cancelled"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4385 (t (setq artist-fill-char-set t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4386 (setq artist-fill-char c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4387 (message "Fill set to \"%c\"" c))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4388
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4389
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4390 (defun artist-select-line-char (c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4391 "Set current line character to be C."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4392 (interactive "cType line char (type RET to turn off): ")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4393 (cond ((eq c ?\r) (setq artist-line-char-set nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4394 (message "Normal lines"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4395 (t (setq artist-line-char-set t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4396 (setq artist-line-char c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4397 (message "Line drawn with \"%c\"" c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4398 (if artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4399 (artist-key-do-continously-common)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4400
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4401
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4402 (defun artist-select-erase-char (c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4403 "Set current erase character to be C."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4404 (interactive "cType char to use when erasing (type RET for normal): ")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4405 (cond ((eq c ?\r) (setq artist-erase-char ?\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4406 (message "Normal erasing"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4407 (t (setq artist-erase-char c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4408 (message "Erasing with \"%c\"" c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4409 (if artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4410 (artist-key-do-continously-common)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4411
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4412 (defun artist-charlist-to-string (char-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4413 "Convert a list of characters, CHAR-LIST, to a string."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4414 (let ((result ""))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4415 (while (not (null char-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4416 (setq result (concat result (char-to-string (car char-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4417 (setq char-list (cdr char-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4418 result))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4419
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4420 (defun artist-string-to-charlist (str)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4421 "Convert a string, STR, to list of characters."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4422 (append str nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4423
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4424 (defun artist-select-spray-chars (chars initial-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4425 "Set current spray characters to be CHARS, starting with INITIAL-CHAR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4426 ;; This huge unreadable `interactive'-clause does the following
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4427 ;; 1. Asks for a string of spray-characters
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4428 ;; 2. Asks for the initial character (default is the first),
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4429 ;; and loops if the answer is not a char within the string in 1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4430 (interactive
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4431 (let* ((str (read-string "Select spray-can characters, lightest first: "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4432 (artist-charlist-to-string artist-spray-chars)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4433 (char-list (artist-string-to-charlist str))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4434 (initial (let* ((err-msg "")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4435 (ok nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4436 (first-char-as-str (char-to-string (car char-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4437 (first-s) (first-c))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4438 (while (not ok)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4439 (setq first-s
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4440 (read-string
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4441 (format (concat "%sSelect initial-character, "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4442 "one of \"%s\" (%s): ")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4443 err-msg str first-char-as-str)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4444 (if (equal first-s "")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4445 (setq first-s first-char-as-str))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4446 (setq first-c (car (artist-string-to-charlist first-s)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4447 (setq ok (not (null (member first-c char-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4448 (if (not ok)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4449 (setq err-msg (format
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4450 "Not in spray-chars: \"%s\". "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4451 (char-to-string first-c)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4452 first-c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4453 (list char-list initial)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4454 (setq artist-spray-chars chars)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4455 (setq artist-spray-new-char initial-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4456 (message "Spray-chars set to \"%s\", initial: \"%s\""
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4457 (artist-charlist-to-string chars) (char-to-string initial-char)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4458
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4459
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4460 (defun artist-select-operation (op-str)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4461 "Select drawing operation OP-STR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4462 (interactive (list (completing-read "Select operation: "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4463 artist-key-compl-table)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4464 (let* ((op-symbol (artist-mt-get-symbol-from-keyword op-str))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4465 (draw-how (if op-symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4466 (artist-go-get-draw-how-from-symbol op-symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4467 nil)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4468 ;; First check that the string was valid
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4469 (if (null op-symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4470 (error "Unknown drawing method: %s" op-str))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4471
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4472 ;; Second, check that we are not about to switch to a different
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4473 ;; kind of shape (do that only if we are drawing with keys;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4474 ;; otherwise this function cannot get called).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4475 (if (and artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4476 (not (equal artist-key-draw-how draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4477 (error "Cannot switch to a different kind of shape while drawing"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4478
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4479 ;; If we were drawing, undraw the shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4480 (if (and artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4481 artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4482 (artist-key-undraw-common))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4483
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4484 ;; Set the current operation and draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4485 (setq artist-curr-go op-symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4486 (setq artist-key-draw-how draw-how)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4487
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4488 ;; If we were drawing, redraw the shape (but don't if shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4489 ;; is drawn by setting only one point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4490 (if (and artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4491 artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4492 (not (eq artist-key-draw-how 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4493 (artist-key-draw-common)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4494
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4495 ;; Feedback
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4496 (artist-mode-line-show-curr-operation artist-key-is-drawing))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4497
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4498
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4499 (defun artist-toggle-rubber-banding (&optional state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4500 "Toggle rubber-banding.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4501 If optional argument STATE is positive, turn rubber-banding on."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4502 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4503 (if artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4504 (error "Cannot toggle rubber-banding while drawing"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4505 (if (setq artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4506 (if (null state) (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4507 (> (prefix-numeric-value state) 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4508 (message "Rubber-banding is now on")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4509 (message "Rubber-banding is now off")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4510
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4511
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4512 (defun artist-toggle-trim-line-endings (&optional state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4513 "Toggle trimming of line-endings.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4514 If optional argument STATE is positive, turn trimming on."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4515 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4516 (if (setq artist-trim-line-endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4517 (if (null state) (not artist-trim-line-endings)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4518 (> (prefix-numeric-value state) 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4519 (message "Trimming is now on")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4520 (message "Trimming is now off")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4521
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4522
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4523 (defun artist-toggle-borderless-shapes (&optional state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4524 "Toggle borders of shapes.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4525 If optional argument STATE is positive, turn borders on."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4526 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4527 (if (setq artist-borderless-shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4528 (if (null state) (not artist-borderless-shapes)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4529 (> (prefix-numeric-value state) 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4530 (message "Borders are now off")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4531 (message "Borders are now on")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4532
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4533
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4534 (defun artist-toggle-first-arrow ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4535 "Toggle first arrow for shape, if possible."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4536 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4537 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4538 (if (not (null artist-arrow-point-1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4539 (let* ((arrow-point artist-arrow-point-1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4540 (arrow-state (artist-arrow-point-get-state arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4541 (arrow-marker (artist-arrow-point-get-marker arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4542 (direction (artist-arrow-point-get-direction arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4543 (orig-char (artist-arrow-point-get-orig-char arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4544 (arrow-char (aref artist-arrows direction))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4545 (new-state (not arrow-state)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4546
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4547 (goto-char (marker-position arrow-marker))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4548
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4549 (if new-state
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4550 (if arrow-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4551 (artist-replace-char arrow-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4552 (artist-replace-char orig-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4553
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4554 (artist-arrow-point-set-state artist-arrow-point-1 new-state)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4555
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4556 (defun artist-toggle-second-arrow ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4557 "Toggle second arrow for shape, if possible."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4558 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4559 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4560 (if (not (null artist-arrow-point-2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4561 (let* ((arrow-point artist-arrow-point-2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4562 (arrow-state (artist-arrow-point-get-state arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4563 (arrow-marker (artist-arrow-point-get-marker arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4564 (direction (artist-arrow-point-get-direction arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4565 (orig-char (artist-arrow-point-get-orig-char arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4566 (arrow-char (aref artist-arrows direction))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4567 (new-state (not arrow-state)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4568
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4569 (goto-char (marker-position arrow-marker))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4570
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4571 (if new-state
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4572 (if arrow-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4573 (artist-replace-char arrow-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4574 (artist-replace-char orig-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4575
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4576 (artist-arrow-point-set-state artist-arrow-point-2 new-state)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4577
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4578
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4579 (defun artist-select-op-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4580 "Select drawing lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4581 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4582 (artist-select-operation "line"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4583
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4584 (defun artist-select-op-straight-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4585 "Select drawing straight lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4586 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4587 (artist-select-operation "straight line"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4588
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4589 (defun artist-select-op-rectangle ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4590 "Select drawing rectangles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4591 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4592 (artist-select-operation "rectangle"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4593
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4594 (defun artist-select-op-square ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4595 "Select drawing squares."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4596 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4597 (artist-select-operation "square"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4598
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4599 (defun artist-select-op-poly-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4600 "Select drawing poly-lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4601 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4602 (artist-select-operation "poly-line"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4603
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4604 (defun artist-select-op-straight-poly-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4605 "Select drawing straight poly-lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4606 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4607 (artist-select-operation "straight poly-line"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4608
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4609 (defun artist-select-op-ellipse ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4610 "Select drawing ellipses."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4611 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4612 (artist-select-operation "ellipse"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4613
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4614 (defun artist-select-op-circle ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4615 "Select drawing circles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4616 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4617 (artist-select-operation "circle"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4619 (defun artist-select-op-text-see-thru ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4620 "Select rendering text (see thru)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4621 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4622 (artist-select-operation "text see-thru"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4623
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4624 (defun artist-select-op-text-overwrite ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4625 "Select rendering text (overwrite)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4626 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4627 (artist-select-operation "text overwrite"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4628
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4629 (defun artist-select-op-spray-can ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4630 "Select spraying."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4631 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4632 (artist-select-operation "spray-can"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4633
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4634 (defun artist-select-op-spray-set-size ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4635 "Select setting size for spraying."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4636 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4637 (artist-select-operation "spray set size"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4638
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4639 (defun artist-select-op-erase-char ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4640 "Select erasing characters."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4641 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4642 (artist-select-operation "erase char"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4643
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4644 (defun artist-select-op-erase-rectangle ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4645 "Select erasing rectangles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4646 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4647 (artist-select-operation "erase rectangle"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4648
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4649 (defun artist-select-op-vaporize-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4650 "Select vaporizing single lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4651 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4652 (artist-select-operation "vaporize line"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4653
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4654 (defun artist-select-op-vaporize-lines ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4655 "Select vaporizing connected lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4656 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4657 (artist-select-operation "vaporize lines"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4658
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4659 (defun artist-select-op-cut-rectangle ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4660 "Select cutting rectangles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4661 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4662 (artist-select-operation "cut rectangle"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4663
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4664 (defun artist-select-op-cut-square ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4665 "Select cutting squares."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4666 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4667 (artist-select-operation "cut square"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4668
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4669 (defun artist-select-op-copy-rectangle ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4670 "Select copying rectangles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4671 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4672 (artist-select-operation "copy rectangle"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4673
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4674 (defun artist-select-op-copy-square ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4675 "Select copying squares."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4676 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4677 (artist-select-operation "cut square"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4678
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4679 (defun artist-select-op-paste ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4680 "Select pasting."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4681 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4682 (artist-select-operation "paste"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4683
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4684 (defun artist-select-op-flood-fill ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4685 "Select flood-filling."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4686 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4687 (artist-select-operation "flood-fill"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4688
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4689
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4690 ;; Drawing lines by using mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4691 ;; Mouse button actions
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4692 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4693
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4694 (defun artist-update-pointer-shape ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4695 "Perform the update of the X Windows pointer shape."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4696 (set-mouse-color nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4697
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4698 (defun artist-set-pointer-shape (new-pointer-shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4699 "Set the shape of the X Windows pointer to NEW-POINTER-SHAPE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4700 (setq x-pointer-shape new-pointer-shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4701 (artist-update-pointer-shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4702
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4703 (defsubst artist-event-is-shifted (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4704 "Check whether the shift-key is pressed in event EV."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4705 (memq 'shift (event-modifiers ev)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4706
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4707 (defun artist-do-nothing ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4708 "Function that does nothing."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4709 (interactive))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4710
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4711 (defun artist-down-mouse-1 (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4712 "Perform drawing action for event EV."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4713 (interactive "@e")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4714 (let* ((real (artist-go-get-symbol-shift
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4715 artist-curr-go (artist-event-is-shifted ev)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4716 (draw-how (artist-go-get-draw-how-from-symbol real))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4717 ;; Remember original values for draw-region-min-y and max-y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4718 ;; in case we are interrupting a key-draw operation.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4719 (orig-draw-region-min-y artist-draw-region-min-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4720 (orig-draw-region-max-y artist-draw-region-max-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4721 (orig-pointer-shape (if (eq window-system 'x) x-pointer-shape nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4722 (echo-keystrokes 10000) ; a lot of seconds
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4723 ;; Remember original binding for the button-up event to this
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4724 ;; button-down event.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4725 (key (let* ((basic (event-basic-type ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4726 (unshifted basic)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4727 (shifted (make-symbol (concat "S-" (symbol-name basic)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4728 (if (artist-event-is-shifted ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4729 (make-vector 1 shifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4730 (make-vector 1 unshifted))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4731 (orig-button-up-binding (lookup-key (current-global-map) key)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4732
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4733 (unwind-protect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4734 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4735 (if (eq window-system 'x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4736 (artist-set-pointer-shape artist-pointer-shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4737
47953
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
4738 ;; Redefine the button-up binding temporarily (the original
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4739 ;; binding is restored in the unwind-forms below). This is to
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4740 ;; avoid the phenomenon outlined in this scenario:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4741 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4742 ;; 1. A routine which reads something from the mini-buffer (such
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4743 ;; as the text renderer) is called from below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4744 ;; 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
4745 ;; 3. As a (funny :-) coincidence, the binding for the
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4746 ;; button-up event is often mouse-set-point, so Emacs
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4747 ;; sets the point to where the button was released, which is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4748 ;; in the buffer where the user wants to place the text.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4749 ;; 4. The user types C-x o (or uses the mouse once again)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4750 ;; until he reaches the mini-buffer which is still prompting
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4751 ;; for some text to render.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4752 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4753 ;; To do this foolproof, all local and minor-mode maps should
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4754 ;; be searched and temporarily changed as well, since they
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4755 ;; too might have some binding for the button-up event,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4756 ;; but I hope dealing with the global map will suffice.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4757 (define-key (current-global-map) key 'artist-do-nothing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4758
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4759 (artist-draw-region-reset)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4760
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4761 (artist-mode-line-show-curr-operation t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4762
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4763 (cond ((eq draw-how 'artist-do-continously)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4764 (artist-mouse-draw-continously ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4765 ((eq draw-how 'artist-do-poly)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4766 (artist-mouse-draw-poly ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4767 ((and (numberp draw-how) (= draw-how 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4768 (artist-mouse-draw-1point ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4769 ((and (numberp draw-how) (= draw-how 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4770 (artist-mouse-draw-2points ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4771 (t (message "Drawing \"%s\"s is not yet implemented"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4772 draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4773
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4774 (if artist-trim-line-endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4775 (artist-draw-region-trim-line-endings artist-draw-region-min-y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4776 artist-draw-region-max-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4777 (setq artist-draw-region-min-y orig-draw-region-min-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4778 (setq artist-draw-region-max-y orig-draw-region-max-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4779
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4780 ; This is protected
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4781 (if (eq window-system 'x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4782 (artist-set-pointer-shape orig-pointer-shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4783
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4784 (if orig-button-up-binding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4785 (define-key (current-global-map) key orig-button-up-binding))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4786
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4787 (artist-mode-line-show-curr-operation artist-key-is-drawing))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4788
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4789
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4790 (defun artist-mouse-choose-operation (ev op)
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
4791 "Choose operation for event EV and operation OP."
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4792 (interactive
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4793 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4794 (select-window (posn-window (event-start last-input-event)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4795 (list last-input-event
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4796 (x-popup-menu last-nonmenu-event artist-popup-menu-table))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4797
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4798 (let ((draw-fn (artist-go-get-draw-fn-from-symbol (car op)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4799 (set-fn (artist-fc-get-fn-from-symbol (car op))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4800 (cond
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4801
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4802 ;; *** It was a draw-function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4803 ((not (listp draw-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4804 (let* ((unshifted (artist-go-get-symbol-shift (car op) nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4805 (shifted (artist-go-get-symbol-shift (car op) t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4806 (shift-state (artist-event-is-shifted ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4807 (selected-op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4808 (keyword (artist-go-get-keyword-from-symbol selected-op)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4809 (artist-select-operation keyword)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4810
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4811 ;; *** It was a set/unset function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4812 ((not (listp set-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4813 (call-interactively set-fn)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4814
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4815
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4816 (defun artist-down-mouse-3 (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4817 "Erase character or rectangle, depending on event EV."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4818 (interactive "@e")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4819 (let ((artist-curr-go 'erase-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4820 (artist-down-mouse-1 ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4821 ;; Restore mode-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4822 (artist-mode-line-show-curr-operation artist-key-is-drawing))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4823
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4824
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4825 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4826 ;; Mouse routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4827 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4828
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4829 (defsubst artist-shift-has-changed (shift-state ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4830 "From the last SHIFT-STATE and EV, determine if the shift-state has changed."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4831 ;; This one simply doesn't work.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4832 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4833 ;; There seems to be no way to tell whether the user has pressed shift
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4834 ;; while dragging the cursor around when we are in a track-mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4835 ;; form. Calling (event-modifiers ev) yields nil :-( Neither is the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4836 ;; (event-basic-type ev) of any help (it is simply `mouse-movement').
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4837 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4838 ;; So this doesn't work:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4839 ;; (cond ((and shift-state (not (artist-event-is-shifted ev))) t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4840 ;; ((and (not shift-state) (artist-event-is-shifted ev)) t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4841 ;; (t nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4842 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4843
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4844 (defun artist-coord-win-to-buf (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4845 "Convert a window-relative coordinate COORD to a buffer-relative coordinate."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4846 (let ((window-x (car coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4847 (window-y (cdr coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4848 (window-start-x (window-hscroll))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4849 (window-start-y (save-excursion (goto-char (window-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4850 (artist-current-line))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4851 (cons (+ window-x window-start-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4852 (+ window-y window-start-y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4853
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4854
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4855 (defun artist-mouse-draw-continously (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4856 "Generic function for shapes that requires 1 point as input.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4857 Operation is done continously while the mouse button is hold down.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4858 The event, EV, is the mouse event."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4859 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4860 (shifted (artist-go-get-symbol-shift artist-curr-go t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4861 (shift-state (artist-event-is-shifted ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4862 (op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4863 (draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4864 (init-fn (artist-go-get-init-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4865 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4866 (exit-fn (artist-go-get-exit-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4867 (draw-fn (artist-go-get-draw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4868 (interval-fn (artist-go-get-interval-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4869 (interval (artist-funcall interval-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4870 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4871 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4872 (ev-start (event-start ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4873 (initial-win (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4874 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4875 (x1 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4876 (y1 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4877 (shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4878 (timer))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4879 (select-window (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4880 (artist-funcall init-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4881 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4882 (artist-no-rb-set-point1 x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4883 (track-mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4884 (while (or (mouse-movement-p ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4885 (member 'down (event-modifiers ev)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4886 (setq ev-start-pos (artist-coord-win-to-buf
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4887 (posn-col-row (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4888 (setq x1 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4889 (setq y1 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4890
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4891 ;; Cancel previous timer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4892 (if timer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4893 (cancel-timer timer))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4894
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4895 (if (not (eq initial-win (posn-window (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4896 ;; If we moved outside the window, do nothing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4897 nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4898
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4899 ;; Still in same window:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4900 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4901 ;; Check if user presses or releases shift key
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4902 (if (artist-shift-has-changed shift-state ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4903
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4904 ;; First check that the draw-how is the same as we
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4905 ;; already have. Otherwise, ignore the changed shift-state.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4906 (if (not (eq draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4907 (artist-go-get-draw-how-from-symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4908 (if (not shift-state) shifted unshifted))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4909 (message "Cannot switch to shifted operation")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4910
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4911 ;; progn is "implicit" since this is the else-part
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4912 (setq shift-state (not shift-state))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4913 (setq op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4914 (setq draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4915 (setq draw-fn (artist-go-get-draw-fn-from-symbol op))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4916
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4917 ;; Draw the new shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4918 (setq shape (artist-funcall draw-fn x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4919 (artist-move-to-xy x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4920
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4921 ;; Start the timer to call `draw-fn' repeatedly every
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4922 ;; `interval' second
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4923 (if (and interval draw-fn)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4924 (setq timer (run-at-time interval interval draw-fn x1 y1))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4925
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4926 ;; Read next event
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4927 (setq ev (read-event))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4928
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4929 ;; Cancel any timers
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4930 (if timer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4931 (cancel-timer timer))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4932
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4933 (artist-funcall prep-fill-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4934
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4935 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4936 (artist-funcall arrow-set-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4937 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4938
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4939 (artist-funcall exit-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4940 (artist-move-to-xy x1 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4941
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4942
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4943
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4944 (defun artist-mouse-draw-poly (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4945 "Generic function for shapes requiring several points as input.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4946 The event, EV, is the mouse event."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4947 (interactive "@e")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4948 (message "Mouse-1: set new point, mouse-2: set last point")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4949 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4950 (shifted (artist-go-get-symbol-shift artist-curr-go t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4951 (shift-state (artist-event-is-shifted ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4952 (op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4953 (draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4954 (init-fn (artist-go-get-init-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4955 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4956 (exit-fn (artist-go-get-exit-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4957 (draw-fn (artist-go-get-draw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4958 (undraw-fn (artist-go-get-undraw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4959 (fill-pred (artist-go-get-fill-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4960 (fill-fn (artist-go-get-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4961 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4962 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4963 (ev-start (event-start ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4964 (initial-win (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4965 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4966 (x1-last (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4967 (y1-last (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4968 (x2 x1-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4969 (y2 y1-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4970 (is-down t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4971 (shape nil)
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
4972 (point-list nil)
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4973 (done nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4974 (select-window (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4975 (artist-funcall init-fn x1-last y1-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4976 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4977 (artist-no-rb-set-point1 x1-last y1-last))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4978 (track-mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4979 (while (not done)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4980 ;; decide what to do
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4981 (cond
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4982
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4983 ;; *** Mouse button is released.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4984 ((and is-down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4985 (or (member 'click (event-modifiers ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4986 (member 'drag (event-modifiers ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4987 ;; First, if not rubber-banding, draw the line.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4988 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4989 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4990 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4991 (artist-no-rb-unset-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4992 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4993
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4994 ;; Set the second point to the shape's second point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4995 ;; (which might be different from the mouse's second point,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4996 ;; if, for example, we are drawing a straight line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4997 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4998 (if (not (null shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4999 (let ((endpoint2 (artist-2point-get-endpoint2 shape)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5000 (setq x1-last (artist-endpoint-get-x endpoint2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5001 (setq y1-last (artist-endpoint-get-y endpoint2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5002 (setq point-list (cons (artist-make-endpoint x1-last y1-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5003 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5004 (setq shape nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5005 (setq is-down nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5006
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5007 ;; *** Mouse button 2 or 3 down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5008 ((and (member 'down (event-modifiers ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5009 (or (equal (event-basic-type ev) 'mouse-2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5010 (equal (event-basic-type ev) 'mouse-3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5011 ;; Ignore
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5012 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5013
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5014 ;; *** Mouse button 2 or 3 released
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5015 ((and (or (member 'click (event-modifiers ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5016 (member 'drag (event-modifiers ev)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5017 (or (equal (event-basic-type ev) 'mouse-2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5018 (equal (event-basic-type ev) 'mouse-3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5019
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5020 ;; This means the end of our poly-line drawing-session.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5021 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5022 (setq done t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5023
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5024 ;; *** Mouse button 1 went down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5025 ((and (not is-down)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5026 (member 'down (event-modifiers ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5027 (equal (event-basic-type ev) 'mouse-1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5028 ;; Check whether the (possibly new, that depends on if shift
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5029 ;; has been pressed or released) symbol has the same draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5030 ;; information as the previous had. If it hasn't, we can't
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5031 ;; proceed.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5032 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5033 (if (not (eq draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5034 (artist-go-get-draw-how-from-symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5035 (if (not shift-state) shifted unshifted))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5036 (message "Cannot switch operation")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5037 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5038 ;; Decide operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5039 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5040 (setq unshifted
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5041 (artist-go-get-symbol-shift artist-curr-go nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5042 shifted
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5043 (artist-go-get-symbol-shift artist-curr-go t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5044 shift-state (artist-event-is-shifted ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5045 op (if shift-state shifted unshifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5046 draw-how (artist-go-get-draw-how-from-symbol op)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5047 draw-fn (artist-go-get-draw-fn-from-symbol op)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5048 undraw-fn (artist-go-get-undraw-fn-from-symbol op)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5049 fill-pred (artist-go-get-fill-pred-from-symbol op)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5050 fill-fn (artist-go-get-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5051
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5052 ;; Draw shape from last place to this place
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5053
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5054 ;; set x2 and y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5055 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5056 (setq ev-start-pos (artist-coord-win-to-buf
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5057 (posn-col-row (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5058 (setq x2 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5059 (setq y2 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5060
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5061 ;; Draw the new shape (if not rubber-banding, place both marks)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5062 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5063 (if artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5064 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5065 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5066 (artist-no-rb-set-point1 x1-last y1-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5067 (artist-no-rb-set-point2 x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5068
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5069 ;; Show new operation in mode-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5070 (let ((artist-curr-go op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5071 (artist-mode-line-show-curr-operation t))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5072
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5073 (setq is-down t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5074
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5075
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5076 ;; *** Mouse moved, button is down and we are still in orig window
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5077 ((and (mouse-movement-p ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5078 is-down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5079 (eq initial-win (posn-window (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5080 ;; Draw shape from last place to this place
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5081 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5082 ;; set x2 and y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5083 (setq ev-start-pos (artist-coord-win-to-buf
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5084 (posn-col-row (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5085 (setq x2 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5086 (setq y2 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5087
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5088 ;; First undraw last shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5089 ;; (unset last point if not rubberbanding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5090 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5091 (artist-funcall undraw-fn shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5092
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5093 ;; Draw the new shape (if not rubberbanding, set 2nd mark)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5094 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5095 (if artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5096 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5097 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5098 (artist-no-rb-unset-point2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5099 (artist-no-rb-set-point2 x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5100 ;; Move cursor
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5101 (artist-move-to-xy x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5102
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5103 ;; *** Mouse moved, button is down but we are NOT in orig window
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5104 ((and (mouse-movement-p ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5105 is-down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5106 (not (eq initial-win (posn-window (event-start ev)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5107 ;; Ignore
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5108 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5109
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5110
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5111 ;; *** Moving mouse while mouse button is not down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5112 ((and (mouse-movement-p ev) (not is-down))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5113 ;; don't do anything.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5114 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5115
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5116
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5117 ;; *** Mouse button 1 went down, first time
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5118 ((and is-down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5119 (member 'down (event-modifiers ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5120 (equal (event-basic-type ev) 'mouse-1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5121 ;; don't do anything
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5122 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5123
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5124
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5125 ;; *** Another event
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5126 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5127 ;; End drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5128 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5129 (setq done t)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5130
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5131 ;; Read next event (only if we should not stop)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5132 (if (not done)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5133 (setq ev (read-event)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5134
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5135 ;; Reverse point-list (last points are cond'ed first)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5136 (setq point-list (reverse point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5137
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5138 (artist-funcall prep-fill-fn point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5139
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5140 ;; Maybe fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5141 (if (artist-funcall fill-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5142 (artist-funcall fill-fn point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5143
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5144 ;; Maybe set arrow points
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
5145 (if (and point-list (artist-funcall arrow-pred))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5146 (artist-funcall arrow-set-fn point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5147 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5148
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5149 (artist-funcall exit-fn point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5150 (artist-move-to-xy x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5151
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5152
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5153 (defun artist-mouse-draw-1point (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5154 "Generic function for shapes requiring only 1 point as input.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5155 Operation is done once. The event, EV, is the mouse event."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5156 (interactive "@e")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5157 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5158 (shifted (artist-go-get-symbol-shift artist-curr-go t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5159 (shift-state (artist-event-is-shifted ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5160 (op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5161 (draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5162 (init-fn (artist-go-get-init-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5163 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5164 (exit-fn (artist-go-get-exit-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5165 (draw-fn (artist-go-get-draw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5166 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5167 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5168 (ev-start (event-start ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5169 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5170 (x1 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5171 (y1 (cdr ev-start-pos)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5172 (select-window (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5173 (artist-funcall init-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5174 (artist-funcall draw-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5175 (artist-funcall prep-fill-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5176 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5177 (artist-funcall arrow-set-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5178 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5179 (artist-funcall exit-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5180 (artist-move-to-xy x1 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5181
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5182
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5183 (defun artist-mouse-draw-2points (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5184 "Generic function for shapes requiring 2 points as input.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5185 The event, EV, is the mouse event."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5186 (interactive "@e")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5187 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5188 (shifted (artist-go-get-symbol-shift artist-curr-go t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5189 (shift-state (artist-event-is-shifted ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5190 (op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5191 (draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5192 (init-fn (artist-go-get-init-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5193 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5194 (exit-fn (artist-go-get-exit-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5195 (draw-fn (artist-go-get-draw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5196 (undraw-fn (artist-go-get-undraw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5197 (fill-pred (artist-go-get-fill-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5198 (fill-fn (artist-go-get-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5199 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5200 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5201 (ev-start (event-start ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5202 (initial-win (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5203 (ev-start-pos (artist-coord-win-to-buf (posn-col-row ev-start)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5204 (x1 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5205 (y1 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5206 (x2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5207 (y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5208 (shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5209 (select-window (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5210 (artist-funcall init-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5211 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5212 (artist-no-rb-set-point1 x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5213 (track-mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5214 (while (or (mouse-movement-p ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5215 (member 'down (event-modifiers ev)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5216 (setq ev-start-pos (artist-coord-win-to-buf
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5217 (posn-col-row (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5218 (setq x2 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5219 (setq y2 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5220
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5221 (if (not (eq initial-win (posn-window (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5222 ;; If we moved outside the window, do nothing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5223 nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5224
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5225 ;; Still in same window:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5226 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5227 ;; First undraw last shape (unset last point if not rubberbanding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5228 (if artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5229 (artist-funcall undraw-fn shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5230 (artist-no-rb-unset-point2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5231
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5232 ;; Check if user presses or releases shift key
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5233 (if (artist-shift-has-changed shift-state ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5234
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5235 ;; First check that the draw-how is the same as we
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5236 ;; already have. Otherwise, ignore the changed shift-state.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5237 (if (not (eq draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5238 (artist-go-get-draw-how-from-symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5239 (if (not shift-state) shifted unshifted))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5240 (message "Cannot switch to shifted operation")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5241
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5242 (message "Switching")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5243 ;; progn is "implicit" since this is the else-part
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5244 (setq shift-state (not shift-state))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5245 (setq op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5246 (setq draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5247 (setq draw-fn (artist-go-get-draw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5248 (setq undraw-fn (artist-go-get-undraw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5249 (setq fill-pred (artist-go-get-fill-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5250 (setq fill-fn (artist-go-get-fill-fn-from-symbol op))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5251
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5252 ;; Draw the new shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5253 (if artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5254 (setq shape (artist-funcall draw-fn x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5255 (artist-no-rb-set-point2 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5256 ;; Move cursor
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5257 (artist-move-to-xy x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5258
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5259
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5260 ;; Read next event
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5261 (setq ev (read-event))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5262
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5263 ;; If we are not rubber-banding (that is, we were moving around the `2')
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5264 ;; draw the shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5265 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5266 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5267 (artist-no-rb-unset-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5268 (setq shape (artist-funcall draw-fn x1 y1 x2 y2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5269
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5270 (artist-funcall prep-fill-fn shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5271
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5272 ;; Maybe fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5273 (if (artist-funcall fill-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5274 (artist-funcall fill-fn shape x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5275
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5276 ;; Maybe set arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5277 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5278 (artist-funcall arrow-set-fn shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5279 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5280
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5281 (artist-funcall exit-fn shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5282 (artist-move-to-xy x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5283
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5284
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5285 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5286 ;; Bug-report-submitting
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5287 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5288 (defun artist-submit-bug-report ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5289 "Submit via mail a bug report on Artist."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5290 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5291 (require 'reporter)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5292 (if (y-or-n-p "Do you want to submit a bug report on Artist? ")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5293 (let ((to artist-maintainer-address)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5294 (vars '(window-system
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5295 window-system-version
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5296 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5297 artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5298 artist-interface-with-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5299 artist-aspect-ratio
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5300 ;; Now the internal ones
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5301 artist-curr-go
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5302 artist-key-poly-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5303 artist-key-shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5304 artist-key-draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5305 artist-arrow-point-1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5306 artist-arrow-point-2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5307 ;; Remove those variables from vars that are not bound
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5308 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5309 (function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5310 (lambda (x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5311 (if (not (and (boundp x) (symbol-value x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5312 (setq vars (delq x vars))))) vars)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5313 (reporter-submit-bug-report
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5314 artist-maintainer-address
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5315 (concat "artist.el " artist-version)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5316 vars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5317 nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5318 (concat "Hello Tomas,\n\n"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5319 "I have a nice bug report on Artist for you! Here it is:")))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5320
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5321
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5322 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5323 ;; Now provide this minor mode
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5324 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5325
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5326 (provide 'artist)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5327
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5328
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5329 ;;; About adding drawing modes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5330 ;;; --------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5331
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5332 ;; If you are going to add a new drawing mode, read the following
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5333 ;; sketchy outlines to get started a bit easier.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5334 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5335 ;; 1. If your new drawing mode falls into one of the following
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5336 ;; categories, goto point 2, otherwise goto point 3.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5337 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5338 ;; - Modes where the shapes are drawn continously, as long as
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5339 ;; the mouse button is held down (continous modes).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5340 ;; Example: the erase-char mode, the pen and pen-line modes.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5341 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5342 ;; - Modes where the shape is made up of from 2 points to an
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5343 ;; arbitrary number of points (poly-point modes).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5344 ;; Example: the poly-line mode
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5345 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5346 ;; - Modes where the shape is made up of 2 points (2-point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5347 ;; modes).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5348 ;; Example: lines, rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5349 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5350 ;; - Modes where the shape is made up of 1 point (1-point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5351 ;; modes). This mode differs from the continous modes in
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5352 ;; that the shape is drawn only once when the mouse button
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5353 ;; is pressed.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5354 ;; Examples: paste, a flood-fill, vaporize modes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5355 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5356 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5357 ;; 2. To make it easier and more flexible to program new drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5358 ;; modes, you might choose to specify
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5359 ;; init-fn: a function to be called at the very beginning
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5360 ;; of the drawing phase,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5361 ;; prep-fill-fn: a function to be called before filling,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5362 ;; arrow-set-fn: a function for setting arrows, to be called
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5363 ;; after filling, and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5364 ;; exit-fn: a function to be called at the very end of
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5365 ;; the drawing phase.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5366 ;; For each of the cases below, the arguments given to the init-fn,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5367 ;; prep-fill-fn, arrow-set-fn and exit-fn are stated.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5368 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5369 ;; If your mode matches the continous mode or the 1-point mode:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5370 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5371 ;; a. Create a draw-function that draws your shape. Your function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5372 ;; must take x and y as arguments. The return value is not
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5373 ;; used.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5374 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5375 ;; b. Add your mode to the master table, `artist-mt'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5376 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5377 ;; init-fn: x y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5378 ;; prep-fill-fn: x y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5379 ;; arrow-set-fn: x y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5380 ;; exit-fn: x y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5381 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5382 ;; If your mode matches the 2-point mode:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5383 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5384 ;; a. Create one draw-function that draws your shape and one
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5385 ;; undraw-function that undraws it.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5386 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5387 ;; The draw-function must take x1, y1, x2 and y2 as
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5388 ;; arguments. It must return a list with three elements:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5389 ;; Endpoint1: a vector [x1 y1]
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5390 ;; Endpoint2: a vector [x2 y2]
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5391 ;; Shapeinfo: all info necessary for your undraw-function to
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5392 ;; be able to undraw the shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5393 ;; Use the artist-endpoint-* accessors to create and inspect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5394 ;; the endpoints.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5395 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5396 ;; If applicable, you must be able to draw your shape without
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5397 ;; borders if the `artist-borderless-shapes' is non-nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5398 ;; See `artist-draw-rect' for an example.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5399 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5400 ;; The undraw-function must take one argument: the list created
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5401 ;; by your draw-function. The return value is not used.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5402 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5403 ;; b. If you want to provide a fill-function, then create a
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5404 ;; function that takes 5 arguments: the list created by your
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5405 ;; draw-function, x1, y1, x2 and y2. The return value is not
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5406 ;; used.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5407 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5408 ;; c. Add your mode to the master table, `artist-mt'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5409 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5410 ;; init-fn: x1 y1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5411 ;; prep-fill-fn: shape x1 y1 x2 y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5412 ;; arrow-set-fn: shape x1 y1 x2 y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5413 ;; exit-fn: shape x1 y1 x2 y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5414 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5415 ;; If your mode matches the poly-point mode:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5416 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5417 ;; a. Create one draw-function that draws your shape and one
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5418 ;; undraw-function that undraws it. The draw- and
46163
426c8cf1a3df Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents: 43685
diff changeset
5419 ;; undraw-functions are used to draw/undraw a segment of
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5420 ;; your poly-point mode between 2 points. The draw- and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5421 ;; undraw-functions are then really 2-point mode functions.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5422 ;; They must take the same arguments and return the same
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5423 ;; values as those of the 2-point mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5424 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5425 ;; If applicable, you must be able to draw your shape without
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5426 ;; borders if the `artist-borderless-shapes' is non-nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5427 ;; See `artist-draw-rect' for an example.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5428 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5429 ;; b. If you want to provide a fill-function, then create a
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5430 ;; function that takes 1 argument: a list of points where each
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5431 ;; point is a vector, [x, y].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5432 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5433 ;; c. Add your mode to the master table, `artist-mt'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5434 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5435 ;; init-fn: x1 y1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5436 ;; prep-fill-fn: point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5437 ;; arrow-set-fn: point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5438 ;; exit-fn: point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5439 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5440 ;; The arrow-set-fn must set the variables `artist-arrow-point-1'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5441 ;; and `artist-arrow-point-2'. If your mode does not take arrows,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5442 ;; you must set the variables to nil. Use the accessors
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5443 ;; artist-arrow-point-* to create and inspect arrow-points.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5444 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5445 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5446 ;; 3. If your mode doesn't match any of the categories, you are facing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5447 ;; a bit more work, and I cannot be as detailed as above. Here is a
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5448 ;; brief outline of what you have to do:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5449 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5450 ;; a. Decide on a name for your type of mode. Let's assume that
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5451 ;; you decided on `xxx'. Then you should use the draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5452 ;; symbol artist-do-xxx.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5453 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5454 ;; b. Create a function artist-mouse-draw-xxx for drawing with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5455 ;; mouse. It should be called from `artist-down-mouse-1'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5456 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5457 ;; The all coordinates must be converted from window-relative
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5458 ;; to buffer relative before saved or handed over to
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5459 ;; any other function. Converting is done with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5460 ;; the function `artist-coord-win-to-buf'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5461 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5462 ;; It must take care to the `artist-rubber-banding' variable
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5463 ;; and perform rubber-banding accordingly. Use the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5464 ;; artist-no-rb-* functions if not rubber-banding.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5465 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5466 ;; If applicable, you must be able to draw your shape without
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5467 ;; borders if the `artist-borderless-shapes' is non-nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5468 ;; See `artist-draw-rect' for an example.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5469 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5470 ;; You must call the init-fn, the prep-fill-fn, arrow-set-fn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5471 ;; and the exit-fn at the apropriate points.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5472 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5473 ;; When artist-mouse-draw-xxx ends, the shape for your mode
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5474 ;; must be completely drawn.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5475 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5476 ;; c. Create functions for drawing with keys:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5477 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5478 ;; - artist-key-set-point-xxx for setting a point in the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5479 ;; mode, to be called from `artist-key-set-point-common'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5480 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5481 ;; - artist-key-do-continously-xxx to be called from
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5482 ;; `artist-key-do-continously-common' whenever the user
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5483 ;; moves around.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5484 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5485 ;; As for the artist-mouse-draw-xxx, these two functions must
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5486 ;; take care to do rubber-banding, borderless shapes and to
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5487 ;; set arrows.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5488 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5489 ;; These functions should set the variable `artist-key-shape'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5490 ;; to the shape drawn.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5491 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5492 ;; d. Create artist-key-draw-xxx and artist-key-undraw-xxx for
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5493 ;; drawing and undrawing. These are needed when the user
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5494 ;; switches operation to draw another shape of the same type
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5495 ;; of drawing mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5496 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5497 ;; You should provide these functions. You might think that
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5498 ;; only you is using your type of mode, so noone will be able
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5499 ;; to switch to another operation of the same type of mode,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5500 ;; but someone else might base a new drawing mode upon your
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5501 ;; work.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5502 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5503 ;; You must call the init-fn, the prep-fill-fn, arrow-set-fn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5504 ;; and the exit-fn at the apropriate points.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5505 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5506 ;; e. Add your new mode to the master table, `artist-mt'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5507 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5508 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5509 ;; Happy hacking! Please let me hear if you add any drawing modes!
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5510 ;; Don't hesitate to ask me any questions.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5511
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5512
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 51965
diff changeset
5513 ;;; arch-tag: 3e63b881-aaaa-4b83-a072-220d4661a8a3
38436
b174db545cfd Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 37825
diff changeset
5514 ;;; artist.el ends here