/[erbot]/erbot/erbc4.el
ViewVC logotype

Diff of /erbot/erbc4.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.34 by deego, Sat Jan 1 04:37:31 2005 UTC revision 1.35 by deego, Sat Jan 8 17:53:08 2005 UTC
# Line 1  Line 1 
1  ;;; erbc4.el --- Russian Roulette  ;;; erbc4.el --- Russian Roulette
2  ;; Time-stamp: <2004-12-31 23:24:59 deego>  ;; Time-stamp: <2005-01-08 12:52:25 deego>
3  ;; Copyright (C) 2003 Taylor Campbell  ;; Copyright (C) 2003 Taylor Campbell
4  ;; Emacs Lisp Archive entry  ;; Emacs Lisp Archive entry
5  ;; Filename: erbc4.el  ;; Filename: erbc4.el
# Line 170  to query using PROMPT, or just return t. Line 170  to query using PROMPT, or just return t.
170    
171  ;;; Real Code:  ;;; Real Code:
172    
173  (defvar erbnoc-RR-empty-bets (make-hash-table))  (defvar erbn-RR-empty-bets (make-hash-table))
174  (defvar erbnoc-RR-bullet-bets (make-hash-table))  (defvar erbn-RR-bullet-bets (make-hash-table))
175  (defvar erbnoc-money (make-hash-table))  (defvar erbn-money (make-hash-table))
176    
177  (defun erbnoc-move-money (nick table1 table2 amount)  (defun erbn-move-money (nick table1 table2 amount)
178    (let ((cell1 (gethash nick table1))    (let ((cell1 (gethash nick table1))
179          (cell2 (gethash nick table2)))          (cell2 (gethash nick table2)))
180      (if cell1      (if cell1
# Line 187  to query using PROMPT, or just return t. Line 187  to query using PROMPT, or just return t.
187  (defun fs-bet (&rest args)  (defun fs-bet (&rest args)
188    (let ((nick (intern nick)))    (let ((nick (intern nick)))
189      (if (null args)      (if (null args)
190          (let ((empty-bet (gethash nick erbnoc-RR-empty-bets))          (let ((empty-bet (gethash nick erbn-RR-empty-bets))
191                (bullet-bet (gethash nick erbnoc-RR-bullet-bets)))                (bullet-bet (gethash nick erbn-RR-bullet-bets)))
192            (cond (empty-bet            (cond (empty-bet
193                   (format "%s has bet %d on there being no bullet."                   (format "%s has bet %d on there being no bullet."
194                           nick empty-bet))                           nick empty-bet))
# Line 202  to query using PROMPT, or just return t. Line 202  to query using PROMPT, or just return t.
202               (_ (if (< how-much 0)               (_ (if (< how-much 0)
203                      (error "You can't bet negative amounts, moron.")))                      (error "You can't bet negative amounts, moron.")))
204               (table (case on-what               (table (case on-what
205                        ((empty no-bullet click) erbnoc-RR-empty-bets)                        ((empty no-bullet click) erbn-RR-empty-bets)
206                        ((bullet bang blam) erbnoc-RR-bullet-bets)                        ((bullet bang blam) erbn-RR-bullet-bets)
207                        (t (error "invalid bet type" on-what))))                        (t (error "invalid bet type" on-what))))
208               (not-table (if (eq table erbnoc-RR-bullet-bets)               (not-table (if (eq table erbn-RR-bullet-bets)
209                              erbnoc-RR-empty-bets                              erbn-RR-empty-bets
210                            erbnoc-RR-bullet-bets)))                            erbn-RR-bullet-bets)))
211          (cond ((gethash nick not-table)          (cond ((gethash nick not-table)
212                 (format "%s: Idiot, you can can only bet on one outcome."                 (format "%s: Idiot, you can can only bet on one outcome."
213                         nick on-what))                         nick on-what))
214                ((< (or (gethash nick erbnoc-money) 0) how-much)                ((< (or (gethash nick erbn-money) 0) how-much)
215                 (format "%s: Fool, you can't bet more than you've got (%d)."                 (format "%s: Fool, you can't bet more than you've got (%d)."
216                         nick (or (gethash nick erbnoc-money) 0)))                         nick (or (gethash nick erbn-money) 0)))
217                (t (erbnoc-move-money nick erbnoc-money table how-much)                (t (erbn-move-money nick erbn-money table how-much)
218                   (format "%s has bet %d GEMs so far on a %s."                   (format "%s has bet %d GEMs so far on a %s."
219                           nick                           nick
220                           (gethash nick table)                           (gethash nick table)
# Line 224  to query using PROMPT, or just return t. Line 224  to query using PROMPT, or just return t.
224    (let* ((to-whom (if (symbolp arg1) arg1 arg2))    (let* ((to-whom (if (symbolp arg1) arg1 arg2))
225           (how-much (if (numberp arg2) arg2 arg1))           (how-much (if (numberp arg2) arg2 arg1))
226           (nick (intern nick))           (nick (intern nick))
227           (money (gethash nick erbnoc-money)))           (money (gethash nick erbn-money)))
228      (if (equal nick to-whom)      (if (equal nick to-whom)
229          (error "You can't lend money to yourself, knave!"))          (error "You can't lend money to yourself, knave!"))
230      (if (> how-much money)      (if (> how-much money)
231          (error "You can't lend more than you have" nick how-much))          (error "You can't lend more than you have" nick how-much))
232      (if (< how-much 0)      (if (< how-much 0)
233          (error "You can't lend negative amounts."))          (error "You can't lend negative amounts."))
234      (decf (gethash nick erbnoc-money) how-much)      (decf (gethash nick erbn-money) how-much)
235      (if (gethash to-whom erbnoc-money)      (if (gethash to-whom erbn-money)
236          (incf (gethash to-whom erbnoc-money) how-much)          (incf (gethash to-whom erbn-money) how-much)
237        (setf (gethash to-whom erbnoc-money) how-much))        (setf (gethash to-whom erbn-money) how-much))
238      (format "%s has lent %d GEMs to %s; %s now has %d GEMs and %s %d."      (format "%s has lent %d GEMs to %s; %s now has %d GEMs and %s %d."
239              nick              nick
240              how-much              how-much
241              to-whom              to-whom
242    
243              nick              nick
244              (gethash nick erbnoc-money)              (gethash nick erbn-money)
245    
246              to-whom              to-whom
247              (gethash to-whom erbnoc-money))))              (gethash to-whom erbn-money))))
248    
249  (defun erbnoc-keyshash (hash-table)  (defun erbn-keyshash (hash-table)
250    (let ((keys nil))    (let ((keys nil))
251      (maphash (lambda (key val) (push key keys)) hash-table)      (maphash (lambda (key val) (push key keys)) hash-table)
252      keys))      keys))
253    
254  (defun erbnoc-valueshash (hash-table)  (defun erbn-valueshash (hash-table)
255    (let ((values nil))    (let ((values nil))
256      (maphash (lambda (key val) (push val values)) hash-table)      (maphash (lambda (key val) (push val values)) hash-table)
257      values))      values))
258    
259  (defun erbnoc-all-money (nick)  (defun erbn-all-money (nick)
260    (let ((amount    (let ((amount
261           (apply #'+           (apply #'+
262                  (mapcar (lambda (table)                  (mapcar (lambda (table)
263                            (or (gethash nick table) 0))                            (or (gethash nick table) 0))
264                          (list erbnoc-money                          (list erbn-money
265                                erbnoc-RR-bullet-bets                                erbn-RR-bullet-bets
266                                erbnoc-RR-empty-bets)))))                                erbn-RR-empty-bets)))))
267      (mapc (lambda (table)      (mapc (lambda (table)
268              (remhash nick table))              (remhash nick table))
269            (list erbnoc-money            (list erbn-money
270                  erbnoc-RR-bullet-bets                  erbn-RR-bullet-bets
271                  erbnoc-RR-empty-bets))                  erbn-RR-empty-bets))
272      amount))      amount))
273    
274  (defun fs-money (&optional maybe-nick)  (defun fs-money (&optional maybe-nick)
# Line 277  to query using PROMPT, or just return t. Line 277  to query using PROMPT, or just return t.
277                                    maybe-nick                                    maybe-nick
278                                  (intern maybe-nick)))                                  (intern maybe-nick)))
279                           (intern nick)))                           (intern nick)))
280           (amount (or (gethash local-nick erbnoc-money) 0)))           (amount (or (gethash local-nick erbn-money) 0)))
281      (if maybe-nick      (if maybe-nick
282          (format "%s has %d GEMs."          (format "%s has %d GEMs."
283                  local-nick                  local-nick
# Line 286  to query using PROMPT, or just return t. Line 286  to query using PROMPT, or just return t.
286                amount                amount
287                nick))))                nick))))
288    
289  (defun erbnoc-percent (m n)  (defun erbn-percent (m n)
290    (/ (* (float m) 100.0) (float n)))    (/ (* (float m) 100.0) (float n)))
291    
292  (defun erbnoc-unpercent (m n)  (defun erbn-unpercent (m n)
293    (/ (* (float m) (float n)) 100.0))    (/ (* (float m) (float n)) 100.0))
294    
295    
296  (defun erbnoc-distribute (maybe-dead-nick winning-table losing-table)  (defun erbn-distribute (maybe-dead-nick winning-table losing-table)
297    (prog1 (cond ((and (= (hash-table-count winning-table) 0)    (prog1 (cond ((and (= (hash-table-count winning-table) 0)
298                       (not maybe-dead-nick))                       (not maybe-dead-nick))
299                  ;; Give the losers their money back.                  ;; Give the losers their money back.
300                  (maphash (lambda (nick amount)                  (maphash (lambda (nick amount)
301                             (incf (gethash nick erbnoc-money) amount))                             (incf (gethash nick erbn-money) amount))
302                           losing-table))                           losing-table))
303                 ((and (= (hash-table-count losing-table) 0)                 ((and (= (hash-table-count losing-table) 0)
304                       (not maybe-dead-nick))                       (not maybe-dead-nick))
305                  ;; Give the winners their money back.                  ;; Give the winners their money back.
306                  (maphash (lambda (nick amount)                  (maphash (lambda (nick amount)
307                             (incf (gethash nick erbnoc-money) amount))                             (incf (gethash nick erbn-money) amount))
308                           winning-table))                           winning-table))
309                 (t (let* ((winning-bets (erbnoc-valueshash winning-table))                 (t (let* ((winning-bets (erbn-valueshash winning-table))
310                           (total-win-bets (apply #'+ winning-bets))                           (total-win-bets (apply #'+ winning-bets))
311                           (total-money                           (total-money
312                            (apply #'+                            (apply #'+
313                                   (if maybe-dead-nick                                   (if maybe-dead-nick
314                                       (erbnoc-all-money maybe-dead-nick)                                       (erbn-all-money maybe-dead-nick)
315                                     0)                                     0)
316                                   total-win-bets                                   total-win-bets
317                                   (erbnoc-valueshash losing-table))))                                   (erbn-valueshash losing-table))))
318                      (maphash (lambda (nick amount)                      (maphash (lambda (nick amount)
319                                 (let* ((percent                                 (let* ((percent
320                                         (erbnoc-percent amount total-win-bets))                                         (erbn-percent amount total-win-bets))
321                                        (unpercent                                        (unpercent
322                                         (erbnoc-unpercent percent                                         (erbn-unpercent percent
323                                                           total-money)))                                                           total-money)))
324                                   (incf (gethash nick erbnoc-money)                                   (incf (gethash nick erbn-money)
325                                         (round unpercent))))                                         (round unpercent))))
326                               winning-table))))                               winning-table))))
327      (clrhash winning-table)      (clrhash winning-table)
328      (clrhash losing-table)))      (clrhash losing-table)))
329    
330  (defvar erbnoc-chamber (random 6))  (defvar erbn-chamber (random 6))
331    
332  ;; Someone tell Riastradh if this is a good way to do this... (the  ;; Someone tell Riastradh if this is a good way to do this... (the
333  ;; click and bang messages)  ;; click and bang messages)
334  (defvar erbnoc-rr-bangs  (defvar erbn-rr-bangs
335    (list (lambda ()    (list (lambda ()
336            (concat "/me blows " nick "'s cerebellum all over "            (concat "/me blows " nick "'s cerebellum all over "
337                    tgt "... *BANG*"))                    tgt "... *BANG*"))
# Line 347  to query using PROMPT, or just return t. Line 347  to query using PROMPT, or just return t.
347            (concat "/me offers " nick " a cold "            (concat "/me offers " nick " a cold "
348                    (fs-describe "beer-data")                    (fs-describe "beer-data")
349                    " before giving him the fatal blow... *KABLAM*"))))                    " before giving him the fatal blow... *KABLAM*"))))
350  (defvar erbnoc-rr-clicks  (defvar erbn-rr-clicks
351    (list (lambda ()    (list (lambda ()
352            (concat "/me points the gnu and " nick            (concat "/me points the gnu and " nick
353                    " trembles... *CLICK*"))                    " trembles... *CLICK*"))
# Line 363  to query using PROMPT, or just return t. Line 363  to query using PROMPT, or just return t.
363            (concat "/me raises the gnu to " nick "'s head and " nick            (concat "/me raises the gnu to " nick "'s head and " nick
364                    " trembles as the *CLICK* sounds."))))                    " trembles as the *CLICK* sounds."))))
365    
366  (defun erbnoc-rr-bang ()  (defun erbn-rr-bang ()
367    (fs-kick erbnoc-nick "*KABLAM!*  Goop from your head dribbles.")    (fs-kick erbn-nick "*KABLAM!*  Goop from your head dribbles.")
368    (funcall (fs-random-choose erbnoc-rr-bangs)))    (funcall (fs-random-choose erbn-rr-bangs)))
369    
370  (defun erbnoc-rr-click ()  (defun erbn-rr-click ()
371    (funcall (fs-random-choose erbnoc-rr-clicks)))    (funcall (fs-random-choose erbn-rr-clicks)))
372    
373  (defun fs-add-bang (&rest bangs)  (defun fs-add-bang (&rest bangs)
374    (setq erbnoc-rr-bangs    (setq erbn-rr-bangs
375          (concat bangs erbnoc-rr-bangs)))          (concat bangs erbn-rr-bangs)))
376  (defun fs-add-click (&rest clicks)  (defun fs-add-click (&rest clicks)
377    (setq erbnoc-rr-clicks    (setq erbn-rr-clicks
378          (concat clicks erbnoc-rr-clicks)))          (concat clicks erbn-rr-clicks)))
379    
380  (defun fs-russian-roulette (&rest ignored)  (defun fs-russian-roulette (&rest ignored)
381    ;; Don't let them do that, because it confuses the money distribution.    ;; Don't let them do that, because it confuses the money distribution.
382    (if (gethash (intern nick) erbnoc-RR-bullet-bets)    (if (gethash (intern nick) erbn-RR-bullet-bets)
383        (error (concat nick ": Idiot, don't bet on your own death."))        (error (concat nick ": Idiot, don't bet on your own death."))
384      (if (= erbnoc-chamber 5)      (if (= erbn-chamber 5)
385          (progn          (progn
386            (setq erbnoc-chamber (random 6))            (setq erbn-chamber (random 6))
387            (erbnoc-distribute (intern nick)            (erbn-distribute (intern nick)
388                               erbnoc-RR-bullet-bets                               erbn-RR-bullet-bets
389                               erbnoc-RR-empty-bets)                               erbn-RR-empty-bets)
390            (erbnoc-rr-bang))            (erbn-rr-bang))
391        (incf erbnoc-chamber)        (incf erbn-chamber)
392        (erbnoc-distribute nil        (erbn-distribute nil
393                           erbnoc-RR-empty-bets                           erbn-RR-empty-bets
394                           erbnoc-RR-bullet-bets)                           erbn-RR-bullet-bets)
395        (erbnoc-rr-click))))        (erbn-rr-click))))
396    
397  (defvar erbnoc-auth-bankers  (defvar erbn-auth-bankers
398    '(deego Riastradh fledermaus _sprintf))    '(deego Riastradh fledermaus _sprintf))
399    
400    
401  (defun erbnoc-add-banker (nick &rest ignored)  (defun erbn-add-banker (nick &rest ignored)
402    (add-to-list 'erbnoc-auth-bankers nick))    (add-to-list 'erbn-auth-bankers nick))
403    
404  (defun fs-auth-bankerp ()  (defun fs-auth-bankerp ()
405    (member (intern nick) erbnoc-auth-bankers))    (member (intern nick) erbn-auth-bankers))
406    
407  (defun fs-reset-money (&rest ignored)  (defun fs-reset-money (&rest ignored)
408    (if (not (fs-auth-bankerp))    (if (not (fs-auth-bankerp))
409        (error (concat nick ": You can't reset the money.")))        (error (concat nick ": You can't reset the money.")))
410    (clrhash erbnoc-money)    (clrhash erbn-money)
411    (clrhash erbnoc-RR-empty-bets)    (clrhash erbn-RR-empty-bets)
412    (clrhash erbnoc-RR-bullet-bets)    (clrhash erbn-RR-bullet-bets)
413    "Money cleared.")    "Money cleared.")
414    
415  (defun fs-init-money (init &rest nicks)  (defun fs-init-money (init &rest nicks)
# Line 419  to query using PROMPT, or just return t. Line 419  to query using PROMPT, or just return t.
419            (setf (gethash (if (stringp nick)            (setf (gethash (if (stringp nick)
420                               (intern nick)                               (intern nick)
421                               nick)                               nick)
422                           erbnoc-money)                           erbn-money)
423                  init))                  init))
424          nicks)          nicks)
425    "Money initialized.")    "Money initialized.")
426    
427  ;; (defvar erbnoc-rr-bullet (random 6))  ;; (defvar erbn-rr-bullet (random 6))
428    
429  ;; (defun fs-russian-roulette (&rest ignore)  ;; (defun fs-russian-roulette (&rest ignore)
430  ;;   (if (>= erbnoc-rr-bullet 5)  ;;   (if (>= erbn-rr-bullet 5)
431  ;;       (progn  ;;       (progn
432  ;;      (setq erbnoc-rr-bullet (random 6))  ;;      (setq erbn-rr-bullet (random 6))
433  ;;      (fs-describe "rr-bang-kick"))  ;;      (fs-describe "rr-bang-kick"))
434  ;;     (incf erbnoc-rr-bullet) (fs-describe "rr-click")))  ;;     (incf erbn-rr-bullet) (fs-describe "rr-click")))
435    
436  (defalias 'fsi-RR 'fs-russian-roulette)  (defalias 'fsi-RR 'fs-russian-roulette)
437  (defalias 'fsi-rr 'fs-russian-roulette)  (defalias 'fsi-rr 'fs-russian-roulette)

Legend:
Removed from v.1.34  
changed lines
  Added in v.1.35

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26