annotate lisp/textmodes/artist.el @ 39465:6912cef77269

Mention core dumps inside XIM on Solaris 8.
author Eli Zaretskii <eliz@gnu.org>
date Wed, 26 Sep 2001 19:36:21 +0000
parents b174db545cfd
children 8716d2ed21c6
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3 ;; Copyright (C) 2000 Free Software Foundation, Inc.
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
8 ;; Version: 1.2.2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
9 ;; Release-date: 22-Oct-2000
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,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
35 ;; rectangles and ellipses by using your mouse and/or keyboard. The
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
64 ;; diagonally. Plain lines go in any direction. The operations in
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
70 ;; straight and connected at their endpoints. Vaporizing is inspired
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
77 ;; regions. Artist also interfaces with the rect package (this can be
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
88 ;; reflect the height-width ratio for the font you are using. Squares
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
139 ;; 1.2.2 19-Nov-2000
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
140 ;; Changed: More documentation fixes.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
141 ;; Bugfix: The arrow characters (`artist-arrows'), which
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
142 ;; got wrong in 1.1, are now corrected.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
143 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
144 ;; 1.2.1 15-Nov-2000
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
145 ;; New: Documentation fixes.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
146 ;; Bugfix: Sets next-line-add-newlines to t while in artist-mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
147 ;; Drawing with keys was confusing without this fix, if
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
148 ;; next-line-add-newlines was set to nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
149 ;; Thanks to Tatsuo Furukawa <tatsuo@kobe.hp.com> for this.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
150 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
151 ;; 1.2 22-Oct-2000
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
152 ;; New: Updated to work with Emacs 21
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
153 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
154 ;; 1.1 15-Aug-2000
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
155 ;; Bugfix: Cursor follows mouse pointer more closely.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
156 ;; New: Works with Emacs 20.x
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
157 ;; New: Variables are customizable
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
158 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
159 ;; 1.1-beta1 21-Apr-1998
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
160 ;; New: Spray-can (Utterly useless, I believe, but it was fun
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
161 ;; to implement :-) after an idea by Karl-Johan Karlsson
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
162 ;; <kj@lysator.liu.se>.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
163 ;; New: Freehand drawing (with pen).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
164 ;; New: Vaporizing lines.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
165 ;; New: Text-rendering using figlet.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
166 ;; New: Picture mode compatibility.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
167 ;; 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
168 ;; with Picture mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
169 ;; Bugfix: No longer leaves traces of lines when rubberbanding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
170 ;; if the buffer auto-scrolls.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
171 ;; Bugfix: Infinite loop sometimes when rubberbanding was turned
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
172 ;; off.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
173 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
174 ;; 1.0 01-Mar-1998
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
175 ;; First official release.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
176
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
177 ;;; Code:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
178
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
179 ;; Variables
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
180
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
181 (defconst artist-version "1.2.2")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
182 (defconst artist-maintainer-address "tab@lysator.liu.se")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
183
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
184
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
185 (eval-and-compile
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
186 (condition-case ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
187 (require 'custom)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
188 (error nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
189 (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
190 nil ;; We've got what we needed
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
191 ;; We have the old custom-library, hack around it!
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
192 (defmacro defgroup (&rest args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
193 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
194 (defmacro defface (var values doc &rest args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
195 (` (make-face (, var))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
196 (defmacro defcustom (var value doc &rest args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
197 (` (defvar (, var) (, value) (, doc))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
198
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
199 ;; User options
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
200 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
201
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
202 (defgroup artist nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
203 "Customization of the Artist mode."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
204 :group 'mouse)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
205
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
206 (defgroup artist-text nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
207 "Customization of the text rendering."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
208 :group 'artist)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
209
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
210 (defcustom artist-rubber-banding t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
211 "Interactively do rubber-banding when non-nil."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
212 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
213 :type 'boolean)
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 (defcustom artist-first-char ?1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
216 "Character to set at first point when not rubber-banding."
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 :type 'character)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
219
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
220 (defcustom artist-second-char ?2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
221 "Character to set at second point when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
222 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
223 :type 'character)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
224
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
225 (defcustom artist-interface-with-rect t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
226 "Whether to interface with the rect package or not.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
227
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
228 Interfacing to the rect package means that the Copy and Paste operations
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
229 will use the rectangle buffer when accessing the copied area. This means
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
230 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
231 and vice versa.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
232
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
233 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
234 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
235 artist package will use its own copy buffer."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
236 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
237 :type 'boolean)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
238
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
239 (defvar artist-arrows [ ?> nil ?v ?L ?< nil ?^ nil ]
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
240 ;; This is a defvar, not a defcustom, since the custom
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
241 ;; package shows vectors of characters as a vector of integers,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
242 ;; which is confusing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
243 "A vector of characters to use as arrows.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
244
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
245 The vector is 8 elements long and contains a character for each
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
246 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
247 in that direction.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
248
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
249 The directions are as follows:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
250
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
251 5 6 7
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
252 \\ | /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
253 4 - * - 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
254 / | \\
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
255 3 2 1")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
256
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
257 (defcustom artist-aspect-ratio 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
258 "Defines the character height-to-width aspect ratio.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
259 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
260 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
261 :type 'number)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
262
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
263 (defcustom artist-trim-line-endings t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
264 "Whether or not to remove white-space at end of lines.
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 If non-nil, line-endings are trimmed (that is, extraneous white-space
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
267 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
268 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
269 :type 'boolean)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
270
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-flood-fill-right-border 'window-width
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
273 "Right edge definition, used when flood-filling.
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 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
276 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
277 variable. This limit is called the fill-border."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
278 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
279 :type '(choice (const :tag "limited to window" window-width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
280 (const :tag "limited to value of `fill-column'" fill-column)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
281
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
282 (defcustom artist-flood-fill-show-incrementally t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
283 "Whether or not to incrementally update display when flood-filling.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
284
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
285 If non-nil, incrementally update display when flood-filling.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
286 If set to non-nil, this currently implies discarding any input events
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
287 during the flood-fill."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
288 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
289 :type 'boolean)
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
292 (defcustom artist-ellipse-right-char ?\)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
293 "Character to use at the rightmost position when drawing narrow ellipses.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
294
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
295 In this figure, it is the right parenthesis (the ``)'' character):
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
296 -----
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
297 ( )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
298 -----"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
299 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
300 :type 'character)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
301
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
302
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
303 (defcustom artist-ellipse-left-char ?\(
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
304 "Character to use at the leftmost position when drawing narrow ellipses.
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 In this figure, it is the left parenthesis (the ``('' character):
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 ( )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
309 -----"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
310 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
311 :type 'character)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
312
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
313 (defcustom artist-picture-compatibility t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
314 "Whether or not picture mode compatibility is on."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
315 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
316 :type 'boolean)
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
320
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
321 (defcustom artist-vaporize-fuzziness 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
322 "How to vaporize lines that are cut off.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
323
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
324 Accept this many characters cutting off a line and still treat
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
325 it as one line.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
326 Example:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
327 If `artist-vaporize-fuzziness' is 2, then those will be recognized as
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
328 lines from A to B (provided you start vaporizing them at the ``*''):
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 A----*------/-----------B
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
331 \\/
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
332 A----*----/\\------------B
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
333 / \\
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
334
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
335 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
336 \\/ /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
337 A----*----/\\/----------B
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 (in fact, only the left part (between the A and the leftmost ``/''
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
340 crossing the line) will be vaporized)"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
341 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
342 :type 'integer)
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
345 (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
346 "*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
347
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
348
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
349 (defcustom artist-text-renderer 'artist-figlet
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
350 "Function for doing text rendering."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
351 :group 'artist-text
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
352 :type 'symbol)
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
355 (defcustom artist-figlet-program "figlet"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
356 "Program to run for `figlet'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
357 :group 'artist-text
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
358 :type 'string)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
359
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
360
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
361 (defcustom artist-figlet-default-font "standard"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
362 "Default font for `figlet'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
363 :group 'artist-text
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
364 :type 'string)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
365
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
366
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
367 (defcustom artist-figlet-list-fonts-command
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
368 ;; list files ending with *.flf in any directory printed by the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
369 ;; ``figlet -I2'' command. I think this will not produce more than
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
370 ;; one directory, but it never hurts to be on the safe side...
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
371 "for dir in `figlet -I2`; do cd $dir; ls *.flf; done"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
372 "Command to run to get list of available fonts."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
373 :group 'artist-text
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
374 :type 'string)
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
377 (defcustom artist-spray-interval 0.2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
378 "Number of seconds between repeated spraying."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
379 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
380 :type 'number)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
381
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
382
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
383 (defcustom artist-spray-radius 4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
384 "Size of the area for spraying."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
385 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
386 :type 'integer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
387
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
388
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
389 (defvar artist-spray-chars '(?\ ?. ?- ?+ ?m ?% ?* ?#)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
390 ;; This is a defvar, not a defcustom, since the custom
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
391 ;; package shows lists of characters as a lists of integers,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
392 ;; which is confusing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
393 "*Characters (``color'') to use when spraying.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
394 They should be ordered
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
395 from the ``lightest'' to the ``heaviest'' since spraying replaces a
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
396 light character with the next heavier one.")
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
399 (defvar artist-spray-new-char ?.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
400 "*Initial character to use when spraying.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
401 This character is used if spraying upon a character that is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
402 not in `artist-spray-chars'. The character defined by this variable
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
403 should be in `artist-spray-chars', or spraying will behave
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
404 strangely.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
405
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 ;; End of user options
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
409
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
410
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
411 ;; Internal variables
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
412 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
413 (defvar artist-mode nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
414 "Non-nil to enable `artist-mode' and nil to disable.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
415 (make-variable-buffer-local 'artist-mode)
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 (defvar artist-mode-name " Artist"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
418 "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
419
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
420 (defvar artist-curr-go 'pen-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
421 "Current selected graphics operation.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
422 (make-variable-buffer-local 'artist-curr-go)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
423
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
424 (defvar artist-line-char-set nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
425 "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
426 (make-variable-buffer-local 'artist-line-char-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
427
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
428 (defvar artist-line-char nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
429 "Char to use when drawing lines.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
430 (make-variable-buffer-local 'artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
431
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
432 (defvar artist-fill-char-set nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
433 "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
434 (make-variable-buffer-local 'artist-fill-char-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
435
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
436 (defvar artist-fill-char nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
437 "Char to use when filling.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
438 (make-variable-buffer-local 'artist-fill-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
439
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
440 (defvar artist-erase-char ?\
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
441 "Char to use when erasing.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
442 (make-variable-buffer-local 'artist-erase-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
443
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
444 (defvar artist-default-fill-char ?.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
445 "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
446 (make-variable-buffer-local 'artist-default-fill-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
447
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
448 ; This variable is not buffer local
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
449 (defvar artist-copy-buffer nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
450 "Copy buffer.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
451
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
452 (defvar artist-draw-region-min-y 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
453 "Line-number for top-most visited line for draw operation.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
454 (make-variable-buffer-local 'artist-draw-region-min-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
455
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
456 (defvar artist-draw-region-max-y 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
457 "Line-number for bottom-most visited line for draw operation.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
458 (make-variable-buffer-local 'artist-draw-region-max-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
459
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
460 (defvar artist-borderless-shapes nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
461 "When non-nil, draw shapes without border.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
462 The fill char is used instead, if it is set.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
463 (make-variable-buffer-local 'artist-borderless-shapes)
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
466 (eval-when-compile
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
467 ;; Make rect available at compile-time
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
468 (require 'rect) ; for interfacing with rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
469 (require 'reporter) ; the bug-reporting tool
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
470 (require 'picture)) ; picture mode compatibility
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
471
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
472 (if artist-interface-with-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
473 (require 'rect))
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 (require 'reporter)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
476
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
477 (if artist-picture-compatibility
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
478 (require 'picture))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
479
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 (defvar artist-mode-map
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
482 (let ((map (make-sparse-keymap)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
483 (setq artist-mode-map (make-sparse-keymap))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
484 (define-key map [down-mouse-1] 'artist-down-mouse-1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
485 (define-key map [S-down-mouse-1] 'artist-down-mouse-1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
486 (define-key map [down-mouse-2] 'artist-mouse-choose-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
487 (define-key map [S-down-mouse-2] 'artist-mouse-choose-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
488 (define-key map [down-mouse-3] 'artist-down-mouse-3)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
489 (define-key map [S-down-mouse-3] 'artist-down-mouse-3)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
490 (define-key map "\r" 'artist-key-set-point) ; return
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
491 (define-key map [up] 'artist-previous-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
492 (define-key map "\C-p" 'artist-previous-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
493 (define-key map [down] 'artist-next-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
494 (define-key map "\C-n" 'artist-next-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
495 (define-key map [left] 'artist-backward-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
496 (define-key map "\C-b" 'artist-backward-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
497 (define-key map [right] 'artist-forward-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
498 (define-key map "\C-f" 'artist-forward-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
499 (define-key map "<" 'artist-toggle-first-arrow)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
500 (define-key map ">" 'artist-toggle-second-arrow)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
501 (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
502 (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
503 (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
504 (define-key map "\C-c\C-a\C-o" 'artist-select-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
505 (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
506 (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
507 (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
508 (define-key map "\C-c\C-c" 'artist-mode-off)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
509 (define-key map "\C-c\C-al" 'artist-select-op-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
510 (define-key map "\C-c\C-aL" 'artist-select-op-straight-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
511 (define-key map "\C-c\C-ar" 'artist-select-op-rectangle)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
512 (define-key map "\C-c\C-aR" 'artist-select-op-square)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
513 (define-key map "\C-c\C-as" 'artist-select-op-square)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
514 (define-key map "\C-c\C-ap" 'artist-select-op-poly-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
515 (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
516 (define-key map "\C-c\C-ae" 'artist-select-op-ellipse)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
517 (define-key map "\C-c\C-ac" 'artist-select-op-circle)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
518 (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
519 (define-key map "\C-c\C-aT" 'artist-select-op-text-overwrite)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
520 (define-key map "\C-c\C-aS" 'artist-select-op-spray-can)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
521 (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
522 (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
523 (define-key map "\C-c\C-aE" 'artist-select-op-erase-rectangle)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
524 (define-key map "\C-c\C-av" 'artist-select-op-vaporize-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
525 (define-key map "\C-c\C-aV" 'artist-select-op-vaporize-lines)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
526 (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
527 (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
528 (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
529 (define-key map "\C-c\C-af" 'artist-select-op-flood-fill)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
530 (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
531 map)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
532 "Keymap for `artist-minor-mode'.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
533
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
534 (defvar artist-replacement-table (make-vector 256 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
535 "Replacement table for `artist-replace-char'.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
536
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
537
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
538 ;;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
539 ;;; The table of graphic operations
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
540 ;;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
541 (defvar artist-mt
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
542 ;; Implementation note: Maybe this should be done using a structure
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
543 ;; in the cl package?
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
544 ;;
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 (menu
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
547 ("Drawing"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
548 ((function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
549 ( "Undo" do-undo undo))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
550
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
551 (separator )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
552 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
553 ("Pen" (("Pen" pen-char "pen-c"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
554 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
555 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
556 artist-do-continously
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
557 artist-pen
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
558 (nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
559 ("Pen Line" pen-line "pen-l"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
560 artist-arrows artist-pen-set-arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
561 artist-pen-reset-last-xy nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
562 artist-do-continously
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
563 artist-pen-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
564 (nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
565
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
566 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
567 ("Line" (("line" line "line"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
568 artist-arrows artist-set-arrow-points-for-2points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
569 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
570 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
571 artist-draw-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
572 (artist-undraw-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
573 artist-nil nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
574 ("straight line" s-line "sline"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
575 artist-arrows artist-set-arrow-points-for-2points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
576 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
577 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
578 artist-draw-sline
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
579 (artist-undraw-sline
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
580 artist-nil nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
581
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
582 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
583 ("Rectangle" (("rectangle" rect "rect"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
584 artist-no-arrows nil
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-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
588 (artist-undraw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
589 artist-t-if-fill-char-set artist-fill-rect))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
590 ("square" square "square"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
591 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
592 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
593 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
594 artist-draw-square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
595 (artist-undraw-square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
596 artist-t-if-fill-char-set artist-fill-square)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
597
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
598 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
599 ("Poly-line" (("poly-line" polyline "poly"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
600 artist-arrows artist-set-arrow-points-for-poly
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 artist-do-poly
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
603 artist-draw-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
604 (artist-undraw-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
605 artist-nil nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
606 ("straight poly-line" spolyline "s-poly"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
607 artist-arrows artist-set-arrow-points-for-poly
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
608 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
609 artist-do-poly
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
610 artist-draw-sline
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
611 (artist-undraw-sline
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
612 artist-nil nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
613
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
614 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
615 ("Ellipse" (("ellipse" ellipse "ellipse"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
616 artist-no-arrows nil
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 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
619 artist-draw-ellipse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
620 (artist-undraw-ellipse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
621 artist-t-if-fill-char-set artist-fill-ellipse))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
622 ("circle" circle "circle"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
623 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
624 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
625 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
626 artist-draw-circle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
627 (artist-undraw-circle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
628 artist-t-if-fill-char-set artist-fill-circle)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
629
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
630 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
631 ("Text" (("text see-thru" text-thru "text-thru"
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 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
635 artist-text-see-thru
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
636 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
637 ("text overwrite" text-ovwrt "text-ovwrt"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
638 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
639 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
640 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
641 artist-text-overwrite
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
642 nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
643
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
644 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
645 ("Spray-can" (("spray-can" spray-can "spray-can"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
646 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
647 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
648 artist-do-continously
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
649 artist-spray
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
650 (artist-spray-get-interval))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
651 ("spray set size" spray-get-size "spray-size"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
652 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
653 nil artist-spray-clear-circle artist-spray-set-radius
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
654 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
655 artist-draw-circle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
656 (artist-undraw-circle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
657 artist-nil nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
658
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
659 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
660 ("Erase" (("erase char" erase-char "erase-c"
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 nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
663 artist-do-continously
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
664 artist-erase-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
665 (nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
666 ("erase rectangle" erase-rect "erase-r"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
667 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
668 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
669 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
670 artist-draw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
671 (artist-undraw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
672 artist-t artist-erase-rect)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
673
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
674 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
675 ("Vaporize" (("vaporize line" vaporize-line "vaporize-1"
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 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
679 artist-vaporize-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
680 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
681 ("vaporize lines" vaporize-lines "vaporize-n"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
682 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
683 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
684 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
685 artist-vaporize-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
686 nil)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
687
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
688 (menu
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
689 ("Edit"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
690 ((graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
691 ("Cut" (("cut rectangle" cut-r "cut-r"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
692 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
693 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
694 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
695 artist-draw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
696 (artist-undraw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
697 artist-t artist-cut-rect)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
698 ("cut square" cut-s "cut-s"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
699 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
700 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
701 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
702 artist-draw-square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
703 (artist-undraw-square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
704 artist-t artist-cut-square)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
705
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
706 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
707 ("Copy" (("copy rectangle" copy-r "copy-r"
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-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
712 (artist-undraw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
713 artist-t artist-copy-rect)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
714 ("copy square" copy-s "copy-s"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
715 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
716 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
717 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
718 artist-draw-square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
719 (artist-undraw-square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
720 artist-t artist-copy-square)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
721
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
722 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
723 ("Paste" (("paste" paste "paste"
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 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
727 artist-paste
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
728 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
729 ("paste" paste "paste"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
730 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
731 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
732 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
733 artist-paste
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
734 nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
735
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
736 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
737 ("Flood-fill" (("flood-fill" flood-fill "flood"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
738 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
739 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
740 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
741 artist-flood-fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
742 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
743 ("flood-fill" flood-fill "flood"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
744 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
745 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
746 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
747 artist-flood-fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
748 nil)))))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
749
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
750 (menu
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
751 ("Settings"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
752 ((function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
753 ("Set Fill" set-fill artist-select-fill-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
754
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
755 (function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
756 ("Set Line" set-line artist-select-line-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
757
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
758 (function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
759 ("Set Erase" set-erase artist-select-erase-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
760
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 ("Rubber-banding" rubber-band artist-toggle-rubber-banding))
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 ("Trimming" trimming artist-toggle-trim-line-endings))
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 ("Borders" borders artist-toggle-borderless-shapes))
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 ("Spray-chars" spray-chars artist-select-spray-chars)))))
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 ) ;; end of list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
774
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
775 "Master Table for `artist-mode'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
776 This table is primarily a table over the different graphics operations
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
777 available in artist mode, but it also holds layout information for the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
778 popup menu.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
779
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
780 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
781 have the layout
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
782
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
783 (TAG INFO-PART)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
784
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
785 There are three kinds of TAG:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
786
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
787 `menu' -- a sub-menu
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
788 `separator' -- produce a separator in the popup menu
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
789 `function-call' -- call a function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
790 `graphics-operation' -- a graphics operation
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 The layout of the INFO-PART for `menu' is
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 (TITLE ((TAG-1 INFO-PART-1) (TAG-2 INFO-PART-2) ...))
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 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
797 menu items, each on the general form (TAG INFO-PART).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
798
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
799
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
800 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
801
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 This is the layout of the INFO-PART for `function-call':
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 (KEYWORD SYMBOL FN)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
806
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
807 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
808 SYMBOL is the symbol for the operations.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
809 FN is the function performing the operation. This function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
810 is called with no arguments. Its return value is ignored.
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
813 The layout of the INFO-PART for `graphics-operation' is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
814
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
815 (TITLE (UNSHIFTED SHIFTED))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
816
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
817 TITLE is the the title that appears in the popup menu. UNSHIFTED
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
818 and SHIFTED specify for unshifted and shifted operation. Both
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
819 have the form
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 (KEYWORD KEY-SYMBOL MODE-LINE ARROW-PRED ARROW-SET-FN
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
822 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
823
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
824 KEYWORD is a string specifying the name of the shape to draw.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
825 This is used when selecting drawing operation.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
826 KEY-SYMBOL is the key which is used when looking up members
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
827 through the functions `artist-go-get-MEMBER-from-symbol'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
828 and `artist-fc-get-MEMBER-from-symbol'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
829 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
830 the shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
831 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
832 can have arrows. The function is called with no arguments and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
833 must return nil or t.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
834 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
835 Arguments and return values for this funcion are described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
836 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
837 point of the shape is set. Arguments and return values for
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
838 this funcion are described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
839 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
840 the last point is set, but before the filling is done.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
841 Arguments and return values for this funcion are described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
842 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
843 is done. Arguments and return values for this funcion are
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
844 described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
845 DRAW-HOW defines the kind of shape. The kinds of shapes are:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
846 `artist-do-continously' -- Do drawing operation continously,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
847 as long as the mouse button is held down.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
848 `artist-do-poly' -- Do drawing operation many times.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
849 1 -- Do drawing operation only once.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
850 2 -- The drawing operation requires two points.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
851 DRAW-FN is the function to call for drawing. Arguments and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
852 return values for this funcion are described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
853 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
854 If DRAW-HOW is `artist-do-continously':
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
855
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
856 (INTERVAL-FN)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
857
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
858 INTERVAL-FN is, if non-nil, a function to call for getting
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
859 an interval between repeated calls to the DRAW-FN.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
860 This function is called with no arguments and must
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
861 return a number, the interval in seconds.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
862 If nil, calls to DRAW-FN are done only when the mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
863 or cursor is moved.
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 If DRAW-HOW is either `artist-do-poly' or 2:
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 (UNDRAW-FN FILL-PRED FILL-FN)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
868
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
869 UNDRAW-FN is a function to call for undrawing the shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
870 Arguments and return values for this funcion are
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
871 described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
872 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
873 can have arrows. The function must take no arguments and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
874 return nil or t.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
875 FILL-FN is a function to call for filling the shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
876 Arguments and return values for this funcion are
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
877 described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
878
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
879 If DRAW-HOW is 1:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
880
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
881 ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
882
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
883 Note! All symbols and keywords (both in the `funcion-call' INFO-PART
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
884 as well as in the `graphics-operation' INFO-PART) must be unique.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
885
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
886 The following table describe function arguments and return value
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
887 for different functions and DRAW-HOWs.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
888
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
889 If DRAW-HOW is either `artist-do-continously' or 1:
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 INIT-FN X Y ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
892 PREP-FILL-FN X Y ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
893 EXIT-FN X Y ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
894 ARROW-SET-FN X Y ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
895 DRAW-FN X Y ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
896
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
897 If DRAW-HOW is 2:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
898
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
899 INIT-FN X1 Y1 ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
900 PREP-FILL-FN X1 Y1 X2 Y2 ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
901 EXIT-FN X1 Y1 X2 Y2 ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
902 ARROW-SET-FN X1 Y1 X2 Y2 ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
903 DRAW-FN X1 Y1 X2 Y2 ==> (ENDPOINT-1 ENDPOINT-2 SHAPE)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
904 UNDRAW-FN (ENDPOINT-1 ENDPOINT-2 SHAPE) ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
905 FILL-FN (ENDPOINT-1 ENDPOINT-2 SHAPE) X1 Y1 X2 Y2 ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
906
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
907 ENDPOINT-1 and ENDPOINT-2 are endpoints which are created with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
908 `artist-make-endpoint'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
909 SHAPE is an opaque structure, created by the DRAW-FN and intented
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
910 to be used only by the UNDRAW-FN.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
911
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
912 If DRAW-HOW is `artist-do-poly':
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
913
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
914 INIT-FN X1 Y1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
915 PREP-FILL-FN POINT-LIST
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
916 ARROW-SET-FN POINT-LIST
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
917 EXIT-FN POINT-LIST
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
918 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
919 UNDRAW-FN (ENDPOINT-1 ENDPOINT-2 SHAPE)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
920 FILL-FN POINT-LIST
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
921
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
922 ENDPOINT-1 and ENDPOINT-2 are endpoints which are created with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
923 `artist-make-endpoint'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
924 SHAPE is an opaque structure, created by the DRAW-FN and intented
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
925 to be used only by the UNDRAW-FN.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
926 POINT-LIST is a list of vectors [X Y].")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
927
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
928
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
929 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
930 ;; Accessors for the master table
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
931 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
932
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
933 (defun artist-mt-get-tag (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
934 "Retrieve the tag component from the master table ELEMENT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
935 (elt element 0))
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 (defun artist-mt-get-info-part (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
938 "Retrieve the info part component from the master table ELEMENT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
939 (elt element 1))
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 ;; For the 'graphics-operation info-parts
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
942 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
943 (defsubst artist-go-get-desc (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
944 "Retrieve the description component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
945 (elt info-part 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
946
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
947 (defsubst artist-go-get-unshifted (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
948 "Retrieve the unshifted info from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
949 (elt (elt info-part 1) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
950
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
951 (defsubst artist-go-get-shifted (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
952 "Retrieve the shifted info from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
953 (elt (elt info-part 1) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
954
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
955 (defsubst artist-go-get-keyword (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
956 "Retrieve the keyword component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
957 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
958 (elt info-variant-part 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-symbol (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
961 "Retrieve the symbol component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
962 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
963 (elt info-variant-part 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
964
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
965 (defsubst artist-go-get-mode-line (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
966 "Retrieve the mode line component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
967 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
968 (elt info-variant-part 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
969
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
970 (defsubst artist-go-get-arrow-pred (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
971 "Retrieve the arrow predicate component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
972 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
973 (elt info-variant-part 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
974
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
975 (defsubst artist-go-get-arrow-set-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
976 "Retrieve the arrow set component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
977 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
978 (elt info-variant-part 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
979
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
980 (defsubst artist-go-get-init-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
981 "Retrieve the init function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
982 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
983 (elt info-variant-part 5))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
984
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
985 (defsubst artist-go-get-prep-fill-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
986 "Retrieve the fill preparation function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
987 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
988 (elt info-variant-part 6))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
989
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
990 (defsubst artist-go-get-exit-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
991 "Retrieve the exit component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
992 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
993 (elt info-variant-part 7))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
994
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
995 (defsubst artist-go-get-draw-how (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
996 "Retrieve the draw how component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
997 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
998 (elt info-variant-part 8))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
999
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1000 (defsubst artist-go-get-draw-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1001 "Retrieve the draw function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1002 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
1003 (elt info-variant-part 9))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1004
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1005 (defsubst artist-go-get-undraw-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1006 "Retrieve the undraw function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1007 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
1008 This interval function component is available only if the `draw-how'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1009 component is other than `artist-do-continously' or 1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1010 (elt (elt info-variant-part 10) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1011
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1012 (defsubst artist-go-get-interval-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1013 "Retrieve the interval function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1014 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
1015 This interval function component is available only if the `draw-how'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1016 component is `artist-do-continously'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1017 (elt (elt info-variant-part 10) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1018
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1019 (defsubst artist-go-get-fill-pred (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1020 "Retrieve the fill predicate component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1021 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
1022 This interval function component is available only if the `draw-how'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1023 component is other than `artist-do-continously' or 1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1024 (elt (elt info-variant-part 10) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1025
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1026 (defsubst artist-go-get-fill-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1027 "Retrieve the fill function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1028 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
1029 This interval function component is available only if the `draw-how'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1030 component is other than `artist-do-continously' or 1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1031 (elt (elt info-variant-part 10) 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1032
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1033 ;; For the 'function-call info-parts
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-fc-get-keyword (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1036 "Retrieve the keyword component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1037 (elt info-part 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1038
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1039 (defsubst artist-fc-get-symbol (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1040 "Retrieve the symbol component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1041 (elt info-part 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1042
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1043 (defsubst artist-fc-get-fn (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1044 "Retrieve the function component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1045 (elt info-part 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1046
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1047 ;; For the 'menu info-parts
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1048 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1049 (defsubst artist-mn-get-title (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1050 "Retrieve the title component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1051 (elt info-part 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1052
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1053 (defsubst artist-mn-get-items (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1054 "Retrieve the items component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1055 (elt info-part 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1056
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 ;;; The artist-mode
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1059 ;;; ---------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1060
33653
55d418b6992e (artist-mode): Fix autoload cookie.
Gerd Moellmann <gerd@gnu.org>
parents: 33618
diff changeset
1061 ;;;###autoload
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1062 (defun artist-mode (&optional state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1063 "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
1064 Artist lets you draw lines, squares, rectangles and poly-lines, ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1065 and circles with your mouse and/or keyboard.
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 How to quit 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 Type \\[artist-mode-off] to quit artist-mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1070
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1071
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1072 How to submit a bug report
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1073
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1074 Type \\[artist-submit-bug-report] to submit a bug report.
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1077 Drawing with the mouse:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1078
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1079 mouse-2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1080 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
1081 mouse-1, and where you can do some settings (described
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1082 below).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1083
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1084 mouse-1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1085 shift mouse-1 Draws lines, rectangles or poly-lines, erases, cuts, copies
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1086 or pastes:
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 Operation Not shifted Shifted
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1089 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1090 Pen fill-char at point line from last point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1091 to new point
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 Line Line in any direction Straight line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1094 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1095 Rectangle Rectangle Square
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 Poly-line Poly-line in any dir Straight poly-lines
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 Ellipses Ellipses Circles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1100 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1101 Text Text (see thru) Text (overwrite)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1102 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1103 Spray-can Spray-can Set size for spray
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1104 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1105 Erase Erase character Erase rectangle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1106 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1107 Vaporize Erase single line Erase connected
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1108 lines
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 Cut Cut rectangle Cut square
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 Copy Copy rectangle Copy square
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 Paste Paste Paste
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 Flood-fill Flood-fill Flood-fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1117 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1118
37825
8968ceca1581 (artist-mode): Fix a typo. From Pavel Janik <Pavel@Janik.cz>.
Eli Zaretskii <eliz@gnu.org>
parents: 34903
diff changeset
1119 * Straight lines can only go horizontally, vertically
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1120 or diagonally.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1121
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1122 * Poly-lines are drawn while holding mouse-1 down. When you
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1123 release the button, the point is set. If you want a segment
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1124 to be straight, hold down shift before pressing the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1125 mouse-1 button. Click mouse-2 or mouse-3 to stop drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1126 poly-lines.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1127
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1128 * See thru for text means that text already in the buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1129 will be visible through blanks in the text rendered, while
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1130 overwrite means the opposite.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1131
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1132 * Vaporizing connected lines only vaporizes lines whose
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1133 _endpoints_ are connected. See also the variable
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1134 `artist-vaporize-fuzziness'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1135
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1136 * Cut copies, then clears the rectangle/square.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1137
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1138 * When drawing lines or poly-lines, you can set arrows.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1139 See below under ``Arrows'' for more info.
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 * The mode line shows the currently selected drawing operation.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1142 In addition, if it has an asterisk (*) at the end, you
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1143 are currently drawing something.
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 * Be patient when flood-filling -- large areas take quite
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1146 some time to fill.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1147
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1148
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1149 mouse-3 Erases character under pointer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1150 shift mouse-3 Erases rectangle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1151
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1152
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1153 Settings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1154
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1155 Set fill Sets the character used when filling rectangles/squares
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 Set line Sets the character used when drawing lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1158
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1159 Erase char Sets the character used when erasing
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 Rubber-banding Toggles rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1162
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1163 Trimming Toggles trimming of line-endings (that is: when the shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1164 is drawn, extraneous white-space at end of lines is removed)
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 Borders Toggles the drawing of line borders around filled shapes.
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1169 Drawing with keys
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1170
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1171 \\[artist-key-set-point] Does one of the following:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1172 For lines/rectangles/squares: sets the first/second endpoint
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1173 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
1174 When erase characters: toggles erasing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1175 When cutting/copying: Sets first/last endpoint of rect/square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1176 When pasting: Pastes
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 \\[artist-select-operation] Selects what to draw
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 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
1181
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1182 \\[artist-select-fill-char] Sets the charater to use when filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1183 \\[artist-select-line-char] Sets the charater to use when drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1184 \\[artist-select-erase-char] Sets the charater to use when erasing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1185 \\[artist-toggle-rubber-banding] Toggles rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1186 \\[artist-toggle-trim-line-endings] Toggles trimming of line-endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1187 \\[artist-toggle-borderless-shapes] Toggles borders on drawn shapes
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1190 Arrows
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1191
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1192 \\[artist-toggle-first-arrow] Sets/unsets an arrow at the beginning
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1193 of the line/poly-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1194
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1195 \\[artist-toggle-second-arrow] Sets/unsets an arrow at the end
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1196 of the line/poly-line
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 Selecting operation
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 There are some keys for quickly selecting drawing operations:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1202
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1203 \\[artist-select-op-line] Selects drawing lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1204 \\[artist-select-op-straight-line] Selects drawing straight lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1205 \\[artist-select-op-rectangle] Selects drawing rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1206 \\[artist-select-op-square] Selects drawing squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1207 \\[artist-select-op-poly-line] Selects drawing poly-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1208 \\[artist-select-op-straight-poly-line] Selects drawing straight poly-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1209 \\[artist-select-op-ellipse] Selects drawing ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1210 \\[artist-select-op-circle] Selects drawing circles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1211 \\[artist-select-op-text-see-thru] Selects rendering text (see thru)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1212 \\[artist-select-op-text-overwrite] Selects rendering text (overwrite)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1213 \\[artist-select-op-spray-can] Spray with spray-can
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1214 \\[artist-select-op-spray-set-size] Set size for the spray-can
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1215 \\[artist-select-op-erase-char] Selects erasing characters
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1216 \\[artist-select-op-erase-rectangle] Selects erasing rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1217 \\[artist-select-op-vaporize-line] Selects vaporizing single lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1218 \\[artist-select-op-vaporize-lines] Selects vaporizing connected lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1219 \\[artist-select-op-cut-rectangle] Selects cutting rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1220 \\[artist-select-op-copy-rectangle] Selects copying rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1221 \\[artist-select-op-paste] Selects pasting
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1222 \\[artist-select-op-flood-fill] Selects flood-filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1223
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1224
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1225 Variables
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1226
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1227 This is a brief overview of the different varaibles. For more info,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1228 see the documentation for the variables (type \\[describe-variable] <variable> RET).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1229
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1230 artist-rubber-banding Interactively do rubber-banding or not
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1231 artist-first-char What to set at first/second point...
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1232 artist-second-char ...when not rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1233 artist-interface-with-rect If cut/copy/paste should interface with rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1234 artist-arrows The arrows to use when drawing arrows
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1235 artist-aspect-ratio Character height-to-width for squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1236 artist-trim-line-endings Trimming of line endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1237 artist-flood-fill-right-border Right border when flood-filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1238 artist-flood-fill-show-incrementally Update display while filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1239 artist-pointer-shape Pointer shape to use while drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1240 artist-ellipse-left-char Character to use for narrow ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1241 artist-ellipse-right-char Character to use for narrow ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1242 artist-borderless-shapes If shapes should have borders
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1243 artist-picture-compatibility Whether or not to be picture mode compatible
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1244 artist-vaporize-fuzziness Tolerance when recognizing lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1245 artist-spray-interval Seconds between repeated sprayings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1246 artist-spray-radius Size of the spray-area
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1247 artist-spray-chars The spray-``color''
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1248 artist-spray-new-chars Initial spray-``color''
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1249
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1250 Hooks
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1251
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1252 When entering artist-mode, the hook `artist-mode-init-hook' is called.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1253 When quitting artist-mode, the hook `artist-mode-exit-hook' is called.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1254
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1255
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1256 Keymap summary
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1257
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1258 \\{artist-mode-map}"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1259 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1260 (if (setq artist-mode
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1261 (if (null state) (not artist-mode)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1262 (> (prefix-numeric-value state) 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1263 (artist-mode-init)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1264 (artist-mode-exit)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1265
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1266 ;; insert our minor mode string
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1267 (or (assq 'artist-mode minor-mode-alist)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1268 (setq minor-mode-alist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1269 (cons '(artist-mode artist-mode-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1270 minor-mode-alist)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1271
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1272 ;; insert our minor mode keymap
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1273 (or (assq 'artist-mode minor-mode-map-alist)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1274 (setq minor-mode-map-alist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1275 (cons (cons 'artist-mode artist-mode-map)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1276 minor-mode-map-alist)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1277
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1278
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1279
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1280 (eval-when-compile
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1281 ;; Variables that are made local in artist-mode-init
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1282 (defvar artist-key-is-drawing nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1283 (defvar artist-key-endpoint1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1284 (defvar artist-key-poly-point-list nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1285 (defvar artist-key-shape nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1286 (defvar artist-key-draw-how nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1287 (defvar artist-popup-menu-table nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1288 (defvar artist-key-compl-table nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1289 (defvar artist-rb-save-data nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1290 (defvar artist-arrow-point-1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1291 (defvar artist-arrow-point-2 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1292
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1293
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1294 ;; Init and exit
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1295 (defun artist-mode-init ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1296 "Init Artist mode. This will call the hook `artist-mode-init-hook'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1297 (let ((i 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1298 (while (< i 256)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1299 (aset artist-replacement-table i i)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1300 (setq i (1+ i))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1301 (aset artist-replacement-table ?\n ?\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1302 (aset artist-replacement-table ?\t ?\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1303 (aset artist-replacement-table 0 ?\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1304 (make-local-variable 'artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1305 (make-local-variable 'artist-key-endpoint1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1306 (make-local-variable 'artist-key-poly-point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1307 (make-local-variable 'artist-key-shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1308 (make-local-variable 'artist-key-draw-how)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1309 (make-local-variable 'artist-popup-menu-table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1310 (make-local-variable 'artist-key-compl-table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1311 (make-local-variable 'artist-rb-save-data)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1312 (make-local-variable 'artist-arrow-point-1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1313 (make-local-variable 'artist-arrow-point-2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1314 (setq artist-key-is-drawing nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1315 (setq artist-key-endpoint1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1316 (setq artist-key-poly-point-list nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1317 (setq artist-key-shape nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1318 (setq artist-popup-menu-table (artist-compute-popup-menu-table artist-mt))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1319 (setq artist-key-compl-table (artist-compute-key-compl-table artist-mt))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1320 (setq artist-rb-save-data (make-vector 7 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1321 (setq artist-arrow-point-1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1322 (setq artist-arrow-point-2 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1323 (make-local-variable 'next-line-add-newlines)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1324 (setq next-line-add-newlines t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1325 (setq artist-key-draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1326 (artist-go-get-draw-how-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1327 (if (and artist-picture-compatibility (not (eq major-mode 'picture-mode)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1328 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1329 (picture-mode)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1330 (message "")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1331 (run-hooks 'artist-mode-init-hook)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1332 (artist-mode-line-show-curr-operation artist-key-is-drawing))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1333
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1334 (defun artist-mode-exit ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1335 "Exit Artist mode. This will call the hook `artist-mode-exit-hook'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1336 (if (and artist-picture-compatibility (eq major-mode 'picture-mode))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1337 (picture-mode-exit))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1338 (kill-local-variable 'next-line-add-newlines)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1339 (run-hooks 'artist-mode-exit-hook))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1340
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1341 (defun artist-mode-off ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1342 "Turn Artist mode off."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1343 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1344 (artist-mode -1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1345 (force-mode-line-update))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1346
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1347 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1348 ;; General routines
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1351 (defun artist-update-display ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1352 "Repaint the display."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1353 (sit-for 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1354
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1355 (defun artist-mode-line-show-curr-operation (is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1356 "Show current operation in mode-line. If IS-DRAWING, show that."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1357 (let ((mtext (concat artist-mode-name "/"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1358 (artist-go-get-mode-line-from-symbol artist-curr-go)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1359 (if is-drawing "/*" ""))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1360 (setcdr (assq 'artist-mode minor-mode-alist) (list mtext)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1361 (force-mode-line-update))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1362
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-t-if-fill-char-set ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1365 "Return the value of the variable `artist-fill-char-set'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1366 artist-fill-char-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1367
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1368 (defun artist-t ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1369 "Always return t."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1370 t)
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 (defun artist-nil ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1373 "Always return nil."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1374 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1375
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1376 (defun artist-arrows ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1377 "Say yes to arrows!"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1378 t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1379
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1380 (defun artist-no-arrows ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1381 "Say no to arrows!"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1382 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1383
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 ;; Auxiliary init-routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1386 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1387
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 ; Computing the table for the x-popup-menu from the master table
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1390 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1391
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1392 (defun artist-compute-popup-menu-table (menu-table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1393 "Create a menu from from MENU-TABLE data.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1394 The returned value is suitable for the `x-popup-menu' function."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1395 (cons "Artist menu"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1396 (artist-compute-popup-menu-table-sub menu-table)))
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 (defun artist-compute-popup-menu-table-sub (menu-table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1399 "Compute operation table suitable for `x-popup-menu' from MENU-TABLE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1400 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1401 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1402 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1403 (cond ((eq element-tag 'graphics-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1404 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1405 (descr (artist-go-get-desc info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1406 (unshifted (artist-go-get-unshifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1407 (symbol (artist-go-get-symbol unshifted)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1408 (list descr symbol)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1409
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1410 ((eq element-tag 'function-call)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1411 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1412 (keyword (artist-fc-get-keyword info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1413 (symbol (artist-fc-get-symbol info-part)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1414 (list keyword symbol)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1415
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1416 ((eq element-tag 'separator)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1417 '("" ""))
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 'menu)
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 (title (artist-mn-get-title info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1422 (items (artist-mn-get-items info-part)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1423 (cons title (artist-compute-popup-menu-table-sub items))))
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 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1426 (error "Internal error: unknown element-tag: \"%s\""
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1427 element-tag)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1428 menu-table))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1429
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1430 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1431 ; Computing the completion table from the master table
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1432 ;
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 (defun artist-compute-key-compl-table (menu-table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1435 "Compute completion table from MENU-TABLE, suitable for `completing-read'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1436 (apply
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1437 'nconc
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1438 (artist-remove-nulls
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1439 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1440 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1441 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1442 (cond ((eq element-tag 'graphics-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1443 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1444 (unshifted (artist-go-get-unshifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1445 (shifted (artist-go-get-shifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1446 (unshifted-kwd (artist-go-get-keyword unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1447 (shifted-kwd (artist-go-get-keyword shifted)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1448 (list (list unshifted-kwd) (list shifted-kwd))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1449 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1450 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1451 (items (artist-mn-get-items info-part)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1452 (artist-compute-key-compl-table items)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1453 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1454 nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1455 menu-table))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1456
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1457
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1458 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1459 ; Retrieving a symbol (graphics operation or function-call) from a keyword
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1460 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1461
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1462 (defun artist-mt-get-symbol-from-keyword (kwd)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1463 "Search master table for keyword KWD and return its symbol."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1464 (artist-mt-get-symbol-from-keyword-sub artist-mt kwd))
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 (defun artist-mt-get-symbol-from-keyword-sub (table kwd)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1467 "Search TABLE for keyword KWD and return its symbol."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1468 (catch 'found
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1469 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1470 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1471 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1472 (cond ((eq element-tag 'graphics-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1473 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1474 (unshifted (artist-go-get-unshifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1475 (shifted (artist-go-get-shifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1476 (unshifted-kwd (artist-go-get-keyword unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1477 (shifted-kwd (artist-go-get-keyword shifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1478 (unshifted-sym (artist-go-get-symbol unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1479 (shifted-sym (artist-go-get-symbol shifted)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1480 (if (string-equal kwd unshifted-kwd)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1481 (throw 'found unshifted-sym))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1482 (if (string-equal kwd shifted-kwd)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1483 (throw 'found shifted-sym))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1484
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1485 ((eq element-tag 'function-call)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1486 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1487 (keyword (artist-fc-get-keyword info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1488 (symbol (artist-fc-get-symbol info-part)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1489 (if (string-equal kwd keyword)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1490 (throw 'found symbol))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1491 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1492 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1493 (items (artist-mn-get-items info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1494 (answer (artist-mt-get-symbol-from-keyword-sub
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1495 items kwd)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1496 (if answer (throw 'found answer))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1497 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1498 nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1499 table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1500 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1501
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1502
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1503 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1504 ; Retrieving info from a graphics operation symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1505 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1506
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1507 (defun artist-go-retrieve-from-symbol (symbol retrieve-fn)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1508 "Search the master table for a graphics operation SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1509 Calls RETRIEVE-FN to retrieve information from that symbol's
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1510 info-variant-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1511 (artist-go-retrieve-from-symbol-sub artist-mt symbol retrieve-fn))
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 (defun artist-go-retrieve-from-symbol-sub (table symbol retrieve-fn)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1514 "Search the TABLE for a graphics operation SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1515 Calls RETRIEVE-FN to retrieve information from that symbol's
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1516 info-variant-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1517 (catch 'found
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1518 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1519 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1520 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1521 (cond ((eq element-tag 'graphics-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1522 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1523 (unshifted (artist-go-get-unshifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1524 (shifted (artist-go-get-shifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1525 (unshifted-sym (artist-go-get-symbol unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1526 (shifted-sym (artist-go-get-symbol shifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1527 (variant-part (cond
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1528 ((eq unshifted-sym symbol) unshifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1529 ((eq shifted-sym symbol) shifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1530 (t nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1531 (if variant-part ; if found do:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1532 (throw 'found (funcall retrieve-fn variant-part)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1533
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1534 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1535 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1536 (items (artist-mn-get-items info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1537 (answer (artist-go-retrieve-from-symbol-sub
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1538 items symbol retrieve-fn)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1539 (if answer (throw 'found answer)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1540
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1541 table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1542 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1543
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1544 (defun artist-go-get-keyword-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1545 "Search the master table, get keyword from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1546 (artist-go-retrieve-from-symbol symbol 'artist-go-get-keyword))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1547
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1548 (defun artist-go-get-mode-line-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1549 "Search the master table, get mode-line from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1550 (artist-go-retrieve-from-symbol symbol 'artist-go-get-mode-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1551
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1552 (defun artist-go-get-arrow-pred-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1553 "Search the master table, get arrow-pred from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1554 (artist-go-retrieve-from-symbol symbol 'artist-go-get-arrow-pred))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1555
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1556 (defun artist-go-get-arrow-set-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1557 "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
1558 (artist-go-retrieve-from-symbol symbol 'artist-go-get-arrow-set-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1559
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1560 (defun artist-go-get-init-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1561 "Search the master table, get init-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1562 (artist-go-retrieve-from-symbol symbol 'artist-go-get-init-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1563
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1564 (defun artist-go-get-prep-fill-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1565 "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
1566 (artist-go-retrieve-from-symbol symbol 'artist-go-get-prep-fill-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1567
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1568 (defun artist-go-get-exit-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1569 "Search the master table, get exit-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1570 (artist-go-retrieve-from-symbol symbol 'artist-go-get-exit-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1571
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1572 (defun artist-go-get-draw-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1573 "Search the master table, get draw-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1574 (artist-go-retrieve-from-symbol symbol 'artist-go-get-draw-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1575
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1576 (defun artist-go-get-draw-how-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1577 "Search the master table, get draw-how from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1578 (artist-go-retrieve-from-symbol symbol 'artist-go-get-draw-how))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1579
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1580 (defun artist-go-get-undraw-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1581 "Search the master table, get undraw-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1582 (artist-go-retrieve-from-symbol symbol 'artist-go-get-undraw-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1583
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1584 (defun artist-go-get-interval-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1585 "Search the master table, get interval-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1586 (artist-go-retrieve-from-symbol symbol 'artist-go-get-interval-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1587
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1588 (defun artist-go-get-fill-pred-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1589 "Search the master table, get fill-pred from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1590 (artist-go-retrieve-from-symbol symbol 'artist-go-get-fill-pred))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1591
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1592 (defun artist-go-get-fill-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1593 "Search the master table, get fill-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1594 (artist-go-retrieve-from-symbol symbol 'artist-go-get-fill-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1595
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1596 (defun artist-go-get-symbol-shift (symbol is-shifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1597 "Search for (shifted or unshifted) graphics operation SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1598 If IS-SHIFTED is non-nil, return the shifted symbol,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1599 otherwise the shifted symbol."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1600 (artist-go-get-symbol-shift-sub artist-mt symbol is-shifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1601
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1602 (defun artist-go-get-symbol-shift-sub (table symbol is-shifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1603 "Search TABLE for (shifted or unshifted) graphics SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1604 If IS-SHIFTED is non-nil, return the shifted symbol,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1605 otherwise the shifted symbol."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1606 (catch 'found
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1607 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1608 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1609 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1610 (cond ((eq element-tag 'graphics-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1611 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1612 (unshift-variant (artist-go-get-unshifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1613 (shift-variant (artist-go-get-shifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1614 (unshift-sym (artist-go-get-symbol unshift-variant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1615 (shift-sym (artist-go-get-symbol shift-variant)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1616 (if (or (eq symbol unshift-sym) (eq symbol shift-sym))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1617 (throw 'found (if is-shifted shift-sym unshift-sym)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1619 ((eq element-tag 'menu)
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 (items (artist-mn-get-items info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1622 (answer (artist-go-get-symbol-shift-sub
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1623 items symbol is-shifted)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1624 (if answer (throw 'found answer)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1625
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1626 table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1627 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1628
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1629 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1630 ; Retrieving info from a function-call symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1631 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1632
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1633 (defun artist-fc-retrieve-from-symbol (symbol retrieve-fn)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1634 "Search the master table for a function call SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1635 Calls RETRIEVE-FN to retrieve information from that symbol's
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1636 info-variant-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1637 (artist-fc-retrieve-from-symbol-sub artist-mt symbol retrieve-fn))
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 (defun artist-fc-retrieve-from-symbol-sub (table symbol retrieve-fn)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1640 "Search TABLE for a function-call SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1641 Calls RETRIEVE-FN to retrieve information from that symbol's
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1642 info-variant-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1643 (catch 'found
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1644 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1645 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1646 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1647 (cond ((eq element-tag 'function-call)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1648 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1649 (fc-symbol (artist-fc-get-symbol info-part)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1650 (if (eq fc-symbol symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1651 (throw 'found (funcall retrieve-fn info-part)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1652
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1653 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1654 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1655 (items (artist-mn-get-items info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1656 (answer (artist-fc-retrieve-from-symbol-sub
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1657 items symbol retrieve-fn)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1658 (if answer (throw 'found answer)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1659
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1660 table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1661 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1662
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1663 (defun artist-fc-get-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1664 "Search the master table to get function from a function call SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1665 (artist-fc-retrieve-from-symbol symbol 'artist-fc-get-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1666
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1667
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 ;; Utilities
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1670 ;;
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 ;; Macro that won't funcall the function if it is nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1673 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1674 (defmacro artist-funcall (fn &rest args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1675 "Call function FN with ARGS iff FN is not nil."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1676 (list 'if fn (cons 'funcall (cons fn args))))
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 (defun artist-last (seq &optional n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1679 "Return the last link in the list SEQ.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1680 With optional argument N, returns Nth-to-last link (default 1)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1681 (if (not n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1682 (setq n 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1683 (let ((len (length seq)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1684 (elt seq (- len n))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1685
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1686 (defun artist-remove-nulls (l)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1687 "Remove nils in list L."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1688 (cond ((null l) nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1689 ((null (car l)) (artist-remove-nulls (cdr l)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1690 (t (cons (car l) (artist-remove-nulls (cdr l))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1691
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1692 (defun artist-uniq (l)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1693 "Remove consecutive duplicates in list L. Comparison is done with `equal'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1694 (cond ((null l) nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1695 ((null (cdr l)) l) ; only one element in list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1696 ((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
1697 (t (cons (car l) (artist-uniq (cdr l)))))) ; first 2 are different
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1698
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1699 (defmacro artist-push (x stack)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1700 "Push element X to a STACK."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1701 (list 'setq stack (list 'cons x stack)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1702
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1703 (defmacro artist-pop (stack)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1704 "Pop an element from a STACK."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1705 (list 'prog1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1706 (list 'car stack)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1707 (list 'setq stack (list 'cdr stack))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1708
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1709 (defun artist-string-split (str r)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1710 "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
1711 (let ((res nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1712 (start 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1713 (match-pos 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1714 (while (setq match-pos (string-match r str start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1715 (setq res (cons (copy-sequence (substring str start match-pos)) res))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1716 (setq start (match-end 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1717 (if (null res)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1718 (list str)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1719 (if (< (match-end 0) (- (length str) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1720 (setq res (cons (substring str (match-end 0) (length str)) res)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1721 (reverse res))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1722
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1723 (defun artist-string-to-file (str file-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1724 "Write string STR to file FILE-NAME."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1725 (write-region str 'end-is-ignored file-name nil 'no-message))
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-file-to-string (file-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1728 "Read from file FILE-NAME into a string."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1729 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1730 (let ((tmp-buffer (get-buffer-create (concat "*artist-" file-name "*"))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1731 (set-buffer tmp-buffer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1732 (goto-char (point-min))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1733 (insert-file-contents file-name nil nil nil t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1734 (let ((str (copy-sequence (buffer-substring (point-min)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1735 (point-max)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1736 (kill-buffer tmp-buffer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1737 str))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1738
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1739 (defun artist-clear-buffer (buf)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1740 "Clear contents of buffer BUF."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1741 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1742 (set-buffer buf)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1743 (goto-char (point-min))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1744 (delete-char (- (point-max) (point-min)) nil)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1745
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1746
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1747 (defun artist-system (program stdin &optional program-args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1748 "Run PROGRAM synchronously with the contents of string STDIN to stdin.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1749 Optional args PROGRAM-ARGS are arguments to PROGRAM.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1750 Return a list (RETURN-CODE STDOUT STDERR)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1751 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1752 (let* ((tmp-stdin-file-name (if stdin
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1753 (make-temp-name
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1754 (concat (file-name-as-directory
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1755 (or (getenv "TMPDIR") "/tmp"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1756 "artist-stdin."))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1757 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1758 (tmp-stdout-buffer (get-buffer-create
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1759 (concat "*artist-" program "*")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1760 (tmp-stderr-file-name (make-temp-name
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1761 (concat (file-name-as-directory
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1762 (or (getenv "TMPDIR") "/tmp"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1763 "artist-stdout.")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1764 (binary-process-input nil) ; for msdos
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1765 (binary-process-output nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1766
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1767 ;; Prepare stdin
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1768 (if stdin (artist-string-to-file stdin tmp-stdin-file-name))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1769
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1770 ;; Clear the buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1771 (artist-clear-buffer tmp-stdout-buffer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1772
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1773 ;; Start the program
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1774 (unwind-protect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1775 (let ((res (if program-args
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1776 (apply 'call-process
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1777 program
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1778 tmp-stdin-file-name
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1779 (list tmp-stdout-buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1780 tmp-stderr-file-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1781 nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1782 (if (stringp program-args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1783 (list program-args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1784 program-args))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1785 (apply 'call-process
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1786 program
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1787 tmp-stdin-file-name
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1788 (list tmp-stdout-buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1789 tmp-stderr-file-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1790 nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1791
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1792 ;; the return value
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1793 (list res
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1794 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1795 (set-buffer tmp-stdout-buffer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1796 (copy-sequence (buffer-substring (point-min)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1797 (point-max))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1798 (artist-file-to-string tmp-stderr-file-name)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1799
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1800 ;; Unwind: remove temporary files and buffers
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1801 (if (and stdin (file-exists-p tmp-stdin-file-name))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1802 (delete-file tmp-stdin-file-name))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1803 (if (file-exists-p tmp-stderr-file-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1804 (delete-file tmp-stderr-file-name))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1805 (if (memq tmp-stdout-buffer (buffer-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1806 (kill-buffer tmp-stdout-buffer))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1807
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1808 ;; Routines that deal with the buffer
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 ;; artist-current-line get line number (top of buffer is 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1811 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1812 ;; 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
1813 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1814 ;; artist-get-char-at-xy get char in at (x,y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1815 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1816 ;; artist-replace-char overwrite (replace) char at point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1817 ;; artist-replace-chars overwrite (replace) chars at point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1818 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1819
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1820 (defsubst artist-current-column ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1821 "Return point's current column."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1822 (current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1823
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1824 (defsubst artist-current-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1825 "Return point's current line, buffer-relative. Top of buffer is 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1826 (+ (count-lines 1 (point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1827 (if (= (current-column) 0) 1 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1828 -1))
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 (defsubst artist-move-to-xy (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1831 "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
1832 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1833 ;; Q: Why do we do forward-line twice?
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1834 ;; A: The documentation for forward-line says
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1835 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1836 ;; "... Returns the count of lines left to move. ... With
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1837 ;; positive N, a non-empty line at the end counts as one
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1838 ;; line successfully moved (for the return value)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1839 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1840 ;; 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
1841 ;; of the buffer, and that last line happened to be longer than
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1842 ;; 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
1843 ;; line, and forward-line returns one less than we actually
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1844 ;; wanted to move.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1845 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1846 ;; Example: In the figure below, the `X' is the very last
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1847 ;; character in the buffer ("a non-empty line at the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1848 ;; end"). Suppose point is at at P. Then (forward-line 1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1849 ;; returns 0 and puts point after the `X'.
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 ;; --------top of buffer--------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1852 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1853 ;; P X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1854 ;; -------bottom of buffer------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1855 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1856 ;; 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
1857 ;; forward, then forward-line will return the (for us) correct
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1858 ;; 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
1859 ;; buffer by the first forward-line. The second forward-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1860 ;; will then get us where we really wanted to go.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1861 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1862 ;; 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
1863 ;; second forward-line will return 0.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1864 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1865 ;; Q: What happens if we are moving upwards?
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1866 ;; A: That will work good. insert-char won't insert a negative
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1867 ;; number of chars, and forward-line will fail silently if we are
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1868 ;; moving past the beginning of the buffer.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1869 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1870 (forward-line (- y (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1871 (insert-char ?\n (forward-line (- y (artist-current-line))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1872 (move-to-column (max x 0) t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1873 (let ((curr-y (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1874 (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
1875 (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
1876
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1877 (defsubst artist-get-char-at-xy (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1878 "Return the character found at column X, row Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1879 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
1880 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1881 (let ((curr-y (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1882 (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
1883 (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
1884 (following-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1885
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1886
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1887 (defun artist-get-char-at-xy-conv (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1888 "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
1889 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1890 (aref artist-replacement-table (artist-get-char-at-xy x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1891
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1892
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1893 (defun artist-replace-char (new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1894 "Replace the character at point with NEW-CHAR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1895 ;; 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
1896 (if (and (and (boundp 'emacs-major-version) (= emacs-major-version 20))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1897 (and (boundp 'emacs-minor-version) (<= emacs-minor-version 3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1898 ;; 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
1899 ;; The self-insert-command doesn't care about the overwrite-mode,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1900 ;; 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
1901 ;; This seems to be a little bit slower.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1902 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1903 (artist-move-to-xy (1+ (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1904 (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1905 (delete-char -1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1906 (insert (aref artist-replacement-table new-char)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1907 ;; In emacs-19, the self-insert-command works better and faster
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1908 (let ((overwrite-mode 'overwrite-mode-textual)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1909 (fill-column 32765) ; Large :-)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1910 (blink-matching-paren nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1911 (setq last-command-event (aref artist-replacement-table new-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1912 (self-insert-command 1))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1913
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1914 (defun artist-replace-chars (new-char count)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1915 "Replace characters at point with NEW-CHAR. COUNT chars are replaced."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1916 ;; 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
1917 (if (and (and (boundp 'emacs-major-version) (= emacs-major-version 20))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1918 (and (boundp 'emacs-minor-version) (<= emacs-minor-version 3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1919 ;; 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
1920 ;; The self-insert-command doesn't care about the overwrite-mode,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1921 ;; 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
1922 ;; This seems to be a little bit slower.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1923 (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
1924 (replaced-s (make-string count replaced-c)))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1925 (artist-move-to-xy (+ (artist-current-column) count)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1926 (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1927 (delete-char (- count))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1928 (insert replaced-s))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1929 ;; In emacs-19, the self-insert-command works better
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1930 (let ((overwrite-mode 'overwrite-mode-textual)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1931 (fill-column 32765) ; Large :-)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1932 (blink-matching-paren nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1933 (setq last-command-event (aref artist-replacement-table new-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1934 (self-insert-command count))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1935
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1936 (defsubst artist-replace-string (string &optional see-thru)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1937 "Replace contents at point with STRING.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1938 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
1939 ``shines thru'' blanks in the STRING."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1940 (let ((char-list (append string nil)) ; convert the string to a list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1941 (overwrite-mode 'overwrite-mode-textual)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1942 (fill-column 32765) ; Large :-)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1943 (blink-matching-paren nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1944 (while char-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1945 (let ((c (car char-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1946 (if (and see-thru (= (aref artist-replacement-table c) ?\ ))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1947 (artist-move-to-xy (1+ (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1948 (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1949 (artist-replace-char c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1950 (setq char-list (cdr char-list)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1951
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1952 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1953 ;; Routines for setting and unsetting points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1954 ;; Used when not rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1955 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1956 (defun artist-no-rb-unset-point1 ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1957 "Unsets point 1 when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1958 (let ((x-now (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1959 (y-now (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1960 (x (aref artist-rb-save-data 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1961 (y (aref artist-rb-save-data 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1962 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1963 (artist-replace-char (aref artist-rb-save-data 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1964 (artist-move-to-xy x-now y-now)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1965
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1966 (defun artist-no-rb-set-point1 (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1967 "Set point 1 at X, Y when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1968 (let ((x-now (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1969 (y-now (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1970 (aset artist-rb-save-data 0 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1971 (aset artist-rb-save-data 1 y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1972 (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
1973 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1974 (artist-replace-char artist-first-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1975 (artist-move-to-xy x-now y-now)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1976 (aset artist-rb-save-data 6 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1977
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1978 (defun artist-no-rb-unset-point2 ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1979 "This function unsets point 2 when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1980 (if (= (aref artist-rb-save-data 6) 1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1981 (let ((x-now (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1982 (y-now (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1983 (x (aref artist-rb-save-data 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1984 (y (aref artist-rb-save-data 4)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1985 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1986 (artist-replace-char (aref artist-rb-save-data 5))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1987 (artist-move-to-xy x-now y-now))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1988
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1989 (defun artist-no-rb-set-point2 (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1990 "Set point 2 at X, Y when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1991 (let ((x-now (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1992 (y-now (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1993 (aset artist-rb-save-data 3 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1994 (aset artist-rb-save-data 4 y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1995 (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
1996 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1997 (artist-replace-char artist-second-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1998 (artist-move-to-xy x-now y-now)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1999 (aset artist-rb-save-data 6 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2000
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2001 (defun artist-no-rb-unset-points ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2002 "This function unsets point 1 and 2 when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2003 (artist-no-rb-unset-point1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2004 (artist-no-rb-unset-point2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2005
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 ;; artist-intersection-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2008 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2009 ;; Note: If changing this, see the notes for artist-unintersection-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2010 ;; and artist-vaporize-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2011 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2012 (defun artist-intersection-char (new-c old-c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2013 "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
2014 Return character according to this scheme:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2015
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2016 OLD-C NEW-C return
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2017 - | +
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 + | +
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2020 + - +
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2021 \\ / X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2022 / \\ X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2023 X / X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2024 X \\ X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2025 other combinations NEW-C"
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 (cond ((and (= old-c ?- ) (= new-c ?| )) ?+ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2028 ((and (= old-c ?| ) (= new-c ?- )) ?+ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2029 ((and (= old-c ?+ ) (= new-c ?- )) ?+ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2030 ((and (= old-c ?+ ) (= new-c ?| )) ?+ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2031 ((and (= old-c ?\\ ) (= new-c ?/ )) ?X )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2032 ((and (= old-c ?/ ) (= new-c ?\\ )) ?X )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2033 ((and (= old-c ?X ) (= new-c ?/ )) ?X )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2034 ((and (= old-c ?X ) (= new-c ?\\ )) ?X )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2035 (t new-c)))
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 ;; artist-unintersection-char
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 ;; Note: If changing this, see the note for artist-vaporize-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2040 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2041 (defun artist-unintersection-char (line-c buffer-c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2042 "Restore character to before intersection when removing LINE-C from BUFFER-C.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2043 Return character according to this scheme:
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 LINE-C BUFFER-C return
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2046 - + |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2047 | + -
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2048 \\ X /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2049 / X \\
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2050 other combinations `artist-erase-char'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2051
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2052 (cond ((and (= line-c ?- ) (= buffer-c ?+ )) ?| )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2053 ((and (= line-c ?| ) (= buffer-c ?+ )) ?- )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2054 ((and (= line-c ?\\ ) (= buffer-c ?X )) ?/ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2055 ((and (= line-c ?/ ) (= buffer-c ?X )) ?\\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2056 ((= line-c buffer-c) artist-erase-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2057 (t buffer-c)))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2060 ;; Computing the line-char to use
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2061 ;; for use with borderless shapes
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 (defsubst artist-compute-line-char ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2064 "Compute which character to use for lines, if any.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2065 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
2066 a character chosen depending on the variables `artist-borderless-shapes',
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2067 `artist-fill-char-set', `artist-fill-char' and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2068 `artist-line-char-set' and `artist-line-char'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2069 (if (and artist-borderless-shapes artist-fill-char-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2070 artist-fill-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2071 (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2072 artist-line-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2073 nil)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2074
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2075
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2076 ;; Things for drawing horizontal, vertical and diagonal (straight) lines.
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 ;; A line here is a vector:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2079 ;; [ start-x start-y length direction saved-char-1 saved-char-2 ... ]
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2080 ;; directions start with 0 at the x-axis and counts anti clockwise.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2081 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2082 (defvar artist-direction-info
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2083 ;; x y char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2084 [ [ 1 0 ?- ] ; direction 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2085 [ 1 1 ?\\ ] ; direction 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2086 [ 0 1 ?| ] ; direction 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2087 [ -1 1 ?/ ] ; direction 3
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2088 [ -1 0 ?- ] ; direction 4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2089 [ -1 -1 ?\\ ] ; direction 5
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2090 [ 0 -1 ?| ] ; direction 6
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2091 [ 1 -1 ?/ ] ] ; direction 7
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2092 "Table used for stepping x and y coordinates in a specific direction.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2093 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
2094
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2095 (defsubst artist-direction-step-x (direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2096 "Return the x-step for DIRECTION from the `artist-direction-info' table."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2097 (aref (aref artist-direction-info direction) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2098
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2099 (defsubst artist-direction-step-y (direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2100 "Return the y-step for DIRECTION from the `artist-direction-info' table."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2101 (aref (aref artist-direction-info direction) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2102
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2103 (defun artist-direction-char (direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2104 "Return the character for DIRECTION from the `artist-direction-info' table."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2105 (aref (aref artist-direction-info direction) 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2106
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2107 ;; artist-find-direction
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2108 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2109 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2110 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2111 (defun artist-find-direction (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2112 "Find the direction from point X1,Y1 to X2,Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2113 Returns a DIRECTION, a number 0--7, coded as follows:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2114
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2115 5 6 7
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 4 - * - 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2118 / | \\
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2119 3 2 1"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2120 (let ((delta-x (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2121 (delta-y (- y2 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2122 (cond ((>= delta-x (* 2 (abs delta-y))) 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2123 ((>= delta-y (* 2 (abs delta-x))) 2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2124 ((>= (- delta-x) (* 2 (abs delta-y))) 4)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2125 ((>= (- delta-y) (* 2 (abs delta-x))) 6)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2126 ((and (>= delta-x 0) (>= delta-y 0)) 1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2127 ((and (<= delta-x 0) (>= delta-y 0)) 3)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2128 ((and (<= delta-x 0) (<= delta-y 0)) 5)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2129 ((and (>= delta-x 0) (<= delta-y 0)) 7))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2130
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2131 (defun artist-straight-calculate-length (direction x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2132 "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
2133 (cond ((or (= direction 7)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2134 (= direction 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2135 (= direction 1)) (1+ (- x2 x1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2136 ((or (= direction 3)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2137 (= direction 4)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2138 (= direction 5)) (1+ (- x1 x2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2139 (t (1+ (abs (- y2 y1))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2140
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2141 (defun artist-sline (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2142 "Create a straight line from X1,Y1 to X2,Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2143 (let* ((direction (artist-find-direction x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2144 (length (artist-straight-calculate-length direction x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2145 (line (make-vector (+ length 4) x1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2146 ;; not needed:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2147 ;; (aset line 0 x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2148 ;; because we set all elements to x1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2149 (aset line 1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2150 (aset line 2 length)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2151 (aset line 3 direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2152 line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2153
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2154 (defun artist-save-chars-under-sline (line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2155 "Save characters under a LINE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2156 (let ((x (aref line 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2157 (y (aref line 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2158 (length (+ (aref line 2) 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2159 (direction (aref line 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2160 (i 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2161 (while (< i length)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2162 (aset line i (artist-get-char-at-xy x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2163 (setq x (+ x (artist-direction-step-x direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2164 (setq y (+ y (artist-direction-step-y direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2165 (setq i (1+ i))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2166 line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2167
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2168
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2169
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2170 ;; Things for drawing lines in all directions.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2171 ;; The line drawing engine is the eight-point alrogithm.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2172 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2173 ;; 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
2174 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2175 (defvar artist-octant-info
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2176 ;; Initial Step in Step in
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2177 ;; coeffs x and y x and y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2178 ;; for if q >= 0 if g < 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2179 ;; dfdx,dfdy
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2180 [ [ 2 1 1 0 1 1 ] ; 1st octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2181 [ 1 2 1 1 0 1 ] ; 2nd octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2182 [ -1 2 0 1 -1 1 ] ; 3rd octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2183 [ -2 1 -1 1 -1 0 ] ; 4th octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2184 [ -2 -1 -1 0 -1 -1 ] ; 5th octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2185 [ -1 -2 -1 -1 0 -1 ] ; 6th octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2186 [ 1 -2 0 -1 1 -1 ] ; 7th octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2187 [ 2 -1 1 -1 1 0 ] ] ; 8th octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2188 "Table used by line drawing algorithm (eight point).")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2189
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2190 ;; Primitives for the artist-octant-info.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2191 ;; 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
2192 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2193 (defsubst artist-get-dfdx-init-coeff (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2194 "Retrieve dfdx component for OCTANT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2195 (aref (aref artist-octant-info (- octant 1)) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2196
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2197 (defsubst artist-get-dfdy-init-coeff (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2198 "Retrieve dfdy component for OCTANT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2199 (aref (aref artist-octant-info (- octant 1)) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2200
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2201 (defsubst artist-get-x-step-q>=0 (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2202 "Retrieve x-step component for OCTANT when q >= 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2203 (aref (aref artist-octant-info (- octant 1)) 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2204
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2205 (defsubst artist-get-y-step-q>=0 (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2206 "Retrieve y-step component for OCTANT when q >= 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2207 (aref (aref artist-octant-info (- octant 1)) 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2208
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2209 (defsubst artist-get-x-step-q<0 (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2210 "Retrieve x-step component for OCTANT for q < 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2211 (aref (aref artist-octant-info (- octant 1)) 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2212
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2213 (defsubst artist-get-y-step-q<0 (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2214 "Retrieve y-step component for OCTANT for q < 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2215 (aref (aref artist-octant-info (- octant 1)) 5))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2216
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2217
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2218 ;; Find octant from x1 y1 x2 y2 coordinates.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2219 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2220 (defun artist-find-octant (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2221 "Find octant for a line from X1,Y1 to X2,Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2222 Octant are numbered 1--8, anti-clockwise as:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2223
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2224 \\3|2/
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2225 4\\|/1
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 5/|\\8
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2228 /6|7\\"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2229
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2230 (if (<= x1 x2) ; quadrant 1 or 4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2231 (if (<= y1 y2) ; quadrant 1, octant 1 or 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2232 (if (>= (- x2 x1) (- y2 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2233 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2234 2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2235 (if (>= (- x2 x1) (- (- y2 y1))) ; quadrant 4, octant 7 or 8
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2236 8
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2237 7))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2238 (if (<= y1 y2) ; quadrant 2 or 3
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2239 (if (>= (- (- x2 x1)) (- y2 y1)) ; quadrant 2, octant 3 or 4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2240 4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2241 3)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2242 (if (>= (- (- x2 x1)) (- (- y2 y1))) ; quadrant 3, octant 5 or 6
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2243 5
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2244 6))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2245
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2246 ;; Some inline funtions for creating, setting and reading
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2247 ;; members of a coordinate
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2248 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2249 (defsubst artist-new-coord (x y &optional new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2250 "Create a new coordinate at X,Y for use in a line.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2251 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
2252 in the coord."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2253 (let ((coord (make-vector 4 x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2254 (aset coord 1 y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2255 (aset coord 3 new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2256 coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2257
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2258 (defsubst artist-coord-get-x (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2259 "Retrieve the x component of a COORD."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2260 (aref coord 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2261
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2262 (defsubst artist-coord-get-y (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2263 "Retrieve the y component of a COORD."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2264 (aref coord 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2265
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2266 (defsubst artist-coord-set-x (coord new-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2267 "Set the x component of a COORD to NEW-X."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2268 (aset coord 0 new-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2269 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2270
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2271 (defsubst artist-coord-set-y (coord new-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2272 "Set the y component of a COORD to NEW-Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2273 (aset coord 1 new-y)
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-saved-char (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2277 "Retrieve the saved char component of a COORD."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2278 (aref coord 2))
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-new-char (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2281 "Retrieve the new char component of a COORD."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2282 (aref coord 3))
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-add-saved-char (coord saved-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2285 "Set the saved char component of a COORD to SAVED-CHAR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2286 (aset coord 2 saved-char)
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-add-new-char (coord new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2290 "Set the new char component of a COORD to NEW-CHAR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2291 (aset coord 3 new-char)
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-set-new-char (coord new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2295 "Set the new char component of a COORD to NEW-CHAR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2296 (aset coord 3 new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2297 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2298
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2299
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2300 ;; Pretend we are plotting a pixel. Instead we just list it
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 (defmacro artist-put-pixel (point-list x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2303 "In POINT-LIST, store a ``pixel'' at coord X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2304 (list 'setq point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2305 (list 'append point-list (list 'list (list 'artist-new-coord x y)))))
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 ;; Calculate list of points using eight point algorithm
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2308 ;; return a list of coords
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2309 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2310 (defun artist-eight-point (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2311 "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
2312 (let* ((point-list nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2313 (octant (artist-find-octant x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2314 (dfdx-coeff (artist-get-dfdx-init-coeff octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2315 (dfdy-coeff (artist-get-dfdy-init-coeff octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2316 (x-step-q>=0 (artist-get-x-step-q>=0 octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2317 (y-step-q>=0 (artist-get-y-step-q>=0 octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2318 (x-step-q<0 (artist-get-x-step-q<0 octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2319 (y-step-q<0 (artist-get-y-step-q<0 octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2320 (dfdx (- (- y2 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2321 (dfdy (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2322 (x x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2323 (y y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2324 (f 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2325 (q (+ (* 2 f)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2326 (* dfdx-coeff dfdx)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2327 (* dfdy-coeff dfdy))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2328 (artist-put-pixel point-list x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2329 (while (or (not (eq x x2)) (not (eq y y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2330 (if (>= q 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2331 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2332 (setq x (+ x x-step-q>=0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2333 (setq y (+ y y-step-q>=0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2334 (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
2335 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2336 (setq x (+ x x-step-q<0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2337 (setq y (+ y y-step-q<0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2338 (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
2339 (setq q (+ (* 2 f) (* dfdx-coeff dfdx) (* dfdy-coeff dfdy)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2340 (artist-put-pixel point-list x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2341 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2342
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2343 ;; artist-save-chars-under-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2344 ;; Remebers the chars that were there before we did draw the line.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2345 ;; Returns point-list.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2346 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2347 (defun artist-save-chars-under-point-list (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2348 "Save characters originally under POINT-LIST."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2349 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2350 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2351 (artist-coord-add-saved-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2352 coord
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2353 (artist-get-char-at-xy (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2354 (artist-coord-get-y coord))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2355 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2356
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2357 ;; artist-calculate-new-char, artist-calculate-new-chars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2358 ;; Calculates which char to insert depending on direction of point-list.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2359 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2360 ;; 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
2361 ;; following chars are returned: \ | / - o, as indicated by this:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2362 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2363 ;; \ | /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2364 ;; - o -
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2365 ;; / | \
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2366 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2367 ;; artist-calculate-new-char works on one coordinate, returns char.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2368 ;; artist-calculate-new-chars works on a point-list, returns point-list.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2369 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2370 (defun artist-calculate-new-char (last-coord new-coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2371 "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
2372 (let ((last-x (artist-coord-get-x last-coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2373 (last-y (artist-coord-get-y last-coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2374 (new-x (artist-coord-get-x new-coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2375 (new-y (artist-coord-get-y new-coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2376 (cond ((> new-x last-x) (cond ((< new-y last-y) ?/ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2377 ((> new-y last-y) ?\\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2378 (t ?- )))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2379 ((< new-x last-x) (cond ((< new-y last-y) ?\\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2380 ((> new-y last-y) ?/ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2381 (t ?- )))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2382 ((eq new-y last-y) ?o)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2383 (t ?| ))))
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 (defun artist-calculate-new-chars (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2386 "Return a list of coords with line-chars calculated. Input: POINT-LIST."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2387 (if (null (cdr point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2388 (list (artist-coord-add-new-char (car point-list) ?o ))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2389 (let ((last-coord (car point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2390 (cons (artist-coord-add-new-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2391 (car point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2392 (artist-calculate-new-char (car (cdr point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2393 (car point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2394 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2395 (lambda (this-coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2396 (prog1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2397 (artist-coord-add-new-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2398 this-coord
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2399 (artist-calculate-new-char last-coord this-coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2400 (setq last-coord this-coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2401 (cdr point-list))))))
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 ;; artist-modify-new-chars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2404 ;; Replaces some characters with some other characters.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2405 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2406 ;; artist-modify-new-chars works on a point-list, returns point-list.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2407 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2408 (defun artist-modify-new-chars (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2409 "Replace intersecting characters in POINT-LIST.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2410 This function returns a point-list."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2411 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2412 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2413 (let* ((new-c (artist-coord-get-new-char coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2414 (saved-c (artist-coord-get-saved-char coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2415 (modified-c (artist-intersection-char new-c saved-c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2416 (artist-coord-set-new-char coord modified-c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2417 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2418
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2419
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 ;; functions for accessing endoints and elements in object requiring
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2422 ;; 2 endpoints
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2425 (defun artist-make-endpoint (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2426 "Create an endpoint at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2427 (let ((new-endpoint (make-vector 2 x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2428 (aset new-endpoint 1 y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2429 new-endpoint))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2430
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2431 (defun artist-endpoint-get-x (endpoint)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2432 "Retrieve the x component of an ENDPOINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2433 (aref endpoint 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2434
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2435 (defun artist-endpoint-get-y (endpoint)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2436 "Retrieve the y component of an ENDPOINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2437 (aref endpoint 1))
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 (defun artist-make-2point-object (endpoint1 endpoint2 shapeinfo)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2440 "Create a 2-point object of ENDPOINT1, ENDPOINT2 and SHAPEINFO."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2441 (list endpoint1 endpoint2 shapeinfo))
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-2point-get-endpoint1 (obj)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2444 "Retrieve the first endpoint of a 2-point object OBJ."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2445 (elt obj 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2446
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2447 (defun artist-2point-get-endpoint2 (obj)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2448 "Retrieve the second endpoint of a 2-point object OBJ."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2449 (elt obj 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2450
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2451 (defun artist-2point-get-shapeinfo (obj)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2452 "Retrieve the shapeinfo component of a 2-point object OBJ."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2453 (elt obj 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2454
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2455
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 ;; Drawing and undrawing lines (any direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2458 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2459
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2460 (defun artist-draw-line (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2461 "Draws a line from X1, Y1 to X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2462
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2463 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
2464
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2465 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
2466 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
2467 (let ((endpoint1 (artist-make-endpoint x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2468 (endpoint2 (artist-make-endpoint x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2469 (artist-make-2point-object
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2470 endpoint1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2471 endpoint2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2472 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2473 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2474 (artist-move-to-xy (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2475 (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2476 (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2477 (artist-replace-char artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2478 (artist-replace-char (artist-coord-get-new-char coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2479 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2480 (artist-modify-new-chars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2481 (artist-calculate-new-chars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2482 (artist-save-chars-under-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2483 (artist-eight-point x1 y1 x2 y2))))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2484
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2485 (defun artist-undraw-line (line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2486 "Undraws LINE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2487 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2488 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2489 (artist-move-to-xy (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2490 (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2491 (artist-replace-char (artist-coord-get-saved-char coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2492 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2493 (artist-2point-get-shapeinfo line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2494
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2495 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2496 ;; Drawing and undrawing straight lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2497 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2498
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2499 (defun artist-draw-sline (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2500 "Draw a strait line from X1, Y1 to X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2501 Straight lines are vertical, horizontal or diagonal lines.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2502 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
2503 when drawing a simple image.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2504
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2505 Output is a straight line, which is a list on the form
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2506 (END-POINT-1 END-POINT-2 SHAPE-INFO).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2507
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2508 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
2509 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
2510 ORIGINAL-CHAR-1 ORIGINAL-CHAR-2 ... ]."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2511 (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
2512 (x (aref line 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2513 (y (aref line 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2514 (length (+ (aref line 2) 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2515 (direction (aref line 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2516 (line-char (artist-direction-char direction))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2517 (i 4)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2518 (endpoint1 (artist-make-endpoint x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2519 (endpoint2 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2520 (while (< i length)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2521 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2522 (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2523 (artist-replace-char artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2524 (artist-replace-char (artist-intersection-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2525 line-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2526 (aref line i))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2527 (if (not (< (1+ i) length))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2528 ;; This is the last element. Set the second endpoint
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2529 (setq endpoint2 (artist-make-endpoint x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2530 (setq x (+ x (artist-direction-step-x direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2531 (setq y (+ y (artist-direction-step-y direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2532 (setq i (1+ i)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2533 (artist-make-2point-object endpoint1 endpoint2 line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2534
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2535
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2536 (defun artist-undraw-sline (line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2537 "Undraw a straight line LINE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2538 (if line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2539 (let* ((shape-info (artist-2point-get-shapeinfo line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2540 (x (aref shape-info 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2541 (y (aref shape-info 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2542 (length (+ (aref shape-info 2) 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2543 (direction (aref shape-info 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2544 (i 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2545 (while (< i length)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2546 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2547 (artist-replace-char (aref shape-info i))
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
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 ;; Drawing and undrawing rectangles and squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2555 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2556
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2557 (defun artist-draw-rect (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2558 "Draws a rectangle with corners at X1, Y1 and X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2559
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2560 Output is a rectangle, which is a list on the form
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2561 (END-POINT-1 END-POINT-2 SHAPE-INFO).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2562
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2563 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
2564 SHAPE-INFO is a list of four straight lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2565 (let* ((artist-line-char (artist-compute-line-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2566 (artist-line-char-set artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2567 (line1 (artist-draw-sline x1 y1 x2 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2568 (line2 (artist-draw-sline x2 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2569 (line3 (artist-draw-sline x2 y2 x1 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2570 (line4 (artist-draw-sline x1 y2 x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2571 (endpoint1 (artist-make-endpoint x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2572 (endpoint2 (artist-make-endpoint x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2573 (artist-make-2point-object endpoint1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2574 endpoint2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2575 (list line1 line2 line3 line4))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2576
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2577 (defun artist-undraw-rect (rectangle)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2578 "Undraws RECTANGLE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2579 (if rectangle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2580 (let ((shape-info (artist-2point-get-shapeinfo rectangle)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2581 (artist-undraw-sline (elt shape-info 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2582 (artist-undraw-sline (elt shape-info 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2583 (artist-undraw-sline (elt shape-info 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2584 (artist-undraw-sline (elt shape-info 0)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2585
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2586
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2587 (defun artist-rect-corners-squarify (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2588 "Compute square corners from rectangle corners at X1, Y1 and X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2589 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
2590 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
2591 (let* ((delta-x (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2592 (delta-y (- y2 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2593 (delta-x-sign (if (< delta-x 0) -1 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2594 (delta-y-sign (if (< delta-y 0) -1 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2595 (new-x2) ; set below
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2596 (new-y2)) ; set below
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2597
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2598 ;; Check which of x2 and y2 is most distant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2599 ;; take care to the aspect ratio
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2600 (if (> (abs delta-x) (abs delta-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2601
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2602 ;; *** x2 more distant than y2 (with care taken to aspect ratio)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2603 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2604 (setq new-x2 x2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2605 (setq new-y2 (+ y1 (round (/ (* (abs delta-x) delta-y-sign)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2606 artist-aspect-ratio)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2607
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2608 ;; *** y2 more distant than x2 (with care taken to aspect ratio)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2609 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2610 (setq new-x2 (round (+ x1 (* (* (abs delta-y) delta-x-sign)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2611 artist-aspect-ratio))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2612 (setq new-y2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2613
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2614 ;; Return this
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2615 (list x1 y1 new-x2 new-y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2616
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2617
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2618 (defun artist-draw-square (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2619 "Draw a square with corners at X1, Y1 and X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2620
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2621 Output is a square, which is a list on the form
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2622 (END-POINT-1 END-POINT-2 SHAPE-INFO).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2623
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2624 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
2625 SHAPE-INFO is a list of four straight lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2626 (let* ((artist-line-char (artist-compute-line-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2627 (artist-line-char-set artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2628 (square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2629 (new-x1 (elt square-corners 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2630 (new-y1 (elt square-corners 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2631 (new-x2 (elt square-corners 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2632 (new-y2 (elt square-corners 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2633 (endpoint1 (artist-make-endpoint new-x1 new-y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2634 (endpoint2 (artist-make-endpoint new-x2 new-y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2635 (line1 (artist-draw-sline new-x1 new-y1 new-x2 new-y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2636 (line2 (artist-draw-sline new-x2 new-y1 new-x2 new-y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2637 (line3 (artist-draw-sline new-x2 new-y2 new-x1 new-y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2638 (line4 (artist-draw-sline new-x1 new-y2 new-x1 new-y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2639 (artist-make-2point-object endpoint1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2640 endpoint2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2641 (list line1 line2 line3 line4))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2642
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2643 (defun artist-undraw-square (square)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2644 "Undraws SQUARE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2645 (if square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2646 (let ((shape-info (artist-2point-get-shapeinfo square)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2647 (artist-undraw-sline (elt shape-info 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2648 (artist-undraw-sline (elt shape-info 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2649 (artist-undraw-sline (elt shape-info 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2650 (artist-undraw-sline (elt shape-info 0)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2651
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2652 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2653 ;; Filling rectangles and squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2654 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2655
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2656 (defun artist-fill-rect (rect x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2657 "Fill rectangle RECT from X1,Y1 to X2,Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2658 (let ((x (1+ (min x1 x2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2659 (y (1+ (min y1 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2660 (x-max (max x1 x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2661 (y-max (max y1 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2662 (let ((w (- x-max x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2663 (while (< y y-max)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2664 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2665 (artist-replace-chars artist-fill-char w)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2666 (setq y (1+ y))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2667
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2668 (defun artist-fill-square (square x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2669 "Fills a SQUARE from X1,Y1 to X2,Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2670 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2671 (new-x1 (elt square-corners 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2672 (new-y1 (elt square-corners 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2673 (new-x2 (elt square-corners 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2674 (new-y2 (elt square-corners 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2675 (x (1+ (min new-x1 new-x2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2676 (y (1+ (min new-y1 new-y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2677 (x-max (max new-x1 new-x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2678 (y-max (max new-y1 new-y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2679 (w (- x-max x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2680 (while (< y y-max)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2681 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2682 (artist-replace-chars artist-fill-char w)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2683 (setq y (1+ y)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2684
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 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2687 ;; Pen drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2688 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2689
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2690 (defun artist-pen (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2691 "Draws a character at X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2692 The character is replaced with the character in `artist-fill-char'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2693 (artist-move-to-xy x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2694 (artist-replace-char (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2695 artist-line-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2696 (if artist-fill-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2697 artist-fill-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2698 artist-default-fill-char))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2699
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2700
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2701 (defun artist-pen-line (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2702 "Draws a line from last pen position to X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2703 The character is replaced with the character in `artist-fill-char'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2704 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
2705 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
2706 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
2707 (let ((artist-line-char (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2708 artist-line-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2709 (if artist-fill-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2710 artist-fill-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2711 artist-default-fill-char))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2712
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2713 ;; Draw line from last point to this
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2714 (let ((x-last (car (car artist-key-poly-point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2715 (y-last (cdr (car artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2716 (artist-move-to-xy x-last y-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2717 (artist-replace-char artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2718 (artist-draw-line x-last y-last x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2719
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2720 ;; Update the point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2721 (setq artist-key-poly-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2722 (cons (cons x1 y1) artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2723
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2724 (defun artist-pen-reset-last-xy (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2725 "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
2726 (artist-clear-arrow-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2727 (setq artist-key-poly-point-list (list (cons x1 y1))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2728
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2729
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2730 (defun artist-pen-set-arrow-points (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2731 "Set arrow points for pen drawing using X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2732 Also, the `artist-key-poly-point-list' is reversed."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2733
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2734 (setq artist-key-poly-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2735 (artist-uniq artist-key-poly-point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2736
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2737 (if (>= (length artist-key-poly-point-list) 2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2738
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2739 ;; 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
2740 (let ((xn (car (car artist-key-poly-point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2741 (yn (cdr (car artist-key-poly-point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2742 (xn-1 (car (car (cdr artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2743 (yn-1 (cdr (car (cdr artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2744 (dirn)) ; direction for point n
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2745 (setq artist-key-poly-point-list (reverse artist-key-poly-point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2746 (let ((x0 (car (car artist-key-poly-point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2747 (y0 (cdr (car artist-key-poly-point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2748 (x1 (car (car (cdr artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2749 (y1 (cdr (car (cdr artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2750 (dir0)) ; direction for point 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2751 (setq dir0 (artist-find-direction x1 y1 x0 y0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2752 (setq dirn (artist-find-direction xn-1 yn-1 xn yn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2753 (setq artist-arrow-point-1 (artist-make-arrow-point x0 y0 dir0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2754 (setq artist-arrow-point-2 (artist-make-arrow-point xn yn dirn))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2755
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 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2758 ;; Text rendering
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2759 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2760 (defun artist-figlet-run (text font extra-args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2761 "Run figlet rendering TEXT using FONT.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2762 EXTRA-ARGS for figlet, for the command line, may be specified."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2763 (let* ((figlet-args (cond ((and font extra-args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2764 (cons (concat "-f" font)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2765 (artist-string-split extra-args "[ \t]+")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2766 (font (concat "-f" font))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2767 (extra-args
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2768 (artist-string-split extra-args "[ \t]+"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2769 (t nil)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2770 (figlet-output (artist-system artist-figlet-program text figlet-args))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2771 (exit-code (elt figlet-output 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2772 (stdout (elt figlet-output 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2773 (stderr (elt figlet-output 2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2774 (if (not (= exit-code 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2775 (error "Failed to render font: %s (%d)" stderr exit-code))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2776 stdout))
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-get-font-list ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2779 "Read fonts in with the shell command.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2780 Returns a list of strings."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2781 (let* ((cmd-interpreter "/bin/sh")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2782 (ls-cmd artist-figlet-list-fonts-command)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2783 (result (artist-system cmd-interpreter ls-cmd nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2784 (exit-code (elt result 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2785 (stdout (elt result 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2786 (stderr (elt result 2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2787 (if (not (= exit-code 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2788 (error "Failed to read available fonts: %s (%d)" stderr exit-code))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2789 (artist-string-split stdout ".flf\n")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2790
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2791 (defun artist-figlet-choose-font ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2792 "Read any extra arguments for figlet."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2793 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2794 (let* ((avail-fonts (artist-figlet-get-font-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2795 (font (completing-read (concat "Select font: (default "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2796 artist-figlet-default-font
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2797 ") ")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2798 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2799 (lambda (font) (cons font font))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2800 avail-fonts))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2801 (if (string= font "") artist-figlet-default-font font)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2802
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2803 (defun artist-figlet-get-extra-args ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2804 "Read any extra arguments for figlet."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2805 (let ((extra-args (read-input "Extra args to figlet: ")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2806 (if (string= extra-args "")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2807 nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2808 extra-args)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2809
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2810 (defun artist-figlet (text)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2811 "Render TEXT using figlet."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2812 (let* ((figlet-font (artist-figlet-choose-font))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2813 (figlet-extra-args (artist-figlet-get-extra-args)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2814 (artist-figlet-run text figlet-font figlet-extra-args)))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2817 (defun artist-text-insert-common (x y text see-thru)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2818 "At position X, Y, insert text TEXT.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2819 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
2820 in the buffer."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2821 (let* ((string-list (artist-string-split text "\n"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2822 (i 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2823 (len (length string-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2824 (while (< i len)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2825 (artist-move-to-xy x (+ y i))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2826 (artist-replace-string (car string-list) see-thru)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2827 (setq string-list (cdr string-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2828 (setq i (1+ i)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2829
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2830 (defun artist-text-insert-see-thru (x y text)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2831 "At position X, Y, insert text TEXT.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2832 Let text already in buffer shine thru the TEXT inserted."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2833 (artist-text-insert-common x y text t))
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-overwrite (x y text)
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 Let blanks in TEXT overwrite any text already in the buffer."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2838 (artist-text-insert-common x y text nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2839
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2840 (defun artist-text-see-thru (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2841 "Prompt for text to render, render it at X,Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2842 This is done by calling the function specified by `artist-text-renderer',
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2843 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
2844
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2845 Text already in the buffer ``shines thru'' blanks in the rendered text."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2846 (let* ((input-text (read-input "Type text to render: "))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2847 (rendered-text (artist-funcall artist-text-renderer input-text)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2848 (artist-text-insert-see-thru x y rendered-text)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2849
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2850
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2851 (defun artist-text-overwrite (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2852 "Prompt for text to render, render it at X,Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2853 This is done by calling the function specified by `artist-text-renderer',
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2854 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
2855
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2856 Blanks in the rendered text overwrites any text in the buffer."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2857 (let* ((input-text (read-input "Type text to render: "))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2858 (rendered-text (artist-funcall artist-text-renderer input-text)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2859 (artist-text-insert-overwrite x y rendered-text)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2860
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2861 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2862 ;; Spraying
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2863 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2864
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2865 (defun artist-spray-get-interval ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2866 "Retrieves the interval for repeated spray."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2867 artist-spray-interval)
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-spray-random-points (n radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2870 "Generate N random points within a radius of RADIUS.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2871 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
2872 (let ((points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2873 (while (> n 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2874 (let* ((angle (* (random 359) (/ pi 180)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2875 (dist (random radius))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2876 (point (cons (round (* dist (cos angle)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2877 (round (* dist (sin angle))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2878 (setq points (cons point points)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2879 (setq n (- n 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2880 points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2881
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2882 (defun artist-spray (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2883 "Spray at X1, Y1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2884 (let* ((num-points (* artist-spray-radius artist-spray-radius))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2885 (spray-points (artist-spray-random-points num-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2886 artist-spray-radius)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2887 (while spray-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2888 ;; Replace one spray point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2889 (let* ((point (car spray-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2890 (x (+ x1 (car point)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2891 (y (+ y1 (cdr point)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2892 (buf-c (artist-get-char-at-xy-conv x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2893 (this-c (memq buf-c artist-spray-chars))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2894 (next-c (cond ((null this-c) artist-spray-new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2895 ((null (cdr this-c)) (car this-c))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2896 (t (car (cdr this-c))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2897 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2898 (artist-replace-char next-c))
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 ;; Step to next spray point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2901 (setq spray-points (cdr spray-points)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2902
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2903 (defun artist-spray-clear-circle (circle x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2904 "Clears circle CIRCLE at X1, Y1 through X2, Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2905 (artist-undraw-circle circle))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2906
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2907 (defun artist-spray-set-radius (circle x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2908 "Set spray radius from CIRCLE at X1, Y1 through X2, Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2909 (let ((dx (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2910 (dy (- y2 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2911 (setq artist-spray-radius (round (sqrt (+ (* dx dx) (* dy dy)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2912 (if (= 0 artist-spray-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2913 (setq artist-spray-radius 1))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2914
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2915 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2916 ;; Erasing
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2919 (defun artist-erase-char (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2920 "Erases a character at X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2921 The character is replaced with the character in `artist-erase-char'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2922 (artist-move-to-xy x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2923 (artist-replace-char artist-erase-char))
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-erase-rect (rect x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2926 "Erase rectangle RECT from X1, Y1, X2, Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2927 (let ((artist-line-char-set t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2928 (artist-fill-char-set t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2929 (artist-line-char artist-erase-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2930 (artist-fill-char artist-erase-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2931 (artist-draw-rect x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2932 (artist-fill-rect rect x1 y1 x2 y2)))
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
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 ;; Vaporizing (erasing) line and lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2937 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2938
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2939
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2940 (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
2941 "Find one endpoint for line through X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2942 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
2943 accepting characters in the list ACCEPT-SET, stopping immediately
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2944 when finding characters in the list REJECT-SET. Fuzziness, that is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2945 the number of consecutive characters not in ACCEPT-SET to allow as
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2946 part of the line, is determined by the variable `artist-vaporize-fuzziness'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2947 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2948 (let ((x x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2949 (y y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2950 (x-last x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2951 (y-last y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2952 (done nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2953 (while (not done)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2954 (let ((c (artist-get-char-at-xy-conv x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2955 (cond ((memq c reject-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2956 (setq done t))
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 ;; We found a character we are accepting as part of the line.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2959 ;; Update position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2960 ((memq c accept-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2961 (setq x-last x
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2962 y-last y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2963 x (+ x step-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2964 y (+ y step-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2965 (if (or (< x 0) (< y 0)) ;stop at the edge
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2966 (setq done t)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2967
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2968 ;; We found a character we are not accepting as part of
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2969 ;; the line Search `artist-vaporize-fuzziness'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2970 ;; characters away from this position in the same
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2971 ;; direction to see if there are any characters in the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2972 ;; accept-set. If not, we have found the endpoint.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2973 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2974 (let ((fuzziness artist-vaporize-fuzziness)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2975 (x-tmp x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2976 (y-tmp y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2977
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2978 ;; while we have more fuzziness left and we have not
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2979 ;; found a character accepted as a line, move
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2980 ;; forward!
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2981 (while (and (> fuzziness 0) (not (memq c accept-set)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2982 (setq x-tmp (+ x-tmp step-x))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2983 (setq y-tmp (+ y-tmp step-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2984 (setq c (artist-get-char-at-xy-conv x-tmp y-tmp))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2985 (setq fuzziness (- fuzziness 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2986 (if (memq c accept-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2987
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2988 ;; The line continues on the other side of the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2989 ;; not-accepted character.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2990 (setq x x-tmp
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2991 y y-tmp)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2992
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2993 ;; Else: We couldn't find any line on the other side.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2994 ;; That means we are done searching for the endpoint.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2995 (setq done t)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2996 (cons x-last y-last)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2997
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2998
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2999 (defun artist-vap-find-endpoints-horiz (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3000 "Find endpoints for a horizontal line through X, Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3001 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3002 (list (artist-vap-find-endpoint x y 1 0 '(?- ?+) '(? ))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3003 (artist-vap-find-endpoint x y -1 0 '(?- ?+) '(? ))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3004
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3005 (defun artist-vap-find-endpoints-vert (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3006 "Find endpoints for a vertical line through X, Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3007 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3008 (list (artist-vap-find-endpoint x y 0 1 '(?| ?+) '(? ))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3009 (artist-vap-find-endpoint x y 0 -1 '(?| ?+) '(? ))))
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 (defun artist-vap-find-endpoints-swne (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3012 "Find endpoints for a diagonal line (made by /'s) through X, Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3013 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3014 (list (artist-vap-find-endpoint x y 1 -1 '(?/ ?X) '(? ))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3015 (artist-vap-find-endpoint x y -1 1 '(?/ ?X) '(? ))))
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-nwse (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3018 "Find endpoints for a diagonal line (made by \\'s) 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 1 '(?\\ ?X) '(? ))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3021 (artist-vap-find-endpoint x y -1 -1 '(?\\ ?X) '(? ))))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3024 (defun artist-vap-find-endpoints (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3025 "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
3026 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3027 (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3028 nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3029 (let ((c (artist-get-char-at-xy-conv x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3030 (cond ((eq c ?-) (artist-vap-find-endpoints-horiz x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3031 ((eq c ?|) (artist-vap-find-endpoints-vert x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3032 ((eq c ?/) (artist-vap-find-endpoints-swne x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3033 ((eq c ?\\) (artist-vap-find-endpoints-nwse x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3034 ((eq c ?+) (append (artist-vap-find-endpoints-horiz x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3035 (artist-vap-find-endpoints-vert x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3036 ((eq c ?X) (append (artist-vap-find-endpoints-swne x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3037 (artist-vap-find-endpoints-nwse x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3038
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3039 ;; We don't know how to find directions when we are on
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3040 ;; another character
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3041 (t nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3042
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3043
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3044 (defun artist-vap-group-in-pairs (l)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3045 "Group elements in list L in pairs."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3046 (cond ((null l) nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3047 ((null (cdr l)) l) ; unevent number of elements in list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3048 (t (append (list (list (car l) (car (cdr l))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3049 (artist-vap-group-in-pairs (cdr (cdr l)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3050
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3051 (defun artist-vaporize-by-endpoints (endpoint1 endpoint2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3052 "Given ENDPOINT1 and ENDPOINT2, vaporize the line between them.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3053 An endpoint is a pair (X . Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3054 (let* ((x1 (car endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3055 (y1 (cdr endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3056 (x2 (car endpoint2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3057 (y2 (cdr endpoint2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3058 (dir (artist-find-direction x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3059 (x-step (aref [1 1 0 -1 -1 -1 0 1] dir))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3060 (y-step (aref [0 1 1 1 0 -1 -1 -1] dir))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3061 (line-c (aref [?- ?\\ ?| ?/ ?- ?\\ ?| ?/] dir))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3062 (line-len (elt (list (abs (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3063 (abs (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3064 (abs (- y2 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3065 (abs (- y2 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3066 (abs (- x1 x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3067 (abs (- x1 x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3068 (abs (- y1 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3069 (abs (- y1 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3070 dir))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3071 (x x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3072 (y y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3073 (while (>= line-len 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3074 (let* ((buffer-c (artist-get-char-at-xy-conv x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3075 (new-c (artist-unintersection-char line-c buffer-c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3076 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3077 (artist-replace-char new-c))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3078 (setq x (+ x x-step)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3079 y (+ y y-step)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3080 line-len (- line-len 1)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3081
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3082
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3083 (defun artist-vaporize-line (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3084 "Vaporize (erase) the straight line through X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3085 Do this by replacing the characters that forms the line with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3086 `artist-erase-char'. Output is a list of endpoints for lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3087 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
3088 (let ((endpoints (artist-vap-find-endpoints x1 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3089 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3090 (lambda (endpoints)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3091 (let ((ep1 (car endpoints))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3092 (ep2 (car (cdr endpoints))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3093 (artist-vaporize-by-endpoints ep1 ep2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3094 (artist-vap-group-in-pairs endpoints))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3095 endpoints))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3096
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3097
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3098 ;; Implementation note: This depends on artist-vaporize-line doing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3099 ;; unintersections of intersecting lines.
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 ;; Example:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3102 ;; Suppose the buffer looks like this and that we start vaporizing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3103 ;; lines at (3,0) (at the ``*'').
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3104 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3105 ;; 0123456
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3106 ;; 0+--*--+
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3107 ;; 1| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3108 ;; 2| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3109 ;; 3+-----+
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3110 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3111 ;; 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
3112 ;; topmost horizontal line:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3113 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3114 ;; 0123456
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3115 ;; 0| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3116 ;; 1| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3117 ;; 2| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3118 ;; 3+-----+
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3119 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3120 ;; 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
3121 ;; 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
3122 ;; the entire rectangle is vaporized.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3123 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3124 ;; Now, What if the `+' in the upper left and upper right corners,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3125 ;; had not been changed to `|' but to spaces instead? We would
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3126 ;; have failed when popping (0,0) and vaporizing that line because
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3127 ;; we wouldn't find any line at (0,0):
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 ;; 0123456
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3130 ;; 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3131 ;; 1| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3132 ;; 2| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3133 ;; 3+-----+
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3134 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3135 ;; That's why we depend on artist-vaporize-line doing unintersecting
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3136 ;; of crossing lines. There are alternative ways to handle this
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3137 ;; if it becomes too much a trouble.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3138 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3139 (defun artist-vaporize-lines (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3140 "Vaporize lines reachable from point X1, Y1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3141 (let ((ep-stack nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3142 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3143 (lambda (ep) (artist-push ep ep-stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3144 (artist-vap-find-endpoints x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3145 (while (not (null ep-stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3146 (let* ((vaporize-point (artist-pop ep-stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3147 (new-endpoints (artist-vaporize-line (car vaporize-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3148 (cdr vaporize-point))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3149 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3150 (lambda (endpoint) (artist-push endpoint ep-stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3151 new-endpoints)))))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3154 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3155 ;; Circles and ellipses
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-ellipse-generate-quadrant (x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3158 "Create a point-list for first quadrant.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3159 Points go from (X-RADIUS, 0) to (0, Y-RADIUS).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3160 Quadrant is generated around origo."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3161 (let* ((rx2 (* x-radius x-radius))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3162 (ry2 (* y-radius y-radius))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3163 (2rx2 (* 2 rx2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3164 (2ry2 (* 2 ry2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3165 (p)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3166 (x 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3167 (y y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3168 (px 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3169 (py (* 2rx2 y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3170 (point-list nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3171 (artist-put-pixel point-list x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3172 (setq p (round (+ ry2 (- (* rx2 y-radius)) (* 0.25 rx2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3173 (while (< px py)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3174 (setq x (1+ x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3175 px (+ px 2ry2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3176 (if (< p 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3177 (setq p (+ p ry2 px))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3178 (setq y (- y 1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3179 py (- py 2rx2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3180 p (+ p ry2 px (- py))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3181 (artist-put-pixel point-list x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3182 (setq p (round (+ (* ry2 (+ x 0.5) (+ x 0.5))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3183 (* rx2 (- y 1) (- y 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3184 (- (* rx2 ry2)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3185 (while (> y 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3186 (setq y (- y 1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3187 py (- py 2rx2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3188 (if (> p 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3189 (setq p (+ p rx2 (- py)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3190 (setq x (1+ x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3191 px (+ px 2ry2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3192 p (+ p rx2 (- py) px)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3193 (artist-put-pixel point-list x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3194 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3195
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3196 (defsubst artist-new-fill-item (x y width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3197 "Create a new item at X, Y, with WIDTH.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3198 This is for use in fill-info in ellipses and circles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3199 (let ((new-item (make-vector 3 x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3200 (aset new-item 1 y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3201 (aset new-item 2 width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3202 new-item))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3203
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3204 (defsubst artist-fill-item-get-x (fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3205 "Retrieve the x component of a FILL-ITEM."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3206 (aref fill-item 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3207
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3208 (defsubst artist-fill-item-set-x (fill-item new-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3209 "Set the x component of a FILL-ITEM to NEW-X."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3210 (aset fill-item 0 new-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3211 fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3212
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3213 (defsubst artist-fill-item-get-y (fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3214 "Retrieve the y component of a FILL-ITEM."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3215 (aref fill-item 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3216
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3217 (defsubst artist-fill-item-set-y (fill-item new-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3218 "Set the y component of a FILL-ITEM to NEW-Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3219 (aset fill-item 1 new-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3220 fill-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-width (fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3223 "Retrieve the width component of a FILL-ITEM."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3224 (aref fill-item 2))
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-width (fill-item new-width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3227 "Set the width component of a FILL-ITEM to NEW-WIDTH."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3228 (aset fill-item 2 new-width)
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3232 (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
3233 "Add offsets X-CENTER and Y-CENTER to coordinates in POINT-LIST."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3234 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3235 (lambda (p)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3236 (artist-coord-set-x p (+ x-center (artist-coord-get-x p)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3237 (artist-coord-set-y p (+ y-center (artist-coord-get-y p))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3238 point-list))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3241 (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
3242 "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
3243 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3244 (lambda (p)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3245 (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
3246 (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
3247 fill-info))
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 (defun artist-ellipse-remove-0-fills (fill-info)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3250 "Remove fill-infos from FILL-INFO that fills a zero-width field."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3251 (cond ((null fill-info)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3252 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3253 ((= 0 (artist-fill-item-get-width (car fill-info)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3254 (artist-ellipse-remove-0-fills (cdr fill-info)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3255 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3256 (append (list (car fill-info))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3257 (artist-ellipse-remove-0-fills (cdr fill-info))))))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3260 (defun artist-ellipse-compute-fill-info (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3261 "Compute fill info for ellipse around 0,0 from POINT-LIST.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3262 The POINT-LIST is expected to cover the first quadrant."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3263 (let ((first-half nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3264 (both-halves nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3265 (last-y nil))
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 ;; Create first half (the lower one (since y grows downwards)) from
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3268 ;; the first quadrant.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3269 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3270 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3271 (let* ((x (artist-coord-get-x coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3272 (y (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3273 (width (max (- (* 2 x) 1) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3274 (left-edge (- x width)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3275 (if (or (null last-y) (not (= y last-y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3276 ;; This was either the first time,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3277 ;; or it was the first time on a new line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3278 (setq first-half
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3279 (append first-half
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3280 ;; Fill info item starts at left-edge on line y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3281 (list (artist-new-fill-item left-edge y width)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3282 (setq last-y y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3283 point-list)
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 the other half by mirroring the first half.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3286 (setq both-halves
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3287 (append first-half
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3288 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3289 (lambda (i)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3290 (artist-new-fill-item (artist-fill-item-get-x i)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3291 (- (artist-fill-item-get-y i))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3292 (artist-fill-item-get-width i)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3293 ;; The cdr below is so we don't include fill-info for
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3294 ;;; the middle line twice
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3295 (cdr (reverse first-half)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3296 (artist-ellipse-remove-0-fills both-halves)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3297
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3298
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3299 (defun artist-ellipse-mirror-quadrant (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3300 "Mirror a POINT-LIST describing first quadrant to create a complete ellipse."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3301 (let ((right-half nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3302 (left-half nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3303
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3304 ;; First, if last char in that quadrant is `/', then replace it with `)'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3305 ;; This way we avoids things
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3306 ;; --------- ---------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3307 ;; / \ / \
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3308 ;; that look like: \ / instead we get: ( )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3309 ;; \ / \ /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3310 ;; --------- ---------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3311 (let ((last-coord (artist-last point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3312 (if (= (artist-coord-get-new-char last-coord) ?/)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3313 (artist-coord-set-new-char last-coord artist-ellipse-right-char)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3314
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3315 ;; 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
3316 (setq right-half
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3317 (append
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3318 point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3319 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3320 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3321 (let ((c (artist-coord-get-new-char coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3322 (artist-new-coord (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3323 (- (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3324 (cond ((= c ?/) ?\\)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3325 ((= c ?\\) ?/)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3326 (t c)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3327 ;; 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
3328 (cdr (reverse point-list)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3329
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3330 ;; Create the left half by mirroring the right half.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3331 (setq left-half
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3332 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3333 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3334 (let ((c (artist-coord-get-new-char coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3335 (artist-new-coord (- (artist-coord-get-x coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3336 (artist-coord-get-y coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3337 (cond ((= c ?/) ?\\)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3338 ((= c ?\\) ?/)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3339 ((= c artist-ellipse-right-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3340 artist-ellipse-left-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3341 (t c)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3342 ;; 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
3343 ;; and middle bottom char twice.
34903
ad60696fa455 (artist-butlast): Deleted.
Kenichi Handa <handa@m17n.org>
parents: 34648
diff changeset
3344 (butlast (cdr (reverse right-half)))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3345 (append right-half left-half)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3346
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 (defun artist-draw-ellipse-general (x y x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3349 "Draw an ellipse with center at X, Y and X-RADIUS and Y-RADIUS.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3350
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3351 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
3352
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3353 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
3354 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
3355
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3356 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
3357 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
3358
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3359 Ellipses with zero y-radius are not drawn correctly."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3360 (let* ((point-list (artist-ellipse-generate-quadrant x-radius y-radius))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3361 (fill-info (artist-ellipse-compute-fill-info point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3362 (shape-info (make-vector 2 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3363
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3364 (setq point-list (artist-calculate-new-chars point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3365 (setq point-list (artist-ellipse-mirror-quadrant point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3366 (setq point-list (artist-ellipse-point-list-add-center x y point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3367 (setq fill-info (artist-ellipse-fill-info-add-center x y fill-info))
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 ;; Draw the ellipse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3370 (setq point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3371 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3372 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3373 (artist-move-to-xy (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3374 (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3375 (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3376 (artist-replace-char artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3377 (artist-replace-char (artist-coord-get-new-char coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3378 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3379 (artist-modify-new-chars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3380 (artist-save-chars-under-point-list point-list))))
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 (aset shape-info 0 point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3383 (aset shape-info 1 fill-info)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3384 (artist-make-2point-object (artist-make-endpoint x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3385 (artist-make-endpoint x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3386 shape-info)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3387
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3388 (defun artist-draw-ellipse-with-0-height (x y x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3389 "Draw an ellipse with center at X, Y and X-RADIUS and Y-RADIUS.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3390
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3391 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
3392
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3393 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
3394 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
3395
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3396 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
3397 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
3398
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3399 The Y-RADIUS must be 0, but the X-RADUIS must not be 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3400 (let ((point-list nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3401 (width (max (- (abs (* 2 x-radius)) 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3402 (left-edge (1+ (- x (abs x-radius))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3403 (line-char (if artist-line-char-set artist-line-char ?-))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3404 (i 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3405 (point-list nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3406 (fill-info nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3407 (shape-info (make-vector 2 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3408 (while (< i width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3409 (let* ((line-x (+ left-edge i))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3410 (line-y y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3411 (new-coord (artist-new-coord line-x line-y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3412 (artist-coord-add-saved-char new-coord
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3413 (artist-get-char-at-xy line-x line-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3414 (artist-move-to-xy line-x line-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3415 (artist-replace-char line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3416 (setq point-list (append point-list (list new-coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3417 (setq i (1+ i))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3418 (aset shape-info 0 point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3419 (aset shape-info 1 fill-info)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3420 (artist-make-2point-object (artist-make-endpoint x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3421 (artist-make-endpoint x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3422 shape-info)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3423
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3424 (defun artist-draw-ellipse (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3425 "Draw an ellipse with center at X1, Y1 and point X2,Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3426
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3427 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
3428
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3429 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
3430 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
3431
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3432 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
3433 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
3434 (let* ((artist-line-char (artist-compute-line-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3435 (artist-line-char-set artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3436 (width (abs (- x2 x1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3437 (height (abs (- y2 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3438 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3439 ;; 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
3440 ;; position, but since x1,y1, x2,y2 marks the corners of one
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3441 ;; of the quadrants, we have to enlarge the ellipse a bit.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3442 ;; Ok, so then why by sqrt(2)?
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3443 ;; It comes from the equation for the ellipse (where a is the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3444 ;; x-radius and b is the y-radius):
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3445 ;; 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
3446 ;; and the fact that we want the enlarged ellipse to have the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3447 ;; same proportions as the smaller square, therefore we have:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3448 ;; a/b = x/y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3449 ;; Solving this yields a-in-larger-ellipse = a-in-smaller * sqrt(2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3450 (x-radius (round (* width (sqrt 2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3451 (y-radius (round (* height (sqrt 2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3452 (x x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3453 (y y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3454 (if (and (= y1 y2) (not (= x1 x2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3455 (artist-draw-ellipse-with-0-height x y x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3456 (artist-draw-ellipse-general x y x-radius y-radius))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3457
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3458
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3459 (defun artist-undraw-ellipse (ellipse)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3460 "Undraw ELLIPSE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3461 (if ellipse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3462 (let ((point-list (aref (artist-2point-get-shapeinfo ellipse) 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3463 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3464 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3465 (artist-move-to-xy (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3466 (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3467 (artist-replace-char (artist-coord-get-saved-char coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3468 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3469 point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3470
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3471
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3472 (defun artist-draw-circle (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3473 "Draw a circle with center at X1, Y1 and point X2,Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3474
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3475 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
3476
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3477 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
3478 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
3479
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3480 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
3481 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
3482 (let* ((artist-line-char (artist-compute-line-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3483 (artist-line-char-set artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3484 (width (abs (- x2 x1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3485 (height (abs (- y2 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3486 ;; When drawing our circle, we want it to through the cursor
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3487 ;; just as when drawing the ellispe, but we have to take
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3488 ;; care for the aspect-ratio.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3489 ;; The equation for the ellipse (where a is the x-radius and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3490 ;; b is the y-radius):
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3491 ;; 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
3492 ;; together with the relationship
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3493 ;; a = aspect-ratio * b
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3494 ;; gives
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3495 ;; a = sqrt( x^2 + (aspect-ratio * y)^2 ) and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3496 ;; b = a / aspect-ratio
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3497 (x-radius (round (sqrt (+ (* width width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3498 (* (* artist-aspect-ratio height)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3499 (* artist-aspect-ratio height))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3500 (y-radius (round (/ x-radius artist-aspect-ratio))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3501 (artist-draw-ellipse-general x1 y1 x-radius y-radius)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3502
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3503 (defalias 'artist-undraw-circle 'artist-undraw-ellipse)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3504
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3505
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3506 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3507 ; Filling ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3508 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3509 (defun artist-fill-ellipse (ellipse x y x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3510 "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
3511 (let ((fill-info (aref (artist-2point-get-shapeinfo ellipse) 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3512 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3513 (lambda (fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3514 (artist-move-to-xy (artist-fill-item-get-x fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3515 (artist-fill-item-get-y fill-item))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3516 (artist-replace-chars artist-fill-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3517 (artist-fill-item-get-width fill-item))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3518 fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3519 fill-info)))
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-fill-circle 'artist-fill-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 ;; Cutting, copying and pasting rectangles and squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3526 ;; (filling functions)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3527 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3528
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3529 (defun artist-cut-rect (rect x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3530 "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
3531 (artist-undraw-rect rect)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3532 (artist-copy-generic x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3533 (artist-erase-rect rect x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3534
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3535 (defun artist-cut-square (square x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3536 "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
3537 (artist-undraw-square square)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3538 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3539 (new-x1 (elt square-corners 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3540 (new-y1 (elt square-corners 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3541 (new-x2 (elt square-corners 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3542 (new-y2 (elt square-corners 3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3543 (artist-copy-generic new-x1 new-y1 new-x2 new-y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3544 (artist-erase-rect square new-x1 new-y1 new-x2 new-y2)))
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-get-buffer-contents-at-xy (x y width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3548 "Retrieve contents from the buffer at X, Y. WIDTH characters are returned."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3549 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3550 (let ((here (point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3551 (there (save-excursion (artist-move-to-xy (+ x width) y) (point))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3552 (untabify here there)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3553 (setq there (save-excursion (artist-move-to-xy (+ x width) y) (point)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3554 (buffer-substring here there)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3555
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3556
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3557 (defun artist-copy-generic (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3558 "Copy a rectangular area with corners at X1, Y1 and X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3559 Output is a copy buffer, a list of strings, representing the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3560 original contents of that area in the buffer."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3561 (let* ((x (min x1 x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3562 (y (min y1 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3563 (x-max (max x1 x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3564 (y-max (max y1 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3565 (w (+ (- x-max x) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3566 (l nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3567 (while (<= y y-max)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3568 (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
3569 (setq y (1+ y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3570 (if artist-interface-with-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3571 (setq killed-rectangle (reverse l))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3572 (setq artist-copy-buffer (reverse l)))))
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-rect (rect x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3576 "Copy rectangle RECT drawn from X1, Y1 to X2, Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3577 (artist-undraw-rect rect)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3578 (artist-copy-generic x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3579
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3580 (defun artist-copy-square (square x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3581 "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
3582 (artist-undraw-square square)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3583 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3584 (new-x1 (elt square-corners 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3585 (new-y1 (elt square-corners 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3586 (new-x2 (elt square-corners 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3587 (new-y2 (elt square-corners 3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3588 (artist-copy-generic new-x1 new-y1 new-x2 new-y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3589
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3590 (defun artist-paste (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3591 "Pastes the contents of the copy-buffer at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3592 (let ((copy-buf (if artist-interface-with-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3593 killed-rectangle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3594 artist-copy-buffer)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3595 (if (not (null copy-buf))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3596 (while (not (null copy-buf))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3597 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3598 (artist-replace-string (car copy-buf))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3599 (setq copy-buf (cdr copy-buf))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3600 (setq y (1+ y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3601 (message "Nothing to paste"))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3602
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3603
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3604 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3605 ;; Flood filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3606 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3607 (defun artist-ff-too-far-right (x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3608 "Determine if the position X is too far to the right."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3609 (cond ((numberp artist-flood-fill-right-border)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3610 (> x artist-flood-fill-right-border))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3611 ((eq artist-flood-fill-right-border 'window-width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3612 (> x (- (window-width) 2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3613 ((eq artist-flood-fill-right-border 'fill-column)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3614 (> x fill-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3615 (t (error "Invalid value for `artist-flood-fill-right-border'"))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3616
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3617 (defun artist-ff-get-rightmost-from-xy (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3618 "Find the rightmost position in this run, starting at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3619 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3620 (let ((char-at-xy (artist-get-char-at-xy-conv x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3621 (last-x x))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3622 (setq x (1+ x))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3623 (while (and (not (artist-ff-too-far-right x))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3624 (= char-at-xy (artist-get-char-at-xy-conv x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3625 (setq last-x x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3626 (setq x (1+ x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3627 last-x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3628
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3629 (defun artist-ff-is-topmost-line (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3630 "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
3631 (= y 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3632
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3633 (defun artist-ff-is-bottommost-line (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3634 "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
3635 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3636 (goto-char (point-max))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3637 (beginning-of-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3638 (let ((last-line (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3639 (if (= (point) (point-max))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3640
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3641 ;; Last line is empty, don't paint on it, report previous line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3642 ;; as last line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3643 (>= y (- last-line 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3644 (>= y last-line))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3645
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-flood-fill (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3648 "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
3649 (let ((stack nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3650 (input-queue nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3651 ;; We are flood-filling the area that has this character.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3652 (c (artist-get-char-at-xy-conv x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3653 (artist-fill-char (if artist-fill-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3654 artist-fill-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3655 artist-default-fill-char)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3656
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3657 ;; 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
3658 ;; 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
3659 ;; needn't.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3660 (if (not (= c artist-fill-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3661 (artist-push (artist-new-coord x1 y1) stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3662
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3663 (while (not (null stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3664 (let* ((coord (artist-pop stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3665 (x (artist-coord-get-x coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3666 (y (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3667
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3668 ;; Here we keep track of the leftmost and rightmost position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3669 ;; for this run
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3670 (x-leftmost 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3671 (x-rightmost 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3672 (last-x 0)
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 ;; Remember if line above and below are accessible
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3675 ;; Lines below the last one, and prior to the first-one
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3676 ;; are not accessible.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3677 (lines-above nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3678 (lines-below nil)
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 ;; Remember char for position on line above and below, so we
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3681 ;; can find the rightmost positions on the runs.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3682 (last-c-above -1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3683 (last-c-below -1))
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 (setq x-rightmost (artist-ff-get-rightmost-from-xy x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3686 (setq lines-above (not (artist-ff-is-topmost-line x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3687 (setq lines-below (not (artist-ff-is-bottommost-line x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3688 (setq last-x x-rightmost)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3689 (setq x x-rightmost)
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 ;; Search line above, push rightmost positions of runs for that line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3692 (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
3693 (if lines-above
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3694 (let ((c-above (artist-get-char-at-xy-conv x (- y 1))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3695 (if (and (= c-above c) (/= c-above last-c-above))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3696 (artist-push (artist-new-coord x (- y 1)) stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3697 (setq last-c-above c-above)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3698 (setq last-x x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3699 (setq x (- x 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3700
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3701 ;; Remember the left-most position on this run
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3702 (setq x-leftmost last-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3703
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3704 ;; Search line below, push rightmost positions of runs for that line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3705 (setq x x-rightmost)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3706 (while (>= x x-leftmost)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3707 (if lines-below
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3708 (let ((c-below (artist-get-char-at-xy-conv x (1+ y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3709 (if (and (= c-below c) (/= c-below last-c-below))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3710 (artist-push (artist-new-coord x (1+ y)) stack))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3711 (setq last-c-below c-below)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3712 (setq x (- x 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3713
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3714 (artist-move-to-xy x-leftmost y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3715 (artist-replace-chars artist-fill-char (1+ (- x-rightmost x-leftmost)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3716
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3717 ;; If we are to show incrementally, we have to remove any pending
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3718 ;; input from the input queue, because processing of pending input
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3719 ;; always has priority over display updates (although this input
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3720 ;; 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
3721 ;; the input on the input queue again.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3722 (if artist-flood-fill-show-incrementally
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3723 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3724 (if (input-pending-p)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3725 (discard-input))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3726 (artist-update-display)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3727
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3728 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3729 ;; Accessors to arrow-points
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3732 (defun artist-make-arrow-point (x y direction &optional state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3733 "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
3734 Optional argument STATE can be used to set state (default is nil)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3735 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3736 (let* ((arrow-point (make-vector 4 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3737 (arrow-marker (make-marker)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3738 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3739 (set-marker arrow-marker (point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3740 (aset arrow-point 0 arrow-marker)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3741 (aset arrow-point 1 (artist-get-char-at-xy x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3742 (aset arrow-point 2 direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3743 (aset arrow-point 3 state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3744 arrow-point)))
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 (defsubst artist-arrow-point-get-marker (arrow-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3747 "Retrieve the marker component of an ARROW-POINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3748 (aref arrow-point 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3749
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3750 (defsubst artist-arrow-point-get-orig-char (arrow-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3751 "Retrieve the orig char component of an ARROW-POINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3752 (aref arrow-point 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3753
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3754 (defsubst artist-arrow-point-get-direction (arrow-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3755 "Retrieve the direction component of an ARROW-POINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3756 (aref arrow-point 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3757
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3758 (defsubst artist-arrow-point-get-state (arrow-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3759 "Retrieve the state component of an ARROW-POINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3760 (aref arrow-point 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3761
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3762 (defsubst artist-arrow-point-set-state (arrow-point new-state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3763 "Set the state component of an ARROW-POINT to NEW-STATE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3764 (aset arrow-point 3 new-state))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3765
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 (defun artist-clear-arrow-points ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3768 "Clear current endpoints."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3769 (setq artist-arrow-point-1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3770 (setq artist-arrow-point-2 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3771
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3772 (defun artist-set-arrow-points-for-poly (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3773 "Generic function for setting arrow-points for poly-shapes from POINT-LIST."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3774 (let* ((ep1 (elt point-list 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3775 (ep2 (elt point-list 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3776 (x1 (artist-endpoint-get-x ep1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3777 (y1 (artist-endpoint-get-y ep1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3778 (x2 (artist-endpoint-get-x ep2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3779 (y2 (artist-endpoint-get-y ep2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3780 (dir1 (artist-find-direction x2 y2 x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3781 (epn (artist-last point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3782 (epn-1 (artist-last point-list 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3783 (xn (artist-endpoint-get-x epn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3784 (yn (artist-endpoint-get-y epn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3785 (xn-1 (artist-endpoint-get-x epn-1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3786 (yn-1 (artist-endpoint-get-y epn-1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3787 (dirn (artist-find-direction xn-1 yn-1 xn yn)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3788 (setq artist-arrow-point-1 (artist-make-arrow-point x1 y1 dir1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3789 (setq artist-arrow-point-2 (artist-make-arrow-point xn yn dirn))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3790
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3791
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3792 (defun artist-set-arrow-points-for-2points (shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3793 "Generic function for setting arrow-points for 2-point shapes.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3794 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
3795 (let* ((endpoint1 (artist-2point-get-endpoint1 shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3796 (endpoint2 (artist-2point-get-endpoint2 shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3797 (x1 (artist-endpoint-get-x endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3798 (y1 (artist-endpoint-get-y endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3799 (x2 (artist-endpoint-get-x endpoint2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3800 (y2 (artist-endpoint-get-y endpoint2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3801 (setq artist-arrow-point-1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3802 (artist-make-arrow-point x1 y1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3803 (artist-find-direction x2 y2 x1 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3804 (setq artist-arrow-point-2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3805 (artist-make-arrow-point x2 y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3806 (artist-find-direction x1 y1 x2 y2)))))
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 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3810 ;; Common routine for drawing/undrawing shapes based
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3811 ;; on the draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3812 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3813
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3814 (defun artist-key-undraw-continously (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3815 "Undraw current continous shape with point at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3816 ;; No undraw-info for continous shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3817 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3818
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3819 (defun artist-key-undraw-poly (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3820 "Undraw current poly shape with point at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3821 (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
3822 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3823 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3824 (artist-funcall undraw-fn artist-key-shape)))
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 (defun artist-key-undraw-1point (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3827 "Undraw current 1-point shape at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3828 ;; No undraw-info for 1-point shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3829 nil)
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-2points (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3832 "Undraw current 2-point shape at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3833 (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
3834 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3835 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3836 (artist-funcall undraw-fn artist-key-shape)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3837
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3838 (defun artist-key-undraw-common ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3839 "Common routine undrawing current shape."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3840 (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
3841 (col (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3842 (row (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3843
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3844 ;; Depending on what we are currently drawing, call other routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3845 ;; that knows how to do the job
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3846 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3847 (cond ((eq draw-how 'artist-do-continously)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3848 (artist-key-undraw-continously col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3849 ((eq draw-how 'artist-do-poly)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3850 (artist-key-undraw-poly col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3851 ((and (numberp draw-how) (= draw-how 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3852 (artist-key-undraw-1point col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3853 ((and (numberp draw-how) (= draw-how 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3854 (artist-key-undraw-2points col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3855 (t (message "Undrawing \"%s\"s is not yet implemented" draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3856
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3857 ;; Now restore the old position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3858 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3859 (artist-move-to-xy col row)))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3862
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3863 ;; Implementation note: This really should honor the interval-fn entry
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3864 ;; in the master table, `artist-mt', which would mean leaving a timer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3865 ;; 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
3866 ;; to be cancelled and reinstalled whenever the user moves the cursor.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3867 ;; 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
3868 ;; 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
3869 ;; simpler: when at the end of `artist-mouse-draw-continously', the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3870 ;; user has released the button, so the timer will always be cancelled
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3871 ;; at that point.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3872 (defun artist-key-draw-continously (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3873 "Draws current continous shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3874 (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
3875 (setq artist-key-shape (artist-funcall draw-fn x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3876
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3877 (defun artist-key-draw-poly (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3878 "Draws current poly-point shape with nth point at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3879 (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
3880 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3881 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3882 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3883
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3884 (defun artist-key-draw-1point (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3885 "Draws current 1-point shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3886 (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
3887 (setq artist-key-shape (artist-funcall draw-fn x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3888
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3889
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3890 (defun artist-key-draw-2points (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3891 "Draws current 2-point shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3892 (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
3893 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3894 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3895 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3896
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3897 (defun artist-key-draw-common ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3898 "Common routine for drawing current shape."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3899 (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
3900 (col (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3901 (row (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3902
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3903 ;; Depending on what we are currently drawing, call other routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3904 ;; that knows how to do the job
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 (cond ((eq draw-how 'artist-do-continously)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3907 (artist-key-draw-continously col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3908 ((eq draw-how 'artist-do-poly)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3909 (artist-key-draw-poly col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3910 ((and (numberp draw-how) (= draw-how 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3911 (artist-key-draw-1point col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3912 ((and (numberp draw-how) (= draw-how 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3913 (artist-key-draw-2points col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3914 (t (message "Drawing \"%s\"s is not yet implemented" draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3915
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3916 ;; Now restore the old position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3917 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3918 (artist-move-to-xy col row)))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3921
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 ;; Functions related to trimming line-endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3924 ;; The region between the topmost and bottommost visited line is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3925 ;; called a draw-region.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3926 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3927
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3928 (defun artist-draw-region-reset ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3929 "Reset the current draw-region."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3930 (setq artist-draw-region-max-y 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3931 (setq artist-draw-region-min-y 1000000))
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 (defun artist-draw-region-trim-line-endings (min-y max-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3934 "Trim lines in current draw-region from MIN-Y to MAX-Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3935 Trimming here means removing white space at end of a line"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3936 ;; 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
3937 (if (< max-y min-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3938 (let ((tmp min-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3939 (setq min-y max-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3940 (setq max-y tmp)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3941 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3942 (let ((curr-y min-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3943 (while (<= curr-y max-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3944 (artist-move-to-xy 0 curr-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3945 (end-of-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3946 (delete-horizontal-space)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3947 (setq curr-y (1+ curr-y))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3948
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 ;; Drawing shapes by using keys
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3951 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3952
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3953 (defun artist-key-do-continously-continously (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3954 "Update current continous shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3955 (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
3956 (artist-funcall draw-fn x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3957
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3958
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3959 (defun artist-key-do-continously-poly (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3960 "Update current poly-point shape with nth point at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3961 (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
3962 (undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3963 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3964 (y1 (artist-endpoint-get-y artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3965 (x2 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3966 (y2 y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3967 ;; If not rubber-banding, then move the 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3968 ;; Otherwise re-draw the shape to the new position
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 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3971 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3972 (artist-no-rb-unset-point2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3973 (artist-no-rb-set-point2 x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3974 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3975 (artist-funcall undraw-fn artist-key-shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3976 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3977
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3978
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3979 (defun artist-key-do-continously-1point (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3980 "Update current 1-point shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3981 ;; Nothing to do continously for operations
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3982 ;; where we have only one input point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3983 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3984
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3985 (defun artist-key-do-continously-2points (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3986 "Update current 2-point shape with 2nd point at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3987 (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
3988 (undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3989 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3990 (y1 (artist-endpoint-get-y artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3991 (x2 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3992 (y2 y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3993 ;; If not rubber-banding, then move the 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3994 ;; Otherwise re-draw the shape to the new position
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 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3997 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3998 (artist-no-rb-unset-point2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3999 (artist-no-rb-set-point2 x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4000 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4001 (artist-funcall undraw-fn artist-key-shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4002 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4003
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4004
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4005 (defun artist-key-do-continously-common ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4006 "Common routine for updating current shape."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4007 (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
4008 (col (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4009 (row (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4010
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4011 ;; Depending on what we are currently drawing, call other routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4012 ;; that knows how to do the job
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4013 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4014 (cond ((eq draw-how 'artist-do-continously)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4015 (artist-key-do-continously-continously col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4016 ((eq draw-how 'artist-do-poly)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4017 (artist-key-do-continously-poly col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4018 ((and (numberp draw-how) (= draw-how 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4019 (artist-key-do-continously-1point col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4020 ((and (numberp draw-how) (= draw-how 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4021 (artist-key-do-continously-2points col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4022 (t (message "Drawing \"%s\"s is not yet implemented" draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4023
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4024 ;; Now restore the old position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4025 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4026 (artist-move-to-xy col row)))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4029 (defun artist-key-set-point-continously (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4030 "Set point for current continous shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4031 ;; Maybe set arrow-points for continous shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4032 (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
4033 (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
4034 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4035 (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
4036 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4037
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4038 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4039 ;; *** We are about to begin drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4040 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4041 (artist-funcall init-fn x y))
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 ;; *** We are about to stop drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4044 (progn
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 (artist-funcall prep-fill-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4047 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4048 (artist-funcall arrow-set-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4049 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4050 (artist-funcall exit-fn x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4051
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4052 ;; Toggle the is-drawing flag
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4053 (setq artist-key-is-drawing (not artist-key-is-drawing)))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4056
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4057 (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
4058 "Set point for current poly-point shape at X,Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4059 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
4060 (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
4061 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4062 (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
4063 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4064 (fill-pred (artist-go-get-fill-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4065 (fill-fn (artist-go-get-fill-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4066 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4067 (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
4068
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4069 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4070
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4071 ;; *** We were not drawing ==> set first point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4072 (progn
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 (artist-funcall init-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4075
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4076 ;; If not rubber-banding, set first point.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4077 ;; Otherwise, draw the shape from x,y to x,y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4078 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4079 (artist-no-rb-set-point1 x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4080 (setq artist-key-shape (artist-funcall draw-fn x y x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4081
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4082 ;; Set first endpoint
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4083 (setq artist-key-endpoint1 (artist-make-endpoint x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4084
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4085 ;; Set point-list to contain start point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4086 (setq artist-key-poly-point-list (list (artist-make-endpoint x y)))
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 ;; Since we are not ready, set the arrow-points to nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4089 (artist-clear-arrow-points)
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 ;; Change state to drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4092 (setq artist-key-is-drawing t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4093
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4094 ;; Feedback
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4095 (message (substitute-command-keys
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4096 (concat "First point set. "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4097 "Set next with \\[artist-key-set-point], "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4098 "set last with C-u \\[artist-key-set-point]"))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4099
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4100
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4101 ;; *** We were drawing ==> we are about to set nth point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4102 ;; (last point if the argument this-is-last-point is non-nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4103 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4104 (let ((x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4105 (y1 (artist-endpoint-get-y artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4106 (x2 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4107 (y2 y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4108
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4109 ;; If not rubber-banding, undraw the 1's and 2's, then
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4110 ;; draw the shape (if we were rubber-banding, then the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4111 ;; shape is already drawn in artist-key-do-continously-2points.)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4112 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4113 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4114 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4115 (artist-no-rb-unset-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4116 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))
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 ;; Set x2 and y2 from shape's second point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4119 ;; (which might be different from the mouse's second point,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4120 ;; if, for example, we are drawing a straight line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4121 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4122 (if (not (null artist-key-shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4123 (let ((endpoint2 (artist-2point-get-endpoint2 artist-key-shape)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4124 (setq x2 (artist-endpoint-get-x endpoint2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4125 (setq y2 (artist-endpoint-get-y endpoint2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4126
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4127 ;; Add the endpoint to the list of poly-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4128 (setq artist-key-poly-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4129 (append artist-key-poly-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4130 (list (artist-make-endpoint x2 y2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4131
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4132 ;; Now do handle the case when this is the last point,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4133 ;; and the case when this point isn't the last
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 (if (not this-is-last-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4136 ;; ** This is not the last point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4137 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4138 ;; Start drawing a new 2-point-shape from last endpoint.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4139
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4140 ;; First set the start-point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4141 (setq x1 x2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4142 (setq y1 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4143 (setq artist-key-endpoint1 (artist-make-endpoint x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4144
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4145 ;; If we are not rubber-banding, then place the '1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4146 ;; Otherwise, draw the shape from x1,y1 to x1,y1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4147 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4148 (artist-no-rb-set-point1 x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4149 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x1 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4150
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4151 ;; Feedback
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4152 (message "Point set"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4153
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4154 ;; ** This is the last point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4155 (progn
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 (artist-funcall prep-fill-fn artist-key-poly-point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4158
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4159 ;; Maybe fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4160 (if (artist-funcall fill-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4161 (artist-funcall fill-fn artist-key-shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4162 artist-key-poly-point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4163
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4164 ;; Set the arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4165 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4166 (artist-funcall arrow-set-fn artist-key-poly-point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4167 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4168
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4169 (artist-funcall exit-fn artist-key-poly-point-list)
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 ;; Change state to not drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4172 (setq artist-key-shape nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4173 (setq artist-key-endpoint1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4174 (setq artist-key-is-drawing nil)))))))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4177 (defun artist-key-set-point-1point (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4178 "Set point for current 1-point shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4179 (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
4180 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4181 (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
4182 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4183 (draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4184 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4185 (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
4186 (artist-funcall init-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4187 (artist-funcall draw-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4188 (artist-funcall prep-fill-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4189 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4190 (artist-funcall arrow-set-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4191 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4192 (artist-funcall exit-fn x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4193 (setq artist-key-shape nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4194 (setq artist-key-is-drawing nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4195
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4196
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4197 (defun artist-key-set-point-2points (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4198 "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
4199 (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
4200 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4201 (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
4202 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4203 (fill-pred (artist-go-get-fill-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4204 (fill-fn (artist-go-get-fill-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4205 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4206 (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
4207 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4208
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4209 ;; *** We were not drawing ==> set first point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4210 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4211
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4212 (artist-funcall init-fn x y)
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 ;; If not rubber-banding, set first point.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4215 ;; Otherwise, draw the shape from x,y to x,y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4216 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4217 (artist-no-rb-set-point1 x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4218 (setq artist-key-shape (artist-funcall draw-fn x y x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4219
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4220 ;; Set first endpoint
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4221 (setq artist-key-endpoint1 (artist-make-endpoint x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4222
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4223 ;; Since we are not ready, clear the arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4224 (artist-clear-arrow-points)
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 ;; Change state to drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4227 (setq artist-key-is-drawing t))
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 ;; *** We were drawing ==> we are about to set 2nd point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4230 ;; and end the drawing operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4231
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4232 (let ((x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4233 (y1 (artist-endpoint-get-y artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4234 (x2 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4235 (y2 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 ;; If not rubber-banding, undraw the 1's and 2's, then
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4238 ;; draw the shape (if we were rubber-banding, then the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4239 ;; shape is already drawn in artist-key-do-continously-2points.)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4240 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4241 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4242 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4243 (artist-no-rb-unset-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4244 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))
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 (artist-funcall prep-fill-fn artist-key-shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4247
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4248 ;; Maybe fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4249 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4250 (if (artist-funcall fill-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4251 (artist-funcall fill-fn artist-key-shape x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4252
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4253 ;; Maybe set the arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4254 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4255 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4256 (artist-funcall arrow-set-fn artist-key-shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4257 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4258
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4259 (artist-funcall exit-fn artist-key-shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4260
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4261 ;; Change state to not drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4262 (setq artist-key-is-drawing nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4263
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 (defun artist-key-set-point-common (arg)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4266 "Common routine for setting point in current shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4267 With ARG set to t, set the last point."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4268 (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
4269 (col (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4270 (row (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4271 (was-drawing artist-key-is-drawing))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4272
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4273 ;; First, if we are about to draw, then reset the draw-region
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4274 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4275 (artist-draw-region-reset))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4276
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4277 ;; Depending on what we are currently drawing, call other routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4278 ;; that knows how to do the job
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4279 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4280 (cond ((eq draw-how 'artist-do-continously)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4281 (artist-key-set-point-continously col row)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4282 ;; Do this now, otherwise nothing will happen until we move.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4283 (artist-key-do-continously-continously col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4284 ((eq draw-how 'artist-do-poly)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4285 (artist-key-set-point-poly col row arg))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4286 ((and (numberp draw-how) (= draw-how 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4287 (artist-key-set-point-1point col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4288 ((and (numberp draw-how) (= draw-how 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4289 (artist-key-set-point-2points col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4290 (t (message "Drawing \"%s\"s is not yet implemented" draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4291
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4292 ;; Maybe trim line endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4293 (if (and artist-trim-line-endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4294 was-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4295 (not artist-key-is-drawing))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4296 (artist-draw-region-trim-line-endings artist-draw-region-min-y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4297 artist-draw-region-max-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4298
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4299 ;; Now restore the old position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4300 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4301 (artist-move-to-xy col row)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4302 (artist-mode-line-show-curr-operation artist-key-is-drawing)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4303
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4304 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4305 ;; Key navigation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4306 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4307
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4308 (defun artist-previous-line (&optional n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4309 "Move cursor up optional N lines (default is 1), updating current shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4310 If N is negative, move cursor down."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4311 (interactive "p")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4312 (let ((col (artist-current-column)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4313 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4314 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4315 (previous-line n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4316 (move-to-column col t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4317 (previous-line n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4318 (move-to-column col t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4319 (artist-key-do-continously-common))))
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 (defun artist-next-line (&optional n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4323 "Move cursor down optional N lines (default is 1), updating current shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4324 If N is negative, move cursor up."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4325 (interactive "p")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4326 (let ((col (artist-current-column)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4327 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4328 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4329 (next-line n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4330 (move-to-column col t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4331 (next-line n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4332 (move-to-column col t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4333 (artist-key-do-continously-common))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4334
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4335 (defun artist-backward-char (&optional n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4336 "Move cursor backward optional N chars (default is 1), updating curr shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4337 If N is negative, move forward."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4338 (interactive "p")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4339 (if (> n 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4340 (artist-forward-char (- n))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4341 (artist-forward-char n)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4342
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4343 (defun artist-forward-char (&optional n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4344 "Move cursor forward optional N chars (default is 1), updating curr shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4345 If N is negative, move backward."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4346 (interactive "p")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4347 (let* ((step-x (if (>= n 0) 1 -1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4348 (distance (abs n))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4349 (curr-col (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4350 (new-col (max 0 (+ curr-col (* distance step-x)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4351 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4352 (move-to-column new-col t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4353 (move-to-column new-col t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4354 (artist-key-do-continously-common))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4355
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4356
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4357 (defun artist-key-set-point (&optional arg)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4358 "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
4359 (interactive "P")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4360 (artist-key-set-point-common arg))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4361
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4362
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4363 (defun artist-select-fill-char (c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4364 "Set current fill character to be C."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4365 (interactive "cType fill char (type RET to turn off): ")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4366 (cond ((eq c ?\r) (setq artist-fill-char-set nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4367 (message "Fill cancelled"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4368 (t (setq artist-fill-char-set t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4369 (setq artist-fill-char c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4370 (message "Fill set to \"%c\"" c))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4371
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 (defun artist-select-line-char (c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4374 "Set current line character to be C."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4375 (interactive "cType line char (type RET to turn off): ")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4376 (cond ((eq c ?\r) (setq artist-line-char-set nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4377 (message "Normal lines"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4378 (t (setq artist-line-char-set t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4379 (setq artist-line-char c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4380 (message "Line drawn with \"%c\"" c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4381 (if artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4382 (artist-key-do-continously-common)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4383
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4384
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4385 (defun artist-select-erase-char (c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4386 "Set current erase character to be C."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4387 (interactive "cType char to use when erasing (type RET for normal): ")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4388 (cond ((eq c ?\r) (setq artist-erase-char ?\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4389 (message "Normal erasing"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4390 (t (setq artist-erase-char c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4391 (message "Erasing with \"%c\"" c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4392 (if artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4393 (artist-key-do-continously-common)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4394
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4395 (defun artist-charlist-to-string (char-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4396 "Convert a list of characters, CHAR-LIST, to a string."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4397 (let ((result ""))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4398 (while (not (null char-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4399 (setq result (concat result (char-to-string (car char-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4400 (setq char-list (cdr char-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4401 result))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4402
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4403 (defun artist-string-to-charlist (str)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4404 "Convert a string, STR, to list of characters."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4405 (append str nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4406
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4407 (defun artist-select-spray-chars (chars initial-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4408 "Set current spray characters to be CHARS, starting with INITIAL-CHAR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4409 ;; This huge unreadable `interactive'-clause does the following
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4410 ;; 1. Asks for a string of spray-characters
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4411 ;; 2. Asks for the initial character (default is the first),
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4412 ;; 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
4413 (interactive
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4414 (let* ((str (read-string "Select spray-can characters, lightest first: "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4415 (artist-charlist-to-string artist-spray-chars)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4416 (char-list (artist-string-to-charlist str))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4417 (initial (let* ((err-msg "")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4418 (ok nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4419 (first-char-as-str (char-to-string (car char-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4420 (first-s) (first-c))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4421 (while (not ok)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4422 (setq first-s
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4423 (read-string
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4424 (format (concat "%sSelect initial-character, "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4425 "one of \"%s\" (%s): ")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4426 err-msg str first-char-as-str)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4427 (if (equal first-s "")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4428 (setq first-s first-char-as-str))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4429 (setq first-c (car (artist-string-to-charlist first-s)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4430 (setq ok (not (null (member first-c char-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4431 (if (not ok)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4432 (setq err-msg (format
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4433 "Not in spray-chars: \"%s\". "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4434 (char-to-string first-c)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4435 first-c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4436 (list char-list initial)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4437 (setq artist-spray-chars chars)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4438 (setq artist-spray-new-char initial-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4439 (message "Spray-chars set to \"%s\", initial: \"%s\""
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4440 (artist-charlist-to-string chars) (char-to-string initial-char)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4441
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4442
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4443 (defun artist-select-operation (op-str)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4444 "Select drawing operation OP-STR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4445 (interactive (list (completing-read "Select operation: "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4446 artist-key-compl-table)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4447 (let* ((op-symbol (artist-mt-get-symbol-from-keyword op-str))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4448 (draw-how (if op-symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4449 (artist-go-get-draw-how-from-symbol op-symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4450 nil)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4451 ;; First check that the string was valid
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4452 (if (null op-symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4453 (error "Unknown drawing method: %s" op-str))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4454
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4455 ;; Second, check that we are not about to switch to a different
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4456 ;; kind of shape (do that only if we are drawing with keys;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4457 ;; otherwise this function cannot get called).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4458 (if (and artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4459 (not (equal artist-key-draw-how draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4460 (error "Cannot switch to a different kind of shape while drawing"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4461
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4462 ;; If we were drawing, undraw the shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4463 (if (and artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4464 artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4465 (artist-key-undraw-common))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4466
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4467 ;; Set the current operation and draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4468 (setq artist-curr-go op-symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4469 (setq artist-key-draw-how draw-how)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4470
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4471 ;; If we were drawing, redraw the shape (but don't if shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4472 ;; is drawn by setting only one point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4473 (if (and artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4474 artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4475 (not (eq artist-key-draw-how 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4476 (artist-key-draw-common)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4477
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4478 ;; Feedback
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4479 (artist-mode-line-show-curr-operation artist-key-is-drawing))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4480
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4481
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4482 (defun artist-toggle-rubber-banding (&optional state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4483 "Toggle rubber-banding.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4484 If optional argument STATE is positive, turn rubber-banding on."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4485 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4486 (if artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4487 (error "Cannot toggle rubber-banding while drawing"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4488 (if (setq artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4489 (if (null state) (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4490 (> (prefix-numeric-value state) 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4491 (message "Rubber-banding is now on")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4492 (message "Rubber-banding is now off")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4493
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 (defun artist-toggle-trim-line-endings (&optional state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4496 "Toggle trimming of line-endings.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4497 If optional argument STATE is positive, turn trimming on."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4498 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4499 (if (setq artist-trim-line-endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4500 (if (null state) (not artist-trim-line-endings)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4501 (> (prefix-numeric-value state) 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4502 (message "Trimming is now on")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4503 (message "Trimming is now off")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4504
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4505
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4506 (defun artist-toggle-borderless-shapes (&optional state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4507 "Toggle borders of shapes.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4508 If optional argument STATE is positive, turn borders on."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4509 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4510 (if (setq artist-borderless-shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4511 (if (null state) (not artist-borderless-shapes)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4512 (> (prefix-numeric-value state) 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4513 (message "Borders are now off")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4514 (message "Borders are now on")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4515
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4516
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4517 (defun artist-toggle-first-arrow ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4518 "Toggle first arrow for shape, if possible."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4519 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4520 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4521 (if (not (null artist-arrow-point-1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4522 (let* ((arrow-point artist-arrow-point-1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4523 (arrow-state (artist-arrow-point-get-state arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4524 (arrow-marker (artist-arrow-point-get-marker arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4525 (direction (artist-arrow-point-get-direction arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4526 (orig-char (artist-arrow-point-get-orig-char arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4527 (arrow-char (aref artist-arrows direction))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4528 (new-state (not arrow-state)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4529
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4530 (goto-char (marker-position arrow-marker))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4531
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4532 (if new-state
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4533 (if arrow-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4534 (artist-replace-char arrow-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4535 (artist-replace-char orig-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4536
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4537 (artist-arrow-point-set-state artist-arrow-point-1 new-state)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4538
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4539 (defun artist-toggle-second-arrow ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4540 "Toggle second arrow for shape, if possible."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4541 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4542 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4543 (if (not (null artist-arrow-point-2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4544 (let* ((arrow-point artist-arrow-point-2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4545 (arrow-state (artist-arrow-point-get-state arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4546 (arrow-marker (artist-arrow-point-get-marker arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4547 (direction (artist-arrow-point-get-direction arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4548 (orig-char (artist-arrow-point-get-orig-char arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4549 (arrow-char (aref artist-arrows direction))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4550 (new-state (not arrow-state)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4551
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4552 (goto-char (marker-position arrow-marker))
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 (if new-state
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4555 (if arrow-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4556 (artist-replace-char arrow-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4557 (artist-replace-char orig-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4558
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4559 (artist-arrow-point-set-state artist-arrow-point-2 new-state)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4560
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4561
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4562 (defun artist-select-op-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4563 "Select drawing lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4564 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4565 (artist-select-operation "line"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4566
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4567 (defun artist-select-op-straight-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4568 "Select drawing straight lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4569 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4570 (artist-select-operation "straight line"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4571
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4572 (defun artist-select-op-rectangle ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4573 "Select drawing rectangles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4574 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4575 (artist-select-operation "rectangle"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4576
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4577 (defun artist-select-op-square ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4578 "Select drawing squares."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4579 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4580 (artist-select-operation "square"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4581
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4582 (defun artist-select-op-poly-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4583 "Select drawing poly-lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4584 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4585 (artist-select-operation "poly-line"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4586
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4587 (defun artist-select-op-straight-poly-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4588 "Select drawing straight poly-lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4589 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4590 (artist-select-operation "straight poly-line"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4591
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4592 (defun artist-select-op-ellipse ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4593 "Select drawing ellipses."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4594 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4595 (artist-select-operation "ellipse"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4596
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4597 (defun artist-select-op-circle ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4598 "Select drawing circles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4599 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4600 (artist-select-operation "circle"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4601
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4602 (defun artist-select-op-text-see-thru ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4603 "Select rendering text (see thru)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4604 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4605 (artist-select-operation "text see-thru"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4606
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4607 (defun artist-select-op-text-overwrite ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4608 "Select rendering text (overwrite)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4609 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4610 (artist-select-operation "text overwrite"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4611
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4612 (defun artist-select-op-spray-can ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4613 "Select spraying."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4614 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4615 (artist-select-operation "spray-can"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4616
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4617 (defun artist-select-op-spray-set-size ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4618 "Select setting size for spraying."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4619 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4620 (artist-select-operation "spray set size"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4621
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4622 (defun artist-select-op-erase-char ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4623 "Select erasing characters."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4624 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4625 (artist-select-operation "erase char"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4626
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4627 (defun artist-select-op-erase-rectangle ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4628 "Select erasing rectangles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4629 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4630 (artist-select-operation "erase rectangle"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4631
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4632 (defun artist-select-op-vaporize-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4633 "Select vaporizing single lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4634 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4635 (artist-select-operation "vaporize line"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4636
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4637 (defun artist-select-op-vaporize-lines ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4638 "Select vaporizing connected lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4639 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4640 (artist-select-operation "vaporize lines"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4641
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4642 (defun artist-select-op-cut-rectangle ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4643 "Select cutting rectangles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4644 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4645 (artist-select-operation "cut rectangle"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4646
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4647 (defun artist-select-op-cut-square ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4648 "Select cutting squares."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4649 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4650 (artist-select-operation "cut square"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4651
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4652 (defun artist-select-op-copy-rectangle ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4653 "Select copying rectangles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4654 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4655 (artist-select-operation "copy rectangle"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4656
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4657 (defun artist-select-op-copy-square ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4658 "Select copying squares."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4659 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4660 (artist-select-operation "cut square"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4661
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4662 (defun artist-select-op-paste ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4663 "Select pasting."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4664 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4665 (artist-select-operation "paste"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4666
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4667 (defun artist-select-op-flood-fill ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4668 "Select flood-filling."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4669 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4670 (artist-select-operation "flood-fill"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4671
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4672
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4673 ;; Drawing lines by using mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4674 ;; Mouse button actions
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4675 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4676
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4677 (defun artist-update-pointer-shape ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4678 "Perform the update of the X Windows pointer shape."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4679 (set-mouse-color nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4680
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4681 (defun artist-set-pointer-shape (new-pointer-shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4682 "Set the shape of the X Windows pointer to NEW-POINTER-SHAPE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4683 (setq x-pointer-shape new-pointer-shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4684 (artist-update-pointer-shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4685
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4686 (defsubst artist-event-is-shifted (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4687 "Check whether the shift-key is pressed in event EV."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4688 (memq 'shift (event-modifiers ev)))
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 (defun artist-do-nothing ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4691 "Function that does nothing."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4692 (interactive))
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-down-mouse-1 (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4695 "Perform drawing action for event EV."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4696 (interactive "@e")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4697 (let* ((real (artist-go-get-symbol-shift
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4698 artist-curr-go (artist-event-is-shifted ev)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4699 (draw-how (artist-go-get-draw-how-from-symbol real))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4700 ;; Remember original values for draw-region-min-y and max-y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4701 ;; in case we are interrupting a key-draw operation.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4702 (orig-draw-region-min-y artist-draw-region-min-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4703 (orig-draw-region-max-y artist-draw-region-max-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4704 (orig-pointer-shape (if (eq window-system 'x) x-pointer-shape nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4705 (echo-keystrokes 10000) ; a lot of seconds
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4706 ;; Remember original binding for the button-up event to this
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4707 ;; button-down event.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4708 (key (let* ((basic (event-basic-type ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4709 (unshifted basic)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4710 (shifted (make-symbol (concat "S-" (symbol-name basic)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4711 (if (artist-event-is-shifted ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4712 (make-vector 1 shifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4713 (make-vector 1 unshifted))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4714 (orig-button-up-binding (lookup-key (current-global-map) key)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4715
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4716 (unwind-protect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4717 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4718 (if (eq window-system 'x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4719 (artist-set-pointer-shape artist-pointer-shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4720
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4721 ;; Redefine the button-up binding temporarily (the original
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4722 ;; binding is restored in the unwind-forms below). This is to
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4723 ;; avoid the phenomenon outlined in this scenario:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4724 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4725 ;; 1. A routine which reads something from the mini-buffer (such
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4726 ;; as the text renderer) is called from below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4727 ;; 2. Meanwhile, the users releases the mouse button.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4728 ;; 3. As a (funny :-) coincidence, the binding for the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4729 ;; button-up event is often mouse-set-point, so Emacs
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4730 ;; sets the point to where the button was released, which is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4731 ;; in the buffer where the user wants to place the text.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4732 ;; 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
4733 ;; until he reaches the mini-buffer which is still prompting
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4734 ;; for some text to render.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4735 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4736 ;; To do this foolproof, all local and minor-mode maps should
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4737 ;; be searched and temporarily changed as well, since they
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4738 ;; too might have some binding for the button-up event,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4739 ;; but I hope dealing with the global map will suffice.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4740 (define-key (current-global-map) key 'artist-do-nothing)
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 (artist-draw-region-reset)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4743
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4744 (artist-mode-line-show-curr-operation t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4745
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4746 (cond ((eq draw-how 'artist-do-continously)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4747 (artist-mouse-draw-continously ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4748 ((eq draw-how 'artist-do-poly)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4749 (artist-mouse-draw-poly ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4750 ((and (numberp draw-how) (= draw-how 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4751 (artist-mouse-draw-1point ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4752 ((and (numberp draw-how) (= draw-how 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4753 (artist-mouse-draw-2points ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4754 (t (message "Drawing \"%s\"s is not yet implemented"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4755 draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4756
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4757 (if artist-trim-line-endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4758 (artist-draw-region-trim-line-endings artist-draw-region-min-y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4759 artist-draw-region-max-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4760 (setq artist-draw-region-min-y orig-draw-region-min-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4761 (setq artist-draw-region-max-y orig-draw-region-max-y))
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 ; This is protected
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4764 (if (eq window-system 'x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4765 (artist-set-pointer-shape orig-pointer-shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4766
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4767 (if orig-button-up-binding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4768 (define-key (current-global-map) key orig-button-up-binding))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4769
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4770 (artist-mode-line-show-curr-operation artist-key-is-drawing))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4771
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4772
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4773 (defun artist-mouse-choose-operation (ev op)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4774 "Choose operation for evenvt EV and operation OP."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4775 (interactive
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4776 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4777 (select-window (posn-window (event-start last-input-event)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4778 (list last-input-event
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4779 (x-popup-menu last-nonmenu-event artist-popup-menu-table))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4780
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4781 (let ((draw-fn (artist-go-get-draw-fn-from-symbol (car op)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4782 (set-fn (artist-fc-get-fn-from-symbol (car op))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4783 (cond
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4784
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4785 ;; *** It was a draw-function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4786 ((not (listp draw-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4787 (let* ((unshifted (artist-go-get-symbol-shift (car op) nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4788 (shifted (artist-go-get-symbol-shift (car op) t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4789 (shift-state (artist-event-is-shifted ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4790 (selected-op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4791 (keyword (artist-go-get-keyword-from-symbol selected-op)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4792 (artist-select-operation keyword)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4793
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4794 ;; *** It was a set/unset function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4795 ((not (listp set-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4796 (call-interactively set-fn)))))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4799 (defun artist-down-mouse-3 (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4800 "Erase character or rectangle, depending on event EV."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4801 (interactive "@e")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4802 (let ((artist-curr-go 'erase-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4803 (artist-down-mouse-1 ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4804 ;; Restore mode-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4805 (artist-mode-line-show-curr-operation artist-key-is-drawing))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4806
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4807
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4808 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4809 ;; Mouse routines
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4812 (defsubst artist-shift-has-changed (shift-state ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4813 "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
4814 ;; This one simply doesn't work.
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 ;; 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
4817 ;; while dragging the cursor around when we are in a track-mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4818 ;; form. Calling (event-modifiers ev) yields nil :-( Neither is the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4819 ;; (event-basic-type ev) of any help (it is simply `mouse-movement').
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4820 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4821 ;; So this doesn't work:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4822 ;; (cond ((and shift-state (not (artist-event-is-shifted ev))) t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4823 ;; ((and (not shift-state) (artist-event-is-shifted ev)) t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4824 ;; (t nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4825 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4826
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4827 (defun artist-coord-win-to-buf (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4828 "Convert a window-relative coordinate COORD to a buffer-relative coordinate."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4829 (let ((window-x (car coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4830 (window-y (cdr coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4831 (window-start-x (window-hscroll))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4832 (window-start-y (save-excursion (goto-char (window-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4833 (artist-current-line))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4834 (cons (+ window-x window-start-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4835 (+ window-y window-start-y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4836
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 (defun artist-mouse-draw-continously (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4839 "Generic function for shapes that requires 1 point as input.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4840 Operation is done continously while the mouse button is hold down.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4841 The event, EV, is the mouse event."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4842 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4843 (shifted (artist-go-get-symbol-shift artist-curr-go t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4844 (shift-state (artist-event-is-shifted ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4845 (op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4846 (draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4847 (init-fn (artist-go-get-init-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4848 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4849 (exit-fn (artist-go-get-exit-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4850 (draw-fn (artist-go-get-draw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4851 (interval-fn (artist-go-get-interval-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4852 (interval (artist-funcall interval-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4853 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4854 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4855 (ev-start (event-start ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4856 (initial-win (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4857 (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
4858 (x1 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4859 (y1 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4860 (shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4861 (timer))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4862 (select-window (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4863 (artist-funcall init-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4864 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4865 (artist-no-rb-set-point1 x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4866 (track-mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4867 (while (or (mouse-movement-p ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4868 (member 'down (event-modifiers ev)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4869 (setq ev-start-pos (artist-coord-win-to-buf
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4870 (posn-col-row (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4871 (setq x1 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4872 (setq y1 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4873
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4874 ;; Cancel previous timer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4875 (if timer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4876 (cancel-timer timer))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4877
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4878 (if (not (eq initial-win (posn-window (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4879 ;; If we moved outside the window, do nothing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4880 nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4881
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4882 ;; Still in same window:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4883 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4884 ;; Check if user presses or releases shift key
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4885 (if (artist-shift-has-changed shift-state ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4886
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4887 ;; First check that the draw-how is the same as we
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4888 ;; already have. Otherwise, ignore the changed shift-state.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4889 (if (not (eq draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4890 (artist-go-get-draw-how-from-symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4891 (if (not shift-state) shifted unshifted))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4892 (message "Cannot switch to shifted operation")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4893
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4894 ;; progn is "implicit" since this is the else-part
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4895 (setq shift-state (not shift-state))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4896 (setq op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4897 (setq draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4898 (setq draw-fn (artist-go-get-draw-fn-from-symbol op))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4899
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4900 ;; Draw the new shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4901 (setq shape (artist-funcall draw-fn x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4902 (artist-move-to-xy x1 y1)
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 ;; Start the timer to call `draw-fn' repeatedly every
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4905 ;; `interval' second
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4906 (if (and interval draw-fn)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4907 (setq timer (run-at-time interval interval draw-fn x1 y1))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4908
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4909 ;; Read next event
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4910 (setq ev (read-event))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4911
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4912 ;; Cancel any timers
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4913 (if timer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4914 (cancel-timer timer))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4915
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4916 (artist-funcall prep-fill-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4917
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4918 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4919 (artist-funcall arrow-set-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4920 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4921
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4922 (artist-funcall exit-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4923 (artist-move-to-xy x1 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4924
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4927 (defun artist-mouse-draw-poly (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4928 "Generic function for shapes requiring several points as input.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4929 The event, EV, is the mouse event."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4930 (interactive "@e")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4931 (message "Mouse-1: set new point, mouse-2: set last point")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4932 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4933 (shifted (artist-go-get-symbol-shift artist-curr-go t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4934 (shift-state (artist-event-is-shifted ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4935 (op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4936 (draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4937 (init-fn (artist-go-get-init-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4938 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4939 (exit-fn (artist-go-get-exit-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4940 (draw-fn (artist-go-get-draw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4941 (undraw-fn (artist-go-get-undraw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4942 (fill-pred (artist-go-get-fill-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4943 (fill-fn (artist-go-get-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4944 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4945 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4946 (ev-start (event-start ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4947 (initial-win (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4948 (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
4949 (x1-last (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4950 (y1-last (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4951 (x2 x1-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4952 (y2 y1-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4953 (is-down t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4954 (shape nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4955 (point-list (list (artist-make-endpoint x1-last y1-last)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4956 (done nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4957 (select-window (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4958 (artist-funcall init-fn x1-last y1-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4959 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4960 (artist-no-rb-set-point1 x1-last y1-last))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4961 (track-mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4962 (while (not done)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4963 ;; decide what to do
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4964 (cond
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4965
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4966 ;; *** Mouse button is released.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4967 ((and is-down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4968 (or (member 'click (event-modifiers ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4969 (member 'drag (event-modifiers ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4970 ;; First, if not rubber-banding, draw the line.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4971 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4972 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4973 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4974 (artist-no-rb-unset-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4975 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4976
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4977 ;; Set the second point to the shape's second point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4978 ;; (which might be different from the mouse's second point,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4979 ;; if, for example, we are drawing a straight line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4980 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4981 (if (not (null shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4982 (let ((endpoint2 (artist-2point-get-endpoint2 shape)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4983 (setq x1-last (artist-endpoint-get-x endpoint2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4984 (setq y1-last (artist-endpoint-get-y endpoint2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4985 (setq point-list (cons (artist-make-endpoint x1-last y1-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4986 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4987 (setq shape nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4988 (setq is-down nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4989
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4990 ;; *** Mouse button 2 or 3 down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4991 ((and (member 'down (event-modifiers ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4992 (or (equal (event-basic-type ev) 'mouse-2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4993 (equal (event-basic-type ev) 'mouse-3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4994 ;; Ignore
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4995 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4996
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4997 ;; *** Mouse button 2 or 3 released
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4998 ((and (or (member 'click (event-modifiers ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4999 (member 'drag (event-modifiers ev)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5000 (or (equal (event-basic-type ev) 'mouse-2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5001 (equal (event-basic-type ev) 'mouse-3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5002
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5003 ;; This means the end of our poly-line drawing-session.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5004 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5005 (setq done t))
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 1 went down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5008 ((and (not is-down)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5009 (member 'down (event-modifiers ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5010 (equal (event-basic-type ev) 'mouse-1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5011 ;; Check whether the (possibly new, that depends on if shift
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5012 ;; has been pressed or released) symbol has the same draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5013 ;; information as the previous had. If it hasn't, we can't
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5014 ;; proceed.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5015 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5016 (if (not (eq draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5017 (artist-go-get-draw-how-from-symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5018 (if (not shift-state) shifted unshifted))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5019 (message "Cannot switch operation")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5020 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5021 ;; Decide operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5022 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5023 (setq unshifted
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5024 (artist-go-get-symbol-shift artist-curr-go nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5025 shifted
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5026 (artist-go-get-symbol-shift artist-curr-go t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5027 shift-state (artist-event-is-shifted ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5028 op (if shift-state shifted unshifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5029 draw-how (artist-go-get-draw-how-from-symbol op)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5030 draw-fn (artist-go-get-draw-fn-from-symbol op)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5031 undraw-fn (artist-go-get-undraw-fn-from-symbol op)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5032 fill-pred (artist-go-get-fill-pred-from-symbol op)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5033 fill-fn (artist-go-get-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5034
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5035 ;; Draw shape from last place to this place
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5036
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5037 ;; set x2 and y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5038 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5039 (setq ev-start-pos (artist-coord-win-to-buf
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5040 (posn-col-row (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5041 (setq x2 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5042 (setq y2 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5043
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5044 ;; Draw the new shape (if not rubber-banding, place both marks)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5045 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5046 (if artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5047 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5048 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5049 (artist-no-rb-set-point1 x1-last y1-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5050 (artist-no-rb-set-point2 x2 y2)))
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 ;; Show new operation in mode-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5053 (let ((artist-curr-go op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5054 (artist-mode-line-show-curr-operation t))))
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 is-down t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5057
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5058
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5059 ;; *** Mouse moved, button is down and we are still in orig window
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5060 ((and (mouse-movement-p ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5061 is-down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5062 (eq initial-win (posn-window (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5063 ;; Draw shape from last place to this place
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5064 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5065 ;; set x2 and y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5066 (setq ev-start-pos (artist-coord-win-to-buf
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5067 (posn-col-row (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5068 (setq x2 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5069 (setq y2 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5070
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5071 ;; First undraw last shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5072 ;; (unset last point if not rubberbanding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5073 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5074 (artist-funcall undraw-fn shape)
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 ;; Draw the new shape (if not rubberbanding, set 2nd mark)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5077 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5078 (if artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5079 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5080 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5081 (artist-no-rb-unset-point2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5082 (artist-no-rb-set-point2 x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5083 ;; Move cursor
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5084 (artist-move-to-xy x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5085
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5086 ;; *** Mouse moved, button is down but we are NOT in orig window
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5087 ((and (mouse-movement-p ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5088 is-down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5089 (not (eq initial-win (posn-window (event-start ev)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5090 ;; Ignore
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5091 nil)
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5094 ;; *** Moving mouse while mouse button is not down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5095 ((and (mouse-movement-p ev) (not is-down))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5096 ;; don't do anything.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5097 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5098
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5099
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5100 ;; *** Mouse button 1 went down, first time
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5101 ((and is-down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5102 (member 'down (event-modifiers ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5103 (equal (event-basic-type ev) 'mouse-1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5104 ;; don't do anything
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5105 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5106
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5107
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5108 ;; *** Another event
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5109 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5110 ;; End drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5111 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5112 (setq done t)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5113
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5114 ;; Read next event (only if we should not stop)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5115 (if (not done)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5116 (setq ev (read-event)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5117
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5118 ;; Reverse point-list (last points are cond'ed first)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5119 (setq point-list (reverse point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5120
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5121 (artist-funcall prep-fill-fn point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5122
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5123 ;; Maybe fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5124 (if (artist-funcall fill-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5125 (artist-funcall fill-fn point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5126
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5127 ;; Maybe set arrow points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5128 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5129 (artist-funcall arrow-set-fn point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5130 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5131
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5132 (artist-funcall exit-fn point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5133 (artist-move-to-xy x2 y2)))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5136 (defun artist-mouse-draw-1point (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5137 "Generic function for shapes requiring only 1 point as input.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5138 Operation is done once. The event, EV, is the mouse event."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5139 (interactive "@e")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5140 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5141 (shifted (artist-go-get-symbol-shift artist-curr-go t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5142 (shift-state (artist-event-is-shifted ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5143 (op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5144 (draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5145 (init-fn (artist-go-get-init-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5146 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5147 (exit-fn (artist-go-get-exit-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5148 (draw-fn (artist-go-get-draw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5149 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5150 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5151 (ev-start (event-start ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5152 (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
5153 (x1 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5154 (y1 (cdr ev-start-pos)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5155 (select-window (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5156 (artist-funcall init-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5157 (artist-funcall draw-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5158 (artist-funcall prep-fill-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5159 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5160 (artist-funcall arrow-set-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5161 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5162 (artist-funcall exit-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5163 (artist-move-to-xy x1 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5164
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5165
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5166 (defun artist-mouse-draw-2points (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5167 "Generic function for shapes requiring 2 points as input.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5168 The event, EV, is the mouse event."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5169 (interactive "@e")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5170 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5171 (shifted (artist-go-get-symbol-shift artist-curr-go t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5172 (shift-state (artist-event-is-shifted ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5173 (op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5174 (draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5175 (init-fn (artist-go-get-init-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5176 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5177 (exit-fn (artist-go-get-exit-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5178 (draw-fn (artist-go-get-draw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5179 (undraw-fn (artist-go-get-undraw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5180 (fill-pred (artist-go-get-fill-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5181 (fill-fn (artist-go-get-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5182 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5183 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5184 (ev-start (event-start ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5185 (initial-win (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5186 (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
5187 (x1 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5188 (y1 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5189 (x2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5190 (y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5191 (shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5192 (select-window (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5193 (artist-funcall init-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5194 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5195 (artist-no-rb-set-point1 x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5196 (track-mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5197 (while (or (mouse-movement-p ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5198 (member 'down (event-modifiers ev)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5199 (setq ev-start-pos (artist-coord-win-to-buf
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5200 (posn-col-row (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5201 (setq x2 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5202 (setq y2 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5203
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5204 (if (not (eq initial-win (posn-window (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5205 ;; If we moved outside the window, do nothing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5206 nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5207
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5208 ;; Still in same window:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5209 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5210 ;; First undraw last shape (unset last point if not rubberbanding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5211 (if artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5212 (artist-funcall undraw-fn shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5213 (artist-no-rb-unset-point2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5214
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5215 ;; Check if user presses or releases shift key
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5216 (if (artist-shift-has-changed shift-state ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5217
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5218 ;; First check that the draw-how is the same as we
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5219 ;; already have. Otherwise, ignore the changed shift-state.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5220 (if (not (eq draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5221 (artist-go-get-draw-how-from-symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5222 (if (not shift-state) shifted unshifted))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5223 (message "Cannot switch to shifted operation")
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 (message "Switching")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5226 ;; progn is "implicit" since this is the else-part
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5227 (setq shift-state (not shift-state))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5228 (setq op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5229 (setq draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5230 (setq draw-fn (artist-go-get-draw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5231 (setq undraw-fn (artist-go-get-undraw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5232 (setq fill-pred (artist-go-get-fill-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5233 (setq fill-fn (artist-go-get-fill-fn-from-symbol op))))
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 ;; Draw the new shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5236 (if artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5237 (setq shape (artist-funcall draw-fn x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5238 (artist-no-rb-set-point2 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5239 ;; Move cursor
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5240 (artist-move-to-xy x2 y2))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5243 ;; Read next event
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5244 (setq ev (read-event))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5245
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5246 ;; 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
5247 ;; draw the shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5248 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5249 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5250 (artist-no-rb-unset-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5251 (setq shape (artist-funcall draw-fn x1 y1 x2 y2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5252
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5253 (artist-funcall prep-fill-fn shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5254
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5255 ;; Maybe fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5256 (if (artist-funcall fill-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5257 (artist-funcall fill-fn shape x1 y1 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 ;; Maybe set arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5260 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5261 (artist-funcall arrow-set-fn shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5262 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5263
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5264 (artist-funcall exit-fn shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5265 (artist-move-to-xy x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5266
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5267
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5268 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5269 ;; Bug-report-submitting
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5270 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5271 (defun artist-submit-bug-report ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5272 "Submit via mail a bug report on Artist."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5273 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5274 (require 'reporter)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5275 (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
5276 (let ((to artist-maintainer-address)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5277 (vars '(window-system
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5278 window-system-version
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5279 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5280 artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5281 artist-interface-with-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5282 artist-aspect-ratio
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5283 ;; Now the internal ones
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5284 artist-curr-go
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5285 artist-key-poly-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5286 artist-key-shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5287 artist-key-draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5288 artist-arrow-point-1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5289 artist-arrow-point-2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5290 ;; Remove those variables from vars that are not bound
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5291 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5292 (function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5293 (lambda (x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5294 (if (not (and (boundp x) (symbol-value x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5295 (setq vars (delq x vars))))) vars)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5296 (reporter-submit-bug-report
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5297 artist-maintainer-address
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5298 (concat "artist.el " artist-version)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5299 vars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5300 nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5301 (concat "Hello Tomas,\n\n"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5302 "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
5303
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5304
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5305 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5306 ;; Now provide this minor mode
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5307 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5308
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5309 (provide 'artist)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5310
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5311
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5312 ;;; About adding drawing modes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5313 ;;; --------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5314
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5315 ;; 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
5316 ;; sketchy outlines to get started a bit easier.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5317 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5318 ;; 1. If your new drawing mode falls into one of the following
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5319 ;; categories, goto point 2, otherwise goto point 3.
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 ;; - Modes where the shapes are drawn continously, as long as
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5322 ;; the mouse button is held down (continous modes).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5323 ;; Example: the erase-char mode, the pen and pen-line modes.
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 ;; - 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
5326 ;; arbitrary number of points (poly-point modes).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5327 ;; Example: the poly-line mode
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 ;; - Modes where the shape is made up of 2 points (2-point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5330 ;; modes).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5331 ;; Example: lines, rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5332 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5333 ;; - Modes where the shape is made up of 1 point (1-point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5334 ;; modes). This mode differs from the continous modes in
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5335 ;; that the shape is drawn only once when the mouse button
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5336 ;; is pressed.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5337 ;; Examples: paste, a flood-fill, vaporize modes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5338 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5339 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5340 ;; 2. To make it easier and more flexible to program new drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5341 ;; modes, you might choose to specify
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5342 ;; init-fn: a function to be called at the very beginning
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5343 ;; of the drawing phase,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5344 ;; prep-fill-fn: a function to be called before filling,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5345 ;; arrow-set-fn: a function for setting arrows, to be called
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5346 ;; after filling, and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5347 ;; exit-fn: a function to be called at the very end of
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5348 ;; the drawing phase.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5349 ;; 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
5350 ;; prep-fill-fn, arrow-set-fn and exit-fn are stated.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5351 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5352 ;; If your mode matches the continous mode or the 1-point mode:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5353 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5354 ;; a. Create a draw-function that draws your shape. Your function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5355 ;; must take x and y as arguments. The return value is not
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5356 ;; used.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5357 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5358 ;; b. Add your mode to the master table, `artist-mt'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5359 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5360 ;; init-fn: x y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5361 ;; prep-fill-fn: x y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5362 ;; arrow-set-fn: x y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5363 ;; exit-fn: x y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5364 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5365 ;; If your mode matches the 2-point mode:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5366 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5367 ;; a. Create one draw-function that draws your shape and one
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5368 ;; undraw-function that undraws it.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5369 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5370 ;; The draw-function must take x1, y1, x2 and y2 as
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5371 ;; arguments. It must return a list with three elements:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5372 ;; Endpoint1: a vector [x1 y1]
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5373 ;; Endpoint2: a vector [x2 y2]
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5374 ;; Shapeinfo: all info necessary for your undraw-function to
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5375 ;; be able to undraw the shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5376 ;; Use the artist-endpoint-* accessors to create and inspect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5377 ;; the endpoints.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5378 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5379 ;; If applicable, you must be able to draw your shape without
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5380 ;; borders if the `artist-borderless-shapes' is non-nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5381 ;; See `artist-draw-rect' for an example.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5382 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5383 ;; The undraw-function must take one argument: the list created
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5384 ;; by your draw-function. The return value is not used.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5385 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5386 ;; b. If you want to provide a fill-function, then create a
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5387 ;; function that takes 5 arguments: the list created by your
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5388 ;; draw-function, x1, y1, x2 and y2. The return value is not
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5389 ;; used.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5390 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5391 ;; c. Add your mode to the master table, `artist-mt'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5392 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5393 ;; init-fn: x1 y1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5394 ;; prep-fill-fn: shape x1 y1 x2 y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5395 ;; arrow-set-fn: shape x1 y1 x2 y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5396 ;; exit-fn: shape x1 y1 x2 y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5397 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5398 ;; If your mode matches the poly-point mode:
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 ;; a. Create one draw-function that draws your shape and one
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5401 ;; undraw-function that undraws it. The draw- and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5402 ;; undraw-functions are used to to draw/undraw a segment of
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5403 ;; your poly-point mode between 2 points. The draw- and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5404 ;; undraw-functions are then really 2-point mode functions.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5405 ;; They must take the same arguments and return the same
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5406 ;; values as those of the 2-point mode.
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 ;; If applicable, you must be able to draw your shape without
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5409 ;; borders if the `artist-borderless-shapes' is non-nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5410 ;; See `artist-draw-rect' for an example.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5411 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5412 ;; b. If you want to provide a fill-function, then create a
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5413 ;; function that takes 1 argument: a list of points where each
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5414 ;; point is a vector, [x, y].
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5415 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5416 ;; c. Add your mode to the master table, `artist-mt'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5417 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5418 ;; init-fn: x1 y1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5419 ;; prep-fill-fn: point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5420 ;; arrow-set-fn: point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5421 ;; exit-fn: point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5422 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5423 ;; The arrow-set-fn must set the variables `artist-arrow-point-1'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5424 ;; and `artist-arrow-point-2'. If your mode does not take arrows,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5425 ;; you must set the variables to nil. Use the accessors
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5426 ;; artist-arrow-point-* to create and inspect arrow-points.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5427 ;;
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 ;; 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
5430 ;; 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
5431 ;; brief outline of what you have to do:
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 ;; 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
5434 ;; you decided on `xxx'. Then you should use the draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5435 ;; symbol artist-do-xxx.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5436 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5437 ;; b. Create a function artist-mouse-draw-xxx for drawing with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5438 ;; mouse. It should be called from `artist-down-mouse-1'.
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 all coordinates must be converted from window-relative
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5441 ;; to buffer relative before saved or handed over to
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5442 ;; any other function. Converting is done with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5443 ;; the function `artist-coord-win-to-buf'.
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 ;; It must take care to the `artist-rubber-banding' variable
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5446 ;; and perform rubber-banding accordingly. Use the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5447 ;; artist-no-rb-* functions if not rubber-banding.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5448 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5449 ;; If applicable, you must be able to draw your shape without
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5450 ;; borders if the `artist-borderless-shapes' is non-nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5451 ;; See `artist-draw-rect' for an example.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5452 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5453 ;; 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
5454 ;; and the exit-fn at the apropriate points.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5455 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5456 ;; When artist-mouse-draw-xxx ends, the shape for your mode
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5457 ;; must be completely drawn.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5458 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5459 ;; c. Create functions for drawing with keys:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5460 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5461 ;; - artist-key-set-point-xxx for setting a point in the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5462 ;; mode, to be called from `artist-key-set-point-common'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5463 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5464 ;; - artist-key-do-continously-xxx to be called from
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5465 ;; `artist-key-do-continously-common' whenever the user
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5466 ;; moves around.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5467 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5468 ;; As for the artist-mouse-draw-xxx, these two functions must
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5469 ;; take care to do rubber-banding, borderless shapes and to
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5470 ;; set arrows.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5471 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5472 ;; These functions should set the variable `artist-key-shape'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5473 ;; to the shape drawn.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5474 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5475 ;; d. Create artist-key-draw-xxx and artist-key-undraw-xxx for
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5476 ;; drawing and undrawing. These are needed when the user
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5477 ;; switches operation to draw another shape of the same type
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5478 ;; of drawing mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5479 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5480 ;; You should provide these functions. You might think that
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5481 ;; 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
5482 ;; to switch to another operation of the same type of mode,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5483 ;; but someone else might base a new drawing mode upon your
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5484 ;; work.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5485 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5486 ;; 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
5487 ;; and the exit-fn at the apropriate points.
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 ;; e. Add your new mode to the master table, `artist-mt'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5490 ;;
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 ;; Happy hacking! Please let me hear if you add any drawing modes!
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5493 ;; Don't hesitate to ask me any questions.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5494
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5495
38436
b174db545cfd Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 37825
diff changeset
5496 ;;; artist.el ends here