etype/etype.el

(require 'cl)

(defvar etype-words-in-play nil)

(defvar etype-unused-words nil)

(defvar etype-score 0)

(defvar etype-in-game nil)

(defvar etype-timers nil)

(defvar etype-overlay nil)

(defvar etype-completing-word 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))
    (insert (make-string fill-column ?-))
    (insert "\nScore: 0"))
  (goto-char (point-min))
  (setq etype-score 0)
  (setq etype-in-game t)
  ;; Shuffle the vector of etype-unused-words and turn it in to a list.

  (setq etype-unused-words (mapcar 'eval (shuffle-vector (etype-read-file)))))

(defun etype-fit-word (word)
  (let* ((space (make-string (+ 1 (length word)) ? )))
    (cond ((looking-at space) (point))
          ((search-backward space (point-at-bol) nil) (point))
          ((search-forward space (point-at-eol) nil) (- (point) (length space))))))

(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)
  (save-excursion
    (when etype-in-game
      (let ((check-word (thing-at-point 'word)))
        (goto-char point)
        (unless (equal check-word (thing-at-point 'word))
          (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-random ()
  (let ((random (abs (random))))
    (/ random (expt 10.0 (floor (log random 10))))))

(defun etype-get-word (&optional count)
  (let ((word (pop etype-unused-words)))
    (if (null (member
               (string-to-char word)
               (mapcar 'string-to-char etype-words-in-play)))
        word
      (add-to-list 'etype-unused-words word t)
      (unless (and count (> count 5))
        (etype-get-word (if count (+ count 1) 1))))))

(defun etype-spawn-word ()
  (save-excursion
    (when etype-in-game
      (let* ((word (etype-get-word))
             (point (random (- fill-column (length word)))))
        (goto-char point)
        (setq point (etype-fit-word word))
        (when point
          (delete-char (length word))
          (insert word)
          (push word etype-words-in-play)
          (push (run-at-time
                 (concat (number-to-string (floor (etype-random))) " sec")
                 (etype-random) 'etype-move-word point) etype-timers)
          (message "Spawned word %s moves every %f second" word random))))))

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

(defun etype-search-word (key-etyped)
  (setq etype-completing-word
        (search-forward-regexp
         (concat
          "\\<" (single-key-description last-input-event)) nil t))
  (when etype-completing-word
    (setq etype-overlay
          (make-overlay (- etype-completing-word 1) etype-completing-word))
    (overlay-put etype-overlay 'face '(:inherit isearch))))

(defun etype-continue-word (key-etyped)
  (when (looking-at key-etyped) (forward-char))
  (move-overlay etype-overlay (overlay-start etype-overlay) (point))
  (when (looking-at " ")
    (etype-clear-word)
    (setq etype-completing-word nil)))

(defun etype-clear-word ()
  (delete-overlay etype-overlay)
  (let* ((word (thing-at-point 'word))
         (len (length word))
         (space (make-string len ? )))
    (setq etype-words-in-play
          (remove word etype-words-in-play))
    (add-to-list 'etype-unused-words word t)
    (backward-word)
    (delete-char len)
    (insert space)
    (incf etype-score (* len 1.5)))
  (search-forward "Score: ")
  (delete-char (- (point-max) (point)))
  (insert (number-to-string etype-score))
  (goto-char (point-min)))

(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-score)
  (make-local-variable 'etype-timers)
  (make-local-variable 'etype-overlay)
  (make-local-variable 'etype-in-game)
  (make-local-variable 'etype-unused-words)
  (make-local-variable 'etype-words-in-play)
  (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))