1 ;;; riece-hangman.el --- allow channel members to play the hangman game
2 ;; Copyright (C) 1998-2004 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Keywords: IRC, riece
7 ;; This file is part of Riece.
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)
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.
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.
26 ;; NOTE: This is an add-on module for Riece.
30 (require 'riece-globals)
31 (require 'riece-identity)
32 (require 'riece-message)
33 (require 'riece-server)
35 (defgroup riece-hangman nil
36 "Allow channel members to play the hangman game."
40 (defcustom riece-hangman-hello-regexp "^,hangman$"
41 "Pattern of string to start the game."
43 :group 'riece-hangman)
45 (defcustom riece-hangman-bye-regexp "^,hangman bye$"
46 "Pattern of string to end the game."
48 :group 'riece-hangman)
50 (defcustom riece-hangman-words-file "/usr/share/dict/words"
51 "Location of words file."
53 :group 'riece-hangman)
55 (defvar riece-hangman-player-context-alist nil)
56 (defvar riece-hangman-words-buffer nil)
58 (defvar riece-hangman-enabled nil)
60 (defconst riece-hangman-description
61 "Allow channel members to play the hangman game.")
63 (put 'riece-hangman 'riece-addon-default-disabled t)
65 (defun riece-hangman-make-context (word)
66 "Make an instance of player context object.
67 This function is for internal use only."
70 (defun riece-hangman-context-word (context)
71 "Return the correct word of CONTEXT.
72 This function is for internal use only."
75 (defun riece-hangman-context-guessed (context)
76 "Return the guessed letters in this CONTEXT.
77 This function is for internal use only."
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."
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))
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))
95 (defun riece-hangman-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*"))
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]+"))))
108 (set-buffer riece-hangman-words-buffer)
109 (goto-char (1+ (random (buffer-size))))
111 (beginning-of-line -1)
113 (buffer-substring (point) (progn (end-of-line) (point)))))
115 (defun riece-hangman-reply (target string)
116 (riece-display-message
117 (riece-make-message (riece-make-identity riece-real-nickname
119 (riece-make-identity target riece-server-name)
121 (riece-send-string (format "NOTICE %s :%s\r\n" target string)))
123 (defun riece-hangman-reply-with-context (user target context)
124 (let ((masked-word (make-string
125 (length (riece-hangman-context-word context))
127 (guessed (copy-sequence (riece-hangman-context-guessed context)))
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)))
136 (format "%s: Word: %s, Guessed: %s"
139 (apply #'string (sort guessed #'<))
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))
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
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))
169 (format "%s: Sorry, the word was \"%s\""
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)))
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
186 (cons (aref message 0)
187 (riece-hangman-context-guessed
189 word (riece-hangman-context-word (cdr pointer)))
190 (unless (catch 'found
192 (while (< index (length word))
193 (if (eq (aref word index) (aref message 0))
195 (setq index (1+ index))))
196 (riece-hangman-context-set-missed-count
198 (1+ (riece-hangman-context-missed-count
200 (if (>= (riece-hangman-context-missed-count (cdr pointer))
205 (format "%s: Sorry, the word was \"%s\""
207 (riece-hangman-context-word (cdr pointer))))
208 (setq riece-hangman-player-context-alist
210 riece-hangman-player-context-alist)))
213 (while (< index (length word))
214 (unless (memq (aref word index) guessed)
216 (setq index (1+ index))))
217 (riece-hangman-reply-with-context user (car targets)
219 (riece-hangman-reply (car targets)
220 (format "%s: You got it! (%s)"
222 (setq riece-hangman-player-context-alist
225 riece-hangman-player-context-alist))))))))))))
227 (defun riece-hangman-insinuate ()
228 (add-hook 'riece-after-privmsg-hook 'riece-hangman-after-privmsg-hook))
230 (defun riece-hangman-uninstall ()
231 (remove-hook 'riece-after-privmsg-hook 'riece-hangman-after-privmsg-hook))
233 (defun riece-hangman-enable ()
235 (setq riece-hangman-enabled t))
237 (defun riece-hangman-disable ()
238 (setq riece-hangman-enabled nil))
240 (provide 'riece-hangman)
242 ;;; riece-hangman.el ends here