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

[chpe svn gnome org]

Author: chpe
Date: Sun Jan  6 22:05:35 2008
New Revision: 7117
URL: http://svn.gnome.org/viewvc/gnome-games?rev=7117&view=rev

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

	* rules/klondike.scm:
	* rules/spider.scm:
	* sol.scm: Double-clicking complete stacks in Spider should move them
	to the foundation. Bug #443307, patch by Vincent Povirk.

Modified:
   trunk/aisleriot/ChangeLog
   trunk/aisleriot/rules/klondike.scm
   trunk/aisleriot/rules/spider.scm
   trunk/aisleriot/sol.scm

Modified: trunk/aisleriot/ChangeLog
==============================================================================
--- trunk/aisleriot/ChangeLog	(original)
+++ trunk/aisleriot/ChangeLog	Sun Jan  6 22:05:35 2008
@@ -1,5 +1,12 @@
 2008-01-06  Christian Persch  <chpe gnome org>
 
+	* rules/klondike.scm:
+	* rules/spider.scm:
+	* sol.scm: Double-clicking complete stacks in Spider should move them
+	to the foundation. Bug #443307, patch by Vincent Povirk.
+
+2008-01-06  Christian Persch  <chpe gnome org>
+
 	* rules/agnes.scm: Implement dealable? for agnes. Bug #445955, patch
 	by Vincent Povirk.
 

Modified: trunk/aisleriot/rules/klondike.scm
==============================================================================
--- trunk/aisleriot/rules/klondike.scm	(original)
+++ trunk/aisleriot/rules/klondike.scm	Sun Jan  6 22:05:35 2008
@@ -217,12 +217,6 @@
 	   (not (= (get-color (get-top-card slot-id)) (get-color card)))
 	   (list 1 (get-name card) (get-name (get-top-card slot-id))))))
 
-(define (any-slot-empty? slots)
-  (if (eq? slots '())
-      #f
-      (or (empty-slot? (car slots))
-          (any-slot-empty? (cdr slots)))))
-
 (define (any-slot-nonempty? slots)
   (if (eq? slots '())
       #f

Modified: trunk/aisleriot/rules/spider.scm
==============================================================================
--- trunk/aisleriot/rules/spider.scm	(original)
+++ trunk/aisleriot/rules/spider.scm	Sun Jan  6 22:05:35 2008
@@ -168,12 +168,6 @@
   (and (droppable? start-slot card-list end-slot)
        (complete-transaction start-slot card-list end-slot)))
 
-(define (any-slot-empty? slots)
-  (if (eq? slots '())
-      #f
-      (or (empty-slot? (car slots))
-          (any-slot-empty? (cdr slots)))))
-
 (define (button-clicked slot)
   (and (= stock slot)
        (not (empty-slot? stock))
@@ -187,8 +181,21 @@
 	     (give-status-message)
 	     #t))))
 
+
+(define (is-playable-stack cards n)
+  (and (not (null? cards))
+       (= (get-value (car cards)) n)
+       (is-visible? (car cards))
+       (or (= n 13)
+           (is-playable-stack (cdr cards) (+ n 1)))))
+
 (define (button-double-clicked slot)
-  #f)
+  (and (member slot tableau)
+       (is-playable-stack (get-cards slot) 1)
+       (let ((card-list (list-head (get-cards slot) 13)))
+            (remove-n-cards slot 13)
+            (complete-transaction slot card-list (find-empty-slot foundation)))
+       #t))
 
 (define (game-over)
   (and (not (game-won))

Modified: trunk/aisleriot/sol.scm
==============================================================================
--- trunk/aisleriot/sol.scm	(original)
+++ trunk/aisleriot/sol.scm	Sun Jan  6 22:05:35 2008
@@ -297,6 +297,17 @@
 (define (empty-slot? slot-id)
   (null? (get-cards slot-id)))
 
+(define (any-slot-empty? slots)
+  (if (eq? slots '())
+      #f
+      (or (empty-slot? (car slots))
+          (any-slot-empty? (cdr slots)))))
+
+(define (find-empty-slot slots)
+  (if (empty-slot? (car slots))
+      (car slots)
+      (find-empty-slot (cdr slots))))
+
 ; Get the nth card from a slot. Returns #f if n is out of range.
 (define (get-nth-card slot-id n)
   (let ((cards (get-cards slot-id)))
@@ -523,6 +534,12 @@
 (define (nthcdr n lst)
   (if (zero? n) lst (nthcdr (+ -1 n) (cdr lst))))
 
+; guile library function I'm not sure I can rely on
+(define (list-head lst k)
+  (if (= k 0)
+      '()
+      (cons (car lst) (list-head (cdr lst) (- k 1)))))
+
 ;; INTERNAL procedures
 
 ; global variables