[aisleriot] royal_east: Use hint-move instead of get-name.
- From: Vincent Povirk <vpovirk src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [aisleriot] royal_east: Use hint-move instead of get-name.
- Date: Sun, 20 Nov 2011 04:05:00 +0000 (UTC)
commit 3978797b514b663d8081f6e1f46cbdf8c032e208
Author: Vincent Povirk <madewokherd gmail com>
Date: Sat Nov 19 12:27:25 2011 -0600
royal_east: Use hint-move instead of get-name.
For bug 551859.
games/royal_east.scm | 50 +++++++++++++++++++++++---------------------------
1 files changed, 23 insertions(+), 27 deletions(-)
---
diff --git a/games/royal_east.scm b/games/royal_east.scm
index 9f9d047..527aae4 100644
--- a/games/royal_east.scm
+++ b/games/royal_east.scm
@@ -16,39 +16,44 @@
(define BASE-VAL 0)
+(define stock 0)
+(define waste 1)
+(define foundation '(2 4 8 10))
+(define tableau '(3 5 6 7 9))
+
(define (new-game)
(initialize-playing-area)
(set-ace-low)
(make-standard-deck)
(shuffle-deck)
- (add-normal-slot DECK)
- (add-normal-slot '())
+ (add-normal-slot DECK 'stock)
+ (add-normal-slot '() 'waste)
(add-blank-slot)
- (add-normal-slot '())
- (add-normal-slot '())
- (add-normal-slot '())
+ (add-normal-slot '() 'foundation)
+ (add-normal-slot '() 'tableau)
+ (add-normal-slot '() 'foundation)
(add-carriage-return-slot)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
- (add-normal-slot '())
- (add-normal-slot '())
- (add-normal-slot '())
+ (add-normal-slot '() 'tableau)
+ (add-normal-slot '() 'tableau)
+ (add-normal-slot '() 'tableau)
(add-carriage-return-slot)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
- (add-normal-slot '())
- (add-normal-slot '())
- (add-normal-slot '())
+ (add-normal-slot '() 'foundation)
+ (add-normal-slot '() 'tableau)
+ (add-normal-slot '() 'foundation)
(deal-cards-face-up 0 '(2 3 5 6 7 9))
@@ -198,7 +203,7 @@
(+ 1 (get-value (get-top-card f-slot))))
(and (= (get-value card) ace)
(= (get-value (get-top-card f-slot)) king)))
- (get-top-card f-slot)
+ f-slot
#f))
(#t (check-a-foundation card (+ 2 f-slot)))))
@@ -211,13 +216,9 @@
(= slot-id 8))
(to-foundations? (+ 1 slot-id)))
((= BASE-VAL (get-value (get-top-card slot-id)))
- (list 2
- (get-name (get-top-card slot-id))
- (_"an empty foundation pile")))
+ (hint-move slot-id 1 (find-empty-slot foundation)))
((check-a-foundation (get-top-card slot-id) 2)
- (list 1
- (get-name (get-top-card slot-id))
- (get-name (check-a-foundation (get-top-card slot-id) 2))))
+ (hint-move slot-id 1 (check-a-foundation (get-top-card slot-id) 2)))
(#t (to-foundations? (+ 1 slot-id)))))
(define (waste-to-tableau? slot-id)
@@ -227,15 +228,12 @@
((or (= slot-id 4)
(= slot-id 8))
(waste-to-tableau? (+ 1 slot-id)))
- ((empty-slot? slot-id)
- (list 2 (get-name (get-top-card 1)) (_"an empty tableau pile")))
- ((or (and (= (get-value (get-top-card 1)) king)
+ ((or (empty-slot? slot-id)
+ (and (= (get-value (get-top-card 1)) king)
(= (get-value (get-top-card slot-id)) ace))
(= (+ 1 (get-value (get-top-card 1)))
(get-value (get-top-card slot-id))))
- (list 1
- (get-name (get-top-card 1))
- (get-name (get-top-card slot-id))))
+ (hint-move waste 1 slot-id))
(#t (waste-to-tableau? (+ 1 slot-id)))))
(define (check-tslot slot1 card-list slot2)
@@ -253,9 +251,7 @@
(= (+ 1 (get-value (car card-list)))
(get-value (get-top-card slot2))))
(check-tslot slot1 (cdr card-list) 3))
- (list 1
- (get-name (get-top-card slot1))
- (get-name (get-top-card slot2))))
+ (hint-move slot1 1 slot2))
(#t (check-tslot slot1 card-list (+ 1 slot2)))))
(define (tableau-movement? slot-id)
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]