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



commit a6c81d5041439548a7ea6e6c83c554c3f2f00d2d
Author: Vincent Povirk <madewokherd gmail com>
Date:   Fri Jun 29 17:33:08 2012 -0500

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

 games/canfield.scm |   47 ++++++++++++++++++++++-------------------------
 1 files changed, 22 insertions(+), 25 deletions(-)
---
diff --git a/games/canfield.scm b/games/canfield.scm
index 2a80ec7..a188bdd 100644
--- a/games/canfield.scm
+++ b/games/canfield.scm
@@ -23,22 +23,22 @@
   (make-standard-deck)
   (shuffle-deck)
 
-  (add-normal-slot DECK)         ; first row
-  (add-partially-extended-slot '() right 3)
+  (add-normal-slot DECK 'stock)         ; first row
+  (add-partially-extended-slot '() right 3 'waste)
   (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-normal-slot '())               ; second row
+  (add-normal-slot '() 'reserve)               ; second row
   (add-blank-slot)
   (add-blank-slot)
-  (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)
 
   (deal-cards 0 '(6 6 6 6 6 6 6 6 6 6 6 6 6 7 8 9 10 2))
 
@@ -228,11 +228,11 @@
       (list 0 (_"Deal a new card from the deck"))
       (list 0 (_"Move waste back to stock"))))
 
-(define (move-up? card slot)
+(define (move-up? from-slot card slot)
   (or (if (empty-slot? slot)
 	  (if (= (get-value card)
 		 BASE-VAL)
-	      (list 1 (get-name card) (_"empty slot on foundation"))
+	      (hint-move from-slot 1 slot)
 	      #f)
 	  (and (= (get-suit card)
 		  (get-suit (get-top-card slot)))
@@ -240,37 +240,35 @@
 			(= (get-value (get-top-card slot)) king))
 		   (= (get-value card)
 		      (+ 1 (get-value (get-top-card slot)))))
-	       (list 2 (get-name card)
-		     (get-name (get-top-card slot)))))
+	       (hint-move from-slot 1 slot)))
       (if (< slot 5)
-	  (move-up? card (+ 1 slot))
+	  (move-up? from-slot card (+ 1 slot))
 	  #f)))
 
 (define (get-valid-move check-list)
   (and (not (null? check-list))
        (or (and (not (empty-slot? (car check-list)))
-		(move-up? (get-top-card (car check-list)) 2))
+		(move-up? (car check-list) (get-top-card (car check-list)) 2))
 	   (get-valid-move (cdr check-list)))))
 
-(define (tabled card slot)
+(define (tabled from-slot card slot)
   (or (if (empty-slot? slot)
-	  (list 1 (get-name card) (_"empty space on tableau"))
+	  (hint-move from-slot 1 slot)
 	  (and (eq? (is-black? card)
 		    (is-red? (get-top-card slot)))
 	       (or (and (= (get-value card) king)
 			(= (get-value (get-top-card slot)) ace))
 		   (= (get-value card)
 		      (- (get-value (get-top-card slot)) 1)))
-	       (list 2 (get-name card)
-		     (get-name (get-top-card slot)))))
+	       (hint-move from-slot 1 slot)))
       (if (< slot 10)
-	  (tabled card (+ 1 slot))
+	  (tabled from-slot card (+ 1 slot))
 	  #f)))
 
 (define (to-tableau? check-list)
   (and (not (null? check-list))
        (or (and (not (empty-slot? (car check-list)))
-		(tabled (get-top-card (car check-list)) 7))
+		(tabled (car check-list) (get-top-card (car check-list)) 7))
 	   (to-tableau? (cdr check-list)))))
 
 (define (col-check card start-slot check-slot)
@@ -286,8 +284,7 @@
 			 (= (get-value (get-top-card check-slot)) ace))
 		    (= (get-value card)
 		       (- (get-value (get-top-card check-slot)) 1)))
-		(list 2 (get-name card)
-		      (get-name (get-top-card check-slot)))))
+		(hint-move start-slot (length (get-cards start-slot)) check-slot)))
        (col-check card start-slot (+ 1 check-slot)))))
 
 (define (move-column? check-list)



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