mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-31 20:02:42 +00:00
Code Issues Releases Activity

(zone-programs): Add `zone-pgm-random-life'.

Browse Source 
(zone-fill-out-screen): New func.
(zone-pgm-drip): Use `zone-fill-out-screen'.
Also, no longer go to point-min on every cycle.
(zone-pgm-paragraph-spaz): Allow spazzing for texinfo-mode.
(zone-pgm-random-life-wait): New user var.
(zone-pgm-random-life): New func.
This commit is contained in:
Thien-Thi Nguyen 2004-12-11 14:51:32 +00:00
parent 982f55b0a9
commit 0ccb50fc8a
2 changed files with 89 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lisp/ChangeLog
View File

@ -1,3 +1,13 @@
2004-12-11 Thien-Thi Nguyen <ttn@gnu.org>
* play/zone.el (zone-programs): Add `zone-pgm-random-life'.
(zone-fill-out-screen): New func.
(zone-pgm-drip): Use `zone-fill-out-screen'.
Also, no longer go to point-min on every cycle.
(zone-pgm-paragraph-spaz): Allow spazzing for texinfo-mode.
(zone-pgm-random-life-wait): New user var.
(zone-pgm-random-life): New func.
2004-12-10 Thien-Thi Nguyen <ttn@gnu.org>
* files.el (auto-mode-alist): Map .com to DCL mode.

103
lisp/play/zone.el
View File

@ -75,6 +75,7 @@ If nil, don't interrupt for about 1^26 seconds.")
zone-pgm-paragraph-spaz
zone-pgm-stress
zone-pgm-stress-destress
zone-pgm-random-life
])
(defmacro zone-orig (&rest body)
@ -459,6 +460,26 @@ If the element is a function or a list of a function and a number,
(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)
@ -486,27 +507,9 @@ If the element is a function or a list of a function and a number,
(mc 0) ; miss count
(total (* ww wh))
(fall-p nil))
(goto-char (point-min))
;; fill out rectangular ws block
(while (not (eobp))
(end-of-line)
(let ((cc (current-column)))
(if (< cc ww)
(insert (make-string (- ww cc) ? ))
(delete-char (- ww cc))))
(unless (eobp)
(forward-char 1)))
;; pad ws past bottom of screen
(let ((nl (- wh (count-lines (point-min) (point)))))
(when (> nl 0)
(let ((line (concat (make-string (1- ww) ? ) "\n")))
(do ((i 0 (1+ i)))
((= i nl))
(insert line)))))
(zone-fill-out-screen ww wh)
(catch 'done
(while (not (input-pending-p))
(goto-char (point-min))
(sit-for 0)
(let ((wbeg (window-start))
(wend (window-end)))
(setq mc 0)
@ -552,7 +555,9 @@ If the element is a function or a list of a function and a number,
;;;; zone-pgm-paragraph-spaz
(defun zone-pgm-paragraph-spaz ()
(if (memq (zone-orig major-mode) '(text-mode fundamental-mode))
(if (memq (zone-orig major-mode)
;; there should be a better way to distinguish textish modes
'(text-mode texinfo-mode fundamental-mode))
(let ((fill-column fill-column)
(fc-min fill-column)
(fc-max fill-column)
@ -570,7 +575,7 @@ If the element is a function or a list of a function and a number,
(zone-pgm-rotate)))
;;;; zone-pgm-stress
;;;; stressing and destressing
(defun zone-pgm-stress ()
(goto-char (point-min))
@ -596,9 +601,6 @@ If the element is a function or a list of a function and a number,
(message (concat (make-string (random (- (frame-width) 5)) ? ) "grrr"))
(sit-for 0.1)))))
;;;; zone-pgm-stress-destress
(defun zone-pgm-stress-destress ()
(zone-call 'zone-pgm-stress 25)
(zone-hiding-modeline
@ -617,6 +619,59 @@ If the element is a function or a list of a function and a number,
zone-pgm-drip))))
;;;; the lyfe so short the craft so long to lerne --chaucer
(defvar zone-pgm-random-life-wait nil
"*Seconds to wait between successive `life' generations.
If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).")
(defun zone-pgm-random-life ()
(require 'life)
(zone-fill-out-screen (1- (window-width)) (1- (window-height)))
(let ((top (progn (goto-char (window-start)) (forward-line 7) (point)))
(bot (progn (goto-char (window-end)) (forward-line -7) (point)))
(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)
(while (< top (point))
(setq c (point))
(move-to-column 9)
(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))))
;;;;;;;;;;;;;;;
(provide 'zone)