Commit 225c8842 authored by Rosanna Yuen's avatar Rosanna Yuen Committed by Rosanna Yuen

added a new game added a new help file


Sat Jun 30 16:33:25 2001  Rosanna Yuen  <zana@webwynk.net>

	* chessboard.scm: added a new game
	* docs/C/chessboard.sgml: added a new help file
parent 6b63aef4
Sat Jun 30 16:33:25 2001 Rosanna Yuen <zana@webwynk.net>
* chessboard.scm: added a new game
2001-06-10 Juan Pablo Mendoza <pablo_juan@yahoo.com>
* sol.c (new_game): Save the most recently played game. Fix bug #18929
......
......@@ -52,6 +52,7 @@ types_DATA = \
bristol.scm \
camelot.scm \
canfield.scm \
chessboard.scm \
clock.scm \
cover.scm \
diamond_mine.scm \
......
; AisleRiot - chessboard.scm
; Copyright (C) 2001 Rosanna Yuen <zana@webwynk.net>
;
; 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 BASE-VAL 0)
(define base-set? #f)
(define (new-game)
(initialize-playing-area)
(set-ace-low)
(make-standard-deck)
(shuffle-deck)
(set! base-set? #f)
(add-extended-slot '() right)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
(add-extended-slot '() right)
(add-carriage-return-slot)
(add-extended-slot '() right)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
(add-normal-slot DECK)
(add-blank-slot)
(add-extended-slot '() right)
(add-carriage-return-slot)
(add-extended-slot '() right)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
(add-normal-slot '())
(add-blank-slot)
(add-extended-slot '() right)
(add-carriage-return-slot)
(add-extended-slot '() right)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
(add-normal-slot '())
(add-blank-slot)
(add-extended-slot '() right)
(add-carriage-return-slot)
(add-extended-slot '() right)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
(add-normal-slot '())
(add-blank-slot)
(add-extended-slot '() right)
(deal-cards-face-up 3 '(0 2 5 8 11 1 4 7 10 13 0 2 5 8 11 1 4 7 10 13 0 2 5 8 11 1 4 7 10 13 0 2 5 8 11 1 4 7 10 13 0 2 5 8 11 1 4 7 10 13 0 1))
(give-status-message)
(list 10 5))
(define (give-status-message)
(if (not base-set?)
(set-statusbar-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 #f)))
(define (button-pressed slot-id card-list)
(and (not (empty-slot? slot-id))
(not (= slot-id 3))
(not (= slot-id 6))
(not (= slot-id 9))
(not (= slot-id 12))
(= (length card-list) 1)))
(define (button-released start-slot card-list end-slot)
(cond ((or (= end-slot 3)
(= end-slot 6)
(= end-slot 9)
(= end-slot 12))
(and (or (and (empty-slot? end-slot)
(or (and (not base-set?)
(set! BASE-VAL (get-value (car card-list)))
(set! base-set? #t))
(= (get-value (car card-list)) BASE-VAL)))
(and (not (empty-slot? end-slot))
(= (get-suit (get-top-card end-slot))
(get-suit (car card-list)))
(or (= (get-value (car card-list))
(+ 1 (get-value (get-top-card end-slot))))
(and (= (get-value (car card-list)) ace)
(= (get-value (get-top-card end-slot)) king)))))
(move-n-cards! start-slot end-slot card-list)
(add-to-score! 1)))
((or (empty-slot? end-slot)
(and (= (get-suit (get-top-card end-slot))
(get-suit (car card-list)))
(or (= (get-value (get-top-card end-slot))
(+ 1 (get-value (car card-list))))
(and (= (get-value (get-top-card end-slot)) king)
(= (get-value (car card-list)) ace))
(and (= (get-value (get-top-card end-slot)) ace)
(= (get-value (car card-list)) king))
(= (+ 1 (get-value (get-top-card end-slot)))
(get-value (car card-list))))))
(move-n-cards! start-slot end-slot card-list))
(#t #f)))
(define (button-clicked slot-id)
#f)
(define (move-to-foundation slot f-slot)
(cond ((= f-slot 15)
#f)
((not base-set?)
(and (set! base-set? #t)
(set! BASE-VAL (get-value (get-top-card slot)))
(deal-cards slot '(3))
(add-to-score! 1)))
((and (empty-slot? f-slot)
(= (get-value (get-top-card slot)) BASE-VAL))
(and (deal-cards slot (list f-slot))
(add-to-score! 1)))
((and (not (empty-slot? f-slot))
(= (get-suit (get-top-card f-slot))
(get-suit (get-top-card slot)))
(or (and (= (get-value (get-top-card f-slot)) king)
(= (get-value (get-top-card slot)) ace))
(= (+ 1 (get-value (get-top-card f-slot)))
(get-value (get-top-card slot)))))
(and (deal-cards slot (list f-slot))
(add-to-score! 1)))
(#t (move-to-foundation slot (+ 3 f-slot)))))
(define (button-double-clicked slot-id)
(and (not (empty-slot? slot-id))
(or (= slot-id 0)
(not (= (modulo slot-id 3) 0)))
(move-to-foundation slot-id 3)))
(define (game-continuable)
(give-status-message)
(and (not (game-won))
(get-hint)))
(define (game-won)
(and (empty-slot? 0)
(empty-slot? 1)
(empty-slot? 2)
(empty-slot? 4)
(empty-slot? 5)
(empty-slot? 7)
(empty-slot? 8)
(empty-slot? 10)
(empty-slot? 11)
(empty-slot? 13)))
(define (to-foundations? slot f-slot)
(cond ((= slot 14)
#f)
((not base-set?)
(list 0 "Move a card to the Foundation"))
((or (empty-slot? slot)
(= slot 3)
(= slot 6)
(= slot 9)
(= slot 12)
(= f-slot 15))
(to-foundations? (+ 1 slot) 3))
((and (empty-slot? f-slot)
(= (get-value (get-top-card slot))
BASE-VAL))
(list 2
(get-name (get-top-card slot))
"an empty Foundation"))
((and (not (empty-slot? f-slot))
(= (get-suit (get-top-card f-slot))
(get-suit (get-top-card slot)))
(or (and (= (get-value (get-top-card slot)) ace)
(= (get-value (get-top-card f-slot)) king))
(= (get-value (get-top-card slot))
(+ 1 (get-value (get-top-card f-slot))))))
(list 1
(get-name (get-top-card slot))
(get-name (get-top-card f-slot))))
(#t (to-foundations? slot (+ 3 f-slot)))))
(define (to-tableau? slot1 slot2)
(cond ((= slot1 14)
#f)
((or (empty-slot? slot1)
(= slot2 14)
(= slot1 3)
(= slot1 6)
(= slot1 9)
(= slot1 12))
(to-tableau? (+ 1 slot1) (+ 2 slot1)))
((and (not (or (= slot2 3)
(= slot2 6)
(= slot2 9)
(= slot2 12)))
(not (empty-slot? slot2))
(= (get-suit (get-top-card slot1))
(get-suit (get-top-card slot2)))
(or (= (get-value (get-top-card slot1))
(+ 1 (get-value (get-top-card slot2))))
(and (= (get-value (get-top-card slot1)) king)
(= (get-value (get-top-card slot2)) ace))
(and (= (get-value (get-top-card slot1)) ace)
(= (get-value (get-top-card slot2)) king))
(= (get-value (get-top-card slot2))
(+ 1 (get-value (get-top-card slot1))))))
(list 1
(get-name (get-top-card slot1))
(get-name (get-top-card slot2))))
(#t
(to-tableau? slot1 (+ 1 slot2)))))
(define (empties?)
(and (or (empty-slot? 0)
(empty-slot? 1)
(empty-slot? 2)
(empty-slot? 4)
(empty-slot? 5)
(empty-slot? 7)
(empty-slot? 8)
(empty-slot? 10)
(empty-slot? 11)
(empty-slot? 13))
(list 0 "Move something into the empty Tableau slot")))
(define (get-hint)
(or (to-foundations? 0 3)
(to-tableau? 0 1)
(empties?)))
(define (undo-func data)
(set-score! (car data))
(set! base-set? (cadr data))
(set! BASE-VAL (caddr data)))
(define (record-move slot-id old-cards)
(set! MOVE (list undo-func
(list (get-score) base-set? BASE-VAL)
(snapshot-board 0 slot-id old-cards))))
(define (get-options)
#f)
(define (apply-options options)
#f)
(define (timeout)
#f)
(set-lambda new-game button-pressed button-released button-clicked
button-double-clicked game-continuable game-won get-hint get-options
apply-options timeout)
......@@ -10,6 +10,7 @@ block-ten.html
bristol.html
camelot.html
canfield.html
chessboard.html
clock.html
cover.html
diamond-mine.html
......
Sat Jun 30 16:33:01 2001 Rosanna Yuen <zana@webwynk.net>
* chessboard.sgml: new help file
Fri Mar 9 01:53:42 2001 Rosanna Yuen <zana@webwynk.net>
* fortress.sgml: added a new help file
......
......@@ -18,6 +18,7 @@ sgml_ents = \
bristol.sgml \
camelot.sgml \
canfield.sgml \
chessboard.sgml \
clock.sgml \
cover.sgml \
diamond_mine.sgml \
......
......@@ -8,6 +8,7 @@
<!ENTITY bristol SYSTEM "bristol.sgml">
<!ENTITY camelot SYSTEM "camelot.sgml">
<!ENTITY canfield SYSTEM "canfield.sgml">
<!ENTITY chessboard SYSTEM "chessboard.sgml">
<!ENTITY clock SYSTEM "clock.sgml">
<!ENTITY cover SYSTEM "cover.sgml">
<!ENTITY diamond-mine SYSTEM "diamond_mine.sgml">
......@@ -105,6 +106,7 @@ been coded for your pleasure in the GNOME scripting language (Scheme).</para>
&bristol;
&camelot;
&canfield;
&chessboard;
&clock;
&cover;
&diamond-mine;
......
<chapter id="chessboard">
<docinfo>
<copyright>
<year>2001</year>
<holder>Rosanna Yuen</holder>
</copyright>
<author>
<firstname>Rosanna</firstname>
<surname>Yuen</surname></author>
<address><email>zana@webwynk.net</email></address>
</docinfo>
<title>Chessboard</title>
<para>written by Rosanna Yuen</para>
<bridgehead>Setup</bridgehead>
<informaltable>
<tgroup cols="2">
<tbody>
<row>
<entry>Type of Deck</entry>
<entry>
Standard Deck
</entry>
</row>
<row>
<entry>Foundations</entry>
<entry>
Four piles in the middle. To be built up in suit from base
card of your choice, wrapping from King to Ace if
necessary.. Cards in Foundation piles are no longer in
play.
</entry>
</row>
<row>
<entry>Tableau</entry>
<entry>
Five piles one each side of the Foundation. Deal five cards
face up on to each of these piles and one more on the top
two piles. The top card in any Tableau pile is available
for play.
</entry>
</row>
</tbody>
</tgroup>
</informaltable>
<bridgehead>Goal</bridgehead>
<para>
Move all cards to Foundation piles.
</para>
<bridgehead>Rules</bridgehead>
<para>
Cards in Tableau piles can be built up or down in suit. Only the
top card in every pile is available for play. Empty slots can be
filled with any available card.
</para>
<para>
The Foundations are built up from the base card of your choice,
wrapping from King to Ace if necessary. Cards in Foundation piles
are no longer in play.
</para>
<bridgehead>Options</bridgehead>
<para>None</para>
<bridgehead>Scoring</bridgehead>
<para>
Each card in Foundation piles scores one point.
</para>
<para>
Maximum possible score: 52
</para>
<bridgehead>Strategy</bridgehead>
<para>
Choose your base card wisely. The obvious choice may lead to nought
but a dead end.
</para>
</chapter>
<!-- Keep this comment at the end of the file
Local variables:
sgml-default-dtd-file: "/usr/lib/sgml/cdtd/docbook.ced"
End:
-->
......@@ -199,7 +199,6 @@
(define (move-to-foundation start-slot card-list end-slot)
(deal-cards start-slot (list end-slot))
(add-to-score! 1))
(define (place-ace card slot)
(if (empty-slot? 2)
......
......@@ -8,6 +8,7 @@
<!ENTITY bristol SYSTEM "bristol.sgml">
<!ENTITY camelot SYSTEM "camelot.sgml">
<!ENTITY canfield SYSTEM "canfield.sgml">
<!ENTITY chessboard SYSTEM "chessboard.sgml">
<!ENTITY clock SYSTEM "clock.sgml">
<!ENTITY cover SYSTEM "cover.sgml">
<!ENTITY diamond-mine SYSTEM "diamond_mine.sgml">
......@@ -105,6 +106,7 @@ been coded for your pleasure in the GNOME scripting language (Scheme).</para>
&bristol;
&camelot;
&canfield;
&chessboard;
&clock;
&cover;
&diamond-mine;
......
<chapter id="chessboard">
<docinfo>
<copyright>
<year>2001</year>
<holder>Rosanna Yuen</holder>
</copyright>
<author>
<firstname>Rosanna</firstname>
<surname>Yuen</surname></author>
<address><email>zana@webwynk.net</email></address>
</docinfo>
<title>Chessboard</title>
<para>written by Rosanna Yuen</para>
<bridgehead>Setup</bridgehead>
<informaltable>
<tgroup cols="2">
<tbody>
<row>
<entry>Type of Deck</entry>
<entry>
Standard Deck
</entry>
</row>
<row>
<entry>Foundations</entry>
<entry>
Four piles in the middle. To be built up in suit from base
card of your choice, wrapping from King to Ace if
necessary.. Cards in Foundation piles are no longer in
play.
</entry>
</row>
<row>
<entry>Tableau</entry>
<entry>
Five piles one each side of the Foundation. Deal five cards
face up on to each of these piles and one more on the top
two piles. The top card in any Tableau pile is available
for play.
</entry>
</row>
</tbody>
</tgroup>
</informaltable>
<bridgehead>Goal</bridgehead>
<para>
Move all cards to Foundation piles.
</para>
<bridgehead>Rules</bridgehead>
<para>
Cards in Tableau piles can be built up or down in suit. Only the
top card in every pile is available for play. Empty slots can be
filled with any available card.
</para>
<para>
The Foundations are built up from the base card of your choice,
wrapping from King to Ace if necessary. Cards in Foundation piles
are no longer in play.
</para>
<bridgehead>Options</bridgehead>
<para>None</para>
<bridgehead>Scoring</bridgehead>
<para>
Each card in Foundation piles scores one point.
</para>
<para>
Maximum possible score: 52
</para>
<bridgehead>Strategy</bridgehead>
<para>
Choose your base card wisely. The obvious choice may lead to nought
but a dead end.
</para>
</chapter>
<!-- Keep this comment at the end of the file
Local variables:
sgml-default-dtd-file: "/usr/lib/sgml/cdtd/docbook.ced"
End:
-->
; AisleRiot - chessboard.scm
; Copyright (C) 2001 Rosanna Yuen <zana@webwynk.net>
;
; 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 BASE-VAL 0)
(define base-set? #f)
(define (new-game)
(initialize-playing-area)
(set-ace-low)
(make-standard-deck)
(shuffle-deck)
(set! base-set? #f)
(add-extended-slot '() right)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
(add-extended-slot '() right)
(add-carriage-return-slot)
(add-extended-slot '() right)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
(add-normal-slot DECK)
(add-blank-slot)
(add-extended-slot '() right)
(add-carriage-return-slot)
(add-extended-slot '() right)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
(add-normal-slot '())
(add-blank-slot)
(add-extended-slot '() right)
(add-carriage-return-slot)
(add-extended-slot '() right)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
(add-normal-slot '())
(add-blank-slot)
(add-extended-slot '() right)
(add-carriage-return-slot)
(add-extended-slot '() right)
(add-blank-slot)
(add-blank-slot)
(add-blank-slot)
(add-normal-slot '())
(add-blank-slot)
(add-extended-slot '() right)
(deal-cards-face-up 3 '(0 2 5 8 11 1 4 7 10 13 0 2 5 8 11 1 4 7 10 13 0 2 5 8 11 1 4 7 10 13 0 2 5 8 11 1 4 7 10 13 0 2 5 8 11 1 4 7 10 13 0 1))
(give-status-message)
(list 10 5))
(define (give-status-message)
(if (not base-set?)
(set-statusbar-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 #f)))
(define (button-pressed slot-id card-list)
(and (not (empty-slot? slot-id))
(not (= slot-id 3))
(not (= slot-id 6))
(not (= slot-id 9))
(not (= slot-id 12))
(= (length card-list) 1)))
(define (button-released start-slot card-list end-slot)
(cond ((or (= end-slot 3)
(= end-slot 6)
(= end-slot 9)
(= end-slot 12))
(and (or (and (empty-slot? end-slot)
(or (and (not base-set?)
(set! BASE-VAL (get-value (car card-list)))
(set! base-set? #t))
(= (get-value (car card-list)) BASE-VAL)))
(and (not (empty-slot? end-slot))
(= (get-suit (get-top-card end-slot))
(get-suit (car card-list)))
(or (= (get-value (car card-list))
(+ 1 (get-value (get-top-card end-slot))))
(and (= (get-value (car card-list)) ace)
(= (get-value (get-top-card end-slot)) king)))))
(move-n-cards! start-slot end-slot card-list)
(add-to-score! 1)))
((or (empty-slot? end-slot)
(and (= (get-suit (get-top-card end-slot))
(get-suit (car card-list)))
(or (= (get-value (get-top-card end-slot))
(+ 1 (get-value (car card-list))))
(and (= (get-value (get-top-card end-slot)) king)
(= (get-value (car card-list)) ace))
(and (= (get-value (get-top-card end-slot)) ace)
(= (get-value (car card-list)) king))
(= (+ 1 (get-value (get-top-card end-slot)))
(get-value (car card-list))))))
(move-n-cards! start-slot end-slot card-list))
(#t #f)))
(define (button-clicked slot-id)
#f)
(define (move-to-foundation slot f-slot)
(cond ((= f-slot 15)
#f)
((not base-set?)
(and (set! base-set? #t)
(set! BASE-VAL (get-value (get-top-card slot)))
(deal-cards slot '(3))
(add-to-score! 1)))
((and (empty-slot? f-slot)
(= (get-value (get-top-card slot)) BASE-VAL))
(and (deal-cards slot (list f-slot))
(add-to-score! 1)))
((and (not (empty-slot? f-slot))
(= (get-suit (get-top-card f-slot))
(get-suit (get-top-card slot)))
(or (and (= (get-value (get-top-card f-slot)) king)
(= (get-value (get-top-card slot)) ace))
(= (+ 1 (get-value (get-top-card f-slot)))
(get-value (get-top-card slot)))))
(and (deal-cards slot (list f-slot))
(add-to-score! 1)))
(#t (move-to-foundation slot (+ 3 f-slot)))))
(define (button-double-clicked slot-id)
(and (not (empty-slot? slot-id))
(or (= slot-id 0)
(not (= (modulo slot-id 3) 0)))
(move-to-foundation slot-id 3)))
(define (game-continuable)
(give-status-message)
(and (not (game-won))
(get-hint)))
(define (game-won)
(and (empty-slot? 0)
(empty-slot? 1)
(empty-slot? 2)
(empty-slot? 4)
(empty-slot? 5)
(empty-slot? 7)
(empty-slot? 8)
(empty-slot? 10)
(empty-slot? 11)
(empty-slot? 13)))
(define (to-foundations? slot f-slot)