Mercurial > emacs
annotate lisp/play/animate.el @ 97608:2bde8f2e8ed1
* xterm.c (x_delete_display): Don't call XrmDestroyDatabase on GTK+.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Thu, 21 Aug 2008 19:36:56 +0000 |
parents | 949bd6ad1ba4 |
children | a9dc0e7c3f2b |
rev | line source |
---|---|
38521 | 1 ;;; animate.el --- make text dance |
2 | |
68634
836785857446
Update copyright notices of all files in the lisp/play directory.
Romain Francoise <romain@orebokech.com>
parents:
65680
diff
changeset
|
3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, |
79716 | 4 ;; 2006, 2007, 2008 Free Software Foundation, Inc. |
38521 | 5 |
38626
6b570d0e1cf3
Add Keywords and Maintainer. Remove a
Gerd Moellmann <gerd@gnu.org>
parents:
38621
diff
changeset
|
6 ;; Maintainer: Richard Stallman <rms@gnu.org> |
6b570d0e1cf3
Add Keywords and Maintainer. Remove a
Gerd Moellmann <gerd@gnu.org>
parents:
38621
diff
changeset
|
7 ;; Keywords: games |
6b570d0e1cf3
Add Keywords and Maintainer. Remove a
Gerd Moellmann <gerd@gnu.org>
parents:
38621
diff
changeset
|
8 |
38521 | 9 ;; This file is part of GNU Emacs. |
10 | |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
38521 | 12 ;; it under the terms of the GNU General Public License as published by |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
38521 | 15 |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
94675
949bd6ad1ba4
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
38521 | 23 |
24 ;;; Commentary: | |
25 | |
26 ;; (animate-string STRING VPOS &optional HPOS) | |
27 ;; makes the string STRING appear starting at VPOS, HPOS | |
28 ;; by having each letter swoop into place from random starting position. | |
29 | |
38708
456acc0ad1ee
Re-insert a reference to re-inserted function animate-birthday-present.
Pavel Janík <Pavel@Janik.cz>
parents:
38702
diff
changeset
|
30 ;; animate-birthday-present was the first application of this program. |
456acc0ad1ee
Re-insert a reference to re-inserted function animate-birthday-present.
Pavel Janík <Pavel@Janik.cz>
parents:
38702
diff
changeset
|
31 |
38521 | 32 ;;; Code: |
33 | |
34 ;;; STRING is the string to be displayed, | |
35 ;;; and DEST-X, DEST-Y say where on the screen | |
36 ;;; it should end up. | |
37 | |
38 ;;; This function returns a list describing | |
39 ;;; all the characters and the paths they should take. | |
40 ;;; Each element has the form | |
41 ;;; (CHAR START-Y START-X DEST-Y DEST-X). | |
42 | |
43 ;;; The start position of each character is chosen randomly. | |
44 ;;; The destination is chosen to put it in the right place | |
45 ;;; in the string when the whole string finally reaches its | |
46 ;;; specified position. | |
47 | |
48 (defun animate-initialize (string vpos hpos) | |
49 (let ((characters nil)) | |
50 (dotimes (i (length string)) | |
51 (setq characters | |
52 (cons (list (aref string i) | |
53 ;; Random starting positions. | |
54 (random (window-height)) | |
55 (random (1- (window-width))) | |
56 ;; All the chars should end up | |
57 ;; on the specified line. | |
58 vpos | |
59 ;; The Ith character in the string | |
60 ;; needs to end up I positions later. | |
61 (+ hpos i)) | |
62 characters))) | |
63 characters)) | |
64 | |
65 ;;; Display the characters in CHARACTERS, | |
66 ;;; each one FRACTION of the way from its start to its destination. | |
67 ;;; If FRACTION is 0, the characters appear in their starting positions. | |
68 ;;; If FRACTION is 1, the characters appear in their destinations. | |
69 | |
70 (defun animate-step (characters fraction) | |
71 (let ((remains (- 1 fraction))) | |
72 (dolist (item characters) | |
73 (let ((vpos (+ (* remains (nth 1 item)) | |
74 (* fraction (nth 3 item)))) | |
75 (hpos (+ (* remains (nth 2 item)) | |
76 (* fraction (nth 4 item))))) | |
77 (animate-place-char (car item) vpos hpos))))) | |
78 | |
79 ;;; Place the character CHAR at position VPOS, HPOS in the current buffer. | |
80 (defun animate-place-char (char vpos hpos) | |
81 (goto-char (window-start)) | |
60537
0e6e83809df8
(animate-place-char): Use forward-line instead
Kim F. Storm <storm@cua.dk>
parents:
54102
diff
changeset
|
82 (let (abbrev-mode) |
38521 | 83 (dotimes (i vpos) |
60537
0e6e83809df8
(animate-place-char): Use forward-line instead
Kim F. Storm <storm@cua.dk>
parents:
54102
diff
changeset
|
84 (end-of-line) |
0e6e83809df8
(animate-place-char): Use forward-line instead
Kim F. Storm <storm@cua.dk>
parents:
54102
diff
changeset
|
85 (if (= (forward-line 1) 1) |
0e6e83809df8
(animate-place-char): Use forward-line instead
Kim F. Storm <storm@cua.dk>
parents:
54102
diff
changeset
|
86 (insert "\n")))) |
38521 | 87 (beginning-of-line) |
88 (move-to-column (floor hpos) t) | |
89 (unless (eolp) (delete-char 1)) | |
90 (insert-char char 1)) | |
91 | |
92 (defvar animate-n-steps 10 | |
93 "Number of steps to use `animate-string'.") | |
94 | |
95 ;;;###autoload | |
96 (defun animate-string (string vpos &optional hpos) | |
97 "Display STRING starting at position VPOS, HPOS, using animation. | |
98 The characters start at randomly chosen places, | |
99 and all slide in parallel to their final positions, | |
100 passing through `animate-n-steps' positions before the final ones. | |
101 If HPOS is nil (or omitted), center the string horizontally | |
102 in the current window." | |
103 (let ((characters | |
104 (animate-initialize string vpos | |
105 (or hpos | |
106 ;; HPOS unspecified, so compute | |
107 ;; it so as to center the string. | |
38621
7f4573a73075
(animate-string): Handle case that the string is
Gerd Moellmann <gerd@gnu.org>
parents:
38522
diff
changeset
|
108 (max 0 (/ (- (window-width) (length string)) 2)))))) |
38521 | 109 (dotimes (i animate-n-steps) |
110 ;; Bind buffer-undo-list so it will be unchanged when we are done. | |
111 ;; (We're going to undo all our changes anyway.) | |
112 (let (buffer-undo-list | |
113 list-to-undo) | |
114 ;; Display the characters at the Ith position. | |
115 ;; This inserts them in the buffer. | |
116 (animate-step characters (/ i 1.0 animate-n-steps)) | |
117 ;; Make sure buffer is displayed starting at the beginning. | |
118 (set-window-start nil 1) | |
119 ;; Display it, and wait just a little while. | |
120 (sit-for .05) | |
121 ;; Now undo the changes we made in the buffer. | |
122 (setq list-to-undo buffer-undo-list) | |
123 (while list-to-undo | |
124 (let ((undo-in-progress t)) | |
125 (setq list-to-undo (primitive-undo 1 list-to-undo)))))) | |
126 ;; Insert the characters in their final positions. | |
127 (animate-step characters 1) | |
128 ;; Put the cursor at the end of the text on the line. | |
129 (end-of-line) | |
130 ;; Redisplay so they appear on the screen there. | |
131 (sit-for 0) | |
132 ;; This is so that the undo command, used afterwards, | |
133 ;; will undo the "animate" calls one by one. | |
134 (undo-boundary))) | |
135 | |
38702
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
136 ;;;###autoload |
38783
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
137 (defun animate-sequence (list-of-strings space) |
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
138 "Display strings from LIST-OF-STRING with animation in a new buffer. |
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
139 Strings will be separated from each other by SPACE lines." |
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
140 (let ((vpos (/ (- (window-height) |
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
141 1 ;; For the mode-line |
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
142 (* (1- (length list-of-strings)) space) |
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
143 (length list-of-strings)) |
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
144 2))) |
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
145 (switch-to-buffer (get-buffer-create "*Animation*")) |
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
146 (erase-buffer) |
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
147 (sit-for 0) |
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
148 (setq indent-tabs-mode nil) |
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
149 (while list-of-strings |
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
150 (animate-string (car list-of-strings) vpos) |
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
151 (setq vpos (+ vpos space 1)) |
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
152 (setq list-of-strings (cdr list-of-strings))))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
38783
diff
changeset
|
153 |
38783
255503bac5c2
(animate-string): Doc fix. Use a buffer
Gerd Moellmann <gerd@gnu.org>
parents:
38708
diff
changeset
|
154 ;;;###autoload |
54102
d0b60a164264
(animate-birthday-present): Accept other than `Sarah', too.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
52401
diff
changeset
|
155 (defun animate-birthday-present (&optional name) |
d0b60a164264
(animate-birthday-present): Accept other than `Sarah', too.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
52401
diff
changeset
|
156 "Display one's birthday present in a new buffer. |
d0b60a164264
(animate-birthday-present): Accept other than `Sarah', too.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
52401
diff
changeset
|
157 You can specify the one's name by NAME; the default value is \"Sarah\"." |
65680
ed770a0a7846
2005-09-24 Emilio C. Lopes <eclig@gmx.net>
Romain Francoise <romain@orebokech.com>
parents:
64701
diff
changeset
|
158 (interactive (list (read-string "Name (default Sarah): " |
54102
d0b60a164264
(animate-birthday-present): Accept other than `Sarah', too.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
52401
diff
changeset
|
159 nil nil "Sarah"))) |
38702
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
160 ;; Make a suitable buffer to display the birthday present in. |
54102
d0b60a164264
(animate-birthday-present): Accept other than `Sarah', too.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
52401
diff
changeset
|
161 (switch-to-buffer (get-buffer-create (format "*%s*" name))) |
38702
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
162 (erase-buffer) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
163 ;; Display the empty buffer. |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
164 (sit-for 0) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
165 ;; Make sure indentation does not use tabs. |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
166 ;; They would confuse things. |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
167 (setq indent-tabs-mode nil) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
168 |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
169 (animate-string "Happy Birthday," 6) |
54102
d0b60a164264
(animate-birthday-present): Accept other than `Sarah', too.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
52401
diff
changeset
|
170 (animate-string (format "%s" name) 7) |
38702
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
171 |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
172 (sit-for 1) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
173 |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
174 (animate-string "You are my sunshine," 10 30) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
175 (sit-for .5) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
176 (animate-string "My only sunshine." 11 30) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
177 (sit-for .5) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
178 (animate-string "I'm awful sad that" 12 30) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
179 (sit-for .5) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
180 (animate-string "You've moved away." 13 30) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
181 (sit-for .5) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
182 (animate-string "Let's talk together" 15 30) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
183 (sit-for .5) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
184 (animate-string "And love more deeply." 16 30) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
185 (sit-for .5) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
186 (animate-string "Please bring back" 17 30) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
187 (animate-string "my sunshine" 18 34) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
188 (animate-string "to stay!" 19 34)) |
dc644b0090f2
(animate-birthday-present): Re-insert.
Gerd Moellmann <gerd@gnu.org>
parents:
38626
diff
changeset
|
189 |
76953 | 190 (random t) |
191 | |
76951 | 192 (provide 'animate) |
193 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79716
diff
changeset
|
194 ;; arch-tag: 275289a3-6ac4-41da-b527-a1147045392f |
38521 | 195 ;;; animate.el ends here |