annotate lisp/textmodes/artist.el @ 78107:30346382d01b

*** empty log message ***
author Jason Rumney <jasonr@gnu.org>
date Wed, 11 Jul 2007 14:43:07 +0000
parents e3694f1cb928
children b6d25790aab2 95d0cdf160ea
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
64751
5b1a238fcbb4 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64084
diff changeset
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
75347
e3694f1cb928 Add 2007 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 70811
diff changeset
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
6 ;; Author: Tomas Abrahamsson <tab@lysator.liu.se>
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
7 ;; Maintainer: Tomas Abrahamsson <tab@lysator.liu.se>
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
8 ;; Keywords: mouse
59223
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
9 ;; Version: 1.2.6
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
10 ;; Release-date: 6-Aug-2004
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
11 ;; Location: http://www.lysator.liu.se/~tab/artist/
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
12
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
13 ;; This file is part of GNU Emacs.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
14
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
15 ;; GNU Emacs is free software; you can redistribute it and/or modify
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
16 ;; 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
17 ;; the Free Software Foundation; either version 2, or (at your option)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
18 ;; any later version.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
19
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
20 ;; GNU Emacs is distributed in the hope that it will be useful,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
23 ;; GNU General Public License for more details.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
24
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
25 ;; You should have received a copy of the GNU General Public License
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
26 ;; along with GNU Emacs; see the file COPYING. If not, write to the
64084
a8fa7c632ee4 Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 63948
diff changeset
27 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
a8fa7c632ee4 Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 63948
diff changeset
28 ;; Boston, MA 02110-1301, USA.
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
29
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
30 ;;; Commentary:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
31
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
32 ;; What is artist?
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 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
35 ;; Artist is an Emacs lisp package that allows you to draw lines,
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
36 ;; rectangles and ellipses by using your mouse and/or keyboard. The
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
37 ;; shapes are made up with the ascii characters |, -, / and \.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
38 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
39 ;; Features are:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
40 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
41 ;; * Intersecting: When a `|' intersects with a `-', a `+' is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
42 ;; drawn, like this: | \ /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
43 ;; --+-- X
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 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
46 ;; * Rubber-banding: When drawing lines you can interactively see the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
47 ;; result while holding the mouse button down and moving the mouse. If
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
48 ;; 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
49 ;; pentium is well enough), you can turn this feature off. You will
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
50 ;; 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
51 ;; you are drawing.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
52 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
53 ;; * Drawing operations: The following drawing operations are implemented:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
54 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
55 ;; lines straight-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
56 ;; rectangles squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
57 ;; poly-lines straight poly-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
58 ;; ellipses circles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
59 ;; text (see-thru) text (overwrite)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
60 ;; spray-can setting size for spraying
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
61 ;; vaporize line vaporize lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
62 ;; erase characters erase rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
63 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
64 ;; Straight lines are lines that go horizontally, vertically or
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
65 ;; diagonally. Plain lines go in any direction. The operations in
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
66 ;; the right column are accessed by holding down the shift key while
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
67 ;; drawing.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
68 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
69 ;; It is possible to vaporize (erase) entire lines and connected lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
70 ;; (rectangles for example) as long as the lines being vaporized are
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
71 ;; straight and connected at their endpoints. Vaporizing is inspired
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
72 ;; by the drawrect package by Jari Aalto <jari.aalto@poboxes.com>.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
73 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
74 ;; * Flood-filling: You can fill any area with a certain character by
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
75 ;; flood-filling.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
76 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
77 ;; * Cut copy and paste: You can cut, copy and paste rectangular
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
78 ;; regions. Artist also interfaces with the rect package (this can be
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
79 ;; 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
80 ;; artist can be yanked with C-x r y and vice versa.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
81 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
82 ;; * Drawing with keys: Everything you can do with the mouse, you can
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
83 ;; also do without the mouse.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
84 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
85 ;; * Arrows: After having drawn a (straight) line or a (straight)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
86 ;; 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
87 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
88 ;; * Aspect-ratio: You can set the variable artist-aspect-ratio to
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
89 ;; reflect the height-width ratio for the font you are using. Squares
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
90 ;; and circles are then drawn square/round. Note, that once your
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
91 ;; ascii-file is shown with font with a different height-width ratio,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
92 ;; 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
93 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
94 ;; * Picture mode compatibility: Artist is picture mode compatible (this
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
95 ;; can be turned off).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
96 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
97 ;; See the documentation for the function artist-mode for a detailed
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
98 ;; description on how to use artist.
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 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
101 ;; What about adding my own drawing modes?
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 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
104 ;; See the short guide at the end of this file.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
105 ;; 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
106 ;; include in the next release!
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
109 ;;; Installation:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
110
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
111 ;; To use artist, put this in your .emacs:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
112 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
113 ;; (autoload 'artist-mode "artist" "Enter artist-mode" t)
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
116 ;;; Requirements:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
117
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
118 ;; Artist requires Emacs 19.28 or higher.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
119 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
120 ;; Artist requires the `rect' package (which comes with Emacs) to be
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
121 ;; loadable, unless the variable `artist-interface-with-rect' is set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
122 ;; to nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
123 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
124 ;; Artist also requires the Picture mode (which also comes with Emacs)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
125 ;; to be loadable, unless the variable `artist-picture-compatibility'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
126 ;; is set to nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
127
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
128 ;;; Known bugs:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
129
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
130 ;; The shifted operations are not available when drawing with the mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
131 ;; in Emacs 19.29 and 19.30.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
132 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
133 ;; It is not possible to change between shifted and unshifted operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
134 ;; while drawing with the mouse. (See the comment in the function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
135 ;; artist-shift-has-changed for further details.)
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
138 ;;; ChangeLog:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
139
59223
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
140 ;; 1.2.6 6-Aug-2004
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
141 ;; New: Coerced with the artist.el that's in Emacs-21.3.
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
142 ;; (minor editorial changes)
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
143 ;;
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
144 ;; 1.2.5 4-Aug-2004
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
145 ;; New: Added tool selection via the mouse-wheel
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
146 ;; Function provided by Andreas Leue <al@sphenon.de>
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
147 ;;
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
148 ;; 1.2.4 25-Oct-2001
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
149 ;; Bugfix: Some operations (the edit menu) got hidden
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
150 ;; Bugfix: The first arrow for poly-lines was always pointing
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
151 ;; to the right
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
152 ;; Changed: Updated with changes made for Emacs 21.1
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
153 ;;
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
154 ;; 1.2.3 20-Nov-2000
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
155 ;; Bugfix: Autoload cookie corrected
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
156 ;;
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
157 ;; 1.2.2 19-Nov-2000
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
158 ;; Changed: More documentation fixes.
47953
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
159 ;; Bugfix: The arrow characters (`artist-arrows'), which
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
160 ;; got wrong in 1.1, are now corrected.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
161 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
162 ;; 1.2.1 15-Nov-2000
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
163 ;; New: Documentation fixes.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
164 ;; Bugfix: Sets next-line-add-newlines to t while in artist-mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
165 ;; Drawing with keys was confusing without this fix, if
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
166 ;; next-line-add-newlines was set to nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
167 ;; Thanks to Tatsuo Furukawa <tatsuo@kobe.hp.com> for this.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
168 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
169 ;; 1.2 22-Oct-2000
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
170 ;; New: Updated to work with Emacs 21
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
171 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
172 ;; 1.1 15-Aug-2000
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
173 ;; Bugfix: Cursor follows mouse pointer more closely.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
174 ;; New: Works with Emacs 20.x
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
175 ;; New: Variables are customizable
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 ;; 1.1-beta1 21-Apr-1998
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
178 ;; New: Spray-can (Utterly useless, I believe, but it was fun
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
179 ;; to implement :-) after an idea by Karl-Johan Karlsson
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
180 ;; <kj@lysator.liu.se>.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
181 ;; New: Freehand drawing (with pen).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
182 ;; New: Vaporizing lines.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
183 ;; New: Text-rendering using figlet.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
184 ;; New: Picture mode compatibility.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
185 ;; 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
186 ;; with Picture mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
187 ;; Bugfix: No longer leaves traces of lines when rubberbanding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
188 ;; if the buffer auto-scrolls.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
189 ;; Bugfix: Infinite loop sometimes when rubberbanding was turned
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
190 ;; off.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
191 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
192 ;; 1.0 01-Mar-1998
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
193 ;; First official release.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
194
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
195 ;;; Code:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
196
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
197 ;; Variables
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
198
59223
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
199 (defconst artist-version "1.2.6")
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
200 (defconst artist-maintainer-address "tab@lysator.liu.se")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
201
65260
c1dcf33345ab (x-pointer-crosshair): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 64751
diff changeset
202 (defvar x-pointer-crosshair)
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
203
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
204 (eval-and-compile
41608
45db352a0971 Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents: 40323
diff changeset
205 (condition-case ()
45db352a0971 Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents: 40323
diff changeset
206 (require 'custom)
45db352a0971 Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents: 40323
diff changeset
207 (error nil))
45db352a0971 Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents: 40323
diff changeset
208 (if (and (featurep 'custom) (fboundp 'custom-declare-variable))
45db352a0971 Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents: 40323
diff changeset
209 nil ;; We've got what we needed
45db352a0971 Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents: 40323
diff changeset
210 ;; We have the old custom-library, hack around it!
45db352a0971 Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents: 40323
diff changeset
211 (defmacro defgroup (&rest args)
45db352a0971 Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents: 40323
diff changeset
212 nil)
45db352a0971 Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents: 40323
diff changeset
213 (defmacro defface (var values doc &rest args)
45db352a0971 Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents: 40323
diff changeset
214 `(make-face ,var))
47953
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
215 (defmacro defcustom (var value doc &rest args)
41608
45db352a0971 Converted backquote to the new style.
Sam Steingold <sds@gnu.org>
parents: 40323
diff changeset
216 `(defvar ,var ,value ,doc))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
217
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
218 ;; User options
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
219 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
220
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
221 (defgroup artist nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
222 "Customization of the Artist mode."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
223 :group 'mouse)
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 (defgroup artist-text nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
226 "Customization of the text rendering."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
227 :group 'artist)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
228
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
229 (defcustom artist-rubber-banding t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
230 "Interactively do rubber-banding when non-nil."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
231 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
232 :type 'boolean)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
233
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
234 (defcustom artist-first-char ?1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
235 "Character to set at first point when not rubber-banding."
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 'character)
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 (defcustom artist-second-char ?2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
240 "Character to set at second point when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
241 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
242 :type 'character)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
243
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
244 (defcustom artist-interface-with-rect t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
245 "Whether to interface with the rect package or not.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
246
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
247 Interfacing to the rect package means that the Copy and Paste operations
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
248 will use the rectangle buffer when accessing the copied area. This means
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
249 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
250 and vice versa.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
251
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
252 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
253 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
254 artist package will use its own copy buffer."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
255 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
256 :type 'boolean)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
257
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
258 (defvar artist-arrows [ ?> nil ?v ?L ?< nil ?^ nil ]
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
259 ;; This is a defvar, not a defcustom, since the custom
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
260 ;; package shows vectors of characters as a vector of integers,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
261 ;; which is confusing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
262 "A vector of characters to use as arrows.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
263
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
264 The vector is 8 elements long and contains a character for each
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
265 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
266 in that direction.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
267
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
268 The directions are as follows:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
269
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
270 5 6 7
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 4 - * - 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
273 / | \\
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
274 3 2 1")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
275
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
276 (defcustom artist-aspect-ratio 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
277 "Defines the character height-to-width aspect ratio.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
278 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
279 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
280 :type 'number)
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-trim-line-endings t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
283 "Whether or not to remove white-space at end of lines.
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, line-endings are trimmed (that is, extraneous white-space
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
286 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
287 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
288 :type 'boolean)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
289
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
290
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
291 (defcustom artist-flood-fill-right-border 'window-width
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
292 "Right edge definition, used when flood-filling.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
293
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
294 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
295 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
296 variable. This limit is called the fill-border."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
297 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
298 :type '(choice (const :tag "limited to window" window-width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
299 (const :tag "limited to value of `fill-column'" fill-column)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
300
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
301 (defcustom artist-flood-fill-show-incrementally t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
302 "Whether or not to incrementally update display when flood-filling.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
303
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
304 If non-nil, incrementally update display when flood-filling.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
305 If set to non-nil, this currently implies discarding any input events
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
306 during the flood-fill."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
307 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
308 :type 'boolean)
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
311 (defcustom artist-ellipse-right-char ?\)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
312 "Character to use at the rightmost position when drawing narrow ellipses.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
313
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
314 In this figure, it is the right parenthesis (the ``)'' character):
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
315 -----
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
316 ( )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
317 -----"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
318 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
319 :type 'character)
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
322 (defcustom artist-ellipse-left-char ?\(
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
323 "Character to use at the leftmost position when drawing narrow ellipses.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
324
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
325 In this figure, it is the left parenthesis (the ``('' character):
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
326 -----
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
327 ( )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
328 -----"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
329 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
330 :type 'character)
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 (defcustom artist-picture-compatibility t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
333 "Whether or not picture mode compatibility is on."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
334 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
335 :type 'boolean)
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
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
340 (defcustom artist-vaporize-fuzziness 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
341 "How to vaporize lines that are cut off.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
342
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
343 Accept this many characters cutting off a line and still treat
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
344 it as one line.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
345 Example:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
346 If `artist-vaporize-fuzziness' is 2, then those will be recognized as
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
347 lines from A to B (provided you start vaporizing them at the ``*''):
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 A----*------/-----------B
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
350 \\/
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
351 A----*----/\\------------B
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
352 / \\
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
353
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
354 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
355 \\/ /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
356 A----*----/\\/----------B
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
357 / /\\
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
358 (in fact, only the left part (between the A and the leftmost ``/''
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
359 crossing the line) will be vaporized)"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
360 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
361 :type 'integer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
362
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
363
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
364 (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
365 "*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
366
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
367
70811
fbbc9639de95 (artist-text-renderer): Make this the alias for the following variable.
Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
parents: 68648
diff changeset
368 (defcustom artist-text-renderer-function 'artist-figlet
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
369 "Function for doing text rendering."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
370 :group 'artist-text
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
371 :type 'symbol)
70811
fbbc9639de95 (artist-text-renderer): Make this the alias for the following variable.
Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
parents: 68648
diff changeset
372 (defvaralias 'artist-text-renderer 'artist-text-renderer-function)
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
373
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
374
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
375 (defcustom artist-figlet-program "figlet"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
376 "Program to run for `figlet'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
377 :group 'artist-text
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
378 :type 'string)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
379
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
380
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
381 (defcustom artist-figlet-default-font "standard"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
382 "Default font for `figlet'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
383 :group 'artist-text
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
384 :type 'string)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
385
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
386
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
387 (defcustom artist-figlet-list-fonts-command
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
388 ;; list files ending with *.flf in any directory printed by the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
389 ;; ``figlet -I2'' command. I think this will not produce more than
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
390 ;; one directory, but it never hurts to be on the safe side...
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
391 "for dir in `figlet -I2`; do cd $dir; ls *.flf; done"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
392 "Command to run to get list of available fonts."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
393 :group 'artist-text
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
394 :type 'string)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
395
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
396
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
397 (defcustom artist-spray-interval 0.2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
398 "Number of seconds between repeated spraying."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
399 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
400 :type 'number)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
401
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
402
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
403 (defcustom artist-spray-radius 4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
404 "Size of the area for spraying."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
405 :group 'artist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
406 :type 'integer)
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
65260
c1dcf33345ab (x-pointer-crosshair): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 64751
diff changeset
409 (defvar artist-spray-chars '(?\s ?. ?- ?+ ?m ?% ?* ?#)
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
410 ;; This is a defvar, not a defcustom, since the custom
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
411 ;; package shows lists of characters as a lists of integers,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
412 ;; which is confusing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
413 "*Characters (``color'') to use when spraying.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
414 They should be ordered
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
415 from the ``lightest'' to the ``heaviest'' since spraying replaces a
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
416 light character with the next heavier one.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
417
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
418
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
419 (defvar artist-spray-new-char ?.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
420 "*Initial character to use when spraying.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
421 This character is used if spraying upon a character that is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
422 not in `artist-spray-chars'. The character defined by this variable
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
423 should be in `artist-spray-chars', or spraying will behave
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
424 strangely.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
425
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
426
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 ;; End of user options
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
429
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
430
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
431 ;; Internal variables
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
432 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
433 (defvar artist-mode nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
434 "Non-nil to enable `artist-mode' and nil to disable.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
435 (make-variable-buffer-local 'artist-mode)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
436
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
437 (defvar artist-mode-name " Artist"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
438 "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
439
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
440 (defvar artist-curr-go 'pen-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
441 "Current selected graphics operation.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
442 (make-variable-buffer-local 'artist-curr-go)
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-line-char-set nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
445 "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
446 (make-variable-buffer-local 'artist-line-char-set)
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 (defvar artist-line-char nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
449 "Char to use when drawing lines.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
450 (make-variable-buffer-local 'artist-line-char)
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-fill-char-set nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
453 "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
454 (make-variable-buffer-local 'artist-fill-char-set)
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-fill-char nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
457 "Char to use when filling.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
458 (make-variable-buffer-local 'artist-fill-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
459
51965
5a62d5472383 (artist-erase-char): Fix default value using ?\s.
Markus Rost <rost@math.uni-bielefeld.de>
parents: 51961
diff changeset
460 (defvar artist-erase-char ?\s
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
461 "Char to use when erasing.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
462 (make-variable-buffer-local 'artist-erase-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
463
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
464 (defvar artist-default-fill-char ?.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
465 "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
466 (make-variable-buffer-local 'artist-default-fill-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
467
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
468 ; This variable is not buffer local
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
469 (defvar artist-copy-buffer nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
470 "Copy buffer.")
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 (defvar artist-draw-region-min-y 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
473 "Line-number for top-most visited line for draw operation.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
474 (make-variable-buffer-local 'artist-draw-region-min-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
475
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
476 (defvar artist-draw-region-max-y 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
477 "Line-number for bottom-most visited line for draw operation.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
478 (make-variable-buffer-local 'artist-draw-region-max-y)
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 (defvar artist-borderless-shapes nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
481 "When non-nil, draw shapes without border.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
482 The fill char is used instead, if it is set.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
483 (make-variable-buffer-local 'artist-borderless-shapes)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
484
59223
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
485 (defvar artist-prev-next-op-alist nil
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
486 "Assoc list for looking up next and/or previous draw operation.
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
487 The structure is as follows: (OP . (PREV-OP . NEXT-OP))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
488 where the elements are as follows:
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
489 * OP is an atom: the KEY-SYMBOL in the `artist-mt' structure
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
490 * PREV-OP and NEXT-OP are strings: the KEYWORD in the `artist-mt' structure
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
491
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
492 This variable is initialized by the artist-make-prev-next-op-alist function.")
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
493
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
494 (eval-when-compile
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
495 ;; Make rect available at compile-time
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
496 (require 'rect) ; for interfacing with rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
497 (require 'reporter) ; the bug-reporting tool
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
498 (require 'picture)) ; picture mode compatibility
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
499
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
500 (if artist-interface-with-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
501 (require 'rect))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
502
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
503 (require 'reporter)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
504
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
505 (if artist-picture-compatibility
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
506 (require 'picture))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
507
63948
c51c70065bb1 (artist-key-is-drawing)
Richard M. Stallman <rms@gnu.org>
parents: 63800
diff changeset
508 ;; Variables that are made local in artist-mode-init
c51c70065bb1 (artist-key-is-drawing)
Richard M. Stallman <rms@gnu.org>
parents: 63800
diff changeset
509 (defvar artist-key-is-drawing nil)
c51c70065bb1 (artist-key-is-drawing)
Richard M. Stallman <rms@gnu.org>
parents: 63800
diff changeset
510 (defvar artist-key-endpoint1 nil)
c51c70065bb1 (artist-key-is-drawing)
Richard M. Stallman <rms@gnu.org>
parents: 63800
diff changeset
511 (defvar artist-key-poly-point-list nil)
c51c70065bb1 (artist-key-is-drawing)
Richard M. Stallman <rms@gnu.org>
parents: 63800
diff changeset
512 (defvar artist-key-shape nil)
c51c70065bb1 (artist-key-is-drawing)
Richard M. Stallman <rms@gnu.org>
parents: 63800
diff changeset
513 (defvar artist-key-draw-how nil)
c51c70065bb1 (artist-key-is-drawing)
Richard M. Stallman <rms@gnu.org>
parents: 63800
diff changeset
514 (defvar artist-popup-menu-table nil)
c51c70065bb1 (artist-key-is-drawing)
Richard M. Stallman <rms@gnu.org>
parents: 63800
diff changeset
515 (defvar artist-key-compl-table nil)
c51c70065bb1 (artist-key-is-drawing)
Richard M. Stallman <rms@gnu.org>
parents: 63800
diff changeset
516 (defvar artist-rb-save-data nil)
c51c70065bb1 (artist-key-is-drawing)
Richard M. Stallman <rms@gnu.org>
parents: 63800
diff changeset
517 (defvar artist-arrow-point-1 nil)
c51c70065bb1 (artist-key-is-drawing)
Richard M. Stallman <rms@gnu.org>
parents: 63800
diff changeset
518 (defvar artist-arrow-point-2 nil)
c51c70065bb1 (artist-key-is-drawing)
Richard M. Stallman <rms@gnu.org>
parents: 63800
diff changeset
519
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
520 (defvar artist-mode-map
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
521 (let ((map (make-sparse-keymap)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
522 (setq artist-mode-map (make-sparse-keymap))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
523 (define-key map [down-mouse-1] 'artist-down-mouse-1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
524 (define-key map [S-down-mouse-1] 'artist-down-mouse-1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
525 (define-key map [down-mouse-2] 'artist-mouse-choose-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
526 (define-key map [S-down-mouse-2] 'artist-mouse-choose-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
527 (define-key map [down-mouse-3] 'artist-down-mouse-3)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
528 (define-key map [S-down-mouse-3] 'artist-down-mouse-3)
59223
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
529 (define-key map [C-mouse-4] 'artist-select-prev-op-in-list)
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
530 (define-key map [C-mouse-5] 'artist-select-next-op-in-list)
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
531 (define-key map "\r" 'artist-key-set-point) ; return
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
532 (define-key map [up] 'artist-previous-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
533 (define-key map "\C-p" 'artist-previous-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
534 (define-key map [down] 'artist-next-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
535 (define-key map "\C-n" 'artist-next-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
536 (define-key map [left] 'artist-backward-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
537 (define-key map "\C-b" 'artist-backward-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
538 (define-key map [right] 'artist-forward-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
539 (define-key map "\C-f" 'artist-forward-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
540 (define-key map "<" 'artist-toggle-first-arrow)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
541 (define-key map ">" 'artist-toggle-second-arrow)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
542 (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
543 (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
544 (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
545 (define-key map "\C-c\C-a\C-o" 'artist-select-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
546 (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
547 (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
548 (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
549 (define-key map "\C-c\C-c" 'artist-mode-off)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
550 (define-key map "\C-c\C-al" 'artist-select-op-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
551 (define-key map "\C-c\C-aL" 'artist-select-op-straight-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
552 (define-key map "\C-c\C-ar" 'artist-select-op-rectangle)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
553 (define-key map "\C-c\C-aR" 'artist-select-op-square)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
554 (define-key map "\C-c\C-as" 'artist-select-op-square)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
555 (define-key map "\C-c\C-ap" 'artist-select-op-poly-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
556 (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
557 (define-key map "\C-c\C-ae" 'artist-select-op-ellipse)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
558 (define-key map "\C-c\C-ac" 'artist-select-op-circle)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
559 (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
560 (define-key map "\C-c\C-aT" 'artist-select-op-text-overwrite)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
561 (define-key map "\C-c\C-aS" 'artist-select-op-spray-can)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
562 (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
563 (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
564 (define-key map "\C-c\C-aE" 'artist-select-op-erase-rectangle)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
565 (define-key map "\C-c\C-av" 'artist-select-op-vaporize-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
566 (define-key map "\C-c\C-aV" 'artist-select-op-vaporize-lines)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
567 (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
568 (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
569 (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
570 (define-key map "\C-c\C-af" 'artist-select-op-flood-fill)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
571 (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
572 map)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
573 "Keymap for `artist-minor-mode'.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
574
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
575 (defvar artist-replacement-table (make-vector 256 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
576 "Replacement table for `artist-replace-char'.")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
577
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
578
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
579 ;;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
580 ;;; The table of graphic operations
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 (defvar artist-mt
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
583 ;; Implementation note: Maybe this should be done using a structure
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
584 ;; in the cl package?
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
585 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
586 '(
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
587 (menu
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
588 ("Drawing"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
589 ((function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
590 ( "Undo" do-undo undo))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
591
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
592 (separator )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
593 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
594 ("Pen" (("Pen" pen-char "pen-c"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
595 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
596 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
597 artist-do-continously
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
598 artist-pen
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
599 (nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
600 ("Pen Line" pen-line "pen-l"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
601 artist-arrows artist-pen-set-arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
602 artist-pen-reset-last-xy nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
603 artist-do-continously
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
604 artist-pen-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
605 (nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
606
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
607 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
608 ("Line" (("line" line "line"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
609 artist-arrows artist-set-arrow-points-for-2points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
610 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
611 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
612 artist-draw-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
613 (artist-undraw-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
614 artist-nil nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
615 ("straight line" s-line "sline"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
616 artist-arrows artist-set-arrow-points-for-2points
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-sline
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
620 (artist-undraw-sline
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
621 artist-nil nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
622
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
623 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
624 ("Rectangle" (("rectangle" rect "rect"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
625 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
626 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
627 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
628 artist-draw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
629 (artist-undraw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
630 artist-t-if-fill-char-set artist-fill-rect))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
631 ("square" square "square"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
632 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
633 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
634 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
635 artist-draw-square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
636 (artist-undraw-square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
637 artist-t-if-fill-char-set artist-fill-square)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
638
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
639 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
640 ("Poly-line" (("poly-line" polyline "poly"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
641 artist-arrows artist-set-arrow-points-for-poly
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
642 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
643 artist-do-poly
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
644 artist-draw-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
645 (artist-undraw-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
646 artist-nil nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
647 ("straight poly-line" spolyline "s-poly"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
648 artist-arrows artist-set-arrow-points-for-poly
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
649 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
650 artist-do-poly
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
651 artist-draw-sline
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
652 (artist-undraw-sline
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
653 artist-nil nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
654
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
655 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
656 ("Ellipse" (("ellipse" ellipse "ellipse"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
657 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
658 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
659 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
660 artist-draw-ellipse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
661 (artist-undraw-ellipse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
662 artist-t-if-fill-char-set artist-fill-ellipse))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
663 ("circle" circle "circle"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
664 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
665 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
666 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
667 artist-draw-circle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
668 (artist-undraw-circle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
669 artist-t-if-fill-char-set artist-fill-circle)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
670
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
671 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
672 ("Text" (("text see-thru" text-thru "text-thru"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
673 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
674 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
675 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
676 artist-text-see-thru
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
677 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
678 ("text overwrite" text-ovwrt "text-ovwrt"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
679 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
680 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
681 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
682 artist-text-overwrite
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
683 nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
684
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
685 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
686 ("Spray-can" (("spray-can" spray-can "spray-can"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
687 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
688 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
689 artist-do-continously
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
690 artist-spray
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
691 (artist-spray-get-interval))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
692 ("spray set size" spray-get-size "spray-size"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
693 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
694 nil artist-spray-clear-circle artist-spray-set-radius
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
695 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
696 artist-draw-circle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
697 (artist-undraw-circle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
698 artist-nil nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
699
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
700 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
701 ("Erase" (("erase char" erase-char "erase-c"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
702 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
703 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
704 artist-do-continously
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
705 artist-erase-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
706 (nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
707 ("erase rectangle" erase-rect "erase-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-erase-rect)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
714
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
715 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
716 ("Vaporize" (("vaporize line" vaporize-line "vaporize-1"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
717 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
718 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
719 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
720 artist-vaporize-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
721 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
722 ("vaporize lines" vaporize-lines "vaporize-n"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
723 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
724 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
725 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
726 artist-vaporize-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
727 nil)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
728
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
729 (menu
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
730 ("Edit"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
731 ((graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
732 ("Cut" (("cut rectangle" cut-r "cut-r"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
733 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
734 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
735 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
736 artist-draw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
737 (artist-undraw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
738 artist-t artist-cut-rect)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
739 ("cut square" cut-s "cut-s"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
740 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
741 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
742 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
743 artist-draw-square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
744 (artist-undraw-square
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
745 artist-t artist-cut-square))))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
746
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
747 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
748 ("Copy" (("copy rectangle" copy-r "copy-r"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
749 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
750 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
751 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
752 artist-draw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
753 (artist-undraw-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
754 artist-t artist-copy-rect)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
755 ("copy square" copy-s "copy-s"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
756 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
757 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
758 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
759 artist-draw-square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
760 (artist-undraw-square
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
761 artist-t artist-copy-square))))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
762
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
763 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
764 ("Paste" (("paste" paste "paste"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
765 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
766 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
767 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
768 artist-paste
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
769 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
770 ("paste" paste "paste"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
771 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
772 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
773 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
774 artist-paste
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
775 nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
776
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
777 (graphics-operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
778 ("Flood-fill" (("flood-fill" flood-fill "flood"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
779 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
780 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
781 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
782 artist-flood-fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
783 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
784 ("flood-fill" flood-fill "flood"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
785 artist-no-arrows nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
786 nil nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
787 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
788 artist-flood-fill
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
789 nil)))))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
790
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
791 (menu
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
792 ("Settings"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
793 ((function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
794 ("Set Fill" set-fill artist-select-fill-char))
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 (function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
797 ("Set Line" set-line artist-select-line-char))
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 (function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
800 ("Set Erase" set-erase artist-select-erase-char))
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 (function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
803 ("Rubber-banding" rubber-band artist-toggle-rubber-banding))
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 (function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
806 ("Trimming" trimming artist-toggle-trim-line-endings))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
807
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
808 (function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
809 ("Borders" borders artist-toggle-borderless-shapes))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
810
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
811 (function-call
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
812 ("Spray-chars" spray-chars artist-select-spray-chars)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
813
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
814 ) ;; end of list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
815
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
816 "Master Table for `artist-mode'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
817 This table is primarily a table over the different graphics operations
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
818 available in artist mode, but it also holds layout information for the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
819 popup menu.
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 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
822 have the layout
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 (TAG INFO-PART)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
825
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
826 There are three kinds of TAG:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
827
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
828 `menu' -- a sub-menu
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
829 `separator' -- produce a separator in the popup menu
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
830 `function-call' -- call a function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
831 `graphics-operation' -- a graphics operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
832
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
833 The layout of the INFO-PART for `menu' is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
834
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
835 (TITLE ((TAG-1 INFO-PART-1) (TAG-2 INFO-PART-2) ...))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
836
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
837 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
838 menu items, each on the general form (TAG INFO-PART).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
839
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
840
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
841 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
842
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
843
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
844 This is the layout of the INFO-PART for `function-call':
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
845
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
846 (KEYWORD SYMBOL FN)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
847
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
848 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
849 SYMBOL is the symbol for the operations.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
850 FN is the function performing the operation. This function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
851 is called with no arguments. Its return value is ignored.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
852
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
853
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
854 The layout of the INFO-PART for `graphics-operation' is
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 (TITLE (UNSHIFTED SHIFTED))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
857
42706
be541feb06cc Fix typo.
Pavel Janík <Pavel@Janik.cz>
parents: 41608
diff changeset
858 TITLE is the title that appears in the popup menu. UNSHIFTED
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
859 and SHIFTED specify for unshifted and shifted operation. Both
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
860 have the form
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
861
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
862 (KEYWORD KEY-SYMBOL MODE-LINE ARROW-PRED ARROW-SET-FN
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
863 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
864
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
865 KEYWORD is a string specifying the name of the shape to draw.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
866 This is used when selecting drawing operation.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
867 KEY-SYMBOL is the key which is used when looking up members
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
868 through the functions `artist-go-get-MEMBER-from-symbol'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
869 and `artist-fc-get-MEMBER-from-symbol'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
870 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
871 the shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
872 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
873 can have arrows. The function is called with no arguments and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
874 must return nil or t.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
875 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
876 Arguments and return values for this funcion are described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
877 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
878 point of the shape is set. Arguments and return values for
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
879 this funcion are described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
880 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
881 the last point is set, but before the filling is done.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
882 Arguments and return values for this funcion are described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
883 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
884 is done. Arguments and return values for this funcion are
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
885 described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
886 DRAW-HOW defines the kind of shape. The kinds of shapes are:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
887 `artist-do-continously' -- Do drawing operation continously,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
888 as long as the mouse button is held down.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
889 `artist-do-poly' -- Do drawing operation many times.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
890 1 -- Do drawing operation only once.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
891 2 -- The drawing operation requires two points.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
892 DRAW-FN is the function to call for drawing. Arguments and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
893 return values for this funcion are described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
894 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
895 If DRAW-HOW is `artist-do-continously':
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 (INTERVAL-FN)
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 INTERVAL-FN is, if non-nil, a function to call for getting
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
900 an interval between repeated calls to the DRAW-FN.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
901 This function is called with no arguments and must
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
902 return a number, the interval in seconds.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
903 If nil, calls to DRAW-FN are done only when the mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
904 or cursor is moved.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
905
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
906 If DRAW-HOW is either `artist-do-poly' or 2:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
907
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
908 (UNDRAW-FN FILL-PRED FILL-FN)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
909
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
910 UNDRAW-FN is a function to call for undrawing the shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
911 Arguments and return values for this funcion are
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
912 described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
913 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
914 can have arrows. The function must take no arguments and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
915 return nil or t.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
916 FILL-FN is a function to call for filling the shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
917 Arguments and return values for this funcion are
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
918 described below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
919
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
920 If DRAW-HOW is 1:
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 ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
923
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
924 Note! All symbols and keywords (both in the `funcion-call' INFO-PART
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
925 as well as in the `graphics-operation' INFO-PART) must be unique.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
926
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
927 The following table describe function arguments and return value
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
928 for different functions and DRAW-HOWs.
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 If DRAW-HOW is either `artist-do-continously' or 1:
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 INIT-FN X Y ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
933 PREP-FILL-FN X Y ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
934 EXIT-FN X Y ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
935 ARROW-SET-FN X Y ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
936 DRAW-FN X Y ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
937
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
938 If DRAW-HOW is 2:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
939
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
940 INIT-FN X1 Y1 ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
941 PREP-FILL-FN X1 Y1 X2 Y2 ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
942 EXIT-FN X1 Y1 X2 Y2 ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
943 ARROW-SET-FN X1 Y1 X2 Y2 ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
944 DRAW-FN X1 Y1 X2 Y2 ==> (ENDPOINT-1 ENDPOINT-2 SHAPE)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
945 UNDRAW-FN (ENDPOINT-1 ENDPOINT-2 SHAPE) ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
946 FILL-FN (ENDPOINT-1 ENDPOINT-2 SHAPE) X1 Y1 X2 Y2 ==> ignored
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
947
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
948 ENDPOINT-1 and ENDPOINT-2 are endpoints which are created with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
949 `artist-make-endpoint'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
950 SHAPE is an opaque structure, created by the DRAW-FN and intented
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
951 to be used only by the UNDRAW-FN.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
952
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
953 If DRAW-HOW is `artist-do-poly':
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 INIT-FN X1 Y1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
956 PREP-FILL-FN POINT-LIST
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
957 ARROW-SET-FN POINT-LIST
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
958 EXIT-FN POINT-LIST
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
959 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
960 UNDRAW-FN (ENDPOINT-1 ENDPOINT-2 SHAPE)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
961 FILL-FN POINT-LIST
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
962
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
963 ENDPOINT-1 and ENDPOINT-2 are endpoints which are created with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
964 `artist-make-endpoint'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
965 SHAPE is an opaque structure, created by the DRAW-FN and intented
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
966 to be used only by the UNDRAW-FN.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
967 POINT-LIST is a list of vectors [X Y].")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
968
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
969
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
970 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
971 ;; Accessors for the master table
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
972 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
973
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
974 (defun artist-mt-get-tag (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
975 "Retrieve the tag component from the master table ELEMENT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
976 (elt element 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
977
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
978 (defun artist-mt-get-info-part (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
979 "Retrieve the info part component from the master table ELEMENT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
980 (elt element 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
981
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
982 ;; For the 'graphics-operation info-parts
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
983 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
984 (defsubst artist-go-get-desc (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
985 "Retrieve the description component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
986 (elt info-part 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
987
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
988 (defsubst artist-go-get-unshifted (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
989 "Retrieve the unshifted info from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
990 (elt (elt info-part 1) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
991
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
992 (defsubst artist-go-get-shifted (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
993 "Retrieve the shifted info from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
994 (elt (elt info-part 1) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
995
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
996 (defsubst artist-go-get-keyword (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
997 "Retrieve the keyword component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
998 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
999 (elt info-variant-part 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1000
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1001 (defsubst artist-go-get-symbol (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1002 "Retrieve the symbol component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1003 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
1004 (elt info-variant-part 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1005
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1006 (defsubst artist-go-get-mode-line (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1007 "Retrieve the mode line component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1008 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
1009 (elt info-variant-part 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1010
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1011 (defsubst artist-go-get-arrow-pred (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1012 "Retrieve the arrow predicate component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1013 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
1014 (elt info-variant-part 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1015
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1016 (defsubst artist-go-get-arrow-set-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1017 "Retrieve the arrow set component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1018 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
1019 (elt info-variant-part 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1020
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1021 (defsubst artist-go-get-init-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1022 "Retrieve the init function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1023 An INFO-VARIANT-PART is the shifted or unshifted info from a info-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1024 (elt info-variant-part 5))
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-prep-fill-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1027 "Retrieve the fill preparation 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 (elt info-variant-part 6))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1030
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1031 (defsubst artist-go-get-exit-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1032 "Retrieve the exit component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1033 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
1034 (elt info-variant-part 7))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1035
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1036 (defsubst artist-go-get-draw-how (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1037 "Retrieve the draw how component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1038 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
1039 (elt info-variant-part 8))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1040
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1041 (defsubst artist-go-get-draw-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1042 "Retrieve the draw function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1043 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
1044 (elt info-variant-part 9))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1045
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1046 (defsubst artist-go-get-undraw-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1047 "Retrieve the undraw function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1048 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
1049 This interval function component is available only if the `draw-how'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1050 component is other than `artist-do-continously' or 1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1051 (elt (elt info-variant-part 10) 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-go-get-interval-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1054 "Retrieve the interval function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1055 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
1056 This interval function component is available only if the `draw-how'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1057 component is `artist-do-continously'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1058 (elt (elt info-variant-part 10) 0))
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 (defsubst artist-go-get-fill-pred (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1061 "Retrieve the fill predicate component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1062 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
1063 This interval function component is available only if the `draw-how'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1064 component is other than `artist-do-continously' or 1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1065 (elt (elt info-variant-part 10) 1))
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 (defsubst artist-go-get-fill-fn (info-variant-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1068 "Retrieve the fill function component from an INFO-VARIANT-PART.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1069 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
1070 This interval function component is available only if the `draw-how'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1071 component is other than `artist-do-continously' or 1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1072 (elt (elt info-variant-part 10) 2))
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 ;; For the 'function-call info-parts
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 (defsubst artist-fc-get-keyword (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1077 "Retrieve the keyword component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1078 (elt info-part 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1079
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1080 (defsubst artist-fc-get-symbol (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1081 "Retrieve the symbol component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1082 (elt info-part 1))
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 (defsubst artist-fc-get-fn (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1085 "Retrieve the function component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1086 (elt info-part 2))
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 ;; For the 'menu info-parts
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 (defsubst artist-mn-get-title (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1091 "Retrieve the title component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1092 (elt info-part 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1093
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1094 (defsubst artist-mn-get-items (info-part)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1095 "Retrieve the items component from a graphics operation INFO-PART."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1096 (elt info-part 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1097
59223
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1098 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1099 ;; mouse wheel cyclic operation selection
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1100
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1101 (defun artist-get-last-non-nil-op (op-list &optional last-non-nil)
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1102 "Find the last non-nil draw operation in OP-LIST.
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1103 Optional LAST-NON-NIL will be returned if OP-LIST is nil."
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1104 (if op-list
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1105 (artist-get-last-non-nil-op (cdr op-list)
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1106 (or (car (car op-list)) last-non-nil))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1107 last-non-nil))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1108
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1109 (defun artist-get-first-non-nil-op (op-list)
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1110 "Find the first non-nil draw operation in OP-LIST."
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1111 (or (car (car op-list)) (artist-get-first-non-nil-op (cdr op-list))))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1112
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1113 (defun artist-is-in-op-list-p (op op-list)
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1114 "Check whether OP is in OP-LIST."
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1115 (and op-list
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1116 (or (and (car (car op-list)) (string= op (car (car op-list))))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1117 (artist-is-in-op-list-p op (cdr op-list)))))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1118
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1119 (defun artist-make-prev-next-op-alist (op-list
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1120 &optional
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1121 last-non-nil-arg first-non-nil-arg
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1122 prev-entry prev-op-arg)
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1123 "Build an assoc-list of OP-LIST.
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1124 The arguments LAST-NON-NIL-ARG, FIRST-NON-NIL-ARG, PREV-ENTRY and
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1125 PREV-OP-ARG are used when invoked recursively during the build-up."
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1126 (let* ((last-non-nil (or last-non-nil-arg
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1127 (artist-get-last-non-nil-op
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1128 artist-key-compl-table)))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1129 (first-non-nil (or first-non-nil-arg
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1130 (artist-get-first-non-nil-op
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1131 artist-key-compl-table)))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1132 (prev-op (or prev-op-arg last-non-nil))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1133 (op (car (car op-list)))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1134 (opsym (artist-mt-get-symbol-from-keyword op))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1135 (entry (cons opsym (cons prev-op nil))))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1136 (if (or (and op-list (not op))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1137 (artist-is-in-op-list-p op (cdr op-list)))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1138 (artist-make-prev-next-op-alist (cdr op-list)
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1139 last-non-nil first-non-nil
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1140 prev-entry prev-op)
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1141 (if prev-entry (setcdr (cdr prev-entry) op))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1142 (if op-list
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1143 (cons entry (artist-make-prev-next-op-alist
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1144 (cdr op-list)
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1145 last-non-nil first-non-nil
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1146 entry op))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1147 (progn (setcdr (cdr prev-entry) first-non-nil) nil)))))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1148
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1149 (defun artist-select-next-op-in-list ()
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1150 "Cyclically select next drawing mode operation."
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1151 (interactive)
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1152 (let ((next-op (cdr (cdr (assoc artist-curr-go artist-prev-next-op-alist)))))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1153 (artist-select-operation next-op)
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1154 (message next-op)))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1155
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1156 (defun artist-select-prev-op-in-list ()
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1157 "Cyclically select previous drawing mode operation."
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1158 (interactive)
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1159 (let ((prev-op (car (cdr (assoc artist-curr-go artist-prev-next-op-alist)))))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1160 (artist-select-operation prev-op)
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1161 (message prev-op)))
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1162
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1163 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1164
33618
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 ;;; The artist-mode
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
33653
55d418b6992e (artist-mode): Fix autoload cookie.
Gerd Moellmann <gerd@gnu.org>
parents: 33618
diff changeset
1169 ;;;###autoload
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1170 (defun artist-mode (&optional state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1171 "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
1172 Artist lets you draw lines, squares, rectangles and poly-lines, ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1173 and circles with your mouse and/or keyboard.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1174
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1175 How to quit artist mode
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1176
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1177 Type \\[artist-mode-off] to quit artist-mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1178
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 How to submit a bug report
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 Type \\[artist-submit-bug-report] to submit a bug report.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1183
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1184
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1185 Drawing with the mouse:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1186
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1187 mouse-2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1188 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
1189 mouse-1, and where you can do some settings (described
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1190 below).
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 mouse-1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1193 shift mouse-1 Draws lines, rectangles or poly-lines, erases, cuts, copies
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1194 or pastes:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1195
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1196 Operation Not shifted Shifted
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 Pen fill-char at point line from last point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1199 to new point
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 Line Line in any direction Straight line
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 Rectangle Rectangle Square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1204 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1205 Poly-line Poly-line in any dir Straight poly-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1206 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1207 Ellipses Ellipses Circles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1208 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1209 Text Text (see thru) Text (overwrite)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1210 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1211 Spray-can Spray-can Set size for spray
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1212 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1213 Erase Erase character Erase rectangle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1214 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1215 Vaporize Erase single line Erase connected
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1216 lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1217 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1218 Cut Cut rectangle Cut square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1219 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1220 Copy Copy rectangle Copy square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1221 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1222 Paste Paste Paste
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 Flood-fill Flood-fill Flood-fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1225 --------------------------------------------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1226
37825
8968ceca1581 (artist-mode): Fix a typo. From Pavel Janik <Pavel@Janik.cz>.
Eli Zaretskii <eliz@gnu.org>
parents: 34903
diff changeset
1227 * Straight lines can only go horizontally, vertically
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1228 or diagonally.
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 * Poly-lines are drawn while holding mouse-1 down. When you
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1231 release the button, the point is set. If you want a segment
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1232 to be straight, hold down shift before pressing the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1233 mouse-1 button. Click mouse-2 or mouse-3 to stop drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1234 poly-lines.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1235
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1236 * See thru for text means that text already in the buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1237 will be visible through blanks in the text rendered, while
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1238 overwrite means the opposite.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1239
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1240 * Vaporizing connected lines only vaporizes lines whose
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1241 _endpoints_ are connected. See also the variable
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1242 `artist-vaporize-fuzziness'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1243
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1244 * Cut copies, then clears the rectangle/square.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1245
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1246 * When drawing lines or poly-lines, you can set arrows.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1247 See below under ``Arrows'' for more info.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1248
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1249 * The mode line shows the currently selected drawing operation.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1250 In addition, if it has an asterisk (*) at the end, you
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1251 are currently drawing something.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1252
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1253 * Be patient when flood-filling -- large areas take quite
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1254 some time to fill.
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1257 mouse-3 Erases character under pointer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1258 shift mouse-3 Erases rectangle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1259
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1260
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1261 Settings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1262
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1263 Set fill Sets the character used when filling rectangles/squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1264
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1265 Set line Sets the character used when drawing lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1266
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1267 Erase char Sets the character used when erasing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1268
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1269 Rubber-banding Toggles rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1270
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1271 Trimming Toggles trimming of line-endings (that is: when the shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1272 is drawn, extraneous white-space at end of lines is removed)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1273
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1274 Borders Toggles the drawing of line borders around filled shapes.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1275
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1276
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1277 Drawing with keys
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 \\[artist-key-set-point] Does one of the following:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1280 For lines/rectangles/squares: sets the first/second endpoint
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1281 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
1282 When erase characters: toggles erasing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1283 When cutting/copying: Sets first/last endpoint of rect/square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1284 When pasting: Pastes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1285
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1286 \\[artist-select-operation] Selects what to draw
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1287
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1288 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
1289
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1290 \\[artist-select-fill-char] Sets the charater to use when filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1291 \\[artist-select-line-char] Sets the charater to use when drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1292 \\[artist-select-erase-char] Sets the charater to use when erasing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1293 \\[artist-toggle-rubber-banding] Toggles rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1294 \\[artist-toggle-trim-line-endings] Toggles trimming of line-endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1295 \\[artist-toggle-borderless-shapes] Toggles borders on drawn shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1296
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1297
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1298 Arrows
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1299
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1300 \\[artist-toggle-first-arrow] Sets/unsets an arrow at the beginning
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1301 of the line/poly-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1302
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1303 \\[artist-toggle-second-arrow] Sets/unsets an arrow at the end
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1304 of the line/poly-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1305
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1306
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1307 Selecting operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1308
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1309 There are some keys for quickly selecting drawing operations:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1310
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1311 \\[artist-select-op-line] Selects drawing lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1312 \\[artist-select-op-straight-line] Selects drawing straight lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1313 \\[artist-select-op-rectangle] Selects drawing rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1314 \\[artist-select-op-square] Selects drawing squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1315 \\[artist-select-op-poly-line] Selects drawing poly-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1316 \\[artist-select-op-straight-poly-line] Selects drawing straight poly-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1317 \\[artist-select-op-ellipse] Selects drawing ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1318 \\[artist-select-op-circle] Selects drawing circles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1319 \\[artist-select-op-text-see-thru] Selects rendering text (see thru)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1320 \\[artist-select-op-text-overwrite] Selects rendering text (overwrite)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1321 \\[artist-select-op-spray-can] Spray with spray-can
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1322 \\[artist-select-op-spray-set-size] Set size for the spray-can
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1323 \\[artist-select-op-erase-char] Selects erasing characters
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1324 \\[artist-select-op-erase-rectangle] Selects erasing rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1325 \\[artist-select-op-vaporize-line] Selects vaporizing single lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1326 \\[artist-select-op-vaporize-lines] Selects vaporizing connected lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1327 \\[artist-select-op-cut-rectangle] Selects cutting rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1328 \\[artist-select-op-copy-rectangle] Selects copying rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1329 \\[artist-select-op-paste] Selects pasting
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1330 \\[artist-select-op-flood-fill] Selects flood-filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1331
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1332
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1333 Variables
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1334
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1335 This is a brief overview of the different varaibles. For more info,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1336 see the documentation for the variables (type \\[describe-variable] <variable> RET).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1337
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1338 artist-rubber-banding Interactively do rubber-banding or not
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1339 artist-first-char What to set at first/second point...
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1340 artist-second-char ...when not rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1341 artist-interface-with-rect If cut/copy/paste should interface with rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1342 artist-arrows The arrows to use when drawing arrows
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1343 artist-aspect-ratio Character height-to-width for squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1344 artist-trim-line-endings Trimming of line endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1345 artist-flood-fill-right-border Right border when flood-filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1346 artist-flood-fill-show-incrementally Update display while filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1347 artist-pointer-shape Pointer shape to use while drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1348 artist-ellipse-left-char Character to use for narrow ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1349 artist-ellipse-right-char Character to use for narrow ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1350 artist-borderless-shapes If shapes should have borders
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1351 artist-picture-compatibility Whether or not to be picture mode compatible
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1352 artist-vaporize-fuzziness Tolerance when recognizing lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1353 artist-spray-interval Seconds between repeated sprayings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1354 artist-spray-radius Size of the spray-area
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1355 artist-spray-chars The spray-``color''
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1356 artist-spray-new-chars Initial spray-``color''
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1357
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1358 Hooks
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1359
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1360 When entering artist-mode, the hook `artist-mode-init-hook' is called.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1361 When quitting artist-mode, the hook `artist-mode-exit-hook' is called.
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 Keymap summary
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1365
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1366 \\{artist-mode-map}"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1367 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1368 (if (setq artist-mode
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1369 (if (null state) (not artist-mode)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1370 (> (prefix-numeric-value state) 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1371 (artist-mode-init)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1372 (artist-mode-exit)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1373
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1374 ;; insert our minor mode string
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1375 (or (assq 'artist-mode minor-mode-alist)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1376 (setq minor-mode-alist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1377 (cons '(artist-mode artist-mode-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1378 minor-mode-alist)))
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 ;; insert our minor mode keymap
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1381 (or (assq 'artist-mode minor-mode-map-alist)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1382 (setq minor-mode-map-alist
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1383 (cons (cons 'artist-mode artist-mode-map)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1384 minor-mode-map-alist)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1385
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 ;; Init and exit
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1388 (defun artist-mode-init ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1389 "Init Artist mode. This will call the hook `artist-mode-init-hook'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1390 (let ((i 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1391 (while (< i 256)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1392 (aset artist-replacement-table i i)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1393 (setq i (1+ i))))
65260
c1dcf33345ab (x-pointer-crosshair): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 64751
diff changeset
1394 (aset artist-replacement-table ?\n ?\s)
c1dcf33345ab (x-pointer-crosshair): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 64751
diff changeset
1395 (aset artist-replacement-table ?\t ?\s)
c1dcf33345ab (x-pointer-crosshair): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 64751
diff changeset
1396 (aset artist-replacement-table 0 ?\s)
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1397 (make-local-variable 'artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1398 (make-local-variable 'artist-key-endpoint1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1399 (make-local-variable 'artist-key-poly-point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1400 (make-local-variable 'artist-key-shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1401 (make-local-variable 'artist-key-draw-how)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1402 (make-local-variable 'artist-popup-menu-table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1403 (make-local-variable 'artist-key-compl-table)
59223
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1404 (make-local-variable 'artist-prev-next-op-alist)
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1405 (make-local-variable 'artist-rb-save-data)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1406 (make-local-variable 'artist-arrow-point-1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1407 (make-local-variable 'artist-arrow-point-2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1408 (setq artist-key-is-drawing nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1409 (setq artist-key-endpoint1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1410 (setq artist-key-poly-point-list nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1411 (setq artist-key-shape nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1412 (setq artist-popup-menu-table (artist-compute-popup-menu-table artist-mt))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1413 (setq artist-key-compl-table (artist-compute-key-compl-table artist-mt))
59223
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1414 (setq artist-prev-next-op-alist
f467c038c83e (artist-version): 1.2.6
Richard M. Stallman <rms@gnu.org>
parents: 55793
diff changeset
1415 (artist-make-prev-next-op-alist artist-key-compl-table))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1416 (setq artist-rb-save-data (make-vector 7 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1417 (setq artist-arrow-point-1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1418 (setq artist-arrow-point-2 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1419 (make-local-variable 'next-line-add-newlines)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1420 (setq next-line-add-newlines t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1421 (setq artist-key-draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1422 (artist-go-get-draw-how-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1423 (if (and artist-picture-compatibility (not (eq major-mode 'picture-mode)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1424 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1425 (picture-mode)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1426 (message "")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1427 (run-hooks 'artist-mode-init-hook)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1428 (artist-mode-line-show-curr-operation artist-key-is-drawing))
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 (defun artist-mode-exit ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1431 "Exit Artist mode. This will call the hook `artist-mode-exit-hook'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1432 (if (and artist-picture-compatibility (eq major-mode 'picture-mode))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1433 (picture-mode-exit))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1434 (kill-local-variable 'next-line-add-newlines)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1435 (run-hooks 'artist-mode-exit-hook))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1436
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1437 (defun artist-mode-off ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1438 "Turn Artist mode off."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1439 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1440 (artist-mode -1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1441 (force-mode-line-update))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1442
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1443 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1444 ;; General routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1445 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1446
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1447 (defun artist-update-display ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1448 "Repaint the display."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1449 (sit-for 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1450
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1451 (defun artist-mode-line-show-curr-operation (is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1452 "Show current operation in mode-line. If IS-DRAWING, show that."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1453 (let ((mtext (concat artist-mode-name "/"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1454 (artist-go-get-mode-line-from-symbol artist-curr-go)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1455 (if is-drawing "/*" ""))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1456 (setcdr (assq 'artist-mode minor-mode-alist) (list mtext)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1457 (force-mode-line-update))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1460 (defun artist-t-if-fill-char-set ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1461 "Return the value of the variable `artist-fill-char-set'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1462 artist-fill-char-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1463
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1464 (defun artist-t ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1465 "Always return t."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1466 t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1467
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1468 (defun artist-nil ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1469 "Always return nil."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1470 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1471
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1472 (defun artist-arrows ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1473 "Say yes to arrows!"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1474 t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1475
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1476 (defun artist-no-arrows ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1477 "Say no to arrows!"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1478 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1479
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1480 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1481 ;; Auxiliary init-routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1482 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1483
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 ; Computing the table for the x-popup-menu from the master table
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1486 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1487
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1488 (defun artist-compute-popup-menu-table (menu-table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1489 "Create a menu from from MENU-TABLE data.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1490 The returned value is suitable for the `x-popup-menu' function."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1491 (cons "Artist menu"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1492 (artist-compute-popup-menu-table-sub menu-table)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1493
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1494 (defun artist-compute-popup-menu-table-sub (menu-table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1495 "Compute operation table suitable for `x-popup-menu' from MENU-TABLE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1496 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1497 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1498 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1499 (cond ((eq element-tag 'graphics-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1500 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1501 (descr (artist-go-get-desc info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1502 (unshifted (artist-go-get-unshifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1503 (symbol (artist-go-get-symbol unshifted)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1504 (list descr 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 ((eq element-tag 'function-call)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1507 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1508 (keyword (artist-fc-get-keyword info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1509 (symbol (artist-fc-get-symbol info-part)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1510 (list keyword symbol)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1511
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1512 ((eq element-tag 'separator)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1513 '("" ""))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1514
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1515 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1516 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1517 (title (artist-mn-get-title info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1518 (items (artist-mn-get-items info-part)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1519 (cons title (artist-compute-popup-menu-table-sub items))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1520
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1521 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1522 (error "Internal error: unknown element-tag: \"%s\""
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1523 element-tag)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1524 menu-table))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1525
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1526 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1527 ; Computing the completion table from the master table
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1528 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1529
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1530 (defun artist-compute-key-compl-table (menu-table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1531 "Compute completion table from MENU-TABLE, suitable for `completing-read'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1532 (apply
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1533 'nconc
59224
0bedd71fb49f (artist-butlast-fn): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents: 59223
diff changeset
1534 (remq nil
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1535 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1536 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1537 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1538 (cond ((eq element-tag 'graphics-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1539 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1540 (unshifted (artist-go-get-unshifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1541 (shifted (artist-go-get-shifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1542 (unshifted-kwd (artist-go-get-keyword unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1543 (shifted-kwd (artist-go-get-keyword shifted)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1544 (list (list unshifted-kwd) (list shifted-kwd))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1545 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1546 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1547 (items (artist-mn-get-items info-part)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1548 (artist-compute-key-compl-table items)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1549 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1550 nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1551 menu-table))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1552
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1553
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1554 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1555 ; Retrieving a symbol (graphics operation or function-call) from a keyword
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1556 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1557
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1558 (defun artist-mt-get-symbol-from-keyword (kwd)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1559 "Search master table for keyword KWD and return its symbol."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1560 (artist-mt-get-symbol-from-keyword-sub artist-mt kwd))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1561
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1562 (defun artist-mt-get-symbol-from-keyword-sub (table kwd)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1563 "Search TABLE for keyword KWD and return its symbol."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1564 (catch 'found
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1565 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1566 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1567 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1568 (cond ((eq element-tag 'graphics-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1569 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1570 (unshifted (artist-go-get-unshifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1571 (shifted (artist-go-get-shifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1572 (unshifted-kwd (artist-go-get-keyword unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1573 (shifted-kwd (artist-go-get-keyword shifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1574 (unshifted-sym (artist-go-get-symbol unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1575 (shifted-sym (artist-go-get-symbol shifted)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1576 (if (string-equal kwd unshifted-kwd)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1577 (throw 'found unshifted-sym))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1578 (if (string-equal kwd shifted-kwd)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1579 (throw 'found shifted-sym))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1580
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1581 ((eq element-tag 'function-call)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1582 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1583 (keyword (artist-fc-get-keyword info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1584 (symbol (artist-fc-get-symbol info-part)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1585 (if (string-equal kwd keyword)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1586 (throw 'found symbol))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1587 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1588 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1589 (items (artist-mn-get-items info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1590 (answer (artist-mt-get-symbol-from-keyword-sub
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1591 items kwd)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1592 (if answer (throw 'found answer))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1593 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1594 nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1595 table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1596 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1597
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1598
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1599 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1600 ; Retrieving info from a graphics operation symbol
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1603 (defun artist-go-retrieve-from-symbol (symbol retrieve-fn)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1604 "Search the master table for a graphics operation SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1605 Calls RETRIEVE-FN to retrieve information from that symbol's
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1606 info-variant-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1607 (artist-go-retrieve-from-symbol-sub artist-mt symbol retrieve-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1608
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1609 (defun artist-go-retrieve-from-symbol-sub (table symbol retrieve-fn)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1610 "Search the TABLE for a graphics operation SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1611 Calls RETRIEVE-FN to retrieve information from that symbol's
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1612 info-variant-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1613 (catch 'found
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1614 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1615 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1616 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1617 (cond ((eq element-tag 'graphics-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1618 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1619 (unshifted (artist-go-get-unshifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1620 (shifted (artist-go-get-shifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1621 (unshifted-sym (artist-go-get-symbol unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1622 (shifted-sym (artist-go-get-symbol shifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1623 (variant-part (cond
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1624 ((eq unshifted-sym symbol) unshifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1625 ((eq shifted-sym symbol) shifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1626 (t nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1627 (if variant-part ; if found do:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1628 (throw 'found (funcall retrieve-fn variant-part)))))
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 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1631 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1632 (items (artist-mn-get-items info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1633 (answer (artist-go-retrieve-from-symbol-sub
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1634 items symbol retrieve-fn)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1635 (if answer (throw 'found answer)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1636
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1637 table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1638 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1639
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1640 (defun artist-go-get-keyword-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1641 "Search the master table, get keyword from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1642 (artist-go-retrieve-from-symbol symbol 'artist-go-get-keyword))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1643
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1644 (defun artist-go-get-mode-line-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1645 "Search the master table, get mode-line from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1646 (artist-go-retrieve-from-symbol symbol 'artist-go-get-mode-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1647
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1648 (defun artist-go-get-arrow-pred-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1649 "Search the master table, get arrow-pred from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1650 (artist-go-retrieve-from-symbol symbol 'artist-go-get-arrow-pred))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1651
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1652 (defun artist-go-get-arrow-set-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1653 "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
1654 (artist-go-retrieve-from-symbol symbol 'artist-go-get-arrow-set-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1655
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1656 (defun artist-go-get-init-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1657 "Search the master table, get init-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1658 (artist-go-retrieve-from-symbol symbol 'artist-go-get-init-fn))
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 (defun artist-go-get-prep-fill-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1661 "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
1662 (artist-go-retrieve-from-symbol symbol 'artist-go-get-prep-fill-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1663
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1664 (defun artist-go-get-exit-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1665 "Search the master table, get exit-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1666 (artist-go-retrieve-from-symbol symbol 'artist-go-get-exit-fn))
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 (defun artist-go-get-draw-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1669 "Search the master table, get draw-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1670 (artist-go-retrieve-from-symbol symbol 'artist-go-get-draw-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1671
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1672 (defun artist-go-get-draw-how-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1673 "Search the master table, get draw-how from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1674 (artist-go-retrieve-from-symbol symbol 'artist-go-get-draw-how))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1675
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1676 (defun artist-go-get-undraw-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1677 "Search the master table, get undraw-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1678 (artist-go-retrieve-from-symbol symbol 'artist-go-get-undraw-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1679
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1680 (defun artist-go-get-interval-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1681 "Search the master table, get interval-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1682 (artist-go-retrieve-from-symbol symbol 'artist-go-get-interval-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1683
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1684 (defun artist-go-get-fill-pred-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1685 "Search the master table, get fill-pred from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1686 (artist-go-retrieve-from-symbol symbol 'artist-go-get-fill-pred))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1687
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1688 (defun artist-go-get-fill-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1689 "Search the master table, get fill-fn from a graphics operation SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1690 (artist-go-retrieve-from-symbol symbol 'artist-go-get-fill-fn))
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-go-get-symbol-shift (symbol is-shifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1693 "Search for (shifted or unshifted) graphics operation SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1694 If IS-SHIFTED is non-nil, return the shifted symbol,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1695 otherwise the shifted symbol."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1696 (artist-go-get-symbol-shift-sub artist-mt symbol is-shifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1697
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1698 (defun artist-go-get-symbol-shift-sub (table symbol is-shifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1699 "Search TABLE for (shifted or unshifted) graphics SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1700 If IS-SHIFTED is non-nil, return the shifted symbol,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1701 otherwise the shifted symbol."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1702 (catch 'found
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1703 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1704 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1705 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1706 (cond ((eq element-tag 'graphics-operation)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1707 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1708 (unshift-variant (artist-go-get-unshifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1709 (shift-variant (artist-go-get-shifted info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1710 (unshift-sym (artist-go-get-symbol unshift-variant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1711 (shift-sym (artist-go-get-symbol shift-variant)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1712 (if (or (eq symbol unshift-sym) (eq symbol shift-sym))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1713 (throw 'found (if is-shifted shift-sym unshift-sym)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1714
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1715 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1716 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1717 (items (artist-mn-get-items info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1718 (answer (artist-go-get-symbol-shift-sub
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1719 items symbol is-shifted)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1720 (if answer (throw 'found answer)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1721
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1722 table)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1723 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1724
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1725 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1726 ; Retrieving info from a function-call symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1727 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1728
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1729 (defun artist-fc-retrieve-from-symbol (symbol retrieve-fn)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1730 "Search the master table for a function call SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1731 Calls RETRIEVE-FN to retrieve information from that symbol's
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1732 info-variant-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1733 (artist-fc-retrieve-from-symbol-sub artist-mt symbol retrieve-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1734
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1735 (defun artist-fc-retrieve-from-symbol-sub (table symbol retrieve-fn)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1736 "Search TABLE for a function-call SYMBOL.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1737 Calls RETRIEVE-FN to retrieve information from that symbol's
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1738 info-variant-part."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1739 (catch 'found
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1740 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1741 (lambda (element)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1742 (let ((element-tag (artist-mt-get-tag element)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1743 (cond ((eq element-tag 'function-call)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1744 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1745 (fc-symbol (artist-fc-get-symbol info-part)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1746 (if (eq fc-symbol symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1747 (throw 'found (funcall retrieve-fn info-part)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1748
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1749 ((eq element-tag 'menu)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1750 (let* ((info-part (artist-mt-get-info-part element))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1751 (items (artist-mn-get-items info-part))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1752 (answer (artist-fc-retrieve-from-symbol-sub
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1753 items symbol retrieve-fn)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1754 (if answer (throw 'found answer)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1755
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1756 table)
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1759 (defun artist-fc-get-fn-from-symbol (symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1760 "Search the master table to get function from a function call SYMBOL."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1761 (artist-fc-retrieve-from-symbol symbol 'artist-fc-get-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1762
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1763
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1764 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1765 ;; Utilities
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1768 ;; Macro that won't funcall the function if it is nil.
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 (defmacro artist-funcall (fn &rest args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1771 "Call function FN with ARGS iff FN is not nil."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1772 (list 'if fn (cons 'funcall (cons fn args))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1773
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1774 (defun artist-uniq (l)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1775 "Remove consecutive duplicates in list L. Comparison is done with `equal'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1776 (cond ((null l) nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1777 ((null (cdr l)) l) ; only one element in list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1778 ((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
1779 (t (cons (car l) (artist-uniq (cdr l)))))) ; first 2 are different
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1780
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1781 (defun artist-string-split (str r)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1782 "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
1783 (let ((res nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1784 (start 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1785 (match-pos 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1786 (while (setq match-pos (string-match r str start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1787 (setq res (cons (copy-sequence (substring str start match-pos)) res))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1788 (setq start (match-end 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1789 (if (null res)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1790 (list str)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1791 (if (< (match-end 0) (- (length str) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1792 (setq res (cons (substring str (match-end 0) (length str)) res)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1793 (reverse res))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1794
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1795 (defun artist-string-to-file (str file-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1796 "Write string STR to file FILE-NAME."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1797 (write-region str 'end-is-ignored file-name nil 'no-message))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1798
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1799 (defun artist-file-to-string (file-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1800 "Read from file FILE-NAME into a string."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1801 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1802 (let ((tmp-buffer (get-buffer-create (concat "*artist-" file-name "*"))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1803 (set-buffer tmp-buffer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1804 (goto-char (point-min))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1805 (insert-file-contents file-name nil nil nil t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1806 (let ((str (copy-sequence (buffer-substring (point-min)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1807 (point-max)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1808 (kill-buffer tmp-buffer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1809 str))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1810
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1811 (defun artist-clear-buffer (buf)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1812 "Clear contents of buffer BUF."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1813 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1814 (set-buffer buf)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1815 (goto-char (point-min))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1816 (delete-char (- (point-max) (point-min)) nil)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1817
47953
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
1818
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1819 (defun artist-system (program stdin &optional program-args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1820 "Run PROGRAM synchronously with the contents of string STDIN to stdin.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1821 Optional args PROGRAM-ARGS are arguments to PROGRAM.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1822 Return a list (RETURN-CODE STDOUT STDERR)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1823 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1824 (let* ((tmp-stdin-file-name (if stdin
43685
498bad2aca78 (artist-system): Use make-temp-file.
Richard M. Stallman <rms@gnu.org>
parents: 42706
diff changeset
1825 (make-temp-file
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1826 (concat (file-name-as-directory
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1827 (or (getenv "TMPDIR") "/tmp"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1828 "artist-stdin."))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1829 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1830 (tmp-stdout-buffer (get-buffer-create
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1831 (concat "*artist-" program "*")))
43685
498bad2aca78 (artist-system): Use make-temp-file.
Richard M. Stallman <rms@gnu.org>
parents: 42706
diff changeset
1832 (tmp-stderr-file-name (make-temp-file
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1833 (concat (file-name-as-directory
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1834 (or (getenv "TMPDIR") "/tmp"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1835 "artist-stdout.")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1836 (binary-process-input nil) ; for msdos
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1837 (binary-process-output nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1838
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1839 ;; Prepare stdin
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1840 (if stdin (artist-string-to-file stdin tmp-stdin-file-name))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1841
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1842 ;; Clear the buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1843 (artist-clear-buffer tmp-stdout-buffer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1844
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1845 ;; Start the program
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1846 (unwind-protect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1847 (let ((res (if program-args
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1848 (apply 'call-process
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1849 program
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1850 tmp-stdin-file-name
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1851 (list tmp-stdout-buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1852 tmp-stderr-file-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1853 nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1854 (if (stringp program-args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1855 (list program-args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1856 program-args))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1857 (apply 'call-process
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1858 program
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1859 tmp-stdin-file-name
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1860 (list tmp-stdout-buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1861 tmp-stderr-file-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1862 nil))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1863
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1864 ;; the return value
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1865 (list res
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1866 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1867 (set-buffer tmp-stdout-buffer)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1868 (copy-sequence (buffer-substring (point-min)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1869 (point-max))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1870 (artist-file-to-string tmp-stderr-file-name)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1871
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1872 ;; Unwind: remove temporary files and buffers
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1873 (if (and stdin (file-exists-p tmp-stdin-file-name))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1874 (delete-file tmp-stdin-file-name))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1875 (if (file-exists-p tmp-stderr-file-name)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1876 (delete-file tmp-stderr-file-name))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1877 (if (memq tmp-stdout-buffer (buffer-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1878 (kill-buffer tmp-stdout-buffer))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1879
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1880 ;; Routines that deal with the buffer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1881 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1882 ;; artist-current-line get line number (top of buffer is 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1883 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1884 ;; 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
1885 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1886 ;; artist-get-char-at-xy get char in at (x,y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1887 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1888 ;; artist-replace-char overwrite (replace) char at point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1889 ;; artist-replace-chars overwrite (replace) chars at point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1890 ;;
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 (defsubst artist-current-column ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1893 "Return point's current column."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1894 (current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1895
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1896 (defsubst artist-current-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1897 "Return point's current line, buffer-relative. Top of buffer is 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1898 (+ (count-lines 1 (point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1899 (if (= (current-column) 0) 1 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1900 -1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1901
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1902 (defsubst artist-move-to-xy (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1903 "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
1904 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1905 ;; Q: Why do we do forward-line twice?
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1906 ;; A: The documentation for forward-line says
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1907 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1908 ;; "... Returns the count of lines left to move. ... With
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1909 ;; positive N, a non-empty line at the end counts as one
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1910 ;; line successfully moved (for the return value)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1911 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1912 ;; 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
1913 ;; of the buffer, and that last line happened to be longer than
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1914 ;; 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
1915 ;; line, and forward-line returns one less than we actually
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1916 ;; wanted to move.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1917 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1918 ;; Example: In the figure below, the `X' is the very last
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1919 ;; character in the buffer ("a non-empty line at the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1920 ;; end"). Suppose point is at at P. Then (forward-line 1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1921 ;; returns 0 and puts point after the `X'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1922 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1923 ;; --------top of buffer--------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1924 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1925 ;; P X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1926 ;; -------bottom of buffer------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1927 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1928 ;; 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
1929 ;; forward, then forward-line will return the (for us) correct
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1930 ;; 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
1931 ;; buffer by the first forward-line. The second forward-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1932 ;; will then get us where we really wanted to go.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1933 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1934 ;; 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
1935 ;; second forward-line will return 0.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1936 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1937 ;; Q: What happens if we are moving upwards?
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1938 ;; A: That will work good. insert-char won't insert a negative
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1939 ;; number of chars, and forward-line will fail silently if we are
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1940 ;; moving past the beginning of the buffer.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1941 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1942 (forward-line (- y (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1943 (insert-char ?\n (forward-line (- y (artist-current-line))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1944 (move-to-column (max x 0) t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1945 (let ((curr-y (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1946 (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
1947 (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
1948
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1949 (defsubst artist-get-char-at-xy (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1950 "Return the character found at column X, row Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1951 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
1952 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1953 (let ((curr-y (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1954 (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
1955 (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
1956 (following-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1957
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1958
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1959 (defun artist-get-char-at-xy-conv (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1960 "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
1961 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1962 (aref artist-replacement-table (artist-get-char-at-xy x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1963
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1964
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1965 (defun artist-replace-char (new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1966 "Replace the character at point with NEW-CHAR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1967 ;; 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
1968 (if (and (and (boundp 'emacs-major-version) (= emacs-major-version 20))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1969 (and (boundp 'emacs-minor-version) (<= emacs-minor-version 3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1970 ;; 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
1971 ;; The self-insert-command doesn't care about the overwrite-mode,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1972 ;; 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
1973 ;; This seems to be a little bit slower.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1974 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1975 (artist-move-to-xy (1+ (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1976 (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1977 (delete-char -1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1978 (insert (aref artist-replacement-table new-char)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1979 ;; In emacs-19, the self-insert-command works better and faster
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1980 (let ((overwrite-mode 'overwrite-mode-textual)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1981 (fill-column 32765) ; Large :-)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1982 (blink-matching-paren nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1983 (setq last-command-event (aref artist-replacement-table new-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1984 (self-insert-command 1))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1985
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1986 (defun artist-replace-chars (new-char count)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1987 "Replace characters at point with NEW-CHAR. COUNT chars are replaced."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1988 ;; 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
1989 (if (and (and (boundp 'emacs-major-version) (= emacs-major-version 20))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1990 (and (boundp 'emacs-minor-version) (<= emacs-minor-version 3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1991 ;; 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
1992 ;; The self-insert-command doesn't care about the overwrite-mode,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1993 ;; 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
1994 ;; This seems to be a little bit slower.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1995 (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
1996 (replaced-s (make-string count replaced-c)))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1997 (artist-move-to-xy (+ (artist-current-column) count)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1998 (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
1999 (delete-char (- count))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2000 (insert replaced-s))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2001 ;; In emacs-19, the self-insert-command works better
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2002 (let ((overwrite-mode 'overwrite-mode-textual)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2003 (fill-column 32765) ; Large :-)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2004 (blink-matching-paren nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2005 (setq last-command-event (aref artist-replacement-table new-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2006 (self-insert-command count))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2007
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2008 (defsubst artist-replace-string (string &optional see-thru)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2009 "Replace contents at point with STRING.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2010 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
2011 ``shines thru'' blanks in the STRING."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2012 (let ((char-list (append string nil)) ; convert the string to a list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2013 (overwrite-mode 'overwrite-mode-textual)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2014 (fill-column 32765) ; Large :-)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2015 (blink-matching-paren nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2016 (while char-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2017 (let ((c (car char-list)))
65260
c1dcf33345ab (x-pointer-crosshair): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 64751
diff changeset
2018 (if (and see-thru (= (aref artist-replacement-table c) ?\s))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2019 (artist-move-to-xy (1+ (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2020 (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2021 (artist-replace-char c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2022 (setq char-list (cdr char-list)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2023
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2024 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2025 ;; Routines for setting and unsetting points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2026 ;; Used when not rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2027 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2028 (defun artist-no-rb-unset-point1 ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2029 "Unsets point 1 when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2030 (let ((x-now (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2031 (y-now (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2032 (x (aref artist-rb-save-data 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2033 (y (aref artist-rb-save-data 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2034 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2035 (artist-replace-char (aref artist-rb-save-data 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2036 (artist-move-to-xy x-now y-now)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2037
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2038 (defun artist-no-rb-set-point1 (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2039 "Set point 1 at X, Y when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2040 (let ((x-now (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2041 (y-now (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2042 (aset artist-rb-save-data 0 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2043 (aset artist-rb-save-data 1 y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2044 (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
2045 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2046 (artist-replace-char artist-first-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2047 (artist-move-to-xy x-now y-now)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2048 (aset artist-rb-save-data 6 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2049
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2050 (defun artist-no-rb-unset-point2 ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2051 "This function unsets point 2 when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2052 (if (= (aref artist-rb-save-data 6) 1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2053 (let ((x-now (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2054 (y-now (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2055 (x (aref artist-rb-save-data 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2056 (y (aref artist-rb-save-data 4)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2057 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2058 (artist-replace-char (aref artist-rb-save-data 5))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2059 (artist-move-to-xy x-now y-now))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2060
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2061 (defun artist-no-rb-set-point2 (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2062 "Set point 2 at X, Y when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2063 (let ((x-now (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2064 (y-now (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2065 (aset artist-rb-save-data 3 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2066 (aset artist-rb-save-data 4 y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2067 (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
2068 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2069 (artist-replace-char artist-second-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2070 (artist-move-to-xy x-now y-now)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2071 (aset artist-rb-save-data 6 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2072
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2073 (defun artist-no-rb-unset-points ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2074 "This function unsets point 1 and 2 when not rubber-banding."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2075 (artist-no-rb-unset-point1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2076 (artist-no-rb-unset-point2))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2079 ;; artist-intersection-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2080 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2081 ;; Note: If changing this, see the notes for artist-unintersection-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2082 ;; and artist-vaporize-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2083 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2084 (defun artist-intersection-char (new-c old-c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2085 "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
2086 Return character according to this scheme:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2087
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2088 OLD-C NEW-C return
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2089 - | +
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2090 | - +
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2091 + | +
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2092 + - +
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2093 \\ / X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2094 / \\ X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2095 X / X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2096 X \\ X
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2097 other combinations NEW-C"
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 (cond ((and (= old-c ?- ) (= new-c ?| )) ?+ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2100 ((and (= old-c ?| ) (= new-c ?- )) ?+ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2101 ((and (= old-c ?+ ) (= new-c ?- )) ?+ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2102 ((and (= old-c ?+ ) (= new-c ?| )) ?+ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2103 ((and (= old-c ?\\ ) (= new-c ?/ )) ?X )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2104 ((and (= old-c ?/ ) (= new-c ?\\ )) ?X )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2105 ((and (= old-c ?X ) (= new-c ?/ )) ?X )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2106 ((and (= old-c ?X ) (= new-c ?\\ )) ?X )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2107 (t new-c)))
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 ;; artist-unintersection-char
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 ;; Note: If changing this, see the note for artist-vaporize-lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2112 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2113 (defun artist-unintersection-char (line-c buffer-c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2114 "Restore character to before intersection when removing LINE-C from BUFFER-C.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2115 Return character according to this scheme:
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 LINE-C BUFFER-C return
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 | + -
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2120 \\ X /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2121 / X \\
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2122 other combinations `artist-erase-char'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2123
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2124 (cond ((and (= line-c ?- ) (= buffer-c ?+ )) ?| )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2125 ((and (= line-c ?| ) (= buffer-c ?+ )) ?- )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2126 ((and (= line-c ?\\ ) (= buffer-c ?X )) ?/ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2127 ((and (= line-c ?/ ) (= buffer-c ?X )) ?\\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2128 ((= line-c buffer-c) artist-erase-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2129 (t buffer-c)))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2132 ;; Computing the line-char to use
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2133 ;; for use with borderless shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2134 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2135 (defsubst artist-compute-line-char ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2136 "Compute which character to use for lines, if any.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2137 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
2138 a character chosen depending on the variables `artist-borderless-shapes',
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2139 `artist-fill-char-set', `artist-fill-char' and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2140 `artist-line-char-set' and `artist-line-char'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2141 (if (and artist-borderless-shapes artist-fill-char-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2142 artist-fill-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2143 (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2144 artist-line-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2145 nil)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2146
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2147
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2148 ;; Things for drawing horizontal, vertical and diagonal (straight) lines.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2149 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2150 ;; A line here is a vector:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2151 ;; [ start-x start-y length direction saved-char-1 saved-char-2 ... ]
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2152 ;; directions start with 0 at the x-axis and counts anti clockwise.
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 (defvar artist-direction-info
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2155 ;; x y char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2156 [ [ 1 0 ?- ] ; direction 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2157 [ 1 1 ?\\ ] ; direction 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2158 [ 0 1 ?| ] ; direction 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2159 [ -1 1 ?/ ] ; direction 3
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2160 [ -1 0 ?- ] ; direction 4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2161 [ -1 -1 ?\\ ] ; direction 5
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2162 [ 0 -1 ?| ] ; direction 6
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2163 [ 1 -1 ?/ ] ] ; direction 7
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2164 "Table used for stepping x and y coordinates in a specific direction.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2165 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
2166
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2167 (defsubst artist-direction-step-x (direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2168 "Return the x-step for DIRECTION from the `artist-direction-info' table."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2169 (aref (aref artist-direction-info direction) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2170
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2171 (defsubst artist-direction-step-y (direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2172 "Return the y-step for DIRECTION from the `artist-direction-info' table."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2173 (aref (aref artist-direction-info direction) 1))
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 (defun artist-direction-char (direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2176 "Return the character for DIRECTION from the `artist-direction-info' table."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2177 (aref (aref artist-direction-info direction) 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2178
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2179 ;; artist-find-direction
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2180 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2181 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2182 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2183 (defun artist-find-direction (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2184 "Find the direction from point X1,Y1 to X2,Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2185 Returns a DIRECTION, a number 0--7, coded as follows:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2186
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2187 5 6 7
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2188 \\ | /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2189 4 - * - 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2190 / | \\
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2191 3 2 1"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2192 (let ((delta-x (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2193 (delta-y (- y2 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2194 (cond ((>= delta-x (* 2 (abs delta-y))) 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2195 ((>= delta-y (* 2 (abs delta-x))) 2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2196 ((>= (- delta-x) (* 2 (abs delta-y))) 4)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2197 ((>= (- delta-y) (* 2 (abs delta-x))) 6)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2198 ((and (>= delta-x 0) (>= delta-y 0)) 1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2199 ((and (<= delta-x 0) (>= delta-y 0)) 3)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2200 ((and (<= delta-x 0) (<= delta-y 0)) 5)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2201 ((and (>= delta-x 0) (<= delta-y 0)) 7))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2202
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2203 (defun artist-straight-calculate-length (direction x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2204 "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
2205 (cond ((or (= direction 7)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2206 (= direction 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2207 (= direction 1)) (1+ (- x2 x1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2208 ((or (= direction 3)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2209 (= direction 4)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2210 (= direction 5)) (1+ (- x1 x2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2211 (t (1+ (abs (- y2 y1))))))
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 (defun artist-sline (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2214 "Create a straight line from X1,Y1 to X2,Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2215 (let* ((direction (artist-find-direction x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2216 (length (artist-straight-calculate-length direction x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2217 (line (make-vector (+ length 4) x1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2218 ;; not needed:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2219 ;; (aset line 0 x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2220 ;; because we set all elements to x1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2221 (aset line 1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2222 (aset line 2 length)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2223 (aset line 3 direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2224 line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2225
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2226 (defun artist-save-chars-under-sline (line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2227 "Save characters under a LINE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2228 (let ((x (aref line 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2229 (y (aref line 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2230 (length (+ (aref line 2) 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2231 (direction (aref line 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2232 (i 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2233 (while (< i length)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2234 (aset line i (artist-get-char-at-xy x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2235 (setq x (+ x (artist-direction-step-x direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2236 (setq y (+ y (artist-direction-step-y direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2237 (setq i (1+ i))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2238 line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2239
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2240
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2241
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2242 ;; Things for drawing lines in all directions.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2243 ;; The line drawing engine is the eight-point alrogithm.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2244 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2245 ;; 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
2246 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2247 (defvar artist-octant-info
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2248 ;; Initial Step in Step in
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2249 ;; coeffs x and y x and y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2250 ;; for if q >= 0 if g < 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2251 ;; dfdx,dfdy
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2252 [ [ 2 1 1 0 1 1 ] ; 1st octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2253 [ 1 2 1 1 0 1 ] ; 2nd octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2254 [ -1 2 0 1 -1 1 ] ; 3rd octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2255 [ -2 1 -1 1 -1 0 ] ; 4th octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2256 [ -2 -1 -1 0 -1 -1 ] ; 5th octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2257 [ -1 -2 -1 -1 0 -1 ] ; 6th octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2258 [ 1 -2 0 -1 1 -1 ] ; 7th octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2259 [ 2 -1 1 -1 1 0 ] ] ; 8th octant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2260 "Table used by line drawing algorithm (eight point).")
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 ;; Primitives for the artist-octant-info.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2263 ;; 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
2264 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2265 (defsubst artist-get-dfdx-init-coeff (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2266 "Retrieve dfdx component for OCTANT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2267 (aref (aref artist-octant-info (- octant 1)) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2268
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2269 (defsubst artist-get-dfdy-init-coeff (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2270 "Retrieve dfdy component for OCTANT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2271 (aref (aref artist-octant-info (- octant 1)) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2272
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2273 (defsubst artist-get-x-step-q>=0 (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2274 "Retrieve x-step component for OCTANT when q >= 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2275 (aref (aref artist-octant-info (- octant 1)) 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2276
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2277 (defsubst artist-get-y-step-q>=0 (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2278 "Retrieve y-step component for OCTANT when q >= 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2279 (aref (aref artist-octant-info (- octant 1)) 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2280
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2281 (defsubst artist-get-x-step-q<0 (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2282 "Retrieve x-step component for OCTANT for q < 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2283 (aref (aref artist-octant-info (- octant 1)) 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2284
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2285 (defsubst artist-get-y-step-q<0 (octant)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2286 "Retrieve y-step component for OCTANT for q < 0."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2287 (aref (aref artist-octant-info (- octant 1)) 5))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2290 ;; Find octant from x1 y1 x2 y2 coordinates.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2291 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2292 (defun artist-find-octant (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2293 "Find octant for a line from X1,Y1 to X2,Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2294 Octant are numbered 1--8, anti-clockwise as:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2295
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2296 \\3|2/
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2297 4\\|/1
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 5/|\\8
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2300 /6|7\\"
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 (if (<= x1 x2) ; quadrant 1 or 4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2303 (if (<= y1 y2) ; quadrant 1, octant 1 or 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2304 (if (>= (- x2 x1) (- y2 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2305 1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2306 2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2307 (if (>= (- x2 x1) (- (- y2 y1))) ; quadrant 4, octant 7 or 8
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2308 8
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2309 7))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2310 (if (<= y1 y2) ; quadrant 2 or 3
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2311 (if (>= (- (- x2 x1)) (- y2 y1)) ; quadrant 2, octant 3 or 4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2312 4
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2313 3)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2314 (if (>= (- (- x2 x1)) (- (- y2 y1))) ; quadrant 3, octant 5 or 6
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2315 5
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2316 6))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2317
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2318 ;; Some inline funtions for creating, setting and reading
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2319 ;; members of a coordinate
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2320 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2321 (defsubst artist-new-coord (x y &optional new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2322 "Create a new coordinate at X,Y for use in a line.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2323 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
2324 in the coord."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2325 (let ((coord (make-vector 4 x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2326 (aset coord 1 y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2327 (aset coord 3 new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2328 coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2329
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2330 (defsubst artist-coord-get-x (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2331 "Retrieve the x component of a COORD."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2332 (aref coord 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2333
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2334 (defsubst artist-coord-get-y (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2335 "Retrieve the y component of a COORD."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2336 (aref coord 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2337
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2338 (defsubst artist-coord-set-x (coord new-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2339 "Set the x component of a COORD to NEW-X."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2340 (aset coord 0 new-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2341 coord)
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 (defsubst artist-coord-set-y (coord new-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2344 "Set the y component of a COORD to NEW-Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2345 (aset coord 1 new-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2346 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2347
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2348 (defsubst artist-coord-get-saved-char (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2349 "Retrieve the saved char component of a COORD."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2350 (aref coord 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2351
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2352 (defsubst artist-coord-get-new-char (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2353 "Retrieve the new char component of a COORD."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2354 (aref coord 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2355
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2356 (defsubst artist-coord-add-saved-char (coord saved-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2357 "Set the saved char component of a COORD to SAVED-CHAR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2358 (aset coord 2 saved-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2359 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2360
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2361 (defsubst artist-coord-add-new-char (coord new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2362 "Set the new char component of a COORD to NEW-CHAR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2363 (aset coord 3 new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2364 coord)
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 (defsubst artist-coord-set-new-char (coord new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2367 "Set the new char component of a COORD to NEW-CHAR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2368 (aset coord 3 new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2369 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2370
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2371
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2372 ;; Pretend we are plotting a pixel. Instead we just list it
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2373 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2374 (defmacro artist-put-pixel (point-list x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2375 "In POINT-LIST, store a ``pixel'' at coord X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2376 (list 'setq point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2377 (list 'append point-list (list 'list (list 'artist-new-coord x y)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2378
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2379 ;; Calculate list of points using eight point algorithm
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2380 ;; return a list of coords
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2381 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2382 (defun artist-eight-point (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2383 "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
2384 (let* ((point-list nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2385 (octant (artist-find-octant x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2386 (dfdx-coeff (artist-get-dfdx-init-coeff octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2387 (dfdy-coeff (artist-get-dfdy-init-coeff octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2388 (x-step-q>=0 (artist-get-x-step-q>=0 octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2389 (y-step-q>=0 (artist-get-y-step-q>=0 octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2390 (x-step-q<0 (artist-get-x-step-q<0 octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2391 (y-step-q<0 (artist-get-y-step-q<0 octant))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2392 (dfdx (- (- y2 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2393 (dfdy (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2394 (x x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2395 (y y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2396 (f 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2397 (q (+ (* 2 f)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2398 (* dfdx-coeff dfdx)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2399 (* dfdy-coeff dfdy))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2400 (artist-put-pixel point-list x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2401 (while (or (not (eq x x2)) (not (eq y y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2402 (if (>= q 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2403 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2404 (setq x (+ x x-step-q>=0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2405 (setq y (+ y y-step-q>=0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2406 (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
2407 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2408 (setq x (+ x x-step-q<0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2409 (setq y (+ y y-step-q<0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2410 (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
2411 (setq q (+ (* 2 f) (* dfdx-coeff dfdx) (* dfdy-coeff dfdy)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2412 (artist-put-pixel point-list x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2413 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2414
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2415 ;; artist-save-chars-under-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2416 ;; Remebers the chars that were there before we did draw the line.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2417 ;; Returns 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 (defun artist-save-chars-under-point-list (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2420 "Save characters originally under POINT-LIST."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2421 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2422 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2423 (artist-coord-add-saved-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2424 coord
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2425 (artist-get-char-at-xy (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2426 (artist-coord-get-y coord))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2427 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2428
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2429 ;; artist-calculate-new-char, artist-calculate-new-chars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2430 ;; Calculates which char to insert depending on direction of point-list.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2431 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2432 ;; 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
2433 ;; following chars are returned: \ | / - o, as indicated by this:
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 ;; \ | /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2436 ;; - o -
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2437 ;; / | \
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2438 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2439 ;; artist-calculate-new-char works on one coordinate, returns char.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2440 ;; artist-calculate-new-chars works on a point-list, returns point-list.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2441 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2442 (defun artist-calculate-new-char (last-coord new-coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2443 "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
2444 (let ((last-x (artist-coord-get-x last-coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2445 (last-y (artist-coord-get-y last-coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2446 (new-x (artist-coord-get-x new-coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2447 (new-y (artist-coord-get-y new-coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2448 (cond ((> new-x last-x) (cond ((< new-y last-y) ?/ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2449 ((> new-y last-y) ?\\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2450 (t ?- )))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2451 ((< new-x last-x) (cond ((< new-y last-y) ?\\ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2452 ((> new-y last-y) ?/ )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2453 (t ?- )))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2454 ((eq new-y last-y) ?o)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2455 (t ?| ))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2456
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2457 (defun artist-calculate-new-chars (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2458 "Return a list of coords with line-chars calculated. Input: POINT-LIST."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2459 (if (null (cdr point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2460 (list (artist-coord-add-new-char (car point-list) ?o ))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2461 (let ((last-coord (car point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2462 (cons (artist-coord-add-new-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2463 (car point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2464 (artist-calculate-new-char (car (cdr point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2465 (car point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2466 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2467 (lambda (this-coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2468 (prog1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2469 (artist-coord-add-new-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2470 this-coord
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2471 (artist-calculate-new-char last-coord this-coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2472 (setq last-coord this-coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2473 (cdr point-list))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2474
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2475 ;; artist-modify-new-chars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2476 ;; Replaces some characters with some other characters.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2477 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2478 ;; artist-modify-new-chars works on a point-list, returns point-list.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2479 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2480 (defun artist-modify-new-chars (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2481 "Replace intersecting characters in POINT-LIST.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2482 This function returns a point-list."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2483 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2484 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2485 (let* ((new-c (artist-coord-get-new-char coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2486 (saved-c (artist-coord-get-saved-char coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2487 (modified-c (artist-intersection-char new-c saved-c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2488 (artist-coord-set-new-char coord modified-c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2489 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2490
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2491
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2492 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2493 ;; functions for accessing endoints and elements in object requiring
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2494 ;; 2 endpoints
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2497 (defun artist-make-endpoint (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2498 "Create an endpoint at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2499 (let ((new-endpoint (make-vector 2 x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2500 (aset new-endpoint 1 y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2501 new-endpoint))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2502
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2503 (defun artist-endpoint-get-x (endpoint)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2504 "Retrieve the x component of an ENDPOINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2505 (aref endpoint 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2506
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2507 (defun artist-endpoint-get-y (endpoint)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2508 "Retrieve the y component of an ENDPOINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2509 (aref endpoint 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2510
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2511 (defun artist-make-2point-object (endpoint1 endpoint2 shapeinfo)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2512 "Create a 2-point object of ENDPOINT1, ENDPOINT2 and SHAPEINFO."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2513 (list endpoint1 endpoint2 shapeinfo))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2514
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2515 (defun artist-2point-get-endpoint1 (obj)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2516 "Retrieve the first endpoint of a 2-point object OBJ."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2517 (elt obj 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2518
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2519 (defun artist-2point-get-endpoint2 (obj)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2520 "Retrieve the second endpoint of a 2-point object OBJ."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2521 (elt obj 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2522
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2523 (defun artist-2point-get-shapeinfo (obj)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2524 "Retrieve the shapeinfo component of a 2-point object OBJ."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2525 (elt obj 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2526
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2527
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2528 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2529 ;; Drawing and undrawing lines (any direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2530 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2531
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2532 (defun artist-draw-line (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2533 "Draws a line from X1, Y1 to X2, Y2.
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 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
2536
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2537 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
2538 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
2539 (let ((endpoint1 (artist-make-endpoint x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2540 (endpoint2 (artist-make-endpoint x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2541 (artist-make-2point-object
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2542 endpoint1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2543 endpoint2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2544 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2545 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2546 (artist-move-to-xy (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2547 (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2548 (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2549 (artist-replace-char artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2550 (artist-replace-char (artist-coord-get-new-char coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2551 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2552 (artist-modify-new-chars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2553 (artist-calculate-new-chars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2554 (artist-save-chars-under-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2555 (artist-eight-point x1 y1 x2 y2))))))))
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-undraw-line (line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2558 "Undraws LINE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2559 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2560 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2561 (artist-move-to-xy (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2562 (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2563 (artist-replace-char (artist-coord-get-saved-char coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2564 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2565 (artist-2point-get-shapeinfo line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2566
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2567 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2568 ;; Drawing and undrawing straight lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2569 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2570
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2571 (defun artist-draw-sline (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2572 "Draw a strait line from X1, Y1 to X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2573 Straight lines are vertical, horizontal or diagonal lines.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2574 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
2575 when drawing a simple image.
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 Output is a straight line, which is a list on the form
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
2578 \(END-POINT-1 END-POINT-2 SHAPE-INFO).
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2579
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2580 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
2581 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
2582 ORIGINAL-CHAR-1 ORIGINAL-CHAR-2 ... ]."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2583 (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
2584 (x (aref line 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2585 (y (aref line 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2586 (length (+ (aref line 2) 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2587 (direction (aref line 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2588 (line-char (artist-direction-char direction))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2589 (i 4)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2590 (endpoint1 (artist-make-endpoint x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2591 (endpoint2 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2592 (while (< i length)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2593 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2594 (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2595 (artist-replace-char artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2596 (artist-replace-char (artist-intersection-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2597 line-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2598 (aref line i))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2599 (if (not (< (1+ i) length))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2600 ;; This is the last element. Set the second endpoint
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2601 (setq endpoint2 (artist-make-endpoint x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2602 (setq x (+ x (artist-direction-step-x direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2603 (setq y (+ y (artist-direction-step-y direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2604 (setq i (1+ i)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2605 (artist-make-2point-object endpoint1 endpoint2 line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2606
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 (defun artist-undraw-sline (line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2609 "Undraw a straight line LINE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2610 (if line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2611 (let* ((shape-info (artist-2point-get-shapeinfo line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2612 (x (aref shape-info 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2613 (y (aref shape-info 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2614 (length (+ (aref shape-info 2) 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2615 (direction (aref shape-info 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2616 (i 4))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2617 (while (< i length)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2618 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2619 (artist-replace-char (aref shape-info i))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2620 (setq x (+ x (artist-direction-step-x direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2621 (setq y (+ y (artist-direction-step-y direction)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2622 (setq i (1+ i))))))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2625 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2626 ;; Drawing and undrawing rectangles and squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2627 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2628
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2629 (defun artist-draw-rect (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2630 "Draws a rectangle with corners at X1, Y1 and X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2631
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2632 Output is a rectangle, which is a list on the form
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
2633 \(END-POINT-1 END-POINT-2 SHAPE-INFO).
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2634
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2635 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
2636 SHAPE-INFO is a list of four straight lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2637 (let* ((artist-line-char (artist-compute-line-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2638 (artist-line-char-set artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2639 (line1 (artist-draw-sline x1 y1 x2 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2640 (line2 (artist-draw-sline x2 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2641 (line3 (artist-draw-sline x2 y2 x1 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2642 (line4 (artist-draw-sline x1 y2 x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2643 (endpoint1 (artist-make-endpoint x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2644 (endpoint2 (artist-make-endpoint x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2645 (artist-make-2point-object endpoint1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2646 endpoint2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2647 (list line1 line2 line3 line4))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2648
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2649 (defun artist-undraw-rect (rectangle)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2650 "Undraws RECTANGLE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2651 (if rectangle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2652 (let ((shape-info (artist-2point-get-shapeinfo rectangle)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2653 (artist-undraw-sline (elt shape-info 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2654 (artist-undraw-sline (elt shape-info 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2655 (artist-undraw-sline (elt shape-info 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2656 (artist-undraw-sline (elt shape-info 0)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2657
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2658
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2659 (defun artist-rect-corners-squarify (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2660 "Compute square corners from rectangle corners at X1, Y1 and X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2661 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
2662 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
2663 (let* ((delta-x (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2664 (delta-y (- y2 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2665 (delta-x-sign (if (< delta-x 0) -1 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2666 (delta-y-sign (if (< delta-y 0) -1 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2667 (new-x2) ; set below
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2668 (new-y2)) ; set below
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2669
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2670 ;; Check which of x2 and y2 is most distant
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2671 ;; take care to the aspect ratio
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2672 (if (> (abs delta-x) (abs delta-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2673
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2674 ;; *** x2 more distant than y2 (with care taken to aspect ratio)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2675 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2676 (setq new-x2 x2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2677 (setq new-y2 (+ y1 (round (/ (* (abs delta-x) delta-y-sign)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2678 artist-aspect-ratio)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2679
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2680 ;; *** y2 more distant than x2 (with care taken to aspect ratio)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2681 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2682 (setq new-x2 (round (+ x1 (* (* (abs delta-y) delta-x-sign)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2683 artist-aspect-ratio))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2684 (setq new-y2 y2)))
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 ;; Return this
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2687 (list x1 y1 new-x2 new-y2)))
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-draw-square (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2691 "Draw a square with corners at X1, Y1 and X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2692
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2693 Output is a square, which is a list on the form
51961
e56cb5adb76f (artist-butlast-fn, artist-draw-sline)
John Paul Wallington <jpw@pobox.com>
parents: 47953
diff changeset
2694 \(END-POINT-1 END-POINT-2 SHAPE-INFO).
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2695
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2696 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
2697 SHAPE-INFO is a list of four straight lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2698 (let* ((artist-line-char (artist-compute-line-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2699 (artist-line-char-set artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2700 (square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2701 (new-x1 (elt square-corners 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2702 (new-y1 (elt square-corners 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2703 (new-x2 (elt square-corners 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2704 (new-y2 (elt square-corners 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2705 (endpoint1 (artist-make-endpoint new-x1 new-y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2706 (endpoint2 (artist-make-endpoint new-x2 new-y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2707 (line1 (artist-draw-sline new-x1 new-y1 new-x2 new-y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2708 (line2 (artist-draw-sline new-x2 new-y1 new-x2 new-y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2709 (line3 (artist-draw-sline new-x2 new-y2 new-x1 new-y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2710 (line4 (artist-draw-sline new-x1 new-y2 new-x1 new-y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2711 (artist-make-2point-object endpoint1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2712 endpoint2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2713 (list line1 line2 line3 line4))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2714
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2715 (defun artist-undraw-square (square)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2716 "Undraws SQUARE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2717 (if square
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2718 (let ((shape-info (artist-2point-get-shapeinfo square)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2719 (artist-undraw-sline (elt shape-info 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2720 (artist-undraw-sline (elt shape-info 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2721 (artist-undraw-sline (elt shape-info 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2722 (artist-undraw-sline (elt shape-info 0)))))
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 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2725 ;; Filling rectangles and squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2726 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2727
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2728 (defun artist-fill-rect (rect x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2729 "Fill rectangle RECT from X1,Y1 to X2,Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2730 (let ((x (1+ (min x1 x2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2731 (y (1+ (min y1 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2732 (x-max (max x1 x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2733 (y-max (max y1 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2734 (let ((w (- x-max x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2735 (while (< y y-max)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2736 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2737 (artist-replace-chars artist-fill-char w)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2738 (setq y (1+ y))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2739
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2740 (defun artist-fill-square (square x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2741 "Fills a SQUARE from X1,Y1 to X2,Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2742 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2743 (new-x1 (elt square-corners 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2744 (new-y1 (elt square-corners 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2745 (new-x2 (elt square-corners 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2746 (new-y2 (elt square-corners 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2747 (x (1+ (min new-x1 new-x2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2748 (y (1+ (min new-y1 new-y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2749 (x-max (max new-x1 new-x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2750 (y-max (max new-y1 new-y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2751 (w (- x-max x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2752 (while (< y y-max)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2753 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2754 (artist-replace-chars artist-fill-char w)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2755 (setq y (1+ y)))))
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 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2759 ;; Pen drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2760 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2761
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2762 (defun artist-pen (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2763 "Draws a character at X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2764 The character is replaced with the character in `artist-fill-char'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2765 (artist-move-to-xy x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2766 (artist-replace-char (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2767 artist-line-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2768 (if artist-fill-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2769 artist-fill-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2770 artist-default-fill-char))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2771
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2772
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2773 (defun artist-pen-line (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2774 "Draws a line from last pen position to X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2775 The character is replaced with the character in `artist-fill-char'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2776 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
2777 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
2778 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
2779 (let ((artist-line-char (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2780 artist-line-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2781 (if artist-fill-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2782 artist-fill-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2783 artist-default-fill-char))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2784
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2785 ;; Draw line from last point to this
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2786 (let ((x-last (car (car artist-key-poly-point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2787 (y-last (cdr (car artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2788 (artist-move-to-xy x-last y-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2789 (artist-replace-char artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2790 (artist-draw-line x-last y-last x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2791
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2792 ;; Update the point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2793 (setq artist-key-poly-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2794 (cons (cons x1 y1) artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2795
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2796 (defun artist-pen-reset-last-xy (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2797 "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
2798 (artist-clear-arrow-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2799 (setq artist-key-poly-point-list (list (cons x1 y1))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2800
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2801
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2802 (defun artist-pen-set-arrow-points (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2803 "Set arrow points for pen drawing using X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2804 Also, the `artist-key-poly-point-list' is reversed."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2805
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2806 (setq artist-key-poly-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2807 (artist-uniq artist-key-poly-point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2808
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2809 (if (>= (length artist-key-poly-point-list) 2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2810
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2811 ;; 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
2812 (let ((xn (car (car artist-key-poly-point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2813 (yn (cdr (car artist-key-poly-point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2814 (xn-1 (car (car (cdr artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2815 (yn-1 (cdr (car (cdr artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2816 (dirn)) ; direction for point n
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2817 (setq artist-key-poly-point-list (reverse artist-key-poly-point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2818 (let ((x0 (car (car artist-key-poly-point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2819 (y0 (cdr (car artist-key-poly-point-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2820 (x1 (car (car (cdr artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2821 (y1 (cdr (car (cdr artist-key-poly-point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2822 (dir0)) ; direction for point 0
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2823 (setq dir0 (artist-find-direction x1 y1 x0 y0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2824 (setq dirn (artist-find-direction xn-1 yn-1 xn yn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2825 (setq artist-arrow-point-1 (artist-make-arrow-point x0 y0 dir0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2826 (setq artist-arrow-point-2 (artist-make-arrow-point xn yn dirn))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2827
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2828
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 ;; Text rendering
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2831 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2832 (defun artist-figlet-run (text font extra-args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2833 "Run figlet rendering TEXT using FONT.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2834 EXTRA-ARGS for figlet, for the command line, may be specified."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2835 (let* ((figlet-args (cond ((and font extra-args)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2836 (cons (concat "-f" font)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2837 (artist-string-split extra-args "[ \t]+")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2838 (font (concat "-f" font))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2839 (extra-args
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2840 (artist-string-split extra-args "[ \t]+"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2841 (t nil)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2842 (figlet-output (artist-system artist-figlet-program text figlet-args))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2843 (exit-code (elt figlet-output 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2844 (stdout (elt figlet-output 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2845 (stderr (elt figlet-output 2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2846 (if (not (= exit-code 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2847 (error "Failed to render font: %s (%d)" stderr exit-code))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2848 stdout))
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 (defun artist-figlet-get-font-list ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2851 "Read fonts in with the shell command.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2852 Returns a list of strings."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2853 (let* ((cmd-interpreter "/bin/sh")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2854 (ls-cmd artist-figlet-list-fonts-command)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2855 (result (artist-system cmd-interpreter ls-cmd nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2856 (exit-code (elt result 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2857 (stdout (elt result 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2858 (stderr (elt result 2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2859 (if (not (= exit-code 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2860 (error "Failed to read available fonts: %s (%d)" stderr exit-code))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2861 (artist-string-split stdout ".flf\n")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2862
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2863 (defun artist-figlet-choose-font ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2864 "Read any extra arguments for figlet."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2865 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2866 (let* ((avail-fonts (artist-figlet-get-font-list))
65680
ed770a0a7846 2005-09-24 Emilio C. Lopes <eclig@gmx.net>
Romain Francoise <romain@orebokech.com>
parents: 65583
diff changeset
2867 (font (completing-read (concat "Select font (default "
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2868 artist-figlet-default-font
65680
ed770a0a7846 2005-09-24 Emilio C. Lopes <eclig@gmx.net>
Romain Francoise <romain@orebokech.com>
parents: 65583
diff changeset
2869 "): ")
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2870 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2871 (lambda (font) (cons font font))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2872 avail-fonts))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2873 (if (string= font "") artist-figlet-default-font font)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2874
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2875 (defun artist-figlet-get-extra-args ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2876 "Read any extra arguments for figlet."
63800
b9819eae04f1 (artist-text-overwrite)
Richard M. Stallman <rms@gnu.org>
parents: 59224
diff changeset
2877 (let ((extra-args (read-string "Extra args to figlet: ")))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2878 (if (string= extra-args "")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2879 nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2880 extra-args)))
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-figlet (text)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2883 "Render TEXT using figlet."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2884 (let* ((figlet-font (artist-figlet-choose-font))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2885 (figlet-extra-args (artist-figlet-get-extra-args)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2886 (artist-figlet-run text figlet-font figlet-extra-args)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2887
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2888
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2889 (defun artist-text-insert-common (x y text see-thru)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2890 "At position X, Y, insert text TEXT.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2891 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
2892 in the buffer."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2893 (let* ((string-list (artist-string-split text "\n"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2894 (i 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2895 (len (length string-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2896 (while (< i len)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2897 (artist-move-to-xy x (+ y i))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2898 (artist-replace-string (car string-list) see-thru)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2899 (setq string-list (cdr string-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2900 (setq i (1+ i)))))
47953
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
2901
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2902 (defun artist-text-insert-see-thru (x y text)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2903 "At position X, Y, insert text TEXT.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2904 Let text already in buffer shine thru the TEXT inserted."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2905 (artist-text-insert-common x y text t))
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-text-insert-overwrite (x y text)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2908 "At position X, Y, insert text TEXT.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2909 Let blanks in TEXT overwrite any text already in the buffer."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2910 (artist-text-insert-common x y text nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2911
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2912 (defun artist-text-see-thru (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2913 "Prompt for text to render, render it at X,Y.
70811
fbbc9639de95 (artist-text-renderer): Make this the alias for the following variable.
Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
parents: 68648
diff changeset
2914 This is done by calling the function specified by
fbbc9639de95 (artist-text-renderer): Make this the alias for the following variable.
Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
parents: 68648
diff changeset
2915 `artist-text-renderer-function', which must return a list of strings,
fbbc9639de95 (artist-text-renderer): Make this the alias for the following variable.
Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
parents: 68648
diff changeset
2916 to be inserted in the buffer.
33618
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 Text already in the buffer ``shines thru'' blanks in the rendered text."
63800
b9819eae04f1 (artist-text-overwrite)
Richard M. Stallman <rms@gnu.org>
parents: 59224
diff changeset
2919 (let* ((input-text (read-string "Type text to render: "))
70811
fbbc9639de95 (artist-text-renderer): Make this the alias for the following variable.
Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
parents: 68648
diff changeset
2920 (rendered-text (artist-funcall artist-text-renderer-function input-text)))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2921 (artist-text-insert-see-thru x y rendered-text)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2922
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2923
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2924 (defun artist-text-overwrite (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2925 "Prompt for text to render, render it at X,Y.
70811
fbbc9639de95 (artist-text-renderer): Make this the alias for the following variable.
Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
parents: 68648
diff changeset
2926 This is done by calling the function specified by
fbbc9639de95 (artist-text-renderer): Make this the alias for the following variable.
Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
parents: 68648
diff changeset
2927 `artist-text-renderer-function', which must return a list of strings,
fbbc9639de95 (artist-text-renderer): Make this the alias for the following variable.
Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
parents: 68648
diff changeset
2928 to be inserted in the buffer.
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2929
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2930 Blanks in the rendered text overwrites any text in the buffer."
63800
b9819eae04f1 (artist-text-overwrite)
Richard M. Stallman <rms@gnu.org>
parents: 59224
diff changeset
2931 (let* ((input-text (read-string "Type text to render: "))
70811
fbbc9639de95 (artist-text-renderer): Make this the alias for the following variable.
Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
parents: 68648
diff changeset
2932 (rendered-text (artist-funcall artist-text-renderer-function input-text)))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2933 (artist-text-insert-overwrite x y rendered-text)))
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 ;; Spraying
47953
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
2937 ;;
33618
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 (defun artist-spray-get-interval ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2940 "Retrieves the interval for repeated spray."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2941 artist-spray-interval)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2942
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2943 (defun artist-spray-random-points (n radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2944 "Generate N random points within a radius of RADIUS.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2945 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
2946 (let ((points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2947 (while (> n 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2948 (let* ((angle (* (random 359) (/ pi 180)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2949 (dist (random radius))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2950 (point (cons (round (* dist (cos angle)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2951 (round (* dist (sin angle))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2952 (setq points (cons point points)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2953 (setq n (- n 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2954 points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2955
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2956 (defun artist-spray (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2957 "Spray at X1, Y1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2958 (let* ((num-points (* artist-spray-radius artist-spray-radius))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2959 (spray-points (artist-spray-random-points num-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2960 artist-spray-radius)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2961 (while spray-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2962 ;; Replace one spray point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2963 (let* ((point (car spray-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2964 (x (+ x1 (car point)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2965 (y (+ y1 (cdr point)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2966 (buf-c (artist-get-char-at-xy-conv x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2967 (this-c (memq buf-c artist-spray-chars))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2968 (next-c (cond ((null this-c) artist-spray-new-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2969 ((null (cdr this-c)) (car this-c))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2970 (t (car (cdr this-c))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2971 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2972 (artist-replace-char next-c))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2973
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2974 ;; Step to next spray point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2975 (setq spray-points (cdr spray-points)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2976
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2977 (defun artist-spray-clear-circle (circle x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2978 "Clears circle CIRCLE at X1, Y1 through X2, Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2979 (artist-undraw-circle circle))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2980
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2981 (defun artist-spray-set-radius (circle x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2982 "Set spray radius from CIRCLE at X1, Y1 through X2, Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2983 (let ((dx (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2984 (dy (- y2 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2985 (setq artist-spray-radius (round (sqrt (+ (* dx dx) (* dy dy)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2986 (if (= 0 artist-spray-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2987 (setq artist-spray-radius 1))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2988
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2989 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2990 ;; Erasing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2991 ;;
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 (defun artist-erase-char (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2994 "Erases a character at X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2995 The character is replaced with the character in `artist-erase-char'."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2996 (artist-move-to-xy x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
2997 (artist-replace-char artist-erase-char))
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-erase-rect (rect x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3000 "Erase rectangle RECT from X1, Y1, X2, Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3001 (let ((artist-line-char-set t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3002 (artist-fill-char-set t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3003 (artist-line-char artist-erase-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3004 (artist-fill-char artist-erase-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3005 (artist-draw-rect x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3006 (artist-fill-rect rect x1 y1 x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3007
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3008
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3009 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3010 ;; Vaporizing (erasing) line and lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3011 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3012
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3013
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3014 (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
3015 "Find one endpoint for line through X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3016 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
3017 accepting characters in the list ACCEPT-SET, stopping immediately
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3018 when finding characters in the list REJECT-SET. Fuzziness, that is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3019 the number of consecutive characters not in ACCEPT-SET to allow as
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3020 part of the line, is determined by the variable `artist-vaporize-fuzziness'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3021 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3022 (let ((x x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3023 (y y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3024 (x-last x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3025 (y-last y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3026 (done nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3027 (while (not done)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3028 (let ((c (artist-get-char-at-xy-conv x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3029 (cond ((memq c reject-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3030 (setq done t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3031
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3032 ;; We found a character we are accepting as part of the line.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3033 ;; Update position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3034 ((memq c accept-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3035 (setq x-last x
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3036 y-last y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3037 x (+ x step-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3038 y (+ y step-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3039 (if (or (< x 0) (< y 0)) ;stop at the edge
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3040 (setq done t)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3041
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3042 ;; We found a character we are not accepting as part of
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3043 ;; the line Search `artist-vaporize-fuzziness'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3044 ;; characters away from this position in the same
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3045 ;; direction to see if there are any characters in the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3046 ;; accept-set. If not, we have found the endpoint.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3047 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3048 (let ((fuzziness artist-vaporize-fuzziness)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3049 (x-tmp x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3050 (y-tmp y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3051
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3052 ;; while we have more fuzziness left and we have not
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3053 ;; found a character accepted as a line, move
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3054 ;; forward!
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3055 (while (and (> fuzziness 0) (not (memq c accept-set)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3056 (setq x-tmp (+ x-tmp step-x))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3057 (setq y-tmp (+ y-tmp step-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3058 (setq c (artist-get-char-at-xy-conv x-tmp y-tmp))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3059 (setq fuzziness (- fuzziness 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3060 (if (memq c accept-set)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3061
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3062 ;; The line continues on the other side of the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3063 ;; not-accepted character.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3064 (setq x x-tmp
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3065 y y-tmp)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3066
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3067 ;; Else: We couldn't find any line on the other side.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3068 ;; That means we are done searching for the endpoint.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3069 (setq done t)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3070 (cons x-last y-last)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3071
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3072
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3073 (defun artist-vap-find-endpoints-horiz (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3074 "Find endpoints for a horizontal line through X, Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3075 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
65260
c1dcf33345ab (x-pointer-crosshair): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 64751
diff changeset
3076 (list (artist-vap-find-endpoint x y 1 0 '(?- ?+) '(?\s))
c1dcf33345ab (x-pointer-crosshair): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 64751
diff changeset
3077 (artist-vap-find-endpoint x y -1 0 '(?- ?+) '(?\s))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3078
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3079 (defun artist-vap-find-endpoints-vert (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3080 "Find endpoints for a vertical line through X, Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3081 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
65260
c1dcf33345ab (x-pointer-crosshair): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 64751
diff changeset
3082 (list (artist-vap-find-endpoint x y 0 1 '(?| ?+) '(?\s))
c1dcf33345ab (x-pointer-crosshair): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 64751
diff changeset
3083 (artist-vap-find-endpoint x y 0 -1 '(?| ?+) '(?\s))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3084
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3085 (defun artist-vap-find-endpoints-swne (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3086 "Find endpoints for a diagonal line (made by /'s) through X, Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3087 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
65260
c1dcf33345ab (x-pointer-crosshair): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 64751
diff changeset
3088 (list (artist-vap-find-endpoint x y 1 -1 '(?/ ?X) '(?\s))
c1dcf33345ab (x-pointer-crosshair): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 64751
diff changeset
3089 (artist-vap-find-endpoint x y -1 1 '(?/ ?X) '(?\s))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3090
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3091 (defun artist-vap-find-endpoints-nwse (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3092 "Find endpoints for a diagonal line (made by \\'s) through X, Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3093 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
65260
c1dcf33345ab (x-pointer-crosshair): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 64751
diff changeset
3094 (list (artist-vap-find-endpoint x y 1 1 '(?\\ ?X) '(?\s))
c1dcf33345ab (x-pointer-crosshair): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 64751
diff changeset
3095 (artist-vap-find-endpoint x y -1 -1 '(?\\ ?X) '(?\s))))
33618
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 (defun artist-vap-find-endpoints (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3099 "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
3100 An endpoint is a cons pair, (ENDPOINT-X . ENDPOINT-Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3101 (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3102 nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3103 (let ((c (artist-get-char-at-xy-conv x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3104 (cond ((eq c ?-) (artist-vap-find-endpoints-horiz x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3105 ((eq c ?|) (artist-vap-find-endpoints-vert x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3106 ((eq c ?/) (artist-vap-find-endpoints-swne x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3107 ((eq c ?\\) (artist-vap-find-endpoints-nwse x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3108 ((eq c ?+) (append (artist-vap-find-endpoints-horiz x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3109 (artist-vap-find-endpoints-vert x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3110 ((eq c ?X) (append (artist-vap-find-endpoints-swne x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3111 (artist-vap-find-endpoints-nwse x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3112
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3113 ;; We don't know how to find directions when we are on
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3114 ;; another character
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3115 (t nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3116
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3117
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3118 (defun artist-vap-group-in-pairs (l)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3119 "Group elements in list L in pairs."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3120 (cond ((null l) nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3121 ((null (cdr l)) l) ; unevent number of elements in list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3122 (t (append (list (list (car l) (car (cdr l))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3123 (artist-vap-group-in-pairs (cdr (cdr l)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3124
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3125 (defun artist-vaporize-by-endpoints (endpoint1 endpoint2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3126 "Given ENDPOINT1 and ENDPOINT2, vaporize the line between them.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3127 An endpoint is a pair (X . Y)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3128 (let* ((x1 (car endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3129 (y1 (cdr endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3130 (x2 (car endpoint2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3131 (y2 (cdr endpoint2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3132 (dir (artist-find-direction x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3133 (x-step (aref [1 1 0 -1 -1 -1 0 1] dir))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3134 (y-step (aref [0 1 1 1 0 -1 -1 -1] dir))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3135 (line-c (aref [?- ?\\ ?| ?/ ?- ?\\ ?| ?/] dir))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3136 (line-len (elt (list (abs (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3137 (abs (- x2 x1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3138 (abs (- y2 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3139 (abs (- y2 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3140 (abs (- x1 x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3141 (abs (- x1 x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3142 (abs (- y1 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3143 (abs (- y1 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3144 dir))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3145 (x x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3146 (y y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3147 (while (>= line-len 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3148 (let* ((buffer-c (artist-get-char-at-xy-conv x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3149 (new-c (artist-unintersection-char line-c buffer-c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3150 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3151 (artist-replace-char new-c))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3152 (setq x (+ x x-step)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3153 y (+ y y-step)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3154 line-len (- line-len 1)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3155
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3156
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3157 (defun artist-vaporize-line (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3158 "Vaporize (erase) the straight line through X1, Y1.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3159 Do this by replacing the characters that forms the line with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3160 `artist-erase-char'. Output is a list of endpoints for lines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3161 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
3162 (let ((endpoints (artist-vap-find-endpoints x1 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3163 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3164 (lambda (endpoints)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3165 (let ((ep1 (car endpoints))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3166 (ep2 (car (cdr endpoints))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3167 (artist-vaporize-by-endpoints ep1 ep2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3168 (artist-vap-group-in-pairs endpoints))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3169 endpoints))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3170
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3171
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3172 ;; Implementation note: This depends on artist-vaporize-line doing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3173 ;; unintersections of intersecting lines.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3174 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3175 ;; Example:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3176 ;; Suppose the buffer looks like this and that we start vaporizing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3177 ;; lines at (3,0) (at the ``*'').
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3178 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3179 ;; 0123456
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3180 ;; 0+--*--+
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3181 ;; 1| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3182 ;; 2| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3183 ;; 3+-----+
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3184 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3185 ;; 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
3186 ;; topmost horizontal line:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3187 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3188 ;; 0123456
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3189 ;; 0| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3190 ;; 1| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3191 ;; 2| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3192 ;; 3+-----+
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3193 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3194 ;; 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
3195 ;; 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
3196 ;; the entire rectangle is vaporized.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3197 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3198 ;; Now, What if the `+' in the upper left and upper right corners,
47953
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
3199 ;; had not been changed to `|' but to spaces instead? We would
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3200 ;; have failed when popping (0,0) and vaporizing that line because
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3201 ;; we wouldn't find any line at (0,0):
47953
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
3202 ;;
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3203 ;; 0123456
47953
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
3204 ;; 0
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3205 ;; 1| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3206 ;; 2| |
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3207 ;; 3+-----+
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3208 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3209 ;; That's why we depend on artist-vaporize-line doing unintersecting
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3210 ;; of crossing lines. There are alternative ways to handle this
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3211 ;; if it becomes too much a trouble.
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 (defun artist-vaporize-lines (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3214 "Vaporize lines reachable from point X1, Y1."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3215 (let ((ep-stack nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3216 (mapcar
59224
0bedd71fb49f (artist-butlast-fn): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents: 59223
diff changeset
3217 (lambda (ep) (push ep ep-stack))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3218 (artist-vap-find-endpoints x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3219 (while (not (null ep-stack))
59224
0bedd71fb49f (artist-butlast-fn): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents: 59223
diff changeset
3220 (let* ((vaporize-point (pop ep-stack))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3221 (new-endpoints (artist-vaporize-line (car vaporize-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3222 (cdr vaporize-point))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3223 (mapcar
59224
0bedd71fb49f (artist-butlast-fn): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents: 59223
diff changeset
3224 (lambda (endpoint) (push endpoint ep-stack))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3225 new-endpoints)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3226
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3227
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3228 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3229 ;; Circles and ellipses
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 (defun artist-ellipse-generate-quadrant (x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3232 "Create a point-list for first quadrant.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3233 Points go from (X-RADIUS, 0) to (0, Y-RADIUS).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3234 Quadrant is generated around origo."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3235 (let* ((rx2 (* x-radius x-radius))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3236 (ry2 (* y-radius y-radius))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3237 (2rx2 (* 2 rx2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3238 (2ry2 (* 2 ry2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3239 (p)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3240 (x 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3241 (y y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3242 (px 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3243 (py (* 2rx2 y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3244 (point-list nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3245 (artist-put-pixel point-list x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3246 (setq p (round (+ ry2 (- (* rx2 y-radius)) (* 0.25 rx2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3247 (while (< px py)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3248 (setq x (1+ x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3249 px (+ px 2ry2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3250 (if (< p 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3251 (setq p (+ p ry2 px))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3252 (setq y (- y 1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3253 py (- py 2rx2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3254 p (+ p ry2 px (- py))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3255 (artist-put-pixel point-list x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3256 (setq p (round (+ (* ry2 (+ x 0.5) (+ x 0.5))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3257 (* rx2 (- y 1) (- y 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3258 (- (* rx2 ry2)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3259 (while (> y 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3260 (setq y (- y 1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3261 py (- py 2rx2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3262 (if (> p 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3263 (setq p (+ p rx2 (- py)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3264 (setq x (1+ x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3265 px (+ px 2ry2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3266 p (+ p rx2 (- py) px)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3267 (artist-put-pixel point-list x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3268 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3269
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3270 (defsubst artist-new-fill-item (x y width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3271 "Create a new item at X, Y, with WIDTH.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3272 This is for use in fill-info in ellipses and circles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3273 (let ((new-item (make-vector 3 x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3274 (aset new-item 1 y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3275 (aset new-item 2 width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3276 new-item))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3277
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3278 (defsubst artist-fill-item-get-x (fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3279 "Retrieve the x component of a FILL-ITEM."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3280 (aref fill-item 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3281
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3282 (defsubst artist-fill-item-set-x (fill-item new-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3283 "Set the x component of a FILL-ITEM to NEW-X."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3284 (aset fill-item 0 new-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3285 fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3286
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3287 (defsubst artist-fill-item-get-y (fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3288 "Retrieve the y component of a FILL-ITEM."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3289 (aref fill-item 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3290
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3291 (defsubst artist-fill-item-set-y (fill-item new-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3292 "Set the y component of a FILL-ITEM to NEW-Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3293 (aset fill-item 1 new-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3294 fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3295
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3296 (defsubst artist-fill-item-get-width (fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3297 "Retrieve the width component of a FILL-ITEM."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3298 (aref fill-item 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3299
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3300 (defsubst artist-fill-item-set-width (fill-item new-width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3301 "Set the width component of a FILL-ITEM to NEW-WIDTH."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3302 (aset fill-item 2 new-width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3303 fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3304
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3305
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3306 (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
3307 "Add offsets X-CENTER and Y-CENTER to coordinates in POINT-LIST."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3308 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3309 (lambda (p)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3310 (artist-coord-set-x p (+ x-center (artist-coord-get-x p)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3311 (artist-coord-set-y p (+ y-center (artist-coord-get-y p))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3312 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3313
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 (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
3316 "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
3317 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3318 (lambda (p)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3319 (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
3320 (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
3321 fill-info))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3322
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3323 (defun artist-ellipse-remove-0-fills (fill-info)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3324 "Remove fill-infos from FILL-INFO that fills a zero-width field."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3325 (cond ((null fill-info)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3326 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3327 ((= 0 (artist-fill-item-get-width (car fill-info)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3328 (artist-ellipse-remove-0-fills (cdr fill-info)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3329 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3330 (append (list (car fill-info))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3331 (artist-ellipse-remove-0-fills (cdr fill-info))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3332
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3333
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3334 (defun artist-ellipse-compute-fill-info (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3335 "Compute fill info for ellipse around 0,0 from POINT-LIST.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3336 The POINT-LIST is expected to cover the first quadrant."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3337 (let ((first-half nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3338 (both-halves nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3339 (last-y nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3340
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3341 ;; Create first half (the lower one (since y grows downwards)) from
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3342 ;; the first quadrant.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3343 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3344 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3345 (let* ((x (artist-coord-get-x coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3346 (y (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3347 (width (max (- (* 2 x) 1) 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3348 (left-edge (- x width)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3349 (if (or (null last-y) (not (= y last-y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3350 ;; This was either the first time,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3351 ;; or it was the first time on a new line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3352 (setq first-half
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3353 (append first-half
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3354 ;; Fill info item starts at left-edge on line y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3355 (list (artist-new-fill-item left-edge y width)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3356 (setq last-y y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3357 point-list)
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 ;; Create the other half by mirroring the first half.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3360 (setq both-halves
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3361 (append first-half
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3362 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3363 (lambda (i)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3364 (artist-new-fill-item (artist-fill-item-get-x i)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3365 (- (artist-fill-item-get-y i))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3366 (artist-fill-item-get-width i)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3367 ;; The cdr below is so we don't include fill-info for
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3368 ;;; the middle line twice
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3369 (cdr (reverse first-half)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3370 (artist-ellipse-remove-0-fills both-halves)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3371
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3372
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3373 (defun artist-ellipse-mirror-quadrant (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3374 "Mirror a POINT-LIST describing first quadrant to create a complete ellipse."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3375 (let ((right-half nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3376 (left-half nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3377
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3378 ;; First, if last char in that quadrant is `/', then replace it with `)'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3379 ;; This way we avoids things
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3380 ;; --------- ---------
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 ;; that look like: \ / instead we get: ( )
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3383 ;; \ / \ /
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3384 ;; --------- ---------
65872
c9a88ce08e2d (artist-ellipse-mirror-quadrant): Fix bug introduced 2005-07-03:
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 65680
diff changeset
3385 (let ((last-coord (car (last point-list))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3386 (if (= (artist-coord-get-new-char last-coord) ?/)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3387 (artist-coord-set-new-char last-coord artist-ellipse-right-char)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3388
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3389 ;; 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
3390 (setq right-half
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3391 (append
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3392 point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3393 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3394 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3395 (let ((c (artist-coord-get-new-char coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3396 (artist-new-coord (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3397 (- (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3398 (cond ((= c ?/) ?\\)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3399 ((= c ?\\) ?/)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3400 (t c)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3401 ;; 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
3402 (cdr (reverse point-list)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3403
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3404 ;; Create the left half by mirroring the right half.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3405 (setq left-half
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3406 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3407 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3408 (let ((c (artist-coord-get-new-char coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3409 (artist-new-coord (- (artist-coord-get-x coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3410 (artist-coord-get-y coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3411 (cond ((= c ?/) ?\\)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3412 ((= c ?\\) ?/)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3413 ((= c artist-ellipse-right-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3414 artist-ellipse-left-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3415 (t c)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3416 ;; 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
3417 ;; and middle bottom char twice.
59224
0bedd71fb49f (artist-butlast-fn): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents: 59223
diff changeset
3418 (butlast (cdr (reverse right-half)))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3419 (append right-half left-half)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3420
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3421
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3422 (defun artist-draw-ellipse-general (x1 y1 x-radius y-radius)
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3423 "Draw an ellipse with center at X1, Y1 and X-RADIUS and Y-RADIUS.
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3424
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3425 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
3426
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3427 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
3428 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
3429
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3430 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
3431 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
3432
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3433 Ellipses with zero Y-RADIUS are not drawn correctly."
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3434 (let* ((point-list (artist-ellipse-generate-quadrant x-radius y-radius))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3435 (fill-info (artist-ellipse-compute-fill-info point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3436 (shape-info (make-vector 2 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3437
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3438 (setq point-list (artist-calculate-new-chars point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3439 (setq point-list (artist-ellipse-mirror-quadrant point-list))
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3440 (setq point-list (artist-ellipse-point-list-add-center x1 y1 point-list))
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3441 (setq fill-info (artist-ellipse-fill-info-add-center x1 y1 fill-info))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3442
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3443 ;; Draw the ellipse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3444 (setq point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3445 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3446 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3447 (artist-move-to-xy (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3448 (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3449 (if artist-line-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3450 (artist-replace-char artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3451 (artist-replace-char (artist-coord-get-new-char coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3452 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3453 (artist-modify-new-chars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3454 (artist-save-chars-under-point-list point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3455
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3456 (aset shape-info 0 point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3457 (aset shape-info 1 fill-info)
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3458 (artist-make-2point-object (artist-make-endpoint x1 y1)
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3459 (artist-make-endpoint x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3460 shape-info)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3461
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3462 (defun artist-draw-ellipse-with-0-height (x1 y1 x-radius y-radius)
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3463 "Draw an ellipse with center at X1, Y1 and X-RADIUS and Y-RADIUS.
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3464
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3465 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
3466
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3467 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
3468 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
3469
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3470 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
3471 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
3472
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3473 The Y-RADIUS must be 0, but the X-RADIUS must not be 0."
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3474 (let ((point-list nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3475 (width (max (- (abs (* 2 x-radius)) 1)))
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3476 (left-edge (1+ (- x1 (abs x-radius))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3477 (line-char (if artist-line-char-set artist-line-char ?-))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3478 (i 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3479 (point-list nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3480 (fill-info nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3481 (shape-info (make-vector 2 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3482 (while (< i width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3483 (let* ((line-x (+ left-edge i))
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3484 (line-y y1)
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3485 (new-coord (artist-new-coord line-x line-y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3486 (artist-coord-add-saved-char new-coord
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3487 (artist-get-char-at-xy line-x line-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3488 (artist-move-to-xy line-x line-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3489 (artist-replace-char line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3490 (setq point-list (append point-list (list new-coord)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3491 (setq i (1+ i))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3492 (aset shape-info 0 point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3493 (aset shape-info 1 fill-info)
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
3494 (artist-make-2point-object (artist-make-endpoint x1 y1)
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3495 (artist-make-endpoint x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3496 shape-info)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3497
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3498 (defun artist-draw-ellipse (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3499 "Draw an ellipse with center at X1, Y1 and point X2,Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3500
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3501 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
3502
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3503 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
3504 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
3505
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3506 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
3507 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
3508 (let* ((artist-line-char (artist-compute-line-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3509 (artist-line-char-set artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3510 (width (abs (- x2 x1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3511 (height (abs (- y2 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3512 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3513 ;; 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
3514 ;; position, but since x1,y1, x2,y2 marks the corners of one
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3515 ;; of the quadrants, we have to enlarge the ellipse a bit.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3516 ;; Ok, so then why by sqrt(2)?
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3517 ;; It comes from the equation for the ellipse (where a is the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3518 ;; x-radius and b is the y-radius):
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3519 ;; 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
3520 ;; and the fact that we want the enlarged ellipse to have the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3521 ;; same proportions as the smaller square, therefore we have:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3522 ;; a/b = x/y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3523 ;; Solving this yields a-in-larger-ellipse = a-in-smaller * sqrt(2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3524 (x-radius (round (* width (sqrt 2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3525 (y-radius (round (* height (sqrt 2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3526 (x x1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3527 (y y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3528 (if (and (= y1 y2) (not (= x1 x2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3529 (artist-draw-ellipse-with-0-height x y x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3530 (artist-draw-ellipse-general x y x-radius y-radius))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3531
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3532
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3533 (defun artist-undraw-ellipse (ellipse)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3534 "Undraw ELLIPSE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3535 (if ellipse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3536 (let ((point-list (aref (artist-2point-get-shapeinfo ellipse) 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3537 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3538 (lambda (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3539 (artist-move-to-xy (artist-coord-get-x coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3540 (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3541 (artist-replace-char (artist-coord-get-saved-char coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3542 coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3543 point-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3544
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 (defun artist-draw-circle (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3547 "Draw a circle with center at X1, Y1 and point X2,Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3548
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3549 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
3550
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3551 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
3552 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
3553
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3554 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
3555 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
3556 (let* ((artist-line-char (artist-compute-line-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3557 (artist-line-char-set artist-line-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3558 (width (abs (- x2 x1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3559 (height (abs (- y2 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3560 ;; When drawing our circle, we want it to through the cursor
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3561 ;; just as when drawing the ellispe, but we have to take
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3562 ;; care for the aspect-ratio.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3563 ;; The equation for the ellipse (where a is the x-radius and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3564 ;; b is the y-radius):
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3565 ;; 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
3566 ;; together with the relationship
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3567 ;; a = aspect-ratio * b
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3568 ;; gives
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3569 ;; a = sqrt( x^2 + (aspect-ratio * y)^2 ) and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3570 ;; b = a / aspect-ratio
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3571 (x-radius (round (sqrt (+ (* width width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3572 (* (* artist-aspect-ratio height)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3573 (* artist-aspect-ratio height))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3574 (y-radius (round (/ x-radius artist-aspect-ratio))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3575 (artist-draw-ellipse-general x1 y1 x-radius y-radius)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3576
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3577 (defalias 'artist-undraw-circle 'artist-undraw-ellipse)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3578
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 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3581 ; Filling ellipses
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3582 ;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3583 (defun artist-fill-ellipse (ellipse x y x-radius y-radius)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3584 "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
3585 (let ((fill-info (aref (artist-2point-get-shapeinfo ellipse) 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3586 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3587 (lambda (fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3588 (artist-move-to-xy (artist-fill-item-get-x fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3589 (artist-fill-item-get-y fill-item))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3590 (artist-replace-chars artist-fill-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3591 (artist-fill-item-get-width fill-item))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3592 fill-item)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3593 fill-info)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3594
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3595 (defalias 'artist-fill-circle 'artist-fill-ellipse)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3596
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3597
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3598 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3599 ;; Cutting, copying and pasting rectangles and squares
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3600 ;; (filling functions)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3601 ;;
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 (defun artist-cut-rect (rect x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3604 "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
3605 (artist-undraw-rect rect)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3606 (artist-copy-generic x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3607 (artist-erase-rect rect x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3608
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3609 (defun artist-cut-square (square x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3610 "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
3611 (artist-undraw-square square)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3612 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3613 (new-x1 (elt square-corners 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3614 (new-y1 (elt square-corners 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3615 (new-x2 (elt square-corners 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3616 (new-y2 (elt square-corners 3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3617 (artist-copy-generic new-x1 new-y1 new-x2 new-y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3618 (artist-erase-rect square new-x1 new-y1 new-x2 new-y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3619
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3620
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3621 (defun artist-get-buffer-contents-at-xy (x y width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3622 "Retrieve contents from the buffer at X, Y. WIDTH characters are returned."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3623 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3624 (let ((here (point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3625 (there (save-excursion (artist-move-to-xy (+ x width) y) (point))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3626 (untabify here there)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3627 (setq there (save-excursion (artist-move-to-xy (+ x width) y) (point)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3628 (buffer-substring here there)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3629
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3630
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3631 (defun artist-copy-generic (x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3632 "Copy a rectangular area with corners at X1, Y1 and X2, Y2.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3633 Output is a copy buffer, a list of strings, representing the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3634 original contents of that area in the buffer."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3635 (let* ((x (min x1 x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3636 (y (min y1 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3637 (x-max (max x1 x2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3638 (y-max (max y1 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3639 (w (+ (- x-max x) 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3640 (l nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3641 (while (<= y y-max)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3642 (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
3643 (setq y (1+ y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3644 (if artist-interface-with-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3645 (setq killed-rectangle (reverse l))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3646 (setq artist-copy-buffer (reverse l)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3647
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3648
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3649 (defun artist-copy-rect (rect x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3650 "Copy rectangle RECT drawn from X1, Y1 to X2, Y2."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3651 (artist-undraw-rect rect)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3652 (artist-copy-generic x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3653
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3654 (defun artist-copy-square (square x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3655 "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
3656 (artist-undraw-square square)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3657 (let* ((square-corners (artist-rect-corners-squarify x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3658 (new-x1 (elt square-corners 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3659 (new-y1 (elt square-corners 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3660 (new-x2 (elt square-corners 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3661 (new-y2 (elt square-corners 3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3662 (artist-copy-generic new-x1 new-y1 new-x2 new-y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3663
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3664 (defun artist-paste (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3665 "Pastes the contents of the copy-buffer at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3666 (let ((copy-buf (if artist-interface-with-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3667 killed-rectangle
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3668 artist-copy-buffer)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3669 (if (not (null copy-buf))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3670 (while (not (null copy-buf))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3671 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3672 (artist-replace-string (car copy-buf))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3673 (setq copy-buf (cdr copy-buf))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3674 (setq y (1+ y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3675 (message "Nothing to paste"))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3676
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3677
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3678 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3679 ;; Flood filling
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3680 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3681 (defun artist-ff-too-far-right (x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3682 "Determine if the position X is too far to the right."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3683 (cond ((numberp artist-flood-fill-right-border)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3684 (> x artist-flood-fill-right-border))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3685 ((eq artist-flood-fill-right-border 'window-width)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3686 (> x (- (window-width) 2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3687 ((eq artist-flood-fill-right-border 'fill-column)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3688 (> x fill-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3689 (t (error "Invalid value for `artist-flood-fill-right-border'"))))
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 (defun artist-ff-get-rightmost-from-xy (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3692 "Find the rightmost position in this run, starting at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3693 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3694 (let ((char-at-xy (artist-get-char-at-xy-conv x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3695 (last-x x))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3696 (setq x (1+ x))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3697 (while (and (not (artist-ff-too-far-right x))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3698 (= char-at-xy (artist-get-char-at-xy-conv x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3699 (setq last-x x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3700 (setq x (1+ x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3701 last-x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3702
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3703 (defun artist-ff-is-topmost-line (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3704 "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
3705 (= y 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3706
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3707 (defun artist-ff-is-bottommost-line (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3708 "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
3709 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3710 (goto-char (point-max))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3711 (beginning-of-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3712 (let ((last-line (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3713 (if (= (point) (point-max))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3714
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3715 ;; Last line is empty, don't paint on it, report previous line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3716 ;; as last line
47953
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
3717 (>= y (- last-line 1))
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
3718 (>= y last-line)))))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3719
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3720 (defun artist-flood-fill (x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3721 "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
3722 (let ((stack nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3723 (input-queue nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3724 ;; We are flood-filling the area that has this character.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3725 (c (artist-get-char-at-xy-conv x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3726 (artist-fill-char (if artist-fill-char-set
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3727 artist-fill-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3728 artist-default-fill-char)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3729
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3730 ;; 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
3731 ;; 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
3732 ;; needn't.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3733 (if (not (= c artist-fill-char))
59224
0bedd71fb49f (artist-butlast-fn): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents: 59223
diff changeset
3734 (push (artist-new-coord x1 y1) stack))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3735
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3736 (while (not (null stack))
59224
0bedd71fb49f (artist-butlast-fn): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents: 59223
diff changeset
3737 (let* ((coord (pop stack))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3738 (x (artist-coord-get-x coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3739 (y (artist-coord-get-y coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3740
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3741 ;; Here we keep track of the leftmost and rightmost position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3742 ;; for this run
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3743 (x-leftmost 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3744 (x-rightmost 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3745 (last-x 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3746
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3747 ;; Remember if line above and below are accessible
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3748 ;; Lines below the last one, and prior to the first-one
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3749 ;; are not accessible.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3750 (lines-above nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3751 (lines-below nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3752
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3753 ;; Remember char for position on line above and below, so we
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3754 ;; can find the rightmost positions on the runs.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3755 (last-c-above -1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3756 (last-c-below -1))
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 (setq x-rightmost (artist-ff-get-rightmost-from-xy x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3759 (setq lines-above (not (artist-ff-is-topmost-line x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3760 (setq lines-below (not (artist-ff-is-bottommost-line x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3761 (setq last-x x-rightmost)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3762 (setq x x-rightmost)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3763
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3764 ;; Search line above, push rightmost positions of runs for that line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3765 (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
3766 (if lines-above
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3767 (let ((c-above (artist-get-char-at-xy-conv x (- y 1))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3768 (if (and (= c-above c) (/= c-above last-c-above))
59224
0bedd71fb49f (artist-butlast-fn): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents: 59223
diff changeset
3769 (push (artist-new-coord x (- y 1)) stack))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3770 (setq last-c-above c-above)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3771 (setq last-x x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3772 (setq x (- x 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3773
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3774 ;; Remember the left-most position on this run
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3775 (setq x-leftmost last-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3776
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3777 ;; Search line below, push rightmost positions of runs for that line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3778 (setq x x-rightmost)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3779 (while (>= x x-leftmost)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3780 (if lines-below
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3781 (let ((c-below (artist-get-char-at-xy-conv x (1+ y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3782 (if (and (= c-below c) (/= c-below last-c-below))
59224
0bedd71fb49f (artist-butlast-fn): Var deleted.
Richard M. Stallman <rms@gnu.org>
parents: 59223
diff changeset
3783 (push (artist-new-coord x (1+ y)) stack))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3784 (setq last-c-below c-below)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3785 (setq x (- x 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3786
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3787 (artist-move-to-xy x-leftmost y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3788 (artist-replace-chars artist-fill-char (1+ (- x-rightmost x-leftmost)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3789
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3790 ;; If we are to show incrementally, we have to remove any pending
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3791 ;; input from the input queue, because processing of pending input
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3792 ;; always has priority over display updates (although this input
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3793 ;; 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
3794 ;; the input on the input queue again.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3795 (if artist-flood-fill-show-incrementally
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3796 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3797 (if (input-pending-p)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3798 (discard-input))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3799 (artist-update-display)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3800
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3801 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3802 ;; Accessors to arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3803 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3804
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3805 (defun artist-make-arrow-point (x y direction &optional state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3806 "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
3807 Optional argument STATE can be used to set state (default is nil)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3808 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3809 (let* ((arrow-point (make-vector 4 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3810 (arrow-marker (make-marker)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3811 (artist-move-to-xy x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3812 (set-marker arrow-marker (point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3813 (aset arrow-point 0 arrow-marker)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3814 (aset arrow-point 1 (artist-get-char-at-xy x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3815 (aset arrow-point 2 direction)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3816 (aset arrow-point 3 state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3817 arrow-point)))
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 (defsubst artist-arrow-point-get-marker (arrow-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3820 "Retrieve the marker component of an ARROW-POINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3821 (aref arrow-point 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3822
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3823 (defsubst artist-arrow-point-get-orig-char (arrow-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3824 "Retrieve the orig char component of an ARROW-POINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3825 (aref arrow-point 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3826
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3827 (defsubst artist-arrow-point-get-direction (arrow-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3828 "Retrieve the direction component of an ARROW-POINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3829 (aref arrow-point 2))
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 (defsubst artist-arrow-point-get-state (arrow-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3832 "Retrieve the state component of an ARROW-POINT."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3833 (aref arrow-point 3))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3834
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3835 (defsubst artist-arrow-point-set-state (arrow-point new-state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3836 "Set the state component of an ARROW-POINT to NEW-STATE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3837 (aset arrow-point 3 new-state))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3838
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3839
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3840 (defun artist-clear-arrow-points ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3841 "Clear current endpoints."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3842 (setq artist-arrow-point-1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3843 (setq artist-arrow-point-2 nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3844
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3845 (defun artist-set-arrow-points-for-poly (point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3846 "Generic function for setting arrow-points for poly-shapes from POINT-LIST."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3847 (let* ((ep1 (elt point-list 0))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3848 (ep2 (elt point-list 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3849 (x1 (artist-endpoint-get-x ep1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3850 (y1 (artist-endpoint-get-y ep1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3851 (x2 (artist-endpoint-get-x ep2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3852 (y2 (artist-endpoint-get-y ep2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3853 (dir1 (artist-find-direction x2 y2 x1 y1))
65872
c9a88ce08e2d (artist-ellipse-mirror-quadrant): Fix bug introduced 2005-07-03:
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 65680
diff changeset
3854 (epn (car (last point-list)))
c9a88ce08e2d (artist-ellipse-mirror-quadrant): Fix bug introduced 2005-07-03:
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 65680
diff changeset
3855 (epn-1 (car (last point-list 2)))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3856 (xn (artist-endpoint-get-x epn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3857 (yn (artist-endpoint-get-y epn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3858 (xn-1 (artist-endpoint-get-x epn-1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3859 (yn-1 (artist-endpoint-get-y epn-1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3860 (dirn (artist-find-direction xn-1 yn-1 xn yn)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3861 (setq artist-arrow-point-1 (artist-make-arrow-point x1 y1 dir1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3862 (setq artist-arrow-point-2 (artist-make-arrow-point xn yn dirn))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3863
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3864
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3865 (defun artist-set-arrow-points-for-2points (shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3866 "Generic function for setting arrow-points for 2-point shapes.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3867 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
3868 (let* ((endpoint1 (artist-2point-get-endpoint1 shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3869 (endpoint2 (artist-2point-get-endpoint2 shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3870 (x1 (artist-endpoint-get-x endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3871 (y1 (artist-endpoint-get-y endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3872 (x2 (artist-endpoint-get-x endpoint2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3873 (y2 (artist-endpoint-get-y endpoint2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3874 (setq artist-arrow-point-1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3875 (artist-make-arrow-point x1 y1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3876 (artist-find-direction x2 y2 x1 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3877 (setq artist-arrow-point-2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3878 (artist-make-arrow-point x2 y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3879 (artist-find-direction x1 y1 x2 y2)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3880
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3881
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3882 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3883 ;; Common routine for drawing/undrawing shapes based
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3884 ;; on the draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3885 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3886
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3887 (defun artist-key-undraw-continously (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3888 "Undraw current continous shape with point at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3889 ;; No undraw-info for continous shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3890 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3891
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3892 (defun artist-key-undraw-poly (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3893 "Undraw current poly shape with point at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3894 (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
3895 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3896 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3897 (artist-funcall undraw-fn artist-key-shape)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3898
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3899 (defun artist-key-undraw-1point (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3900 "Undraw current 1-point shape at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3901 ;; No undraw-info for 1-point shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3902 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3903
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3904 (defun artist-key-undraw-2points (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3905 "Undraw current 2-point shape at X, Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3906 (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
3907 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3908 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3909 (artist-funcall undraw-fn artist-key-shape)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3910
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3911 (defun artist-key-undraw-common ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3912 "Common routine undrawing current shape."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3913 (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
3914 (col (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3915 (row (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3916
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3917 ;; Depending on what we are currently drawing, call other routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3918 ;; that knows how to do the job
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 (cond ((eq draw-how 'artist-do-continously)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3921 (artist-key-undraw-continously col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3922 ((eq draw-how 'artist-do-poly)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3923 (artist-key-undraw-poly col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3924 ((and (numberp draw-how) (= draw-how 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3925 (artist-key-undraw-1point col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3926 ((and (numberp draw-how) (= draw-how 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3927 (artist-key-undraw-2points col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3928 (t (message "Undrawing \"%s\"s is not yet implemented" draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3929
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3930 ;; Now restore the old position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3931 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3932 (artist-move-to-xy col row)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3933
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3934
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3935
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3936 ;; Implementation note: This really should honor the interval-fn entry
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3937 ;; in the master table, `artist-mt', which would mean leaving a timer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3938 ;; 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
3939 ;; to be cancelled and reinstalled whenever the user moves the cursor.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3940 ;; 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
3941 ;; 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
3942 ;; simpler: when at the end of `artist-mouse-draw-continously', the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3943 ;; user has released the button, so the timer will always be cancelled
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3944 ;; at that point.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3945 (defun artist-key-draw-continously (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3946 "Draws current continous shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3947 (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
3948 (setq artist-key-shape (artist-funcall draw-fn x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3949
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3950 (defun artist-key-draw-poly (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3951 "Draws current poly-point shape with nth point at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3952 (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
3953 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3954 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3955 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3956
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3957 (defun artist-key-draw-1point (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3958 "Draws current 1-point shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3959 (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
3960 (setq artist-key-shape (artist-funcall draw-fn x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3961
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3962
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3963 (defun artist-key-draw-2points (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3964 "Draws current 2-point shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3965 (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
3966 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3967 (y1 (artist-endpoint-get-y artist-key-endpoint1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3968 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3969
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3970 (defun artist-key-draw-common ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3971 "Common routine for drawing current shape."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3972 (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
3973 (col (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3974 (row (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3975
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3976 ;; Depending on what we are currently drawing, call other routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3977 ;; that knows how to do the job
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 (cond ((eq draw-how 'artist-do-continously)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3980 (artist-key-draw-continously col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3981 ((eq draw-how 'artist-do-poly)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3982 (artist-key-draw-poly col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3983 ((and (numberp draw-how) (= draw-how 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3984 (artist-key-draw-1point col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3985 ((and (numberp draw-how) (= draw-how 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3986 (artist-key-draw-2points col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3987 (t (message "Drawing \"%s\"s is not yet implemented" draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3988
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3989 ;; Now restore the old position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3990 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3991 (artist-move-to-xy col row)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3992
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3993
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3994
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3995 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3996 ;; Functions related to trimming line-endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3997 ;; The region between the topmost and bottommost visited line is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3998 ;; called a draw-region.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
3999 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4000
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4001 (defun artist-draw-region-reset ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4002 "Reset the current draw-region."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4003 (setq artist-draw-region-max-y 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4004 (setq artist-draw-region-min-y 1000000))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4005
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4006 (defun artist-draw-region-trim-line-endings (min-y max-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4007 "Trim lines in current draw-region from MIN-Y to MAX-Y.
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
4008 Trimming here means removing white space at end of a line."
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4009 ;; 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
4010 (if (< max-y min-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4011 (let ((tmp min-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4012 (setq min-y max-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4013 (setq max-y tmp)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4014 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4015 (let ((curr-y min-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4016 (while (<= curr-y max-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4017 (artist-move-to-xy 0 curr-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4018 (end-of-line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4019 (delete-horizontal-space)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4020 (setq curr-y (1+ curr-y))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4021
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4022 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4023 ;; Drawing shapes by using keys
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4024 ;;
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 (defun artist-key-do-continously-continously (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4027 "Update current continous shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4028 (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
4029 (artist-funcall draw-fn x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4030
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4031
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4032 (defun artist-key-do-continously-poly (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4033 "Update current poly-point shape with nth point at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4034 (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
4035 (undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4036 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4037 (y1 (artist-endpoint-get-y artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4038 (x2 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4039 (y2 y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4040 ;; If not rubber-banding, then move the 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4041 ;; Otherwise re-draw the shape to the new position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4042 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4043 (if (not artist-rubber-banding)
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 (artist-no-rb-unset-point2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4046 (artist-no-rb-set-point2 x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4047 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4048 (artist-funcall undraw-fn artist-key-shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4049 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4050
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 (defun artist-key-do-continously-1point (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4053 "Update current 1-point shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4054 ;; Nothing to do continously for operations
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4055 ;; where we have only one input point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4056 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4057
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4058 (defun artist-key-do-continously-2points (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4059 "Update current 2-point shape with 2nd point at X,Y."
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 (undraw-fn (artist-go-get-undraw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4062 (x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4063 (y1 (artist-endpoint-get-y artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4064 (x2 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4065 (y2 y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4066 ;; If not rubber-banding, then move the 2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4067 ;; Otherwise re-draw the shape to the new position
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-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4070 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4071 (artist-no-rb-unset-point2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4072 (artist-no-rb-set-point2 x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4073 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4074 (artist-funcall undraw-fn artist-key-shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4075 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4076
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4077
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4078 (defun artist-key-do-continously-common ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4079 "Common routine for updating current shape."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4080 (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
4081 (col (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4082 (row (artist-current-line)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4083
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4084 ;; Depending on what we are currently drawing, call other routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4085 ;; that knows how to do the job
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4086 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4087 (cond ((eq draw-how 'artist-do-continously)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4088 (artist-key-do-continously-continously col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4089 ((eq draw-how 'artist-do-poly)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4090 (artist-key-do-continously-poly col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4091 ((and (numberp draw-how) (= draw-how 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4092 (artist-key-do-continously-1point col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4093 ((and (numberp draw-how) (= draw-how 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4094 (artist-key-do-continously-2points col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4095 (t (message "Drawing \"%s\"s is not yet implemented" draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4096
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4097 ;; Now restore the old position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4098 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4099 (artist-move-to-xy col row)))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4102 (defun artist-key-set-point-continously (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4103 "Set point for current continous shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4104 ;; Maybe set arrow-points for continous shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4105 (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
4106 (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
4107 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4108 (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
4109 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4110
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4111 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4112 ;; *** We are about to begin drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4113 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4114 (artist-funcall init-fn x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4115
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4116 ;; *** We are about to stop drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4117 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4118
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4119 (artist-funcall prep-fill-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4120 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4121 (artist-funcall arrow-set-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4122 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4123 (artist-funcall exit-fn x y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4124
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4125 ;; Toggle the is-drawing flag
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4126 (setq artist-key-is-drawing (not artist-key-is-drawing)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4127
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4128
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4129
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4130 (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
4131 "Set point for current poly-point shape at X,Y.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4132 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
4133 (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
4134 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4135 (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
4136 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4137 (fill-pred (artist-go-get-fill-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4138 (fill-fn (artist-go-get-fill-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4139 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4140 (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
4141
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4142 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4143
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4144 ;; *** We were not drawing ==> set first point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4145 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4146
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4147 (artist-funcall init-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4148
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4149 ;; If not rubber-banding, set first point.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4150 ;; Otherwise, draw the shape from x,y to x,y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4151 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4152 (artist-no-rb-set-point1 x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4153 (setq artist-key-shape (artist-funcall draw-fn x y x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4154
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4155 ;; Set first endpoint
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4156 (setq artist-key-endpoint1 (artist-make-endpoint x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4157
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4158 ;; Set point-list to contain start point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4159 (setq artist-key-poly-point-list (list (artist-make-endpoint x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4160
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4161 ;; Since we are not ready, set the arrow-points to nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4162 (artist-clear-arrow-points)
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 ;; Change state to drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4165 (setq artist-key-is-drawing t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4166
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4167 ;; Feedback
65583
703495630901 Message format spec fixes (2)
Deepak Goel <deego@gnufans.org>
parents: 65260
diff changeset
4168 (message "%s" (substitute-command-keys
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4169 (concat "First point set. "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4170 "Set next with \\[artist-key-set-point], "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4171 "set last with C-u \\[artist-key-set-point]"))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4172
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4173
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4174 ;; *** We were drawing ==> we are about to set nth point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4175 ;; (last point if the argument this-is-last-point is non-nil)
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 (let ((x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4178 (y1 (artist-endpoint-get-y artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4179 (x2 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4180 (y2 y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4181
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4182 ;; If not rubber-banding, undraw the 1's and 2's, then
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4183 ;; draw the shape (if we were rubber-banding, then the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4184 ;; shape is already drawn in artist-key-do-continously-2points.)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4185 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4186 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4187 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4188 (artist-no-rb-unset-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4189 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4190
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4191 ;; Set x2 and y2 from shape's second point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4192 ;; (which might be different from the mouse's second point,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4193 ;; if, for example, we are drawing a straight line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4194 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4195 (if (not (null artist-key-shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4196 (let ((endpoint2 (artist-2point-get-endpoint2 artist-key-shape)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4197 (setq x2 (artist-endpoint-get-x endpoint2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4198 (setq y2 (artist-endpoint-get-y endpoint2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4199
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4200 ;; Add the endpoint to the list of poly-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4201 (setq artist-key-poly-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4202 (append artist-key-poly-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4203 (list (artist-make-endpoint x2 y2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4204
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4205 ;; Now do handle the case when this is the last point,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4206 ;; and the case when this point isn't the last
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4207 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4208 (if (not this-is-last-point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4209 ;; ** This is not the last 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 ;; Start drawing a new 2-point-shape from last endpoint.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4212
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4213 ;; First set the start-point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4214 (setq x1 x2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4215 (setq y1 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4216 (setq artist-key-endpoint1 (artist-make-endpoint x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4217
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4218 ;; If we are not rubber-banding, then place the '1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4219 ;; Otherwise, draw the shape from x1,y1 to x1,y1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4220 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4221 (artist-no-rb-set-point1 x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4222 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x1 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4223
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4224 ;; Feedback
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4225 (message "Point set"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4226
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4227 ;; ** This is the last point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4228 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4229
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4230 (artist-funcall prep-fill-fn artist-key-poly-point-list)
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 ;; Maybe fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4233 (if (artist-funcall fill-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4234 (artist-funcall fill-fn artist-key-shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4235 artist-key-poly-point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4236
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4237 ;; Set the arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4238 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4239 (artist-funcall arrow-set-fn artist-key-poly-point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4240 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4241
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4242 (artist-funcall exit-fn artist-key-poly-point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4243
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4244 ;; Change state to not drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4245 (setq artist-key-shape nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4246 (setq artist-key-endpoint1 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4247 (setq artist-key-is-drawing nil)))))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4248
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4249
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4250 (defun artist-key-set-point-1point (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4251 "Set point for current 1-point shape at X,Y."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4252 (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
4253 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4254 (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
4255 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4256 (draw-fn (artist-go-get-draw-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4257 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4258 (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
4259 (artist-funcall init-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4260 (artist-funcall draw-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4261 (artist-funcall prep-fill-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4262 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4263 (artist-funcall arrow-set-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4264 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4265 (artist-funcall exit-fn x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4266 (setq artist-key-shape nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4267 (setq artist-key-is-drawing nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4268
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4269
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4270 (defun artist-key-set-point-2points (x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4271 "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
4272 (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
4273 (init-fn (artist-go-get-init-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4274 (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
4275 (exit-fn (artist-go-get-exit-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4276 (fill-pred (artist-go-get-fill-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4277 (fill-fn (artist-go-get-fill-fn-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4278 (arrow-pred (artist-go-get-arrow-pred-from-symbol artist-curr-go))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4279 (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
4280 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4281
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4282 ;; *** We were not drawing ==> set first point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4283 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4284
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4285 (artist-funcall init-fn x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4286
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4287 ;; If not rubber-banding, set first point.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4288 ;; Otherwise, draw the shape from x,y to x,y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4289 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4290 (artist-no-rb-set-point1 x y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4291 (setq artist-key-shape (artist-funcall draw-fn x y x y)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4292
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4293 ;; Set first endpoint
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4294 (setq artist-key-endpoint1 (artist-make-endpoint x y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4295
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4296 ;; Since we are not ready, clear the arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4297 (artist-clear-arrow-points)
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 ;; Change state to drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4300 (setq artist-key-is-drawing t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4301
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4302 ;; *** We were drawing ==> we are about to set 2nd point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4303 ;; and end the drawing operation
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 (let ((x1 (artist-endpoint-get-x artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4306 (y1 (artist-endpoint-get-y artist-key-endpoint1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4307 (x2 x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4308 (y2 y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4309
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4310 ;; If not rubber-banding, undraw the 1's and 2's, then
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4311 ;; draw the shape (if we were rubber-banding, then the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4312 ;; shape is already drawn in artist-key-do-continously-2points.)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4313 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4314 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4315 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4316 (artist-no-rb-unset-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4317 (setq artist-key-shape (artist-funcall draw-fn x1 y1 x2 y2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4318
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4319 (artist-funcall prep-fill-fn artist-key-shape x1 y1 x2 y2)
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 ;; Maybe fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4322 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4323 (if (artist-funcall fill-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4324 (artist-funcall fill-fn artist-key-shape x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4325
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4326 ;; Maybe set the arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4327 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4328 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4329 (artist-funcall arrow-set-fn artist-key-shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4330 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4331
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4332 (artist-funcall exit-fn artist-key-shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4333
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4334 ;; Change state to not drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4335 (setq artist-key-is-drawing nil)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4336
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4337
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4338 (defun artist-key-set-point-common (arg)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4339 "Common routine for setting point in current shape.
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
4340 With non-nil ARG, set the last point."
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4341 (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
4342 (col (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4343 (row (artist-current-line))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4344 (was-drawing artist-key-is-drawing))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4345
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4346 ;; First, if we are about to draw, then reset the draw-region
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4347 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4348 (artist-draw-region-reset))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4349
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4350 ;; Depending on what we are currently drawing, call other routines
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4351 ;; that knows how to do the job
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4352 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4353 (cond ((eq draw-how 'artist-do-continously)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4354 (artist-key-set-point-continously col row)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4355 ;; Do this now, otherwise nothing will happen until we move.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4356 (artist-key-do-continously-continously col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4357 ((eq draw-how 'artist-do-poly)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4358 (artist-key-set-point-poly col row arg))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4359 ((and (numberp draw-how) (= draw-how 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4360 (artist-key-set-point-1point col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4361 ((and (numberp draw-how) (= draw-how 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4362 (artist-key-set-point-2points col row))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4363 (t (message "Drawing \"%s\"s is not yet implemented" draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4364
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4365 ;; Maybe trim line endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4366 (if (and artist-trim-line-endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4367 was-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4368 (not artist-key-is-drawing))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4369 (artist-draw-region-trim-line-endings artist-draw-region-min-y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4370 artist-draw-region-max-y))
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 ;; Now restore the old position
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4373 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4374 (artist-move-to-xy col row)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4375 (artist-mode-line-show-curr-operation artist-key-is-drawing)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4376
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4377 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4378 ;; Key navigation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4379 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4380
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4381 (defun artist-previous-line (&optional n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4382 "Move cursor up optional N lines (default is 1), updating current shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4383 If N is negative, move cursor down."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4384 (interactive "p")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4385 (let ((col (artist-current-column)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4386 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4387 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4388 (previous-line n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4389 (move-to-column col t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4390 (previous-line n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4391 (move-to-column col t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4392 (artist-key-do-continously-common))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4393
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-next-line (&optional n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4396 "Move cursor down optional N lines (default is 1), updating current shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4397 If N is negative, move cursor up."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4398 (interactive "p")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4399 (let ((col (artist-current-column)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4400 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4401 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4402 (next-line n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4403 (move-to-column col t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4404 (next-line n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4405 (move-to-column col t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4406 (artist-key-do-continously-common))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4407
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4408 (defun artist-backward-char (&optional n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4409 "Move cursor backward optional N chars (default is 1), updating curr shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4410 If N is negative, move forward."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4411 (interactive "p")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4412 (if (> n 0)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4413 (artist-forward-char (- n))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4414 (artist-forward-char n)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4415
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4416 (defun artist-forward-char (&optional n)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4417 "Move cursor forward optional N chars (default is 1), updating curr shape.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4418 If N is negative, move backward."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4419 (interactive "p")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4420 (let* ((step-x (if (>= n 0) 1 -1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4421 (distance (abs n))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4422 (curr-col (artist-current-column))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4423 (new-col (max 0 (+ curr-col (* distance step-x)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4424 (if (not artist-key-is-drawing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4425 (move-to-column new-col t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4426 (move-to-column new-col t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4427 (artist-key-do-continously-common))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4428
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4429
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4430 (defun artist-key-set-point (&optional arg)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4431 "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
4432 (interactive "P")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4433 (artist-key-set-point-common arg))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4434
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4435
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4436 (defun artist-select-fill-char (c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4437 "Set current fill character to be C."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4438 (interactive "cType fill char (type RET to turn off): ")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4439 (cond ((eq c ?\r) (setq artist-fill-char-set nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4440 (message "Fill cancelled"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4441 (t (setq artist-fill-char-set t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4442 (setq artist-fill-char c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4443 (message "Fill set to \"%c\"" c))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4444
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4445
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4446 (defun artist-select-line-char (c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4447 "Set current line character to be C."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4448 (interactive "cType line char (type RET to turn off): ")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4449 (cond ((eq c ?\r) (setq artist-line-char-set nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4450 (message "Normal lines"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4451 (t (setq artist-line-char-set t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4452 (setq artist-line-char c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4453 (message "Line drawn with \"%c\"" c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4454 (if artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4455 (artist-key-do-continously-common)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4456
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4457
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4458 (defun artist-select-erase-char (c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4459 "Set current erase character to be C."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4460 (interactive "cType char to use when erasing (type RET for normal): ")
65260
c1dcf33345ab (x-pointer-crosshair): Add defvar.
Juanma Barranquero <lekktu@gmail.com>
parents: 64751
diff changeset
4461 (cond ((eq c ?\r) (setq artist-erase-char ?\s)
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4462 (message "Normal erasing"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4463 (t (setq artist-erase-char c)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4464 (message "Erasing with \"%c\"" c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4465 (if artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4466 (artist-key-do-continously-common)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4467
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4468 (defun artist-charlist-to-string (char-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4469 "Convert a list of characters, CHAR-LIST, to a string."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4470 (let ((result ""))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4471 (while (not (null char-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4472 (setq result (concat result (char-to-string (car char-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4473 (setq char-list (cdr char-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4474 result))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4475
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4476 (defun artist-string-to-charlist (str)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4477 "Convert a string, STR, to list of characters."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4478 (append str nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4479
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4480 (defun artist-select-spray-chars (chars initial-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4481 "Set current spray characters to be CHARS, starting with INITIAL-CHAR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4482 ;; This huge unreadable `interactive'-clause does the following
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4483 ;; 1. Asks for a string of spray-characters
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4484 ;; 2. Asks for the initial character (default is the first),
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4485 ;; 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
4486 (interactive
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4487 (let* ((str (read-string "Select spray-can characters, lightest first: "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4488 (artist-charlist-to-string artist-spray-chars)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4489 (char-list (artist-string-to-charlist str))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4490 (initial (let* ((err-msg "")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4491 (ok nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4492 (first-char-as-str (char-to-string (car char-list)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4493 (first-s) (first-c))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4494 (while (not ok)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4495 (setq first-s
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4496 (read-string
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4497 (format (concat "%sSelect initial-character, "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4498 "one of \"%s\" (%s): ")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4499 err-msg str first-char-as-str)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4500 (if (equal first-s "")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4501 (setq first-s first-char-as-str))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4502 (setq first-c (car (artist-string-to-charlist first-s)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4503 (setq ok (not (null (member first-c char-list))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4504 (if (not ok)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4505 (setq err-msg (format
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4506 "Not in spray-chars: \"%s\". "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4507 (char-to-string first-c)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4508 first-c)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4509 (list char-list initial)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4510 (setq artist-spray-chars chars)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4511 (setq artist-spray-new-char initial-char)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4512 (message "Spray-chars set to \"%s\", initial: \"%s\""
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4513 (artist-charlist-to-string chars) (char-to-string initial-char)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4514
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 (defun artist-select-operation (op-str)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4517 "Select drawing operation OP-STR."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4518 (interactive (list (completing-read "Select operation: "
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4519 artist-key-compl-table)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4520 (let* ((op-symbol (artist-mt-get-symbol-from-keyword op-str))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4521 (draw-how (if op-symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4522 (artist-go-get-draw-how-from-symbol op-symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4523 nil)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4524 ;; First check that the string was valid
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4525 (if (null op-symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4526 (error "Unknown drawing method: %s" op-str))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4527
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4528 ;; Second, check that we are not about to switch to a different
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4529 ;; kind of shape (do that only if we are drawing with keys;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4530 ;; otherwise this function cannot get called).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4531 (if (and artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4532 (not (equal artist-key-draw-how draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4533 (error "Cannot switch to a different kind of shape while drawing"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4534
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4535 ;; If we were drawing, undraw the shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4536 (if (and artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4537 artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4538 (artist-key-undraw-common))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4539
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4540 ;; Set the current operation and draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4541 (setq artist-curr-go op-symbol)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4542 (setq artist-key-draw-how draw-how)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4543
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4544 ;; If we were drawing, redraw the shape (but don't if shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4545 ;; is drawn by setting only one point)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4546 (if (and artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4547 artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4548 (not (eq artist-key-draw-how 1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4549 (artist-key-draw-common)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4550
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4551 ;; Feedback
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4552 (artist-mode-line-show-curr-operation artist-key-is-drawing))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4555 (defun artist-toggle-rubber-banding (&optional state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4556 "Toggle rubber-banding.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4557 If optional argument STATE is positive, turn rubber-banding on."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4558 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4559 (if artist-key-is-drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4560 (error "Cannot toggle rubber-banding while drawing"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4561 (if (setq artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4562 (if (null state) (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4563 (> (prefix-numeric-value state) 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4564 (message "Rubber-banding is now on")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4565 (message "Rubber-banding is now off")))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4568 (defun artist-toggle-trim-line-endings (&optional state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4569 "Toggle trimming of line-endings.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4570 If optional argument STATE is positive, turn trimming on."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4571 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4572 (if (setq artist-trim-line-endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4573 (if (null state) (not artist-trim-line-endings)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4574 (> (prefix-numeric-value state) 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4575 (message "Trimming is now on")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4576 (message "Trimming is now off")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4577
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4578
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4579 (defun artist-toggle-borderless-shapes (&optional state)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4580 "Toggle borders of shapes.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4581 If optional argument STATE is positive, turn borders on."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4582 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4583 (if (setq artist-borderless-shapes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4584 (if (null state) (not artist-borderless-shapes)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4585 (> (prefix-numeric-value state) 0)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4586 (message "Borders are now off")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4587 (message "Borders are now on")))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4588
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4589
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4590 (defun artist-toggle-first-arrow ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4591 "Toggle first arrow for shape, if possible."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4592 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4593 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4594 (if (not (null artist-arrow-point-1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4595 (let* ((arrow-point artist-arrow-point-1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4596 (arrow-state (artist-arrow-point-get-state arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4597 (arrow-marker (artist-arrow-point-get-marker arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4598 (direction (artist-arrow-point-get-direction arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4599 (orig-char (artist-arrow-point-get-orig-char arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4600 (arrow-char (aref artist-arrows direction))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4601 (new-state (not arrow-state)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4602
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4603 (goto-char (marker-position arrow-marker))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4604
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4605 (if new-state
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4606 (if arrow-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4607 (artist-replace-char arrow-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4608 (artist-replace-char orig-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4609
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4610 (artist-arrow-point-set-state artist-arrow-point-1 new-state)))))
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-toggle-second-arrow ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4613 "Toggle second arrow for shape, if possible."
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 (save-excursion
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4616 (if (not (null artist-arrow-point-2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4617 (let* ((arrow-point artist-arrow-point-2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4618 (arrow-state (artist-arrow-point-get-state arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4619 (arrow-marker (artist-arrow-point-get-marker arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4620 (direction (artist-arrow-point-get-direction arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4621 (orig-char (artist-arrow-point-get-orig-char arrow-point))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4622 (arrow-char (aref artist-arrows direction))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4623 (new-state (not arrow-state)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4624
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4625 (goto-char (marker-position arrow-marker))
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 (if new-state
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4628 (if arrow-char
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4629 (artist-replace-char arrow-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4630 (artist-replace-char orig-char))
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 (artist-arrow-point-set-state artist-arrow-point-2 new-state)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4633
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4634
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4635 (defun artist-select-op-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4636 "Select drawing lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4637 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4638 (artist-select-operation "line"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4639
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4640 (defun artist-select-op-straight-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4641 "Select drawing straight lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4642 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4643 (artist-select-operation "straight line"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4644
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4645 (defun artist-select-op-rectangle ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4646 "Select drawing rectangles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4647 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4648 (artist-select-operation "rectangle"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4649
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4650 (defun artist-select-op-square ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4651 "Select drawing squares."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4652 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4653 (artist-select-operation "square"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4654
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4655 (defun artist-select-op-poly-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4656 "Select drawing poly-lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4657 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4658 (artist-select-operation "poly-line"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4659
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4660 (defun artist-select-op-straight-poly-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4661 "Select drawing straight poly-lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4662 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4663 (artist-select-operation "straight poly-line"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4664
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4665 (defun artist-select-op-ellipse ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4666 "Select drawing ellipses."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4667 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4668 (artist-select-operation "ellipse"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4669
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4670 (defun artist-select-op-circle ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4671 "Select drawing circles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4672 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4673 (artist-select-operation "circle"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4674
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4675 (defun artist-select-op-text-see-thru ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4676 "Select rendering text (see thru)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4677 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4678 (artist-select-operation "text see-thru"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4679
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4680 (defun artist-select-op-text-overwrite ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4681 "Select rendering text (overwrite)."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4682 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4683 (artist-select-operation "text overwrite"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4684
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4685 (defun artist-select-op-spray-can ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4686 "Select spraying."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4687 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4688 (artist-select-operation "spray-can"))
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-select-op-spray-set-size ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4691 "Select setting size for spraying."
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 (artist-select-operation "spray set size"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4694
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4695 (defun artist-select-op-erase-char ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4696 "Select erasing characters."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4697 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4698 (artist-select-operation "erase char"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4699
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4700 (defun artist-select-op-erase-rectangle ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4701 "Select erasing rectangles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4702 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4703 (artist-select-operation "erase rectangle"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4704
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4705 (defun artist-select-op-vaporize-line ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4706 "Select vaporizing single lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4707 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4708 (artist-select-operation "vaporize line"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4709
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4710 (defun artist-select-op-vaporize-lines ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4711 "Select vaporizing connected lines."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4712 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4713 (artist-select-operation "vaporize lines"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4714
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4715 (defun artist-select-op-cut-rectangle ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4716 "Select cutting rectangles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4717 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4718 (artist-select-operation "cut rectangle"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4719
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4720 (defun artist-select-op-cut-square ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4721 "Select cutting squares."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4722 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4723 (artist-select-operation "cut square"))
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 (defun artist-select-op-copy-rectangle ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4726 "Select copying rectangles."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4727 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4728 (artist-select-operation "copy rectangle"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4729
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4730 (defun artist-select-op-copy-square ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4731 "Select copying squares."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4732 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4733 (artist-select-operation "cut square"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4734
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4735 (defun artist-select-op-paste ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4736 "Select pasting."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4737 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4738 (artist-select-operation "paste"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4739
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4740 (defun artist-select-op-flood-fill ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4741 "Select flood-filling."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4742 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4743 (artist-select-operation "flood-fill"))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4744
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 ;; Drawing lines by using mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4747 ;; Mouse button actions
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4748 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4749
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4750 (defun artist-update-pointer-shape ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4751 "Perform the update of the X Windows pointer shape."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4752 (set-mouse-color nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4753
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4754 (defun artist-set-pointer-shape (new-pointer-shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4755 "Set the shape of the X Windows pointer to NEW-POINTER-SHAPE."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4756 (setq x-pointer-shape new-pointer-shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4757 (artist-update-pointer-shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4758
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4759 (defsubst artist-event-is-shifted (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4760 "Check whether the shift-key is pressed in event EV."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4761 (memq 'shift (event-modifiers ev)))
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 (defun artist-do-nothing ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4764 "Function that does nothing."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4765 (interactive))
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 (defun artist-down-mouse-1 (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4768 "Perform drawing action for event EV."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4769 (interactive "@e")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4770 (let* ((real (artist-go-get-symbol-shift
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4771 artist-curr-go (artist-event-is-shifted ev)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4772 (draw-how (artist-go-get-draw-how-from-symbol real))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4773 ;; Remember original values for draw-region-min-y and max-y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4774 ;; in case we are interrupting a key-draw operation.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4775 (orig-draw-region-min-y artist-draw-region-min-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4776 (orig-draw-region-max-y artist-draw-region-max-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4777 (orig-pointer-shape (if (eq window-system 'x) x-pointer-shape nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4778 (echo-keystrokes 10000) ; a lot of seconds
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4779 ;; Remember original binding for the button-up event to this
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4780 ;; button-down event.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4781 (key (let* ((basic (event-basic-type ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4782 (unshifted basic)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4783 (shifted (make-symbol (concat "S-" (symbol-name basic)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4784 (if (artist-event-is-shifted ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4785 (make-vector 1 shifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4786 (make-vector 1 unshifted))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4787 (orig-button-up-binding (lookup-key (current-global-map) key)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4788
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4789 (unwind-protect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4790 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4791 (if (eq window-system 'x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4792 (artist-set-pointer-shape artist-pointer-shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4793
47953
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
4794 ;; Redefine the button-up binding temporarily (the original
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4795 ;; binding is restored in the unwind-forms below). This is to
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4796 ;; avoid the phenomenon outlined in this scenario:
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 ;; 1. A routine which reads something from the mini-buffer (such
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4799 ;; as the text renderer) is called from below.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4800 ;; 2. Meanwhile, the users releases the mouse button.
47953
126b6cb8740d (artist-ff-is-bottommost-line): Fix misplaced ELSE expression on IF.
Juanma Barranquero <lekktu@gmail.com>
parents: 46163
diff changeset
4801 ;; 3. As a (funny :-) coincidence, the binding for the
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4802 ;; button-up event is often mouse-set-point, so Emacs
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4803 ;; sets the point to where the button was released, which is
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4804 ;; in the buffer where the user wants to place the text.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4805 ;; 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
4806 ;; until he reaches the mini-buffer which is still prompting
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4807 ;; for some text to render.
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 ;; To do this foolproof, all local and minor-mode maps should
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4810 ;; be searched and temporarily changed as well, since they
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4811 ;; too might have some binding for the button-up event,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4812 ;; but I hope dealing with the global map will suffice.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4813 (define-key (current-global-map) key 'artist-do-nothing)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4814
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4815 (artist-draw-region-reset)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4816
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4817 (artist-mode-line-show-curr-operation t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4818
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4819 (cond ((eq draw-how 'artist-do-continously)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4820 (artist-mouse-draw-continously ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4821 ((eq draw-how 'artist-do-poly)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4822 (artist-mouse-draw-poly ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4823 ((and (numberp draw-how) (= draw-how 1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4824 (artist-mouse-draw-1point ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4825 ((and (numberp draw-how) (= draw-how 2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4826 (artist-mouse-draw-2points ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4827 (t (message "Drawing \"%s\"s is not yet implemented"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4828 draw-how)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4829
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4830 (if artist-trim-line-endings
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4831 (artist-draw-region-trim-line-endings artist-draw-region-min-y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4832 artist-draw-region-max-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4833 (setq artist-draw-region-min-y orig-draw-region-min-y)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4834 (setq artist-draw-region-max-y orig-draw-region-max-y))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4835
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4836 ; This is protected
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4837 (if (eq window-system 'x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4838 (artist-set-pointer-shape orig-pointer-shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4839
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4840 (if orig-button-up-binding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4841 (define-key (current-global-map) key orig-button-up-binding))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4842
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4843 (artist-mode-line-show-curr-operation artist-key-is-drawing))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4844
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4845
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4846 (defun artist-mouse-choose-operation (ev op)
55793
812519af46fd (artist-last, artist-remove-nulls): Simplify.
Juanma Barranquero <lekktu@gmail.com>
parents: 52401
diff changeset
4847 "Choose operation for event EV and operation OP."
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4848 (interactive
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4849 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4850 (select-window (posn-window (event-start last-input-event)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4851 (list last-input-event
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4852 (x-popup-menu last-nonmenu-event artist-popup-menu-table))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4853
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4854 (let ((draw-fn (artist-go-get-draw-fn-from-symbol (car op)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4855 (set-fn (artist-fc-get-fn-from-symbol (car op))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4856 (cond
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4857
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4858 ;; *** It was a draw-function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4859 ((not (listp draw-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4860 (let* ((unshifted (artist-go-get-symbol-shift (car op) nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4861 (shifted (artist-go-get-symbol-shift (car op) t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4862 (shift-state (artist-event-is-shifted ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4863 (selected-op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4864 (keyword (artist-go-get-keyword-from-symbol selected-op)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4865 (artist-select-operation keyword)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4866
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4867 ;; *** It was a set/unset function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4868 ((not (listp set-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4869 (call-interactively set-fn)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4870
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4871
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4872 (defun artist-down-mouse-3 (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4873 "Erase character or rectangle, depending on event EV."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4874 (interactive "@e")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4875 (let ((artist-curr-go 'erase-char))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4876 (artist-down-mouse-1 ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4877 ;; Restore mode-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4878 (artist-mode-line-show-curr-operation artist-key-is-drawing))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4879
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4880
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 ;; Mouse routines
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4885 (defsubst artist-shift-has-changed (shift-state ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4886 "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
4887 ;; This one simply doesn't work.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4888 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4889 ;; 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
4890 ;; while dragging the cursor around when we are in a track-mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4891 ;; form. Calling (event-modifiers ev) yields nil :-( Neither is the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4892 ;; (event-basic-type ev) of any help (it is simply `mouse-movement').
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 ;; So this doesn't work:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4895 ;; (cond ((and shift-state (not (artist-event-is-shifted ev))) t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4896 ;; ((and (not shift-state) (artist-event-is-shifted ev)) t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4897 ;; (t nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4898 nil)
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 (defun artist-coord-win-to-buf (coord)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4901 "Convert a window-relative coordinate COORD to a buffer-relative coordinate."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4902 (let ((window-x (car coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4903 (window-y (cdr coord))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4904 (window-start-x (window-hscroll))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4905 (window-start-y (save-excursion (goto-char (window-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4906 (artist-current-line))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4907 (cons (+ window-x window-start-x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4908 (+ window-y window-start-y))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4909
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4910
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4911 (defun artist-mouse-draw-continously (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4912 "Generic function for shapes that requires 1 point as input.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4913 Operation is done continously while the mouse button is hold down.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4914 The event, EV, is the mouse event."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4915 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4916 (shifted (artist-go-get-symbol-shift artist-curr-go t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4917 (shift-state (artist-event-is-shifted ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4918 (op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4919 (draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4920 (init-fn (artist-go-get-init-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4921 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4922 (exit-fn (artist-go-get-exit-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4923 (draw-fn (artist-go-get-draw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4924 (interval-fn (artist-go-get-interval-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4925 (interval (artist-funcall interval-fn))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4926 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4927 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4928 (ev-start (event-start ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4929 (initial-win (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4930 (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
4931 (x1 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4932 (y1 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4933 (shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4934 (timer))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4935 (select-window (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4936 (artist-funcall init-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4937 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4938 (artist-no-rb-set-point1 x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4939 (track-mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4940 (while (or (mouse-movement-p ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4941 (member 'down (event-modifiers ev)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4942 (setq ev-start-pos (artist-coord-win-to-buf
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4943 (posn-col-row (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4944 (setq x1 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4945 (setq y1 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4946
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4947 ;; Cancel previous timer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4948 (if timer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4949 (cancel-timer timer))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4950
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4951 (if (not (eq initial-win (posn-window (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4952 ;; If we moved outside the window, do nothing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4953 nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4954
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4955 ;; Still in same window:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4956 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4957 ;; Check if user presses or releases shift key
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4958 (if (artist-shift-has-changed shift-state ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4959
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4960 ;; First check that the draw-how is the same as we
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4961 ;; already have. Otherwise, ignore the changed shift-state.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4962 (if (not (eq draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4963 (artist-go-get-draw-how-from-symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4964 (if (not shift-state) shifted unshifted))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4965 (message "Cannot switch to shifted operation")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4966
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4967 ;; progn is "implicit" since this is the else-part
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4968 (setq shift-state (not shift-state))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4969 (setq op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4970 (setq draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4971 (setq draw-fn (artist-go-get-draw-fn-from-symbol op))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4972
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4973 ;; Draw the new shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4974 (setq shape (artist-funcall draw-fn x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4975 (artist-move-to-xy x1 y1)
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 ;; Start the timer to call `draw-fn' repeatedly every
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4978 ;; `interval' second
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4979 (if (and interval draw-fn)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4980 (setq timer (run-at-time interval interval draw-fn x1 y1))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4981
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4982 ;; Read next event
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4983 (setq ev (read-event))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4984
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4985 ;; Cancel any timers
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4986 (if timer
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4987 (cancel-timer timer))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4988
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4989 (artist-funcall prep-fill-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4990
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4991 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4992 (artist-funcall arrow-set-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4993 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4994
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4995 (artist-funcall exit-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4996 (artist-move-to-xy x1 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4997
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4998
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
4999
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5000 (defun artist-mouse-draw-poly (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5001 "Generic function for shapes requiring several points as input.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5002 The event, EV, is the mouse event."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5003 (interactive "@e")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5004 (message "Mouse-1: set new point, mouse-2: set last point")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5005 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5006 (shifted (artist-go-get-symbol-shift artist-curr-go t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5007 (shift-state (artist-event-is-shifted ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5008 (op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5009 (draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5010 (init-fn (artist-go-get-init-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5011 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5012 (exit-fn (artist-go-get-exit-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5013 (draw-fn (artist-go-get-draw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5014 (undraw-fn (artist-go-get-undraw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5015 (fill-pred (artist-go-get-fill-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5016 (fill-fn (artist-go-get-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5017 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5018 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5019 (ev-start (event-start ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5020 (initial-win (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5021 (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
5022 (x1-last (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5023 (y1-last (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5024 (x2 x1-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5025 (y2 y1-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5026 (is-down t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5027 (shape nil)
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
5028 (point-list nil)
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5029 (done nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5030 (select-window (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5031 (artist-funcall init-fn x1-last y1-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5032 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5033 (artist-no-rb-set-point1 x1-last y1-last))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5034 (track-mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5035 (while (not done)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5036 ;; decide what to do
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5037 (cond
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 ;; *** Mouse button is released.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5040 ((and is-down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5041 (or (member 'click (event-modifiers ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5042 (member 'drag (event-modifiers ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5043 ;; First, if not rubber-banding, draw the line.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5044 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5045 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5046 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5047 (artist-no-rb-unset-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5048 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5049
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5050 ;; Set the second point to the shape's second point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5051 ;; (which might be different from the mouse's second point,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5052 ;; if, for example, we are drawing a straight line)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5053 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5054 (if (not (null shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5055 (let ((endpoint2 (artist-2point-get-endpoint2 shape)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5056 (setq x1-last (artist-endpoint-get-x endpoint2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5057 (setq y1-last (artist-endpoint-get-y endpoint2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5058 (setq point-list (cons (artist-make-endpoint x1-last y1-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5059 point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5060 (setq shape nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5061 (setq is-down nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5062
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5063 ;; *** Mouse button 2 or 3 down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5064 ((and (member 'down (event-modifiers ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5065 (or (equal (event-basic-type ev) 'mouse-2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5066 (equal (event-basic-type ev) 'mouse-3)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5067 ;; Ignore
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5068 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5069
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5070 ;; *** Mouse button 2 or 3 released
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5071 ((and (or (member 'click (event-modifiers ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5072 (member 'drag (event-modifiers ev)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5073 (or (equal (event-basic-type ev) 'mouse-2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5074 (equal (event-basic-type ev) 'mouse-3)))
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 ;; This means the end of our poly-line drawing-session.
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 (setq done t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5079
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5080 ;; *** Mouse button 1 went down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5081 ((and (not is-down)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5082 (member 'down (event-modifiers ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5083 (equal (event-basic-type ev) 'mouse-1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5084 ;; Check whether the (possibly new, that depends on if shift
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5085 ;; has been pressed or released) symbol has the same draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5086 ;; information as the previous had. If it hasn't, we can't
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5087 ;; proceed.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5088 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5089 (if (not (eq draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5090 (artist-go-get-draw-how-from-symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5091 (if (not shift-state) shifted unshifted))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5092 (message "Cannot switch operation")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5093 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5094 ;; Decide operation
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5095 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5096 (setq unshifted
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5097 (artist-go-get-symbol-shift artist-curr-go nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5098 shifted
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5099 (artist-go-get-symbol-shift artist-curr-go t)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5100 shift-state (artist-event-is-shifted ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5101 op (if shift-state shifted unshifted)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5102 draw-how (artist-go-get-draw-how-from-symbol op)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5103 draw-fn (artist-go-get-draw-fn-from-symbol op)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5104 undraw-fn (artist-go-get-undraw-fn-from-symbol op)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5105 fill-pred (artist-go-get-fill-pred-from-symbol op)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5106 fill-fn (artist-go-get-fill-fn-from-symbol op))
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 ;; Draw shape from last place to this place
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5109
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5110 ;; set x2 and y2
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 ev-start-pos (artist-coord-win-to-buf
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5113 (posn-col-row (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5114 (setq x2 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5115 (setq y2 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5116
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5117 ;; Draw the new shape (if not rubber-banding, place both marks)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5118 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5119 (if artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5120 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5121 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5122 (artist-no-rb-set-point1 x1-last y1-last)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5123 (artist-no-rb-set-point2 x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5124
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5125 ;; Show new operation in mode-line
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5126 (let ((artist-curr-go op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5127 (artist-mode-line-show-curr-operation t))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5128
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5129 (setq is-down t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5130
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5131
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5132 ;; *** Mouse moved, button is down and we are still in orig window
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5133 ((and (mouse-movement-p ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5134 is-down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5135 (eq initial-win (posn-window (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5136 ;; Draw shape from last place to this place
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5137 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5138 ;; set x2 and y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5139 (setq ev-start-pos (artist-coord-win-to-buf
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5140 (posn-col-row (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5141 (setq x2 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5142 (setq y2 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5143
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5144 ;; First undraw last shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5145 ;; (unset last point if not rubberbanding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5146 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5147 (artist-funcall undraw-fn shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5148
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5149 ;; Draw the new shape (if not rubberbanding, set 2nd mark)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5150 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5151 (if artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5152 (setq shape (artist-funcall draw-fn x1-last y1-last x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5153 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5154 (artist-no-rb-unset-point2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5155 (artist-no-rb-set-point2 x2 y2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5156 ;; Move cursor
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5157 (artist-move-to-xy x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5158
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5159 ;; *** Mouse moved, button is down but we are NOT in orig window
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5160 ((and (mouse-movement-p ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5161 is-down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5162 (not (eq initial-win (posn-window (event-start ev)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5163 ;; Ignore
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5164 nil)
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5167 ;; *** Moving mouse while mouse button is not down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5168 ((and (mouse-movement-p ev) (not is-down))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5169 ;; don't do anything.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5170 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5171
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5172
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5173 ;; *** Mouse button 1 went down, first time
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5174 ((and is-down
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5175 (member 'down (event-modifiers ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5176 (equal (event-basic-type ev) 'mouse-1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5177 ;; don't do anything
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5178 nil)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5179
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5180
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5181 ;; *** Another event
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5182 (t
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5183 ;; End drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5184 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5185 (setq done t)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5186
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5187 ;; Read next event (only if we should not stop)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5188 (if (not done)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5189 (setq ev (read-event)))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5190
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5191 ;; Reverse point-list (last points are cond'ed first)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5192 (setq point-list (reverse point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5193
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5194 (artist-funcall prep-fill-fn point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5195
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5196 ;; Maybe fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5197 (if (artist-funcall fill-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5198 (artist-funcall fill-fn point-list))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5199
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5200 ;; Maybe set arrow points
40323
8716d2ed21c6 (artist-version): 1.2.4.
Gerd Moellmann <gerd@gnu.org>
parents: 38436
diff changeset
5201 (if (and point-list (artist-funcall arrow-pred))
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5202 (artist-funcall arrow-set-fn point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5203 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5204
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5205 (artist-funcall exit-fn point-list)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5206 (artist-move-to-xy x2 y2)))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5209 (defun artist-mouse-draw-1point (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5210 "Generic function for shapes requiring only 1 point as input.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5211 Operation is done once. The event, EV, is the mouse event."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5212 (interactive "@e")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5213 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5214 (shifted (artist-go-get-symbol-shift artist-curr-go t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5215 (shift-state (artist-event-is-shifted ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5216 (op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5217 (draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5218 (init-fn (artist-go-get-init-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5219 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5220 (exit-fn (artist-go-get-exit-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5221 (draw-fn (artist-go-get-draw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5222 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5223 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5224 (ev-start (event-start ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5225 (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
5226 (x1 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5227 (y1 (cdr ev-start-pos)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5228 (select-window (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5229 (artist-funcall init-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5230 (artist-funcall draw-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5231 (artist-funcall prep-fill-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5232 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5233 (artist-funcall arrow-set-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5234 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5235 (artist-funcall exit-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5236 (artist-move-to-xy x1 y1)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5237
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5238
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5239 (defun artist-mouse-draw-2points (ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5240 "Generic function for shapes requiring 2 points as input.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5241 The event, EV, is the mouse event."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5242 (interactive "@e")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5243 (let* ((unshifted (artist-go-get-symbol-shift artist-curr-go nil))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5244 (shifted (artist-go-get-symbol-shift artist-curr-go t))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5245 (shift-state (artist-event-is-shifted ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5246 (op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5247 (draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5248 (init-fn (artist-go-get-init-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5249 (prep-fill-fn (artist-go-get-prep-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5250 (exit-fn (artist-go-get-exit-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5251 (draw-fn (artist-go-get-draw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5252 (undraw-fn (artist-go-get-undraw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5253 (fill-pred (artist-go-get-fill-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5254 (fill-fn (artist-go-get-fill-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5255 (arrow-pred (artist-go-get-arrow-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5256 (arrow-set-fn (artist-go-get-arrow-set-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5257 (ev-start (event-start ev))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5258 (initial-win (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5259 (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
5260 (x1 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5261 (y1 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5262 (x2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5263 (y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5264 (shape))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5265 (select-window (posn-window ev-start))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5266 (artist-funcall init-fn x1 y1)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5267 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5268 (artist-no-rb-set-point1 x1 y1))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5269 (track-mouse
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5270 (while (or (mouse-movement-p ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5271 (member 'down (event-modifiers ev)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5272 (setq ev-start-pos (artist-coord-win-to-buf
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5273 (posn-col-row (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5274 (setq x2 (car ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5275 (setq y2 (cdr ev-start-pos))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5276
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5277 (if (not (eq initial-win (posn-window (event-start ev))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5278 ;; If we moved outside the window, do nothing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5279 nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5280
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5281 ;; Still in same window:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5282 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5283 ;; First undraw last shape (unset last point if not rubberbanding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5284 (if artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5285 (artist-funcall undraw-fn shape)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5286 (artist-no-rb-unset-point2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5287
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5288 ;; Check if user presses or releases shift key
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5289 (if (artist-shift-has-changed shift-state ev)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5290
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5291 ;; First check that the draw-how is the same as we
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5292 ;; already have. Otherwise, ignore the changed shift-state.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5293 (if (not (eq draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5294 (artist-go-get-draw-how-from-symbol
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5295 (if (not shift-state) shifted unshifted))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5296 (message "Cannot switch to shifted operation")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5297
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5298 (message "Switching")
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5299 ;; progn is "implicit" since this is the else-part
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5300 (setq shift-state (not shift-state))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5301 (setq op (if shift-state shifted unshifted))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5302 (setq draw-how (artist-go-get-draw-how-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5303 (setq draw-fn (artist-go-get-draw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5304 (setq undraw-fn (artist-go-get-undraw-fn-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5305 (setq fill-pred (artist-go-get-fill-pred-from-symbol op))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5306 (setq fill-fn (artist-go-get-fill-fn-from-symbol op))))
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 ;; Draw the new shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5309 (if artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5310 (setq shape (artist-funcall draw-fn x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5311 (artist-no-rb-set-point2 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5312 ;; Move cursor
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5313 (artist-move-to-xy x2 y2))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5316 ;; Read next event
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5317 (setq ev (read-event))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5318
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5319 ;; 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
5320 ;; draw the shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5321 (if (not artist-rubber-banding)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5322 (progn
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5323 (artist-no-rb-unset-points)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5324 (setq shape (artist-funcall draw-fn x1 y1 x2 y2))))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5325
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5326 (artist-funcall prep-fill-fn shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5327
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5328 ;; Maybe fill
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5329 (if (artist-funcall fill-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5330 (artist-funcall fill-fn shape x1 y1 x2 y2))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5331
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5332 ;; Maybe set arrow-points
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5333 (if (artist-funcall arrow-pred)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5334 (artist-funcall arrow-set-fn shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5335 (artist-clear-arrow-points))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5336
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5337 (artist-funcall exit-fn shape x1 y1 x2 y2)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5338 (artist-move-to-xy x2 y2)))
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
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5341 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5342 ;; Bug-report-submitting
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5343 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5344 (defun artist-submit-bug-report ()
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5345 "Submit via mail a bug report on Artist."
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5346 (interactive)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5347 (require 'reporter)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5348 (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
5349 (let ((to artist-maintainer-address)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5350 (vars '(window-system
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5351 window-system-version
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5352 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5353 artist-rubber-banding
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5354 artist-interface-with-rect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5355 artist-aspect-ratio
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5356 ;; Now the internal ones
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5357 artist-curr-go
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5358 artist-key-poly-point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5359 artist-key-shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5360 artist-key-draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5361 artist-arrow-point-1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5362 artist-arrow-point-2)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5363 ;; Remove those variables from vars that are not bound
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5364 (mapcar
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5365 (function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5366 (lambda (x)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5367 (if (not (and (boundp x) (symbol-value x)))
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5368 (setq vars (delq x vars))))) vars)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5369 (reporter-submit-bug-report
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5370 artist-maintainer-address
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5371 (concat "artist.el " artist-version)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5372 vars
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5373 nil nil
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5374 (concat "Hello Tomas,\n\n"
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5375 "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
5376
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5377
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 ;; Now provide this minor mode
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5380 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5381
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5382 (provide 'artist)
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5383
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5384
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5385 ;;; About adding drawing modes
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5386 ;;; --------------------------
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5387
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5388 ;; 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
5389 ;; sketchy outlines to get started a bit easier.
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 ;; 1. If your new drawing mode falls into one of the following
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5392 ;; categories, goto point 2, otherwise goto point 3.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5393 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5394 ;; - Modes where the shapes are drawn continously, as long as
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5395 ;; the mouse button is held down (continous modes).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5396 ;; Example: the erase-char mode, the pen and pen-line modes.
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 ;; - 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
5399 ;; arbitrary number of points (poly-point modes).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5400 ;; Example: the poly-line mode
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5401 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5402 ;; - Modes where the shape is made up of 2 points (2-point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5403 ;; modes).
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5404 ;; Example: lines, rectangles
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5405 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5406 ;; - Modes where the shape is made up of 1 point (1-point
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5407 ;; modes). This mode differs from the continous modes in
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5408 ;; that the shape is drawn only once when the mouse button
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5409 ;; is pressed.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5410 ;; Examples: paste, a flood-fill, vaporize modes
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 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5413 ;; 2. To make it easier and more flexible to program new drawing
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5414 ;; modes, you might choose to specify
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5415 ;; init-fn: a function to be called at the very beginning
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5416 ;; of the drawing phase,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5417 ;; prep-fill-fn: a function to be called before filling,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5418 ;; arrow-set-fn: a function for setting arrows, to be called
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5419 ;; after filling, and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5420 ;; exit-fn: a function to be called at the very end of
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5421 ;; the drawing phase.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5422 ;; 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
5423 ;; prep-fill-fn, arrow-set-fn and exit-fn are stated.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5424 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5425 ;; If your mode matches the continous mode or the 1-point mode:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5426 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5427 ;; a. Create a draw-function that draws your shape. Your function
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5428 ;; must take x and y as arguments. The return value is not
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5429 ;; used.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5430 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5431 ;; b. Add your mode to the master table, `artist-mt'.
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 ;; init-fn: x y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5434 ;; prep-fill-fn: x y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5435 ;; arrow-set-fn: x y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5436 ;; exit-fn: x y
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5437 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5438 ;; If your mode matches the 2-point mode:
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 ;; a. Create one draw-function that draws your shape and one
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5441 ;; undraw-function that undraws it.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5442 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5443 ;; The draw-function must take x1, y1, x2 and y2 as
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5444 ;; arguments. It must return a list with three elements:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5445 ;; Endpoint1: a vector [x1 y1]
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5446 ;; Endpoint2: a vector [x2 y2]
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5447 ;; Shapeinfo: all info necessary for your undraw-function to
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5448 ;; be able to undraw the shape
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5449 ;; Use the artist-endpoint-* accessors to create and inspect
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5450 ;; the endpoints.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5451 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5452 ;; If applicable, you must be able to draw your shape without
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5453 ;; borders if the `artist-borderless-shapes' is non-nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5454 ;; See `artist-draw-rect' for an example.
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 ;; The undraw-function must take one argument: the list created
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5457 ;; by your draw-function. The return value is not used.
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 ;; b. If you want to provide a fill-function, then create a
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5460 ;; function that takes 5 arguments: the list created by your
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5461 ;; draw-function, x1, y1, x2 and y2. The return value is not
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5462 ;; used.
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 ;; c. Add your mode to the master table, `artist-mt'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5465 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5466 ;; init-fn: x1 y1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5467 ;; prep-fill-fn: shape x1 y1 x2 y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5468 ;; arrow-set-fn: shape x1 y1 x2 y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5469 ;; exit-fn: shape x1 y1 x2 y2
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5470 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5471 ;; If your mode matches the poly-point mode:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5472 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5473 ;; a. Create one draw-function that draws your shape and one
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5474 ;; undraw-function that undraws it. The draw- and
46163
426c8cf1a3df Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents: 43685
diff changeset
5475 ;; undraw-functions are used to draw/undraw a segment of
33618
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5476 ;; your poly-point mode between 2 points. The draw- and
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5477 ;; undraw-functions are then really 2-point mode functions.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5478 ;; They must take the same arguments and return the same
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5479 ;; values as those of the 2-point mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5480 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5481 ;; If applicable, you must be able to draw your shape without
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5482 ;; borders if the `artist-borderless-shapes' is non-nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5483 ;; See `artist-draw-rect' for an example.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5484 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5485 ;; b. If you want to provide a fill-function, then create a
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5486 ;; function that takes 1 argument: a list of points where each
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5487 ;; point is a vector, [x, y].
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 ;; c. Add your 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 ;; init-fn: x1 y1
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5492 ;; prep-fill-fn: point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5493 ;; arrow-set-fn: point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5494 ;; exit-fn: point-list
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5495 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5496 ;; The arrow-set-fn must set the variables `artist-arrow-point-1'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5497 ;; and `artist-arrow-point-2'. If your mode does not take arrows,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5498 ;; you must set the variables to nil. Use the accessors
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5499 ;; artist-arrow-point-* to create and inspect arrow-points.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5500 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5501 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5502 ;; 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
5503 ;; 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
5504 ;; brief outline of what you have to do:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5505 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5506 ;; 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
5507 ;; you decided on `xxx'. Then you should use the draw-how
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5508 ;; symbol artist-do-xxx.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5509 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5510 ;; b. Create a function artist-mouse-draw-xxx for drawing with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5511 ;; mouse. It should be called from `artist-down-mouse-1'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5512 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5513 ;; The all coordinates must be converted from window-relative
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5514 ;; to buffer relative before saved or handed over to
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5515 ;; any other function. Converting is done with
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5516 ;; the function `artist-coord-win-to-buf'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5517 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5518 ;; It must take care to the `artist-rubber-banding' variable
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5519 ;; and perform rubber-banding accordingly. Use the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5520 ;; artist-no-rb-* functions if not rubber-banding.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5521 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5522 ;; If applicable, you must be able to draw your shape without
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5523 ;; borders if the `artist-borderless-shapes' is non-nil.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5524 ;; See `artist-draw-rect' for an example.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5525 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5526 ;; 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
5527 ;; and the exit-fn at the apropriate points.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5528 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5529 ;; When artist-mouse-draw-xxx ends, the shape for your mode
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5530 ;; must be completely drawn.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5531 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5532 ;; c. Create functions for drawing with keys:
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5533 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5534 ;; - artist-key-set-point-xxx for setting a point in the
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5535 ;; mode, to be called from `artist-key-set-point-common'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5536 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5537 ;; - artist-key-do-continously-xxx to be called from
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5538 ;; `artist-key-do-continously-common' whenever the user
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5539 ;; moves around.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5540 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5541 ;; As for the artist-mouse-draw-xxx, these two functions must
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5542 ;; take care to do rubber-banding, borderless shapes and to
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5543 ;; set arrows.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5544 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5545 ;; These functions should set the variable `artist-key-shape'
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5546 ;; to the shape drawn.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5547 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5548 ;; d. Create artist-key-draw-xxx and artist-key-undraw-xxx for
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5549 ;; drawing and undrawing. These are needed when the user
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5550 ;; switches operation to draw another shape of the same type
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5551 ;; of drawing mode.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5552 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5553 ;; You should provide these functions. You might think that
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5554 ;; 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
5555 ;; to switch to another operation of the same type of mode,
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5556 ;; but someone else might base a new drawing mode upon your
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5557 ;; work.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5558 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5559 ;; 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
5560 ;; and the exit-fn at the apropriate points.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5561 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5562 ;; e. Add your new mode to the master table, `artist-mt'.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5563 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5564 ;;
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5565 ;; Happy hacking! Please let me hear if you add any drawing modes!
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5566 ;; Don't hesitate to ask me any questions.
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5567
beb961476e7f *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents:
diff changeset
5568
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 51965
diff changeset
5569 ;;; arch-tag: 3e63b881-aaaa-4b83-a072-220d4661a8a3
38436
b174db545cfd Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 37825
diff changeset
5570 ;;; artist.el ends here