1 ;;; animate.el --- make text dance
3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005,
4 ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 ;; Maintainer: Richard Stallman <rms@gnu.org>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
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.
30 ;; animate-birthday-present was the first application of this program.
34 ;;; STRING is the string to be displayed,
35 ;;; and DEST-X, DEST-Y say where on the screen
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).
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.
48 (defun animate-initialize (string vpos hpos
)
49 (let ((characters nil
))
50 (dotimes (i (length string
))
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.
59 ;; The Ith character in the string
60 ;; needs to end up I positions later.
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.
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
)))))
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))
85 (if (= (forward-line 1) 1)
88 (move-to-column (floor hpos
) t
)
89 (unless (eolp) (delete-char 1))
92 (defvar animate-n-steps
10
93 "Number of steps to use `animate-string'.")
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."
104 (animate-initialize string vpos
106 ;; HPOS unspecified, so compute
107 ;; it so as to center the string.
108 (max 0 (/ (- (window-width) (length string
)) 2)))))
109 (show-trailing-whitespace nil
)
110 ;; Make sure indentation does not use tabs.
111 ;; They would confuse things.
112 (indent-tabs-mode nil
))
113 (dotimes (i animate-n-steps
)
114 ;; Bind buffer-undo-list so it will be unchanged when we are done.
115 ;; (We're going to undo all our changes anyway.)
116 (let (buffer-undo-list
118 ;; Display the characters at the Ith position.
119 ;; This inserts them in the buffer.
120 (animate-step characters
(/ i
1.0 animate-n-steps
))
121 ;; Make sure buffer is displayed starting at the beginning.
122 (set-window-start nil
1)
123 ;; Display it, and wait just a little while.
125 ;; Now undo the changes we made in the buffer.
126 (setq list-to-undo buffer-undo-list
)
128 (let ((undo-in-progress t
))
129 (setq list-to-undo
(primitive-undo 1 list-to-undo
))))))
130 ;; Insert the characters in their final positions.
131 (animate-step characters
1)
132 ;; Put the cursor at the end of the text on the line.
134 ;; Redisplay so they appear on the screen there.
136 ;; This is so that the undo command, used afterwards,
137 ;; will undo the "animate" calls one by one.
141 (defun animate-sequence (list-of-strings space
)
142 "Display strings from LIST-OF-STRING with animation in a new buffer.
143 Strings will be separated from each other by SPACE lines."
144 (let ((vpos (/ (- (window-height)
145 1 ;; For the mode-line
146 (* (1- (length list-of-strings
)) space
)
147 (length list-of-strings
))
149 (switch-to-buffer (get-buffer-create "*Animation*"))
152 (while list-of-strings
153 (animate-string (car list-of-strings
) vpos
)
154 (setq vpos
(+ vpos space
1))
155 (setq list-of-strings
(cdr list-of-strings
)))))
158 (defun animate-birthday-present (&optional name
)
159 "Display one's birthday present in a new buffer.
160 You can specify the one's name by NAME; the default value is \"Sarah\"."
161 (interactive (list (read-string "Name (default Sarah): "
163 ;; Make a suitable buffer to display the birthday present in.
164 (switch-to-buffer (get-buffer-create (format "*%s*" name
)))
166 ;; Display the empty buffer.
169 (animate-string "Happy Birthday," 6)
170 (animate-string (format "%s" name
) 7)
174 (animate-string "You are my sunshine," 10 30)
176 (animate-string "My only sunshine." 11 30)
178 (animate-string "I'm awful sad that" 12 30)
180 (animate-string "You've moved away." 13 30)
182 (animate-string "Let's talk together" 15 30)
184 (animate-string "And love more deeply." 16 30)
186 (animate-string "Please bring back" 17 30)
187 (animate-string "my sunshine" 18 34)
188 (animate-string "to stay!" 19 34))
194 ;; arch-tag: 275289a3-6ac4-41da-b527-a1147045392f
195 ;;; animate.el ends here