lisp/play/animate.el

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