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

[chpe svn gnome org]

Author: chpe
Date: Wed Jun 18 20:49:46 2008
New Revision: 7700
URL: http://svn.gnome.org/viewvc/gnome-games?rev=7700&view=rev

Log:
Implement dealable feature for klondike based games. Bug #445955.


Modified:
   trunk/aisleriot/rules/athena.scm
   trunk/aisleriot/rules/aunt_mary.scm
   trunk/aisleriot/rules/gold_mine.scm
   trunk/aisleriot/rules/klondike.scm
   trunk/aisleriot/rules/saratoga.scm
   trunk/aisleriot/sol.scm

Modified: trunk/aisleriot/rules/athena.scm
==============================================================================
--- trunk/aisleriot/rules/athena.scm	(original)
+++ trunk/aisleriot/rules/athena.scm	Wed Jun 18 20:49:46 2008
@@ -82,4 +82,4 @@
 (define (apply-options options)
   (set! deal-three (cadar options)))
 
-(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?)
+(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? dealable?)

Modified: trunk/aisleriot/rules/aunt_mary.scm
==============================================================================
--- trunk/aisleriot/rules/aunt_mary.scm	(original)
+++ trunk/aisleriot/rules/aunt_mary.scm	Wed Jun 18 20:49:46 2008
@@ -68,4 +68,4 @@
 (define (apply-options options) 
   #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 droppable?)
+(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? dealable?)

Modified: trunk/aisleriot/rules/gold_mine.scm
==============================================================================
--- trunk/aisleriot/rules/gold_mine.scm	(original)
+++ trunk/aisleriot/rules/gold_mine.scm	Wed Jun 18 20:49:46 2008
@@ -66,4 +66,4 @@
 
 (define (apply-options options) #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 droppable?)
+(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? dealable)

Modified: trunk/aisleriot/rules/klondike.scm
==============================================================================
--- trunk/aisleriot/rules/klondike.scm	(original)
+++ trunk/aisleriot/rules/klondike.scm	Wed Jun 18 20:49:46 2008
@@ -127,6 +127,12 @@
 			 (= (get-value (get-top-card end-slot)) 
 			    (- (get-value (car card-list)) 1))))))))
 
+(define (dealable?)
+  (flippable? stock max-redeal))
+
+(define (do-deal-next-cards)
+  (flip-stock stock waste max-redeal (if deal-three 3 1)))
+
 (define (button-clicked start-slot)
   (and (= start-slot stock)
        (flip-stock stock waste max-redeal 
@@ -279,6 +285,6 @@
 
 (define (timeout) #f)
 
-(set-features droppable-feature)
+(set-features droppable-feature dealable-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?)
+(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? dealable?)

Modified: trunk/aisleriot/rules/saratoga.scm
==============================================================================
--- trunk/aisleriot/rules/saratoga.scm	(original)
+++ trunk/aisleriot/rules/saratoga.scm	Wed Jun 18 20:49:46 2008
@@ -82,4 +82,4 @@
 (define (apply-options options)
   (set! deal-three (cadar options)))
 
-(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?)
+(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? dealable?)

Modified: trunk/aisleriot/sol.scm
==============================================================================
--- trunk/aisleriot/sol.scm	(original)
+++ trunk/aisleriot/sol.scm	Wed Jun 18 20:49:46 2008
@@ -230,6 +230,11 @@
 
 ;; Utilities
 
+(define (flippable? stock-slot flip-limit)
+  (or (not (empty-slot? stock-slot))
+      (< flip-limit 0)
+      (< FLIP-COUNTER flip-limit)))
+
 ; deal a card from the stock-slot to the waste-slot.
 ; when the stock slot is empty than the waste slot will be flipped back
 ; onto the stock unless the flip limit has been reached.