changeset 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'.

--- a/lisp/play/zone.el	Wed Dec 15 13:23:25 2004 +0000
+++ b/lisp/play/zone.el	Wed Dec 15 13:53:58 2004 +0000
@@ -140,12 +140,13 @@
                    (window-start)))))
     (put 'zone 'orig-buffer (current-buffer))
     (put 'zone 'modeline-hidden-level 0)
-    (set-buffer outbuf)
+    (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)
-    (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)
@@ -195,13 +196,11 @@
   (message "I won't zone out any more"))
 
 
-;;;; zone-pgm-jitter
+;;;; jittering
 
 (defun zone-shift-up ()
   (let* ((b (point))
-         (e (progn
-              (end-of-line)
-              (if (looking-at "\n") (1+ (point)) (point))))
+         (e (progn (forward-line 1) (point)))
          (s (buffer-substring b e)))
     (delete-region b e)
     (goto-char (point-max))
@@ -209,48 +208,40 @@
 
 (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))))
+         (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 ()
-  (while (not (eobp))
-    (or (eolp)
-        (let ((c (following-char)))
-          (delete-char 1)
-          (end-of-line)
-          (insert c)))
-    (forward-line 1)))
+  (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 ()
-  (while (not (eobp))
-    (end-of-line)
-    (or (bolp)
-        (let ((c (preceding-char)))
-          (delete-backward-char 1)
-          (beginning-of-line)
-          (insert c)))
-    (forward-line 1)))
+  (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-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))
@@ -260,7 +251,7 @@
       (sit-for 0 10))))
 
 
-;;;; zone-pgm-whack-chars
+;;;; whacking chars
 
 (defun zone-pgm-whack-chars ()
   (let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl))))
@@ -280,7 +271,7 @@
          (setq i (1+ i)))
        tbl))
 
-;;;; zone-pgm-dissolve
+;;;; dissolving
 
 (defun zone-remove-text ()
   (let ((working t))
@@ -305,11 +296,11 @@
   (zone-pgm-jitter))
 
 
-;;;; zone-pgm-explode
+;;;; exploding
 
 (defun zone-exploding-remove ()
   (let ((i 0))
-    (while (< i 20)
+    (while (< i 5)
       (save-excursion
         (goto-char (point-min))
         (while (not (eobp))
@@ -328,7 +319,7 @@
   (zone-pgm-jitter))
 
 
-;;;; zone-pgm-putz-with-case
+;;;; 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,7 +368,7 @@
     (sit-for 0 2)))
 
 
-;;;; zone-pgm-rotate
+;;;; rotating
 
 (defun zone-line-specs ()
   (let (ret)
@@ -439,12 +430,23 @@
   (zone-pgm-rotate (lambda () (1- (- (random 3))))))
 
 
-;;;; zone-pgm-drip
+;;;; dripping
 
-(defun zone-cpos (pos)
+(defsubst zone-cpos (pos)
   (buffer-substring pos (1+ pos)))
 
-(defun zone-fret (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,48 +459,45 @@
       (goto-char pos)
       (delete-char 1)
       (insert (if (= 0 (% i 2)) hmm c-string))
-      (sit-for wait))
+      (zone-park/sit-for wbeg wait))
     (delete-char -1) (insert c-string)))
 
 (defun zone-fill-out-screen (width height)
-  (save-excursion
-    (goto-char (point-min))
+  (let ((start (window-start))
+	(line (make-string width 32)))
+    (goto-char start)
     ;; 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)))
+    (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)
-        (let ((line (concat (make-string (1- width) ? ) "\n")))
-          (do ((i 0 (1+ i)))
-              ((= i nl))
-            (insert line)))))))
+	(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 col wend)
+(defun zone-fall-through-ws (c ww wbeg 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))))
+        (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,41 +505,36 @@
          (wh (window-height))
          (mc 0)                         ; miss count
          (total (* ww wh))
-         (fall-p nil))
+         (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))
-        (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))))
+        (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))
-          (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 "_"))))))
+          (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,7 +546,7 @@
   (zone-pgm-drip t t))
 
 
-;;;; zone-pgm-paragraph-spaz
+;;;; paragraph spazzing (for textish modes)
 
 (defun zone-pgm-paragraph-spaz ()
   (if (memq (zone-orig major-mode)
@@ -633,30 +627,28 @@
         (rtc (- (frame-width) 11))
         (min (window-start))
         (max (1- (window-end)))
-        c col)
+        s c col)
     (delete-region max (point-max))
-    (while (progn (goto-char (+ min (random max)))
-                  (and (sit-for 0.005)
+    (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))))
-      (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)))
+      (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,8 +658,13 @@
       (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))))
+    (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))))