cgit.sxemacs.org Git - riece/blob - 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 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!" user))
 221                         (setq riece-hangman-player-context-alist
 222                               (delq
 223                                pointer
 224                                riece-hangman-player-context-alist))))))))))))
 225
 226 (defun riece-hangman-insinuate ()
 227   (add-hook 'riece-after-privmsg-hook 'riece-hangman-after-privmsg-hook))
 228
 229 (defun riece-hangman-enable ()
 230   (setq riece-hangman-enabled t))
 231
 232 (defun riece-hangman-disable ()
 233   (setq riece-hangman-enabled nil))
 234
 235 (provide 'riece-hangman)
 236
 237 ;;; riece-hangman.el ends here