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



commit 5d5024bb93eedf1f5053c1df70cd50ef33e80c03
Author: Vincent Povirk <madewokherd gmail com>
Date:   Fri Jun 29 11:49:37 2012 -0500

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

 games/bear-river.scm |   54 ++++++++++++++++++++++++-------------------------
 1 files changed, 26 insertions(+), 28 deletions(-)
---
diff --git a/games/bear-river.scm b/games/bear-river.scm
index 0b45834..507df3c 100644
--- a/games/bear-river.scm
+++ b/games/bear-river.scm
@@ -30,37 +30,37 @@
   (shuffle-deck)
 
   (add-blank-slot)
-  (add-normal-slot DECK)
-  (add-normal-slot '())
-  (add-normal-slot '())
-  (add-normal-slot '())
+  (add-normal-slot DECK 'foundation)
+  (add-normal-slot '() 'foundation)
+  (add-normal-slot '() 'foundation)
+  (add-normal-slot '() 'foundation)
   (add-carriage-return-slot)
 
-  (add-extended-slot '() right)
-  (add-extended-slot '() right)
-  (add-extended-slot '() right)
-  (add-extended-slot '() right)
-  (add-extended-slot '() right)
+  (add-extended-slot '() right 'tableau)
+  (add-extended-slot '() right 'tableau)
+  (add-extended-slot '() right 'tableau)
+  (add-extended-slot '() right 'tableau)
+  (add-extended-slot '() right 'tableau)
   (set! HORIZPOS (+ HORIZPOS 0.18))
-  (add-extended-slot '() right)
+  (add-extended-slot '() right 'tableau)
   (add-carriage-return-slot)
 
-  (add-extended-slot '() right)
-  (add-extended-slot '() right)
-  (add-extended-slot '() right)
-  (add-extended-slot '() right)
-  (add-extended-slot '() right)
+  (add-extended-slot '() right 'tableau)
+  (add-extended-slot '() right 'tableau)
+  (add-extended-slot '() right 'tableau)
+  (add-extended-slot '() right 'tableau)
+  (add-extended-slot '() right 'tableau)
   (set! HORIZPOS (+ HORIZPOS 0.18))
-  (add-extended-slot '() right)
+  (add-extended-slot '() right 'tableau)
   (add-carriage-return-slot)
 
-  (add-extended-slot '() right)
-  (add-extended-slot '() right)
-  (add-extended-slot '() right)
-  (add-extended-slot '() right)
-  (add-extended-slot '() right)
+  (add-extended-slot '() right 'tableau)
+  (add-extended-slot '() right 'tableau)
+  (add-extended-slot '() right 'tableau)
+  (add-extended-slot '() right 'tableau)
+  (add-extended-slot '() right 'tableau)
   (set! HORIZPOS (+ HORIZPOS 0.18))
-  (add-extended-slot '() right)
+  (add-extended-slot '() right 'tableau)
   (add-carriage-return-slot)
 
   (deal-to-tableau 0 tableau)
@@ -147,18 +147,16 @@
       acc
       (count-cards (cdr slots) (+ acc (length (get-cards (car slots)))))))
 
-(define (update-score)
+(define (calculate-score)
   (set-score! (count-cards foundation 0)))
 
 (define (game-won)
-  (= (update-score) 52))
+  (= (calculate-score) 52))
 
 (define (hint-slot-to-foundation from-slot to-slots)
   (cond ((null? to-slots) #f)
         ((droppable? from-slot (list (get-top-card from-slot)) (car to-slots))
-         (if (empty-slot? (car to-slots))
-             (list 2 (get-name (get-top-card from-slot)) (_"an empty foundation slot"))
-             (list 1 (get-name (get-top-card from-slot)) (get-name (get-top-card (car to-slots))))))
+         (hint-move from-slot 1 (car to-slots)))
         (else (hint-slot-to-foundation from-slot (cdr to-slots)))))
 
 (define (hint-to-foundation from-slots to-slots)
@@ -172,7 +170,7 @@
   (cond ((null? to-slots) #f)
         ((empty-slot? (car to-slots)) (hint-slot-to-tableau from-slot (cdr to-slots)))
         ((droppable? from-slot (list (get-top-card from-slot)) (car to-slots))
-         (list 1 (get-name (get-top-card from-slot)) (get-name (get-top-card (car to-slots)))))
+         (hint-move from-slot 1 (car to-slots)))
         (else (hint-slot-to-tableau from-slot (cdr to-slots)))))
 
 (define (hint-within-tableau from-slots to-slots)



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