GNOME.org
 

gnome-games r9044 - in trunk: aisleriot aisleriot/help aisleriot/help/C aisleriot/rules po

Author: vpovirk
Date: Mon Apr 13 02:10:49 2009
New Revision: 9044
URL: http://svn.gnome.org/viewvc/gnome-games?rev=9044&view=rev

Log:
aisleriot: add Giant game by Ed Sirett


Added:
   trunk/aisleriot/help/C/giant.xml
   trunk/aisleriot/rules/giant.scm
Modified:
   trunk/aisleriot/help/C/aisleriot.xml
   trunk/aisleriot/help/Makefile.am
   trunk/aisleriot/rules/Makefile.am
   trunk/aisleriot/translatable_game_names.h
   trunk/po/POTFILES.in

Modified: trunk/aisleriot/help/C/aisleriot.xml
==============================================================================
--- trunk/aisleriot/help/C/aisleriot.xml	(original)
+++ trunk/aisleriot/help/C/aisleriot.xml	Mon Apr 13 02:10:49 2009
@@ -34,6 +34,7 @@
 <!ENTITY freecell SYSTEM "freecell.xml">
 <!ENTITY gaps SYSTEM "gaps.xml">
 <!ENTITY gay-gordons SYSTEM "gay_gordons.xml">
+<!ENTITY giant SYSTEM "giant.xml">
 <!ENTITY glenwood SYSTEM "glenwood.xml">
 <!ENTITY gold-mine SYSTEM "gold_mine.xml">
 <!ENTITY golf SYSTEM "golf.xml">
@@ -321,6 +322,7 @@
   &freecell;
   &gaps;
   &gay-gordons;
+  &giant;
   &glenwood;
   &gold-mine;
   &golf;

Added: trunk/aisleriot/help/C/giant.xml
==============================================================================
--- (empty file)
+++ trunk/aisleriot/help/C/giant.xml	Mon Apr 13 02:10:49 2009
@@ -0,0 +1,122 @@
+<sect1 id="Giant"><!--<sect1info>
+		<copyright>
+			<year>2009</year>
+			<holder>Ed Sirett</holder>
+		</copyright>
+		<author>
+			<firstname>Ed</firstname>
+			<surname>Sirett</surname>
+		</author>
+		<address><email>ed makewrite demon co uk</email></address>
+	</sect1info>-->
+
+	<title>Giant</title>
+
+  <para>Written by Ed Sirett</para>
+
+          <sect2><title>Setup</title>
+
+
+  <informaltable>
+    <tgroup cols="2">
+      <tbody>
+	<row>
+	  <entry>Type of Deck</entry>
+	  <entry>Double Deck</entry>
+	</row>
+	<row>
+	  <entry>Stock</entry>
+	  <entry>
+	    Top left pile.  All cards are placed here after dealing on
+	    the Tableau.  Cards are dealt a row at a time onto the tableau piles.
+	    No redeals.
+	  </entry>
+	</row>
+	<row>
+	  <entry>Foundation</entry>
+	  <entry>
+	    Eight piles top right.  To be built up in suit from Ace to
+	    King.  Topmost card in each Foundation can be played back on
+	    to the Tableau.
+	  </entry>
+	</row>
+	<row>
+	  <entry>Tableau</entry>
+	  <entry>
+	    Eight piles.  Deal one card face up to all eight piles.
+	  </entry>
+	</row>
+	<row>
+	  <entry>Reserve</entry>
+	  <entry>
+	    To the right of the Tableau. Initially empty. May contain any single card.
+	  </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>
+    Cards in the Tableau are built down by alternating-colors. Cards are
+    moved singly or in groups.  An empty slot in the Tableau can be filled with any card. There is an option to restrict the movement to
+    only cards of the same suit. See below.
+  </para>
+  <para>
+    Cards are dealt from the Stock to the Tableau in complete rows. The reserve may be empty or
+    occupied as you wish.
+  </para>
+  <para>
+    Foundations are built up from suit from Ace to King.  Top cards in
+    Foundations are still in play.  Double clicking on a card will move
+    it to the appropriate Foundation pile if such a move is possible. Double clicking on a Foundation
+    will automatically move as many cards as possible to the Foundations.
+  </para>
+          </sect2>
+        <sect2><title>Options</title>
+
+  <para>
+    There are two ways to play. The difference between them
+    is in how the cards may be built in the tableau.
+  </para>
+  <variablelist>
+    <varlistentry><term>Same suit</term>
+      <listitem>
+      <para>Cards must be of the same suit to be moved as a group and must be placed on a card of the same suit.</para>
+      </listitem>
+    </varlistentry>
+    <varlistentry><term>Alternating colors</term>
+      <listitem>
+         <para>To be moved as a gorup cards must be in a sequence of alternaing colors. The top card must be placed on a card of
+               the opposite color.</para>
+      </listitem>
+    </varlistentry>
+  </variablelist>
+
+          </sect2>
+        <sect2><title>Scoring</title>
+
+  <para>
+    Each card in the Foundation piles scores one point.
+  </para>
+  <para>
+    Maximum possible score:  104
+  </para>
+
+          </sect2>
+        <sect2><title>Strategy</title>
+
+  <para>
+    Avoid leaving small cards buried in the tableau. Use the Reserve wisely.
+  </para>
+        </sect2>
+</sect1>

Modified: trunk/aisleriot/help/Makefile.am
==============================================================================
--- trunk/aisleriot/help/Makefile.am	(original)
+++ trunk/aisleriot/help/Makefile.am	Mon Apr 13 02:10:49 2009
@@ -42,6 +42,7 @@
 	gaps.xml \
 	gold_mine.xml \
 	gay_gordons.xml \
+	giant.xml \
 	glenwood.xml \
 	golf.xml \
 	gypsy.xml \

Modified: trunk/aisleriot/rules/Makefile.am
==============================================================================
--- trunk/aisleriot/rules/Makefile.am	(original)
+++ trunk/aisleriot/rules/Makefile.am	Mon Apr 13 02:10:49 2009
@@ -36,6 +36,7 @@
 	freecell.scm		\
 	gaps.scm		\
 	gay_gordons.scm		\
+	giant.scm		\
 	glenwood.scm		\
 	gold_mine.scm		\
 	golf.scm		\

Added: trunk/aisleriot/rules/giant.scm
==============================================================================
--- (empty file)
+++ trunk/aisleriot/rules/giant.scm	Mon Apr 13 02:10:49 2009
@@ -0,0 +1,306 @@
+; AisleRiot - giant.scm
+; Copyright (C) 2009 Ed Sirett <ed makewrite demon co uk>
+;
+; 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
+
+
+;set up the deck
+(set-ace-low)
+
+(define stock-slot 0)
+(define foundation '(1 2 3 4 5 6 7 8))
+(define tableau '(9 10 11 12 13 14 15 16 ))
+(define reserve-slot 17)
+(define (make-deck)
+  (make-standard-double-deck)
+)
+
+(define winning-score 104)
+
+(define allow-empty-slots #t)
+(define same-suit #f)
+
+(define (new-game)
+  (initialize-playing-area)
+  (make-deck)
+  (shuffle-deck)
+
+  ;set up the board
+  (add-normal-slot DECK)
+  (add-blank-slot)
+  (add-normal-slot '())
+  (add-normal-slot '())
+  (add-normal-slot '())
+  (add-normal-slot '())
+  (add-normal-slot '())
+  (add-normal-slot '())
+  (add-normal-slot '())
+  (add-normal-slot '())
+  (add-carriage-return-slot)
+  (add-extended-slot '() down)
+  (add-extended-slot '() down)
+  (add-extended-slot '() down)
+  (add-extended-slot '() down)
+  (add-extended-slot '() down)
+  (add-extended-slot '() down)
+  (add-extended-slot '() down)
+  (add-extended-slot '() down)
+  (add-blank-slot)
+  (add-normal-slot '())
+
+  (deal-cards-face-up stock-slot tableau)
+
+
+  (give-status-message)
+  (list 10 4.5))
+
+(define (give-status-message)
+  (set-statusbar-message (get-stock-no-string))
+)
+
+(define (get-stock-no-string)
+  (format (_"Deals left: ~a")
+          (number->string (/ (length (get-cards stock-slot)) 8 ))
+  )
+)
+
+;additional functions.
+
+(define (complete-transaction start-slot card-list end-slot)
+  (if (member end-slot foundation)
+      (move-n-cards! start-slot end-slot (reverse card-list))
+      (move-n-cards! start-slot end-slot card-list)
+  )
+)
+
+(define (button-pressed slot card-list)
+  (if (or (empty-slot? slot) (= slot stock-slot))
+        #f   ; can't pick from stock or empty piles
+        (and (or (and (not same-suit) (check-alternating-color-list card-list))
+                 (and same-suit  (check-same-suit-list card-list)))
+             (check-straight-descending-list card-list))))
+
+
+
+(define (droppable? start-slot card-list end-slot)
+  (and (not (= start-slot end-slot))
+       ( or (and  (member end-slot foundation)
+                  (check-straight-descending-list card-list)
+                  (check-same-suit-list card-list)
+                  (if (empty-slot? end-slot)
+                      (= (get-value (car card-list)) ace)
+                      (and (= (get-suit (car card-list)) (get-suit (get-top-card end-slot)))
+                           (= (- (get-value (car card-list)) 1 ) (get-value (get-top-card end-slot)))
+                      )
+                  )
+            )
+            (and  (member end-slot tableau)
+                  (check-straight-descending-list card-list)
+                  (or (and (not same-suit) (check-alternating-color-list card-list))
+                      (and  same-suit (check-same-suit-list card-list)))
+                  (if (not (empty-slot? end-slot))
+                      (and (= (+ (get-value (car (reverse card-list))) 1 ) (get-value (get-top-card end-slot)))
+                           (or (and (not same-suit)
+                                    (not ( eq? ( is-red? ( car (reverse card-list))) (is-red? (get-top-card end-slot)))))
+                               (and same-suit
+                                    (= (get-suit (car (reverse card-list))) (get-suit (get-top-card end-slot))))))
+                      #t
+                  )
+            )
+            (and  (=  end-slot reserve-slot)
+                  (empty-slot? reserve-slot)
+                  (= (length card-list) 1)
+            )
+       )
+  )
+)
+
+(define (button-released start-slot card-list end-slot)
+  (and (droppable? start-slot card-list end-slot)
+       (complete-transaction start-slot card-list end-slot))
+)
+
+(define (do-deal-next-cards)
+  (deal-cards-face-up stock-slot tableau))
+
+(define (button-clicked slot)
+  (if (= stock-slot slot)
+      (if (dealable?) (do-deal-next-cards) #f)
+      #f))
+
+
+(define (find-any-to-foundation from-slots)
+  (if (eq? from-slots '() )
+      #f
+      (let ((find-to-result (find-to foundation (car from-slots))))
+        (if find-to-result
+            (list (car from-slots) find-to-result)
+            (find-any-to-foundation (cdr from-slots))))))
+
+; remake a list of slots with/without empty members
+(define (without-gaps slots with-empties)
+    (cond ((eq? slots '()) '())
+          (with-empties slots)
+          ((empty-slot? (car slots)) (without-gaps (cdr slots) with-empties))
+          ( else (cons (car slots) (without-gaps (cdr slots) with-empties)))))
+
+
+(define (find-any-to-tableau from-slots with-empties)
+  (if (eq? from-slots '() )
+      #f
+      (let ((find-to-result (find-to (without-gaps tableau with-empties) (car from-slots)))
+            (cfs (car from-slots)))
+        (if (and find-to-result
+                  ; check we are not breaking an existing run
+                 (or (= (length (get-cards cfs )) 1)
+                     (not (check-straight-descending-list (list (get-top-card cfs) (cadr (get-cards cfs))))))
+                  ; if suggesting a move to a gap make sure it is worthwhile
+                 (or (not (empty-slot? find-to-result))
+                     (> (length (get-cards cfs )) 1)))  ;can move a top card to a gap if it does not make a gap
+            (list cfs find-to-result)
+            (find-any-to-tableau (cdr from-slots) with-empties)))))
+
+(define (move-any-to-foundation slots)
+  (let (( find-any-result (find-any-to-foundation slots)))
+    (if find-any-result
+        (move-a-card (car find-any-result) (cadr find-any-result))
+        #f)))
+
+
+(define (auto-play)
+    (if (move-any-to-foundation (append tableau (list reserve-slot)))
+        (delayed-call auto-play)
+        #f
+    )
+)
+
+
+(define (find-to slots from-slot)
+  (if (or (empty-slot? from-slot) (eq? slots '()))
+        #f
+       (if (droppable? from-slot (list (get-top-card from-slot)) (car slots) )
+           (car slots)
+           (find-to (cdr slots) from-slot)
+       )
+  )
+)
+
+(define (move-a-card from-slot to-slot)
+   (if ( or (not to-slot) (empty-slot? from-slot))
+        #f
+       (add-card! to-slot (remove-card from-slot))
+   )
+)
+
+(define (move-to-foundation from-slot)
+   (move-a-card from-slot (find-to foundation from-slot ))
+)
+
+
+(define (button-double-clicked slot)
+   (if (member slot foundation)
+           (auto-play)
+           (if (or (member slot tableau) (= slot reserve-slot) )
+               (move-to-foundation slot)
+               #f
+           )
+   )
+)
+
+
+(define (game-over)
+  (give-status-message)
+  (and (not (game-won))
+       (get-hint)))
+
+
+
+; score the game - 1 pt for every card in the foundations 104 to win.
+(define (game-score slot-list)
+  (if (and (null? slot-list))
+      0
+      (+ (length (get-cards (car slot-list))) (game-score (cdr slot-list)))
+  )
+)
+
+; game is won when all cards are moved to foundations.
+(define (game-won)
+   (= (set-score! (game-score foundation)) winning-score)
+)
+
+
+
+(define (dealable?)
+  (if (and
+        (not (empty-slot? stock-slot ))
+        (or allow-empty-slots
+            (not (any-slot-empty? tableau))))
+      (list 0 (_"Deal a row"))
+      #f))
+
+
+(define (my-get-card-name slot)
+    (if (empty-slot? slot)
+        (cond  ((member slot foundation) (_"an empty foundation place"))
+               ((member slot tableau) (_"an empty tableau place"))
+               ( else (_"Error in hinting")))
+        (get-name (get-top-card slot))
+    )
+)
+
+
+
+
+; This is the hint function
+; 1) Suggest a move to a foundation.
+; 2) Suggest moving a card from the (reserve  + tableau) to the tableau.
+; 3) Suggest moviing a card to an empty tableau-slot
+; 4) Suggest moving to the reserve if unoccupied
+; 5) Suggest dealing a row if there are cards still in the stock.
+; 6) Suggest moving cards around.
+
+(define (get-hint)
+  (let ((find-result (find-any-to-foundation (append tableau (list reserve-slot))))
+        (t-result1   (find-any-to-tableau  (append tableau (list reserve-slot)) #f  ))
+        (t-result2   (find-any-to-tableau  (append tableau (list reserve-slot)) #t )))
+     (cond
+           ( find-result
+            (list 2 (my-get-card-name (car find-result)) (my-get-card-name (cadr find-result))))
+           ( t-result1
+            (list 2 (my-get-card-name (car t-result1)) (my-get-card-name (cadr t-result1))))
+           ( t-result2
+            (list 2 (my-get-card-name (car t-result2)) (my-get-card-name (cadr t-result2))))
+           ( (empty-slot? reserve-slot) (list 0 (_"Try moving a card to the reserve")))
+           ( (dealable?) (list 0 (_"Try dealing a row of cards")))
+; this isn't great, but it will get around the premature end-of-game call
+           (else (list 0 (_"Try moving card piles around")))
+     )))
+
+(define (get-options)
+  (list 'begin-exclusive
+        (list (_"Same suit") same-suit)
+        (list (_"Alternating colors") (not same-suit))
+        'end-exclusive))
+
+(define (apply-options options)
+  (set! same-suit (cadr (list-ref options 1))))
+
+(define (timeout) #f)
+
+(set-features droppable-feature dealable-feature)
+
+(set-lambda new-game button-pressed button-released button-clicked button-double-clicked game-over game-won get-hint
+get-options apply-options timeout droppable? dealable?)

Modified: trunk/aisleriot/translatable_game_names.h
==============================================================================
--- trunk/aisleriot/translatable_game_names.h	(original)
+++ trunk/aisleriot/translatable_game_names.h	Mon Apr 13 02:10:49 2009
@@ -31,6 +31,7 @@
 gchar *s = N_("Freecell")
 gchar *s = N_("Gaps")
 gchar *s = N_("Gay Gordons")
+gchar *s = N_("Giant")
 gchar *s = N_("Glenwood")
 gchar *s = N_("Gold Mine")
 gchar *s = N_("Golf")
@@ -44,7 +45,6 @@
 gchar *s = N_("King Albert")
 gchar *s = N_("Kings Audience")
 gchar *s = N_("Klondike")
-gchar *s = N_("Klondike Three Decks")
 gchar *s = N_("Labyrinth")
 gchar *s = N_("Lady Jane")
 gchar *s = N_("Maze")

Modified: trunk/po/POTFILES.in
==============================================================================
--- trunk/po/POTFILES.in	(original)
+++ trunk/po/POTFILES.in	Mon Apr 13 02:10:49 2009
@@ -47,6 +47,7 @@
 aisleriot/rules/freecell.scm
 aisleriot/rules/gaps.scm
 aisleriot/rules/gay_gordons.scm
+aisleriot/rules/giant.scm
 aisleriot/rules/glenwood.scm
 aisleriot/rules/gold_mine.scm
 aisleriot/rules/golf.scm
[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]