[aisleriot] kansas: Add "move tableau to self" type hints.

[Vincent Povirk <vpovirk src gnome org>]

commit 3263cd9218da497882466c98d64b202a63338da8
Author: Vincent Povirk <madewokherd gmail com>
Date:   Tue Nov 1 21:32:09 2011 -0500

    kansas: Add "move tableau to self" type hints.
    
    These are cases where one can reveal a card in the tableau with the rank
    equal to the top card's rank (or empty a tableau pile if the bottom card's
    rank is immediately below the top card's rank) by first moving part of that
    pile to another tableau, then moving from the same pile to the same pile
    again.
    
    This also removes hints that attempt to group cards of the same suit in the
    tableau, as they are unnecessary and would combine with this new type of hint
    to create situations where the hints suggest moving a stack endlessly between
    two tableau piles.
    
    For bug 660297.

 games/kansas.scm |   32 ++++++++++++++++++++++++++++----
 1 files changed, 28 insertions(+), 4 deletions(-)
---
diff --git a/games/kansas.scm b/games/kansas.scm
index dea0509..0cb7155 100644
--- a/games/kansas.scm
+++ b/games/kansas.scm
@@ -252,20 +252,44 @@
                      (+ 1 (get-value (car card-list))))
                   (and (= (get-value card) ace)
                        (= (get-value (car card-list)) king)))
-              (or (check-a-foundation (cadr card-list) 2)
-                  (eq? (get-suit card)
-                       (get-suit (car card-list)))))
+              (or (= (length card-list) 1)
+                  (check-a-foundation (cadr card-list) 2)))
               (list 1 (get-name (car card-list)) (get-name card)))
 	(#t
 	 (check-a-tableau-list card (cdr card-list)))))
 
+(define (find-tableau-target source-slot source-card target-slot)
+  (cond ((> target-slot 9) #f)
+        ((and (not (= source-slot target-slot))
+              (not (empty-slot? target-slot))
+              (let ((target-value (get-value (get-top-card target-slot)))
+                    (source-value (get-value source-card)))
+                   (or (= target-value (+ 1 source-value))
+                       (and (= target-value ace) (= source-value king)))))
+         target-slot)
+        (#t (find-tableau-target source-slot source-card (+ target-slot 1)))))
+
+(define (check-a-tableau-list-self slot top-card card-list)
+  (cond ((null? card-list) #f)
+        ((find-tableau-target slot (car card-list) 7)
+         (and (check-a-tableau-list top-card (cdr card-list))
+              (list 1 (get-name (car card-list)) (get-name (get-top-card (find-tableau-target slot (car card-list) 7))))))
+        (#t (check-a-tableau-list-self slot top-card (cdr card-list)))))
+
+(define (check-a-tableau-self slot)
+  (if (> slot 9)
+      #f
+      (and (not (empty-slot? slot))
+           (check-a-tableau-list-self slot (get-top-card slot) (get-cards slot)))))
+
 (define (check-a-tableau slot1 slot2)
   (cond ((> slot2 9)
 	 #f)
 	((= slot2 2)
 	 (check-a-tableau slot1 6))
         ((= slot1 slot2)
-         (check-a-tableau slot1 (+ 1 slot2)))
+         (or (check-a-tableau-self slot1)
+             (check-a-tableau slot1 (+ 1 slot2))))
 	((or (= slot2 1)
 	     (= slot2 6))
 	 (or (and (not (empty-slot? slot2))