iankelling.org Git - spray/blob - spray.el

   1 ;; custom
   2 (defvar spray-wpm 400 "words/min")
   3 (defvar spray-height 400 "height of characters")
   4
   5 (make-face 'spray-base-face)
   6 (set-face-attribute 'spray-base-face nil
   7                     :background (face-background 'default)
   8                     :foreground (face-foreground 'default))
   9
  10 (make-face 'spray-orp-face)
  11 (set-face-attribute 'spray-orp-face nil
  12                     :foreground "red"
  13                     :overline (face-foreground 'default)
  14                     :underline (face-foreground 'default))
  15
  16 ;; internal variables
  17 (defvar spray--base-overlay nil)
  18 (defvar spray--orp-overlay nil)
  19 (defvar spray--timer nil)
  20 (defvar spray--delay 0)
  21 (defvar spray--saved-cursor-type nil)
  22
  23 (define-minor-mode spray-mode
  24   "spray mode"
  25   :init nil
  26   :global nil
  27   (cond (spray-mode
  28          (let ((buffer-face-mode-face `(:height ,spray-height)))
  29            (buffer-face-mode 1))
  30          (setq spray--base-overlay (make-overlay (point-min) (point-max))
  31                spray--orp-overlay (make-overlay 0 0)
  32                spray--timer (run-with-timer 0 (/ 60.0 spray-wpm) 'spray-next)
  33                spray--saved-cursor-type cursor-type)
  34          (setq cursor-type nil)
  35          (overlay-put spray--base-overlay 'priority 100)
  36          (overlay-put spray--base-overlay 'face 'spray-base-face)
  37          (overlay-put spray--orp-overlay 'priority 101)
  38          (overlay-put spray--orp-overlay 'face 'spray-orp-face)
  39          (add-hook 'pre-command-hook 'turn-off-spray-mode))
  40         (t
  41          (buffer-face-mode -1)
  42          (widen)
  43          (setq cursor-type spray--saved-cursor-type)
  44          (delete-overlay spray--base-overlay)
  45          (delete-overlay spray--orp-overlay)
  46          (cancel-timer spray--timer)
  47          (remove-hook 'pre-command-hook 'turn-off-spray-mode))))
  48
  49 (defun turn-on-spray-mode () (interactive) (spray-mode 1))
  50 (defun turn-off-spray-mode () (interactive) (spray-mode -1))
  51
  52 (defun spray-next ()
  53   (cond ((not (zerop spray--delay))
  54          (setq spray--delay (1- spray--delay))
  55          (when (= spray--delay 2)
  56            (narrow-to-region (point) (point))))
  57         (t
  58          (widen)
  59          (if (eobp)
  60              (turn-off-spray-mode)
  61            (skip-chars-forward "\s\t\n")
  62            (let* ((beg (point))
  63                   (len (skip-chars-forward "^\s\t\n"))
  64                   (end (point))
  65                   (orp (+ beg (cl-case len
  66                                 ((1) 1)
  67                                 ((2 3 4 5) 2)
  68                                 ((6 7 8 9) 3)
  69                                 ((10 11 12 13) 4)
  70                                 (t 5)))))
  71              (setq spray--delay (+ (if (> len 9) 1 0)
  72                                    (if (eql (char-after) ?\n) 3 0)
  73                                    (cl-case (char-before)
  74                                      ((?. ?! ?\? ?\;) 3)
  75                                      ((?, ?:) 1)
  76                                      (t 0))))
  77              (move-overlay spray--orp-overlay (1- orp) orp)
  78              (move-overlay spray--base-overlay beg end)
  79              (overlay-put spray--base-overlay
  80                           'before-string (make-string (- 5 (- orp beg)) ?\s))
  81              (narrow-to-region beg end))))))
  82
  83 (provide 'spray)