gnome-games r8521 - in trunk/aisleriot: help help/C rules

[chpe svn gnome org]

Author: chpe
Date: Tue Jan  6 19:40:09 2009
New Revision: 8521
URL: http://svn.gnome.org/viewvc/gnome-games?rev=8521&view=rev

Log:
Bug 526392 â A new game (Accordion) for aisleriot

Added:
   trunk/aisleriot/help/C/accordion.xml
   trunk/aisleriot/rules/accordion.scm
Modified:
   trunk/aisleriot/help/C/aisleriot.xml
   trunk/aisleriot/help/Makefile.am
   trunk/aisleriot/rules/Makefile.am

Added: trunk/aisleriot/help/C/accordion.xml
==============================================================================
--- (empty file)
+++ trunk/aisleriot/help/C/accordion.xml	Tue Jan  6 19:40:09 2009
@@ -0,0 +1,80 @@
+<sect1 id="Accordion"><!--<sect1info>
+		<copyright>
+			<year>2008</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>Accordion</title>
+
+  <para>Written by Ed Sirett</para>
+
+          <sect2><title>Setup</title>
+
+
+	<informaltable>
+		<tgroup cols="2">
+			<tbody>
+	<row>
+		<entry>Type of Deck</entry>
+		<entry>Standard Deck</entry>
+	</row>
+
+	<row>
+		<entry>Tableau</entry>
+		<entry>
+			Fifty-four spaces in five rows of nine and a last row of seven. Deal cards face up
+            one per space. The spaces should be considered as one continuous line, the rows 
+            simply arrange the tableau so all of it can be seen at once. Thus the 
+            rightmost space of a row is to be considered to the left of the leftmost space
+            of the row below. 
+		</entry>
+	</row>
+			</tbody>
+		</tgroup>
+	</informaltable>
+
+          </sect2>
+        <sect2><title>Goal</title>
+
+  <para>
+    To remove all cards except one. 
+  </para>
+
+          </sect2>
+        <sect2><title>Rules</title>
+
+  <para>
+    Cards are moved singly. Any card can be moved over another card of the same suit or rank
+    that is in the space immediately to its left or three spaces to its left.
+    The card that is covered is removed from play. All the cards (if any) in spaces to the 
+    right of the resulting gap are moved to the left one space so as to close the gap.
+    Double-clicking causes the card to move three spaces, if possible, or failing that one space 
+    to the left. 
+  </para>
+
+          </sect2>
+        <sect2><title>Scoring</title>
+
+  <para>
+    Each card removed scaores 1 point. 
+  </para>
+  <para>
+    Maximum possible score:  51
+  </para>
+
+          </sect2>
+        <sect2><title>Strategy</title>
+
+  <para>
+    This is a diffcult game. Try to find two or three cards of the same rank at or near the 
+    last row. Try not to remove any card of this rank. At the end you can move these cards
+    onto each other to win.
+  </para>
+        </sect2>
+</sect1>

Modified: trunk/aisleriot/help/C/aisleriot.xml
==============================================================================
--- trunk/aisleriot/help/C/aisleriot.xml	(original)
+++ trunk/aisleriot/help/C/aisleriot.xml	Tue Jan  6 19:40:09 2009
@@ -1,6 +1,7 @@
 <?xml version="1.0"?>
 <!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.1.2//EN"
     "http://www.oasis-open.org/docbook/xml/4.1.2/docbookx.dtd"; [
+<!ENTITY accordion SYSTEM "accordion.xml">
 <!ENTITY agnes SYSTEM "agnes.xml">
 <!ENTITY athena SYSTEM "athena.xml">
 <!ENTITY auld-lang-syne SYSTEM "auld_lang_syne.xml">
@@ -287,6 +288,7 @@
 <chapter id="games">
     <title>The Games</title>
 
+  &accordion;
   &agnes;
   &athena;
   &auld-lang-syne;

Modified: trunk/aisleriot/help/Makefile.am
==============================================================================
--- trunk/aisleriot/help/Makefile.am	(original)
+++ trunk/aisleriot/help/Makefile.am	Tue Jan  6 19:40:09 2009
@@ -7,6 +7,7 @@
 DOC_MODULE = aisleriot
 
 DOC_ENTITIES = \
+	accordion.xml \
 	agnes.xml \
 	athena.xml \
 	auld_lang_syne.xml \

Modified: trunk/aisleriot/rules/Makefile.am
==============================================================================
--- trunk/aisleriot/rules/Makefile.am	(original)
+++ trunk/aisleriot/rules/Makefile.am	Tue Jan  6 19:40:09 2009
@@ -3,6 +3,7 @@
 rulesdir  = $(pkgdatadir)/aisleriot/games
 
 rules_DATA  = 			\
+	accordion.scm		\
 	agnes.scm		\
 	athena.scm		\
 	auld_lang_syne.scm	\

Added: trunk/aisleriot/rules/accordion.scm
==============================================================================
--- (empty file)
+++ trunk/aisleriot/rules/accordion.scm	Tue Jan  6 19:40:09 2009
@@ -0,0 +1,250 @@
+; AisleRiot - accordion.scm
+; Copyright (C) 2008 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
+
+(define row1 '(0 1 2 3 4 5 6 7 8 ))
+(define row2 '(9 10 11 12 13 14 15 16 17 ))
+(define row3 '(18 19 20 21 22 23 24 25 26 ))
+(define row4 '(27 28 29 30 31 32 33 34 35 ))
+(define row5 '(36 37 38 39 40 41 42 43 44 ))
+(define row6 '(45 46 47 48 49 50 51 ))
+
+
+(define (add-full-line)
+  (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-normal-slot '() )
+  (add-carriage-return-slot)
+)
+
+(define (new-game)
+
+  (initialize-playing-area)
+  (set-ace-low)
+  (make-standard-deck)
+  (shuffle-deck)
+
+
+  (add-full-line)
+  (add-full-line)
+  (add-full-line)
+  (add-full-line)
+  (add-full-line)
+  (add-normal-slot '() )
+  (add-normal-slot '() )
+  (add-normal-slot '() )
+  (add-normal-slot '() )
+  (add-normal-slot '() )
+  (add-normal-slot '() )
+  (add-normal-slot '() )
+
+  (deal-cards-face-up-from-deck DECK (append row1 row2 row3 row4 row5 row6))
+  (give-status-message)
+  (list 9 6)
+)
+
+
+(define (recalc-score last-slot) 
+  (if 
+    (not (empty-slot? last-slot)) 
+    0 
+    (+ 1 (recalc-score (- last-slot 1)))
+  )
+)
+
+(define (give-status-message)
+  (set-score! (recalc-score 51))
+)
+
+
+
+
+
+(define (button-clicked slot-id) 
+  #f
+)
+
+(define  (sidle-up first-slot)
+    (if (and (< first-slot 51)
+             (not (empty-slot? (+ first-slot 1)))
+             (empty-slot? first-slot)
+        )
+        (and  
+            (move-n-cards! (+ first-slot 1) first-slot (list (get-top-card (+ first-slot 1))))
+            (remove-card (+ first-slot 1))
+            (sidle-up (+ first-slot 1))
+        )
+        #t
+    )
+)
+
+
+(define (do-action end-slot start-slot card-list)
+      (and
+          (remove-card end-slot) 
+          (move-n-cards! start-slot end-slot card-list)
+          (if (not (empty-slot? start-slot)) (remove-card start-slot) #t)
+          (sidle-up start-slot)
+          (give-status-message)
+      )
+)
+
+(define (button-released start-slot card-list end-slot)
+   (if ( droppable? start-slot card-list end-slot)
+      (do-action end-slot start-slot card-list) 
+      #f  
+  )
+)
+
+(define (matches-in-rank slot1 card) 
+   (and (>= slot1 0) 
+        (= (get-value (get-top-card slot1)) 
+           (get-value card)
+        )
+   )
+)
+
+(define (matches-in-suit slot1 card) 
+   (and (>= slot1 0) 
+        (= (get-suit (get-top-card slot1)) 
+           (get-suit card)
+        )
+   )
+)
+
+(define (button-pressed slot-id card-list) 
+   (if (not (empty-slot? slot-id))
+         (> slot-id 0)
+         #f
+   )
+)
+
+
+
+
+(define (playable? from-slot card)
+   (or (playable-1? from-slot card) 
+       (playable-3? from-slot card)
+   )
+)
+
+(define (playable-3? from card)
+    (and (>= from 3) 
+	     (or (matches-in-suit  (- from 3) card ) 
+	         (matches-in-rank  (- from 3) card )
+	     )
+    )
+)
+
+(define (playable-1? from card)
+    ( and (>= from 1)
+	   (or (matches-in-suit  (- from 1) card  ) 
+	       (matches-in-rank  (- from 1) card  )
+	   )
+    )
+)
+
+(define (button-double-clicked slot-id) 
+    (cond ((empty-slot? slot-id) #f)
+          ((playable-3? slot-id (get-top-card slot-id))
+             (do-action (- slot-id 3) slot-id (list (get-top-card slot-id)))
+          )          
+          ((playable-1? slot-id (get-top-card slot-id))
+             (do-action (- slot-id 1) slot-id (list (get-top-card slot-id)))
+          )
+	  (else #f)          
+    )
+)
+
+
+ 
+(define (game-continuable)
+  (give-status-message)
+  (and (not (game-won))
+       (get-hint)
+  )
+)
+
+
+
+(define (game-won)
+  (and (empty-slot? 1) 
+       (not (empty-slot? 0))
+  )
+)
+
+(define (make-hint possible-move)
+    (if (car possible-move)
+           (list 2 (get-name (get-top-card (car possible-move)))
+                   (get-name (get-top-card (car (cdr possible-move)))) 
+           ) 
+           #f
+    )
+)
+
+
+(define (find-playable-move start-slot)
+	(cond ( (empty-slot? start-slot) 
+              (list #f)
+          )
+          ( (playable-3? start-slot (get-top-card start-slot)) 
+              (list start-slot (- start-slot 3))
+          )
+          ( (playable-1? start-slot (get-top-card start-slot)) 
+              (list start-slot (- start-slot 1))
+          )
+          ( else 
+              (find-playable-move (+ start-slot 1))
+          )  
+    )    
+)
+
+
+(define (get-hint)
+       (make-hint (find-playable-move 1 ))
+)
+
+(define (droppable?  start-slot card-list  end-slot) 
+  ( and 
+       (not (empty-slot? end-slot))    
+         (or (= (+ end-slot 1) start-slot)
+             (= (+ end-slot 3) start-slot)
+         )
+         (or (matches-in-rank end-slot (car card-list))
+             (matches-in-suit end-slot (car card-list))
+         )
+  )
+)
+
+(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?
+)