/[emacs]/emacs/lisp/play/zone.el
ViewVC logotype

Diff of /emacs/lisp/play/zone.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.12 by uid65629, Sun Feb 8 22:32:18 2004 UTC revision 1.13 by ttn, Sat Dec 11 14:49:45 2004 UTC
# Line 75  If nil, don't interrupt for about 1^26 s Line 75  If nil, don't interrupt for about 1^26 s
75                         zone-pgm-paragraph-spaz                         zone-pgm-paragraph-spaz
76                         zone-pgm-stress                         zone-pgm-stress
77                         zone-pgm-stress-destress                         zone-pgm-stress-destress
78                           zone-pgm-random-life
79                         ])                         ])
80    
81  (defmacro zone-orig (&rest body)  (defmacro zone-orig (&rest body)
# Line 459  If the element is a function or a list o Line 460  If the element is a function or a list o
460        (sit-for wait))        (sit-for wait))
461      (delete-char -1) (insert c-string)))      (delete-char -1) (insert c-string)))
462    
463    (defun zone-fill-out-screen (width height)
464      (save-excursion
465        (goto-char (point-min))
466        ;; fill out rectangular ws block
467        (while (not (eobp))
468          (end-of-line)
469          (let ((cc (current-column)))
470            (if (< cc width)
471                (insert (make-string (- width cc) 32))
472              (delete-char (- width cc))))
473          (unless (eobp)
474            (forward-char 1)))
475        ;; pad ws past bottom of screen
476        (let ((nl (- height (count-lines (point-min) (point)))))
477          (when (> nl 0)
478            (let ((line (concat (make-string (1- width) ? ) "\n")))
479              (do ((i 0 (1+ i)))
480                  ((= i nl))
481                (insert line)))))))
482    
483  (defun zone-fall-through-ws (c col wend)  (defun zone-fall-through-ws (c col wend)
484    (let ((fall-p nil)                    ; todo: move outward    (let ((fall-p nil)                    ; todo: move outward
485          (wait 0.15)          (wait 0.15)
# Line 486  If the element is a function or a list o Line 507  If the element is a function or a list o
507           (mc 0)                         ; miss count           (mc 0)                         ; miss count
508           (total (* ww wh))           (total (* ww wh))
509           (fall-p nil))           (fall-p nil))
510      (goto-char (point-min))      (zone-fill-out-screen ww wh)
     ;; 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)))))  
511      (catch 'done      (catch 'done
512        (while (not (input-pending-p))        (while (not (input-pending-p))
         (goto-char (point-min))  
         (sit-for 0)  
513          (let ((wbeg (window-start))          (let ((wbeg (window-start))
514                (wend (window-end)))                (wend (window-end)))
515            (setq mc 0)            (setq mc 0)
# Line 552  If the element is a function or a list o Line 555  If the element is a function or a list o
555  ;;;; zone-pgm-paragraph-spaz  ;;;; zone-pgm-paragraph-spaz
556    
557  (defun zone-pgm-paragraph-spaz ()  (defun zone-pgm-paragraph-spaz ()
558    (if (memq (zone-orig major-mode) '(text-mode fundamental-mode))    (if (memq (zone-orig major-mode)
559                ;; there should be a better way to distinguish textish modes
560                '(text-mode texinfo-mode fundamental-mode))
561        (let ((fill-column fill-column)        (let ((fill-column fill-column)
562              (fc-min fill-column)              (fc-min fill-column)
563              (fc-max fill-column)              (fc-max fill-column)
# Line 570  If the element is a function or a list o Line 575  If the element is a function or a list o
575      (zone-pgm-rotate)))      (zone-pgm-rotate)))
576    
577    
578  ;;;; zone-pgm-stress  ;;;; stressing and destressing
579    
580  (defun zone-pgm-stress ()  (defun zone-pgm-stress ()
581    (goto-char (point-min))    (goto-char (point-min))
# Line 596  If the element is a function or a list o Line 601  If the element is a function or a list o
601         (message (concat (make-string (random (- (frame-width) 5)) ? ) "grrr"))         (message (concat (make-string (random (- (frame-width) 5)) ? ) "grrr"))
602         (sit-for 0.1)))))         (sit-for 0.1)))))
603    
   
 ;;;; zone-pgm-stress-destress  
   
604  (defun zone-pgm-stress-destress ()  (defun zone-pgm-stress-destress ()
605    (zone-call 'zone-pgm-stress 25)    (zone-call 'zone-pgm-stress 25)
606    (zone-hiding-modeline    (zone-hiding-modeline
# Line 617  If the element is a function or a list o Line 619  If the element is a function or a list o
619                  zone-pgm-drip))))                  zone-pgm-drip))))
620    
621    
622    ;;;; the lyfe so short the craft so long to lerne --chaucer
623    
624    (defvar zone-pgm-random-life-wait nil
625      "*Seconds to wait between successive `life' generations.
626    If nil, `zone-pgm-random-life' chooses a value from 0-3 (inclusive).")
627    
628    (defun zone-pgm-random-life ()
629      (require 'life)
630      (zone-fill-out-screen (1- (window-width)) (1- (window-height)))
631      (let ((top (progn (goto-char (window-start)) (forward-line 7) (point)))
632            (bot (progn (goto-char (window-end)) (forward-line -7) (point)))
633            (rtc (- (frame-width) 11))
634            (min (window-start))
635            (max (1- (window-end)))
636            c col)
637        (delete-region max (point-max))
638        (while (progn (goto-char (+ min (random max)))
639                      (and (sit-for 0.005)
640                           (or (progn (skip-chars-forward " @\n" max)
641                                      (not (= max (point))))
642                               (unless (or (= 0 (skip-chars-backward " @\n" min))
643                                           (= min (point)))
644                                 (forward-char -1)
645                                 t))))
646          (setq c (char-after))
647          (unless (or (not c) (= ?\n c))
648            (forward-char 1)
649            (insert-and-inherit             ; keep colors
650             (cond ((or (> top (point))
651                        (< bot (point))
652                        (or (> 11 (setq col (current-column)))
653                            (< rtc col)))
654                    32)
655                   ((and (<= ?a c) (>= ?z c)) (+ c (- ?A ?a)))
656                   ((and (<= ?A c) (>= ?Z c)) ?*)
657                   (t ?@)))
658            (forward-char -1)
659            (delete-char -1)))
660        (sit-for 3)
661        (setq col nil)
662        (goto-char bot)
663        (while (< top (point))
664          (setq c (point))
665          (move-to-column 9)
666          (setq col (cons (buffer-substring (point) c) col))
667          (end-of-line 0)
668          (forward-char -10))
669        (let ((life-patterns (vector (cons (make-string (length (car col)) 32)
670                                           col))))
671          (life (or zone-pgm-random-life-wait (random 4)))
672          (kill-buffer nil))))
673    
674    
675  ;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;
676  (provide 'zone)  (provide 'zone)
677    

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26