mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-28 07:45:00 +00:00
Code Issues Releases Activity

(zone): Set `truncate-lines'.

Browse Source 
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'.
This commit is contained in:
Thien-Thi Nguyen 2004-12-15 13:53:58 +00:00
parent 1bb3da3814
commit 3ef8085247
1 changed files with 120 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

243
lisp/play/zone.el
View File

@ -140,12 +140,13 @@ If the element is a function or a list of a function and a number,
(window-start))))) (window-start)))))
(put 'zone 'orig-buffer (current-buffer)) (put 'zone 'orig-buffer (current-buffer))
(put 'zone 'modeline-hidden-level 0) (put 'zone 'modeline-hidden-level 0)
(set-buffer outbuf) (switch-to-buffer outbuf)
(setq mode-name "Zone") (setq mode-name "Zone")
(erase-buffer) (erase-buffer)
(setq buffer-undo-list t
truncate-lines t
tab-width (zone-orig tab-width))
(insert text) (insert text)
(switch-to-buffer outbuf)
(setq buffer-undo-list t)
(untabify (point-min) (point-max)) (untabify (point-min) (point-max))
(set-window-start (selected-window) (point-min)) (set-window-start (selected-window) (point-min))
(set-window-point (selected-window) wp) (set-window-point (selected-window) wp)
@ -195,13 +196,11 @@ If the element is a function or a list of a function and a number,
(message "I won't zone out any more")) (message "I won't zone out any more"))
;;;; zone-pgm-jitter ;;;; jittering
(defun zone-shift-up () (defun zone-shift-up ()
(let* ((b (point)) (let* ((b (point))
(e (progn (e (progn (forward-line 1) (point)))
(end-of-line)
(if (looking-at "\n") (1+ (point)) (point))))
(s (buffer-substring b e))) (s (buffer-substring b e)))
(delete-region b e) (delete-region b e)
(goto-char (point-max)) (goto-char (point-max))
@ -209,48 +208,40 @@ If the element is a function or a list of a function and a number,
(defun zone-shift-down () (defun zone-shift-down ()
(goto-char (point-max)) (goto-char (point-max))
(forward-line -1)
(beginning-of-line)
(let* ((b (point)) (let* ((b (point))
(e (progn (e (progn (forward-line -1) (point)))
(end-of-line)
(if (looking-at "\n") (1+ (point)) (point))))
(s (buffer-substring b e))) (s (buffer-substring b e)))
(delete-region b e) (delete-region b e)
(goto-char (point-min)) (goto-char (point-min))
(insert s))) (insert s)))
(defun zone-shift-left () (defun zone-shift-left ()
(while (not (eobp)) (let (s)
(or (eolp) (while (not (eobp))
(let ((c (following-char))) (unless (eolp)
(delete-char 1) (setq s (buffer-substring (point) (1+ (point))))
(end-of-line) (delete-char 1)
(insert c))) (end-of-line)
(forward-line 1))) (insert s))
(forward-char 1))))
(defun zone-shift-right () (defun zone-shift-right ()
(while (not (eobp)) (goto-char (point-max))
(end-of-line) (end-of-line)
(or (bolp) (let (s)
(let ((c (preceding-char))) (while (not (bobp))
(delete-backward-char 1) (unless (bolp)
(beginning-of-line) (setq s (buffer-substring (1- (point)) (point)))
(insert c))) (delete-char -1)
(forward-line 1))) (beginning-of-line)
(insert s))
(end-of-line 0))))
(defun zone-pgm-jitter () (defun zone-pgm-jitter ()
(let ((ops [ (let ((ops [
zone-shift-left
zone-shift-left
zone-shift-left
zone-shift-left zone-shift-left
zone-shift-right zone-shift-right
zone-shift-down zone-shift-down
zone-shift-down
zone-shift-down
zone-shift-down
zone-shift-down
zone-shift-up zone-shift-up
])) ]))
(goto-char (point-min)) (goto-char (point-min))
@ -260,7 +251,7 @@ If the element is a function or a list of a function and a number,
(sit-for 0 10)))) (sit-for 0 10))))
;;;; zone-pgm-whack-chars ;;;; whacking chars
(defun zone-pgm-whack-chars () (defun zone-pgm-whack-chars ()
(let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl)))) (let ((tbl (copy-sequence (get 'zone-pgm-whack-chars 'wc-tbl))))
@ -280,7 +271,7 @@ If the element is a function or a list of a function and a number,
(setq i (1+ i))) (setq i (1+ i)))
tbl)) tbl))
;;;; zone-pgm-dissolve ;;;; dissolving
(defun zone-remove-text () (defun zone-remove-text ()
(let ((working t)) (let ((working t))
@ -305,11 +296,11 @@ If the element is a function or a list of a function and a number,
(zone-pgm-jitter)) (zone-pgm-jitter))
;;;; zone-pgm-explode ;;;; exploding
(defun zone-exploding-remove () (defun zone-exploding-remove ()
(let ((i 0)) (let ((i 0))
(while (< i 20) (while (< i 5)
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(while (not (eobp)) (while (not (eobp))
@ -328,7 +319,7 @@ If the element is a function or a list of a function and a number,
(zone-pgm-jitter)) (zone-pgm-jitter))
;;;; zone-pgm-putz-with-case ;;;; putzing w/ case
;; Faster than `zone-pgm-putz-with-case', but not as good: all ;; Faster than `zone-pgm-putz-with-case', but not as good: all
;; instances of the same letter have the same case, which produces a ;; instances of the same letter have the same case, which produces a
@ -377,7 +368,7 @@ If the element is a function or a list of a function and a number,
(sit-for 0 2))) (sit-for 0 2)))
;;;; zone-pgm-rotate ;;;; rotating
(defun zone-line-specs () (defun zone-line-specs ()
(let (ret) (let (ret)
@ -439,12 +430,23 @@ If the element is a function or a list of a function and a number,
(zone-pgm-rotate (lambda () (1- (- (random 3)))))) (zone-pgm-rotate (lambda () (1- (- (random 3))))))
;;;; zone-pgm-drip ;;;; dripping
(defun zone-cpos (pos) (defsubst zone-cpos (pos)
(buffer-substring pos (1+ 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) (let* ((case-fold-search nil)
(c-string (zone-cpos pos)) (c-string (zone-cpos pos))
(hmm (cond (hmm (cond
@ -457,48 +459,45 @@ If the element is a function or a list of a function and a number,
(goto-char pos) (goto-char pos)
(delete-char 1) (delete-char 1)
(insert (if (= 0 (% i 2)) hmm c-string)) (insert (if (= 0 (% i 2)) hmm c-string))
(sit-for wait)) (zone-park/sit-for wbeg wait))
(delete-char -1) (insert c-string))) (delete-char -1) (insert c-string)))
(defun zone-fill-out-screen (width height) (defun zone-fill-out-screen (width height)
(save-excursion (let ((start (window-start))
(goto-char (point-min)) (line (make-string width 32)))
(goto-char start)
;; fill out rectangular ws block ;; fill out rectangular ws block
(while (not (eobp)) (while (progn (end-of-line)
(end-of-line) (let ((cc (current-column)))
(let ((cc (current-column))) (if (< cc width)
(if (< cc width) (insert (substring line cc))
(insert (make-string (- width cc) 32)) (delete-char (- width cc)))
(delete-char (- width cc)))) (cond ((eobp) (insert "\n") nil)
(unless (eobp) (t (forward-char 1) t)))))
(forward-char 1)))
;; pad ws past bottom of screen ;; pad ws past bottom of screen
(let ((nl (- height (count-lines (point-min) (point))))) (let ((nl (- height (count-lines (point-min) (point)))))
(when (> nl 0) (when (> nl 0)
(let ((line (concat (make-string (1- width) ? ) "\n"))) (setq line (concat line "\n"))
(do ((i 0 (1+ i))) (do ((i 0 (1+ i)))
((= i nl)) ((= i nl))
(insert line))))))) (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 (let ((fall-p nil) ; todo: move outward
(wait 0.15) (wait 0.15))
(o (point)) ; for terminals w/o cursor hiding (while (when (= 32 (char-after (+ (point) ww 1)))
(p (point))) (setq fall-p t)
(while (progn (delete-char 1)
(forward-line 1) (insert " ")
(move-to-column col) (forward-char ww)
(looking-at " ")) (when (< (point) wend)
(setq fall-p t) (delete-char 1)
(delete-char 1) (insert c)
(insert (if (< (point) wend) c " ")) (forward-char -1)
(save-excursion (zone-park/sit-for wbeg (setq wait (* wait 0.8))))))
(goto-char p)
(delete-char 1)
(insert " ")
(goto-char o)
(sit-for (setq wait (* wait 0.8))))
(setq p (1- (point))))
fall-p)) fall-p))
(defun zone-pgm-drip (&optional fret-p pancake-p) (defun zone-pgm-drip (&optional fret-p pancake-p)
@ -506,41 +505,36 @@ If the element is a function or a list of a function and a number,
(wh (window-height)) (wh (window-height))
(mc 0) ; miss count (mc 0) ; miss count
(total (* ww wh)) (total (* ww wh))
(fall-p nil)) (fall-p nil)
wbeg wend c)
(zone-fill-out-screen ww wh) (zone-fill-out-screen ww wh)
(setq wbeg (window-start)
wend (window-end))
(catch 'done (catch 'done
(while (not (input-pending-p)) (while (not (input-pending-p))
(let ((wbeg (window-start)) (setq mc 0)
(wend (window-end))) ;; select non-ws character, but don't miss too much
(setq mc 0) (goto-char (+ wbeg (random (- wend wbeg))))
;; select non-ws character, but don't miss too much (while (looking-at "[ \n\f]")
(goto-char (+ wbeg (random (- wend wbeg)))) (if (= total (setq mc (1+ mc)))
(while (looking-at "[ \n\f]") (throw 'done 'sel)
(if (= total (setq mc (1+ mc))) (goto-char (+ wbeg (random (- wend wbeg))))))
(throw 'done 'sel) ;; character animation sequence
(goto-char (+ wbeg (random (- wend wbeg)))))) (let ((p (point)))
;; character animation sequence (when fret-p (zone-fret wbeg p))
(let ((p (point))) (goto-char p)
(when fret-p (zone-fret p)) (setq c (zone-cpos p)
(goto-char p) fall-p (zone-fall-through-ws c ww wbeg wend)))
(setq fall-p (zone-fall-through-ws
(zone-cpos p) (current-column) wend))))
;; assuming current-column has not changed... ;; assuming current-column has not changed...
(when (and pancake-p (when (and pancake-p
fall-p fall-p
(< (count-lines (point-min) (point)) (< (count-lines (point-min) (point))
wh)) wh))
(previous-line 1) (zone-replace-char 1 c ?@)
(forward-char 1) (zone-park/sit-for wbeg 0.137)
(sit-for 0.137) (zone-replace-char -1 c ?*)
(delete-char -1) (zone-park/sit-for wbeg 0.137)
(insert "@") (zone-replace-char -1 c ?_))))))
(sit-for 0.137)
(delete-char -1)
(insert "*")
(sit-for 0.137)
(delete-char -1)
(insert "_"))))))
(defun zone-pgm-drip-fretfully () (defun zone-pgm-drip-fretfully ()
(zone-pgm-drip t)) (zone-pgm-drip t))
@ -552,7 +546,7 @@ If the element is a function or a list of a function and a number,
(zone-pgm-drip t t)) (zone-pgm-drip t t))
;;;; zone-pgm-paragraph-spaz ;;;; paragraph spazzing (for textish modes)
(defun zone-pgm-paragraph-spaz () (defun zone-pgm-paragraph-spaz ()
(if (memq (zone-orig major-mode) (if (memq (zone-orig major-mode)
@ -633,30 +627,28 @@ If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).")
(rtc (- (frame-width) 11)) (rtc (- (frame-width) 11))
(min (window-start)) (min (window-start))
(max (1- (window-end))) (max (1- (window-end)))
c col) s c col)
(delete-region max (point-max)) (delete-region max (point-max))
(while (progn (goto-char (+ min (random max))) (while (and (progn (goto-char min) (sit-for 0.05))
(and (sit-for 0.005) (progn (goto-char (+ min (random max)))
(or (progn (skip-chars-forward " @\n" max) (or (progn (skip-chars-forward " @\n" max)
(not (= max (point)))) (not (= max (point))))
(unless (or (= 0 (skip-chars-backward " @\n" min)) (unless (or (= 0 (skip-chars-backward " @\n" min))
(= min (point))) (= min (point)))
(forward-char -1) (forward-char -1)
t)))) t))))
(setq c (char-after)) (unless (or (eolp) (eobp))
(unless (or (not c) (= ?\n c)) (setq s (zone-cpos (point))
(forward-char 1) c (aref s 0))
(insert-and-inherit ; keep colors (zone-replace-char
(cond ((or (> top (point)) 1 s (cond ((or (> top (point))
(< bot (point)) (< bot (point))
(or (> 11 (setq col (current-column))) (or (> 11 (setq col (current-column)))
(< rtc col))) (< rtc col)))
32) 32)
((and (<= ?a c) (>= ?z c)) (+ c (- ?A ?a))) ((and (<= ?a c) (>= ?z c)) (+ c (- ?A ?a)))
((and (<= ?A c) (>= ?Z c)) ?*) ((and (<= ?A c) (>= ?Z c)) ?*)
(t ?@))) (t ?@)))))
(forward-char -1)
(delete-char -1)))
(sit-for 3) (sit-for 3)
(setq col nil) (setq col nil)
(goto-char bot) (goto-char bot)
@ -666,8 +658,13 @@ If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).")
(setq col (cons (buffer-substring (point) c) col)) (setq col (cons (buffer-substring (point) c) col))
(end-of-line 0) (end-of-line 0)
(forward-char -10)) (forward-char -10))
(let ((life-patterns (vector (cons (make-string (length (car col)) 32) (let ((life-patterns (vector
col)))) (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))) (life (or zone-pgm-random-life-wait (random 4)))
(kill-buffer nil)))) (kill-buffer nil))))