[aisleriot] seahaven: Use hint-move instead of get-name.
- From: Vincent Povirk <vpovirk src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [aisleriot] seahaven: Use hint-move instead of get-name.
- Date: Sun, 5 May 2013 22:13:00 +0000 (UTC)
commit 40558d5f52486c9f485c1959f52f2ad1bd92927e
Author: Vincent Povirk <madewokherd gmail com>
Date: Sun May 5 13:21:52 2013 -0500
seahaven: Use hint-move instead of get-name.
games/seahaven.scm | 69 +++++++++++++++++++++++++--------------------------
1 files changed, 34 insertions(+), 35 deletions(-)
---
diff --git a/games/seahaven.scm b/games/seahaven.scm
index c1a697a..71eca85 100644
--- a/games/seahaven.scm
+++ b/games/seahaven.scm
@@ -28,33 +28,33 @@
(make-standard-deck)
(shuffle-deck)
- (add-normal-slot DECK)
- (add-normal-slot '())
+ (add-normal-slot DECK 'foundation)
+ (add-normal-slot '() 'foundation)
(add-blank-slot)
- (add-normal-slot '())
- (add-normal-slot '())
- (add-normal-slot '())
- (add-normal-slot '())
+ (add-normal-slot '() 'reserve)
+ (add-normal-slot '() 'reserve)
+ (add-normal-slot '() 'reserve)
+ (add-normal-slot '() 'reserve)
(add-blank-slot)
- (add-normal-slot '())
- (add-normal-slot '())
+ (add-normal-slot '() 'foundation)
+ (add-normal-slot '() 'foundation)
(add-carriage-return-slot)
- (add-extended-slot '() down)
- (add-extended-slot '() down)
- (add-extended-slot '() down)
- (add-extended-slot '() down)
- (add-extended-slot '() down)
- (add-extended-slot '() down)
- (add-extended-slot '() down)
- (add-extended-slot '() down)
- (add-extended-slot '() down)
- (add-extended-slot '() down)
+ (add-extended-slot '() down 'tableau)
+ (add-extended-slot '() down 'tableau)
+ (add-extended-slot '() down 'tableau)
+ (add-extended-slot '() down 'tableau)
+ (add-extended-slot '() down 'tableau)
+ (add-extended-slot '() down 'tableau)
+ (add-extended-slot '() down 'tableau)
+ (add-extended-slot '() down 'tableau)
+ (add-extended-slot '() down 'tableau)
+ (add-extended-slot '() down 'tableau)
(deal-cards-face-up 0 '(8 9 10 11 12 13 14 15 16 17 8 9 10 11 12 13
14 15 16 17 8 9 10 11 12 13 14 15 16 17 8
@@ -242,23 +242,23 @@
(= f-slot 8))
(check-to-foundations? (+ 1 slot) 0))
((= (get-value (get-top-card slot)) ace)
- (list 2 (get-name (get-top-card slot)) (_"an empty foundation")))
+ (hint-move slot 1 (find-empty-slot foundation)))
((and (not (empty-slot? f-slot))
(= (get-suit (get-top-card slot))
(get-suit (get-top-card f-slot)))
(= (get-value (get-top-card slot))
(+ 1 (get-value (get-top-card f-slot)))))
- (list 1 (get-name (get-top-card slot)) (get-name (get-top-card f-slot))))
+ (hint-move slot 1 f-slot))
(#t (check-to-foundations? slot (+ 1 f-slot)))))
-(define (check-for-king card-list iter slot)
+(define (check-for-king card-list iter slot to-slot)
(cond ((= (length card-list) 0)
#f)
((and (= (length card-list) 1)
(> slot 7))
#f)
((= (get-value (car card-list)) king)
- (get-name (car card-list)))
+ (hint-move slot (- (+ 1 (length (get-cards slot))) (length card-list)) to-slot))
((= iter 0)
#f)
((and (> (length card-list)1)
@@ -266,14 +266,14 @@
(get-suit (cadr card-list)))
(= (+ 1 (get-value (car card-list)))
(get-value (cadr card-list))))
- (check-for-king (cdr card-list) (- iter 1) slot))
+ (check-for-king (cdr card-list) (- iter 1) slot to-slot))
(#t #f)))
-(define (check-for-spec-card card-list iter value)
+(define (check-for-spec-card card-list iter value slot cards to-slot)
(cond ((= (length card-list) 0)
#f)
((= (get-value (car card-list)) value)
- #t)
+ (hint-move slot cards to-slot))
((= iter 0)
#f)
((and (> (length card-list) 1)
@@ -281,7 +281,7 @@
(get-suit (cadr card-list)))
(= (+ 1 (get-value (car card-list)))
(get-value (cadr card-list))))
- (check-for-spec-card (cdr card-list) (- iter 1) value))
+ (check-for-spec-card (cdr card-list) (- iter 1) value slot (+ 1 cards) to-slot))
(#t #f)))
(define (check-to-tableau? slot t-slot)
@@ -294,21 +294,20 @@
(check-to-tableau? (+ 1 slot) 8))
((and (not (= slot t-slot))
(empty-slot? t-slot)
- (check-for-king (get-cards slot) free-reserves slot))
- (list 2
- (check-for-king (get-cards slot) free-reserves slot)
- (_"an empty tableau")))
+ (check-for-king (get-cards slot) free-reserves slot t-slot))
+ (check-for-king (get-cards slot) free-reserves slot t-slot))
((and (not (= slot t-slot))
(not (empty-slot? t-slot))
(= (get-suit (get-top-card slot))
(get-suit (get-top-card t-slot)))
(check-for-spec-card (get-cards slot)
free-reserves
- (- (get-value (get-top-card t-slot)) 1)))
- (list 1
- (get-name (make-card (- (get-value (get-top-card t-slot)) 1)
- (get-suit (get-top-card t-slot))))
- (get-name (get-top-card t-slot))))
+ (- (get-value (get-top-card t-slot)) 1)
+ slot 1 t-slot))
+ (check-for-spec-card (get-cards slot)
+ free-reserves
+ (- (get-value (get-top-card t-slot)) 1)
+ slot 1 t-slot))
(#t (check-to-tableau? slot (+ 1 t-slot)))))
(define (check-for-empty-reserve)
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]