Hardcell for Aisleriot

hardcell.scm

;;; hardcell.scm -- Modified Free Cell game for AisleRiot.

;; Copyright (C) 2014 Markus Kitsinger

;; Author: Markus Kitsinger <root@swooshalicio.us>

; 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/>.

;;; Code:

;Load original Freecell game.
(primitive-load-path "freecell")

;Change initial setup.
(define (deal-initial-setup)
  (let ((fields (list field-1 field-2 field-3 field-4
			       field-5 field-6 field-7 field-8))
	(half-fields (list field-1 field-2 field-3 field-4)))
  	;Deal cards face down
    (deal-cards-from-deck DECK
				  (append fields fields fields
					fields fields fields
					half-fields))
    ;Flip cards that are supposed to be visible.
	(flipfour field-1)
	(flipfour field-2)
	(flipfour field-3)
	(flipfour field-4)
	(flipthree field-5)
	(flipthree field-6)
	(flipthree field-7)
	(flipthree field-8)
))

(define (flipfour slot)
	(let ((cards (list (make-visible (remove-card slot))
		(make-visible (remove-card slot))
		(make-visible (remove-card slot))
		(make-visible (remove-card slot)))))
	(add-cards! slot cards)))

(define (flipthree slot)
	(let ((cards (list (make-visible (remove-card slot))
		(make-visible (remove-card slot))
		(make-visible (remove-card slot)))))
	(add-cards! slot cards)))

;Make cards visible as they're revealed
(define (remove-card slot-id)
  (let ((cards (get-cards slot-id)))
    (if (and (not (null? (cdr cards)))
             (member slot-id fields))
        (set-cards! slot-id (cons (make-visible (car (cdr cards))) (cdr (cdr cards))))
        (set-cards! slot-id (cdr cards)))
    (car cards)))

(define (button-released start-slot card-list end-slot)
  (and (not (= start-slot end-slot))
       (cond ((homecell? end-slot) (move-to-homecell card-list end-slot))
             ((field?    end-slot) (move-to-field    start-slot card-list end-slot))
             ((freecell? end-slot) (move-to-freecell card-list end-slot)))
       (if (not (null? (get-cards start-slot)))
           (make-visible-top-card start-slot))
       (move-low-cards 0)))

(define (get-options) #f)

(define (apply-options options) #f)

(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?)

hardcell.xml

<?xml version="1.0" encoding="utf-8" ?>
<!DOCTYPE refentry PUBLIC "-//OASIS//DTD DocBook XML V4.3//EN"
                   "http://www.oasis-open.org/docbook/xml/4.3/docbookx.dtd" [
]>
<sect1 id="Hardcell"><!--<sect1info>
		<copyright>
			<year>1999</year>
			<holder>Rosanna Yuen</holder>
		</copyright>
		<author>
			<firstname>Rosanna</firstname>
			<surname>Yuen</surname>
		</author>
		<address><email>rwsy@mit.edu</email></address>
		<editor>
			<othername>Markus Kitsinger</othername>
			<contrib>Modification from Freecell to Hardcell</contrib>
		</editor>
		<address><email>root@swooshalicio.us</email></address>
	</sect1info>-->

	<title>Hardcell</title>

	<para>Written by Markus Kitsinger</para>

	        <sect2><title>Setup</title>


	<informaltable>
		<tgroup cols="2">
			<tbody>
	<row>
		<entry>Type of Deck</entry>
		<entry>Standard Deck</entry>
	</row>
	<row>
		<entry>Reserves</entry>
		<entry>
			Four left piles on top row.  Each Reserve pile can only hold one card.
		</entry>
	</row>
	<row>
		<entry>Foundation</entry>
		<entry>
			Four piles top right.  To be built up in suit from Ace to
			King.  Cards in Foundations are no longer in play.
		</entry>
	</row>
	<row>
		<entry>Tableau</entry>
		<entry>
			Eight piles.  Deal three face down cards to each pile, then deal all
			remaining cards face up, ending up with seven cards in each of the
			first four piles and six cards in the last four piles.  Tableau can
			be built down in alternating colors.  Cards can only be moved singly,
			but as a shortcut, if there are enough Reserve piles free to allow
			it, cards in sequence can be moved together.
		</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 color.  Groups of
		cards can be moved if there are enough Reserve piles free to allow the
		move if the cards were moved singly.  An empty pile in the Tableau can
		be filled with any card or group of cards.
	</para>
	<para>
		Foundations are built up in suit from Ace to King.  Cards in Foundations
		are not in play.  Double clicking on a card will move it to the
		appropriate Foundation pile if such a move is possible.
	</para>
	<para>
		Cards in Reserve piles can be played back on to Tableau or on to the
		Foundation.
	</para>

	        </sect2>
        <sect2><title>Scoring</title>

	<para>
		Each card in the Foundation piles scores one point.
	</para>
	<para>
		Maximum possible score:  52
	</para>

	        </sect2>
        <sect2><title>Strategy</title>

	<para>
		Space is a valuable commodity.  Keep as many of the Reserve piles free
		as possible.
	</para>
        </sect2>
</sect1>