* riece-doctor.el (riece-doctor-after-privmsg-hook): Prefix user
authorueno <ueno>
Thu, 20 May 2004 07:22:07 +0000 (07:22 +0000)
committerueno <ueno>
Thu, 20 May 2004 07:22:07 +0000 (07:22 +0000)
name to reply.

* riece-hangman.el: New add-on.
* COMPILE (riece-modules): Add riece-hangman.
* Makefile.am (EXTRA_DIST): Add riece-hangman.el.

lisp/COMPILE
lisp/ChangeLog
lisp/Makefile.am
lisp/riece-doctor.el
lisp/riece-hangman.el [new file with mode: 0644]

index 17a0332..866cc44 100644 (file)
@@ -64,7 +64,8 @@
                riece-lsdb
                riece-xface
                riece-ctlseq
-               riece-ignore))))
+               riece-ignore
+               riece-hangman))))
 
 (defun riece-compile-modules (modules)
   (let ((load-path (cons nil load-path)))
index b4795bd..1d176cd 100644 (file)
@@ -1,3 +1,12 @@
+2004-05-20  Daiki Ueno  <ueno@unixuser.org>
+
+       * riece-doctor.el (riece-doctor-after-privmsg-hook): Prefix user
+       name to reply.
+
+       * riece-hangman.el: New add-on.
+       * COMPILE (riece-modules): Add riece-hangman.
+       * Makefile.am (EXTRA_DIST): Add riece-hangman.el.
+
 2004-05-19  Daiki Ueno  <ueno@unixuser.org>
 
        * riece-400.el (riece-handle-read-string): Append "Quit" to prompt
index 2753735..430a291 100644 (file)
@@ -11,7 +11,7 @@ EXTRA_DIST = COMPILE ChangeLog ChangeLog.Liece \
        riece-doctor.el riece-alias.el riece-layout.el riece-skk-kakutei.el \
        riece-guess.el riece-history.el riece-button.el riece-keyword.el \
        riece-menu.el riece-icon.el riece-async.el riece-lsdb.el \
-       riece-xface.el riece-ctlseq.el riece-ignore.el
+       riece-xface.el riece-ctlseq.el riece-ignore.el riece-hangman.el
 
 CLEANFILES = auto-autoloads.el custom-load.el *.elc
 FLAGS ?= -batch -q -no-site-file
index bd9ef47..7de1c11 100644 (file)
@@ -76,7 +76,8 @@
        (if (riece-identity-member user riece-doctor-patients)
            (riece-doctor-reply
             (car targets)
-            "You are already talking with me.")
+            (format "%s: You are already talking with me."
+                    (riece-format-identity user t)))
          (save-excursion
            (set-buffer (get-buffer-create (riece-doctor-buffer-name user)))
            (erase-buffer)
          (setq riece-doctor-patients (cons user riece-doctor-patients))
          (riece-doctor-reply
           (car targets)           
-          "I am the psychotherapist.  Please, describe your problems."))
+          (format
+           "%s: I am the psychotherapist.  Please, describe your problems."
+           (riece-format-identity user t))))
       (if (string-match riece-doctor-bye-regexp message)
          (let ((pointer (riece-identity-member user riece-doctor-patients)))
            (when pointer
              (kill-buffer (riece-doctor-buffer-name user))
              (setq riece-doctor-patients (delq (car pointer)
                                                riece-doctor-patients))
-             (riece-doctor-reply (car targets) "Good bye.")))
+             (riece-doctor-reply
+              (car targets)
+              (format "%s: Good bye." (riece-format-identity user t)))))
        (if (riece-identity-member user riece-doctor-patients)
            (let (string)
              (save-excursion
                  (insert string)
                  (subst-char-in-region (point-min) (point-max) ?\n ? )
                  (setq string (buffer-string))))
-             (riece-doctor-reply (car targets) string)))))))
+             (riece-doctor-reply
+              (car targets)
+              (format "%s: %s" (riece-format-identity user t) string))))))))
 
 (defun riece-doctor-insinuate ()
   (add-hook 'riece-after-privmsg-hook 'riece-doctor-after-privmsg-hook))
diff --git a/lisp/riece-hangman.el b/lisp/riece-hangman.el
new file mode 100644 (file)
index 0000000..8811e09
--- /dev/null
@@ -0,0 +1,209 @@
+;;; riece-hangman.el --- hangman
+;; Copyright (C) 1998-2004 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Keywords: IRC, riece
+
+;; This file is part of Riece.
+
+;; 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, 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 GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; To use, add the following line to your ~/.riece/init.el:
+;; (add-to-list 'riece-addons 'riece-hangman t)
+
+;;; Code:
+
+(require 'riece-globals)
+(require 'riece-identity)
+(require 'riece-message)
+(require 'riece-server)
+
+(defgroup riece-hangman nil
+  "Interface to hangman.el"
+  :prefix "riece-"
+  :group 'riece)
+
+(defcustom riece-hangman-hello-regexp "^, hangman"
+  "Pattern of string to start the game."
+  :type 'string
+  :group 'riece-hangman)
+
+(defcustom riece-hangman-bye-regexp "^, bye hangman"
+  "Pattern of string to end the game."
+  :type 'string
+  :group 'riece-hangman)
+
+(defcustom riece-hangman-words-file "/usr/share/dict/words"
+  "Location of words file."
+  :type 'file
+  :group 'riece-hangman)
+
+(defvar riece-hangman-players nil)
+(defvar riece-hangman-words-buffer nil)
+
+(defun riece-hangman-make-context (word)
+  (vector word nil 0))
+
+(defun riece-hangman-context-word (context)
+  (aref context 0))
+
+(defun riece-hangman-context-guessed (context)
+  (aref context 1))
+
+(defun riece-hangman-context-missed-count (context)
+  (aref context 2))
+
+(defun riece-hangman-context-set-word (context word)
+  (aset context 0 word))
+
+(defun riece-hangman-context-set-guessed (context guessed)
+  (aset context 1 guessed))
+
+(defun riece-hangman-context-set-missed-count (context missed-count)
+  (aset context 2 missed-count))
+
+(defun riece-hangman-word ()
+  (unless riece-hangman-words-buffer
+    (setq riece-hangman-words-buffer (generate-new-buffer " *riece-hangman*"))
+    (save-excursion
+      (set-buffer riece-hangman-words-buffer)
+      (buffer-disable-undo)
+      (insert-file-contents riece-hangman-words-file)
+      (let ((case-fold-search nil))
+       (delete-non-matching-lines "^[a-z][a-z][a-z][a-z][a-z][a-z]"))))
+  (save-excursion
+    (set-buffer riece-hangman-words-buffer)
+    (goto-char (% (1+ (random)) (buffer-size)))
+    (if (eobp)
+       (beginning-of-line -1)
+      (beginning-of-line))
+    (buffer-substring (point) (progn (end-of-line) (point)))))
+
+(defun riece-hangman-reply (target string)
+  (riece-display-message
+   (riece-make-message (riece-make-identity riece-real-nickname
+                                           riece-server-name)
+                      (riece-make-identity target riece-server-name)
+                      string 'notice t))
+  (riece-send-string (format "NOTICE %s :%s\r\n" target string)))
+
+(defun riece-hangman-reply-with-context (target context)
+  (let* ((word (riece-hangman-context-word context))
+        (masked-word (make-string (length word) ?-))
+        (guessed (riece-hangman-context-guessed context))
+        (index 0))
+    (while (< index (length word))
+      (if (memq (aref word index) guessed)
+         (aset masked-word index (aref word index)))
+      (setq index (1+ index)))
+    (riece-hangman-reply
+     target
+     (format "Word: %s, Guessed: %s"
+            masked-word
+            (apply #'string (sort (copy-sequence guessed) #'<))))))
+
+(defun riece-hangman-after-privmsg-hook (prefix string)
+  (let* ((user (riece-make-identity (riece-prefix-nickname prefix)
+                                   riece-server-name))
+        (parameters (riece-split-parameters string))
+        (targets (split-string (car parameters) ","))
+        (message (nth 1 parameters))
+        pointer)
+    (if (string-match riece-hangman-hello-regexp message)
+       (if (riece-identity-assoc user riece-hangman-players)
+           (riece-hangman-reply
+            (car targets)
+            (format "%s: You are already playing the game."
+                    (riece-format-identity user t)))
+         (let ((context (riece-hangman-make-context (riece-hangman-word))))
+           (setq riece-hangman-players (cons (cons user context)
+                                             riece-hangman-players))
+           (riece-hangman-reply-with-context (car targets) context)))
+      (if (string-match riece-hangman-bye-regexp message)
+         (when (setq pointer (riece-identity-assoc user
+                                                   riece-hangman-players))
+           (setq riece-hangman-players (delq pointer riece-hangman-players))
+           (riece-hangman-reply
+            (car targets)
+            (format "%s: Sorry, the word was \"%s\""
+                    (riece-format-identity user t)
+                    (riece-hangman-context-word (cdr pointer)))))
+       (if (setq pointer (riece-identity-assoc user riece-hangman-players))
+           (if (or (/= (length message) 1)
+                   (not (string-match "[a-z]" message)))
+               (riece-hangman-reply
+                (car targets)
+                (format "%s: Not a valid guess: %s"
+                        (riece-format-identity user t)
+                        message))
+             (if (memq (aref message 0)
+                       (riece-hangman-context-guessed (cdr pointer)))
+                 (riece-hangman-reply (car targets)
+                                      (format "%s: Already guessed '%c'"
+                                              (riece-format-identity user t)
+                                              (aref message 0)))
+               (riece-hangman-context-set-guessed
+                (cdr pointer)
+                (cons (aref message 0)
+                      (riece-hangman-context-guessed (cdr pointer))))
+               (let ((word (riece-hangman-context-word (cdr pointer)))
+                     (index 0)
+                     (char (aref message 0)))
+                 (unless (catch 'found
+                           (while (< index (length word))
+                             (if (eq (aref word index) char)
+                                 (throw 'found t))
+                             (setq index (1+ index))))
+                   (riece-hangman-context-set-missed-count
+                    (cdr pointer)
+                    (1+ (riece-hangman-context-missed-count
+                         (cdr pointer))))))
+               (if (>= (riece-hangman-context-missed-count (cdr pointer)) 7)
+                   (progn
+                     (riece-hangman-reply
+                      (car targets)
+                      (format "%s: Sorry, the word was \"%s\""
+                              (riece-format-identity user t)
+                              (riece-hangman-context-word (cdr pointer))))
+                     (setq riece-hangman-players
+                           (delq pointer
+                                 riece-hangman-players)))
+                 (let ((word (riece-hangman-context-word (cdr pointer)))
+                       (guessed (riece-hangman-context-guessed (cdr pointer)))
+                       (index 0)
+                       (char (aref message 0)))
+                   (if (catch 'missing
+                         (while (< index (length word))
+                           (unless (memq (aref word index) guessed)
+                             (throw 'missing t))
+                           (setq index (1+ index))))
+                       (riece-hangman-reply-with-context
+                        (car targets) (cdr pointer))
+                     (riece-hangman-reply
+                      (car targets)
+                      (format "%s: You got it!"
+                              (riece-format-identity user t)))
+                     (setq riece-hangman-players
+                           (delq pointer riece-hangman-players))))))))))))
+
+(defun riece-hangman-insinuate ()
+  (add-hook 'riece-after-privmsg-hook 'riece-hangman-after-privmsg-hook))
+
+(provide 'riece-hangman)
+
+;;; riece-hangman.el ends here