gnome-games r8895 - trunk/aisleriot/rules

[vpovirk svn gnome org]

Author: vpovirk
Date: Wed Mar 25 05:15:52 2009
New Revision: 8895
URL: http://svn.gnome.org/viewvc/gnome-games?rev=8895&view=rev

Log:
aisleriot: don't add empty moves when double-clicks fail in Eagle Wing

This fixes a test failure (see bug 569936).


Modified:
   trunk/aisleriot/rules/eagle_wing.scm

Modified: trunk/aisleriot/rules/eagle_wing.scm
==============================================================================
--- trunk/aisleriot/rules/eagle_wing.scm	(original)
+++ trunk/aisleriot/rules/eagle_wing.scm	Wed Mar 25 05:15:52 2009
@@ -113,14 +113,19 @@
        (not (member slot-id '(2 3 4 5)))
        (is-visible? (car card-list))))
 
+(define (fill-tableau-slot slot)
+  (and (> slot 5)
+       (not (= slot 10))
+       (empty-slot? slot)
+       (not (empty-slot? 10))
+       (deal-cards-face-up 10 (cons slot '())))
+  #t)
+
 (define (complete-transaction start-slot card-list end-slot)
   (if (member end-slot '(2 3 4 5))
       (add-to-score! (length card-list)))
   (move-n-cards! start-slot end-slot card-list)
-  (if (and (not (= start-slot 1))
-	   (empty-slot? start-slot)
-	   (not (empty-slot? 10)))
-      (deal-cards-face-up 10 (cons start-slot '())))
+  (fill-tableau-slot start-slot)
   (give-status-message))
 
 (define (droppable? start-slot card-list end-slot)
@@ -173,21 +178,15 @@
 	       (and (> slot 10))))
       (cond ((and (= BASE-VAL (get-value (get-top-card slot))))
 	     (cond ((empty-slot? 2)
-		    (begin
-		      (deal-cards slot '(2))
-		      (add-to-score! 1)))
+	            (deal-cards slot '(2)))
 		   ((empty-slot? 3)
-		    (begin
-		      (deal-cards slot '(3))
-		      (add-to-score! 1)))
+		    (deal-cards slot '(3)))
 		   ((empty-slot? 4)
-		    (begin
-		      (deal-cards slot '(4))
-		      (add-to-score! 1)))
+		    (deal-cards slot '(4)))
 		   (#t
-		    (begin 
-		      (deal-cards slot '(5))
-		      (add-to-score! 1)))))
+		    (deal-cards slot '(5))))
+	     (add-to-score! 1)
+	     (fill-tableau-slot slot))
 	    ((and (not (empty-slot? 2))
 		  (= (get-suit (get-top-card slot))
 		     (get-suit (get-top-card 2))))
@@ -197,7 +196,8 @@
 			(+ 1 (get-value (get-top-card 2)))))
 		 (begin
 		   (deal-cards slot '(2))
-		   (add-to-score! 1))
+		   (add-to-score! 1)
+		   (fill-tableau-slot slot))
 		 #f))
 	    ((and (not (empty-slot? 3))
 		  (= (get-suit (get-top-card slot))
@@ -208,7 +208,8 @@
 			(+ 1 (get-value (get-top-card 3)))))
 		 (begin
 		   (deal-cards slot '(3))
-		   (add-to-score! 1))
+		   (add-to-score! 1)
+		   (fill-tableau-slot slot))
 		 #f))
 	    ((and (not (empty-slot? 4))
 		  (= (get-suit (get-top-card slot))
@@ -219,7 +220,8 @@
 			(+ 1 (get-value (get-top-card 4)))))
 		 (begin
 		   (deal-cards slot '(4))
-		   (add-to-score! 1))
+		   (add-to-score! 1)
+		   (fill-tableau-slot slot))
 		 #f))
 	    ((and (not (empty-slot? 5))
 		  (= (get-suit (get-top-card slot))
@@ -230,15 +232,11 @@
 			(+ 1 (get-value (get-top-card 5)))))
 		 (begin
 		   (deal-cards slot '(5))
-		   (add-to-score! 1))
+		   (add-to-score! 1)
+		   (fill-tableau-slot slot))
 		 #f))
 	    (#t #f))
-      #f)
-  (if (and (> slot 5)
-	   (not (= slot 10))
-	   (empty-slot? slot)
-	   (not (empty-slot? 10)))
-      (deal-cards-face-up 10 (cons slot '()))))
+      #f))
 
 (define (game-over)
   (and (not (game-won))