lisp/play/animate.el

   1 ;;; animate.el --- make text dance
   2
   3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005,
   4 ;;   2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Maintainer: Richard Stallman <rms@gnu.org>
   7 ;; Keywords: games
   8
   9 ;; This file is part of GNU Emacs.
  10
  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, or (at your option)
  14 ;; any later version.
  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
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; (animate-string STRING VPOS &optional HPOS)
  29 ;; makes the string STRING appear starting at VPOS, HPOS
  30 ;; by having each letter swoop into place from random starting position.
  31
  32 ;; animate-birthday-present was the first application of this program.
  33
  34 ;;; Code:
  35
  36 ;;; STRING is the string to be displayed,
  37 ;;; and DEST-X, DEST-Y say where on the screen
  38 ;;; it should end up.
  39
  40 ;;; This function returns a list describing
  41 ;;; all the characters and the paths they should take.
  42 ;;; Each element has the form
  43 ;;;  (CHAR START-Y START-X DEST-Y DEST-X).
  44
  45 ;;; The start position of each character is chosen randomly.
  46 ;;; The destination is chosen to put it in the right place
  47 ;;; in the string when the whole string finally reaches its
  48 ;;; specified position.
  49
  50 (defun animate-initialize (string vpos hpos)
  51   (let ((characters nil))
  52     (dotimes (i (length string))
  53       (setq characters
  54             (cons (list (aref string i)
  55                         ;; Random starting positions.
  56                         (random (window-height))
  57                         (random (1- (window-width)))
  58                         ;; All the chars should end up
  59                         ;; on the specified line.
  60                         vpos
  61                         ;; The Ith character in the string
  62                         ;; needs to end up I positions later.
  63                         (+ hpos i))
  64                   characters)))
  65     characters))
  66
  67 ;;; Display the characters in CHARACTERS,
  68 ;;; each one FRACTION of the way from its start to its destination.
  69 ;;; If FRACTION is 0, the characters appear in their starting positions.
  70 ;;; If FRACTION is 1, the characters appear in their destinations.
  71
  72 (defun animate-step (characters fraction)
  73   (let ((remains (- 1 fraction)))
  74     (dolist (item characters)
  75       (let ((vpos (+ (* remains (nth 1 item))
  76                      (* fraction (nth 3 item))))
  77             (hpos (+ (* remains (nth 2 item))
  78                      (* fraction (nth 4 item)))))
  79         (animate-place-char (car item) vpos hpos)))))
  80
  81 ;;; Place the character CHAR at position VPOS, HPOS in the current buffer.
  82 (defun animate-place-char (char vpos hpos)
  83   (goto-char (window-start))
  84   (let (abbrev-mode)
  85     (dotimes (i vpos)
  86       (end-of-line)
  87       (if (= (forward-line 1) 1)
  88           (insert "\n"))))
  89   (beginning-of-line)
  90   (move-to-column (floor hpos) t)
  91   (unless (eolp) (delete-char 1))
  92   (insert-char char 1))
  93
  94 (defvar animate-n-steps 10
  95   "Number of steps to use `animate-string'.")
  96
  97 ;;;###autoload
  98 (defun animate-string (string vpos &optional hpos)
  99   "Display STRING starting at position VPOS, HPOS, using animation.
 100 The characters start at randomly chosen places,
 101 and all slide in parallel to their final positions,
 102 passing through `animate-n-steps' positions before the final ones.
 103 If HPOS is nil (or omitted), center the string horizontally
 104 in the current window."
 105   (let ((characters
 106          (animate-initialize string vpos
 107                              (or hpos
 108                                  ;; HPOS unspecified, so compute
 109                                  ;; it so as to center the string.
 110                                  (max 0 (/ (- (window-width) (length string)) 2))))))
 111     (dotimes (i animate-n-steps)
 112       ;; Bind buffer-undo-list so it will be unchanged when we are done.
 113       ;; (We're going to undo all our changes anyway.)
 114       (let (buffer-undo-list
 115             list-to-undo)
 116         ;; Display the characters at the Ith position.
 117         ;; This inserts them in the buffer.
 118         (animate-step characters (/ i 1.0 animate-n-steps))
 119         ;; Make sure buffer is displayed starting at the beginning.
 120         (set-window-start nil 1)
 121         ;; Display it, and wait just a little while.
 122         (sit-for .05)
 123         ;; Now undo the changes we made in the buffer.
 124         (setq list-to-undo buffer-undo-list)
 125         (while list-to-undo
 126           (let ((undo-in-progress t))
 127             (setq list-to-undo (primitive-undo 1 list-to-undo))))))
 128     ;; Insert the characters in their final positions.
 129     (animate-step characters 1)
 130     ;; Put the cursor at the end of the text on the line.
 131     (end-of-line)
 132     ;; Redisplay so they appear on the screen there.
 133     (sit-for 0)
 134     ;; This is so that the undo command, used afterwards,
 135     ;; will undo the "animate" calls one by one.
 136     (undo-boundary)))
 137
 138 ;;;###autoload
 139 (defun animate-sequence (list-of-strings space)
 140   "Display strings from LIST-OF-STRING with animation in a new buffer.
 141 Strings will be separated from each other by SPACE lines."
 142   (let ((vpos (/ (- (window-height)
 143                     1 ;; For the mode-line
 144                     (* (1- (length list-of-strings)) space)
 145                     (length list-of-strings))
 146                  2)))
 147     (switch-to-buffer (get-buffer-create "*Animation*"))
 148     (erase-buffer)
 149     (sit-for 0)
 150     (setq indent-tabs-mode nil)
 151     (while list-of-strings
 152       (animate-string (car list-of-strings) vpos)
 153       (setq vpos (+ vpos space 1))
 154       (setq list-of-strings (cdr list-of-strings)))))
 155
 156 ;;;###autoload
 157 (defun animate-birthday-present (&optional name)
 158   "Display one's birthday present in a new buffer.
 159 You can specify the one's name by NAME; the default value is \"Sarah\"."
 160   (interactive (list (read-string "Name (default Sarah): "
 161                                   nil nil "Sarah")))
 162   ;; Make a suitable buffer to display the birthday present in.
 163   (switch-to-buffer (get-buffer-create (format "*%s*" name)))
 164   (erase-buffer)
 165   ;; Display the empty buffer.
 166   (sit-for 0)
 167   ;; Make sure indentation does not use tabs.
 168   ;; They would confuse things.
 169   (setq indent-tabs-mode nil)
 170
 171   (animate-string "Happy Birthday," 6)
 172   (animate-string (format "%s" name) 7)
 173
 174   (sit-for 1)
 175
 176   (animate-string "You are my sunshine," 10 30)
 177   (sit-for .5)
 178   (animate-string "My only sunshine." 11 30)
 179   (sit-for .5)
 180   (animate-string "I'm awful sad that" 12 30)
 181   (sit-for .5)
 182   (animate-string "You've moved away." 13 30)
 183   (sit-for .5)
 184   (animate-string "Let's talk together" 15 30)
 185   (sit-for .5)
 186   (animate-string "And love more deeply." 16 30)
 187   (sit-for .5)
 188   (animate-string "Please bring back" 17 30)
 189   (animate-string "my sunshine" 18 34)
 190   (animate-string "to stay!" 19 34))
 191
 192 (random t)
 193
 194 (provide 'animate)
 195
 196 ;;; arch-tag: 275289a3-6ac4-41da-b527-a1147045392f
 197 ;;; animate.el ends here