Mercurial > hg > xemacs-beta

comparison lisp/utils/xbm-button.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; Create XBM text buttons under XEmacs (requires 19.12 or beyond)
2 ;;; Copyright (C) 1995 Kyle E. Jones
3 ;;;
4 ;;; This program is free software; you can redistribute it and/or modify
5 ;;; it under the terms of the GNU General Public License as published by
6 ;;; the Free Software Foundation; either version 1, or (at your option)
7 ;;; any later version.
8 ;;;
9 ;;; This program is distributed in the hope that it will be useful,
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 ;;; GNU General Public License for more details.
13 ;;;
14 ;;; A copy of the GNU General Public License can be obtained from this
15 ;;; program's author (send electronic mail to kyle@uunet.uu.net) or from
16 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
17 ;;; 02139, USA.
18 ;;;
19 ;;; Synched up with: Not in FSF.
20 ;;;
21 ;;; Send bug reports to kyle@wonderworks.com
22
23 ;;; The sole interface function is xbm-button-create.
24
25
26 (provide 'xbm-button)
27
28 (defvar xbm-button-version "1.00"
29 "Version string for xbm-button.")
30
31 (defvar xbm-button-vertical-padding 3
32 "Number of pixels between the text and the top/bottom of the button.")
33
34 (defvar xbm-button-horizontal-padding 3
35 "Number of pixels between the text and the left/right edges of the button.")
36
37 (defvar xbm-button-font-pixel-lines
38 '(
39 "000011000001111110000011110101111111000111111110111111110001111010011110011110111100001111011110111101111000001111000111101110000111000111110001111111000011111000011111110000111101011111111011110011101111000111011110111101110111101111011110111011111111000000000111000000000000000001110000000000011100000000011100000001100011011100000011100000000000000000000000000000000000000000000000000000000000000000100000000000000000000000000000000000000000000000000000000000011000001000111100011110000111000111110001110011111100111100011110001000000001100000111100000010100011110000110001000000010000001110000000100000010100000000000000000000000000000000001111000110111101100000000011010100000000000000000000000100111100100000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
40 "000011000000110011000110001100110001100011000110011000110011000110001100001100011000000110001100010000110000000111000111000111000010001100011000110001100110001100001100011001100011011011011001100001000110000010001100011000100011000100001100010011000111000000000011000000000000000000110000000000110100000000001100000001100011001100000001100000000000000000000000000000000000000000000000000000000000000001100000000000000000000000000000000000000000000000000000000000100100111001100110110011000111000111100010011011111101100110110011010000000001100011000010000010100110111001101111000000010000011001000010101000100010000000000000000000000000000000001100001100001100110000000011010100000000000000000000000101100110110000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
41 "000101100000110011001100000100110000110011000010011000010110000010001100001100011000000110001100100000110000000111000111000111100010011000001100110001101100000110001100011001100001010011001001100001000110000010001100011000100011101000001100010010001110000000000011000000000000000000110000000000110000000110001100000000000000001100000001100000000000000000000000000000000000000000000000000000000000000001100000000000000000000000000000000000000000000000000000000001100110011001100110110011001011000100000110011010001001100010110011011000000001100100111101001111110100100011001010000000111000011010000001110001100011000000000000000000000000000100001100001100001100110000000001010100000000000000000000000101100110010000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
42 "000101100000110011001100000100110000110011001000011001010110000010001100001100011000000110001101000000110000000101101011000101110010011000001100110001101100000110001100011001111000010011001001100001000011000100000110101101000001111000000110100000011100001111000011011000001110000110110000111001111100111100001101100011100111001101110001100111011001100011101100000111000111011000001101100111011001111011111011101110011110111011101111011101110111011110111011111101100110011000000110000011001011000111100110000000011000110100110011011000000001100101001101000101000110100011001010011000101000001100111010101001000001000000000000000000000000000100001100001100001100110011011010000000000000110000110000001100000110011000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
43 "001000110000111110001100000000110000110011111000011111000110000000001111111100011000000110001111100000110000000101101011000100111010011000001100110011001100000110001111100000111110000011000001100001000011000100000110101101000000111000000110100000011000001001100011101110111011011101110011101100110001100110001110110001100011001101100001100011101110110001110110011101110011101110111011100011111010001001100001100110001100010001100110001000110010001100010010011101100110011000001100001100010011000100110111110000011000111100011111000001100101101011011001000101000011110011010100110101101100011110010000100011000001100000000000000001111110000100001100001000001100010011011000000000000011100000011100001000001100001000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
44 "001111110000110001101100000000110000110011001000011001000110001111001100001100011000000110001101110000110000000101101011000100011110011000001100111110001101100110001100110000001111000011000001100001000001101000000110101101000001011100000011000000111000000111100011000110110000011000110011111100110001100110001100110001100011001111000001100011001100110001100110011000110011000110110001100011000011110001100001100110000110100000110111010000011100000110100000111001100110011000011000000011010011000000110110011000110000101110000011000011111101101011011010011111100000111001100101100101000100100111100000000011000001101111110000000000000000111111101100010000001100001000000000000000001110000000000111011000010000001100100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
45 "010000011000110001101100000100110000110011000010011000000110000110001100001100011001100110001100110000110000100100110011000100001110011000001100110000001110010110001100110001000011000011000001100001000001101000000011000110000001001110000011000001110001011001100011000110110000011000110011000000110000111100001100110001100011001101100001100011001100110001100110011000110011000110110001100011000001111001100001100110000110100000110111010000011100000110100001110001100110011000100010110011011111101100110110011000110001000110110011000010011000001001101100001010000110101000001001100100000001100011100000000011000001100000000000000001111110000100001100001000001100010000000000000000000011100000011100010000000000000100100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
46 "010000011000110001100110001100110001100011000110011000000011000110001100001100011001100110001100111000110001100100110011000100000110001100011000110000000110011100001100011101100011000011000001110011000000110000000011000110000010000110000011000011100011011011100011001110111011011101110011101100110001000000001100110001100011001100110001100011001100110001100110011101110011101110111011100011000010001001100001101110000011000000011001100000100110000011000011100100100100011001111110110011000011001100110110011000110001100110110010000000000001100100000010001010000110101000001001101000000001110011111000000001000001000000000000000000000000000100001100001100001100110011011000000001100000110110110000010000011000000110100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
47 "111000111101111111000011111001111111000111111110111100000001111010011110011110111100111000011110011101111111101110110111101110000010000111110001111000000011111000011110011001011110000111100000111110000000110000000011000110000111001111000111100011111111001101110010111000001110000110111000111001111001111110011110111011110011011110111011110111101110111011110111000111000011011000001101100111100011110000110000110111000011000000011001100001110111000011000011111100011000111101111110011110000111100111100011110000110000111100011100000000000001100011111100001010000011110000010000110000000000111100110000000001100011000000000000000000000000000100001100001100001100110011011000000001100000000110000000010000011000000010100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
48 "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000111111000000000000000011000000000000000000000000000000000000000000000011000000000001100000000000000000000000000000000000000000000000000000000000000010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000100000000000000000000000000000000000000000100010000000000000000000000000000000001100001100001100110001000000000000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
49 "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001000011000000000000000011000000000000000000000000000000000000000000000011000000000001100000000000000000000000000000000000000000000000000000000000011100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010100000000000111111100000000000000001111000110111101100010000000000001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
50 "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000111110000000000000000110000000000000000000000000000000000000000000000111100000000011110000000000000000000000000000000000000000000000000000000000011000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
51 )
52 "List of strings representing pixel lines for the button font.")
53
54 (defvar xbm-button-font-line-indices
55 '(("A" 0 10)
56 ("B" 11 19)
57 ("C" 20 28)
58 ("D" 29 38)
59 ("E" 39 47)
60 ("F" 48 56)
61 ("G" 57 66)
62 ("H" 67 77)
63 ("I" 78 82)
64 ("J" 83 90)
65 ("K" 91 100)
66 ("L" 101 109)
67 ("M" 110 121)
68 ("N" 122 132)
69 ("O" 133 142)
70 ("P" 143 151)
71 ("Q" 152 162)
72 ("R" 163 172)
73 ("S" 173 180)
74 ("T" 181 189)
75 ("U" 190 199)
76 ("V" 200 210)
77 ("W" 211 224)
78 ("X" 225 234)
79 ("Y" 235 243)
80 ("Z" 244 252)
81 ("a" 253 260)
82 ("b" 261 269)
83 ("c" 270 276)
84 ("d" 277 285)
85 ("e" 286 292)
86 ("f" 293 298)
87 ("g" 299 306)
88 ("h" 307 315)
89 ("i" 316 320)
90 ("j" 321 324)
91 ("k" 325 333)
92 ("l" 334 338)
93 ("m" 339 351)
94 ("n" 352 360)
95 ("o" 361 368)
96 ("p" 369 377)
97 ("q" 378 386)
98 ("r" 387 393)
99 ("s" 394 399)
100 ("t" 400 405)
101 ("u" 406 414)
102 ("v" 415 423)
103 ("w" 424 436)
104 ("x" 437 444)
105 ("y" 445 453)
106 ("z" 454 460)
107 ("0" 461 467)
108 ("1" 468 472)
109 ("2" 473 479)
110 ("3" 480 486)
111 ("4" 487 493)
112 ("5" 494 500)
113 ("6" 501 507)
114 ("7" 508 514)
115 ("8" 515 521)
116 ("9" 522 528)
117 ("`" 529 531)
118 ("~" 532 538)
119 ("!" 539 541)
120 ("@" 542 552)
121 ("#" 553 560)
122 ("$" 561 567)
123 ("%" 568 580)
124 ("^" 581 586)
125 ("&" 587 597)
126 ("*" 598 603)
127 ("(" 604 608)
128 (")" 609 613)
129 ("-" 614 620)
130 ("_" 621 628)
131 ("=" 629 635)
132 ("+" 636 643)
133 ("[" 644 648)
134 ("{" 649 653)
135 ("]" 654 658)
136 ("}" 659 663)
137 (";" 664 666)
138 (":" 667 669)
139 ("'" 670 672)
140 ("\"" 673 676)
141 ("," 677 679)
142 ("<" 680 686)
143 ("." 687 689)
144 (">" 690 696)
145 ("/" 697 700)
146 ("?" 701 707)
147 ("\\" 708 713)
148 ("|" 714 715)
149 (" " 716 719))
150 "Indices into the xbm-button-font-pixel-lines strings for each character.
151 Format is
152 (STR START END)
153 STR contains the character.
154 START is where the character's pixels start in each string of
155 xbm-button-font-pixel-lines (0 is the index of the first pixel).
156 END is the index of the position after the last pixel of the character.")
157
158 (defun xbm-bit-lines-to-xbm-bits (&optional beg end)
159 "Convert lines of bits to a string of chars containing the bits,
160 plus width and height information. A list of the form
161 (WIDTH HEIGHT STRING)
162 is returned. WIDTH is set to be the length of the first line,
163 ignoring the newline. HEIGHT is the number of lines in the region.
164
165 BEG and END specify the region containing the bit lines. Each
166 line should contain only the characters '0' or '1' and be
167 terminated by a newline."
168 (or beg (setq beg (point-min)))
169 (or end (setq end (point-max)))
170 (let (octet octet-count bit-count b char width height)
171 (save-excursion
172 (save-excursion
173 (set-buffer (setq b (get-buffer-create
174 " xbm-button-bit-lines-to-xbm")))
175 (erase-buffer))
176 (goto-char beg)
177 (setq bit-count 0
178 height 0
179 width (- (save-excursion (end-of-line) (point)) (point))
180 octet 0)
181 (while (< (point) end)
182 (setq char (char-after (point)))
183 (cond ((= char ?0)
184 (setq bit-count (1+ bit-count)))
185 ((= char ?1)
186 ;; least significant bit of octet is leftmost pixel.
187 (setq octet (+ octet (expt 2 bit-count))
188 bit-count (1+ bit-count)))
189 ((= char ?\n)
190 (setq height (1+ height))))
191 ;; output octet whenever we have retrived 8 bits or when
192 ;; a newline is encountered.
193 (cond ((or (= bit-count 8) (= char ?\n))
194 (save-excursion
195 (set-buffer b)
196 (insert-char octet))
197 (setq bit-count 0
198 octet 0)))
199 (forward-char 1))
200 (set-buffer b)
201 ;; otput last octet if any bits collected.
202 (cond ((not (= bit-count 0))
203 (insert-char octet)))
204
205 (list width height (buffer-substring nil nil b)) )))
206
207 ;;;###autoload
208 (defun xbm-button-create (text border-thickness)
209 "Returns a list of XBM image instantiators for a button displaying TEXT.
210 The list is of the form
211 (UP DOWN DISABLED)
212 where UP, DOWN, and DISABLED are the up, down and disabled image
213 instantiators for the button.
214
215 BORDER-THICKNESS specifies how many pixels should be used for the
216 borders on the edges of the buttons. It should be a positive integer,
217 or 0 to mean no border."
218 (save-excursion
219 (set-buffer (get-buffer-create " xbm-button-create"))
220 (erase-buffer)
221 ;; create the correct number of lines for the pixels for the
222 ;; characters.
223 (insert-char ?\n (length xbm-button-font-pixel-lines))
224 (let ((i 0)
225 (str (make-string 1 0))
226 (lim (length text))
227 (bg-char ?0)
228 font-pixel-lines q)
229 ;; loop through text, adding the character pixels
230 (while (< i lim)
231 (aset str 0 (aref text i))
232 (if (null (setq q (assoc str xbm-button-font-line-indices)))
233 nil ; no pixel data for this character
234 (goto-char (point-min))
235 (setq font-pixel-lines xbm-button-font-pixel-lines)
236 (while font-pixel-lines
237 (end-of-line)
238 (if (not (bolp))
239 ;; Insert space before some of the characters.
240 ;; This isn't really correct for this font
241 ;; but doing it right is too hard.
242 ;; This isn't TeX after all.
243 (if (memq (aref str 0) '(?, ?. ?\" ?! ?| ?\' ?\`))
244 (insert-char bg-char 1))
245 ;; offset the start a bit from the left edge of the button
246 (insert-char bg-char xbm-button-horizontal-padding))
247 ;; insert the character pixels.
248 (insert (substring (car font-pixel-lines) (nth 1 q) (nth 2 q)))
249 (forward-line)
250 (setq font-pixel-lines (cdr font-pixel-lines))))
251 (setq i (1+ i)))
252 ;; now offset the text from the right edge of the button.
253 (goto-char (point-min))
254 (while (not (eobp))
255 (end-of-line)
256 (insert-char bg-char xbm-button-horizontal-padding)
257 (forward-line)))
258 (let ((fg-char ?1)
259 (bg-char ?0)
260 i len up down disabled)
261 ;; find the length of a pixel line.
262 (goto-char (point-min))
263 (end-of-line)
264 (setq len (- (point) (point-min)))
265 ;; offset text from the top of the button
266 (goto-char (point-min))
267 (setq i xbm-button-vertical-padding)
268 (while (> i 0)
269 (insert-char bg-char len)
270 (insert ?\n)
271 (setq i (1- i)))
272 ;; offset text from the bottom of the button
273 (goto-char (point-max))
274 (setq i xbm-button-vertical-padding)
275 (while (> i 0)
276 (insert-char bg-char len)
277 (insert ?\n)
278 (setq i (1- i)))
279 ;; add borders to the pixel lines
280 (goto-char (point-min))
281 (while (not (eobp))
282 (insert-char fg-char border-thickness)
283 (end-of-line)
284 (insert-char fg-char border-thickness)
285 (forward-line))
286 ;; add top and bottom border lines
287 (setq i border-thickness)
288 (goto-char (point-min))
289 (while (> i 0)
290 (insert-char fg-char (+ len (* 2 border-thickness)))
291 (insert ?\n)
292 (setq i (1- i)))
293 (setq i border-thickness)
294 (goto-char (point-max))
295 (while (> i 0)
296 (insert-char fg-char (+ len (* 2 border-thickness)))
297 (insert ?\n)
298 (setq i (1- i)))
299 ;; convert the pixel lines to octets of xbm bit data
300 (setq up (xbm-bit-lines-to-xbm-bits)
301 down up)
302 ;; stipple the foreground pixels for the disabled button.
303 (let ((str (make-string 1 0))
304 (bit 0)
305 lim line-start)
306 (aset str 0 fg-char)
307 (goto-char (point-min))
308 (while (not (eobp))
309 (setq lim (save-excursion (end-of-line) (point))
310 line-start (point))
311 (while (search-forward str lim t)
312 (if (= (% (- (point) line-start) 2) bit)
313 (subst-char-in-region (1- (point)) (point) fg-char bg-char t)))
314 (if (zerop bit)
315 (setq bit 1)
316 (setq bit 0))
317 (forward-line)))
318 (setq disabled (xbm-bit-lines-to-xbm-bits))
319
320 (list (vector 'xbm ':data up)
321 (vector 'xbm ':data down)
322 (vector 'xbm ':data disabled)) )))