1 ;;; spray.el --- a speed reading mode
3 ;; Copyright (C) 2014 zk_phi
5 ;; This program is free software; you can redistribute it and/or modify
6 ;; it under the terms of the GNU General Public License as published by
7 ;; the Free Software Foundation; either version 2 of the License, or
8 ;; (at your option) any later version.
10 ;; This program is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;; GNU General Public License for more details.
15 ;; You should have received a copy of the GNU General Public License
16 ;; along with this program; if not, write to the Free Software
17 ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
20 ;; URL: http://hins11.yu-yake.com/
21 ;; Author: Ian Kelling <ian@iankelling.org>
26 ;; Put this script into a "load-path"ed directory, and load it in your
31 ;; Then you may run spray with "M-x spray-mode". Binding some keys may
34 ;; (global-set-key (kbd "<f6>") 'spray-mode)
36 ;; For more informations, see Readme.org.
39 ;; repeated words are indistinguishable, for example
40 ;; "going, going, gone" reads like going, gone, with a slight delay.
42 ;; sentences (like this) should trigger a pause for ( and )
46 ;; 0.0.1 add spray-set-margins
47 ;; 0.0.2 margin options, speed control, better quit
53 ;; * customizable vars
55 (defvar spray-wpm 400 "words/min")
56 (defvar spray-height 400 "height of characters")
57 (defvar spray-margin-top 1 "character margin at top of buffer. Characters are as big as spray text characters.")
58 (defvar spray-margin-left 1 "character margin at left of buffer. Characters are as big as spray text characters.")
60 "Ramp up to full speed. Pause for this multiple of wpm on the first word,
61 decreasing by one for each subsequent word.")
63 (defvar spray-mode-map
64 (let ((km (make-sparse-keymap)))
65 (define-key km (kbd "SPC") 'spray-start/stop)
66 (define-key km (kbd "h") 'spray-backward-word)
67 (define-key km (kbd "l") 'spray-forward-word)
68 (define-key km (kbd "<left>") 'spray-backward-word)
69 (define-key km (kbd "<right>") 'spray-forward-word)
70 (define-key km (kbd "f") 'spray-faster)
71 (define-key km (kbd "s") 'spray-slower)
72 (define-key km (kbd "q") 'spray-quit)
73 (define-key km (kbd "<return>") 'spray-quit)
75 "keymap for spray-mode buffers")
79 (make-face 'spray-base-face)
80 (set-face-attribute 'spray-base-face nil
81 :background (face-background 'default)
82 :foreground (face-foreground 'default)
85 (make-face 'spray-accent-face)
86 (set-face-attribute 'spray-accent-face nil
88 :overline (face-foreground 'default)
89 :underline (face-foreground 'default)
94 (defvar spray--margin-string ""
95 "Currently not used.")
96 (defvar spray--base-overlay nil)
97 (defvar spray--accent-overlay nil)
98 (defvar spray--running nil)
99 (defvar spray--first-words 0)
100 (defvar spray--initial-delay 0)
101 (defvar spray--delay 0)
102 (defvar spray--saved-cursor-type nil)
103 (defvar spray--saved-buffer-face nil)
104 (defvar spray--saved-restriction nil)
105 (defvar spray--saved-smartparens-enabled nil)
107 ;; * utility functions
109 (defun spray-set-margins ()
110 "Setup spray--margin-string"
111 (setq spray--margin-string
112 (concat (make-string spray-margin-top 10) ;; 10 = ascii newline
113 (make-string spray-margin-left 32)))) ;; 32 = ascii space
118 (define-minor-mode spray-mode
121 :keymap spray-mode-map
123 (setq spray--base-overlay (make-overlay (point-min) (point-max))
124 spray--accent-overlay (make-overlay 0 0)
125 spray--saved-cursor-type cursor-type
126 spray--saved-restriction (and (buffer-narrowed-p)
127 (cons (point-min) (point-max)))
128 spray--saved-buffer-face (and (boundp 'buffer-face-mode)
130 buffer-face-mode-face)
131 spray--saved-smartparens-enabled (and (boundp 'smartparens-mode)
133 spray--saved-highlight-symbol-enabled (and (boundp 'highlight-symbol-mode)
134 highlight-symbol-mode))
135 ;; smartparens wrapping of all letter binds can cause problems.
136 ;; for example, it can cause auto-complete to activate
137 (and spray--saved-smartparens-enabled (smartparens-mode -1))
138 (and spray--saved-highlight-symbol-enabled (highlight-symbol-mode -1))
139 (setq cursor-type nil)
140 (let ((buffer-face-mode-face `(:height ,spray-height)))
141 (buffer-face-mode 1))
142 (overlay-put spray--base-overlay 'priority 100)
143 (overlay-put spray--base-overlay 'face 'spray-base-face)
144 (overlay-put spray--accent-overlay 'priority 101)
145 (overlay-put spray--accent-overlay 'face 'spray-accent-face)
148 (and spray--saved-smartparens-enabled (smartparens-mode 1))
149 (and spray--saved-highlight-symbol-enabled (highlight-symbol-mode 1))
150 (setq cursor-type spray--saved-cursor-type)
151 (if spray--saved-restriction
152 (narrow-to-region (car spray--saved-restriction)
153 (cdr spray--saved-restriction))
155 (buffer-face-mode -1)
156 (if spray--saved-buffer-face
157 (let ((buffer-face-mode-face spray--saved-buffer-face))
158 (buffer-face-mode 1)))
159 (delete-overlay spray--base-overlay)
160 (delete-overlay spray--accent-overlay)
168 (defun spray--word-at-point ()
169 (skip-chars-backward "^\s\t\n—")
171 (len (+ (skip-chars-forward "^\s\t\n—") (skip-chars-forward "—")))
173 (accent (+ beg (cl-case len
179 ;; this fairly obfuscated, using magic numbers to store state
180 ;; it would be nice to sometime patch this so it is more readable.
181 ;; for greater than 9 length, we display for twice as long
182 ;; for some punctuation, we display a blank
183 (setq spray--delay (+ (if (> len 9) 1 0)
184 (if (looking-at "\n[\s\t\n]") 3 0)
185 (cl-case (char-before)
189 (move-overlay spray--accent-overlay (1- accent) accent)
190 (move-overlay spray--base-overlay beg end)
192 (overlay-put spray--base-overlay 'before-string
193 (concat spray--margin-string
194 (make-string (- 5 (- accent beg)) ?\s)))
195 (narrow-to-region beg end)))
198 (defun spray--update ()
199 (cond ((not (zerop spray--initial-delay))
200 (setq spray--initial-delay (1- spray--initial-delay)))
201 ((not (zerop spray--delay))
202 (setq spray--delay (1- spray--delay))
203 (when (= spray--delay 2)
204 (narrow-to-region (point) (point))))
209 (when (not (zerop spray--first-words))
210 (setq spray--initial-delay spray--first-words)
211 (setq spray--first-words (1- spray--first-words)))
212 (skip-chars-forward "\s\t\n—")
213 (spray--word-at-point)))))
215 ;; * interactive commands
217 (defun spray-start/stop ()
218 "Toggle pause/unpause spray."
220 (or (spray-stop) (spray-start)))
224 Returns t if spray was unpaused."
226 (prog1 spray--running
228 (cancel-timer spray--running)
229 (setq spray--running nil))))
231 (defun spray-start ()
232 "Start / resume spray."
234 (setq spray--first-words spray-ramp)
236 (run-with-timer 0 (/ 60.0 spray-wpm) 'spray--update)))
239 (defun spray-forward-word ()
243 (skip-chars-forward "\s\t\n—")
244 (spray--word-at-point))
246 (defun spray-backward-word ()
250 (skip-chars-backward "^\s\t\n—")
251 (skip-chars-backward "\s\t\n—")
252 (spray--word-at-point))
254 (defun spray-faster ()
257 Increases the wpm (words per minute) parameter. See the variable
262 (defun spray-slower ()
265 Decreases the wpm (words per minute) parameter. See the variable
270 (defun spray-inc-wpm (delta)
271 (let ((was-running spray--running))
273 (when (< 10 (+ spray-wpm delta))
274 (setq spray-wpm (+ spray-wpm delta)))
275 (and was-running (spray-backward-word))
276 (message "spray wpm: %d" spray-wpm)
284 ;;; spray.el ends here