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 t)
  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-players nil)
  57 (defvar riece-hangman-words-buffer nil)
  58
  59 (defun riece-hangman-make-context (word)
  60   (vector word nil 0))
  61
  62 (defun riece-hangman-context-word (context)
  63   (aref context 0))
  64
  65 (defun riece-hangman-context-guessed (context)
  66   (aref context 1))
  67
  68 (defun riece-hangman-context-missed-count (context)
  69   (aref context 2))
  70
  71 (defun riece-hangman-context-set-word (context word)
  72   (aset context 0 word))
  73
  74 (defun riece-hangman-context-set-guessed (context guessed)
  75   (aset context 1 guessed))
  76
  77 (defun riece-hangman-context-set-missed-count (context missed-count)
  78   (aset context 2 missed-count))
  79
  80 (defun riece-hangman-word ()
  81   (unless riece-hangman-words-buffer
  82     (setq riece-hangman-words-buffer (generate-new-buffer " *riece-hangman*"))
  83     (save-excursion
  84       (set-buffer riece-hangman-words-buffer)
  85       (buffer-disable-undo)
  86       (insert-file-contents riece-hangman-words-file)
  87       (let ((case-fold-search nil))
  88         (delete-non-matching-lines "^[a-z][a-z][a-z][a-z][a-z][a-z]"))))
  89   (save-excursion
  90     (set-buffer riece-hangman-words-buffer)
  91     (goto-char (% (1+ (random)) (buffer-size)))
  92     (if (eobp)
  93         (beginning-of-line -1)
  94       (beginning-of-line))
  95     (buffer-substring (point) (progn (end-of-line) (point)))))
  96
  97 (defun riece-hangman-reply (target string)
  98   (riece-display-message
  99    (riece-make-message (riece-make-identity riece-real-nickname
 100                                             riece-server-name)
 101                        (riece-make-identity target riece-server-name)
 102                        string 'notice t))
 103   (riece-send-string (format "NOTICE %s :%s\r\n" target string)))
 104
 105 (defun riece-hangman-reply-with-context (target context)
 106   (let* ((word (riece-hangman-context-word context))
 107          (masked-word (make-string (length word) ?-))
 108          (guessed (riece-hangman-context-guessed context))
 109          (index 0))
 110     (while (< index (length word))
 111       (if (memq (aref word index) guessed)
 112           (aset masked-word index (aref word index)))
 113       (setq index (1+ index)))
 114     (riece-hangman-reply
 115      target
 116      (format "Word: %s, Guessed: %s"
 117              masked-word
 118              (apply #'string (sort (copy-sequence guessed) #'<))))))
 119
 120 (defun riece-hangman-after-privmsg-hook (prefix string)
 121   (let* ((user (riece-make-identity (riece-prefix-nickname prefix)
 122                                     riece-server-name))
 123          (parameters (riece-split-parameters string))
 124          (targets (split-string (car parameters) ","))
 125          (message (nth 1 parameters))
 126          pointer)
 127     (if (string-match riece-hangman-hello-regexp message)
 128         (if (riece-identity-assoc user riece-hangman-players)
 129             (riece-hangman-reply
 130              (car targets)
 131              (format "%s: You are already playing the game."
 132                      (riece-format-identity user t)))
 133           (let ((context (riece-hangman-make-context (riece-hangman-word))))
 134             (setq riece-hangman-players (cons (cons user context)
 135                                               riece-hangman-players))
 136             (riece-hangman-reply-with-context (car targets) context)))
 137       (if (string-match riece-hangman-bye-regexp message)
 138           (when (setq pointer (riece-identity-assoc user
 139                                                     riece-hangman-players))
 140             (setq riece-hangman-players (delq pointer riece-hangman-players))
 141             (riece-hangman-reply
 142              (car targets)
 143              (format "%s: Sorry, the word was \"%s\""
 144                      (riece-format-identity user t)
 145                      (riece-hangman-context-word (cdr pointer)))))
 146         (if (setq pointer (riece-identity-assoc user riece-hangman-players))
 147             (if (or (/= (length message) 1)
 148                     (not (string-match "[a-z]" message)))
 149                 (riece-hangman-reply
 150                  (car targets)
 151                  (format "%s: Not a valid guess: %s"
 152                          (riece-format-identity user t)
 153                          message))
 154               (if (memq (aref message 0)
 155                         (riece-hangman-context-guessed (cdr pointer)))
 156                   (riece-hangman-reply (car targets)
 157                                        (format "%s: Already guessed '%c'"
 158                                                (riece-format-identity user t)
 159                                                (aref message 0)))
 160                 (riece-hangman-context-set-guessed
 161                  (cdr pointer)
 162                  (cons (aref message 0)
 163                        (riece-hangman-context-guessed (cdr pointer))))
 164                 (let ((word (riece-hangman-context-word (cdr pointer)))
 165                       (index 0)
 166                       (char (aref message 0)))
 167                   (unless (catch 'found
 168                             (while (< index (length word))
 169                               (if (eq (aref word index) char)
 170                                   (throw 'found t))
 171                               (setq index (1+ index))))
 172                     (riece-hangman-context-set-missed-count
 173                      (cdr pointer)
 174                      (1+ (riece-hangman-context-missed-count
 175                           (cdr pointer))))))
 176                 (if (>= (riece-hangman-context-missed-count (cdr pointer)) 7)
 177                     (progn
 178                       (riece-hangman-reply
 179                        (car targets)
 180                        (format "%s: Sorry, the word was \"%s\""
 181                                (riece-format-identity user t)
 182                                (riece-hangman-context-word (cdr pointer))))
 183                       (setq riece-hangman-players
 184                             (delq pointer
 185                                   riece-hangman-players)))
 186                   (let ((word (riece-hangman-context-word (cdr pointer)))
 187                         (guessed (riece-hangman-context-guessed (cdr pointer)))
 188                         (index 0)
 189                         (char (aref message 0)))
 190                     (if (catch 'missing
 191                           (while (< index (length word))
 192                             (unless (memq (aref word index) guessed)
 193                               (throw 'missing t))
 194                             (setq index (1+ index))))
 195                         (riece-hangman-reply-with-context
 196                          (car targets) (cdr pointer))
 197                       (riece-hangman-reply
 198                        (car targets)
 199                        (format "%s: You got it!"
 200                                (riece-format-identity user t)))
 201                       (setq riece-hangman-players
 202                             (delq pointer riece-hangman-players))))))))))))
 203
 204 (defun riece-hangman-insinuate ()
 205   (add-hook 'riece-after-privmsg-hook 'riece-hangman-after-privmsg-hook))
 206
 207 (provide 'riece-hangman)
 208
 209 ;;; riece-hangman.el ends here