Mercurial > emacs
comparison lisp/play/zone.el @ 58978:848f5e78398e
(zone): Set `truncate-lines'.
Also, init `tab-width' with value from original buffer.
(zone-shift-up): Rewrite for speed.
(zone-shift-down, zone-shift-left, zone-shift-right): Likewise.
(zone-pgm-jitter): Remove redundant entries from ops vector.
(zone-exploding-remove): Reduce iteration count.
(zone-cpos): Convert to defsubst.
(zone-replace-char): New defsubst.
(zone-park/sit-for): Likewise.
(zone-fret): Take window-start arg.
Update callers. Use `zone-park/sit-for'.
(zone-fill-out-screen): Rewrite.
(zone-fall-through-ws): Likewise. Update callers.
(zone-pgm-drip): Use `zone-replace-char'.
Move var inits before while-loop. Use `zone-park/sit-for'.
(zone-pgm-random-life): Handle empty initial field.
Use `zone-replace-char' and `zone-park/sit-for'.
author | Thien-Thi Nguyen <ttn@gnuvola.org> |
---|---|
date | Wed, 15 Dec 2004 13:53:58 +0000 |
parents | f3d97fc520ff |
children | 64c212b55c0c |
comparison
equal
deleted
inserted
replaced
58977:5cb0e562cfae | 58978:848f5e78398e |
---|---|
138 (text (buffer-substring (window-start) (window-end))) | 138 (text (buffer-substring (window-start) (window-end))) |
139 (wp (1+ (- (window-point (selected-window)) | 139 (wp (1+ (- (window-point (selected-window)) |
140 (window-start))))) | 140 (window-start))))) |
141 (put 'zone 'orig-buffer (current-buffer)) | 141 (put 'zone 'orig-buffer (current-buffer)) |
142 (put 'zone 'modeline-hidden-level 0) | 142 (put 'zone 'modeline-hidden-level 0) |
143 (set-buffer outbuf) | 143 (switch-to-buffer outbuf) |
144 (setq mode-name "Zone") | 144 (setq mode-name "Zone") |
145 (erase-buffer) | 145 (erase-buffer) |
146 (setq buffer-undo-list t | |
147 truncate-lines t | |
148 tab-width (zone-orig tab-width)) | |
146 (insert text) | 149 (insert text) |
147 (switch-to-buffer outbuf) | |
148 (setq buffer-undo-list t) | |
149 (untabify (point-min) (point-max)) | 150 (untabify (point-min) (point-max)) |
150 (set-window-start (selected-window) (point-min)) | 151 (set-window-start (selected-window) (point-min)) |
151 (set-window-point (selected-window) wp) | 152 (set-window-point (selected-window) wp) |
152 (sit-for 0 500) | 153 (sit-for 0 500) |
153 (let ((pgm (elt zone-programs (random (length zone-programs)))) | 154 (let ((pgm (elt zone-programs (random (length zone-programs)))) |
193 (cancel-timer zone-timer)) | 194 (cancel-timer zone-timer)) |
194 (setq zone-timer nil) | 195 (setq zone-timer nil) |
195 (message "I won't zone out any more")) | 196 (message "I won't zone out any more")) |
196 | 197 |
197 | 198 |
198 ;;;; zone-pgm-jitter | 199 ;;;; jittering |
199 | 200 |
200 (defun zone-shift-up () | 201 (defun zone-shift-up () |
201 (let* ((b (point)) | 202 (let* ((b (point)) |
202 (e (progn | 203 (e (progn (forward-line 1) (point))) |
203 (end-of-line) | |
204 (if (looking-at "\n") (1+ (point)) (point)))) | |
205 (s (buffer-substring b e))) | 204 (s (buffer-substring b e))) |
206 (delete-region b e) | 205 (delete-region b e) |
207 (goto-char (point-max)) | 206 (goto-char (point-max)) |
208 (insert s))) | 207 (insert s))) |
209 | 208 |
210 (defun zone-shift-down () | 209 (defun zone-shift-down () |
211 (goto-char (point-max)) | 210 (goto-char (point-max)) |
212 (forward-line -1) | |
213 (beginning-of-line) | |
214 (let* ((b (point)) | 211 (let* ((b (point)) |
215 (e (progn | 212 (e (progn (forward-line -1) (point))) |
216 (end-of-line) | |
217 (if (looking-at "\n") (1+ (point)) (point)))) | |
218 (s (buffer-substring b e))) | 213 (s (buffer-substring b e))) |
219 (delete-region b e) | 214 (delete-region b e) |
220 (goto-char (point-min)) | 215 (goto-char (point-min)) |
221 (insert s))) | 216 (insert s))) |
222 | 217 |
223 (defun zone-shift-left () | 218 (defun zone-shift-left () |
224 (while (not (eobp)) | 219 (let (s) |
225 (or (eolp) | 220 (while (not (eobp)) |
226 (let ((c (following-char))) | 221 (unless (eolp) |
227 (delete-char 1) | 222 (setq s (buffer-substring (point) (1+ (point)))) |
228 (end-of-line) | 223 (delete-char 1) |
229 (insert c))) | 224 (end-of-line) |
230 (forward-line 1))) | 225 (insert s)) |
226 (forward-char 1)))) | |
231 | 227 |
232 (defun zone-shift-right () | 228 (defun zone-shift-right () |
233 (while (not (eobp)) | 229 (goto-char (point-max)) |
234 (end-of-line) | 230 (end-of-line) |
235 (or (bolp) | 231 (let (s) |
236 (let ((c (preceding-char))) | 232 (while (not (bobp)) |
237 (delete-backward-char 1) | 233 (unless (bolp) |
238 (beginning-of-line) | 234 (setq s (buffer-substring (1- (point)) (point))) |
239 (insert c))) | 235 (delete-char -1) |
240 (forward-line 1))) | 236 (beginning-of-line) |
237 (insert s)) | |
238 (end-of-line 0)))) | |
241 | 239 |
242 (defun zone-pgm-jitter () | 240 (defun zone-pgm-jitter () |
243 (let ((ops [ | 241 (let ((ops [ |
244 zone-shift-left | 242 zone-shift-left |
245 zone-shift-left | |
246 zone-shift-left | |
247 zone-shift-left | |
248 zone-shift-right | 243 zone-shift-right |
249 zone-shift-down | |
250 zone-shift-down | |
251 zone-shift-down | |
252 zone-shift-down | |
253 zone-shift-down | 244 zone-shift-down |
254 zone-shift-up | 245 zone-shift-up |
255 ])) | 246 ])) |
256 (goto-char (point-min)) | 247 (goto-char (point-min)) |
257 (while (not (input-pending-p)) | 248 (while (not (input-pending-p)) |
258 (funcall (elt ops (random (length ops)))) | 249 (funcall (elt ops (random (length ops)))) |
259 (goto-char (point-min)) | 250 (goto-char (point-min)) |
260 (sit-for 0 10)))) | 251 (sit-for 0 10)))) |
261 | 252 |
262 | 253 |
263 ;;;; zone-pgm-whack-chars | 254 ;;;; whacking chars |
264 | 255 |
265 (defun zone-pgm-whack-chars () | 256 (defun zone-pgm-whack-chars () |
266 (let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl)))) | 257 (let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl)))) |
267 (while (not (input-pending-p)) | 258 (while (not (input-pending-p)) |
268 (let ((i 48)) | 259 (let ((i 48)) |
278 (while (< i 128) | 269 (while (< i 128) |
279 (aset tbl i i) | 270 (aset tbl i i) |
280 (setq i (1+ i))) | 271 (setq i (1+ i))) |
281 tbl)) | 272 tbl)) |
282 | 273 |
283 ;;;; zone-pgm-dissolve | 274 ;;;; dissolving |
284 | 275 |
285 (defun zone-remove-text () | 276 (defun zone-remove-text () |
286 (let ((working t)) | 277 (let ((working t)) |
287 (while working | 278 (while working |
288 (setq working nil) | 279 (setq working nil) |
303 (defun zone-pgm-dissolve () | 294 (defun zone-pgm-dissolve () |
304 (zone-remove-text) | 295 (zone-remove-text) |
305 (zone-pgm-jitter)) | 296 (zone-pgm-jitter)) |
306 | 297 |
307 | 298 |
308 ;;;; zone-pgm-explode | 299 ;;;; exploding |
309 | 300 |
310 (defun zone-exploding-remove () | 301 (defun zone-exploding-remove () |
311 (let ((i 0)) | 302 (let ((i 0)) |
312 (while (< i 20) | 303 (while (< i 5) |
313 (save-excursion | 304 (save-excursion |
314 (goto-char (point-min)) | 305 (goto-char (point-min)) |
315 (while (not (eobp)) | 306 (while (not (eobp)) |
316 (if (looking-at "[^*\n\t ]") | 307 (if (looking-at "[^*\n\t ]") |
317 (let ((n (random 5))) | 308 (let ((n (random 5))) |
326 (defun zone-pgm-explode () | 317 (defun zone-pgm-explode () |
327 (zone-exploding-remove) | 318 (zone-exploding-remove) |
328 (zone-pgm-jitter)) | 319 (zone-pgm-jitter)) |
329 | 320 |
330 | 321 |
331 ;;;; zone-pgm-putz-with-case | 322 ;;;; putzing w/ case |
332 | 323 |
333 ;; Faster than `zone-pgm-putz-with-case', but not as good: all | 324 ;; Faster than `zone-pgm-putz-with-case', but not as good: all |
334 ;; instances of the same letter have the same case, which produces a | 325 ;; instances of the same letter have the same case, which produces a |
335 ;; less interesting effect than you might imagine. | 326 ;; less interesting effect than you might imagine. |
336 (defun zone-pgm-2nd-putz-with-case () | 327 (defun zone-pgm-2nd-putz-with-case () |
375 (setq np (+ np (1+ (random 5)))))) | 366 (setq np (+ np (1+ (random 5)))))) |
376 (goto-char (point-min)) | 367 (goto-char (point-min)) |
377 (sit-for 0 2))) | 368 (sit-for 0 2))) |
378 | 369 |
379 | 370 |
380 ;;;; zone-pgm-rotate | 371 ;;;; rotating |
381 | 372 |
382 (defun zone-line-specs () | 373 (defun zone-line-specs () |
383 (let (ret) | 374 (let (ret) |
384 (save-excursion | 375 (save-excursion |
385 (goto-char (window-start)) | 376 (goto-char (window-start)) |
437 | 428 |
438 (defun zone-pgm-rotate-RL-variable () | 429 (defun zone-pgm-rotate-RL-variable () |
439 (zone-pgm-rotate (lambda () (1- (- (random 3)))))) | 430 (zone-pgm-rotate (lambda () (1- (- (random 3)))))) |
440 | 431 |
441 | 432 |
442 ;;;; zone-pgm-drip | 433 ;;;; dripping |
443 | 434 |
444 (defun zone-cpos (pos) | 435 (defsubst zone-cpos (pos) |
445 (buffer-substring pos (1+ pos))) | 436 (buffer-substring pos (1+ pos))) |
446 | 437 |
447 (defun zone-fret (pos) | 438 (defsubst zone-replace-char (direction char-as-string new-value) |
439 (delete-char direction) | |
440 (aset char-as-string 0 new-value) | |
441 (insert char-as-string)) | |
442 | |
443 (defsubst zone-park/sit-for (pos seconds) | |
444 (let ((p (point))) | |
445 (goto-char pos) | |
446 (prog1 (sit-for seconds) | |
447 (goto-char p)))) | |
448 | |
449 (defun zone-fret (wbeg pos) | |
448 (let* ((case-fold-search nil) | 450 (let* ((case-fold-search nil) |
449 (c-string (zone-cpos pos)) | 451 (c-string (zone-cpos pos)) |
450 (hmm (cond | 452 (hmm (cond |
451 ((string-match "[a-z]" c-string) (upcase c-string)) | 453 ((string-match "[a-z]" c-string) (upcase c-string)) |
452 ((string-match "[A-Z]" c-string) (downcase c-string)) | 454 ((string-match "[A-Z]" c-string) (downcase c-string)) |
455 (wait 0.5 (* wait 0.8))) | 457 (wait 0.5 (* wait 0.8))) |
456 ((= i 20)) | 458 ((= i 20)) |
457 (goto-char pos) | 459 (goto-char pos) |
458 (delete-char 1) | 460 (delete-char 1) |
459 (insert (if (= 0 (% i 2)) hmm c-string)) | 461 (insert (if (= 0 (% i 2)) hmm c-string)) |
460 (sit-for wait)) | 462 (zone-park/sit-for wbeg wait)) |
461 (delete-char -1) (insert c-string))) | 463 (delete-char -1) (insert c-string))) |
462 | 464 |
463 (defun zone-fill-out-screen (width height) | 465 (defun zone-fill-out-screen (width height) |
464 (save-excursion | 466 (let ((start (window-start)) |
465 (goto-char (point-min)) | 467 (line (make-string width 32))) |
468 (goto-char start) | |
466 ;; fill out rectangular ws block | 469 ;; fill out rectangular ws block |
467 (while (not (eobp)) | 470 (while (progn (end-of-line) |
468 (end-of-line) | 471 (let ((cc (current-column))) |
469 (let ((cc (current-column))) | 472 (if (< cc width) |
470 (if (< cc width) | 473 (insert (substring line cc)) |
471 (insert (make-string (- width cc) 32)) | 474 (delete-char (- width cc))) |
472 (delete-char (- width cc)))) | 475 (cond ((eobp) (insert "\n") nil) |
473 (unless (eobp) | 476 (t (forward-char 1) t))))) |
474 (forward-char 1))) | |
475 ;; pad ws past bottom of screen | 477 ;; pad ws past bottom of screen |
476 (let ((nl (- height (count-lines (point-min) (point))))) | 478 (let ((nl (- height (count-lines (point-min) (point))))) |
477 (when (> nl 0) | 479 (when (> nl 0) |
478 (let ((line (concat (make-string (1- width) ? ) "\n"))) | 480 (setq line (concat line "\n")) |
479 (do ((i 0 (1+ i))) | 481 (do ((i 0 (1+ i))) |
480 ((= i nl)) | 482 ((= i nl)) |
481 (insert line))))))) | 483 (insert line)))) |
482 | 484 (goto-char start) |
483 (defun zone-fall-through-ws (c col wend) | 485 (recenter 0) |
486 (sit-for 0))) | |
487 | |
488 (defun zone-fall-through-ws (c ww wbeg wend) | |
484 (let ((fall-p nil) ; todo: move outward | 489 (let ((fall-p nil) ; todo: move outward |
485 (wait 0.15) | 490 (wait 0.15)) |
486 (o (point)) ; for terminals w/o cursor hiding | 491 (while (when (= 32 (char-after (+ (point) ww 1))) |
487 (p (point))) | 492 (setq fall-p t) |
488 (while (progn | 493 (delete-char 1) |
489 (forward-line 1) | 494 (insert " ") |
490 (move-to-column col) | 495 (forward-char ww) |
491 (looking-at " ")) | 496 (when (< (point) wend) |
492 (setq fall-p t) | 497 (delete-char 1) |
493 (delete-char 1) | 498 (insert c) |
494 (insert (if (< (point) wend) c " ")) | 499 (forward-char -1) |
495 (save-excursion | 500 (zone-park/sit-for wbeg (setq wait (* wait 0.8)))))) |
496 (goto-char p) | |
497 (delete-char 1) | |
498 (insert " ") | |
499 (goto-char o) | |
500 (sit-for (setq wait (* wait 0.8)))) | |
501 (setq p (1- (point)))) | |
502 fall-p)) | 501 fall-p)) |
503 | 502 |
504 (defun zone-pgm-drip (&optional fret-p pancake-p) | 503 (defun zone-pgm-drip (&optional fret-p pancake-p) |
505 (let* ((ww (1- (window-width))) | 504 (let* ((ww (1- (window-width))) |
506 (wh (window-height)) | 505 (wh (window-height)) |
507 (mc 0) ; miss count | 506 (mc 0) ; miss count |
508 (total (* ww wh)) | 507 (total (* ww wh)) |
509 (fall-p nil)) | 508 (fall-p nil) |
509 wbeg wend c) | |
510 (zone-fill-out-screen ww wh) | 510 (zone-fill-out-screen ww wh) |
511 (setq wbeg (window-start) | |
512 wend (window-end)) | |
511 (catch 'done | 513 (catch 'done |
512 (while (not (input-pending-p)) | 514 (while (not (input-pending-p)) |
513 (let ((wbeg (window-start)) | 515 (setq mc 0) |
514 (wend (window-end))) | 516 ;; select non-ws character, but don't miss too much |
515 (setq mc 0) | 517 (goto-char (+ wbeg (random (- wend wbeg)))) |
516 ;; select non-ws character, but don't miss too much | 518 (while (looking-at "[ \n\f]") |
517 (goto-char (+ wbeg (random (- wend wbeg)))) | 519 (if (= total (setq mc (1+ mc))) |
518 (while (looking-at "[ \n\f]") | 520 (throw 'done 'sel) |
519 (if (= total (setq mc (1+ mc))) | 521 (goto-char (+ wbeg (random (- wend wbeg)))))) |
520 (throw 'done 'sel) | 522 ;; character animation sequence |
521 (goto-char (+ wbeg (random (- wend wbeg)))))) | 523 (let ((p (point))) |
522 ;; character animation sequence | 524 (when fret-p (zone-fret wbeg p)) |
523 (let ((p (point))) | 525 (goto-char p) |
524 (when fret-p (zone-fret p)) | 526 (setq c (zone-cpos p) |
525 (goto-char p) | 527 fall-p (zone-fall-through-ws c ww wbeg wend))) |
526 (setq fall-p (zone-fall-through-ws | |
527 (zone-cpos p) (current-column) wend)))) | |
528 ;; assuming current-column has not changed... | 528 ;; assuming current-column has not changed... |
529 (when (and pancake-p | 529 (when (and pancake-p |
530 fall-p | 530 fall-p |
531 (< (count-lines (point-min) (point)) | 531 (< (count-lines (point-min) (point)) |
532 wh)) | 532 wh)) |
533 (previous-line 1) | 533 (zone-replace-char 1 c ?@) |
534 (forward-char 1) | 534 (zone-park/sit-for wbeg 0.137) |
535 (sit-for 0.137) | 535 (zone-replace-char -1 c ?*) |
536 (delete-char -1) | 536 (zone-park/sit-for wbeg 0.137) |
537 (insert "@") | 537 (zone-replace-char -1 c ?_)))))) |
538 (sit-for 0.137) | |
539 (delete-char -1) | |
540 (insert "*") | |
541 (sit-for 0.137) | |
542 (delete-char -1) | |
543 (insert "_")))))) | |
544 | 538 |
545 (defun zone-pgm-drip-fretfully () | 539 (defun zone-pgm-drip-fretfully () |
546 (zone-pgm-drip t)) | 540 (zone-pgm-drip t)) |
547 | 541 |
548 (defun zone-pgm-five-oclock-swan-dive () | 542 (defun zone-pgm-five-oclock-swan-dive () |
550 | 544 |
551 (defun zone-pgm-martini-swan-dive () | 545 (defun zone-pgm-martini-swan-dive () |
552 (zone-pgm-drip t t)) | 546 (zone-pgm-drip t t)) |
553 | 547 |
554 | 548 |
555 ;;;; zone-pgm-paragraph-spaz | 549 ;;;; paragraph spazzing (for textish modes) |
556 | 550 |
557 (defun zone-pgm-paragraph-spaz () | 551 (defun zone-pgm-paragraph-spaz () |
558 (if (memq (zone-orig major-mode) | 552 (if (memq (zone-orig major-mode) |
559 ;; there should be a better way to distinguish textish modes | 553 ;; there should be a better way to distinguish textish modes |
560 '(text-mode texinfo-mode fundamental-mode)) | 554 '(text-mode texinfo-mode fundamental-mode)) |
631 (let ((top (progn (goto-char (window-start)) (forward-line 7) (point))) | 625 (let ((top (progn (goto-char (window-start)) (forward-line 7) (point))) |
632 (bot (progn (goto-char (window-end)) (forward-line -7) (point))) | 626 (bot (progn (goto-char (window-end)) (forward-line -7) (point))) |
633 (rtc (- (frame-width) 11)) | 627 (rtc (- (frame-width) 11)) |
634 (min (window-start)) | 628 (min (window-start)) |
635 (max (1- (window-end))) | 629 (max (1- (window-end))) |
636 c col) | 630 s c col) |
637 (delete-region max (point-max)) | 631 (delete-region max (point-max)) |
638 (while (progn (goto-char (+ min (random max))) | 632 (while (and (progn (goto-char min) (sit-for 0.05)) |
639 (and (sit-for 0.005) | 633 (progn (goto-char (+ min (random max))) |
640 (or (progn (skip-chars-forward " @\n" max) | 634 (or (progn (skip-chars-forward " @\n" max) |
641 (not (= max (point)))) | 635 (not (= max (point)))) |
642 (unless (or (= 0 (skip-chars-backward " @\n" min)) | 636 (unless (or (= 0 (skip-chars-backward " @\n" min)) |
643 (= min (point))) | 637 (= min (point))) |
644 (forward-char -1) | 638 (forward-char -1) |
645 t)))) | 639 t)))) |
646 (setq c (char-after)) | 640 (unless (or (eolp) (eobp)) |
647 (unless (or (not c) (= ?\n c)) | 641 (setq s (zone-cpos (point)) |
648 (forward-char 1) | 642 c (aref s 0)) |
649 (insert-and-inherit ; keep colors | 643 (zone-replace-char |
650 (cond ((or (> top (point)) | 644 1 s (cond ((or (> top (point)) |
651 (< bot (point)) | 645 (< bot (point)) |
652 (or (> 11 (setq col (current-column))) | 646 (or (> 11 (setq col (current-column))) |
653 (< rtc col))) | 647 (< rtc col))) |
654 32) | 648 32) |
655 ((and (<= ?a c) (>= ?z c)) (+ c (- ?A ?a))) | 649 ((and (<= ?a c) (>= ?z c)) (+ c (- ?A ?a))) |
656 ((and (<= ?A c) (>= ?Z c)) ?*) | 650 ((and (<= ?A c) (>= ?Z c)) ?*) |
657 (t ?@))) | 651 (t ?@))))) |
658 (forward-char -1) | |
659 (delete-char -1))) | |
660 (sit-for 3) | 652 (sit-for 3) |
661 (setq col nil) | 653 (setq col nil) |
662 (goto-char bot) | 654 (goto-char bot) |
663 (while (< top (point)) | 655 (while (< top (point)) |
664 (setq c (point)) | 656 (setq c (point)) |
665 (move-to-column 9) | 657 (move-to-column 9) |
666 (setq col (cons (buffer-substring (point) c) col)) | 658 (setq col (cons (buffer-substring (point) c) col)) |
667 (end-of-line 0) | 659 (end-of-line 0) |
668 (forward-char -10)) | 660 (forward-char -10)) |
669 (let ((life-patterns (vector (cons (make-string (length (car col)) 32) | 661 (let ((life-patterns (vector |
670 col)))) | 662 (if (and col (re-search-forward "[^ ]" max t)) |
663 (cons (make-string (length (car col)) 32) col) | |
664 (list (mapconcat 'identity | |
665 (make-list (/ (- rtc 11) 15) | |
666 (make-string 5 ?@)) | |
667 (make-string 10 32))))))) | |
671 (life (or zone-pgm-random-life-wait (random 4))) | 668 (life (or zone-pgm-random-life-wait (random 4))) |
672 (kill-buffer nil)))) | 669 (kill-buffer nil)))) |
673 | 670 |
674 | 671 |
675 ;;;;;;;;;;;;;;; | 672 ;;;;;;;;;;;;;;; |