Adjustable AI difficulty, and fix red-on-red alternating-colour builds

* cg-core.el (cg-ai-level): new difficulty defcustom.  (cg-red-suit-p):
return a normalised boolean so two red suits compare equal by colour --
diamond and heart were wrongly treated as opposite colours, letting a red
card build on another red card in the alternating-colour games.
* cg-crapette.el (cg-crap--ai-greedy-move, cg-crap--ai-play): honour easy
/ normal / hard.
* cg-trick.el (cg-trick--run): easy plays a random legal card.
* card-games.el (card-game): clickable AI-level control.
(card-game--cycle-ai, card-games-set-ai-level): change it.
* test/card-games-tests.el: cgt-red-suit-boolean, cgt-ai-level-easy-crapette;
bind cg-ai-level in cgt-crap-ai-enabling.
* NEWS.

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
+  - On normal and hard the computer empties its reserve first (the pile
-    win), prefers loading its cards onto you, and -- new -- looks a move
+    you must clear to win) and prefers loading its cards onto you; on hard
-    ahead to rearrange the houses when doing so frees a card it could not
+    it also looks a move ahead to rearrange the houses when doing so frees
-    otherwise place.
+    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

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

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."
+  "Return t when SUIT index denotes a red suit, else nil.
-  (memq suit '(2 3)))
+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."

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."
+  "Play the AI opponent's whole turn on GAME, per `cg-ai-level'."
-  (let ((guard 0))
+  (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)
+                      (if (eq level 'easy)
-                      (cg-crap--ai-enabling-move game))))
+                          (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)

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

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))
+    (let ((cg-ai-level 'hard) (cg-crap--recording nil)) (cg-crap--ai-play g))
-    (should (null (cg-crap--reserve g 1)))))                ; it unstuck and unloaded
+    (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))))