* trivial enhancements to poker.el
@ 2019-01-30 16:24 Jean-Christophe Helary
0 siblings, 0 replies; only message in thread
From: Jean-Christophe Helary @ 2019-01-30 16:24 UTC (permalink / raw)
To: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 368 bytes --]
1) add (l)eave code to leave the table (replaces the 'quit action that did not seem to work)
2) add visual enhancements to readability (line breaks, indentation, etc.)
3) putt the game in its own buffer, one new buffer per game
Even though that's really trivial, there are probably issues with the way I did it. Would somebody please check the modifications ?
[-- Attachment #2: poker.el.diff --]
[-- Type: application/octet-stream, Size: 16441 bytes --]
diff --git a/packages/poker/poker.el b/packages/poker/poker.el
index fbfa78c10..7ffa76090 100644
--- a/packages/poker/poker.el
+++ b/packages/poker/poker.el
@@ -518,7 +518,7 @@ The optional number of OPPONENTS defaults to 1."
(code (poker-starting-hand-name pocket)))
(unless (rassq code hands)
(accept-process-output)
- (message "%S" code)
+ (insert (message "%S\n" code))
(push (cons (poker-strength pocket nil opponents)
code)
hands)))))))))
@@ -557,7 +557,7 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
(defun poker-player-bet (player amount)
"Make PLAYER bet AMOUNT of chips."
(let ((actual (min (poker-player-stack player) amount)))
- (when (zerop actual) (message "WARNING: Actual is 0."))
+ (when (zerop actual) (insert (message "WARNING: Actual is 0.\n")))
(unless (zerop actual)
(cl-decf (cdr (assq 'stack player)) actual)
(cl-incf (cdr (assq 'wagered player)) actual))
@@ -611,11 +611,11 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
(define-key map [?c] 'call)
(define-key map [?f] 'fold)
(when (> max-raise 0) (define-key map [?r] 'raise))
- (define-key map [?q] 'quit)
+ (define-key map [?l] 'leave)
map))
(action nil))
(while (not action)
- (message (format "%s%d in pot, %d to call: (f)old%s: "
+ (insert (message (format " %s %d in pot, %d to call\n (f)old%s:\n"
(or prompt "") pot to-call
(if (> max-raise 0)
(if (zerop to-call)
@@ -623,7 +623,7 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
", (c)all or (r)aise")
(if (zerop to-call)
" or (c)heck"
- " or (c)all"))))
+ " or (c)all")))))
(setq action (lookup-key map (vector (read-event)))))
(cond
((eq action 'fold) nil)
@@ -634,14 +634,17 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
(read-number (format "Raise by (max %d): "
max-raise))))
(cl-check-type raise integer)
- raise))))))
+ raise)))
+ ((eq action 'leave) (progn
+ (insert "\nYou have left the table.")
+ (signal 'quit nil))))))
(defun poker-interactive-fcr (player pot due max-raise board opponents)
(poker-read-fold-call-raise
- pot due max-raise (format "%s%s, %d stack, "
+ pot due max-raise (format "%s%s, %d stack\n"
(mapconcat #'poker-card-name (poker-player-pocket player) ", ")
(if board
- (concat "(" (mapconcat #'poker-card-name board " ") ")")
+ (concat " (" (mapconcat #'poker-card-name board " ") ")")
"")
(poker-player-stack player))))
@@ -741,16 +744,16 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
(<= (- decision amount-to-call) max-raise))))
(cond
((null decision)
- (message (format "%s folds." (poker-player-name player)))
+ (insert (message (format "%s folds.\n" (poker-player-name player))))
(poker-player-fold player))
((zerop decision)
- (message "%s checks." (poker-player-name player)))
+ (insert (message "%s checks.\n" (poker-player-name player))))
((integerp decision)
(if (= decision amount-to-call)
- (message "%s calls %d." (poker-player-name player) decision)
+ (insert (message "%s calls %d.\n" (poker-player-name player) decision))
(cl-assert (>= decision amount-to-call))
- (message "%s raises by %d."
- (poker-player-name player) (- decision amount-to-call)))
+ (insert (message "%s raises by %d.\n"
+ (poker-player-name player) (- decision amount-to-call))))
(poker-player-bet player decision))))))
(defun poker-dealer (min-bet deck board players)
@@ -760,17 +763,17 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
;; pre-flop
((and (null board) (zerop (poker-pot players)))
(let ((blinds players))
- (message "Collecting blinds.")
- (message "%s posts %d small blind." (poker-player-name (car blinds)) (/ min-bet 2))
+ (insert (message "Collecting blinds.\n"))
+ (insert (message "%s posts %d small blind.\n" (poker-player-name (car blinds)) (/ min-bet 2)))
(poker-player-bet (car blinds) (/ min-bet 2))
- (message "%s posts %d big blind." (poker-player-name (cadr blinds)) min-bet)
+ (insert (message "%s posts %d big blind.\n" (poker-player-name (cadr blinds)) min-bet))
(poker-player-bet (cadr blinds) min-bet)
- (message "Dealing cards to players.")
+ (insert (message "Dealing cards to players.\n\nYou can always leave the table by hitting (l).\n"))
(dotimes (_ 2)
(dolist (player players) (poker-player-give-card player (pop deck))))
-
- (message "Initial betting round.")
-
+
+ (insert (message "\n* Initial betting round.\n"))
+
(dolist (player (poker-next-players (cadr blinds) players))
(unless (zerop (poker-player-stack player))
@@ -788,9 +791,9 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
((and (not (zerop (poker-pot players)))
(= (length (cl-remove-if-not #'poker-player-active-p players)) 1))
(let ((winners (cl-remove-if-not #'poker-player-active-p players)))
- (message "%s silently wins %d."
+ (insert (message "\n%s silently wins %d.\n"
(poker-player-name (car winners))
- (poker-distribute-winnings winners players))
+ (poker-distribute-winnings winners players)))
winners))
;; pre-flop, second round of bets, no raises allowed
@@ -803,7 +806,7 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
(poker-current-wager players))))
(poker-rotate-to-first (cadr players) players)))
- (message "Pre flop, second round of bets.")
+ (insert (message "\n* Pre flop, second round of bets.\n"))
(dolist (player (cl-remove-if
(lambda (player)
@@ -823,7 +826,7 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
((null board)
(dotimes (_ 3) (push (pop deck) board))
- (message "The flop: %s" (mapconcat #'poker-card-name board " "))
+ (insert (message "\n* The flop: %s\n" (mapconcat #'poker-card-name board " ")))
(dolist (player (cl-remove-if-not #'poker-player-can-bet-p players))
(when (or (> (length (cl-remove-if-not #'poker-player-can-bet-p players)) 1)
@@ -839,7 +842,7 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
(= (poker-player-wagered player)
(poker-current-wager players))))
players))
- (message "The flop, second round of bets.")
+ (insert (message "\n* The flop, second round of bets.\n"))
(dolist (player (cl-remove-if
(lambda (player)
(or (not (poker-player-can-bet-p player))
@@ -854,7 +857,7 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
((= (length board) 3)
(push (pop deck) board)
- (message "The turn: %s" (mapconcat #'poker-card-name board " "))
+ (insert (message "\n* The turn: %s\n" (mapconcat #'poker-card-name board " ")))
(setq min-bet (* min-bet 2))
@@ -872,7 +875,7 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
(= (poker-player-wagered player)
(poker-current-wager players))))
players))
- (message "The turn, second round of bets.")
+ (insert (message "\n* The turn, second round of bets.\n"))
(dolist (player (cl-remove-if
(lambda (player)
(or (not (poker-player-can-bet-p player))
@@ -886,7 +889,7 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
;; river
((= (length board) 4)
(push (pop deck) board)
- (message "The river: %s" (mapconcat #'poker-card-name board " "))
+ (insert (message "\n* The river: %s\n" (mapconcat #'poker-card-name board " ")))
(dolist (player (cl-remove-if-not #'poker-player-can-bet-p players))
(when (or (> (length (cl-remove-if-not #'poker-player-can-bet-p players)) 1)
@@ -902,7 +905,7 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
(= (poker-player-wagered player)
(poker-current-wager players))))
players))
- (message "Last betting round.")
+ (insert (message "\n* Last betting round.\n"))
(dolist (player (cl-remove-if
(lambda (player)
(or (not (poker-player-can-bet-p player))
@@ -920,13 +923,13 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
(groups ())
(game-interactive-p (poker-interactive-p players)))
(unless (> (length in-play) 1)
- (error "In-play to small: %S %S" in-play players))
+ (error "In-play too small: %S %S" in-play players))
(while in-play
(if (= (length in-play) 1)
(progn
- (message "%s wins %d."
+ (insert (message "\n%s wins %d.\n"
(poker-player-name (car in-play))
- (poker-distribute-winnings in-play players))
+ (poker-distribute-winnings in-play players)))
(when game-interactive-p (sit-for 2))
(push in-play groups)
(setq in-play nil))
@@ -942,14 +945,14 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
best-hand-value))
in-play)))
(dolist (player in-play)
- (message "%s shows %s, %s."
+ (insert (message "\n%s shows %s, %s."
(poker-player-name player)
(mapconcat #'poker-card-name (poker-player-pocket player) " ")
- (poker-describe-hand (poker-player-best-hand player board)))
+ (poker-describe-hand (poker-player-best-hand player board))))
(when game-interactive-p (sit-for 2)))
- (message "%s wins %d."
+ (insert (message "\n\n%s wins %d.\n"
(mapconcat #'poker-player-name winners ", ")
- (poker-distribute-winnings winners players))
+ (poker-distribute-winnings winners players)))
(when game-interactive-p (sit-for 2))
(push winners groups))
(setq in-play (cl-remove-if-not #'poker-player-active-p players))))
@@ -961,6 +964,7 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
;;;###autoload
(defun poker (initial-stack min-bet players)
"Play a game of texas hold 'em poker."
+ (switch-to-buffer (generate-new-buffer-name "Poker Game "))
(interactive (list (read-number "Initial stack: " 1000)
(read-number "Minimum bet: " 50)
(list (poker-make-player "Angela" #'poker-automatic-fcr)
@@ -974,8 +978,9 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
(poker-make-player "Ingrid" #'poker-automatic-fcr)
(poker-make-player (user-full-name) #'poker-interactive-fcr))))
(cl-assert (> (length players) 1))
+ (insert "-------- New Game Starting --------\n\n")
(dolist (player players)
- (message "%s receives %d chips." (poker-player-name player) initial-stack)
+ (insert (message "%s receives %d chips.\n" (poker-player-name player) initial-stack))
(setcdr (assq 'stack player) initial-stack))
(let ((game-interactive-p (poker-interactive-p players))
(button-player (nth (random (length players)) players))
@@ -985,7 +990,8 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
(while (and button-player
(or (not game-interactive-p)
(poker-interactive-p players)))
- (message "Round %d, %d players." (1+ (length rounds)) (length players))
+ (insert "\n---------------\n\n")
+ (insert (message "Round %d, %d players.\n" (1+ (length rounds)) (length players)))
(push (poker-dealer min-bet (poker-random-deck) () players)
rounds)
@@ -1001,17 +1007,17 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
(setq players (cl-remove-if
(lambda (player)
(when (member player lost)
- (message "%s drops out." (poker-player-name player))
+ (insert (message "\n%s drops out.\n" (poker-player-name player)))
t))
players))
(setq losers (nconc losers lost))))
- (message "Remaining players: %s"
- (mapconcat (lambda (player) (format "%s (%d)"
+ (insert (message "\nRemaining players:\n%s\n"
+ (mapconcat (lambda (player) (format " %s (%d)"
(poker-player-name player)
(poker-player-stack player)))
(cl-sort (append players nil)
#'> :key #'poker-player-stack)
- " "))
+ "\n")))
(when button-player
(cl-assert (member button-player players))
(let ((count (length players)))
@@ -1021,15 +1027,15 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
(accept-process-output)
(when (and game-interactive-p (not (poker-interactive-p players)))
- (message "You drop out in %s place."
+ (insert (message "\nYou drop out in %s place.\n"
(let ((rank (1+ (length players))))
(pcase rank
(2 "2nd")
(3 "3rd")
- (n (format "%dth" n)))))))
+ (n (format "%dth" n))))))))
(when (and game-interactive-p (poker-interactive-p players))
- (message "You are the winner."))
+ (insert (message "\nYou are the winner.\n")))
(cons players rounds)))
@@ -1097,5 +1103,83 @@ FCR-FN specifies a function to use when a fold-call-raise decision is required."
(* 1000 (length players))))
(setq players (cdr players)))))
+;;;; ChangeLog:
+
+;; 2019-01-31 Jean-Christophe Helary <jean.christophe.helary@gmail.com>
+;;
+;; add (l)eave code to leave the table (replaces the 'quit action)
+;;
+;; add visual enhancements to readability (line breaks, indentation, etc.)
+;;
+;; putt the game in its own buffer, one new buffer per game
+;;
+;; 2016-08-11 Mario Lang <mlang@delysid.org>
+;;
+;; [poker] Version 0.2, update copyright years and add todo
+;;
+;; 2016-08-06 Mario Lang <mlang@delysid.org>
+;;
+;; Set default number of iterations to 300
+;;
+;; Accidentally set too high in previous commit.
+;;
+;; 2016-08-06 Mario Lang <mlang@delysid.org>
+;;
+;; Add a pre-flop hand strength table and an ert test for poker-hand-value
+;;
+;; Precalculated pre-flop starting hand values with 1^6 iterations. Adjust
+;; `poker-strength' to use them when appropriate.
+;;
+;; 2016-08-05 Mario Lang <mlang@delysid.org>
+;;
+;; Improve performance of poker-hand-value by a factor of 4
+;;
+;; `cl-count' is unnecessarily expensive, as it at least uses `length' and
+;; `nthcdr' which we really don't need in this performance cricital code
+;; path. Rewriting it without `cl-count' turns up another opportunity to
+;; speed up, as we actually don't need to check the whole list to count
+;; occurances of unique elements. For one, we can start counting from 1
+;; (not 0) if we encounter the first element, and we only need to check the
+;; rest of the list of cards. Also, stop using `mapcar' with
+;; `poker-card-rank' to allow it to actually be inlined. This turns out to
+;; make poker-hand-value
+;; *a lot* faster. Mission accomplished.
+;;
+;; 2016-08-04 Mario Lang <mlang@delysid.org>
+;;
+;; Improve poker-hand-value performance by 25%
+;;
+;; Avoid unnecessary calls to poker-card-suit in flush check.
+;;
+;; 2016-08-02 Mario Lang <mlang@delysid.org>
+;;
+;; Very slightly improve performance
+;;
+;; * packages/poker/poker.el (poker-hand-value): Use `delete-dups' instead
+;; of
+;; `cl-delete-duplicates' and avoid an unnecessary call to `ash'.
+;;
+;; 2016-07-11 Paul Eggert <eggert@cs.ucla.edu>
+;;
+;; Fix some quoting problems in doc strings
+;;
+;; Most of these are minor issues involving, e.g., quoting `like this'
+;; instead of 'like this'. A few involve escaping ` and ' with a preceding
+;; \= when the characters should not be turned into curved single quotes.
+;;
+;; 2014-10-15 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; * poker/poker.el (poker-combinations, poker-possible-hands): Fix tests.
+;;
+;; 2014-06-18 Mario Lang <mlang@delysid.org>
+;;
+;; [poker] Add to the games menu.
+;;
+;; 2014-05-18 Mario Lang <mlang@delysid.org>
+;;
+;; Add new simple package poker.el.
+;;
+
+
(provide 'poker)
;;; poker.el ends here
[-- Attachment #3: Type: text/plain, Size: 124 bytes --]
Jean-Christophe Helary
-----------------------------------------------
http://mac4translators.blogspot.com @brandelune
^ permalink raw reply related [flat|nested] only message in thread
only message in thread, other threads:[~2019-01-30 16:24 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2019-01-30 16:24 trivial enhancements to poker.el Jean-Christophe Helary
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.