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



commit 40558d5f52486c9f485c1959f52f2ad1bd92927e
Author: Vincent Povirk <madewokherd gmail com>
Date:   Sun May 5 13:21:52 2013 -0500

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

 games/seahaven.scm |   69 +++++++++++++++++++++++++--------------------------
 1 files changed, 34 insertions(+), 35 deletions(-)
---
diff --git a/games/seahaven.scm b/games/seahaven.scm
index c1a697a..71eca85 100644
--- a/games/seahaven.scm
+++ b/games/seahaven.scm
@@ -28,33 +28,33 @@
   (make-standard-deck)
   (shuffle-deck)
 
-  (add-normal-slot DECK)
-  (add-normal-slot '())
+  (add-normal-slot DECK 'foundation)
+  (add-normal-slot '() 'foundation)
 
   (add-blank-slot)
 
-  (add-normal-slot '())
-  (add-normal-slot '())
-  (add-normal-slot '())
-  (add-normal-slot '())
+  (add-normal-slot '() 'reserve)
+  (add-normal-slot '() 'reserve)
+  (add-normal-slot '() 'reserve)
+  (add-normal-slot '() 'reserve)
 
   (add-blank-slot)
 
-  (add-normal-slot '())
-  (add-normal-slot '())
+  (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)
-  (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)
+  (add-extended-slot '() down 'tableau)
+  (add-extended-slot '() down 'tableau)
+  (add-extended-slot '() down 'tableau)
 
   (deal-cards-face-up 0 '(8 9 10 11 12 13 14 15 16 17 8 9 10 11 12 13
                            14 15 16 17 8 9 10 11 12 13 14 15 16 17 8
@@ -242,23 +242,23 @@
             (= f-slot 8))
         (check-to-foundations? (+ 1 slot) 0))
        ((= (get-value (get-top-card slot)) ace)
-        (list 2 (get-name (get-top-card slot)) (_"an empty foundation")))
+        (hint-move slot 1 (find-empty-slot foundation)))
        ((and (not (empty-slot? f-slot))
              (= (get-suit (get-top-card slot))
                 (get-suit (get-top-card f-slot)))
              (= (get-value (get-top-card slot))
                 (+ 1 (get-value (get-top-card f-slot)))))
-        (list 1 (get-name (get-top-card slot)) (get-name (get-top-card f-slot))))
+        (hint-move slot 1 f-slot))
        (#t (check-to-foundations? slot (+ 1 f-slot)))))
 
-(define (check-for-king card-list iter slot)
+(define (check-for-king card-list iter slot to-slot)
   (cond ((= (length card-list) 0)
         #f)
        ((and (= (length card-list) 1)
              (> slot 7))
         #f)
        ((= (get-value (car card-list)) king)
-        (get-name (car card-list)))
+        (hint-move slot (- (+ 1 (length (get-cards slot))) (length card-list)) to-slot))
        ((= iter 0)
         #f)
        ((and (> (length card-list)1)
@@ -266,14 +266,14 @@
                 (get-suit (cadr card-list)))
              (= (+ 1 (get-value (car card-list)))
                 (get-value (cadr card-list))))
-        (check-for-king (cdr card-list) (- iter 1) slot))
+        (check-for-king (cdr card-list) (- iter 1) slot to-slot))
        (#t #f)))
 
-(define (check-for-spec-card card-list iter value)
+(define (check-for-spec-card card-list iter value slot cards to-slot)
   (cond ((= (length card-list) 0)
         #f)
        ((= (get-value (car card-list)) value)
-        #t)
+        (hint-move slot cards to-slot))
        ((= iter 0)
         #f)
        ((and (> (length card-list) 1)
@@ -281,7 +281,7 @@
                 (get-suit (cadr card-list)))
              (= (+ 1 (get-value (car card-list)))
                 (get-value (cadr card-list))))
-        (check-for-spec-card (cdr card-list) (- iter 1) value))
+        (check-for-spec-card (cdr card-list) (- iter 1) value slot (+ 1 cards) to-slot))
        (#t #f)))
 
 (define (check-to-tableau? slot t-slot)
@@ -294,21 +294,20 @@
         (check-to-tableau? (+ 1 slot) 8))
        ((and (not (= slot t-slot))
              (empty-slot? t-slot)
-             (check-for-king (get-cards slot) free-reserves slot))
-        (list 2 
-              (check-for-king (get-cards slot) free-reserves slot) 
-              (_"an empty tableau")))
+             (check-for-king (get-cards slot) free-reserves slot t-slot))
+        (check-for-king (get-cards slot) free-reserves slot t-slot))
        ((and (not (= slot t-slot))
              (not (empty-slot? t-slot))
              (= (get-suit (get-top-card slot))
                 (get-suit (get-top-card t-slot)))
              (check-for-spec-card (get-cards slot) 
                                   free-reserves 
-                                  (- (get-value (get-top-card t-slot)) 1)))
-        (list 1 
-              (get-name (make-card (- (get-value (get-top-card t-slot)) 1)
-                                   (get-suit (get-top-card t-slot))))
-              (get-name (get-top-card t-slot))))
+                                  (- (get-value (get-top-card t-slot)) 1)
+                                  slot 1 t-slot))
+        (check-for-spec-card (get-cards slot) 
+                             free-reserves 
+                             (- (get-value (get-top-card t-slot)) 1)
+                             slot 1 t-slot))
        (#t (check-to-tableau? slot (+ 1 t-slot)))))
 
 (define (check-for-empty-reserve)


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