etype/etype.el

(require 'cl)

(defvar etype-score 0)

(defvar etype-in-game nil)

(defvar etype-completing-word nil)

(defvar etype-words nil)

(defvar etype-timers nil)

(defvar etype-banned-initials nil)

(defconst etype-lines-file "etype.lines")

(defun etype-read-file ()
  (with-temp-buffer
    (insert-file-contents (expand-file-name etype-lines-file default-directory))
    (apply
     'vector
     (split-string
      (buffer-substring-no-properties (point-min) (point-max)) "\n"))))

(defun init-game ()
  (let ((space (make-string fill-column ? )))
    (dotimes (i 30)
      (insert space)
      (newline))
    (goto-char (point-min))
    (setq etype-in-game t)
    ;; Shuffle the vector of etype-words and turn it in to a list.
    (setq etype-words (mapcar 'eval (shuffle-vector (etype-read-file))))))

(defun etype-fit-word (word)
  (let ((space (make-string (+ 1 (length word)) ? )))
    (or (and (looking-at space) (point))
        (search-backward space nil nil)
        (search-forward space nil nil))))

(defun etype-playing-p ()
  (string= "Etype" (buffer-name (current-buffer))))

(defun etype-search-timers (point)
  (first
   (remove-if-not
    (lambda (timer)
      (let ((arg (timer--args timer)))
        (and (numberp (first arg))
             (= point (first arg))))) etype-timers)))

(defun etype-move-word (point)
  (message "score: %f" etype-score)
  (save-excursion
    (when (etype-playing-p)
      (goto-char point)
      (let* ((word (thing-at-point 'word))
             (len (length word))
             (timer (etype-search-timers point)))
        (delete-char len)
        (insert (make-string len ? ))
        (forward-char (- (+ 1 fill-column) len))
        (let ((point (etype-fit-word word)))
          (goto-char point)
          (delete-char len)
          (insert word)
          (setf (timer--args timer) (list (- (point) len))))))))

(defun etype-spawn-word ()
  (save-excursion
    (when (etype-playing-p)
      (let* ((word (pop etype-words))
             (point (random (- fill-column (length word)))))
        (goto-char point)
        (setq point (etype-fit-word word))
        (when point
          (delete-char (length word))
          (insert word)
          (push (run-at-time "5 sec" (+ 1 (random 4))
                             'etype-move-word point) etype-timers))))))

(defun etype-loop ()
  ;; (push (run-at-time "5 sec" 3 'etype-drop) etype-timers)
  (push (run-at-time "0 sec" 2 'etype-spawn-word) etype-timers))

(defun etype-search-word (key-etyped)
  (setq etype-completing-word
        (search-forward
         (concat " " (single-key-description last-input-event)) nil t)))

(defun etype-clear-word ()
  (let* ((len (length (thing-at-point 'word)))
         (space (make-string len ? )))
    (backward-word)
    (delete-char len)
    (insert space)
    (goto-char (point-min))
    (incf etype-score (* len 1.5))))

(defun etype-continue-word (key-etyped)
  (when (looking-at key-etyped) (forward-char))
  (when (looking-at " ")
    (etype-clear-word)
    (setq visible-cursor)
    (setq etype-completing-word nil)))

(defun etype-catch-input ()
  (interactive)
  (let ((key-etyped (single-key-description last-input-event)))
    (if etype-completing-word
        (etype-continue-word key-etyped)
      (etype-search-word key-etyped))))

(defun etype ()
  (interactive)
  (switch-to-buffer "Etype")
  (etype-mode)
  (init-game)
  (etype-loop))

(defun etype-cleanup ()
  (mapc 'cancel-timer etype-timers))

(define-derived-mode etype-mode nil "Etype"
  "A mode for playing Etype."
  (make-local-variable 'etype-words)
  (make-local-variable 'etype-timers)
  (make-local-variable 'etype-in-game)
  (make-local-variable 'etype-completing-word)
  (define-key (current-local-map) [remap self-insert-command] 'etype-catch-input)
  (add-hook 'kill-buffer-hook 'etype-cleanup))