From: Daiki Ueno Date: Thu, 20 May 2004 07:22:07 +0000 (+0000) Subject: * riece-doctor.el (riece-doctor-after-privmsg-hook): Prefix user X-Git-Url: https://cgit.sxemacs.org/?p=riece;a=commitdiff_plain;h=93cc8b9f10b1b3e74d76de99a0e1e476b1ce0a11 * 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. --- diff --git a/lisp/COMPILE b/lisp/COMPILE index 17a0332..866cc44 100644 --- a/lisp/COMPILE +++ b/lisp/COMPILE @@ -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))) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b4795bd..1d176cd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2004-05-20 Daiki Ueno + + * 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 * riece-400.el (riece-handle-read-string): Append "Quit" to prompt diff --git a/lisp/Makefile.am b/lisp/Makefile.am index 2753735..430a291 100644 --- a/lisp/Makefile.am +++ b/lisp/Makefile.am @@ -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 diff --git a/lisp/riece-doctor.el b/lisp/riece-doctor.el index bd9ef47..7de1c11 100644 --- a/lisp/riece-doctor.el +++ b/lisp/riece-doctor.el @@ -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) @@ -84,14 +85,18 @@ (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 @@ -105,7 +110,9 @@ (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 index 0000000..8811e09 --- /dev/null +++ b/lisp/riece-hangman.el @@ -0,0 +1,209 @@ +;;; riece-hangman.el --- hangman +;; Copyright (C) 1998-2004 Daiki Ueno + +;; Author: Daiki Ueno +;; 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