GNOME.org
 

[aisleriot] eliminator: New game by Wa.

commit c7eec70650c2e53980616ccd750a051ff4c1452e
Author: Vincent Povirk <madewokherd gmail com>
Date:   Sun May 29 15:46:34 2011 -0500

    eliminator: New game by Wa.
    
    bug 637030

 games/Makefile.am     |    1 +
 games/eliminator.scm  |  210 +++++++++++++++++++++++++++++++++++++++++++++++++
 help/C/aisleriot.xml  |    2 +
 help/C/eliminator.xml |   81 +++++++++++++++++++
 help/Makefile.am      |    1 +
 help/sol.6            |    2 +-
 po/POTFILES.in        |    1 +
 7 files changed, 297 insertions(+), 1 deletions(-)
---
diff --git a/games/Makefile.am b/games/Makefile.am
index 26c2c76..22c325d 100644
--- a/games/Makefile.am
+++ b/games/Makefile.am
@@ -29,6 +29,7 @@ rules_DATA  = 			\
 	easthaven.scm		\
 	eight_off.scm		\
 	elevator.scm		\
+	eliminator.scm		\
 	escalator.scm		\
 	first_law.scm		\
 	fortress.scm		\
diff --git a/games/eliminator.scm b/games/eliminator.scm
new file mode 100644
index 0000000..5c49c6d
--- /dev/null
+++ b/games/eliminator.scm
@@ -0,0 +1,210 @@
+; AisleRiot - eliminator.scm
+; Copyright (C) 2010 Wa (logicplace.com)
+;
+; This program 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 3 of the License, 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, see <http://www.gnu.org/licenses/>.
+
+(define foundation '(0 1 2 3 4 5))
+(define found-amt 6)
+(define tableau '(6 7 8 9))
+
+; Suggestion by Vincent Povirk
+(define (any lst)
+	(let ((lcdr (cdr lst)) (lcar (car lst)))
+		(if (or (null? lcdr) lcar)
+			lcar
+			(any lcdr)
+		)
+	)
+)
+(define (all lst)
+	(let ((lcdr (cdr lst)) (lcar (car lst)))
+		(if (or (null? lcdr) (not lcar))
+			lcar
+			(all lcdr)
+		)
+	)
+)
+
+(define (new-game)
+	(initialize-playing-area)
+	(set-ace-low)
+	(make-standard-deck)
+	(shuffle-deck)
+	
+	; Add foundation slots
+	(add-normal-slot '())
+	(add-normal-slot '())
+	(add-normal-slot '())
+	(add-normal-slot '())
+	(if (>= found-amt 5) (add-normal-slot '()))
+	(if (= found-amt 6) (add-normal-slot '()))
+	(set! foundation (iota found-amt))
+	
+	(add-carriage-return-slot)
+	(if (= found-amt 6) (add-blank-slot))
+	
+	; Add tableau
+	(add-extended-slot '() down)
+	(add-extended-slot '() down)
+	(add-extended-slot '() down)
+	(add-extended-slot '() down)
+	(set! tableau (map (lambda(n) (+ n found-amt)) (iota 4)))
+	
+	; Deal cards (13x)
+	(deal-cards-face-up-from-deck DECK (apply append (make-list 13 tableau)))
+	
+	; Remove unrequested foundation
+	;(let ((down (make-card joker spade)))
+	;	(if (< found-amt 6) (add-card! 0 down))
+	;	(if (< found-amt 5) (add-card! 5 down))
+	;)
+	
+	(give-status-message)
+	
+	(list found-amt 4)
+)
+
+(define (button-pressed slot-id card-list)
+	(and (member slot-id tableau) (= (length card-list) 1))
+)
+(define (button-released start-slot card-list end-slot)
+	(if (droppable? start-slot card-list end-slot)
+		(begin
+			(if (not (empty-slot? end-slot)) (add-to-score! 1))
+			(add-card! end-slot (car card-list))
+		)
+		#f
+	)
+)
+(define (button-double-clicked tid)
+	(let ((card (get-top-card tid)) (mv #f))
+		(for-each (lambda(fid)
+			(if mv #t
+				(if (and
+					(not (empty-slot? tid))
+					(not (empty-slot? fid))
+					(droppable? tid (list card) fid)
+				)(begin
+					(deal-cards tid (list fid))
+					(add-to-score! 1)
+					(set! mv #t)
+				) #f )
+			)
+		)foundation)
+		mv
+		;(if mv
+		;	#t 
+		;	(begin ; Don't spam!
+		;		(add-to-score! -1)
+		;		#f
+		;	)
+		;)
+	)
+)
+
+(define (find-possible-move)
+	(let ((fnd #f))
+		(let ((tmp (any (apply append (map (lambda(tid)
+			(map (lambda(fid)
+				(and (not (empty-slot? tid)) (eq? fnd #f)
+					(if (droppable? tid (list (get-top-card tid)) fid)
+						(begin (if (not (empty-slot? fid)) (set! fnd (list tid fid))) #t)
+						#f
+					)
+				)
+			)foundation)
+		)tableau)))))
+			(if fnd fnd tmp)
+		)
+	)
+)
+
+(define (game-continuable)
+	(and
+		; Has the game been won?
+		(not (game-won))
+		(or
+			; If there's still an empty slot, you can play
+			(any (map empty-slot? foundation))
+			; Otherwise check all cards
+			(list? (find-possible-move))
+		)
+	)
+)
+
+(define (game-won) ; If the tableau is empty you win
+	(all (map empty-slot? tableau))
+)
+
+(define (droppable? start-slot card-list end-slot)
+	(if (member end-slot foundation)
+		(let ((top-card (get-top-card end-slot)))
+			(or (empty-slot? end-slot)
+				(and (is-visible? top-card)
+					(let ((top (get-value top-card)) (card (get-value (car card-list))))
+						(or 
+							(= card (+ top 1)) ; Card is higher
+							(= card (- top 1)) ; Card is lower
+							(or (equal? (list card top) '(13 1)) ; Card is king over ace
+								(equal? (list card top) '(1 13)) ; Card is ace over king
+							)
+						)
+					)
+				)
+			)
+		)
+		#f
+	)
+)
+
+; Options
+(define (get-options)
+	(list 'begin-exclusive 
+		(list (_"Six Foundations")  (= found-amt 6))
+		(list (_"Five Foundations") (= found-amt 5))
+		(list (_"Four Foundations") (= found-amt 4))
+	'end-exclusive)
+)
+(define (apply-options options)
+	(set! found-amt (cond
+		((cadr (list-ref options 1)) 6)
+		((cadr (list-ref options 2)) 5)
+		((cadr (list-ref options 3)) 4)
+		(#t found-amt)
+	))
+)
+
+; Hint
+(define (get-hint)
+	(let ((x (find-possible-move)))
+		(if (list? x)
+			(list 1 (get-name (get-top-card (car x))) (get-name (get-top-card (cadr x))))
+			(if x
+				(list 0 (_"Play a card to foundation."))
+				(list 0 (_"No moves."))
+			)
+		)
+	)
+)
+
+; Ignore
+(define (do-deal-next-cards) #f)
+(define (timeout) #f)
+(define (button-clicked slot-id) #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/help/C/aisleriot.xml b/help/C/aisleriot.xml
index c25bd28..d93bc6c 100644
--- a/help/C/aisleriot.xml
+++ b/help/C/aisleriot.xml
@@ -25,6 +25,7 @@
 <!ENTITY easthaven SYSTEM "easthaven.xml">
 <!ENTITY eight-off SYSTEM "eight_off.xml">
 <!ENTITY elevator SYSTEM "elevator.xml">
+<!ENTITY eliminator SYSTEM "eliminator.xml">
 <!ENTITY escalator SYSTEM "escalator.xml">
 <!ENTITY first-law SYSTEM "first_law.xml">
 <!ENTITY fortress SYSTEM "fortress.xml">
@@ -315,6 +316,7 @@ been coded for your pleasure in the GNOME scripting language (Scheme).
   &easthaven;
   &eight-off;
   &elevator;
+  &eliminator;
   &escalator;
   &first-law;
   &fortress;
diff --git a/help/C/eliminator.xml b/help/C/eliminator.xml
new file mode 100644
index 0000000..0006428
--- /dev/null
+++ b/help/C/eliminator.xml
@@ -0,0 +1,81 @@
+<sect1 id="Eliminator"><!--<sect1info>
+	<copyright>
+		<year>2010</year>
+		<holder>Wa (logicplace.com)</holder>
+	</copyright>
+	<author>
+		<firstname>Wa</firstname>
+		<surname>*</surname>
+	</author>
+	<address>
+		<email>admin logicplace com</email>
+	</address>
+	</sect1info>-->
+
+	<title>Eliminator</title>
+
+	<para>Written by Wa (logicplace.com)</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>
+							Four piles. Deal 13 cards to each. (This is all of the cards.)
+						</entry>
+					</row>
+					<row>
+						<entry>Foundation</entry>
+						<entry>
+							Four to six empty slots that you build in either direction.
+						</entry>
+					</row>
+				</tbody>
+			</tgroup>
+		</informaltable>
+	</sect2>
+
+	<sect2>
+		<title>Goal</title>
+		<para>
+		Move all cards to Foundation.
+		</para>
+	</sect2>
+
+	<sect2>
+		<title>Rules</title>
+		<para>
+		Any card can be placed as the first card in the Foundation. 
+		Foundation piles can be built up or down from the top card's 
+		value, disregarding suit. Kings can be placed on Aces and 
+		vice versa.
+		</para>
+	</sect2>
+
+	<sect2>
+		<title>Scoring</title>
+		<para>
+			Every card moved from the Tableau on top of a card in the 
+			Foundation scores one point.
+		</para>
+		<para>
+			Maximum possible score:  51
+		</para>
+	</sect2>
+
+	<sect2>
+		<title>Strategy</title>
+		<para>
+		Make sure to look at all the cards coming up, and be sure 
+		you're not going to lock any cards that are necessary to 
+		move the one on top.
+		</para>
+	</sect2>
+</sect1>
diff --git a/help/Makefile.am b/help/Makefile.am
index 03ec276..e41f005 100644
--- a/help/Makefile.am
+++ b/help/Makefile.am
@@ -32,6 +32,7 @@ DOC_ENTITIES = \
 	easthaven.xml \
 	eight_off.xml \
 	elevator.xml \
+	eliminator.xml \
 	escalator.xml \
 	first_law.xml \
 	fortress.xml \
diff --git a/help/sol.6 b/help/sol.6
index 02c6edb..826a4f3 100644
--- a/help/sol.6
+++ b/help/sol.6
@@ -56,7 +56,7 @@ Saratoga, Cruel, Block Ten, Will O The Wisp, Odessa, Eagle Wing, Treize, Zebra,
 Cover, Elevator, Fortress, Giant, Spider, Gaps, Bakers Dozen, Whitehead,
 Freecell, Helsinki, Spider Three Decks, Scuffle, Poker, Klondike Three Decks,
 Valentine, Royal East, Thumb And Pouch, Klondike, Doublets, Template, Golf,
-Westhaven, Beleaguered Castle, Hopscotch
+Westhaven, Beleaguered Castle, Hopscotch, Eliminator
 .RE
 
 .SH OPTIONS
diff --git a/po/POTFILES.in b/po/POTFILES.in
index 60da25d..130bbec 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -47,6 +47,7 @@ games/eagle_wing.scm
 games/easthaven.scm
 games/eight_off.scm
 games/elevator.scm
+games/eliminator.scm
 games/escalator.scm
 games/first_law.scm
 games/fortress.scm
[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]