Mercurial > emacs
annotate lisp/play/zone.el @ 35123:767b546e1676
Update to version 4.0. Provide support
for detecting a keypress that generates an ASCII key sequence.
(Previously, only a keypress that generates a vector was
recognized.) Embed Window Manager name into name of the generated
EDT Emulation initialization file since the initialization file is
Window Manager specific. Add Commentary section to file header.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Mon, 08 Jan 2001 13:18:18 +0000 |
parents | abc299ad3386 |
children | 67b464da13ec |
rev | line source |
---|---|
30565 | 1 ;;; zone.el --- idle display hacks |
2 | |
3 ;; Copyright (C) 2000 Free Software Foundation, Inc. | |
4 | |
5 ;;; Author: Victor Zandy <zandy@cs.wisc.edu> | |
6 ;;; Maintainer: Thien-Thi Nguyen <ttn@gnu.org> | |
7 ;;; Keywords: games | |
8 ;;; Created: June 6, 1998 | |
9 | |
10 ;; This file is part of GNU Emacs. | |
11 | |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation; either version 2, or (at your option) | |
15 ;; any later version. | |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
25 ;; Boston, MA 02111-1307, USA. | |
26 | |
27 ;;; Commentary: | |
28 | |
29 ;; Don't zone out in front of Emacs! Try M-x zone. | |
30 ;; If it eventually irritates you, try M-x zone-leave-me-alone. | |
31 | |
32 ;; Bored by the zone pyrotechnics? Write your own! Add it to | |
33 ;; `zone-programs'. | |
34 | |
35 ;; WARNING: Not appropriate for Emacs sessions over modems or | |
36 ;; computers as slow as mine. | |
37 | |
38 ;; THANKS: Christopher Mayer, Scott Flinchbaugh, Rachel Kalmar, | |
39 ;; Max Froumentin. | |
40 | |
41 ;;; Code: | |
42 | |
43 (require 'timer) | |
44 (require 'tabify) | |
45 (eval-when-compile (require 'cl)) | |
46 | |
47 (defvar zone-idle 20 | |
48 "*Seconds to idle before zoning out.") | |
49 | |
50 ;; Vector of functions that zone out. `zone' will execute one of | |
51 ;; these functions, randomly chosen. The chosen function is invoked | |
52 ;; in the *zone* buffer, which contains the text of the selected | |
53 ;; window. If the function loops, it *must* periodically check and | |
54 ;; halt if `input-pending-p' is t (because quitting is disabled when | |
55 ;; Emacs idle timers are run). | |
56 (defvar zone-programs [ | |
57 zone-pgm-jitter | |
58 zone-pgm-putz-with-case | |
59 zone-pgm-dissolve | |
60 ; zone-pgm-explode | |
61 zone-pgm-whack-chars | |
62 zone-pgm-rotate | |
63 zone-pgm-rotate-LR-lockstep | |
64 zone-pgm-rotate-RL-lockstep | |
65 zone-pgm-rotate-LR-variable | |
66 zone-pgm-rotate-RL-variable | |
67 zone-pgm-drip | |
68 zone-pgm-drip-fretfully | |
69 zone-pgm-five-oclock-swan-dive | |
70 zone-pgm-martini-swan-dive | |
71 zone-pgm-paragraph-spaz | |
72 zone-pgm-stress | |
73 ]) | |
74 | |
75 (defmacro zone-orig (&rest body) | |
76 `(with-current-buffer (get 'zone 'orig-buffer) | |
77 ,@body)) | |
78 | |
79 ;;;###autoload | |
80 (defun zone () | |
81 "Zone out, completely." | |
82 (interactive) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
83 (let ((timer (get 'zone 'timer))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
84 (and (timerp timer) (cancel-timer timer))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
85 (put 'zone 'timer nil) |
30592
fbdf4c1e1acf
(zone, zone-pgm-stress): Don't use window-system.
Eli Zaretskii <eliz@gnu.org>
parents:
30565
diff
changeset
|
86 (let ((f (selected-frame)) |
30565 | 87 (outbuf (get-buffer-create "*zone*")) |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
88 (text (buffer-substring (window-start) (window-end))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
89 (wp (1+ (- (window-point (selected-window)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
90 (window-start))))) |
30565 | 91 (put 'zone 'orig-buffer (current-buffer)) |
92 (set-buffer outbuf) | |
93 (setq mode-name "Zone") | |
94 (erase-buffer) | |
95 (insert text) | |
96 (switch-to-buffer outbuf) | |
97 (setq buffer-undo-list t) | |
98 (untabify (point-min) (point-max)) | |
99 (set-window-start (selected-window) (point-min)) | |
100 (set-window-point (selected-window) wp) | |
101 (sit-for 0 500) | |
102 (let ((pgm (elt zone-programs (random (length zone-programs)))) | |
103 (ct (and f (frame-parameter f 'cursor-type)))) | |
104 (when ct (modify-frame-parameters f '((cursor-type . (bar . 0))))) | |
105 (condition-case nil | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
106 (progn |
30565 | 107 (message "Zoning... (%s)" pgm) |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
108 (garbage-collect) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
109 ;; If some input is pending, zone says "sorry", which |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
110 ;; isn't nice; this might happen e.g. when they invoke the |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
111 ;; game by clicking the menu bar. So discard any pending |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
112 ;; input before zoning out. |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
113 (if (input-pending-p) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
114 (discard-input)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
115 (funcall pgm) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
116 (message "Zoning...sorry")) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
117 (error |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
118 (while (not (input-pending-p)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
119 (message (format "We were zoning when we wrote %s..." pgm)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
120 (sit-for 3) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
121 (message "...here's hoping we didn't hose your buffer!") |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
122 (sit-for 3))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
123 (quit (ding) (message "Zoning...sorry"))) |
30565 | 124 (when ct (modify-frame-parameters f (list (cons 'cursor-type ct))))) |
125 (kill-buffer outbuf) | |
126 (zone-when-idle zone-idle))) | |
127 | |
128 ;;;; Zone when idle, or not. | |
129 | |
130 (defun zone-when-idle (secs) | |
131 "Zone out when Emacs has been idle for SECS seconds." | |
132 (interactive "nHow long before I start zoning (seconds): ") | |
133 (or (<= secs 0) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
134 (let ((timer (get 'zone 'timer))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
135 (or (eq timer t) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
136 (timerp timer))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
137 (put 'zone 'timer (run-with-idle-timer secs t 'zone)))) |
30565 | 138 |
139 (defun zone-leave-me-alone () | |
140 "Don't zone out when Emacs is idle." | |
141 (interactive) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
142 (let ((timer (get 'zone 'timer))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
143 (and (timerp timer) (cancel-timer timer))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
144 (put 'zone 'timer t) |
30565 | 145 (message "I won't zone out any more")) |
146 | |
147 | |
148 ;;;; zone-pgm-jitter | |
149 | |
150 (defun zone-shift-up () | |
151 (let* ((b (point)) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
152 (e (progn |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
153 (end-of-line) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
154 (if (looking-at "\n") (1+ (point)) (point)))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
155 (s (buffer-substring b e))) |
30565 | 156 (delete-region b e) |
157 (goto-char (point-max)) | |
158 (insert s))) | |
159 | |
160 (defun zone-shift-down () | |
161 (goto-char (point-max)) | |
162 (forward-line -1) | |
163 (beginning-of-line) | |
164 (let* ((b (point)) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
165 (e (progn |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
166 (end-of-line) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
167 (if (looking-at "\n") (1+ (point)) (point)))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
168 (s (buffer-substring b e))) |
30565 | 169 (delete-region b e) |
170 (goto-char (point-min)) | |
171 (insert s))) | |
172 | |
173 (defun zone-shift-left () | |
174 (while (not (eobp)) | |
175 (or (eolp) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
176 (let ((c (following-char))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
177 (delete-char 1) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
178 (end-of-line) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
179 (insert c))) |
30565 | 180 (forward-line 1))) |
181 | |
182 (defun zone-shift-right () | |
183 (while (not (eobp)) | |
184 (end-of-line) | |
185 (or (bolp) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
186 (let ((c (preceding-char))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
187 (delete-backward-char 1) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
188 (beginning-of-line) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
189 (insert c))) |
30565 | 190 (forward-line 1))) |
191 | |
192 (defun zone-pgm-jitter () | |
193 (let ((ops [ | |
194 zone-shift-left | |
195 zone-shift-left | |
196 zone-shift-left | |
197 zone-shift-left | |
198 zone-shift-right | |
199 zone-shift-down | |
200 zone-shift-down | |
201 zone-shift-down | |
202 zone-shift-down | |
203 zone-shift-down | |
204 zone-shift-up | |
205 ])) | |
206 (goto-char (point-min)) | |
207 (while (not (input-pending-p)) | |
208 (funcall (elt ops (random (length ops)))) | |
209 (goto-char (point-min)) | |
210 (sit-for 0 10)))) | |
211 | |
212 | |
213 ;;;; zone-pgm-whack-chars | |
214 | |
215 (defun zone-pgm-whack-chars () | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
216 (let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl)))) |
30565 | 217 (while (not (input-pending-p)) |
218 (let ((i 48)) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
219 (while (< i 122) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
220 (aset tbl i (+ 48 (random (- 123 48)))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
221 (setq i (1+ i))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
222 (translate-region (point-min) (point-max) tbl) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
223 (sit-for 0 2))))) |
30565 | 224 |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
225 (put 'zone-pgm-whack-chars 'wc-tbl |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
226 (let ((tbl (make-string 128 ?x)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
227 (i 0)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
228 (while (< i 128) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
229 (aset tbl i i) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
230 (setq i (1+ i))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
231 tbl)) |
30565 | 232 |
233 ;;;; zone-pgm-dissolve | |
234 | |
235 (defun zone-remove-text () | |
236 (let ((working t)) | |
237 (while working | |
238 (setq working nil) | |
239 (save-excursion | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
240 (goto-char (point-min)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
241 (while (not (eobp)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
242 (if (looking-at "[^(){}\n\t ]") |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
243 (let ((n (random 5))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
244 (if (not (= n 0)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
245 (progn |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
246 (setq working t) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
247 (forward-char 1)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
248 (delete-char 1) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
249 (insert " "))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
250 (forward-char 1)))) |
30565 | 251 (sit-for 0 2)))) |
252 | |
253 (defun zone-pgm-dissolve () | |
254 (zone-remove-text) | |
255 (zone-pgm-jitter)) | |
256 | |
257 | |
258 ;;;; zone-pgm-explode | |
259 | |
260 (defun zone-exploding-remove () | |
261 (let ((i 0)) | |
262 (while (< i 20) | |
263 (save-excursion | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
264 (goto-char (point-min)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
265 (while (not (eobp)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
266 (if (looking-at "[^*\n\t ]") |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
267 (let ((n (random 5))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
268 (if (not (= n 0)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
269 (forward-char 1)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
270 (insert " "))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
271 (forward-char 1))) |
30565 | 272 (setq i (1+ i)) |
273 (sit-for 0 2))) | |
274 (zone-pgm-jitter)) | |
275 | |
276 (defun zone-pgm-explode () | |
277 (zone-exploding-remove) | |
278 (zone-pgm-jitter)) | |
279 | |
280 | |
281 ;;;; zone-pgm-putz-with-case | |
282 | |
283 ;; Faster than `zone-pgm-putz-with-case', but not as good: all | |
284 ;; instances of the same letter have the same case, which produces a | |
285 ;; less interesting effect than you might imagine. | |
286 (defun zone-pgm-2nd-putz-with-case () | |
287 (let ((tbl (make-string 128 ?x)) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
288 (i 0)) |
30565 | 289 (while (< i 128) |
290 (aset tbl i i) | |
291 (setq i (1+ i))) | |
292 (while (not (input-pending-p)) | |
293 (setq i ?a) | |
294 (while (<= i ?z) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
295 (aset tbl i |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
296 (if (zerop (random 5)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
297 (upcase i) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
298 (downcase i))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
299 (setq i (+ i (1+ (random 5))))) |
30565 | 300 (setq i ?A) |
301 (while (<= i ?z) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
302 (aset tbl i |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
303 (if (zerop (random 5)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
304 (downcase i) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
305 (upcase i))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
306 (setq i (+ i (1+ (random 5))))) |
30565 | 307 (translate-region (point-min) (point-max) tbl) |
308 (sit-for 0 2)))) | |
309 | |
310 (defun zone-pgm-putz-with-case () | |
311 (goto-char (point-min)) | |
312 (while (not (input-pending-p)) | |
313 (let ((np (+ 2 (random 5))) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
314 (pm (point-max))) |
30565 | 315 (while (< np pm) |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
316 (goto-char np) |
30565 | 317 (let ((prec (preceding-char)) |
318 (props (text-properties-at (1- (point))))) | |
319 (insert (if (zerop (random 2)) | |
320 (upcase prec) | |
321 (downcase prec))) | |
322 (set-text-properties (1- (point)) (point) props)) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
323 (backward-char 2) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
324 (delete-char 1) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
325 (setq np (+ np (1+ (random 5)))))) |
30565 | 326 (goto-char (point-min)) |
327 (sit-for 0 2))) | |
328 | |
329 | |
330 ;;;; zone-pgm-rotate | |
331 | |
332 (defun zone-line-specs () | |
333 (let (ret) | |
334 (save-excursion | |
335 (goto-char (window-start)) | |
336 (while (< (point) (window-end)) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
337 (when (looking-at "[\t ]*\\([^\n]+\\)") |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
338 (setq ret (cons (cons (match-beginning 1) (match-end 1)) ret))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
339 (forward-line 1))) |
30565 | 340 ret)) |
341 | |
342 (defun zone-pgm-rotate (&optional random-style) | |
343 (let* ((specs (apply | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
344 'vector |
30565 | 345 (let (res) |
346 (mapcar (lambda (ent) | |
347 (let* ((beg (car ent)) | |
348 (end (cdr ent)) | |
349 (amt (if random-style | |
350 (funcall random-style) | |
351 (- (random 7) 3)))) | |
352 (when (< (- end (abs amt)) beg) | |
353 (setq amt (random (- end beg)))) | |
354 (unless (= 0 amt) | |
355 (setq res | |
356 (cons | |
357 (vector amt beg (- end (abs amt))) | |
358 res))))) | |
359 (zone-line-specs)) | |
360 res))) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
361 (n (length specs)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
362 amt aamt cut paste txt i ent) |
30565 | 363 (while (not (input-pending-p)) |
364 (setq i 0) | |
365 (while (< i n) | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
366 (setq ent (aref specs i)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
367 (setq amt (aref ent 0) aamt (abs amt)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
368 (if (> 0 amt) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
369 (setq cut 1 paste 2) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
370 (setq cut 2 paste 1)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
371 (goto-char (aref ent cut)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
372 (setq txt (buffer-substring (point) (+ (point) aamt))) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
373 (delete-char aamt) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
374 (goto-char (aref ent paste)) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
375 (insert txt) |
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
376 (setq i (1+ i))) |
30565 | 377 (sit-for 0.04)))) |
378 | |
379 (defun zone-pgm-rotate-LR-lockstep () | |
380 (zone-pgm-rotate (lambda () 1))) | |
381 | |
382 (defun zone-pgm-rotate-RL-lockstep () | |
383 (zone-pgm-rotate (lambda () -1))) | |
384 | |
385 (defun zone-pgm-rotate-LR-variable () | |
386 (zone-pgm-rotate (lambda () (1+ (random 3))))) | |
387 | |
388 (defun zone-pgm-rotate-RL-variable () | |
389 (zone-pgm-rotate (lambda () (1- (- (random 3)))))) | |
390 | |
391 | |
392 ;;;; zone-pgm-drip | |
393 | |
394 (defun zone-cpos (pos) | |
395 (buffer-substring pos (1+ pos))) | |
396 | |
397 (defun zone-fret (pos) | |
398 (let* ((case-fold-search nil) | |
399 (c-string (zone-cpos pos)) | |
400 (hmm (cond | |
401 ((string-match "[a-z]" c-string) (upcase c-string)) | |
402 ((string-match "[A-Z]" c-string) (downcase c-string)) | |
403 (t " ")))) | |
404 (do ((i 0 (1+ i)) | |
405 (wait 0.5 (* wait 0.8))) | |
406 ((= i 20)) | |
407 (goto-char pos) | |
408 (delete-char 1) | |
409 (insert (if (= 0 (% i 2)) hmm c-string)) | |
410 (sit-for wait)) | |
411 (delete-char -1) (insert c-string))) | |
412 | |
413 (defun zone-fall-through-ws (c col wend) | |
414 (let ((fall-p nil) ; todo: move outward | |
415 (wait 0.15) | |
416 (o (point)) ; for terminals w/o cursor hiding | |
417 (p (point))) | |
418 (while (progn | |
419 (forward-line 1) | |
420 (move-to-column col) | |
421 (looking-at " ")) | |
422 (setq fall-p t) | |
423 (delete-char 1) | |
424 (insert (if (< (point) wend) c " ")) | |
425 (save-excursion | |
426 (goto-char p) | |
427 (delete-char 1) | |
428 (insert " ") | |
429 (goto-char o) | |
430 (sit-for (setq wait (* wait 0.8)))) | |
431 (setq p (1- (point)))) | |
432 fall-p)) | |
433 | |
434 (defun zone-pgm-drip (&optional fret-p pancake-p) | |
435 (let* ((ww (1- (window-width))) | |
436 (wh (window-height)) | |
437 (mc 0) ; miss count | |
438 (total (* ww wh)) | |
439 (fall-p nil)) | |
440 (goto-char (point-min)) | |
441 ;; fill out rectangular ws block | |
442 (while (not (eobp)) | |
443 (end-of-line) | |
444 (let ((cc (current-column))) | |
445 (if (< cc ww) | |
446 (insert (make-string (- ww cc) ? )) | |
447 (delete-char (- ww cc)))) | |
448 (unless (eobp) | |
449 (forward-char 1))) | |
450 ;; what the hell is going on here? | |
451 (let ((nl (- wh (count-lines (point-min) (point))))) | |
452 (when (> nl 0) | |
453 (let ((line (concat (make-string (1- ww) ? ) "\n"))) | |
454 (do ((i 0 (1+ i))) | |
455 ((= i nl)) | |
456 (insert line))))) | |
457 ;; | |
32348
abc299ad3386
(zone-timer, zone-wc-tbl): Rework
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
30628
diff
changeset
|
458 (catch 'done; ugh |
30565 | 459 (while (not (input-pending-p)) |
460 (goto-char (point-min)) | |
461 (sit-for 0) | |
462 (let ((wbeg (window-start)) | |
463 (wend (window-end))) | |
464 (setq mc 0) | |
465 ;; select non-ws character, but don't miss too much | |
466 (goto-char (+ wbeg (random (- wend wbeg)))) | |
467 (while (looking-at "[ \n\f]") | |
468 (if (= total (setq mc (1+ mc))) | |
469 (throw 'done 'sel) | |
470 (goto-char (+ wbeg (random (- wend wbeg)))))) | |
471 ;; character animation sequence | |
472 (let ((p (point))) | |
473 (when fret-p (zone-fret p)) | |
474 (goto-char p) | |
475 (setq fall-p (zone-fall-through-ws | |
476 (zone-cpos p) (current-column) wend)))) | |
477 ;; assuming current-column has not changed... | |
478 (when (and pancake-p | |
479 fall-p | |
480 (< (count-lines (point-min) (point)) | |
481 wh)) | |
482 (previous-line 1) | |
483 (forward-char 1) | |
484 (sit-for 0.137) | |
485 (delete-char -1) | |
486 (insert "@") | |
487 (sit-for 0.137) | |
488 (delete-char -1) | |
489 (insert "*") | |
490 (sit-for 0.137) | |
491 (delete-char -1) | |
492 (insert "_")))))) | |
493 | |
494 (defun zone-pgm-drip-fretfully () | |
495 (zone-pgm-drip t)) | |
496 | |
497 (defun zone-pgm-five-oclock-swan-dive () | |
498 (zone-pgm-drip nil t)) | |
499 | |
500 (defun zone-pgm-martini-swan-dive () | |
501 (zone-pgm-drip t t)) | |
502 | |
503 | |
504 ;;;; zone-pgm-paragraph-spaz | |
505 | |
506 (defun zone-pgm-paragraph-spaz () | |
507 (if (memq (zone-orig major-mode) '(text-mode fundamental-mode)) | |
508 (let ((fill-column fill-column) | |
509 (fc-min fill-column) | |
510 (fc-max fill-column) | |
511 (max-fc (1- (frame-width)))) | |
512 (while (sit-for 0.1) | |
513 (fill-paragraph 1) | |
514 (setq fill-column (+ fill-column (- (random 5) 2))) | |
515 (when (< fill-column fc-min) | |
516 (setq fc-min fill-column)) | |
517 (when (> fill-column max-fc) | |
518 (setq fill-column max-fc)) | |
519 (when (> fill-column fc-max) | |
520 (setq fc-max fill-column)))) | |
521 (message "Zoning... (zone-pgm-rotate)") | |
522 (zone-pgm-rotate))) | |
523 | |
524 | |
525 ;;;; zone-pgm-stress | |
526 | |
527 (defun zone-pgm-stress () | |
528 (goto-char (point-min)) | |
529 (let (lines bg m-fg m-bg) | |
530 (while (< (point) (point-max)) | |
531 (let ((p (point))) | |
532 (forward-line 1) | |
533 (setq lines (cons (buffer-substring p (point)) lines)))) | |
534 (sit-for 5) | |
30592
fbdf4c1e1acf
(zone, zone-pgm-stress): Don't use window-system.
Eli Zaretskii <eliz@gnu.org>
parents:
30565
diff
changeset
|
535 (when (display-color-p) |
30565 | 536 (setq bg (frame-parameter (selected-frame) 'background-color) |
537 m-fg (face-foreground 'modeline) | |
538 m-bg (face-background 'modeline)) | |
539 (set-face-foreground 'modeline bg) | |
540 (set-face-background 'modeline bg)) | |
541 (let ((msg "Zoning... (zone-pgm-stress)")) | |
542 (while (not (string= msg "")) | |
543 (message (setq msg (substring msg 1))) | |
544 (sit-for 0.05))) | |
545 (while (not (input-pending-p)) | |
546 (when (< 50 (random 100)) | |
547 (goto-char (point-max)) | |
548 (forward-line -1) | |
549 (let ((kill-whole-line t)) | |
550 (kill-line)) | |
551 (goto-char (point-min)) | |
552 (insert (nth (random (length lines)) lines))) | |
553 (message (concat (make-string (random (- (frame-width) 5)) ? ) "grrr")) | |
554 (sit-for 0.1)) | |
30592
fbdf4c1e1acf
(zone, zone-pgm-stress): Don't use window-system.
Eli Zaretskii <eliz@gnu.org>
parents:
30565
diff
changeset
|
555 (when (display-color-p) |
30565 | 556 (set-face-foreground 'modeline m-fg) |
557 (set-face-background 'modeline m-bg)))) | |
558 | |
559 (provide 'zone) | |
560 | |
561 ;;; zone.el ends here |