Add the following comment to add-on modules.
[riece] / lisp / riece-hangman.el
1 ;;; riece-hangman.el --- allow channel members to play the hangman game
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 ;; NOTE: This is an add-on module for Riece.
27
28 ;;; Code:
29
30 (require 'riece-globals)
31 (require 'riece-identity)
32 (require 'riece-message)
33 (require 'riece-server)
34
35 (defgroup riece-hangman nil
36   "Allow channel members to play the hangman game."
37   :prefix "riece-"
38   :group 'riece)
39
40 (defcustom riece-hangman-hello-regexp "^,hangman$"
41   "Pattern of string to start the game."
42   :type 'string
43   :group 'riece-hangman)
44
45 (defcustom riece-hangman-bye-regexp "^,hangman bye$"
46   "Pattern of string to end the game."
47   :type 'string
48   :group 'riece-hangman)
49
50 (defcustom riece-hangman-words-file "/usr/share/dict/words"
51   "Location of words file."
52   :type 'file
53   :group 'riece-hangman)
54
55 (defvar riece-hangman-player-context-alist nil)
56 (defvar riece-hangman-words-buffer nil)
57
58 (defvar riece-hangman-enabled nil)
59
60 (defconst riece-hangman-description
61   "Allow channel members to play the hangman game.")
62
63 (put 'riece-hangman 'riece-addon-default-disabled t)
64
65 (defun riece-hangman-make-context (word)
66   "Make an instance of player context object.
67 This function is for internal use only."
68   (vector word nil 0))
69
70 (defun riece-hangman-context-word (context)
71   "Return the correct word of CONTEXT.
72 This function is for internal use only."
73   (aref context 0))
74
75 (defun riece-hangman-context-guessed (context)
76   "Return the guessed letters in this CONTEXT.
77 This function is for internal use only."
78   (aref context 1))
79
80 (defun riece-hangman-context-missed-count (context)
81   "Return the count of missed guesses in this CONTEXT.
82 This function is for internal use only."
83   (aref context 2))
84
85 (defun riece-hangman-context-set-guessed (context guessed)
86   "Set the GUESSED letters in this CONTEXT.
87 This function is for internal use only."
88   (aset context 1 guessed))
89
90 (defun riece-hangman-context-set-missed-count (context missed-count)
91   "Set the count of MISSED guesses in this CONTEXT.
92 This function is for internal use only."
93   (aset context 2 missed-count))
94
95 (defun riece-hangman-word ()
96   "Return random word.
97 The wordlist is read from `riece-hangman-words-file'."
98   (unless (and riece-hangman-words-buffer
99                (buffer-name riece-hangman-words-buffer))
100     (setq riece-hangman-words-buffer (generate-new-buffer " *riece-hangman*"))
101     (save-excursion
102       (set-buffer riece-hangman-words-buffer)
103       (buffer-disable-undo)
104       (insert-file-contents riece-hangman-words-file)
105       (let ((case-fold-search nil))
106         (delete-non-matching-lines "^[a-z][a-z][a-z][a-z][a-z][a-z]+"))))
107   (save-excursion
108     (set-buffer riece-hangman-words-buffer)
109     (goto-char (1+ (random (buffer-size))))
110     (if (eobp)
111         (beginning-of-line -1)
112       (beginning-of-line))
113     (buffer-substring (point) (progn (end-of-line) (point)))))
114
115 (defun riece-hangman-reply (target string)
116   (riece-display-message
117    (riece-make-message (riece-make-identity riece-real-nickname
118                                             riece-server-name)
119                        (riece-make-identity target riece-server-name)
120                        string 'notice t))
121   (riece-send-string (format "NOTICE %s :%s\r\n" target string)))
122
123 (defun riece-hangman-reply-with-context (user target context)
124   (let ((masked-word (make-string
125                       (length (riece-hangman-context-word context))
126                       ?-))
127         (guessed (copy-sequence (riece-hangman-context-guessed context)))
128         (index 0))
129     (while (< index (length (riece-hangman-context-word context)))
130       (if (memq (aref (riece-hangman-context-word context) index) guessed)
131           (aset masked-word index
132                 (aref (riece-hangman-context-word context) index)))
133       (setq index (1+ index)))
134     (riece-hangman-reply
135      target
136      (format "%s: Word: %s, Guessed: %s"
137              user masked-word
138              (if guessed
139                  (apply #'string (sort guessed #'<))
140                "")))))
141
142 (defun riece-hangman-after-privmsg-hook (prefix string)
143   (if riece-hangman-enabled
144       (let* ((user (riece-prefix-nickname prefix))
145              (parameters (riece-split-parameters string))
146              (targets (split-string (car parameters) ","))
147              (message (nth 1 parameters))
148              case-fold-search
149              pointer word guessed index)
150         (if (string-match riece-hangman-hello-regexp message)
151             (if (riece-identity-assoc user riece-hangman-player-context-alist
152                                       t)
153                 (riece-hangman-reply
154                  (car targets)
155                  (format "%s: You are already playing the game." user))
156               (let ((context (riece-hangman-make-context
157                               (riece-hangman-word))))
158                 (setq riece-hangman-player-context-alist
159                       (cons (cons user context)
160                             riece-hangman-player-context-alist))
161                 (riece-hangman-reply-with-context user (car targets) context)))
162           (if (string-match riece-hangman-bye-regexp message)
163               (when (setq pointer (riece-identity-assoc
164                                    user riece-hangman-player-context-alist t))
165                 (setq riece-hangman-player-context-alist
166                       (delq pointer riece-hangman-player-context-alist))
167                 (riece-hangman-reply
168                  (car targets)
169                  (format "%s: Sorry, the word was \"%s\""
170                          user
171                          (riece-hangman-context-word (cdr pointer)))))
172             (if (setq pointer (riece-identity-assoc
173                                user riece-hangman-player-context-alist t))
174                 (if (or (/= (length message) 1)
175                         (not (string-match "[a-z]" message)))
176                     (riece-hangman-reply
177                      (car targets)
178                      (format "%s: Not a valid guess: %s" user message))
179                   (if (memq (aref message 0)
180                             (riece-hangman-context-guessed (cdr pointer)))
181                       (riece-hangman-reply (car targets)
182                                            (format "%s: Already guessed '%c'"
183                                                    user (aref message 0)))
184                     (setq guessed (riece-hangman-context-set-guessed
185                                    (cdr pointer)
186                                    (cons (aref message 0)
187                                          (riece-hangman-context-guessed
188                                           (cdr pointer))))
189                           word (riece-hangman-context-word (cdr pointer)))
190                     (unless (catch 'found
191                               (setq index 0)
192                               (while (< index (length word))
193                                 (if (eq (aref word index) (aref message 0))
194                                     (throw 'found t))
195                                 (setq index (1+ index))))
196                       (riece-hangman-context-set-missed-count
197                        (cdr pointer)
198                        (1+ (riece-hangman-context-missed-count
199                             (cdr pointer)))))
200                     (if (>= (riece-hangman-context-missed-count (cdr pointer))
201                             7)
202                         (progn
203                           (riece-hangman-reply
204                            (car targets)
205                            (format "%s: Sorry, the word was \"%s\""
206                                    user
207                                    (riece-hangman-context-word (cdr pointer))))
208                           (setq riece-hangman-player-context-alist
209                                 (delq pointer
210                                       riece-hangman-player-context-alist)))
211                       (if (catch 'missing
212                             (setq index 0)
213                             (while (< index (length word))
214                               (unless (memq (aref word index) guessed)
215                                 (throw 'missing t))
216                               (setq index (1+ index))))
217                           (riece-hangman-reply-with-context user (car targets)
218                                                             (cdr pointer))
219                         (riece-hangman-reply (car targets)
220                                              (format "%s: You got it! (%s)"
221                                                      user word))
222                         (setq riece-hangman-player-context-alist
223                               (delq
224                                pointer
225                                riece-hangman-player-context-alist))))))))))))
226
227 (defun riece-hangman-insinuate ()
228   (add-hook 'riece-after-privmsg-hook 'riece-hangman-after-privmsg-hook))
229
230 (defun riece-hangman-enable ()
231   (random t)
232   (setq riece-hangman-enabled t))
233
234 (defun riece-hangman-disable ()
235   (setq riece-hangman-enabled nil))
236
237 (provide 'riece-hangman)
238
239 ;;; riece-hangman.el ends here