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 |
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 |
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)) |
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) |
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) |
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 |
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*")) |
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*")) |
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) |
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) |