[aisleriot] agnes: Use hint-move instead of get-name.
- From: Vincent Povirk <vpovirk src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [aisleriot] agnes: Use hint-move instead of get-name.
- Date: Sun, 20 Nov 2011 04:05:20 +0000 (UTC)
commit f7e6f59ed4ff37a1c0c9ef6512a2aee4209dd70a
Author: Vincent Povirk <madewokherd gmail com>
Date: Sat Nov 19 16:15:11 2011 -0600
agnes: Use hint-move instead of get-name.
For bug 551859.
games/agnes.scm | 40 +++++++++++++++++++---------------------
games/sol.scm | 10 ++++++++++
2 files changed, 29 insertions(+), 21 deletions(-)
---
diff --git a/games/agnes.scm b/games/agnes.scm
index 7286027..d92893d 100644
--- a/games/agnes.scm
+++ b/games/agnes.scm
@@ -18,29 +18,33 @@
; Andersca claims that seed 1791329065 wins
(define BASE-VAL 0)
+(define stock 0)
+(define foundation '(1 2 3 4))
+(define tableau '(5 6 7 8 9 10 11))
+
(define (new-game)
(initialize-playing-area)
(set-ace-low)
(make-standard-deck)
(shuffle-deck)
- (add-normal-slot DECK)
+ (add-normal-slot DECK 'stock)
(add-blank-slot)
(add-blank-slot)
- (add-normal-slot '())
- (add-normal-slot '())
- (add-normal-slot '())
- (add-normal-slot '())
+ (add-normal-slot '() 'foundation)
+ (add-normal-slot '() 'foundation)
+ (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 '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 0 '(5 6 7 8 9 10 11 6 7 8 9 10 11 7 8 9 10 11 8 9 10 11
9 10 11 10 11 11))
@@ -217,14 +221,10 @@
((and (not (empty-slot? slot))
(= (get-value (get-top-card slot))
BASE-VAL))
- (list 2
- (get-name (get-top-card slot))
- (_"an empty foundation pile")))
+ (hint-move slot 1 (find-empty-slot foundation)))
((and (not (empty-slot? slot))
(check-dc slot 1 #t))
- (list 1
- (get-name (get-top-card slot))
- (get-name (get-top-card (check-dc slot 1 #t)))))
+ (hint-move slot 1 (check-dc slot 1 #t)))
(#t (check-to-foundation? (+ 1 slot)))))
(define (check-a-tableau card slot)
@@ -255,9 +255,7 @@
(check-to-tableau? (+ 1 slot1) 5))
((and (not (= slot1 slot2))
(check-a-tableau (strip (get-cards slot1)) slot2))
- (list 1
- (get-name (strip (get-cards slot1)))
- (get-name (get-top-card slot2))))
+ (hint-move slot1 (find-card slot1 (strip (get-cards slot1))) slot2))
(#t (check-to-tableau? slot1 (+ 1 slot2)))))
diff --git a/games/sol.scm b/games/sol.scm
index 6656a02..a1f1742 100644
--- a/games/sol.scm
+++ b/games/sol.scm
@@ -301,6 +301,16 @@
(car slots)
(find-empty-slot (cdr slots))))
+(define (find-card-helper card cards n)
+ (if (null? cards)
+ #f
+ (if (equal? (car cards) card)
+ n
+ (find-card-helper card (cdr cards) (+ n 1)))))
+
+(define (find-card slot card)
+ (find-card-helper card (get-cards slot) 1))
+
; 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)))
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]