[gnome-games] aisleriot: implement dealable feature in Carpet

[Vincent Povirk <vpovirk src gnome org>]

commit b644dcd24331d30a939195456da295bf1579cc5f
Author: Vincent Povirk <madewokherd gmail com>
Date:   Sun Jun 14 22:40:27 2009 -0500

    aisleriot: implement dealable feature in Carpet
    
    bug #445955

 aisleriot/TODO             |    2 +-
 aisleriot/rules/carpet.scm |   12 +++++++++---
 2 files changed, 10 insertions(+), 4 deletions(-)
---
diff --git a/aisleriot/TODO b/aisleriot/TODO
index b489c55..7e2348e 100644
--- a/aisleriot/TODO
+++ b/aisleriot/TODO
@@ -29,7 +29,7 @@ block_ten                   NOT NEEDED
 bristol                     DONE
 camelot                     DONE
 canfield                    DONE
-carpet
+carpet                      DONE
 chessboard                  NOT NEEDED
 clock                       NOT NEEDED
 cover                       NOT NEEDED
diff --git a/aisleriot/rules/carpet.scm b/aisleriot/rules/carpet.scm
index 86732f7..df25f86 100644
--- a/aisleriot/rules/carpet.scm
+++ b/aisleriot/rules/carpet.scm
@@ -129,9 +129,15 @@
        (= (get-suit (car card-list)) (get-suit (get-top-card end-slot)))
        (= (get-value (car card-list)) (+ 1 (get-value (get-top-card end-slot))))))
 
+(define (dealable?)
+  (flippable? stock waste 0))
+
+(define (do-deal-next-cards)
+  (flip-stock stock waste 0 1))
+
 (define (button-clicked start-slot)
   (and (= start-slot stock)
-       (flip-stock stock waste 0 1)))
+       (do-deal-next-cards)))
 
 (define (play-to-foundation start-slot end-slots)
   (if (or (eq? end-slots '())
@@ -192,6 +198,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?)