1 ;;; wpuzzle.el --- find as many word in a given time -*- coding: utf-8; lexical-binding: t -*-
3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
5 ;; Author: Ivan Kanis <ivan@kanis.fr>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; Find as many word as possible in a 100 seconds. Words are scored by
26 ;; length and the scrablle letter value.
28 ;; M-x 100secwp to start the game
30 ;; You need to have aspell installed, it will check for valid words.
34 ;; Inspiration from an Android game written by SpiceLabs http://spicelabs.in
36 ;; I dedicate this code to my grandmother who taught me to play Scrabble
44 ;; install aspell english dictionary. On Ubuntu or Debian type the following:
46 ;; sudo apt-get install aspell aspell-en
50 ;; - add other languages such as french
51 ;; - input letter one by one like the original game
52 ;; - really stop after 100 seconds
53 ;; - display something more fancy with letter points (SVG would be cool!)
55 ;; - display best possible score on a given deck at the end of the game
56 ;; - use gamegrid.el for dealing with high score
57 ;; - use defcustom for variables
59 ;; - use global state less (functional style programming)
60 ;; - clock ticks with timer
61 ;; - use face to display picked letter
62 ;; (insert (propertize "foo" 'face 'highlight))
63 ;; - kill score buffer when quiting
64 ;; - use a list instead of a string for the deck letters
65 ;; - add command to shuffle the deck
66 ;; - navigate to source code in other window to pretend working while playing
68 ;; search for TODO within the file
76 ;; bump version number to see if it gets published
82 (defvar 100secwp-time-limit 100
83 "Number of seconds the game will last.")
85 (defvar 100secwp-high-score-buffer "100secwp-score"
86 "File for holding high scores.")
88 (defvar 100secwp-high-score-directory
89 (locate-user-emacs-file "games/")
90 "A directory for storing game high score.")
92 (defvar 100secwp-high-score-file
93 (expand-file-name 100secwp-high-score-buffer 100secwp-high-score-directory)
94 "Full path to file used for storing game high score.")
96 (defvar 100secwp-buffer "*100secwp*"
99 (defvar 100secwp-state
104 "Global game state.")
106 (defconst 100secwp-frequency
118 (?d . 70) ; crank up for verb ending in ed (normally 33)
122 (?g . 70) ; same for ing (normally 33)
129 (?x . 10) ; (normally 2) remaining letters are cranked up to
130 (?z . 10) ; add a bit of spice to the game :)
131 (?j . 10) ; (normally 1)
133 "English letter frequency.")
135 (defconst 100secwp-scrabble
136 '((?a . 1) (?b . 3) (?c . 3) (?d . 2) (?e . 1) (?f . 4) (?g . 2) (?h . 4)
137 (?i . 1) (?j . 8) (?k . 5) (?l . 1) (?m . 3) (?n . 1) (?o . 1) (?p . 3)
138 (?q . 10) (?r . 1) (?s . 1) (?t . 1) (?u . 1) (?v . 4) (?w . 4) (?x . 8)
140 "Scrabble letter values.")
142 (defmacro 100secwp-state (key)
143 "Return KEY stored variable state."
144 `(cdr (assoc ',key 100secwp-state)))
146 (defmacro 100secwp-add (place number)
147 "Append number PLACE with CHAR."
148 `(setf ,place (+ ,place ,number)))
150 (defmacro 100secwp-append (place element)
151 "Append to list PLACE with ELEMENT."
152 `(setf ,place (append ,place (list ,element))))
154 (defun 100secwp-coerce (x type)
155 "Coerce OBJECT to type TYPE.
156 TYPE is a Common Lisp type specifier.
158 (cond ((eq type 'list) (if (listp x) x (append x nil)))
159 ((eq type 'string) (if (stringp x) x (concat x)))
160 (t (error "Can't coerce %s to type %s" x type))))
162 (defun 100secwp-pick-letter ()
163 "Pick a random letter."
167 (list 100secwp-frequency))
169 (setq ret (+ ret (cdr (car list)))
170 list (cdr list))) ret))
173 (list 100secwp-frequency))
176 (setq ret (car (car list))))
177 (setq start (+ start (cdr (car list)))
178 list (cdr list))) ret)))
180 (defun 100secwp-generate-first-deck ()
181 "Generate first deck of letters."
182 (let ((word (100secwp-generate-first-deck-1)))
183 (while (100secwp-insane-deck word)
184 (setq word (100secwp-generate-first-deck-1))) word))
186 (defun 100secwp-generate-first-deck-1 ()
187 "Generate a ten letter deck."
191 (setq word (concat (100secwp-pick-letter) word)
192 index (1+ index))) word))
194 (defun 100secwp-generate-next-deck (deck input)
195 "Remove INPUT in DECK and pick a new letter.
196 Return new string, nil if INPUT is not in DECK."
197 (let ((match (string-match input deck)))
201 (aset deck match (aref (100secwp-pick-letter) 0))
202 (when (not (100secwp-insane-deck deck))
203 (throw 'done t)))) deck))))
205 (defun 100secwp-set-difference (list1 list2)
206 "Combine LIST1 and LIST2 using a set-difference operation.
207 The resulting list contains all items that appear in LIST1 but not LIST2."
208 (if (or (null list1) (null list2)) list1
211 (when (not (member (car list1) list2))
212 (setq res (cons (car list1) res)))
213 (setq list1 (cdr list1))) res)))
215 (defun 100secwp-insane-deck (word)
216 "Return nil if deck is nice to play with."
217 (let ((vowel-count 0)
219 (vowel '(?a ?e ?i ?o ?y))
220 (three-identical-letter nil)
222 (let ((character ?a) list)
223 (while (<= character ?z)
224 (setq list (append list (list (cons character 0)))
225 character (1+ character))) list)))
226 ;; vowel-count vowels and consonant
227 (while (< index (length word))
228 (when (member (aref word index) vowel)
229 (setq vowel-count (1+ vowel-count)))
230 (setq index (1+ index)))
231 (setq vowel-count (or vowel-count 0))
234 (while (< index (length word))
235 (when (>= (100secwp-add
236 (cdr (assoc (aref word index) letter-count-alist)) 1)
238 (setq three-identical-letter t))
239 (setq index (1+ index)))
240 (or (< vowel-count 4) (< (- (length word) vowel-count) 3)
241 three-identical-letter)))
243 (defun 100secwp-sum-word (word)
244 "Return sum of WORD with Scrabble letter value and length."
245 (let ((length (length word))
248 (while (< index length)
249 (setq sum (+ sum (cdr (assoc (aref word index) 100secwp-scrabble))))
250 (setq index (1+ index)))
254 (setq sum (+ sum 100)))
258 '((3 . 5) (4 . 10) (5 . 20) (6 . 40)
259 (7 . 50) (8 . 75) (9 . 85))))))))
263 (defun 100secwp-begin-game ()
264 "Reset game state. Display deck."
265 (setf (100secwp-state start-time) (float-time))
266 (setf (100secwp-state score) 0)
267 (setf (100secwp-state deck-letter)
268 (let ((word (100secwp-generate-first-deck-1)))
269 (while (100secwp-insane-deck word)
270 (setq word (100secwp-generate-first-deck-1))) word))
271 (100secwp-generate-first-deck)
272 (setf (100secwp-state correct-word) nil)
273 (100secwp-display-deck nil nil 100secwp-time-limit))
275 (defun 100secwp-display-deck (invalid-word invalid-input time-left)
277 (when (<= time-left 0)
279 (insert (format (concat "%d second"
280 (if (> time-left 1) "s")
281 " left Score %d High score %d\n")
283 (100secwp-state score)
284 (100secwp-retrieve-high-score)))
285 (let ((deck (100secwp-state deck-letter)))
287 (100secwp-display-deck-1 (upcase (substring deck 0 3)))
288 (100secwp-display-deck-1 (upcase (substring deck 3 7)))
290 (100secwp-display-deck-1 (upcase (substring deck 7 10))))
291 (when (stringp invalid-word)
292 (insert (format "\nThe word %s does not exist.\n" invalid-word)))
295 (insert (format "\nThe following letters are not in the deck: %s\n"
296 (100secwp-coerce invalid-input 'string))))
300 (insert "\nThe game is over. Press enter to play one more time.\n\n"))
301 (insert "\nEnter word: ")))
303 (defun 100secwp-display-deck-1 (letter)
305 (while (< index (length letter))
306 (insert (substring letter index (+ 1 index)) " ")
307 (setq index (1+ index)))
310 (defun 100secwp-word-exist (word)
311 "Return t when WORD exists in dictionary."
316 "100secwp" (current-buffer)
317 "aspell" "-a" "-B" "--encoding=utf-8")))
318 (process-send-string nil
319 (concat"%n\n^" word "\n"))
320 (while (accept-process-output process 0.1))
321 (goto-char (point-min))
322 (re-search-forward "^\*$" nil t))))
325 (defun 100secwp-substitute-letter (input)
326 "Pick new letter that are proposed from INPUT."
328 (length (length input))
330 (while (< index length)
331 (setq letter (substring input index (+ 1 index)))
332 (setq exist (100secwp-generate-next-deck
333 (100secwp-state deck-letter) letter))
335 (setf (100secwp-state deck-letter) exist))
336 (setq index (1+ index)))))
339 (defun 100secwp-check-input (input)
340 "Return list of character from INPUT that are not in the deck."
341 (100secwp-set-difference
342 (100secwp-coerce input 'list)
343 (100secwp-coerce (100secwp-state deck-letter) 'list)))
345 (defun 100secwp-retrieve-high-score ()
346 (when (not (file-exists-p 100secwp-high-score-directory))
347 (make-directory 100secwp-high-score-directory))
348 (with-current-buffer (find-file-noselect 100secwp-high-score-file)
349 (goto-char (point-min))
352 (string-to-number (word-at-point))
359 (defun 100secwp-end-game ()
361 (score (100secwp-state score)))
362 (when (not (= (100secwp-state score) 0))
364 (dolist (word (100secwp-state correct-word))
365 (when (> (length word) max-length)
366 (setq max-length (length word))))
367 (dolist (word (100secwp-state correct-word))
368 (insert (format (concat "%-" (int-to-string max-length) "s %d\n")
369 word (100secwp-sum-word word))))
370 (insert (make-string (+ 4 max-length) ?-) "\n")
371 (insert "sum " (make-string (- max-length 3) ? )
372 (int-to-string score) "\n")
373 (when (> (100secwp-state score) (100secwp-retrieve-high-score))
374 (insert "\nCongratulation, you beat the high score!\n")
375 ;; TODO there is duplication with 100secwp-retrieve-high-score
376 ;; maybe it could be refactored in one function setter and getter.
378 (find-file-noselect 100secwp-high-score-file)
380 (insert (int-to-string score))
384 (defun 100secwp-read-input ()
385 "Read input from player."
387 (let ((input (word-at-point))
388 (time-left (- 100secwp-time-limit
389 (- (float-time) (100secwp-state start-time))))
392 (when (< time-left 0)
395 (setq invalid-input (100secwp-check-input input))
396 (when (not invalid-input)
397 (if (100secwp-word-exist input)
399 (100secwp-add (100secwp-state score)
400 (100secwp-sum-word input))
401 ;; Update global list of correct word to be
402 ;; displayed at the end of the game."
403 (100secwp-append (100secwp-state correct-word) input)
404 (100secwp-substitute-letter input) t)
405 (setq invalid-word input))))
406 (if (and (not input) (= time-left 0))
407 (100secwp-begin-game)
408 (100secwp-display-deck invalid-word invalid-input time-left))))
410 (define-derived-mode 100secwp-mode text-mode "100secwp"
411 "Major mode for the word by word game."
412 (100secwp-begin-game)
414 (let ((map (make-sparse-keymap)))
415 (define-key map (kbd "RET") '100secwp-read-input) map))
416 (100secwp-begin-game))
422 (switch-to-buffer 100secwp-buffer)
424 (switch-to-buffer 100secwp-buffer)
426 (insert (format "Welcome to %d seconds word puzzle!
428 You have %d seconds to type as many word made out of the
429 letters presented. Longer words are worth more points. The letters
430 are scored with Scrabble value.
432 Press any key to start." 100secwp-time-limit 100secwp-time-limit))
433 (while (not (aref (read-key-sequence nil) 0))
440 ;; compile-command: "make"
444 ;;; wpuzzle.el ends here