2015-12-18 Star Wars crawl in Emacs

As I mentioned a while ago, I’m not an uncritical fan of Star Wars. The franchise, however, is obviously one of my childhood memories. Therefore, even though I try not to expect too much from Episode VII, I will certainly watch it. And since I’m (obviously) a huge (though not uncritical, either!) fan of Emacs, I could not resist this little piece of code. Try selecting some text buffer and launching the star-wars-scroll function. (At first I wanted to make a screencast out if it. But I decided not to: just paste the code into your Emacs and see it for yourself. And if you happen not to have Emacs installed, well, all I can say is that I find your lack of an Emacs binary disturbing.)

Of course, I could have used font sizes for that; but as it is, it works even in text terminals, which is cooler.

(defvar sw/substitution-list
  '(("." . 0)
    (" " . 0)
    ("[.,;:!?] " . 1)
    ("\\B[aeiou]\\B" . 0)
    ("\\B[bcdfghjklmnpqrstvwxyz]\\B" . 0)
    ("\\w\\b" . 0)
    ("[.,;:!?]" . 0)
    ("[^.,;:!?] " . 1)
    ("\\b\\w" . 0)
    (".$" . 0)
    ("^." . 0))
  "A list of dotted pairs with car equal to the regex matching
the character we want to delete and cdr equal to how many
characters we want to move the point forward before actually
deleting a character (useful in the case of space after a
punctuation).  We begin with the substitutions we want to perform
first.  If more than one regex matches, the last one is valid, so
it is probably a good idea to begin with \".\".")

(defun center-line-no-tabs ()
  "A simplified version of center-line, using no tabs (and not
taking into account leading/trailing whitespace."
    (let ((length (progn (end-of-line)
      (insert (make-string (max 0 (/ (- fill-column length) 2)) ?\s)))))

(defun sw/scroll-prepare-marker-list ()
  "Prepare (and return) a list of markers pointing at characters
to delete from the current line, in the \"right\" order."
    (let ((limit (progn
                   (center-line-no-tabs) ; this may use tabs!
          (subst-list sw/substitution-list)
          (marker-list nil))
      (while subst-list
        (while (re-search-backward (caar subst-list) limit t)
          (forward-char (cdar subst-list))
          (push (point-marker) marker-list))
        (setq subst-list (cdr subst-list)))
      (delete-dups marker-list)
      (setq marker-list (nreverse marker-list)))))

(defvar sw/untouched-lines 3
  "Number of lines at the bottom of the window which should not
  be touched by character deletion.")

(defvar sw/delay .5
  "Delay (in seconds) between frames of animation.")

(defun sw/scroll-current-buffer ()
  "Actually do SW-like scroll in the current buffer."
  (let (marker-list-list)
    (open-line (window-height))
    (goto-char (point-max))
    (move-beginning-of-line 0)
    (while (progn
             (push (sw/scroll-prepare-marker-list) marker-list-list)
             (> (point) (+ (point-min) (window-height))))
    (while (< (point-min) (point-max)) ; here the actual scroll begins
      (goto-char (point-min))
      (kill-line 1)
      (redisplay t)
      (sleep-for sw/delay)
      (let ((walker marker-list-list))
        (while (progn ;
                 (goto-char (or (caar walker) (point-min)))
                 (and walker (< (line-number-at-pos) (- (window-height) sw/untouched-lines))))
          (when (car walker)
            (goto-char (caar walker))
            (delete-char 1)
            (setf (car walker) (cdar walker)))
          (when (car walker)
            (goto-char (caar walker))
            (delete-char 1)
            (setf (car walker) (cdar walker))
            (insert " "))
          (setq walker (cdr walker)))))))

(defun star-wars-scroll ()
  "Do Star-Wars-like scroll of the region, or the whole buffer if
  no region is active, in a temporary buffer, and delete it
  afterwards.  Special care is taken to make the lines more or
  less legible as long as possible, for example spaces after
  punctuation are deleted before vowels, vowels are deleted
  before consonants etc."
    (let ((begin (point-min)) (end (point-max)))
      (when (region-active-p)
        (setq begin (region-beginning))
        (setq end (region-end)))
      (copy-region-as-kill begin end)
        (switch-to-buffer (current-buffer))
        (rename-buffer "*Star Wars Scroll*")
	(untabify (point-min) (point-max))

The code is far from perfect; in fact, you will never find a more wretched hive of impenetrable parentheses. I wrote it a couple years ago, when my Elisp knowledge was much worse than is it is now. (Also, my elegant-code-fu was far weaker than it is now – or so I hope at least. I learned a lot during last few years; after all, studying Lisp is the pathway to many abilities some consider to be… unnatural.) But I leave it as it is, as a proof that I try to suck less each year: I’d never write such obfuscated code today. Y’know what they say – this isn’t the code quality you are looking for. Also, it’s probably more buggy than you could possibly imagine. (For instance, I have a very bad feeling that it doesn’t work with too long lines, and I have no idea why. I can’t believe how shitty code I was writing three years ago…) But I had a lot of fun putting it together. (And I hope to rewrite it some day – from scratch, probably, since in its current state it’s rather beyond repair…)

Note that it has one interesting feature (which turned out to be more fun coding than watching, in fact): it tries to preserve the legibility of the text as long as possible. For instance, vowels are deleted before consonants, and letters inside words are deleted before the first and the last one, etc.

And no, I will not end this post with the famous greeting. Just have fun, and don’t take Star Wars too seriously.

CategoryEnglish, CategoryBlog, CategoryEmacs, CategoryHumor