[aisleriot] odessa: Use hint-move instead of get-name.
- From: Vincent Povirk <vpovirk src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [aisleriot] odessa: Use hint-move instead of get-name.
- Date: Thu, 9 Aug 2012 23:19:43 +0000 (UTC)
commit 789d3c66bdc37f86397df5e3b60751ab890368f6
Author: Vincent Povirk <madewokherd gmail com>
Date: Thu Aug 9 14:04:46 2012 -0500
odessa: Use hint-move instead of get-name.
For bug 551859.
games/odessa.scm | 77 ++++++++++++++++++++++++++++-------------------------
1 files changed, 41 insertions(+), 36 deletions(-)
---
diff --git a/games/odessa.scm b/games/odessa.scm
index cc8ecde..e7ab410 100644
--- a/games/odessa.scm
+++ b/games/odessa.scm
@@ -21,26 +21,28 @@
;set up the deck
(set-ace-low)
+(define foundation '(0 8 9 10))
+(define tableau '(1 2 3 4 5 6 7))
(define (new-game)
(initialize-playing-area)
(make-standard-deck)
(shuffle-deck)
- (add-normal-slot DECK) ;Slot 0
- (add-extended-slot '() down) ;Slot 1
- (add-extended-slot '() down) ;Slot 2
- (add-extended-slot '() down) ;Slot 3
- (add-extended-slot '() down) ;Slot 4
- (add-extended-slot '() down) ;Slot 5
- (add-extended-slot '() down) ;Slot 6
- (add-extended-slot '() down) ;Slot 7
+ (add-normal-slot DECK 'foundation) ;Slot 0
+ (add-extended-slot '() down 'tableau) ;Slot 1
+ (add-extended-slot '() down 'tableau) ;Slot 2
+ (add-extended-slot '() down 'tableau) ;Slot 3
+ (add-extended-slot '() down 'tableau) ;Slot 4
+ (add-extended-slot '() down 'tableau) ;Slot 5
+ (add-extended-slot '() down 'tableau) ;Slot 6
+ (add-extended-slot '() down 'tableau) ;Slot 7
(add-carriage-return-slot)
- (add-normal-slot '()) ;Slot 8
+ (add-normal-slot '() 'foundation) ;Slot 8
(add-carriage-return-slot)
- (add-normal-slot '()) ;Slot 9
+ (add-normal-slot '() 'foundation) ;Slot 9
(add-carriage-return-slot)
- (add-normal-slot '()) ;Slot 10
+ (add-normal-slot '() 'foundation) ;Slot 10
(deal-cards 0 '(1 2 3 4 5 6 7 1 2 3 4 5 6 7 1 2 3 4 5 6 7 ))
(deal-cards-face-up 0 '(1 2 3 4 5 6 7 1 2 3 4 5 6 7 1 2 3 4 5 6 7 2 3 4 5 6 2 3 4 5 6))
@@ -175,48 +177,51 @@
(move-to-foundations? slot 0))
#f))
-(define (is-ploppable card value suit)
+(define (is-ploppable card value suit slot-id)
(or (and (= ace (get-value card))
- (list 2 (get-name card) (_"an empty slot") ))
- (and (or (and (not (empty-slot? 0))
- (= value (get-value (get-top-card 0)))
- (= suit (get-suit (get-top-card 0))))
- (and (not (empty-slot? 8))
- (= value (get-value (get-top-card 8)))
- (= suit (get-suit (get-top-card 8))))
- (and (not (empty-slot? 9))
- (= value (get-value (get-top-card 9)))
- (= suit (get-suit (get-top-card 9))))
- (and (not (empty-slot? 10))
- (= value (get-value (get-top-card 10)))
- (= suit (get-suit (get-top-card 10)))))
- (list 1 (get-name card) (get-name (make-card value suit))))))
-
-(define (is-visible-card cards card value suit)
+ (hint-move slot-id 1 (find-empty-slot foundation)))
+ (and (not (empty-slot? 0))
+ (= value (get-value (get-top-card 0)))
+ (= suit (get-suit (get-top-card 0)))
+ (hint-move slot-id 1 0))
+ (and (not (empty-slot? 8))
+ (= value (get-value (get-top-card 8)))
+ (= suit (get-suit (get-top-card 8)))
+ (hint-move slot-id 1 8))
+ (and (not (empty-slot? 9))
+ (= value (get-value (get-top-card 9)))
+ (= suit (get-suit (get-top-card 9)))
+ (hint-move slot-id 1 9))
+ (and (not (empty-slot? 10))
+ (= value (get-value (get-top-card 10)))
+ (= suit (get-suit (get-top-card 10)))
+ (hint-move slot-id 1 10))))
+
+(define (is-visible-card slot-id2 slot-id cards card value suit num-cards)
(and (not (null? cards))
(if (and (= (get-value (car cards)) value)
(= (get-suit (car cards)) suit))
(and (is-visible? (car cards))
- (list 1 (get-name (make-card value suit)) (get-name card)))
- (is-visible-card (cdr cards) card value suit))))
+ (hint-move slot-id2 num-cards slot-id))
+ (is-visible-card slot-id2 slot-id (cdr cards) card value suit (+ 1 num-cards)))))
(define (is-extendable slot-id2 slot-id card value suit)
(and (< slot-id2 8)
(or (and (not (= slot-id2 slot-id))
- (is-visible-card (get-cards slot-id2) card value suit))
+ (is-visible-card slot-id2 slot-id (get-cards slot-id2) card value suit 1))
(is-extendable (+ 1 slot-id2) slot-id card value suit))))
-(define (is-visible-king cards)
+(define (is-visible-king cards slot-id num-cards)
(and (not (null? cards))
(or (and (= (get-value (car cards)) king)
(is-visible? (car cards))
(not (null? (cdr cards)))
- (list 2 (get-name (car cards)) (_"an empty slot")))
- (is-visible-king (cdr cards)))))
+ (hint-move slot-id num-cards (find-empty-slot tableau)))
+ (is-visible-king (cdr cards) slot-id (+ 1 num-cards)))))
(define (find-king slot-id)
(and (< slot-id 8)
- (or (is-visible-king (get-cards slot-id))
+ (or (is-visible-king (get-cards slot-id) slot-id 1)
(find-king (+ 1 slot-id)))))
; Checks to see if any moves can be made in the tableau
@@ -239,7 +244,7 @@
(#t (or (let* ((card (get-top-card slot-id))
(suit (get-suit card))
(value (- (get-value card) 1)))
- (is-ploppable card value suit))
+ (is-ploppable card value suit slot-id))
(check-game-over-foundation (+ 1 slot-id) check-kings)))))
; We want to always check to see if moves can be moved among the
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]