gnome-games r7108 - in trunk/aisleriot: . rules

[chpe svn gnome org]

Author: chpe
Date: Sun Jan  6 18:37:28 2008
New Revision: 7108
URL: http://svn.gnome.org/viewvc/gnome-games?rev=7108&view=rev

Log:
2008-01-06  Christian Persch  <chpe gnome org>

	* rules/fortunes.scm:
	* rules/gaps.scm:
	* rules/maze.scm: Implement droppable feature. Bug #338466, patches by 
	Vincent	Povirk.

Modified:
   trunk/aisleriot/ChangeLog
   trunk/aisleriot/rules/fortunes.scm
   trunk/aisleriot/rules/gaps.scm
   trunk/aisleriot/rules/maze.scm

Modified: trunk/aisleriot/ChangeLog
==============================================================================
--- trunk/aisleriot/ChangeLog	(original)
+++ trunk/aisleriot/ChangeLog	Sun Jan  6 18:37:28 2008
@@ -1,3 +1,10 @@
+2008-01-06  Christian Persch  <chpe gnome org>
+
+	* rules/fortunes.scm:
+	* rules/gaps.scm:
+	* rules/maze.scm: Implement droppable feature. Bug #338466, patches by 
+	Vincent	Povirk.
+
 2007-12-21  Christian Persch  <chpe gnome org>
 
 	* rules/klondike.scm: Define any-slot-empty and any-slot-nonempty, and

Modified: trunk/aisleriot/rules/fortunes.scm
==============================================================================
--- trunk/aisleriot/rules/fortunes.scm	(original)
+++ trunk/aisleriot/rules/fortunes.scm	Sun Jan  6 18:37:28 2008
@@ -52,17 +52,16 @@
 	   (empty-slot? 4))))
 
 (define (button-released start-slot card-list end-slot)
-  (if (= end-slot start-slot)
-      (if (= 1 (length card-list))
-	  (begin
-	    (move-n-cards! start-slot end-slot card-list)
-	    (if (button-clicked start-slot)
-		#t
-		#t))
-	  #f)
-      (if (empty-slot? end-slot)
-	  (move-n-cards! start-slot end-slot card-list)
-	  #f)))
+  (if (droppable? start-slot card-list end-slot)
+      (begin
+        (move-n-cards! start-slot end-slot card-list)
+        #t)
+      #f))
+
+(define (droppable? start-slot card-list end-slot)
+  (and (member end-slot '(1 2 3 4))
+       (not (= end-slot start-slot))
+       (empty-slot? end-slot)))
 
 (define (removable? slot-id reason)
   (if (= slot-id reason)
@@ -166,4 +165,6 @@
 
 (define (timeout) #f)
 
-(set-lambda new-game button-pressed button-released button-clicked button-double-clicked game-over game-won get-hint get-options apply-options timeout)
+(set-features droppable-feature)
+
+(set-lambda new-game button-pressed button-released button-clicked button-double-clicked game-over game-won get-hint get-options apply-options timeout droppable?)

Modified: trunk/aisleriot/rules/gaps.scm
==============================================================================
--- trunk/aisleriot/rules/gaps.scm	(original)
+++ trunk/aisleriot/rules/gaps.scm	Sun Jan  6 18:37:28 2008
@@ -126,7 +126,14 @@
 )
 
 (define (button-released start-slot card-list end-slot)
+  (and (droppable? start-slot card-list end-slot)
+       (complete-transaction start-slot card-list end-slot)
+  ) 
+)
+
+(define (droppable? start-slot card-list end-slot)
   (and (empty-slot? end-slot)
+       (not (= start-slot end-slot))
        (or (and (= 0 (modulo end-slot 13)) 
                 (= 2 (get-value(car card-list)))
            )
@@ -140,8 +147,7 @@
                 )
            )               
        )
-       (complete-transaction start-slot card-list end-slot)
-  ) 
+  )
 )
 
 (define (complete-transaction start-slot card-list end-slot)
@@ -322,7 +328,9 @@
 
 (define (timeout) #f)
 
+(set-features droppable-feature)
+
 (set-lambda new-game button-pressed button-released button-clicked 
             button-double-clicked game-continuable game-won get-hint 
-            get-options apply-options timeout
+            get-options apply-options timeout droppable?
 )

Modified: trunk/aisleriot/rules/maze.scm
==============================================================================
--- trunk/aisleriot/rules/maze.scm	(original)
+++ trunk/aisleriot/rules/maze.scm	Sun Jan  6 18:37:28 2008
@@ -91,8 +91,13 @@
       (suit-next? lower higher)))
 
 (define (button-released start-slot card-list end-slot)
+  (and (droppable? start-slot card-list end-slot)
+       (add-card! end-slot (car card-list))))
+
+(define (droppable? start-slot card-list end-slot)
   (set! card (car card-list))
-  (and (empty-slot? end-slot)
+  (and (not (= start-slot end-slot))
+       (empty-slot? end-slot)
        (or (if (= end-slot 0)
 	       (= ace (get-value card))
 	       (and (not (empty-slot? (- end-slot 1)))
@@ -100,8 +105,7 @@
 	   (if (= end-slot 53)
 	       (= queen (get-value card))
 	       (and (not (empty-slot? (1+ end-slot)))
-		    (card-next? card (get-top-card (1+ end-slot))))))
-       (add-card! end-slot (car card-list))))
+		    (card-next? card (get-top-card (1+ end-slot))))))))
 
 (define (button-clicked slot-id)
   #f)
@@ -151,6 +155,8 @@
 (define (timeout) 
   #f)
 
+(set-features droppable-feature)
+
 (set-lambda new-game button-pressed button-released button-clicked
 button-double-clicked game-over game-won get-hint get-options
-apply-options timeout)
+apply-options timeout droppable?)