[Emacs-diffs] Changes to emacs/lisp/play/zone.el

[Thien-Thi Nguyen]

Index: emacs/lisp/play/zone.el
diff -c emacs/lisp/play/zone.el:1.13 emacs/lisp/play/zone.el:1.14
*** emacs/lisp/play/zone.el:1.13        Sat Dec 11 14:49:45 2004
--- emacs/lisp/play/zone.el     Wed Dec 15 13:53:58 2004
***************
*** 140,151 ****
                     (window-start)))))
      (put 'zone 'orig-buffer (current-buffer))
      (put 'zone 'modeline-hidden-level 0)
!     (set-buffer outbuf)
      (setq mode-name "Zone")
      (erase-buffer)
      (insert text)
-     (switch-to-buffer outbuf)
-     (setq buffer-undo-list t)
      (untabify (point-min) (point-max))
      (set-window-start (selected-window) (point-min))
      (set-window-point (selected-window) wp)
--- 140,152 ----
                     (window-start)))))
      (put 'zone 'orig-buffer (current-buffer))
      (put 'zone 'modeline-hidden-level 0)
!     (switch-to-buffer outbuf)
      (setq mode-name "Zone")
      (erase-buffer)
+     (setq buffer-undo-list t
+           truncate-lines t
+           tab-width (zone-orig tab-width))
      (insert text)
      (untabify (point-min) (point-max))
      (set-window-start (selected-window) (point-min))
      (set-window-point (selected-window) wp)
***************
*** 195,207 ****
    (message "I won't zone out any more"))
  
  
! ;;;; zone-pgm-jitter
  
  (defun zone-shift-up ()
    (let* ((b (point))
!          (e (progn
!               (end-of-line)
!               (if (looking-at "\n") (1+ (point)) (point))))
           (s (buffer-substring b e)))
      (delete-region b e)
      (goto-char (point-max))
--- 196,206 ----
    (message "I won't zone out any more"))
  
  
! ;;;; jittering
  
  (defun zone-shift-up ()
    (let* ((b (point))
!          (e (progn (forward-line 1) (point)))
           (s (buffer-substring b e)))
      (delete-region b e)
      (goto-char (point-max))
***************
*** 209,256 ****
  
  (defun zone-shift-down ()
    (goto-char (point-max))
-   (forward-line -1)
-   (beginning-of-line)
    (let* ((b (point))
!          (e (progn
!               (end-of-line)
!               (if (looking-at "\n") (1+ (point)) (point))))
           (s (buffer-substring b e)))
      (delete-region b e)
      (goto-char (point-min))
      (insert s)))
  
  (defun zone-shift-left ()
!   (while (not (eobp))
!     (or (eolp)
!         (let ((c (following-char)))
!           (delete-char 1)
!           (end-of-line)
!           (insert c)))
!     (forward-line 1)))
  
  (defun zone-shift-right ()
!   (while (not (eobp))
!     (end-of-line)
!     (or (bolp)
!         (let ((c (preceding-char)))
!           (delete-backward-char 1)
!           (beginning-of-line)
!           (insert c)))
!     (forward-line 1)))
  
  (defun zone-pgm-jitter ()
    (let ((ops [
                zone-shift-left
-               zone-shift-left
-               zone-shift-left
-               zone-shift-left
                zone-shift-right
                zone-shift-down
-               zone-shift-down
-               zone-shift-down
-               zone-shift-down
-               zone-shift-down
                zone-shift-up
                ]))
      (goto-char (point-min))
--- 208,247 ----
  
  (defun zone-shift-down ()
    (goto-char (point-max))
    (let* ((b (point))
!          (e (progn (forward-line -1) (point)))
           (s (buffer-substring b e)))
      (delete-region b e)
      (goto-char (point-min))
      (insert s)))
  
  (defun zone-shift-left ()
!   (let (s)
!     (while (not (eobp))
!       (unless (eolp)
!         (setq s (buffer-substring (point) (1+ (point))))
!         (delete-char 1)
!         (end-of-line)
!         (insert s))
!       (forward-char 1))))
  
  (defun zone-shift-right ()
!   (goto-char (point-max))
!   (end-of-line)
!   (let (s)
!     (while (not (bobp))
!       (unless (bolp)
!         (setq s (buffer-substring (1- (point)) (point)))
!         (delete-char -1)
!         (beginning-of-line)
!         (insert s))
!       (end-of-line 0))))
  
  (defun zone-pgm-jitter ()
    (let ((ops [
                zone-shift-left
                zone-shift-right
                zone-shift-down
                zone-shift-up
                ]))
      (goto-char (point-min))
***************
*** 260,266 ****
        (sit-for 0 10))))
  
  
! ;;;; zone-pgm-whack-chars
  
  (defun zone-pgm-whack-chars ()
    (let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl))))
--- 251,257 ----
        (sit-for 0 10))))
  
  
! ;;;; whacking chars
  
  (defun zone-pgm-whack-chars ()
    (let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl))))
***************
*** 280,286 ****
           (setq i (1+ i)))
         tbl))
  
! ;;;; zone-pgm-dissolve
  
  (defun zone-remove-text ()
    (let ((working t))
--- 271,277 ----
           (setq i (1+ i)))
         tbl))
  
! ;;;; dissolving
  
  (defun zone-remove-text ()
    (let ((working t))
***************
*** 305,315 ****
    (zone-pgm-jitter))
  
  
! ;;;; zone-pgm-explode
  
  (defun zone-exploding-remove ()
    (let ((i 0))
!     (while (< i 20)
        (save-excursion
          (goto-char (point-min))
          (while (not (eobp))
--- 296,306 ----
    (zone-pgm-jitter))
  
  
! ;;;; exploding
  
  (defun zone-exploding-remove ()
    (let ((i 0))
!     (while (< i 5)
        (save-excursion
          (goto-char (point-min))
          (while (not (eobp))
***************
*** 328,334 ****
    (zone-pgm-jitter))
  
  
! ;;;; zone-pgm-putz-with-case
  
  ;; Faster than `zone-pgm-putz-with-case', but not as good: all
  ;; instances of the same letter have the same case, which produces a
--- 319,325 ----
    (zone-pgm-jitter))
  
  
! ;;;; putzing w/ case
  
  ;; Faster than `zone-pgm-putz-with-case', but not as good: all
  ;; instances of the same letter have the same case, which produces a
***************
*** 377,383 ****
      (sit-for 0 2)))
  
  
! ;;;; zone-pgm-rotate
  
  (defun zone-line-specs ()
    (let (ret)
--- 368,374 ----
      (sit-for 0 2)))
  
  
! ;;;; rotating
  
  (defun zone-line-specs ()
    (let (ret)
***************
*** 439,450 ****
    (zone-pgm-rotate (lambda () (1- (- (random 3))))))
  
  
! ;;;; zone-pgm-drip
  
! (defun zone-cpos (pos)
    (buffer-substring pos (1+ pos)))
  
! (defun zone-fret (pos)
    (let* ((case-fold-search nil)
           (c-string (zone-cpos pos))
           (hmm (cond
--- 430,452 ----
    (zone-pgm-rotate (lambda () (1- (- (random 3))))))
  
  
! ;;;; dripping
  
! (defsubst zone-cpos (pos)
    (buffer-substring pos (1+ pos)))
  
! (defsubst zone-replace-char (direction char-as-string new-value)
!   (delete-char direction)
!   (aset char-as-string 0 new-value)
!   (insert char-as-string))
! 
! (defsubst zone-park/sit-for (pos seconds)
!   (let ((p (point)))
!     (goto-char pos)
!     (prog1 (sit-for seconds)
!       (goto-char p))))
! 
! (defun zone-fret (wbeg pos)
    (let* ((case-fold-search nil)
           (c-string (zone-cpos pos))
           (hmm (cond
***************
*** 457,504 ****
        (goto-char pos)
        (delete-char 1)
        (insert (if (= 0 (% i 2)) hmm c-string))
!       (sit-for wait))
      (delete-char -1) (insert c-string)))
  
  (defun zone-fill-out-screen (width height)
!   (save-excursion
!     (goto-char (point-min))
      ;; fill out rectangular ws block
!     (while (not (eobp))
!       (end-of-line)
!       (let ((cc (current-column)))
!         (if (< cc width)
!             (insert (make-string (- width cc) 32))
!           (delete-char (- width cc))))
!       (unless (eobp)
!         (forward-char 1)))
      ;; pad ws past bottom of screen
      (let ((nl (- height (count-lines (point-min) (point)))))
        (when (> nl 0)
!         (let ((line (concat (make-string (1- width) ? ) "\n")))
!           (do ((i 0 (1+ i)))
!               ((= i nl))
!             (insert line)))))))
  
! (defun zone-fall-through-ws (c col wend)
    (let ((fall-p nil)                    ; todo: move outward
!         (wait 0.15)
!         (o (point))                     ; for terminals w/o cursor hiding
!         (p (point)))
!     (while (progn
!              (forward-line 1)
!              (move-to-column col)
!              (looking-at " "))
!       (setq fall-p t)
!       (delete-char 1)
!       (insert (if (< (point) wend) c " "))
!       (save-excursion
!         (goto-char p)
!         (delete-char 1)
!         (insert " ")
!         (goto-char o)
!         (sit-for (setq wait (* wait 0.8))))
!       (setq p (1- (point))))
      fall-p))
  
  (defun zone-pgm-drip (&optional fret-p pancake-p)
--- 459,503 ----
        (goto-char pos)
        (delete-char 1)
        (insert (if (= 0 (% i 2)) hmm c-string))
!       (zone-park/sit-for wbeg wait))
      (delete-char -1) (insert c-string)))
  
  (defun zone-fill-out-screen (width height)
!   (let ((start (window-start))
!       (line (make-string width 32)))
!     (goto-char start)
      ;; fill out rectangular ws block
!     (while (progn (end-of-line)
!                 (let ((cc (current-column)))
!                   (if (< cc width)
!                       (insert (substring line cc))
!                     (delete-char (- width cc)))
!                   (cond ((eobp) (insert "\n") nil)
!                         (t (forward-char 1) t)))))
      ;; pad ws past bottom of screen
      (let ((nl (- height (count-lines (point-min) (point)))))
        (when (> nl 0)
!       (setq line (concat line "\n"))
!       (do ((i 0 (1+ i)))
!           ((= i nl))
!         (insert line))))
!     (goto-char start)
!     (recenter 0)
!     (sit-for 0)))
  
! (defun zone-fall-through-ws (c ww wbeg wend)
    (let ((fall-p nil)                    ; todo: move outward
!         (wait 0.15))
!     (while (when (= 32 (char-after (+ (point) ww 1)))
!            (setq fall-p t)
!            (delete-char 1)
!            (insert " ")
!            (forward-char ww)
!            (when (< (point) wend)
!              (delete-char 1)
!              (insert c)
!              (forward-char -1)
!              (zone-park/sit-for wbeg (setq wait (* wait 0.8))))))
      fall-p))
  
  (defun zone-pgm-drip (&optional fret-p pancake-p)
***************
*** 506,546 ****
           (wh (window-height))
           (mc 0)                         ; miss count
           (total (* ww wh))
!          (fall-p nil))
      (zone-fill-out-screen ww wh)
      (catch 'done
        (while (not (input-pending-p))
!         (let ((wbeg (window-start))
!               (wend (window-end)))
!           (setq mc 0)
!           ;; select non-ws character, but don't miss too much
!           (goto-char (+ wbeg (random (- wend wbeg))))
!           (while (looking-at "[ \n\f]")
!             (if (= total (setq mc (1+ mc)))
!                 (throw 'done 'sel)
!               (goto-char (+ wbeg (random (- wend wbeg))))))
!           ;; character animation sequence
!           (let ((p (point)))
!             (when fret-p (zone-fret p))
!             (goto-char p)
!             (setq fall-p (zone-fall-through-ws
!                           (zone-cpos p) (current-column) wend))))
          ;; assuming current-column has not changed...
          (when (and pancake-p
                     fall-p
                     (< (count-lines (point-min) (point))
                        wh))
!           (previous-line 1)
!           (forward-char 1)
!           (sit-for 0.137)
!           (delete-char -1)
!           (insert "@")
!           (sit-for 0.137)
!           (delete-char -1)
!           (insert "*")
!           (sit-for 0.137)
!           (delete-char -1)
!           (insert "_"))))))
  
  (defun zone-pgm-drip-fretfully ()
    (zone-pgm-drip t))
--- 505,540 ----
           (wh (window-height))
           (mc 0)                         ; miss count
           (total (* ww wh))
!          (fall-p nil)
!          wbeg wend c)
      (zone-fill-out-screen ww wh)
+     (setq wbeg (window-start)
+           wend (window-end))
      (catch 'done
        (while (not (input-pending-p))
!         (setq mc 0)
!         ;; select non-ws character, but don't miss too much
!         (goto-char (+ wbeg (random (- wend wbeg))))
!         (while (looking-at "[ \n\f]")
!           (if (= total (setq mc (1+ mc)))
!               (throw 'done 'sel)
!             (goto-char (+ wbeg (random (- wend wbeg))))))
!         ;; character animation sequence
!         (let ((p (point)))
!           (when fret-p (zone-fret wbeg p))
!           (goto-char p)
!           (setq c (zone-cpos p)
!                 fall-p (zone-fall-through-ws c ww wbeg wend)))
          ;; assuming current-column has not changed...
          (when (and pancake-p
                     fall-p
                     (< (count-lines (point-min) (point))
                        wh))
!           (zone-replace-char 1 c ?@)
!           (zone-park/sit-for wbeg 0.137)
!           (zone-replace-char -1 c ?*)
!           (zone-park/sit-for wbeg 0.137)
!           (zone-replace-char -1 c ?_))))))
  
  (defun zone-pgm-drip-fretfully ()
    (zone-pgm-drip t))
***************
*** 552,558 ****
    (zone-pgm-drip t t))
  
  
! ;;;; zone-pgm-paragraph-spaz
  
  (defun zone-pgm-paragraph-spaz ()
    (if (memq (zone-orig major-mode)
--- 546,552 ----
    (zone-pgm-drip t t))
  
  
! ;;;; paragraph spazzing (for textish modes)
  
  (defun zone-pgm-paragraph-spaz ()
    (if (memq (zone-orig major-mode)
***************
*** 633,662 ****
          (rtc (- (frame-width) 11))
          (min (window-start))
          (max (1- (window-end)))
!         c col)
      (delete-region max (point-max))
!     (while (progn (goto-char (+ min (random max)))
!                   (and (sit-for 0.005)
                         (or (progn (skip-chars-forward " @\n" max)
                                    (not (= max (point))))
                             (unless (or (= 0 (skip-chars-backward " @\n" min))
                                         (= min (point)))
                               (forward-char -1)
                               t))))
!       (setq c (char-after))
!       (unless (or (not c) (= ?\n c))
!         (forward-char 1)
!         (insert-and-inherit             ; keep colors
!          (cond ((or (> top (point))
!                     (< bot (point))
!                     (or (> 11 (setq col (current-column)))
!                         (< rtc col)))
!                 32)
!                ((and (<= ?a c) (>= ?z c)) (+ c (- ?A ?a)))
!                ((and (<= ?A c) (>= ?Z c)) ?*)
!                (t ?@)))
!         (forward-char -1)
!         (delete-char -1)))
      (sit-for 3)
      (setq col nil)
      (goto-char bot)
--- 627,654 ----
          (rtc (- (frame-width) 11))
          (min (window-start))
          (max (1- (window-end)))
!         s c col)
      (delete-region max (point-max))
!     (while (and (progn (goto-char min) (sit-for 0.05))
!                 (progn (goto-char (+ min (random max)))
                         (or (progn (skip-chars-forward " @\n" max)
                                    (not (= max (point))))
                             (unless (or (= 0 (skip-chars-backward " @\n" min))
                                         (= min (point)))
                               (forward-char -1)
                               t))))
!       (unless (or (eolp) (eobp))
!         (setq s (zone-cpos (point))
!               c (aref s 0))
!         (zone-replace-char
!          1 s (cond ((or (> top (point))
!                         (< bot (point))
!                         (or (> 11 (setq col (current-column)))
!                             (< rtc col)))
!                     32)
!                    ((and (<= ?a c) (>= ?z c)) (+ c (- ?A ?a)))
!                    ((and (<= ?A c) (>= ?Z c)) ?*)
!                    (t ?@)))))
      (sit-for 3)
      (setq col nil)
      (goto-char bot)
***************
*** 666,673 ****
        (setq col (cons (buffer-substring (point) c) col))
        (end-of-line 0)
        (forward-char -10))
!     (let ((life-patterns (vector (cons (make-string (length (car col)) 32)
!                                        col))))
        (life (or zone-pgm-random-life-wait (random 4)))
        (kill-buffer nil))))
  
--- 658,670 ----
        (setq col (cons (buffer-substring (point) c) col))
        (end-of-line 0)
        (forward-char -10))
!     (let ((life-patterns (vector
!                           (if (and col (re-search-forward "[^ ]" max t))
!                               (cons (make-string (length (car col)) 32) col)
!                             (list (mapconcat 'identity
!                                              (make-list (/ (- rtc 11) 15)
!                                                         (make-string 5 ?@))
!                                              (make-string 10 32)))))))
        (life (or zone-pgm-random-life-wait (random 4)))
        (kill-buffer nil))))