mirror of
https://github.com/larstvei/etype.git
synced 2024-11-26 02:08:30 +00:00
132 lines
3.7 KiB
EmacsLisp
132 lines
3.7 KiB
EmacsLisp
(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))
|