/[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.17 by ttn, Thu Dec 16 17:13:22 2004 UTC revision 1.18 by ttn, Fri Dec 17 11:47:16 2004 UTC
# Line 146  If the element is a function or a list o Line 146  If the element is a function or a list o
146      (erase-buffer)      (erase-buffer)
147      (setq buffer-undo-list t      (setq buffer-undo-list t
148            truncate-lines t            truncate-lines t
149            tab-width (zone-orig tab-width))            tab-width (zone-orig tab-width)
150              line-spacing (zone-orig line-spacing))
151      (insert text)      (insert text)
152      (untabify (point-min) (point-max))      (untabify (point-min) (point-max))
153      (set-window-start (selected-window) (point-min))      (set-window-start (selected-window) (point-min))
# Line 446  If the element is a function or a list o Line 447  If the element is a function or a list o
447  (defsubst zone-cpos (pos)  (defsubst zone-cpos (pos)
448    (buffer-substring pos (1+ pos)))    (buffer-substring pos (1+ pos)))
449    
450  (defsubst zone-replace-char (direction char-as-string new-value)  (defsubst zone-replace-char (count del-count char-as-string new-value)
451    (delete-char direction)    (delete-char (or del-count (- count)))
452    (aset char-as-string 0 new-value)    (aset char-as-string 0 new-value)
453    (insert char-as-string))    (dotimes (i count) (insert char-as-string)))
454    
455  (defsubst zone-park/sit-for (pos seconds)  (defsubst zone-park/sit-for (pos seconds)
456    (let ((p (point)))    (let ((p (point)))
# Line 460  If the element is a function or a list o Line 461  If the element is a function or a list o
461  (defun zone-fret (wbeg pos)  (defun zone-fret (wbeg pos)
462    (let* ((case-fold-search nil)    (let* ((case-fold-search nil)
463           (c-string (zone-cpos pos))           (c-string (zone-cpos pos))
464             (cw-ceil (ceiling (char-width (aref c-string 0))))
465           (hmm (cond           (hmm (cond
466                 ((string-match "[a-z]" c-string) (upcase c-string))                 ((string-match "[a-z]" c-string) (upcase c-string))
467                 ((string-match "[A-Z]" c-string) (downcase c-string))                 ((string-match "[A-Z]" c-string) (downcase c-string))
468                 (t " "))))                 (t (propertize " " 'display `(space :width ,cw-ceil))))))
469      (do ((i 0 (1+ i))      (do ((i 0 (1+ i))
470           (wait 0.5 (* wait 0.8)))           (wait 0.5 (* wait 0.8)))
471          ((= i 20))          ((= i 20))
# Line 496  If the element is a function or a list o Line 498  If the element is a function or a list o
498      (recenter 0)      (recenter 0)
499      (sit-for 0)))      (sit-for 0)))
500    
501  (defun zone-fall-through-ws (c ww wbeg wend)  (defun zone-fall-through-ws (c wbeg wend)
502    (let ((fall-p nil)                    ; todo: move outward    (let* ((cw-ceil (ceiling (char-width (aref c 0))))
503          (wait 0.15))           (spaces (make-string cw-ceil 32))
504      (while (when (= 32 (char-after (+ (point) ww 1)))           (col (current-column))
505             (wait 0.15)
506             newpos fall-p)
507        (while (when (save-excursion
508                       (next-line 1)
509                       (and (= col (current-column))
510                            (setq newpos (point))
511                            (string= spaces (buffer-substring-no-properties
512                                             newpos (+ newpos cw-ceil)))
513                            (setq newpos (+ newpos (1- cw-ceil)))))
514               (setq fall-p t)               (setq fall-p t)
515               (delete-char 1)               (delete-char 1)
516               (insert " ")               (insert spaces)
517               (forward-char ww)               (goto-char newpos)
518               (when (< (point) wend)               (when (< (point) wend)
519                 (delete-char 1)                 (delete-char cw-ceil)
520                 (insert c)                 (insert c)
521                 (forward-char -1)                 (forward-char -1)
522                 (zone-park/sit-for wbeg (setq wait (* wait 0.8))))))                 (zone-park/sit-for wbeg (setq wait (* wait 0.8))))))
# Line 523  If the element is a function or a list o Line 534  If the element is a function or a list o
534            wend (window-end))            wend (window-end))
535      (catch 'done      (catch 'done
536        (while (not (input-pending-p))        (while (not (input-pending-p))
537          (setq mc 0)          (setq mc 0 wend (window-end))
538          ;; select non-ws character, but don't miss too much          ;; select non-ws character, but don't miss too much
539          (goto-char (+ wbeg (random (- wend wbeg))))          (goto-char (+ wbeg (random (- wend wbeg))))
540          (while (looking-at "[ \n\f]")          (while (looking-at "[ \n\f]")
# Line 535  If the element is a function or a list o Line 546  If the element is a function or a list o
546            (when fret-p (zone-fret wbeg p))            (when fret-p (zone-fret wbeg p))
547            (goto-char p)            (goto-char p)
548            (setq c (zone-cpos p)            (setq c (zone-cpos p)
549                  fall-p (zone-fall-through-ws c ww wbeg wend)))                  fall-p (zone-fall-through-ws c wbeg wend)))
550          ;; assuming current-column has not changed...          ;; assuming current-column has not changed...
551          (when (and pancake-p          (when (and pancake-p
552                     fall-p                     fall-p
553                     (< (count-lines (point-min) (point))                     (< (count-lines (point-min) (point))
554                        wh))                        wh))
555            (zone-replace-char 1 c ?@)            (let ((cw (ceiling (char-width (aref c 0)))))
556            (zone-park/sit-for wbeg 0.137)              (zone-replace-char cw   1 c ?@) (zone-park/sit-for wbeg 0.137)
557            (zone-replace-char -1 c ?*)              (zone-replace-char cw nil c ?*) (zone-park/sit-for wbeg 0.137)
558            (zone-park/sit-for wbeg 0.137)              (zone-replace-char cw nil c ?_)))))))
           (zone-replace-char -1 c ?_))))))  
559    
560  (defun zone-pgm-drip-fretfully ()  (defun zone-pgm-drip-fretfully ()
561    (zone-pgm-drip t))    (zone-pgm-drip t))
# Line 652  If nil, `zone-pgm-random-life' chooses a Line 662  If nil, `zone-pgm-random-life' chooses a
662          (setq s (zone-cpos (point))          (setq s (zone-cpos (point))
663                c (aref s 0))                c (aref s 0))
664          (zone-replace-char          (zone-replace-char
665           1 s (cond ((or (> top (point))           (char-width c)
666             t s (cond ((or (> top (point))
667                          (< bot (point))                          (< bot (point))
668                          (or (> 11 (setq col (current-column)))                          (or (> 11 (setq col (current-column)))
669                              (< rtc col)))                              (< rtc col)))

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18

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