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

[Vincent Povirk <vpovirk src gnome org>]

commit 81b60e1c462354eadc3acb97cc790b5a8f4ca1f0
Author: Vincent Povirk <madewokherd gmail com>
Date:   Thu Apr 23 23:59:17 2009 -0500

    aisleriot: implement dealable feature in Camelot
---
 aisleriot/TODO              |    2 +-
 aisleriot/rules/camelot.scm |   48 ++++++++++++++++++++++++------------------
 2 files changed, 28 insertions(+), 22 deletions(-)

diff --git a/aisleriot/TODO b/aisleriot/TODO
index 38033bf..4feacca 100644
--- a/aisleriot/TODO
+++ b/aisleriot/TODO
@@ -27,7 +27,7 @@ bakers_game                 NOT NEEDED
 beleaguered_castle          NOT NEEDED
 block_ten                   NOT NEEDED
 bristol                     DONE
-camelot
+camelot                     DONE
 canfield
 carpet
 chessboard                  NOT NEEDED
diff --git a/aisleriot/rules/camelot.scm b/aisleriot/rules/camelot.scm
index 76c1526..2669390 100644
--- a/aisleriot/rules/camelot.scm
+++ b/aisleriot/rules/camelot.scm
@@ -119,27 +119,33 @@
 	      (remove-card end-slot)
 	      (set! fill-count (- fill-count 2))))))
 
+(define (dealable?)
+  (and (empty-slot? 17)
+       (or (empty-slot? 0)
+           (empty-slot? 1)
+           (empty-slot? 2)
+           (empty-slot? 3)
+           (empty-slot? 4)
+           (empty-slot? 5)
+           (empty-slot? 6)
+           (empty-slot? 7)
+           (empty-slot? 8)
+           (empty-slot? 9)
+           (empty-slot? 10)
+           (empty-slot? 11)
+           (empty-slot? 12)
+           (empty-slot? 13)
+           (empty-slot? 14)
+           (empty-slot? 15))))
+
+(define (do-deal-next-cards)
+  (set! add-stage #t)
+  (flip-stock 16 17 0))
+
 (define (button-clicked slot-id)  
   (if (= slot-id 16)
-      (and (empty-slot? 17)
-	   (or (empty-slot? 0)
-	       (empty-slot? 1)
-	       (empty-slot? 2)
-	       (empty-slot? 3)
-	       (empty-slot? 4)
-	       (empty-slot? 5)
-	       (empty-slot? 6)
-	       (empty-slot? 7)
-	       (empty-slot? 8)
-	       (empty-slot? 9)
-	       (empty-slot? 10)
-	       (empty-slot? 11)
-	       (empty-slot? 12)
-	       (empty-slot? 13)
-	       (empty-slot? 14)
-	       (empty-slot? 15))
-	   (set! add-stage #t)
-	   (flip-stock 16 17 0))
+      (and (dealable?)
+           (do-deal-next-cards))
       (and (not add-stage)
 	   (not (empty-slot? slot-id))
 	   (is-visible? (get-top-card slot-id))
@@ -231,8 +237,8 @@
 
 (define (timeout) #f)
 
-(set-features droppable-feature scores-disabled)
+(set-features droppable-feature scores-disabled 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?)