[aisleriot] straight_up: Use hint-move instead of get-name.
- From: Vincent Povirk <vpovirk src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [aisleriot] straight_up: Use hint-move instead of get-name.
- Date: Sun, 20 Nov 2011 04:05:40 +0000 (UTC)
commit 07bf1b05f0ee3b3fde080e1261c38f61e954ec60
Author: Vincent Povirk <madewokherd gmail com>
Date: Sat Nov 19 17:37:14 2011 -0600
straight_up: Use hint-move instead of get-name.
For bug 551859.
games/straight_up.scm | 57 ++++++++++++++++--------------------------------
1 files changed, 19 insertions(+), 38 deletions(-)
---
diff --git a/games/straight_up.scm b/games/straight_up.scm
index b5bdab4..2186985 100644
--- a/games/straight_up.scm
+++ b/games/straight_up.scm
@@ -21,27 +21,27 @@
(set! DECK (make-deck-list-ace-high 3 3 club))
(shuffle-deck)
- (add-normal-slot DECK)
- (add-normal-slot '())
+ (add-normal-slot DECK 'stock)
+ (add-normal-slot '() 'waste)
(add-blank-slot)
- (add-normal-slot (list (make-visible (make-card 2 club))))
- (add-normal-slot (list (make-visible (make-card 2 diamond))))
- (add-normal-slot (list (make-visible (make-card 2 heart))))
- (add-normal-slot (list (make-visible (make-card 2 spade))))
+ (add-normal-slot (list (make-visible (make-card 2 club))) 'foundation)
+ (add-normal-slot (list (make-visible (make-card 2 diamond))) 'foundation)
+ (add-normal-slot (list (make-visible (make-card 2 heart))) 'foundation)
+ (add-normal-slot (list (make-visible (make-card 2 spade))) 'foundation)
(add-carriage-return-slot)
- (add-normal-slot '())
+ (add-normal-slot '() 'reserve)
(add-blank-slot)
(add-blank-slot)
- (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)
(deal-cards 0 '(6 6 6 6 6 6 6 6 6 6 6 6))
(deal-cards-face-up 0 '(6 7 8 9 10))
@@ -176,8 +176,9 @@
#f)
((eq? (get-suit (get-top-card slot-id))
(get-suit (get-top-card foundation-id)))
- (= (get-value (get-top-card slot-id))
- (+ 1 (get-value (get-top-card foundation-id)))))
+ (and (= (get-value (get-top-card slot-id))
+ (+ 1 (get-value (get-top-card foundation-id))))
+ foundation-id))
(#t (check-a-foundation slot-id (+ 1 foundation-id)))))
(define (to-foundations slot-id)
@@ -187,11 +188,7 @@
(to-foundations 6))
((and (not (empty-slot? slot-id))
(check-a-foundation slot-id 2))
- (list 1
- (get-name (get-top-card slot-id))
- (get-name (make-card (- (get-value (get-top-card slot-id))
- 1)
- (get-suit (get-top-card slot-id))))))
+ (hint-move slot-id 1 (check-a-foundation slot-id 2)))
(#t
(to-foundations (+ 1 slot-id)))))
@@ -210,7 +207,7 @@
(+ 1
(get-value
(car (reverse (get-cards slot-id)))))))))
- #t)
+ t-slot)
(#t (check-a-tableau slot-id (+ 1 t-slot)))))
(define (to-tableau slot-id)
@@ -221,24 +218,8 @@
((and (not (empty-slot? slot-id))
(check-a-tableau slot-id 7))
(if (< slot-id 7)
- (list 1
- (get-name (get-top-card slot-id))
- (get-name (make-card (+ (get-value
- (get-top-card slot-id))
- 1)
- (get-suit
- (get-top-card slot-id)))))
- (list 1
- (get-name
- (car (reverse (get-cards slot-id))))
- (get-name
- (make-card (+ (get-value
- (car
- (reverse (get-cards slot-id))))
- 1)
- (get-suit
- (car
- (reverse (get-cards slot-id)))))))))
+ (hint-move slot-id 1 (check-a-tableau slot-id 7))
+ (hint-move slot-id (length (get-cards slot-id)) (check-a-tableau slot-id 7))))
(#t (to-tableau (+ 1 slot-id)))))
(define (empty-tableau? slot-id)
@@ -246,7 +227,7 @@
(> slot-id 10))
#f)
((empty-slot? slot-id)
- (list 2 (get-name (get-top-card 1)) (_"an empty tableau slot")))
+ (hint-move 1 1 slot-id))
(#t (empty-tableau? (+ 1 slot-id)))))
(define (get-hint)
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]