[aisleriot] Define new hint functions and deprecate (get-name).
- From: Vincent Povirk <vpovirk src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [aisleriot] Define new hint functions and deprecate (get-name).
- Date: Wed, 28 Sep 2011 09:14:08 +0000 (UTC)
commit 6a94bec9fa0527f543339d5609d8056a8f4fe88f
Author: Vincent Povirk <madewokherd gmail com>
Date: Wed Sep 28 04:07:55 2011 -0500
Define new hint functions and deprecate (get-name).
See bug 569936.
The inner workings of (hint-move) and (hint-click) may change in the future,
but its usage will not. The idea is that if we need to change it for i18n
reasons, or we want to show the hints visually instead of as text, we can do
that by modifying those functions instead of every game.
games/Rules.HOWTO | 4 +-
games/klondike.scm | 19 ++++++-----
games/sol.scm | 87 +++++++++++++++++++++++++++++++++++++++++++++++++++-
3 files changed, 99 insertions(+), 11 deletions(-)
---
diff --git a/games/Rules.HOWTO b/games/Rules.HOWTO
index ece4335..4aa9458 100644
--- a/games/Rules.HOWTO
+++ b/games/Rules.HOWTO
@@ -201,7 +201,7 @@ I'll deal with (new-game) later.
(game-continuable) Asks if the game is not stuck (and therefore not lost).
-(get-hint) is called when the user requests a hint. The return from hint is in the form of a list. It seems to be used in two ways. (get-name a-card) is a very useful library function.
+(get-hint) is called when the user requests a hint. It should be created like (list 0 (_"Hint string.")), or (hint-move from-slot card-count to-slot).
Method 0:
(list 0 "A single sentence.") Perhaps something like _"Deal the next row".
@@ -359,7 +359,7 @@ Quite a few are self explanatory:
(check-alternating-color-list card-list)
(check-straight-descending-list card-list)
(length card-list)
-(get-name card) ; card description as a string
+(hint-move from-slot card-count to-slot) ; creates a hint for moving cards
(set-cards! slot-id card-list) ; puts card-list into the slot "slot-id"
(make-card value suit) ; turn a value and a suit into a card
diff --git a/games/klondike.scm b/games/klondike.scm
index fdffb4a..64724f9 100644
--- a/games/klondike.scm
+++ b/games/klondike.scm
@@ -174,6 +174,7 @@
; Global variables used in searching (keeping it simple):
+(define build '())
(define card #f)
(define color 0)
(define suit 0)
@@ -184,28 +185,29 @@
(and (not (empty-slot? slot-id2))
(= suit (get-suit (get-top-card slot-id2)))
(= value (get-value (get-top-card slot-id2)))
- (list 1 (get-name (get-top-card slot-id2)) (get-name card))))
+ (hint-move slot-id2 1 slot-id1)))
(define (ploppable? slot-id)
(and (not (empty-slot? slot-id))
(set! card (get-top-card slot-id))
(set! suit (get-suit card))
(set! value (+ (get-value card) 1))
+ (set! slot-id1 slot-id)
(or-map match? (cons waste tableau))))
(define (is-ace? slot-id)
(and (not (empty-slot? slot-id))
(= ace (get-value (get-top-card slot-id)))
- (list 2 (get-name (get-top-card slot-id)) (_"an empty slot" ))))
+ (hint-move slot-id 1 (find-empty-slot foundation))))
(define (shiftable? slot-id2)
(and (not (= slot-id2 slot-id1))
(if (empty-slot? slot-id2)
(and (= value king)
- (list 2 (get-name card) (_"an empty slot")))
+ (hint-move slot-id1 (length build) slot-id2))
(and (= (get-value (get-top-card slot-id2)) (+ 1 value))
(not (= (get-color (get-top-card slot-id2)) color))
- (list 1 (get-name card) (get-name (get-top-card slot-id2)))))))
+ (hint-move slot-id1 (length build) slot-id2)))))
(define (get-top-build card-list acc)
(if (or (null? card-list)
@@ -221,7 +223,8 @@
(define (shiftable-iter slot-id)
(and (not (empty-slot? slot-id))
(begin
- (set! card (car (get-top-build (get-cards slot-id) '())))
+ (set! build (get-top-build (get-cards slot-id) '()))
+ (set! card (car build))
(set! color (get-color card))
(set! value (get-value card))
(set! slot-id1 slot-id)
@@ -232,10 +235,10 @@
(define (addable? slot-id)
(if (empty-slot? slot-id)
(and (= (get-value card) king)
- (list 2 (get-name card) (_"an empty slot" )))
+ (hint-move waste 1 slot-id))
(and (= (get-value (get-top-card slot-id)) (+ 1 (get-value card)))
(not (= (get-color (get-top-card slot-id)) (get-color card)))
- (list 1 (get-name card) (get-name (get-top-card slot-id))))))
+ (hint-move waste 1 slot-id))))
(define (any-slot-nonempty? slots)
(if (eq? slots '())
@@ -258,7 +261,7 @@
(< FLIP-COUNTER max-redeal))
(not (empty-slot? waste)))
(not (empty-slot? stock)))
- (list 0 (_"Deal a new card from the deck")))
+ (hint-click stock (_"Deal a new card from the deck")))
; FIXME: need to give proper hints for this case too ...
(and (not (and-map empty-slot? foundation))
(list 0 (_"Try moving cards down from the foundation")))
diff --git a/games/sol.scm b/games/sol.scm
index 3ae6fd9..0ccb915 100644
--- a/games/sol.scm
+++ b/games/sol.scm
@@ -67,7 +67,9 @@
(set! IN-GAME #f)
(set! MOVE '())
(set-statusbar-message " ")
- (set! HISTORY '()))
+ (set! HISTORY '())
+ (set! FOUNDATION-SLOTS '())
+ (set! TABLEAU-SLOTS '()))
; Use this instead of define for variables which determine the state of
; the game. i.e. anything that isn't a constant. This is so undo/redo
@@ -371,6 +373,8 @@
(if (is-black? card) (_"black joker") (_"red joker")))
(define (get-name card)
+ ; Do not use this function directly. To create a hint for moving a card or
+ ; stack of cards, use (hint-move).
(let ((value (get-value card)) (suit (get-suit card)))
(if (is-joker? card)
(get-joker-name card)
@@ -436,6 +440,82 @@
(#t (_"the unknown card"))))
(#t (_"the unknown card"))))))
+(define (hint-get-dest-format to-slot)
+ (if (empty-slot? to-slot)
+ (cond ((member to-slot FOUNDATION-SLOTS) (if (= (length FOUNDATION-SLOTS) 1) (_"Move ~a onto the foundation.") (_"Move ~a onto an empty foundation slot.")))
+ ((member to-slot TABLEAU-SLOTS) (if (= (length TABLEAU-SLOTS) 1) (_"Move ~a onto the tableau.") (_"Move ~a onto an empty tableau slot.")))
+ (else (_"Move ~a onto an empty slot.")))
+ (let* ((card (get-top-card to-slot)) (value (get-value card)) (suit (get-suit card)))
+ (cond ((is-joker? card)
+ (if (is-black? card) (_"Move ~a onto the black joker.") (_"Move ~a onto the red joker.")))
+ ((eq? suit club)
+ (cond ((eq? value ace) (_"Move ~a onto the ace of clubs."))
+ ((eq? value 2) (_"Move ~a onto the two of clubs."))
+ ((eq? value 3) (_"Move ~a onto the three of clubs."))
+ ((eq? value 4) (_"Move ~a onto the four of clubs."))
+ ((eq? value 5) (_"Move ~a onto the five of clubs."))
+ ((eq? value 6) (_"Move ~a onto the six of clubs."))
+ ((eq? value 7) (_"Move ~a onto the seven of clubs."))
+ ((eq? value 8) (_"Move ~a onto the eight of clubs."))
+ ((eq? value 9) (_"Move ~a onto the nine of clubs."))
+ ((eq? value 10) (_"Move ~a onto the ten of clubs."))
+ ((eq? value jack) (_"Move ~a onto the jack of clubs."))
+ ((eq? value queen) (_"Move ~a onto the queen of clubs."))
+ ((eq? value king) (_"Move ~a onto the king of clubs."))
+ (#t (_"Move ~a onto the unknown card."))))
+ ((eq? suit spade)
+ (cond ((eq? value ace) (_"Move ~a onto the ace of spades."))
+ ((eq? value 2) (_"Move ~a onto the two of spades."))
+ ((eq? value 3) (_"Move ~a onto the three of spades."))
+ ((eq? value 4) (_"Move ~a onto the four of spades."))
+ ((eq? value 5) (_"Move ~a onto the five of spades."))
+ ((eq? value 6) (_"Move ~a onto the six of spades."))
+ ((eq? value 7) (_"Move ~a onto the seven of spades."))
+ ((eq? value 8) (_"Move ~a onto the eight of spades."))
+ ((eq? value 9) (_"Move ~a onto the nine of spades."))
+ ((eq? value 10) (_"Move ~a onto the ten of spades."))
+ ((eq? value jack) (_"Move ~a onto the jack of spades."))
+ ((eq? value queen) (_"Move ~a onto the queen of spades."))
+ ((eq? value king) (_"Move ~a onto the king of spades."))
+ (#t (_"Move ~a onto the unknown card."))))
+ ((eq? suit heart)
+ (cond ((eq? value ace) (_"Move ~a onto the ace of hearts."))
+ ((eq? value 2) (_"Move ~a onto the two of hearts."))
+ ((eq? value 3) (_"Move ~a onto the three of hearts."))
+ ((eq? value 4) (_"Move ~a onto the four of hearts."))
+ ((eq? value 5) (_"Move ~a onto the five of hearts."))
+ ((eq? value 6) (_"Move ~a onto the six of hearts."))
+ ((eq? value 7) (_"Move ~a onto the seven of hearts."))
+ ((eq? value 8) (_"Move ~a onto the eight of hearts."))
+ ((eq? value 9) (_"Move ~a onto the nine of hearts."))
+ ((eq? value 10) (_"Move ~a onto the ten of hearts."))
+ ((eq? value jack) (_"Move ~a onto the jack of hearts."))
+ ((eq? value queen) (_"Move ~a onto the queen of hearts."))
+ ((eq? value king) (_"Move ~a onto the king of hearts."))
+ (#t (_"Move ~a onto the unknown card."))))
+ ((eq? suit diamond)
+ (cond ((eq? value ace) (_"Move ~a onto the ace of diamonds."))
+ ((eq? value 2) (_"Move ~a onto the two of diamonds."))
+ ((eq? value 3) (_"Move ~a onto the three of diamonds."))
+ ((eq? value 4) (_"Move ~a onto the four of diamonds."))
+ ((eq? value 5) (_"Move ~a onto the five of diamonds."))
+ ((eq? value 6) (_"Move ~a onto the six of diamonds."))
+ ((eq? value 7) (_"Move ~a onto the seven of diamonds."))
+ ((eq? value 8) (_"Move ~a onto the eight of diamonds."))
+ ((eq? value 9) (_"Move ~a onto the nine of diamonds."))
+ ((eq? value 10) (_"Move ~a onto the ten of diamonds."))
+ ((eq? value jack) (_"Move ~a onto the jack of diamonds."))
+ ((eq? value queen) (_"Move ~a onto the queen of diamonds."))
+ ((eq? value king) (_"Move ~a onto the king of diamonds."))
+ (#t (_"Move ~a onto the unknown card."))))
+ (#t (_"Move ~a onto the unknown card."))))))
+
+(define (hint-move from-slot from-slot-count to-slot)
+ (list 0 (format (hint-get-dest-format to-slot) (get-name (get-nth-card from-slot from-slot-count)))))
+
+(define (hint-click slot-id hint-string)
+ (list 0 hint-string))
+
(define (move-n-cards! start-slot end-slot cards)
(add-cards! end-slot cards))
@@ -491,6 +571,9 @@
(list #f deck placement (if (null? type) 'unknown (car type))))
(define (set-tag! slot)
+ (case (cadddr slot)
+ ((tableau) (set! TABLEAU-SLOTS (cons SLOTS TABLEAU-SLOTS)))
+ ((foundation) (set! FOUNDATION-SLOTS (cons SLOTS FOUNDATION-SLOTS))))
(set! SLOTS (+ 1 SLOTS))
(cons (- SLOTS 1) (cdr slot)))
@@ -527,6 +610,8 @@
(define HISTORY '())
(define FUTURE '())
(define IN-GAME #f)
+(define FOUNDATION-SLOTS '())
+(define TABLEAU-SLOTS '())
; called from C:
(define (start-game)
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
