cgit.sxemacs.org Git - riece/blob - lisp/riece-hangman.el

   1 ;;; riece-hangman.el --- allow channel members to play the hangman game -*- lexical-binding: t -*-
   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., 51 Franklin Street, Fifth Floor,
  22 ;; Boston, MA 02110-1301, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; NOTE: This is an add-on module for Riece.
  27
  28 ;;; Code:
  29
  30 (require 'riece-globals)
  31 (require 'riece-identity)
  32 (require 'riece-message)
  33 (require 'riece-server)
  34
  35 (defgroup riece-hangman nil
  36   "Allow channel members to play the hangman game."
  37   :prefix "riece-"
  38   :group 'riece)
  39
  40 (defcustom riece-hangman-hello-regexp "^,hangman$"
  41   "Pattern of string to start the game."
  42   :type 'string
  43   :group 'riece-hangman)
  44
  45 (defcustom riece-hangman-bye-regexp "^,hangman bye$"
  46   "Pattern of string to end the game."
  47   :type 'string
  48   :group 'riece-hangman)
  49
  50 (defcustom riece-hangman-words-file "/usr/share/dict/words"
  51   "Location of words file."
  52   :type 'file
  53   :group 'riece-hangman)
  54
  55 (defvar riece-hangman-player-context-alist nil)
  56 (defvar riece-hangman-words-buffer nil)
  57
  58 (defconst riece-hangman-description
  59   "Allow channel members to play the hangman game.")
  60
  61 (put 'riece-hangman 'riece-addon-default-disabled t)
  62
  63 (defun riece-hangman-make-context (word)
  64   "Make an instance of player context object.
  65 This function is for internal use only."
  66   (vector word nil 0))
  67
  68 (defun riece-hangman-context-word (context)
  69   "Return the correct word of CONTEXT.
  70 This function is for internal use only."
  71   (aref context 0))
  72
  73 (defun riece-hangman-context-guessed (context)
  74   "Return the guessed letters in this CONTEXT.
  75 This function is for internal use only."
  76   (aref context 1))
  77
  78 (defun riece-hangman-context-missed-count (context)
  79   "Return the count of missed guesses in this CONTEXT.
  80 This function is for internal use only."
  81   (aref context 2))
  82
  83 (defun riece-hangman-context-set-guessed (context guessed)
  84   "Set the GUESSED letters in this CONTEXT.
  85 This function is for internal use only."
  86   (aset context 1 guessed))
  87
  88 (defun riece-hangman-context-set-missed-count (context missed-count)
  89   "Set the count of MISSED guesses in this CONTEXT.
  90 This function is for internal use only."
  91   (aset context 2 missed-count))
  92
  93 (defun riece-hangman-word ()
  94   "Return random word.
  95 The wordlist is read from `riece-hangman-words-file'."
  96   (unless (and riece-hangman-words-buffer
  97                (buffer-name riece-hangman-words-buffer))
  98     (setq riece-hangman-words-buffer (generate-new-buffer " *riece-hangman*"))
  99     (with-current-buffer riece-hangman-words-buffer
 100       (buffer-disable-undo)
 101       (insert-file-contents riece-hangman-words-file)
 102       (let ((case-fold-search nil))
 103         (delete-non-matching-lines "^[a-z][a-z][a-z][a-z][a-z][a-z]+"))))
 104   (with-current-buffer riece-hangman-words-buffer
 105     (goto-char (1+ (random (buffer-size))))
 106     (if (eobp)
 107         (beginning-of-line -1)
 108       (beginning-of-line))
 109     (buffer-substring (point) (progn (end-of-line) (point)))))
 110
 111 (defun riece-hangman-reply (target string)
 112   (riece-display-message
 113    (riece-make-message (riece-make-identity riece-real-nickname
 114                                             riece-server-name)
 115                        (riece-make-identity target riece-server-name)
 116                        string 'notice t))
 117   (riece-send-string (format "NOTICE %s :%s\r\n" target string)))
 118
 119 (defun riece-hangman-reply-with-context (user target context)
 120   (let ((masked-word (make-string
 121                       (length (riece-hangman-context-word context))
 122                       ?-))
 123         (guessed (copy-sequence (riece-hangman-context-guessed context)))
 124         (index 0))
 125     (while (< index (length (riece-hangman-context-word context)))
 126       (if (memq (aref (riece-hangman-context-word context) index) guessed)
 127           (aset masked-word index
 128                 (aref (riece-hangman-context-word context) index)))
 129       (setq index (1+ index)))
 130     (riece-hangman-reply
 131      target
 132      (format "%s: Word: %s, Guessed: %s"
 133              user masked-word
 134              (if guessed
 135                  (apply #'string (sort guessed #'<))
 136                "")))))
 137
 138 (defun riece-hangman-after-privmsg-hook (prefix string)
 139   (if (get 'riece-hangman 'riece-addon-enabled)
 140       (let* ((user (riece-prefix-nickname prefix))
 141              (parameters (riece-split-parameters string))
 142              (targets (split-string (car parameters) ","))
 143              (message (nth 1 parameters))
 144              case-fold-search
 145              pointer word guessed index)
 146         (if (string-match riece-hangman-hello-regexp message)
 147             (if (riece-identity-assoc user riece-hangman-player-context-alist
 148                                       t)
 149                 (riece-hangman-reply
 150                  (car targets)
 151                  (format "%s: You are already playing the game." user))
 152               (let ((context (riece-hangman-make-context
 153                               (riece-hangman-word))))
 154                 (setq riece-hangman-player-context-alist
 155                       (cons (cons user context)
 156                             riece-hangman-player-context-alist))
 157                 (riece-hangman-reply-with-context user (car targets) context)))
 158           (if (string-match riece-hangman-bye-regexp message)
 159               (when (setq pointer (riece-identity-assoc
 160                                    user riece-hangman-player-context-alist t))
 161                 (setq riece-hangman-player-context-alist
 162                       (delq pointer riece-hangman-player-context-alist))
 163                 (riece-hangman-reply
 164                  (car targets)
 165                  (format "%s: Sorry, the word was \"%s\""
 166                          user
 167                          (riece-hangman-context-word (cdr pointer)))))
 168             (if (setq pointer (riece-identity-assoc
 169                                user riece-hangman-player-context-alist t))
 170                 (if (or (/= (length message) 1)
 171                         (not (string-match "[a-z]" message)))
 172                     (riece-hangman-reply
 173                      (car targets)
 174                      (format "%s: Not a valid guess: %s" user message))
 175                   (if (memq (aref message 0)
 176                             (riece-hangman-context-guessed (cdr pointer)))
 177                       (riece-hangman-reply (car targets)
 178                                            (format "%s: Already guessed '%c'"
 179                                                    user (aref message 0)))
 180                     (setq guessed (riece-hangman-context-set-guessed
 181                                    (cdr pointer)
 182                                    (cons (aref message 0)
 183                                          (riece-hangman-context-guessed
 184                                           (cdr pointer))))
 185                           word (riece-hangman-context-word (cdr pointer)))
 186                     (unless (catch 'found
 187                               (setq index 0)
 188                               (while (< index (length word))
 189                                 (if (eq (aref word index) (aref message 0))
 190                                     (throw 'found t))
 191                                 (setq index (1+ index))))
 192                       (riece-hangman-context-set-missed-count
 193                        (cdr pointer)
 194                        (1+ (riece-hangman-context-missed-count
 195                             (cdr pointer)))))
 196                     (if (>= (riece-hangman-context-missed-count (cdr pointer))
 197                             7)
 198                         (progn
 199                           (riece-hangman-reply
 200                            (car targets)
 201                            (format "%s: Sorry, the word was \"%s\""
 202                                    user
 203                                    (riece-hangman-context-word (cdr pointer))))
 204                           (setq riece-hangman-player-context-alist
 205                                 (delq pointer
 206                                       riece-hangman-player-context-alist)))
 207                       (if (catch 'missing
 208                             (setq index 0)
 209                             (while (< index (length word))
 210                               (unless (memq (aref word index) guessed)
 211                                 (throw 'missing t))
 212                               (setq index (1+ index))))
 213                           (riece-hangman-reply-with-context user (car targets)
 214                                                             (cdr pointer))
 215                         (riece-hangman-reply (car targets)
 216                                              (format "%s: You got it! (%s)"
 217                                                      user word))
 218                         (setq riece-hangman-player-context-alist
 219                               (delq
 220                                pointer
 221                                riece-hangman-player-context-alist))))))))))))
 222
 223 (defun riece-hangman-insinuate ()
 224   (add-hook 'riece-after-privmsg-hook 'riece-hangman-after-privmsg-hook))
 225
 226 (defun riece-hangman-uninstall ()
 227   (remove-hook 'riece-after-privmsg-hook 'riece-hangman-after-privmsg-hook))
 228
 229 (defun riece-hangman-enable ()
 230   (random t))
 231
 232 (provide 'riece-hangman)
 233
 234 ;;; riece-hangman.el ends here