100 second word puzzle

100 second word puzzle

[Ivan Kanis]

[-- Attachment #1: Type: text/plain, Size: 132 bytes --]

It's like Scrabble for a single player. If there is interest I will
clean it up so that it can be integrated in emacs.

Ivan Kanis


[-- Attachment #2: 100secwp.el --]
[-- Type: application/emacs-lisp, Size: 10614 bytes --]

;; -*- coding: utf-8; lexical-binding: t -*-

;;; 100secwp.el --- One hundred seconds word puzzle

;;; Commentary:

;; Version 1.0

;; Ideas for improvement:
;;  - add other languages such as french
;;  - input letter one by one like the original game
;;  - really stop after 100 seconds
;;  - display something more fancy with letter points (SVG would be cool!)
;;  - use ispell.el
;;  - display best possible score on a given deck at the end of the game
;;  - use gamegrid.el for dealing with high score

;;; THANKS:

;; It is inspired by a game of SpiceLabs http://spicelabs.in

;; I dedicate this code to my grandmother who taught me to play Scrabble

;;; BUGS:

;;; INSTALLATION:

;; M-x eval-buffer
;; M-x 100secwp

;;; Code:

(defvar 100secwp-time-limit 100
  "Number of seconds the game will last.")

(defvar 100secwp-score-file "100secwp-scores"
  "File for holding high scores.")

(defvar 100secwp-high-score-directory
  (locate-user-emacs-file "games/")
  "A directory for storing game high score.")

(defvar 100secwp-high-score-file
  (concat 100secwp-high-score-directory "100secwp")
  "Full path to file used for storing game high score.")

(defvar 100secwp-frequency
  '((?E . 111)
    (?A . 84)
    (?R . 75)
    (?I . 75)
    (?O . 71)
    (?T . 69)
    (?N . 66)
    (?S . 57)
    (?L . 54)
    (?C . 45)
    (?U . 36)
    (?D . 33)
    (?P . 31)
    (?M . 30)
    (?H . 30)
    (?G . 24)
    (?B . 20)
    (?F . 18)
    (?Y . 17)
    (?W . 12)
    (?K . 11)
    (?V . 10)
    (?X . 2)
    (?Z . 2)
    (?J . 1)
    (?Q . 1))
  "English letter frequency.")

(defvar 100secwp-scrabble
  '((?A . 1)
    (?B . 3)
    (?C . 3)
    (?D . 2)
    (?E . 1)
    (?F . 4)
    (?G . 2)
    (?H . 4)
    (?I . 1)
    (?J . 8)
    (?K . 5)
    (?L . 1)
    (?M . 3)
    (?N . 1)
    (?O . 1)
    (?P . 3)
    (?Q . 10)
    (?R . 1)
    (?S . 1)
    (?T . 1)
    (?U . 1)
    (?V . 4)
    (?W . 4)
    (?X . 8)
    (?Y . 4)
    (?Z . 10))
  "Scrabble letter values.")

(defvar 100secwp-buffer "*100secwp*"
  "Game buffer")

(defmacro 100secwp-state (key)
  "Return KEY stored in buffer local variable state."
  `(cdr (assoc ',key (buffer-local-value 'state (current-buffer)))))

(defmacro 100secwp-add (place number)
  "Append number PLACE with CHAR."
  `(setf ,place (+ ,place ,number)))

(defmacro 100secwp-append (place element)
  "Append to list PLACE with ELEMENT."
  `(setf ,place (append ,place (list ,element))))

(defun 100secwp-pick-letter ()
  "Pick a random letter."
  (string
   (let* ((start 0)
          (sum (let ((ret 0))
                 (dolist (el 100secwp-frequency ret)
                   (setq ret (+ ret (cdr el))))))
          (pick (random sum)) ret)
     (dolist (el 100secwp-frequency ret)
       (when (< start pick)
         (setq ret (car el)))
       (setq start (+ start (cdr el)))))))

(defun 100secwp-ask-first ()
  "Initial string to play with."
  (let ((ret ""))
    (dolist (el (make-list 10 nil) ret)
      (setq ret (concat ret (100secwp-pick-letter))) el)))

(defun 100secwp-ask-next (letters input)
  "Remove INPUT in LETTERS and pick a new letter.
Return new string, nil if INPUT is not in LETTERS."
  (let ((match (string-match input letters)))
    (when match
      (aset letters match (aref (100secwp-pick-letter) 0))
      letters)))

(defun 100secwp-sum-word (word)
  "Return sum of WORD with Scrabble letter value and length."
  (let ((length (length word))
        (sum 0)
        (index 0))
    (while (< index length)
      (setq sum (+ sum (cdr (assoc (aref word index) 100secwp-scrabble))))
      (incf index))
    (cond ((< length 3)
           (setq sum 0))
          ((> length 10)
           (setq sum (+ sum 100)))
          (t
           (setq sum (+ sum
                        (cdr (assoc length
                                    '((3 . 10) (4 . 20) (5 . 30) (6 . 40)
                                      (7 . 50) (8 . 75) (9 . 85))))))))

    sum))

(define-derived-mode 100secwp-mode text-mode "100secwp"
  "Major mode for running the program."
  (use-local-map
   (let ((map (make-sparse-keymap)))
     (define-key map (kbd "RET") '100secwp-read-input) map))
  (make-local-variable 'state)
  (setq state '((deck-letter . "")
                (score . 0)
                (start-time 0)
                (game-over)
                (correct-word)))
  (switch-to-buffer 100secwp-buffer)
  (100secwp-begin-game))

(defun 100secwp-begin-game ()
  "Reset game state."
  (setf (100secwp-state start-time) (float-time))
  (setf (100secwp-state score) 0)
  (setf (100secwp-state game-over) nil)
  (setf (100secwp-state deck-letter) (100secwp-ask-first))
  (setf (100secwp-state correct-word) nil))

(defun 100secwp-display-deck ()
  (when (not (100secwp-state game-over))
    (let ((deck (100secwp-state deck-letter)))
      (insert "\n ")
      (100secwp-display-deck-1 (substring deck 0 3))
      (100secwp-display-deck-1 (substring deck 3 7))
      (insert " ")
      (100secwp-display-deck-1 (substring deck 7 10)))))

(defun 100secwp-display-deck-1 (letter)
  (let ((index 0))
    (while (< index (length letter))
      (insert (substring letter index (+ 1 index)) " ")
      (incf index))
    (insert "\n")))

(defun 100secwp-check-word (word)
  "Return not nil when WORD exists in dictionary."
  (with-temp-buffer
    (let ((process
           (start-process
            "100secwp" (current-buffer)
            "aspell" "-a" "-B" "--encoding=utf-8")))
      (process-send-string nil
                           (concat"%n\n^" word "\n"))
      (accept-process-output process)
      (goto-char (point-min))
      (re-search-forward "^\*$" nil t))))

(defun 100secwp-substitute-letter (input)
  "Pick new letter that are proposed from INPUT."
  (let ((index 0)
        (length (length input))
        (wrong "")
        exist letter)
    (while (< index length)
      (setq letter (substring input index (+ 1 index)))
      (setq exist (100secwp-ask-next (100secwp-state deck-letter) letter))
      (if exist
          (setf (100secwp-state deck-letter) exist)
        (setq wrong (concat wrong letter)))
      (incf index))
    (when (not (string= wrong ""))
      wrong)))

(defun 100secwp-read-input ()
  (interactive)
  (catch 'exit
    (let ((input (word-at-point))
          (time-left
           (- 100secwp-time-limit
              (- (float-time) (100secwp-state start-time)))))
      (if (100secwp-state game-over)
          (if (and input (string= input "quit"))
              (progn
                (kill-buffer 100secwp-buffer)
                (throw 'exit nil))
            (100secwp-begin-game))
        (when input
          (100secwp-read-input-1 input time-left))))
    (100secwp-display-deck)))

(defun 100secwp-retrieve-high-score ()
  (let ((high-score 0))
    (when (not (file-exists-p 100secwp-high-score-directory))
      (make-directory 100secwp-high-score-directory))
    (save-excursion
      (find-file 100secwp-high-score-file)
      (goto-char (point-min))
      (let ((wap (word-at-point)))
        (if (and wap (not (string= wap "")))
            (setq high-score (string-to-int (word-at-point))) 0))
      high-score)))

(defun 100secwp-end-game (correct-word)
  (let ((max-length 1)
        (score (100secwp-state score)))
    (dolist (word (100secwp-state correct-word))
      (when (> (length word) max-length)
        (setq max-length (length word))))
    (dolist (word (100secwp-state correct-word))
      (insert (format (concat "%-" (int-to-string max-length) "s %d\n") (downcase word) (100secwp-sum-word word))))
    (insert (make-string (+ 4 max-length) ?-) "\n")
    (insert "sum " (make-string (- max-length 3) ? ) (int-to-string score) "\n")
    (when (> (100secwp-state score) (100secwp-retrieve-high-score))
      (insert "\nCongratulation, you beat the high score!\n")
      (save-excursion
        (find-file 100secwp-high-score-file)
        (erase-buffer)
        (insert (int-to-string score))
        (save-buffer)))
    (insert "\nPress enter to play one more game
Type 'quit' to exit the game.\n")))

(defun 100secwp-read-input-1 (input time-left)
  (let (correct-word)
    (if (> time-left 0)
        (progn
          (if (100secwp-check-word input)
              (progn
                (setq input (upcase input))
                (let ((wrong (100secwp-substitute-letter input)))
                  (if wrong
                      (insert (format  "\nThe following is not in the deck: %s." wrong))
                    (100secwp-add (100secwp-state score)
                                  (100secwp-sum-word input))
                    (100secwp-append (100secwp-state correct-word) input))))
            (insert (format "\nThe word %s does not exist." input)))
          (insert (format "\n%d second left. Your score is %d." time-left (100secwp-state score))))
      (insert "\n\nGame over!\n\n")
      (when (not (= (100secwp-state score) 0))
        (100secwp-end-game correct-word))
      (setf (100secwp-state game-over) t))))

;;;###autoload
(defun 100secwp ()
  "Start game."
  (interactive)
  (switch-to-buffer 100secwp-buffer)
  (insert "Welcome to 100 seconds word puzzle!

You have a hundred second to type as many word made out of the
letters presented. Longer words are worth more point. The letters
are scored with Scrabble value.

The high score is " (int-to-string (100secwp-retrieve-high-score)) "

Press enter to start game.")
  (switch-to-buffer 100secwp-buffer)
  (100secwp-mode))

;; Copyright (C) 2012 Ivan Kanis
;; Author: Ivan Kanis
;;
;; This program is free software ; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation ; either version 2 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY ; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program ; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;
;; vi:et:sw=4:ts=4:
;; Local Variables:
;; compile-command: "make"
;; End:

Re: 100 second word puzzle

[xfq]

On Mon, 10 Dec 2012 14:56:15 +0100
Ivan Kanis <ivan.kanis@googlemail.com> wrote:

> It's like Scrabble for a single player. If there is interest I will
> clean it up so that it can be integrated in emacs.
> 
> Ivan Kanis
> 
Seems interesting.  And maybe gnu-emacs-sources is a better place to post Lisp code for use with GNU Emacs.

-- 
xfq <xfq.free@gmail.com>

Re: 100 second word puzzle

[xfq]

On Mon, 10 Dec 2012 14:56:15 +0100
Ivan Kanis <ivan.kanis@googlemail.com> wrote:

> It's like Scrabble for a single player. If there is interest I will
> clean it up so that it can be integrated in emacs.
> 
> Ivan Kanis
> 
Sorry for my ignoring your posting on gnu-emacs-sources.

-- 
xfq <xfq.free@gmail.com>