unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
blob 6b0b33b633adda463f7443cce42dba341c66ee40 7332 bytes (raw)
name: lisp/play/animate.el 	 # note: path name is non-authoritative(*)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
 
;;; animate.el --- make text dance

;; Copyright (C) 2001-2019 Free Software Foundation, Inc.

;; Maintainer: Richard Stallman <rms@gnu.org>
;; Keywords: games

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; (animate-string STRING VPOS &optional HPOS)
;; makes the string STRING appear starting at VPOS, HPOS
;; by having each letter swoop into place from random starting position.

;; animate-birthday-present was the first application of this program.

;;; Code:

;;; STRING is the string to be displayed,
;;; and DEST-X, DEST-Y say where on the screen
;;; it should end up.

;;; This function returns a list describing
;;; all the characters and the paths they should take.
;;; Each element has the form
;;;  (CHAR START-Y START-X DEST-Y DEST-X).

;;; The start position of each character is chosen randomly.
;;; The destination is chosen to put it in the right place
;;; in the string when the whole string finally reaches its
;;; specified position.

(defgroup animate nil
  "Make text dance."
  :group 'games
  :prefix "animate-")

(defun animate-initialize (string vpos hpos)
  (let ((characters nil))
    (dotimes (i (length string))
      (setq characters
	    (cons (list (aref string i)
			;; Random starting positions.
			(random (window-height))
			(random (1- (window-width)))
			;; All the chars should end up
			;; on the specified line.
			vpos
			;; The Ith character in the string
			;; needs to end up I positions later.
			(+ hpos i))
		  characters)))
    characters))

;;; Display the characters in CHARACTERS,
;;; each one FRACTION of the way from its start to its destination.
;;; If FRACTION is 0, the characters appear in their starting positions.
;;; If FRACTION is 1, the characters appear in their destinations.

(defun animate-step (characters fraction)
  (let ((remains (- 1 fraction)))
    (dolist (item characters)
      (let ((vpos (+ (* remains (nth 1 item))
		     (* fraction (nth 3 item))))
	    (hpos (+ (* remains (nth 2 item))
		     (* fraction (nth 4 item)))))
	(animate-place-char (car item) vpos hpos)))))

;;; Place the character CHAR at position VPOS, HPOS in the current buffer.
(defun animate-place-char (char vpos hpos)
  (goto-char (window-start))
  (let (abbrev-mode)
    (dotimes (i vpos)
      (end-of-line)
      (if (= (forward-line 1) 1)
	  (insert "\n"))))
  (beginning-of-line)
  (move-to-column (floor hpos) t)
  (unless (eolp) (delete-char 1))
  (insert-char char 1))

(defcustom animate-n-steps 10
  "Number of steps `animate-string' will place a char before its last position."
  :type 'integer)

(defvar animation-buffer-name nil
  "String naming the default buffer for animations.
When nil animations displayed in the buffer named *Animation*.")

;;;###autoload
(defun animate-string (string vpos &optional hpos)
  "Display STRING animations starting at position VPOS, HPOS.
The characters start at randomly chosen places,
and all slide in parallel to their final positions,
passing through `animate-n-steps' positions before the final ones.
If HPOS is nil (or omitted), center the string horizontally
in the current window."
  (let ((characters
	 (animate-initialize string vpos
			     (or hpos
				 ;; HPOS unspecified, so compute
				 ;; it so as to center the string.
				 (max 0 (/ (- (window-width) (length string)) 2)))))
	(show-trailing-whitespace nil)
	;; Make sure indentation does not use tabs.
	;; They would confuse things.
	(indent-tabs-mode nil))
    (dotimes (i animate-n-steps)
      ;; Bind buffer-undo-list so it will be unchanged when we are done.
      ;; (We're going to undo all our changes anyway.)
      (let (buffer-undo-list
	    list-to-undo)
	;; Display the characters at the Ith position.
	;; This inserts them in the buffer.
	(animate-step characters (/ i 1.0 animate-n-steps))
	;; Make sure buffer is displayed starting at the beginning.
	(set-window-start nil 1)
	;; Display it, and wait just a little while.
	(sit-for .05)
	;; Now undo the changes we made in the buffer.
	(setq list-to-undo buffer-undo-list)
	(while list-to-undo
	  (let ((undo-in-progress t))
	    (setq list-to-undo (primitive-undo 1 list-to-undo))))))
    ;; Insert the characters in their final positions.
    (animate-step characters 1)
    ;; Put the cursor at the end of the text on the line.
    (end-of-line)
    ;; Redisplay so they appear on the screen there.
    (sit-for 0)
    ;; This is so that the undo command, used afterwards,
    ;; will undo the "animate" calls one by one.
    (undo-boundary)))

;;;###autoload
(defun animate-sequence (list-of-strings space)
  "Display animation strings from LIST-OF-STRING with buffer *Animation*.
Strings will be separated from each other by SPACE lines.
 When the variable `animation-buffer-name' is non-nil display
animation in the buffer named by variable's value, creating the
buffer if one does not exist."
  (let ((vpos (/ (- (window-height)
		    1 ;; For the mode-line
		    (* (1- (length list-of-strings)) space)
		    (length list-of-strings))
		 2)))
    (switch-to-buffer (get-buffer-create
                       (or animation-buffer-name
                           "*Animation*")))
    (erase-buffer)
    (sit-for 0)
    (while list-of-strings
      (animate-string (car list-of-strings) vpos)
      (setq vpos (+ vpos space 1))
      (setq list-of-strings (cdr list-of-strings)))))

;;;###autoload
(defun animate-birthday-present (&optional name)
  "Return a birthday present in the buffer *Birthday-Present*.
When optional arg NAME is non-nil or called-interactively, prompt for
NAME of birthday present receiver and return a birthday present in
the buffer *Birthday-Present-for-Name*."
  (interactive (list (read-string "Birthday present for: "
				  nil nil)))
  ;; Make a suitable buffer to display the birthday present in.
  (switch-to-buffer (get-buffer-create
		     (if name
			 (concat "*A-Present-for-" (capitalize name) "*")
		       "*Birthday-Present*")))
  (erase-buffer)
  ;; Display the empty buffer.
  (sit-for 0)

  (if name
      (animate-string "Happy Birthday," 6)
      (animate-string "Happy Birthday" 6))
  (when name (animate-string (format "%s" (capitalize name)) 7))
  (sit-for 1)

  (animate-string "You are my sunshine," 10 30)
  (sit-for .5)
  (animate-string "My only sunshine." 11 30)
  (sit-for .5)
  (animate-string "I'm awful sad that" 12 30)
  (sit-for .5)
  (animate-string "You've moved away." 13 30)
  (sit-for .5)
  (animate-string "Let's talk together" 15 30)
  (sit-for .5)
  (animate-string "And love more deeply." 16 30)
  (sit-for .5)
  (animate-string "Please bring back" 17 30)
  (animate-string "my sunshine" 18 34)
  (animate-string "to stay!" 19 34))

(provide 'animate)

;;; animate.el ends here

debug log:

solving 6b0b33b633 ...
found 6b0b33b633 in https://git.savannah.gnu.org/cgit/emacs.git

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).