diff --git a/NEWS b/NEWS index 2acc2cd..e9790b4 100644 --- a/NEWS +++ b/NEWS @@ -81,11 +81,23 @@ the mouse as well as the keyboard. "Next hand" button and the hand fan. - Live multiplayer 500 over TCP (~M-x cg-bid-host~ / ~M-x cg-bid-join~). +** Adjustable computer opponents + - A new ~cg-ai-level~ (easy, normal, hard) sets how hard the computer + plays, and you can change it right from the ~M-x card-game~ menu (or + with ~M-x card-games-set-ai-level~). Russian Bank (Crapette) plays + all three levels; the trick-taking games play a random legal card on + easy. Other games ignore it for now. + ** A craftier Russian Bank (Crapette) opponent - - The computer now empties its reserve first (the pile you must clear to - win), prefers loading its cards onto you, and -- new -- looks a move - ahead to rearrange the houses when doing so frees a card it could not - otherwise place. + - On normal and hard the computer empties its reserve first (the pile + you must clear to win) and prefers loading its cards onto you; on hard + it also looks a move ahead to rearrange the houses when doing so frees + a card it could not otherwise place. Easy keeps the old simple play. + +** Bug fixes + - Alternating-colour building (the tableau solitaires and Russian Bank) + wrongly treated a diamond and a heart as opposite colours, so a red + card could be built on another red card. Both are red; fixed. ** Playtest fixes - ~q~ now returns to the ~M-x card-game~ menu from any game, instead of diff --git a/card-games.el b/card-games.el index 886cd67..9b7d654 100644 --- a/card-games.el +++ b/card-games.el @@ -134,6 +134,19 @@ "Registry of playable games. Each entry is (NAME COMMAND DESCRIPTION); `card-game' lists them.") +(defun card-game--cycle-ai (_button) + "Cycle the AI difficulty (`cg-ai-level') and refresh the chooser." + (setq cg-ai-level (pcase cg-ai-level ('easy 'normal) ('normal 'hard) (_ 'easy))) + (card-game)) + +;;;###autoload +(defun card-games-set-ai-level (level) + "Set the computer-opponent difficulty to LEVEL (easy, normal, or hard)." + (interactive + (list (intern (completing-read "AI level: " '("easy" "normal" "hard") nil t)))) + (setq cg-ai-level level) + (message "AI level: %s" level)) + (defun card-game--launch (button) "Start the game whose command is stored on BUTTON." (let ((cmd (button-get button 'card-game-command))) @@ -169,8 +182,15 @@ Press RET (or click) on a game to start it." (erase-buffer) (insert (propertize " Card Games for Emacs\n" 'face 'bold)) (insert (propertize - " Choose a game with RET or the mouse. q to quit.\n\n" + " Choose a game with RET or the mouse. q to quit.\n" 'face 'shadow)) + (insert " AI opponents: ") + (insert-text-button + (symbol-name cg-ai-level) + 'face 'link + 'help-echo "Click to change the AI difficulty (easy/normal/hard)" + 'action #'card-game--cycle-ai) + (insert (propertize " (click to cycle easy/normal/hard)\n\n" 'face 'shadow)) (dolist (g card-games-list) (insert " ") (insert-text-button diff --git a/cg-core.el b/cg-core.el index a831fe2..e5dbc43 100644 --- a/cg-core.el +++ b/cg-core.el @@ -73,6 +73,17 @@ and SPC as an action key. Takes effect the next time a game starts." (const :tag "Classic (adds hjkl, SPC)" classic)) :group 'card-games) +(defcustom cg-ai-level 'normal + "Difficulty of the computer opponents, where a game supports it. +`easy' plays a quick, simple game, `normal' plays soundly, and `hard' +thinks a little harder. Honoured by Russian Bank (Crapette) and the +trick-taking games so far; other games ignore it for now. Change it from +the `card-game' menu or with `card-games-set-ai-level'." + :type '(choice (const :tag "Easy" easy) + (const :tag "Normal" normal) + (const :tag "Hard" hard)) + :group 'card-games) + (defclass cg-game () ((name :initarg :name :initform "game" :type string :documentation "Human-readable game name.") @@ -196,8 +207,10 @@ The glyphs are taken from `cg-symbols'." "?")) (defsubst cg-red-suit-p (suit) - "Return non-nil when SUIT index denotes a red suit." - (memq suit '(2 3))) + "Return t when SUIT index denotes a red suit, else nil. +Normalised to a boolean so callers may compare two results with `eq' +\(diamonds and hearts are both red but `memq' returns different tails)." + (and (memq suit '(2 3)) t)) (defsubst cg-sister-suit (suit) "Return the other suit index of the same colour as SUIT." diff --git a/cg-crapette.el b/cg-crapette.el index e68c61e..bf52ea0 100644 --- a/cg-crapette.el +++ b/cg-crapette.el @@ -481,16 +481,34 @@ and only when the shuffle genuinely opens one, so the turn still ends." (throw 'found (cons (cons 'house i) (cons 'house j))))))))))) nil))) +(defun cg-crap--ai-greedy-move (game) + "A simple first-fit unload move -- the `easy' AI. +Empties the reserve or waste top onto the first legal spot, without the +scoring or the house-rearranging lookahead of the tougher levels." + (catch 'm + (dolist (spot (list (cons 'res 1) (cons 'was 1))) + (let ((card (cg-crap--spot-top game spot))) + (when card + (dolist (dst (list (cons 'res 0) (cons 'was 0))) + (when (cg-crap--load-accepts (cg-crap--spot-top game dst) card) + (throw 'm (cons spot dst)))) + (cl-loop for i below 8 + when (cg-crap--house-accepts game i card) + do (throw 'm (cons spot (cons 'house i))))))) + nil)) + (defun cg-crap--ai-play (game) - "Play the AI opponent's whole turn on GAME." - (let ((guard 0)) + "Play the AI opponent's whole turn on GAME, per `cg-ai-level'." + (let ((guard 0) (level cg-ai-level)) (catch 'done (while t (when (> (setq guard (1+ guard)) 800) (throw 'done nil)) (when (cg-crap--won-p game 1) (throw 'done nil)) (let ((mv (or (cg-crap--ai-found-move game) - (cg-crap--ai-unload-move game) - (cg-crap--ai-enabling-move game)))) + (if (eq level 'easy) + (cg-crap--ai-greedy-move game) + (cg-crap--ai-unload-move game)) + (and (eq level 'hard) (cg-crap--ai-enabling-move game))))) (cond (mv (cg-crap--move game (car mv) (cdr mv) 1)) ((cg-crap--hand game 1) diff --git a/cg-trick.el b/cg-trick.el index dae410b..6ef8b70 100644 --- a/cg-trick.el +++ b/cg-trick.el @@ -394,7 +394,11 @@ "Play a whole hand with AI for every seat (used by tests)." (while (not (cg-trick--hand-over-p game)) (let ((seat (cg-get game :turn))) - (cg-trick--play game seat (cg-trick--ai-play game seat)))) + (cg-trick--play game seat + (if (eq cg-ai-level 'easy) + (let ((moves (cg-trick--legal-moves game seat))) + (nth (random (length moves)) moves)) + (cg-trick--ai-play game seat))))) (cg-trick--score-hand game)) ;;;; New-game / hand lifecycle diff --git a/test/card-games-tests.el b/test/card-games-tests.el index 83bada1..92a362c 100644 --- a/test/card-games-tests.el +++ b/test/card-games-tests.el @@ -771,8 +771,8 @@ (aset (cg-get g :houses) 1 (list '(1 . 6))) ; 7C (dotimes (k 6) (aset (cg-get g :houses) (+ 2 k) (list '(2 . 6)))) ; 7D fillers, none empty (cg-put g :turn 1) - (let ((cg-crap--recording nil)) (cg-crap--ai-play g)) - (should (null (cg-crap--reserve g 1))))) ; it unstuck and unloaded + (let ((cg-ai-level 'hard) (cg-crap--recording nil)) (cg-crap--ai-play g)) + (should (null (cg-crap--reserve g 1))))) ; hard unstuck and unloaded (ert-deftest cgt-crap-ai-loads-you () ;; reserve 6D loads onto your reserve top 7D; the AI should prefer that @@ -1553,3 +1553,30 @@ (should (plist-get rg :help-close)) (should (plist-get rg :help-classic)) (should (plist-get rg :help-quit))))) + + +(ert-deftest cgt-red-suit-boolean () + "Two red suits compare equal by colour (the diamond/heart eq bug)." + (should (eq (cg-red-suit-p 2) (cg-red-suit-p 3))) ; both red -> eq + (should (eq (cg-red-suit-p 0) (cg-red-suit-p 1))) ; both black -> eq + (should-not (eq (cg-red-suit-p 2) (cg-red-suit-p 0))) ; red vs black + ;; a diamond may NOT sit on a heart in a house (both red) + (let ((g (cg-crap--deal (cg-crapette-game)))) + (aset (cg-get g :houses) 0 (list '(3 . 5))) ; 6 of hearts + (should-not (cg-crap--house-accepts g 0 '(2 . 4))) ; 5 of diamonds (both red) + (aset (cg-get g :houses) 0 (list '(0 . 5))) ; 6 of spades (black) + (should (cg-crap--house-accepts g 0 '(2 . 4))))) ; 5 of diamonds ok + +(ert-deftest cgt-ai-level-easy-crapette () + "The easy Crapette AI does not rearrange houses, so a stuck card stays." + (let ((g (cg-crap--deal (cg-crapette-game)))) + (aset (cg-get g :reserve) 1 (list '(2 . 4))) + (aset (cg-get g :waste) 1 nil) (aset (cg-get g :hand) 1 nil) + (aset (cg-get g :reserve) 0 nil) (aset (cg-get g :waste) 0 nil) + (aset (cg-get g :found) 0 nil) + (aset (cg-get g :houses) 0 (list '(0 . 5) '(3 . 5))) + (aset (cg-get g :houses) 1 (list '(1 . 6))) + (dotimes (k 6) (aset (cg-get g :houses) (+ 2 k) (list '(2 . 6)))) + (cg-put g :turn 1) + (let ((cg-ai-level 'easy) (cg-crap--recording nil)) (cg-crap--ai-play g)) + (should (cg-crap--reserve g 1))))