comparison lisp/play/zone.el @ 59013:811c3c23099a

(zone): Init `line-spacing' from orig buffer. (zone-replace-char): Take `count' and `del-count' instead of `direction'. Update callers. When `del-count' is non-nil, delete that many characters, otherwise `count' characters backwards. Insert the newly-replaced string `count' times. (zone-fret): Handle chars w/ width greater than one. (zone-fall-through-ws): No longer take window width `ww'. Update callers. Add handling for `char-width' greater than one. (zone-pgm-drip): Update var holding window-end position every cycle.

59012:4757a09db597

    (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)
    (untabify (point-min) (point-max))
    (set-window-start (selected-window) (point-min))
    (set-window-point (selected-window) wp)
    (sit-for 0 500)

;;;; dripping

(defsubst zone-cpos (pos)
  (buffer-substring pos (1+ 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
               ((string-match "[a-z]" c-string) (upcase c-string))
               ((string-match "[A-Z]" c-string) (downcase c-string))
               (t " "))))
    (do ((i 0 (1+ i))
         (wait 0.5 (* wait 0.8)))
        ((= i 20))
      (goto-char pos)
      (delete-char 1)

	  (insert line))))
    (goto-char start)
    (recenter 0)
    (sit-for 0)))

(defun zone-fall-through-ws (c ww wbeg wend)
  (let ((fall-p nil)                    ; todo: move outward
        (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))

    (zone-fill-out-screen ww wh)
    (setq wbeg (window-start)
          wend (window-end))
    (catch 'done
      (while (not (input-pending-p))
        (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)

        ;; 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))
          (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))

(defun zone-pgm-five-oclock-swan-dive ()

                             t))))
      (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)))

59013:811c3c23099a

    (switch-to-buffer outbuf)
    (setq mode-name "Zone")
    (erase-buffer)
    (setq buffer-undo-list t
          truncate-lines t
          tab-width (zone-orig tab-width)
          line-spacing (zone-orig line-spacing))
    (insert text)
    (untabify (point-min) (point-max))
    (set-window-start (selected-window) (point-min))
    (set-window-point (selected-window) wp)
    (sit-for 0 500)

;;;; dripping

(defsubst zone-cpos (pos)
  (buffer-substring pos (1+ pos)))

(defsubst zone-replace-char (count del-count char-as-string new-value)
  (delete-char (or del-count (- count)))
  (aset char-as-string 0 new-value)
  (dotimes (i count) (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))
         (cw-ceil (ceiling (char-width (aref c-string 0))))
         (hmm (cond
               ((string-match "[a-z]" c-string) (upcase c-string))
               ((string-match "[A-Z]" c-string) (downcase c-string))
               (t (propertize " " 'display `(space :width ,cw-ceil))))))
    (do ((i 0 (1+ i))
         (wait 0.5 (* wait 0.8)))
        ((= i 20))
      (goto-char pos)
      (delete-char 1)

	  (insert line))))
    (goto-char start)
    (recenter 0)
    (sit-for 0)))

(defun zone-fall-through-ws (c wbeg wend)
  (let* ((cw-ceil (ceiling (char-width (aref c 0))))
         (spaces (make-string cw-ceil 32))
         (col (current-column))
         (wait 0.15)
         newpos fall-p)
    (while (when (save-excursion
                   (next-line 1)
                   (and (= col (current-column))
                        (setq newpos (point))
                        (string= spaces (buffer-substring-no-properties
                                         newpos (+ newpos cw-ceil)))
                        (setq newpos (+ newpos (1- cw-ceil)))))
	     (setq fall-p t)
	     (delete-char 1)
	     (insert spaces)
             (goto-char newpos)
	     (when (< (point) wend)
	       (delete-char cw-ceil)
	       (insert c)
	       (forward-char -1)
	       (zone-park/sit-for wbeg (setq wait (* wait 0.8))))))
    fall-p))

    (zone-fill-out-screen ww wh)
    (setq wbeg (window-start)
          wend (window-end))
    (catch 'done
      (while (not (input-pending-p))
        (setq mc 0 wend (window-end))
        ;; 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)

        ;; 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 wbeg wend)))
        ;; assuming current-column has not changed...
        (when (and pancake-p
                   fall-p
                   (< (count-lines (point-min) (point))
                      wh))
          (let ((cw (ceiling (char-width (aref c 0)))))
            (zone-replace-char cw   1 c ?@) (zone-park/sit-for wbeg 0.137)
            (zone-replace-char cw nil c ?*) (zone-park/sit-for wbeg 0.137)
            (zone-replace-char cw nil c ?_)))))))

(defun zone-pgm-drip-fretfully ()
  (zone-pgm-drip t))

(defun zone-pgm-five-oclock-swan-dive ()

                             t))))
      (unless (or (eolp) (eobp))
        (setq s (zone-cpos (point))
              c (aref s 0))
        (zone-replace-char
         (char-width c)
         t s (cond ((or (> top (point))
                        (< bot (point))
                        (or (> 11 (setq col (current-column)))
                            (< rtc col)))
                    32)
                   ((and (<= ?a c) (>= ?z c)) (+ c (- ?A ?a)))