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



commit f7e6f59ed4ff37a1c0c9ef6512a2aee4209dd70a
Author: Vincent Povirk <madewokherd gmail com>
Date:   Sat Nov 19 16:15:11 2011 -0600

    agnes: Use hint-move instead of get-name.
    
    For bug 551859.

 games/agnes.scm |   40 +++++++++++++++++++---------------------
 games/sol.scm   |   10 ++++++++++
 2 files changed, 29 insertions(+), 21 deletions(-)
---
diff --git a/games/agnes.scm b/games/agnes.scm
index 7286027..d92893d 100644
--- a/games/agnes.scm
+++ b/games/agnes.scm
@@ -18,29 +18,33 @@
 ; Andersca claims that seed 1791329065 wins
 (define BASE-VAL 0)
 
+(define stock 0)
+(define foundation '(1 2 3 4))
+(define tableau '(5 6 7 8 9 10 11))
+
 (define (new-game)
   (initialize-playing-area)
   (set-ace-low)
   (make-standard-deck)
   (shuffle-deck)
   
-  (add-normal-slot DECK)
+  (add-normal-slot DECK 'stock)
   (add-blank-slot)
   (add-blank-slot)
 
-  (add-normal-slot '())
-  (add-normal-slot '())
-  (add-normal-slot '())
-  (add-normal-slot '())
+  (add-normal-slot '() 'foundation)
+  (add-normal-slot '() 'foundation)
+  (add-normal-slot '() 'foundation)
+  (add-normal-slot '() 'foundation)
   (add-carriage-return-slot)
 
-  (add-extended-slot '() down)
-  (add-extended-slot '() down)
-  (add-extended-slot '() down)
-  (add-extended-slot '() down)
-  (add-extended-slot '() down)
-  (add-extended-slot '() down)
-  (add-extended-slot '() down)
+  (add-extended-slot '() down 'tableau)
+  (add-extended-slot '() down 'tableau)
+  (add-extended-slot '() down 'tableau)
+  (add-extended-slot '() down 'tableau)
+  (add-extended-slot '() down 'tableau)
+  (add-extended-slot '() down 'tableau)
+  (add-extended-slot '() down 'tableau)
 
   (deal-cards 0 '(5 6 7 8 9 10 11 6 7 8 9 10 11 7 8 9 10 11 8 9 10 11
 		    9 10 11 10 11 11))
@@ -217,14 +221,10 @@
 	((and (not (empty-slot? slot))
 	      (= (get-value (get-top-card slot))
 		 BASE-VAL))
-	 (list 2
-	       (get-name (get-top-card slot))
-	       (_"an empty foundation pile")))
+	 (hint-move slot 1 (find-empty-slot foundation)))
 	((and (not (empty-slot? slot))
 	      (check-dc slot 1 #t))
-	 (list 1
-	       (get-name (get-top-card slot))
-	       (get-name (get-top-card (check-dc slot 1 #t)))))
+	 (hint-move slot 1 (check-dc slot 1 #t)))
 	(#t (check-to-foundation? (+ 1 slot)))))
 
 (define (check-a-tableau card slot)
@@ -255,9 +255,7 @@
 	 (check-to-tableau? (+ 1 slot1) 5))
 	((and (not (= slot1 slot2))
 	      (check-a-tableau (strip (get-cards slot1)) slot2))
-	 (list 1 
-	       (get-name (strip (get-cards slot1)))
-	       (get-name (get-top-card slot2))))
+	 (hint-move slot1 (find-card slot1 (strip (get-cards slot1))) slot2))
 	(#t (check-to-tableau? slot1 (+ 1 slot2)))))
 
 
diff --git a/games/sol.scm b/games/sol.scm
index 6656a02..a1f1742 100644
--- a/games/sol.scm
+++ b/games/sol.scm
@@ -301,6 +301,16 @@
       (car slots)
       (find-empty-slot (cdr slots))))
 
+(define (find-card-helper card cards n)
+  (if (null? cards)
+      #f
+      (if (equal? (car cards) card)
+          n
+          (find-card-helper card (cdr cards) (+ n 1)))))
+
+(define (find-card slot card)
+  (find-card-helper card (get-cards slot) 1))
+
 ; Get the nth card from a slot. Returns #f if n is out of range.
 (define (get-nth-card slot-id n)
   (let ((cards (get-cards slot-id)))



[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]