[aisleriot] freecell: Use hint-move instead of get-name.

[Vincent Povirk <vpovirk src gnome org>]

commit 7a30164efd6ddfdfd3dd0dfa2fef2275093136a6
Author: Vincent Povirk <madewokherd gmail com>
Date:   Fri Jun 15 13:02:38 2012 -0500

    freecell: Use hint-move instead of get-name.

 games/api.scm      |   12 ++++++++++++
 games/freecell.scm |   13 ++++++++-----
 2 files changed, 20 insertions(+), 5 deletions(-)
---
diff --git a/games/api.scm b/games/api.scm
index 6249fb7..6abcdad 100644
--- a/games/api.scm
+++ b/games/api.scm
@@ -72,6 +72,7 @@
   (set! HISTORY '())
   (set! FOUNDATION-SLOTS '())
   (set! TABLEAU-SLOTS '())
+  (set! RESERVE-SLOTS '())
   (set! EDGE-SLOTS '())
   (set! CORNER-SLOTS '())
   (set! TOP-SLOTS '())
@@ -319,6 +320,14 @@
 (define-public (find-card slot card)
   (find-card-helper card (get-cards slot) 1))
 
+(define (find-card-slot-helper slot card)
+  (if (equal? #f (find-card slot card))
+      (find-card-slot-helper (+ 1 slot) card)
+      slot))
+
+(define-public (find-card-slot card)
+  (find-card-slot-helper 0 card))
+
 ; Get the nth card from a slot. Returns #f if n is out of range.
 (define-public (get-nth-card slot-id n)
   (let ((cards (get-cards slot-id)))
@@ -463,6 +472,7 @@
   (if (empty-slot? to-slot)
       (cond ((member to-slot FOUNDATION-SLOTS) (if (= (length FOUNDATION-SLOTS) 1) (_"Move ~a onto the foundation.") (_"Move ~a onto an empty foundation slot.")))
             ((member to-slot TABLEAU-SLOTS) (if (= (length TABLEAU-SLOTS) 1) (_"Move ~a onto the tableau.") (_"Move ~a onto an empty tableau slot.")))
+            ((member to-slot RESERVE-SLOTS) (if (= (length RESERVE-SLOTS) 1) (_"Move ~a onto the reserve.") (_"Move ~a onto an empty reserve slot.")))
             ((member to-slot EDGE-SLOTS) (_"Move ~a onto an empty edge slot."))
             ((member to-slot CORNER-SLOTS) (_"Move ~a onto an empty corner slot."))
             ((member to-slot TOP-SLOTS) (_"Move ~a onto an empty top slot."))
@@ -598,6 +608,7 @@
 (define-public (set-tag! slot)
   (case (cadddr slot)
     ((tableau) (set! TABLEAU-SLOTS (cons SLOTS TABLEAU-SLOTS)))
+    ((reserve) (set! RESERVE-SLOTS (cons SLOTS RESERVE-SLOTS)))
     ((edge) (set! EDGE-SLOTS (cons SLOTS EDGE-SLOTS)))
     ((corner) (set! CORNER-SLOTS (cons SLOTS CORNER-SLOTS)))
     ((top) (set! TOP-SLOTS (cons SLOTS TOP-SLOTS)))
@@ -646,6 +657,7 @@
 (define-public IN-GAME #f)
 (define-public FOUNDATION-SLOTS '())
 (define-public TABLEAU-SLOTS '())
+(define-public RESERVE-SLOTS '())
 (define-public EDGE-SLOTS '())
 (define-public CORNER-SLOTS '())
 (define-public TOP-SLOTS '())
diff --git a/games/freecell.scm b/games/freecell.scm
index 64970c3..3b15143 100644
--- a/games/freecell.scm
+++ b/games/freecell.scm
@@ -629,11 +629,14 @@
 	   (to-stack  (vector-ref board to-slot)))
       (if (eq? (vector-ref (cdar best-move) index-outcome) outcome-lose)
 	(list 0 (_"The game has no solution. Undo or start again."))
-	(list 1 (get-name from-card)
-	      (cond ((freecell? to-slot)  (_"an empty reserve"))
-		    ((homecell? to-slot)  (_"the foundation"))
-		    ((null? to-stack)     (_"an open tableau"))
-		    (else (get-name (car to-stack)))))))))
+	(hint-move (find-card-slot from-card) (find-card (find-card-slot from-card) from-card)
+	      (cond ((freecell? to-slot) (find-empty-slot freecells))
+		    ((homecell? to-slot)
+		     (if (equal? 0 to-stack)
+		         (find-empty-slot homecells)
+		         (find-card-slot (list to-stack (get-suit from-card) #t))))
+		    ((null? to-stack) (find-empty-slot fields))
+		    (else (find-card-slot (car to-stack)))))))))
 
 ; Returns a vector copy of the master board for use as the initial
 ; node in the search.