feat(fun): snowcrash simulator

.gitattributes

@@ -0,0 +1 @@
+*.webm filter=lfs diff=lfs merge=lfs -text

configuration.org

@@ -2630,6 +2630,19 @@ Enable =narrow-to-region=
 (put 'narrow-to-region 'disabled nil)
 #+END_SRC
 
+* For the fun of it
+
+** Snowcrash
+
+White noise for the whole family.
+
+[[file:misc/snowcrash.webm]]
+
+#+begin_src emacs-lisp
+  (use-package snowcrash
+    :demand t)
+#+end_src
+
 * Emacs daemon/server quick keys
 Like =with-editor=, set up =server.el= (see =server-visit-files=) with =C-c
 C-c= to "commit" save and close the buffer, and =C-c C-k= to revert and close

site-lisp/snowcrash.el

@@ -0,0 +1,49 @@
+(defvar snowcrash--refresh-rate "1 sec")
+
+(defvar snowcrash--symbols '(?█ ? ))
+;; (defvar snowcrash--symbols '(?. ? ))
+
+(defvar snowcrash--buffer-name "*snowcrash*")
+
+(defvar snowcrash--timer nil)
+
+(defun snowcrash--draw ()
+  "Draw snowcrash in the current buffer."
+  (with-current-buffer (get-buffer snowcrash--buffer-name)
+    (read-only-mode -1)
+    (erase-buffer)
+    (dotimes (lines (1- (window-total-height nil 'floor)))
+      (dotimes (columns (1- (window-total-width nil 'floor)))
+        (insert-char (nth (random (length snowcrash--symbols))
+                          snowcrash--symbols)))
+      (unless (= lines (- (window-total-height nil t) 2))
+        (newline)))
+    (goto-char (point-min))
+    (read-only-mode 1)))
+
+(defun snowcrash--tick ()
+  (snowcrash--draw)
+  (setq snowcrash--timer
+        (run-with-timer snowcrash--refresh-rate t #'snowcrash--tick)))
+
+(defun snowcrash ()
+  (interactive)
+  (switch-to-buffer (get-buffer-create snowcrash--buffer-name))
+  (snowcrash-mode))
+
+(defun snowcrash--quit-window-hook ()
+  (when (and (eq major-mode 'snowcrash-mode)
+             snowcrash--timer)
+    (cancel-timer snowcrash--timer)
+    (setq snowcrash--timer nil)))
+
+(define-derived-mode
+  snowcrash-mode
+  special-mode
+  "Snowcrash"
+  "Draw snowcrash noise.  Fun for the entire family!"
+  (add-hook 'quit-window-hook #'snowcrash--quit-window-hook)
+  (message "Type q to quit.")
+  (snowcrash--tick))
+
+(provide 'snowcrash)