[aisleriot] canfield: Use hint-move instead of get-name.
- From: Vincent Povirk <vpovirk src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [aisleriot] canfield: Use hint-move instead of get-name.
- Date: Sat, 30 Jun 2012 00:34:25 +0000 (UTC)
commit a6c81d5041439548a7ea6e6c83c554c3f2f00d2d
Author: Vincent Povirk <madewokherd gmail com>
Date: Fri Jun 29 17:33:08 2012 -0500
canfield: Use hint-move instead of get-name.
For bug 551859.
games/canfield.scm | 47 ++++++++++++++++++++++-------------------------
1 files changed, 22 insertions(+), 25 deletions(-)
---
diff --git a/games/canfield.scm b/games/canfield.scm
index 2a80ec7..a188bdd 100644
--- a/games/canfield.scm
+++ b/games/canfield.scm
@@ -23,22 +23,22 @@
(make-standard-deck)
(shuffle-deck)
- (add-normal-slot DECK) ; first row
- (add-partially-extended-slot '() right 3)
+ (add-normal-slot DECK 'stock) ; first row
+ (add-partially-extended-slot '() right 3 'waste)
(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-normal-slot '()) ; second row
+ (add-normal-slot '() 'reserve) ; second row
(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 6 7 8 9 10 2))
@@ -228,11 +228,11 @@
(list 0 (_"Deal a new card from the deck"))
(list 0 (_"Move waste back to stock"))))
-(define (move-up? card slot)
+(define (move-up? from-slot card slot)
(or (if (empty-slot? slot)
(if (= (get-value card)
BASE-VAL)
- (list 1 (get-name card) (_"empty slot on foundation"))
+ (hint-move from-slot 1 slot)
#f)
(and (= (get-suit card)
(get-suit (get-top-card slot)))
@@ -240,37 +240,35 @@
(= (get-value (get-top-card slot)) king))
(= (get-value card)
(+ 1 (get-value (get-top-card slot)))))
- (list 2 (get-name card)
- (get-name (get-top-card slot)))))
+ (hint-move from-slot 1 slot)))
(if (< slot 5)
- (move-up? card (+ 1 slot))
+ (move-up? from-slot card (+ 1 slot))
#f)))
(define (get-valid-move check-list)
(and (not (null? check-list))
(or (and (not (empty-slot? (car check-list)))
- (move-up? (get-top-card (car check-list)) 2))
+ (move-up? (car check-list) (get-top-card (car check-list)) 2))
(get-valid-move (cdr check-list)))))
-(define (tabled card slot)
+(define (tabled from-slot card slot)
(or (if (empty-slot? slot)
- (list 1 (get-name card) (_"empty space on tableau"))
+ (hint-move from-slot 1 slot)
(and (eq? (is-black? card)
(is-red? (get-top-card slot)))
(or (and (= (get-value card) king)
(= (get-value (get-top-card slot)) ace))
(= (get-value card)
(- (get-value (get-top-card slot)) 1)))
- (list 2 (get-name card)
- (get-name (get-top-card slot)))))
+ (hint-move from-slot 1 slot)))
(if (< slot 10)
- (tabled card (+ 1 slot))
+ (tabled from-slot card (+ 1 slot))
#f)))
(define (to-tableau? check-list)
(and (not (null? check-list))
(or (and (not (empty-slot? (car check-list)))
- (tabled (get-top-card (car check-list)) 7))
+ (tabled (car check-list) (get-top-card (car check-list)) 7))
(to-tableau? (cdr check-list)))))
(define (col-check card start-slot check-slot)
@@ -286,8 +284,7 @@
(= (get-value (get-top-card check-slot)) ace))
(= (get-value card)
(- (get-value (get-top-card check-slot)) 1)))
- (list 2 (get-name card)
- (get-name (get-top-card check-slot)))))
+ (hint-move start-slot (length (get-cards start-slot)) check-slot)))
(col-check card start-slot (+ 1 check-slot)))))
(define (move-column? check-list)
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]