[aisleriot] bear-river: Use hint-move instead of get-name.
- From: Vincent Povirk <vpovirk src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [aisleriot] bear-river: Use hint-move instead of get-name.
- Date: Fri, 29 Jun 2012 18:06:14 +0000 (UTC)
commit 5d5024bb93eedf1f5053c1df70cd50ef33e80c03
Author: Vincent Povirk <madewokherd gmail com>
Date: Fri Jun 29 11:49:37 2012 -0500
bear-river: Use hint-move instead of get-name.
For bug 551859.
games/bear-river.scm | 54 ++++++++++++++++++++++++-------------------------
1 files changed, 26 insertions(+), 28 deletions(-)
---
diff --git a/games/bear-river.scm b/games/bear-river.scm
index 0b45834..507df3c 100644
--- a/games/bear-river.scm
+++ b/games/bear-river.scm
@@ -30,37 +30,37 @@
(shuffle-deck)
(add-blank-slot)
- (add-normal-slot DECK)
- (add-normal-slot '())
- (add-normal-slot '())
- (add-normal-slot '())
+ (add-normal-slot DECK 'foundation)
+ (add-normal-slot '() 'foundation)
+ (add-normal-slot '() 'foundation)
+ (add-normal-slot '() 'foundation)
(add-carriage-return-slot)
- (add-extended-slot '() right)
- (add-extended-slot '() right)
- (add-extended-slot '() right)
- (add-extended-slot '() right)
- (add-extended-slot '() right)
+ (add-extended-slot '() right 'tableau)
+ (add-extended-slot '() right 'tableau)
+ (add-extended-slot '() right 'tableau)
+ (add-extended-slot '() right 'tableau)
+ (add-extended-slot '() right 'tableau)
(set! HORIZPOS (+ HORIZPOS 0.18))
- (add-extended-slot '() right)
+ (add-extended-slot '() right 'tableau)
(add-carriage-return-slot)
- (add-extended-slot '() right)
- (add-extended-slot '() right)
- (add-extended-slot '() right)
- (add-extended-slot '() right)
- (add-extended-slot '() right)
+ (add-extended-slot '() right 'tableau)
+ (add-extended-slot '() right 'tableau)
+ (add-extended-slot '() right 'tableau)
+ (add-extended-slot '() right 'tableau)
+ (add-extended-slot '() right 'tableau)
(set! HORIZPOS (+ HORIZPOS 0.18))
- (add-extended-slot '() right)
+ (add-extended-slot '() right 'tableau)
(add-carriage-return-slot)
- (add-extended-slot '() right)
- (add-extended-slot '() right)
- (add-extended-slot '() right)
- (add-extended-slot '() right)
- (add-extended-slot '() right)
+ (add-extended-slot '() right 'tableau)
+ (add-extended-slot '() right 'tableau)
+ (add-extended-slot '() right 'tableau)
+ (add-extended-slot '() right 'tableau)
+ (add-extended-slot '() right 'tableau)
(set! HORIZPOS (+ HORIZPOS 0.18))
- (add-extended-slot '() right)
+ (add-extended-slot '() right 'tableau)
(add-carriage-return-slot)
(deal-to-tableau 0 tableau)
@@ -147,18 +147,16 @@
acc
(count-cards (cdr slots) (+ acc (length (get-cards (car slots)))))))
-(define (update-score)
+(define (calculate-score)
(set-score! (count-cards foundation 0)))
(define (game-won)
- (= (update-score) 52))
+ (= (calculate-score) 52))
(define (hint-slot-to-foundation from-slot to-slots)
(cond ((null? to-slots) #f)
((droppable? from-slot (list (get-top-card from-slot)) (car to-slots))
- (if (empty-slot? (car to-slots))
- (list 2 (get-name (get-top-card from-slot)) (_"an empty foundation slot"))
- (list 1 (get-name (get-top-card from-slot)) (get-name (get-top-card (car to-slots))))))
+ (hint-move from-slot 1 (car to-slots)))
(else (hint-slot-to-foundation from-slot (cdr to-slots)))))
(define (hint-to-foundation from-slots to-slots)
@@ -172,7 +170,7 @@
(cond ((null? to-slots) #f)
((empty-slot? (car to-slots)) (hint-slot-to-tableau from-slot (cdr to-slots)))
((droppable? from-slot (list (get-top-card from-slot)) (car to-slots))
- (list 1 (get-name (get-top-card from-slot)) (get-name (get-top-card (car to-slots)))))
+ (hint-move from-slot 1 (car to-slots)))
(else (hint-slot-to-tableau from-slot (cdr to-slots)))))
(define (hint-within-tableau from-slots to-slots)
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]