* riece-hangman.el (riece-hangman-word): Check killed-buffer or
[riece] / lisp / riece-hangman.el
1 ;;; riece-hangman.el --- hangman
2 ;; Copyright (C) 1998-2004 Daiki Ueno
3
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Keywords: IRC, riece
6
7 ;; This file is part of Riece.
8
9 ;; This program is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13
14 ;; This program is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 ;; GNU General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
23
24 ;;; Commentary:
25
26 ;; To use, add the following line to your ~/.riece/init.el:
27 ;; (add-to-list 'riece-addons 'riece-hangman)
28
29 ;;; Code:
30
31 (require 'riece-globals)
32 (require 'riece-identity)
33 (require 'riece-message)
34 (require 'riece-server)
35
36 (defgroup riece-hangman nil
37   "Interface to hangman.el"
38   :prefix "riece-"
39   :group 'riece)
40
41 (defcustom riece-hangman-hello-regexp "^, hangman"
42   "Pattern of string to start the game."
43   :type 'string
44   :group 'riece-hangman)
45
46 (defcustom riece-hangman-bye-regexp "^, bye hangman"
47   "Pattern of string to end the game."
48   :type 'string
49   :group 'riece-hangman)
50
51 (defcustom riece-hangman-words-file "/usr/share/dict/words"
52   "Location of words file."
53   :type 'file
54   :group 'riece-hangman)
55
56 (defvar riece-hangman-player-context-alist nil)
57 (defvar riece-hangman-words-buffer nil)
58
59 (defvar riece-hangman-enabled nil)
60
61 (defconst riece-hangman-description
62   "Allow users in channel to play classic textual game \"hangman\"")
63
64 (put 'riece-hangman 'riece-addon-default-disabled t)
65
66 (defun riece-hangman-make-context (word)
67   "Make an instance of player context object.
68 This function is for internal use only."
69   (vector word nil 0))
70
71 (defun riece-hangman-context-word (context)
72   "Return the correct word of CONTEXT.
73 This function is for internal use only."
74   (aref context 0))
75
76 (defun riece-hangman-context-guessed (context)
77   "Return the guessed letters in this CONTEXT.
78 This function is for internal use only."
79   (aref context 1))
80
81 (defun riece-hangman-context-missed-count (context)
82   "Return the count of missed guesses in this CONTEXT.
83 This function is for internal use only."
84   (aref context 2))
85
86 (defun riece-hangman-context-set-guessed (context guessed)
87   "Set the GUESSED letters in this CONTEXT.
88 This function is for internal use only."
89   (aset context 1 guessed))
90
91 (defun riece-hangman-context-set-missed-count (context missed-count)
92   "Set the count of MISSED guesses in this CONTEXT.
93 This function is for internal use only."
94   (aset context 2 missed-count))
95
96 (defun riece-hangman-word ()
97   "Return random word.
98 The wordlist is read from `riece-hangman-words-file'."
99   (unless (and riece-hangman-words-buffer
100                (buffer-name riece-hangman-words-buffer))
101     (setq riece-hangman-words-buffer (generate-new-buffer " *riece-hangman*"))
102     (save-excursion
103       (set-buffer riece-hangman-words-buffer)
104       (buffer-disable-undo)
105       (insert-file-contents riece-hangman-words-file)
106       (let ((case-fold-search nil))
107         (delete-non-matching-lines "^[a-z][a-z][a-z][a-z][a-z][a-z]+"))))
108   (save-excursion
109     (set-buffer riece-hangman-words-buffer)
110     (goto-char (1+ (random (buffer-size))))
111     (if (eobp)
112         (beginning-of-line -1)
113       (beginning-of-line))
114     (buffer-substring (point) (progn (end-of-line) (point)))))
115
116 (defun riece-hangman-reply (target string)
117   (riece-display-message
118    (riece-make-message (riece-make-identity riece-real-nickname
119                                             riece-server-name)
120                        (riece-make-identity target riece-server-name)
121                        string 'notice t))
122   (riece-send-string (format "NOTICE %s :%s\r\n" target string)))
123
124 (defun riece-hangman-reply-with-context (user target context)
125   (let ((masked-word (make-string
126                       (length (riece-hangman-context-word context))
127                       ?-))
128         (guessed (copy-sequence (riece-hangman-context-guessed context)))
129         (index 0))
130     (while (< index (length (riece-hangman-context-word context)))
131       (if (memq (aref (riece-hangman-context-word context) index) guessed)
132           (aset masked-word index
133                 (aref (riece-hangman-context-word context) index)))
134       (setq index (1+ index)))
135     (riece-hangman-reply
136      target
137      (format "%s: Word: %s, Guessed: %s"
138              user masked-word
139              (if guessed
140                  (apply #'string (sort guessed #'<))
141                "")))))
142
143 (defun riece-hangman-after-privmsg-hook (prefix string)
144   (if riece-hangman-enabled
145       (let* ((user (riece-prefix-nickname prefix))
146              (parameters (riece-split-parameters string))
147              (targets (split-string (car parameters) ","))
148              (message (nth 1 parameters))
149              case-fold-search
150              pointer word guessed index)
151         (if (string-match riece-hangman-hello-regexp message)
152             (if (riece-identity-assoc user riece-hangman-player-context-alist
153                                       t)
154                 (riece-hangman-reply
155                  (car targets)
156                  (format "%s: You are already playing the game." user))
157               (let ((context (riece-hangman-make-context
158                               (riece-hangman-word))))
159                 (setq riece-hangman-player-context-alist
160                       (cons (cons user context)
161                             riece-hangman-player-context-alist))
162                 (riece-hangman-reply-with-context user (car targets) context)))
163           (if (string-match riece-hangman-bye-regexp message)
164               (when (setq pointer (riece-identity-assoc
165                                    user riece-hangman-player-context-alist t))
166                 (setq riece-hangman-player-context-alist
167                       (delq pointer riece-hangman-player-context-alist))
168                 (riece-hangman-reply
169                  (car targets)
170                  (format "%s: Sorry, the word was \"%s\""
171                          user
172                          (riece-hangman-context-word (cdr pointer)))))
173             (if (setq pointer (riece-identity-assoc
174                                user riece-hangman-player-context-alist t))
175                 (if (or (/= (length message) 1)
176                         (not (string-match "[a-z]" message)))
177                     (riece-hangman-reply
178                      (car targets)
179                      (format "%s: Not a valid guess: %s" user message))
180                   (if (memq (aref message 0)
181                             (riece-hangman-context-guessed (cdr pointer)))
182                       (riece-hangman-reply (car targets)
183                                            (format "%s: Already guessed '%c'"
184                                                    user (aref message 0)))
185                     (setq guessed (riece-hangman-context-set-guessed
186                                    (cdr pointer)
187                                    (cons (aref message 0)
188                                          (riece-hangman-context-guessed
189                                           (cdr pointer))))
190                           word (riece-hangman-context-word (cdr pointer)))
191                     (unless (catch 'found
192                               (setq index 0)
193                               (while (< index (length word))
194                                 (if (eq (aref word index) (aref message 0))
195                                     (throw 'found t))
196                                 (setq index (1+ index))))
197                       (riece-hangman-context-set-missed-count
198                        (cdr pointer)
199                        (1+ (riece-hangman-context-missed-count
200                             (cdr pointer)))))
201                     (if (>= (riece-hangman-context-missed-count (cdr pointer))
202                             7)
203                         (progn
204                           (riece-hangman-reply
205                            (car targets)
206                            (format "%s: Sorry, the word was \"%s\""
207                                    user
208                                    (riece-hangman-context-word (cdr pointer))))
209                           (setq riece-hangman-player-context-alist
210                                 (delq pointer
211                                       riece-hangman-player-context-alist)))
212                       (if (catch 'missing
213                             (setq index 0)
214                             (while (< index (length word))
215                               (unless (memq (aref word index) guessed)
216                                 (throw 'missing t))
217                               (setq index (1+ index))))
218                           (riece-hangman-reply-with-context user (car targets)
219                                                             (cdr pointer))
220                         (riece-hangman-reply (car targets)
221                                              (format "%s: You got it! (%s)"
222                                                      user word))
223                         (setq riece-hangman-player-context-alist
224                               (delq
225                                pointer
226                                riece-hangman-player-context-alist))))))))))))
227
228 (defun riece-hangman-insinuate ()
229   (add-hook 'riece-after-privmsg-hook 'riece-hangman-after-privmsg-hook))
230
231 (defun riece-hangman-enable ()
232   (random t)
233   (setq riece-hangman-enabled t))
234
235 (defun riece-hangman-disable ()
236   (setq riece-hangman-enabled nil))
237
238 (provide 'riece-hangman)
239
240 ;;; riece-hangman.el ends here