[gnome-games] aisleriot: add Bear River game #578855
- From: Vincent Povirk <vpovirk src gnome org>
- To: svn-commits-list gnome org
- Subject: [gnome-games] aisleriot: add Bear River game #578855
- Date: Wed, 6 May 2009 19:54:04 -0400 (EDT)
commit a19ba4e21176ce435a3ff605bde5b350df16d960
Author: Vincent Povirk <madewokherd gmail com>
Date: Wed May 6 18:52:21 2009 -0500
aisleriot: add Bear River game #578855
---
aisleriot/help/C/aisleriot.xml | 2 +
aisleriot/help/C/bear_river.xml | 130 ++++++++++++++++++++
aisleriot/help/Makefile.am | 1 +
aisleriot/rules/Makefile.am | 1 +
aisleriot/rules/bear_river.scm | 227 +++++++++++++++++++++++++++++++++++
aisleriot/translatable_game_names.h | 1 +
po/POTFILES.in | 1 +
7 files changed, 363 insertions(+), 0 deletions(-)
diff --git a/aisleriot/help/C/aisleriot.xml b/aisleriot/help/C/aisleriot.xml
index cac1d03..253796d 100644
--- a/aisleriot/help/C/aisleriot.xml
+++ b/aisleriot/help/C/aisleriot.xml
@@ -9,6 +9,7 @@
<!ENTITY backbone SYSTEM "backbone.xml">
<!ENTITY bakers-dozen SYSTEM "bakers_dozen.xml">
<!ENTITY bakers-game SYSTEM "bakers_game.xml">
+<!ENTITY bear-river SYSTEM "bear_river.xml">
<!ENTITY beleaguered-castle SYSTEM "beleaguered_castle.xml">
<!ENTITY block-ten SYSTEM "block_ten.xml">
<!ENTITY bristol SYSTEM "bristol.xml">
@@ -299,6 +300,7 @@ been coded for your pleasure in the GNOME scripting language (Scheme).
&backbone;
&bakers-dozen;
&bakers-game;
+ &bear-river;
&beleaguered-castle;
&block-ten;
&bristol;
diff --git a/aisleriot/help/C/bear_river.xml b/aisleriot/help/C/bear_river.xml
new file mode 100644
index 0000000..1171815
--- /dev/null
+++ b/aisleriot/help/C/bear_river.xml
@@ -0,0 +1,130 @@
+<sect1 id="Bear_River"><!--<sect1info>
+ <copyright>
+ <year>2009</year>
+ <holder>Joel Levin</holder>
+ </copyright>
+ <author>
+ <firstname>Joel</firstname>
+ <surname>Levin</surname>
+ </author>
+ <address><email>JoelNYC gmail com</email></address>
+ </sect1info>-->
+
+ <title>Bear River</title>
+
+ <para>Written by Bruce and Joel Levin</para>
+
+
+ <sect2><title>Setup</title>
+
+ <informaltable>
+ <tgroup cols="2">
+ <tbody>
+
+ <row>
+ <entry>
+ Type of Deck
+ </entry>
+ <entry>
+ Standard Deck
+ </entry>
+ </row>
+
+ <row>
+ <entry>
+ Foundation
+ </entry>
+ <entry>
+ Four piles at top. One card is dealt face up in the first Foundation
+ pile.
+ </entry>
+ </row>
+
+ <row>
+ <entry>
+ Tableau
+ </entry>
+ <entry>
+ There are 18 Tableau piles arranged in three rows of six piles each.
+ All cards are dealt face up and fanned, such that all cards are
+ visible. The first five piles of each row start with three cards each.
+ The sixth pile of each row starts with two cards each.
+ </entry>
+ </row>
+
+ </tbody>
+ </tgroup>
+ </informaltable>
+
+ </sect2>
+
+
+ <sect2><title>Goal</title>
+
+ <para>
+ Move all cards to the Foundation piles.
+ </para>
+
+ </sect2>
+
+
+ <sect2><title>Rules</title>
+
+ <para>
+ One random card has already been dealt to a Foundation pile. The rank
+ of that card becomes the Base Card. The other three cards with the same
+ rank can be moved to an empty Foundation. Foundations are built up in
+ ascending order, matching suit. Cards can "wrap-around" from Queen to
+ King to Ace to Two. Cards on the Foundations may not be moved back onto
+ Tableau piles.
+ </para>
+ <para>
+ None of the Tableau piles can have more than three cards. The top card of
+ each Tableau pile can be moved to any other Tableau pile if it matches suit
+ and has a face value of one higher or one lower than the top card of the
+ pile it is being moved to. Cards can "wrap-around" between King and Ace.
+ </para>
+ <para>
+ There are two types of Tableau piles: "Standard" piles, and "Hole" piles.
+ The first five piles of each row (the ones with three cards) are the
+ Standard piles. An empty standard pile CANNOT have a new card placed on it.
+ The last pile of each row (the ones with two cards) are the Hole piles. An
+ empty Hole pile CAN have a new card placed on it.
+ </para>
+
+ </sect2>
+
+
+ <sect2><title>Scoring</title>
+
+ <para>
+ Each card moved to the Foundation scores one point.
+ </para>
+ <para>
+ Maximum possible score: 52
+ </para>
+
+ </sect2>
+
+
+ <sect2><title>Strategy</title>
+
+ <para>
+ Try to free up one or more Hole piles early.
+ </para>
+ <para>
+ There is never a disadvantage in moving cards to the Foundations.
+ Move as many as possible, as soon as possible.
+ </para>
+ <para>
+ Cards that have a rank one lower than the Base Card can be very difficult
+ to move. Be careful where you place them.
+ </para>
+ <para>
+ Bear River can be won about one third of the time.
+ </para>
+
+ </sect2>
+
+
+</sect1>
diff --git a/aisleriot/help/Makefile.am b/aisleriot/help/Makefile.am
index 5cea841..3f69a0b 100644
--- a/aisleriot/help/Makefile.am
+++ b/aisleriot/help/Makefile.am
@@ -15,6 +15,7 @@ DOC_ENTITIES = \
backbone.xml \
bakers_dozen.xml \
bakers_game.xml \
+ bear_river.xml \
beleaguered_castle.xml \
block_ten.xml \
bristol.xml \
diff --git a/aisleriot/rules/Makefile.am b/aisleriot/rules/Makefile.am
index 9b63f5e..6302a8e 100644
--- a/aisleriot/rules/Makefile.am
+++ b/aisleriot/rules/Makefile.am
@@ -11,6 +11,7 @@ rules_DATA = \
backbone.scm \
bakers_dozen.scm \
bakers_game.scm \
+ bear_river.scm \
beleaguered_castle.scm \
block_ten.scm \
bristol.scm \
diff --git a/aisleriot/rules/bear_river.scm b/aisleriot/rules/bear_river.scm
new file mode 100644
index 0000000..d152228
--- /dev/null
+++ b/aisleriot/rules/bear_river.scm
@@ -0,0 +1,227 @@
+; AisleRiot - Bear River
+; Copyright (C) 2009 Vincent Povirk
+;
+; This game is free software; you can redistribute it and/or modify
+; it under the terms of the GNU General Public License as published by
+; the Free Software Foundation; either version 2, or (at your option)
+; any later version.
+;
+; This program is distributed in the hope that it will be useful,
+; but WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+; GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License
+; along with this program; if not, write to the Free Software
+; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
+; USA
+
+
+
+(define tableau '(4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21))
+(define foundation '(0 1 2 3))
+(define hole '(9 15 21))
+
+(define BASE-VAL 0)
+
+(define (new-game)
+ (initialize-playing-area)
+ (set-ace-low)
+
+ (make-standard-deck)
+ (shuffle-deck)
+
+ (add-blank-slot)
+ (add-normal-slot DECK)
+ (add-normal-slot '())
+ (add-normal-slot '())
+ (add-normal-slot '())
+ (add-carriage-return-slot)
+
+ (add-extended-slot '() right)
+ (add-extended-slot '() right)
+ (add-extended-slot '() right)
+ (add-extended-slot '() right)
+ (add-extended-slot '() right)
+ (set! HORIZPOS (+ HORIZPOS 0.18))
+ (add-extended-slot '() right)
+ (add-carriage-return-slot)
+
+ (add-extended-slot '() right)
+ (add-extended-slot '() right)
+ (add-extended-slot '() right)
+ (add-extended-slot '() right)
+ (add-extended-slot '() right)
+ (set! HORIZPOS (+ HORIZPOS 0.18))
+ (add-extended-slot '() right)
+ (add-carriage-return-slot)
+
+ (add-extended-slot '() right)
+ (add-extended-slot '() right)
+ (add-extended-slot '() right)
+ (add-extended-slot '() right)
+ (add-extended-slot '() right)
+ (set! HORIZPOS (+ HORIZPOS 0.18))
+ (add-extended-slot '() right)
+ (add-carriage-return-slot)
+
+ (deal-to-tableau 0 tableau)
+ (flip-top-card 0)
+
+ (set! BASE-VAL (get-value (get-top-card 0)))
+
+ (list 6.3 4))
+
+(define (deal-to-tableau deck piles)
+ (if (null? piles)
+ #t
+ (begin
+ (deal-cards-face-up deck (list (car piles) (car piles)))
+ (and (not (member (car piles) hole))
+ (deal-cards-face-up deck (list (car piles))))
+ (deal-to-tableau deck (cdr piles)))))
+
+(define (give-status-message)
+ (set-statusbar-message (get-base-string)))
+
+(define (get-base-string)
+ (cond ((and (> BASE-VAL 1)
+ (< BASE-VAL 11))
+ (string-append (_"Base Card: ") (number->string BASE-VAL)))
+ ((= BASE-VAL 1)
+ (_"Base Card: Ace"))
+ ((= BASE-VAL 11)
+ (_"Base Card: Jack"))
+ ((= BASE-VAL 12)
+ (_"Base Card: Queen"))
+ ((= BASE-VAL 13)
+ (_"Base Card: King"))
+ (#t "")))
+
+(define (button-pressed slot-id card-list)
+ (and (member slot-id tableau)
+ (= (length card-list) 1)))
+
+(define (value-offset? offset card1 card2)
+ (= offset
+ (modulo (- (get-value card2) (get-value card1)) 13)))
+
+(define (droppable? start-slot card-list end-slot)
+ (if (member end-slot foundation)
+ (if (empty-slot? end-slot)
+ (= (get-value (car card-list)) BASE-VAL)
+ (and (suit-eq? (car card-list) (get-top-card end-slot))
+ (value-offset? 1 (get-top-card end-slot) (car card-list))))
+ (and (not (= start-slot end-slot))
+ (if (empty-slot? end-slot)
+ (member end-slot hole)
+ (and (< (length (get-cards end-slot)) 3)
+ (suit-eq? (get-top-card end-slot) (car card-list))
+ (or (value-offset? 1 (get-top-card end-slot) (car card-list))
+ (value-offset? 1 (car card-list) (get-top-card end-slot))))))))
+
+(define (button-released start-slot card-list end-slot)
+ (and (droppable? start-slot card-list end-slot)
+ (move-n-cards! start-slot end-slot card-list)))
+
+(define (button-clicked slot-id)
+ #f)
+
+(define (try-to-foundations from-slot to-slots)
+ (if (null? to-slots)
+ #f
+ (if (droppable? from-slot (list (get-top-card from-slot)) (car to-slots))
+ (deal-cards from-slot (list (car to-slots)))
+ (try-to-foundations from-slot (cdr to-slots)))))
+
+(define (button-double-clicked slot-id)
+ (and (member slot-id tableau)
+ (not (empty-slot? slot-id))
+ (try-to-foundations slot-id foundation)))
+
+(define (game-continuable)
+ (give-status-message)
+ (and (not (game-won))
+ (get-hint)))
+
+(define (count-cards slots acc)
+ (if (null? slots)
+ acc
+ (count-cards (cdr slots) (+ acc (length (get-cards (car slots)))))))
+
+(define (update-score)
+ (set-score! (count-cards foundation 0)))
+
+(define (game-won)
+ (= (update-score) 52))
+
+(define (hint-slot-to-foundation from-slot to-slots)
+ (cond ((null? to-slots) #f)
+ ((droppable? from-slot (list (get-top-card from-slot)) (car to-slots))
+ (if (empty-slot? (car to-slots))
+ (list 2 (get-name (get-top-card from-slot)) (_"an empty foundation slot"))
+ (list 1 (get-name (get-top-card from-slot)) (get-name (get-top-card (car to-slots))))))
+ (else (hint-slot-to-foundation from-slot (cdr to-slots)))))
+
+(define (hint-to-foundation from-slots to-slots)
+ (cond ((null? from-slots) #f)
+ ((empty-slot? (car from-slots))
+ (hint-to-foundation (cdr from-slots) to-slots))
+ (else (or (hint-slot-to-foundation (car from-slots) to-slots)
+ (hint-to-foundation (cdr from-slots) to-slots)))))
+
+(define (hint-slot-to-tableau from-slot to-slots)
+ (cond ((null? to-slots) #f)
+ ((empty-slot? (car to-slots)) (hint-slot-to-tableau from-slot (cdr to-slots)))
+ ((droppable? from-slot (list (get-top-card from-slot)) (car to-slots))
+ (list 1 (get-name (get-top-card from-slot)) (get-name (get-top-card (car to-slots)))))
+ (else (hint-slot-to-tableau from-slot (cdr to-slots)))))
+
+(define (hint-within-tableau from-slots to-slots)
+ (cond ((null? from-slots) #f)
+ ((or (< (length (get-cards (car from-slots))) 2)
+ (let ((card1 (get-top-card (car from-slots)))
+ (card2 (cadr (get-cards (car from-slots)))))
+ (and (suit-eq? card1 card2)
+ (value-offset? 1 card1 card2))))
+ (hint-within-tableau (cdr from-slots) to-slots))
+ (else (or (hint-slot-to-tableau (car from-slots) to-slots)
+ (hint-within-tableau (cdr from-slots) to-slots)))))
+
+(define (hint-empty-hole from-slots to-slots)
+ (cond ((null? from-slots) #f)
+ ((not (= (length (get-cards (car from-slots))) 1))
+ (hint-empty-hole (cdr from-slots) to-slots))
+ (else (or (hint-slot-to-tableau (car from-slots) to-slots)
+ (hint-empty-hole (cdr from-slots) to-slots)))))
+
+; Last resort hint: Find any possible tableau move, even unpleasant ones that were skipped earlier.
+(define (hint-last-resort from-slots to-slots)
+ (if (null? from-slots)
+ #f
+ (or (and (not (empty-slot? (car from-slots)))
+ (hint-slot-to-tableau (car from-slots) to-slots))
+ (hint-last-resort (cdr from-slots) to-slots))))
+
+(define (get-hint)
+ (or (hint-to-foundation tableau foundation)
+ (hint-empty-hole hole tableau)
+ (hint-within-tableau tableau tableau)
+ (and (any-slot-empty? hole)
+ (list 0 (_"Move something onto an empty right-hand tableau slot")))
+ (hint-last-resort tableau tableau)))
+
+(define (get-options)
+ #f)
+
+(define (apply-options options)
+ #f)
+
+(define (timeout)
+ #f)
+
+(set-features droppable-feature)
+
+(set-lambda new-game button-pressed button-released button-clicked
+button-double-clicked game-continuable game-won get-hint get-options
+apply-options timeout droppable?)
diff --git a/aisleriot/translatable_game_names.h b/aisleriot/translatable_game_names.h
index e838633..7f8279d 100644
--- a/aisleriot/translatable_game_names.h
+++ b/aisleriot/translatable_game_names.h
@@ -6,6 +6,7 @@ gchar *s = N_("Aunt Mary")
gchar *s = N_("Backbone")
gchar *s = N_("Bakers Dozen")
gchar *s = N_("Bakers Game")
+gchar *s = N_("Bear River")
gchar *s = N_("Beleaguered Castle")
gchar *s = N_("Block Ten")
gchar *s = N_("Bristol")
diff --git a/po/POTFILES.in b/po/POTFILES.in
index 1a54019..dd57065 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -22,6 +22,7 @@ aisleriot/rules/aunt_mary.scm
aisleriot/rules/backbone.scm
aisleriot/rules/bakers_dozen.scm
aisleriot/rules/bakers_game.scm
+aisleriot/rules/bear_river.scm
aisleriot/rules/beleaguered_castle.scm
aisleriot/rules/block_ten.scm
aisleriot/rules/bristol.scm
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
