Mercurial > emacs
comparison lisp/play/zone.el @ 59013:811c3c23099a
(zone): Init `line-spacing' from orig buffer.
(zone-replace-char): Take `count' and `del-count'
instead of `direction'. Update callers. When `del-count' is
non-nil, delete that many characters, otherwise `count' characters
backwards. Insert the newly-replaced string `count' times.
(zone-fret): Handle chars w/ width greater than one.
(zone-fall-through-ws): No longer take window width `ww'.
Update callers. Add handling for `char-width' greater than one.
(zone-pgm-drip): Update var holding window-end position every cycle.
author | Thien-Thi Nguyen <ttn@gnuvola.org> |
---|---|
date | Fri, 17 Dec 2004 11:47:16 +0000 |
parents | ee201fcb86f7 |
children | 34b8a83e2361 |
comparison
equal
deleted
inserted
replaced
59012:4757a09db597 | 59013:811c3c23099a |
---|---|
144 (switch-to-buffer outbuf) | 144 (switch-to-buffer outbuf) |
145 (setq mode-name "Zone") | 145 (setq mode-name "Zone") |
146 (erase-buffer) | 146 (erase-buffer) |
147 (setq buffer-undo-list t | 147 (setq buffer-undo-list t |
148 truncate-lines t | 148 truncate-lines t |
149 tab-width (zone-orig tab-width)) | 149 tab-width (zone-orig tab-width) |
150 line-spacing (zone-orig line-spacing)) | |
150 (insert text) | 151 (insert text) |
151 (untabify (point-min) (point-max)) | 152 (untabify (point-min) (point-max)) |
152 (set-window-start (selected-window) (point-min)) | 153 (set-window-start (selected-window) (point-min)) |
153 (set-window-point (selected-window) wp) | 154 (set-window-point (selected-window) wp) |
154 (sit-for 0 500) | 155 (sit-for 0 500) |
444 ;;;; dripping | 445 ;;;; dripping |
445 | 446 |
446 (defsubst zone-cpos (pos) | 447 (defsubst zone-cpos (pos) |
447 (buffer-substring pos (1+ pos))) | 448 (buffer-substring pos (1+ pos))) |
448 | 449 |
449 (defsubst zone-replace-char (direction char-as-string new-value) | 450 (defsubst zone-replace-char (count del-count char-as-string new-value) |
450 (delete-char direction) | 451 (delete-char (or del-count (- count))) |
451 (aset char-as-string 0 new-value) | 452 (aset char-as-string 0 new-value) |
452 (insert char-as-string)) | 453 (dotimes (i count) (insert char-as-string))) |
453 | 454 |
454 (defsubst zone-park/sit-for (pos seconds) | 455 (defsubst zone-park/sit-for (pos seconds) |
455 (let ((p (point))) | 456 (let ((p (point))) |
456 (goto-char pos) | 457 (goto-char pos) |
457 (prog1 (sit-for seconds) | 458 (prog1 (sit-for seconds) |
458 (goto-char p)))) | 459 (goto-char p)))) |
459 | 460 |
460 (defun zone-fret (wbeg pos) | 461 (defun zone-fret (wbeg pos) |
461 (let* ((case-fold-search nil) | 462 (let* ((case-fold-search nil) |
462 (c-string (zone-cpos pos)) | 463 (c-string (zone-cpos pos)) |
464 (cw-ceil (ceiling (char-width (aref c-string 0)))) | |
463 (hmm (cond | 465 (hmm (cond |
464 ((string-match "[a-z]" c-string) (upcase c-string)) | 466 ((string-match "[a-z]" c-string) (upcase c-string)) |
465 ((string-match "[A-Z]" c-string) (downcase c-string)) | 467 ((string-match "[A-Z]" c-string) (downcase c-string)) |
466 (t " ")))) | 468 (t (propertize " " 'display `(space :width ,cw-ceil)))))) |
467 (do ((i 0 (1+ i)) | 469 (do ((i 0 (1+ i)) |
468 (wait 0.5 (* wait 0.8))) | 470 (wait 0.5 (* wait 0.8))) |
469 ((= i 20)) | 471 ((= i 20)) |
470 (goto-char pos) | 472 (goto-char pos) |
471 (delete-char 1) | 473 (delete-char 1) |
494 (insert line)))) | 496 (insert line)))) |
495 (goto-char start) | 497 (goto-char start) |
496 (recenter 0) | 498 (recenter 0) |
497 (sit-for 0))) | 499 (sit-for 0))) |
498 | 500 |
499 (defun zone-fall-through-ws (c ww wbeg wend) | 501 (defun zone-fall-through-ws (c wbeg wend) |
500 (let ((fall-p nil) ; todo: move outward | 502 (let* ((cw-ceil (ceiling (char-width (aref c 0)))) |
501 (wait 0.15)) | 503 (spaces (make-string cw-ceil 32)) |
502 (while (when (= 32 (char-after (+ (point) ww 1))) | 504 (col (current-column)) |
505 (wait 0.15) | |
506 newpos fall-p) | |
507 (while (when (save-excursion | |
508 (next-line 1) | |
509 (and (= col (current-column)) | |
510 (setq newpos (point)) | |
511 (string= spaces (buffer-substring-no-properties | |
512 newpos (+ newpos cw-ceil))) | |
513 (setq newpos (+ newpos (1- cw-ceil))))) | |
503 (setq fall-p t) | 514 (setq fall-p t) |
504 (delete-char 1) | 515 (delete-char 1) |
505 (insert " ") | 516 (insert spaces) |
506 (forward-char ww) | 517 (goto-char newpos) |
507 (when (< (point) wend) | 518 (when (< (point) wend) |
508 (delete-char 1) | 519 (delete-char cw-ceil) |
509 (insert c) | 520 (insert c) |
510 (forward-char -1) | 521 (forward-char -1) |
511 (zone-park/sit-for wbeg (setq wait (* wait 0.8)))))) | 522 (zone-park/sit-for wbeg (setq wait (* wait 0.8)))))) |
512 fall-p)) | 523 fall-p)) |
513 | 524 |
521 (zone-fill-out-screen ww wh) | 532 (zone-fill-out-screen ww wh) |
522 (setq wbeg (window-start) | 533 (setq wbeg (window-start) |
523 wend (window-end)) | 534 wend (window-end)) |
524 (catch 'done | 535 (catch 'done |
525 (while (not (input-pending-p)) | 536 (while (not (input-pending-p)) |
526 (setq mc 0) | 537 (setq mc 0 wend (window-end)) |
527 ;; select non-ws character, but don't miss too much | 538 ;; select non-ws character, but don't miss too much |
528 (goto-char (+ wbeg (random (- wend wbeg)))) | 539 (goto-char (+ wbeg (random (- wend wbeg)))) |
529 (while (looking-at "[ \n\f]") | 540 (while (looking-at "[ \n\f]") |
530 (if (= total (setq mc (1+ mc))) | 541 (if (= total (setq mc (1+ mc))) |
531 (throw 'done 'sel) | 542 (throw 'done 'sel) |
533 ;; character animation sequence | 544 ;; character animation sequence |
534 (let ((p (point))) | 545 (let ((p (point))) |
535 (when fret-p (zone-fret wbeg p)) | 546 (when fret-p (zone-fret wbeg p)) |
536 (goto-char p) | 547 (goto-char p) |
537 (setq c (zone-cpos p) | 548 (setq c (zone-cpos p) |
538 fall-p (zone-fall-through-ws c ww wbeg wend))) | 549 fall-p (zone-fall-through-ws c wbeg wend))) |
539 ;; assuming current-column has not changed... | 550 ;; assuming current-column has not changed... |
540 (when (and pancake-p | 551 (when (and pancake-p |
541 fall-p | 552 fall-p |
542 (< (count-lines (point-min) (point)) | 553 (< (count-lines (point-min) (point)) |
543 wh)) | 554 wh)) |
544 (zone-replace-char 1 c ?@) | 555 (let ((cw (ceiling (char-width (aref c 0))))) |
545 (zone-park/sit-for wbeg 0.137) | 556 (zone-replace-char cw 1 c ?@) (zone-park/sit-for wbeg 0.137) |
546 (zone-replace-char -1 c ?*) | 557 (zone-replace-char cw nil c ?*) (zone-park/sit-for wbeg 0.137) |
547 (zone-park/sit-for wbeg 0.137) | 558 (zone-replace-char cw nil c ?_))))))) |
548 (zone-replace-char -1 c ?_)))))) | |
549 | 559 |
550 (defun zone-pgm-drip-fretfully () | 560 (defun zone-pgm-drip-fretfully () |
551 (zone-pgm-drip t)) | 561 (zone-pgm-drip t)) |
552 | 562 |
553 (defun zone-pgm-five-oclock-swan-dive () | 563 (defun zone-pgm-five-oclock-swan-dive () |
650 t)))) | 660 t)))) |
651 (unless (or (eolp) (eobp)) | 661 (unless (or (eolp) (eobp)) |
652 (setq s (zone-cpos (point)) | 662 (setq s (zone-cpos (point)) |
653 c (aref s 0)) | 663 c (aref s 0)) |
654 (zone-replace-char | 664 (zone-replace-char |
655 1 s (cond ((or (> top (point)) | 665 (char-width c) |
666 t s (cond ((or (> top (point)) | |
656 (< bot (point)) | 667 (< bot (point)) |
657 (or (> 11 (setq col (current-column))) | 668 (or (> 11 (setq col (current-column))) |
658 (< rtc col))) | 669 (< rtc col))) |
659 32) | 670 32) |
660 ((and (<= ?a c) (>= ?z c)) (+ c (- ?A ?a))) | 671 ((and (<= ?a c) (>= ?z c)) (+ c (- ?A ?a))) |