larstvei/etype
1
0
Fork 0
mirror of https://github.com/larstvei/etype.git synced 2024-11-26 02:08:30 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Makes sure all initial letters are unique.

Browse Source
This commit is contained in:
larstvei 2013-11-26 02:05:33 +01:00
parent 73e8feb652
commit 3b1206f3c9
1 changed files with 82 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

128
etype.el
View File

@ -1,16 +1,18 @@
(require 'cl)
(defvar etype-words-in-play nil)
(defvar etype-unused-words nil)
(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)
(defvar etype-overlay nil)
(defvar etype-completing-word nil)
(defconst etype-lines-file "etype.lines")
@ -27,19 +29,20 @@
(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))))))
(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)) ? )))
(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))))
(search-backward space (point-at-bol) nil)
(search-forward space (point-at-eol) nil))))
(defun etype-search-timers (point)
(first
@ -50,34 +53,53 @@
(= 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))))))))
(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-playing-p)
(let* ((word (pop etype-words))
(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
(when (and point (etype-word-ok-p word))
(delete-char (length word))
(insert word)
(push (run-at-time "5 sec" (+ 1 (random 4))
'etype-move-word point) etype-timers))))))
(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 "5 sec" 3 'etype-drop) etype-timers)
@ -86,24 +108,35 @@
(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))))
(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 visible-cursor)
(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 ? )))
(delq 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)))
@ -123,8 +156,11 @@
(define-derived-mode etype-mode nil "Etype"
"A mode for playing Etype."
(make-local-variable 'etype-words)
(make-local-variable 'etype-score)
(make-local-variable 'etype-words-in-play)
(make-local-variable 'etype-unused-words)
(make-local-variable 'etype-timers)
(make-local-variable 'etype-overlay)
(make-local-variable 'etype-in-game)
(make-local-variable 'etype-completing-word)
(define-key (current-local-map) [remap self-insert-command] 'etype-catch-input)